From 665dd3020da1a1d45a7631e25ed7433825d4966b Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 4 Dec 2020 03:30:39 +0100 Subject: [PATCH 001/214] new gmsh version --- PRIVATE | 2 +- src/mesh/discretization_mesh.f90 | 14 ++++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/PRIVATE b/PRIVATE index 68cde5229..113f44413 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 68cde52291ebb683ca6f610879f2ae28372597a7 +Subproject commit 113f44413c88e9b577f3781012592ea9a4836458 diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 7dbd05e46..d998c84db 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -69,7 +69,7 @@ subroutine discretization_mesh_init(restart) integer, allocatable, dimension(:) :: chunkPos integer :: dimPlex, & mesh_Nnodes, & !< total number of nodes in mesh - j, l, & + j, l, k, & debug_element, debug_ip PetscSF :: sf DM :: globalMesh @@ -96,7 +96,6 @@ subroutine discretization_mesh_init(restart) debug_element = config_debug%get_asInt('element',defaultVal=1) debug_ip = config_debug%get_asInt('integrationpoint',defaultVal=1) - call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) @@ -137,11 +136,14 @@ subroutine discretization_mesh_init(restart) l = l + 1 if (trim(fileContent(l)) == '$EndElements') exit chunkPos = IO_stringPos(fileContent(l)) - if (chunkPos(1) == 3+IO_intValue(fileContent(l),chunkPos,3)+dimPlex+1) then - call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,4),ierr) - CHKERRQ(ierr) - j = j + 1 + if(IO_intValue(fileContent(l),chunkPos,1) == 3) then + do k = 1, IO_intValue(fileContent(l),chunkPos,4) + call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,2),ierr) + CHKERRQ(ierr) + j = j + 1 + enddo endif + l = l + IO_intValue(fileContent(l),chunkPos,4) enddo exit endif From 579d2a91471d6b8735bf0ccc1b8a819989077042 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 4 Dec 2020 13:05:54 +0100 Subject: [PATCH 002/214] test file updated --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 113f44413..df8eb2621 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 113f44413c88e9b577f3781012592ea9a4836458 +Subproject commit df8eb262174f2e07b3c5d6a8655022940c9fc5c9 From f563313ce97c61720d0daafe6f01498278e964fe Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Sat, 5 Dec 2020 23:52:30 +0100 Subject: [PATCH 003/214] PETSc provides subroutine to read physical tags --- src/mesh/discretization_mesh.f90 | 47 ++++++++++---------------------- 1 file changed, 14 insertions(+), 33 deletions(-) diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index d998c84db..69c86798e 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -83,6 +83,7 @@ subroutine discretization_mesh_init(restart) class(tNode), pointer :: & num_mesh integer :: integrationOrder !< order of quadrature rule required + print'(/,a)', ' <<<+- discretization_mesh init -+>>>' @@ -96,12 +97,16 @@ subroutine discretization_mesh_init(restart) debug_element = config_debug%get_asInt('element',defaultVal=1) debug_ip = config_debug%get_asInt('integrationpoint',defaultVal=1) + ! vol_tag = 10 call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) CHKERRQ(ierr) call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) CHKERRQ(ierr) + call DMView(globalMesh, PETSC_VIEWER_STDOUT_WORLD,ierr) + CHKERRQ(ierr) + ! get number of IDs in face sets (for boundary conditions?) call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) CHKERRQ(ierr) @@ -109,6 +114,14 @@ subroutine discretization_mesh_init(restart) call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + if (worldrank == 0) then + call DMClone(globalMesh,geomMesh,ierr) + CHKERRQ(ierr) + else + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + CHKERRQ(ierr) + endif + allocate(mesh_boundaries(mesh_Nboundaries), source = 0) call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) CHKERRQ(ierr) @@ -123,38 +136,6 @@ subroutine discretization_mesh_init(restart) endif call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) - if (worldrank == 0) then - fileContent = IO_readlines(interface_geomFile) - l = 0 - do - l = l + 1 - if (IO_isBlank(fileContent(l))) cycle ! need also to ignore C and C++ style comments? - if (trim(fileContent(l)) == '$Elements') then - j = 0 - l = l + 1 - do - l = l + 1 - if (trim(fileContent(l)) == '$EndElements') exit - chunkPos = IO_stringPos(fileContent(l)) - if(IO_intValue(fileContent(l),chunkPos,1) == 3) then - do k = 1, IO_intValue(fileContent(l),chunkPos,4) - call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,2),ierr) - CHKERRQ(ierr) - j = j + 1 - enddo - endif - l = l + IO_intValue(fileContent(l),chunkPos,4) - enddo - exit - endif - enddo - call DMClone(globalMesh,geomMesh,ierr) - CHKERRQ(ierr) - else - call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) - CHKERRQ(ierr) - endif - call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_NcpElems,ierr) @@ -169,7 +150,7 @@ subroutine discretization_mesh_init(restart) allocate(materialAt(mesh_NcpElems)) do j = 1, mesh_NcpElems - call DMGetLabelValue(geomMesh,'material',j-1,materialAt(j),ierr) + call DMGetLabelValue(geomMesh,'Cell Sets',j-1,materialAt(j),ierr) CHKERRQ(ierr) end do From 21faee4eaa9f5dddfa11f68a6795906eff55e9f5 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Mon, 7 Dec 2020 13:03:18 +0100 Subject: [PATCH 004/214] '0' based indexing --- PRIVATE | 2 +- src/mesh/discretization_mesh.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index df8eb2621..899f0ae9e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit df8eb262174f2e07b3c5d6a8655022940c9fc5c9 +Subproject commit 899f0ae9e25ddad62530ec8a9381cf520aad083b diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 69c86798e..0a9c5adaa 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -97,7 +97,6 @@ subroutine discretization_mesh_init(restart) debug_element = config_debug%get_asInt('element',defaultVal=1) debug_ip = config_debug%get_asInt('integrationpoint',defaultVal=1) - ! vol_tag = 10 call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr) CHKERRQ(ierr) call DMGetDimension(globalMesh,dimPlex,ierr) @@ -153,6 +152,7 @@ subroutine discretization_mesh_init(restart) call DMGetLabelValue(geomMesh,'Cell Sets',j-1,materialAt(j),ierr) CHKERRQ(ierr) end do + materialAt(:) = materialAt(:) + 1 if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') From 610c233fb68b1a87ef48d98d103ee66e4872799d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 08:45:08 +0100 Subject: [PATCH 005/214] ensure correct shape --- python/tests/test_Table.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/python/tests/test_Table.py b/python/tests/test_Table.py index ac5859ecb..8f617aff5 100644 --- a/python/tests/test_Table.py +++ b/python/tests/test_Table.py @@ -22,7 +22,7 @@ class TestTable: @pytest.mark.parametrize('N',[10,40]) def test_len(self,N): - len(Table(np.random.rand(N,3),{'X':3})) == N + assert len(Table(np.random.rand(N,3),{'X':3})) == N def test_get_scalar(self,default): d = default.get('s') From 0e8082860cac913bc5739ff7ce9436295a257546 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 08:45:44 +0100 Subject: [PATCH 006/214] Fortran standard is 2018 will not work for older compilers --- cmake/Compiler-Intel.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cmake/Compiler-Intel.cmake b/cmake/Compiler-Intel.cmake index 719ed885b..5b551069e 100644 --- a/cmake/Compiler-Intel.cmake +++ b/cmake/Compiler-Intel.cmake @@ -20,7 +20,7 @@ endif () # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172) -set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name") +set (STANDARD_CHECK "-stand f18 -standard-semantics -assume nostd_mod_proc_name") set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel") # Link against shared Intel libraries instead of static ones From b6d00e2fb836a8324b85da3159a93234415d01ce Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 08:48:04 +0100 Subject: [PATCH 007/214] limit access to public variables to one function not sure if the 'volatile' attribute is needed --- src/DAMASK_interface.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 41f421eb8..f664eb458 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -392,7 +392,7 @@ end function makeRelativePath subroutine catchSIGTERM(signal) bind(C) integer(C_INT), value :: signal - interface_SIGTERM = .true. + call interface_setSIGTERM(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE' @@ -417,7 +417,7 @@ end subroutine interface_setSIGTERM subroutine catchSIGUSR1(signal) bind(C) integer(C_INT), value :: signal - interface_SIGUSR1 = .true. + call interface_setSIGUSR1(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE' @@ -442,7 +442,7 @@ end subroutine interface_setSIGUSR1 subroutine catchSIGUSR2(signal) bind(C) integer(C_INT), value :: signal - interface_SIGUSR2 = .true. + call interface_setSIGUSR2(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE' From 189597dbffd4a33bc64b55d4bce9ac49f638aa90 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 08:55:07 +0100 Subject: [PATCH 008/214] drop support for old PETSc versions --- src/DAMASK_interface.f90 | 2 +- src/mesh/mesh_mech_FEM.f90 | 29 +---------------------------- 2 files changed, 2 insertions(+), 29 deletions(-) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index f664eb458..d38020225 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -10,7 +10,7 @@ !> and working directory. !-------------------------------------------------------------------------------------------------- #define PETSC_MAJOR 3 -#define PETSC_MINOR_MIN 10 +#define PETSC_MINOR_MIN 12 #define PETSC_MINOR_MAX 14 module DAMASK_interface diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 8aa084ac8..a4fa29204 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -147,14 +147,9 @@ subroutine FEM_mech_init(fieldBC) call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr) call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr) nBasis = nBasis/nc -#if (PETSC_VERSION_MINOR > 10) call DMAddField(mech_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr) call DMCreateDS(mech_mesh,ierr); CHKERRQ(ierr) -#endif call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) -#if (PETSC_VERSION_MINOR < 11) - call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr) -#endif call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr) call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr) call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr) @@ -163,11 +158,7 @@ subroutine FEM_mech_init(fieldBC) ! Setup FEM mech boundary conditions call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(mech_mesh,section,ierr); CHKERRQ(ierr) -#endif allocate(pnumComp(1), source=dimPlex) allocate(pnumDof(0:dimPlex), source = 0) do topologDim = 0, dimPlex @@ -205,14 +196,8 @@ subroutine FEM_mech_init(fieldBC) endif endif enddo; enddo -#if (PETSC_VERSION_MINOR < 11) - call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & - numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr) -#else call DMPlexCreateSection(mech_mesh,nolabel,pNumComp,pNumDof, & numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr) - -#endif CHKERRQ(ierr) call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr) do faceSet = 1, numBC @@ -267,11 +252,7 @@ subroutine FEM_mech_init(fieldBC) x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal) enddo px_scal => x_scal -#if (PETSC_VERSION_MINOR < 11) - call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr) -#else - call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) ! PETSc: cbee0a90b60958e5c50c89b1e41f4451dfa6008c -#endif + call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) CHKERRQ(ierr) enddo @@ -355,11 +336,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) allocate(pinvcellJ(dimPlex**2)) allocate(x_scal(cellDof)) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr) -#endif call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) CHKERRQ(ierr) @@ -502,11 +479,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr) -#endif call DMGetGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr) call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) From 104fa167bdcbdce00b32b31170b5e82a5f1f4e55 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 19:30:34 +0100 Subject: [PATCH 009/214] missing rename: constituent -> phase meaningfull order --- src/material.f90 | 2 +- src/results.f90 | 169 ++++++++++++++++++++++++----------------------- 2 files changed, 87 insertions(+), 84 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 223ea6ed8..b05979298 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -176,7 +176,7 @@ subroutine material_init(restart) if (.not. restart) then call results_openJobFile - call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,material_name_phase) + call results_mapping_phase(material_phaseAt,material_phaseMemberAt,material_name_phase) call results_mapping_homogenization(material_homogenizationAt,material_homogenizationMemberAt,material_name_homogenization) call results_closeJobFile endif diff --git a/src/results.f90 b/src/results.f90 index f15ad4e4a..ea9fd62d4 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -49,7 +49,7 @@ module results results_setLink, & results_addAttribute, & results_removeLink, & - results_mapping_constituent, & + results_mapping_phase, & results_mapping_homogenization contains @@ -461,7 +461,7 @@ end subroutine results_writeTensorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- -subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) +subroutine results_mapping_phase(phaseAt,memberAtLocal,label) integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element) integer, dimension(:,:,:), intent(in) :: memberAtLocal !< phase member at (constituent,IP,element) @@ -491,6 +491,47 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int integer :: hdferr, ierr, i +!-------------------------------------------------------------------------------------------------- +! prepare MPI communication (transparent for non-MPI runs) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + memberOffset = 0 + do i=1, size(label) + memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process + 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, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process + if(ierr /= 0) error stop 'MPI error' + + call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process + if(ierr /= 0) error stop 'MPI error' +#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) + + +!--------------------------------------------------------------------------------------------------- +! 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 + !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) @@ -525,34 +566,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) call h5tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!-------------------------------------------------------------------------------------------------- -! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - memberOffset = 0 - do i=1, size(label) - memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process - 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, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - - call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if(ierr /= 0) error stop 'MPI error' - - call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if(ierr /= 0) error stop 'MPI error' -#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,hdferr,myShape) @@ -564,18 +577,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!--------------------------------------------------------------------------------------------------- -! expand phaseAt to consider IPs (is not stored per IP) - 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., hdferr) @@ -609,7 +610,7 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) if(hdferr < 0) error stop 'HDF5 error' call h5tclose_f(position_id, hdferr) -end subroutine results_mapping_constituent +end subroutine results_mapping_phase !-------------------------------------------------------------------------------------------------- @@ -645,6 +646,48 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int integer :: hdferr, ierr, i + +!-------------------------------------------------------------------------------------------------- +! prepare MPI communication (transparent for non-MPI runs) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + memberOffset = 0 + do i=1, size(label) + memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process + 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, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process + if(ierr /= 0) error stop 'MPI error' + + call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process + if(ierr /= 0) error stop 'MPI error' +#endif + + myShape = int([writeSize(worldrank)], HSIZE_T) + myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T) + totalShape = int([sum(writeSize)], HSIZE_T) + + +!--------------------------------------------------------------------------------------------------- +! 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 + !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) @@ -679,34 +722,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) call h5tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!-------------------------------------------------------------------------------------------------- -! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - memberOffset = 0 - do i=1, size(label) - memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process - 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, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - - call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if(ierr /= 0) error stop 'MPI error' - - call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if(ierr /= 0) error stop 'MPI error' -#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,hdferr,myShape) @@ -718,18 +733,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!--------------------------------------------------------------------------------------------------- -! expand phaseAt to consider IPs (is not stored per IP) - 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., hdferr) From 8100f3ebfaa78da64f473d721016dc0e84abd8de Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 13 Dec 2020 22:29:36 +0100 Subject: [PATCH 010/214] not required for cmake > 2.4 --- CMakeLists.txt | 2 +- PRIVATE | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index dd2348fd1..d8eb2cbf0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,6 @@ ######################################################################################## # Compiler options for building DAMASK -cmake_minimum_required (VERSION 3.10.0 FATAL_ERROR) +cmake_minimum_required (VERSION 3.10.0) #--------------------------------------------------------------------------------------- # Find PETSc from system environment diff --git a/PRIVATE b/PRIVATE index 08f8aea46..6b8ba6d84 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 08f8aea465a1b5e476b584bcae7927d113919b1d +Subproject commit 6b8ba6d844b70695233b02eae85f4300315f339d From b95eb6f604dfef0bb08b4d7936f857f635342212 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 14 Dec 2020 13:01:52 +0100 Subject: [PATCH 011/214] simplified (using pkg-config module of PETSc) might be possible to use pkg-config for FFTW and HDF5 in future --- CMakeLists.txt | 53 ++++++++++++++++---------------------------------- 1 file changed, 17 insertions(+), 36 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index d8eb2cbf0..553c42400 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,18 @@ -######################################################################################## -# Compiler options for building DAMASK cmake_minimum_required (VERSION 3.10.0) +include (FindPkgConfig REQUIRED) + +# Dummy project to determine compiler names and version +project (Prerequisites LANGUAGES) +set(ENV{PKG_CONFIG_PATH} "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/pkgconfig") +pkg_search_module (PETSC REQUIRED PETSc>3.12.0) +pkg_get_variable (CMAKE_Fortran_COMPILER PETSc fcompiler) +pkg_get_variable (CMAKE_C_COMPILER PETSc ccompiler) + +find_program (CAT_EXECUTABLE NAMES cat) +execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION + RESULT_VARIABLE DAMASK_VERSION_RETURN + OUTPUT_VARIABLE DAMASK_VERSION + OUTPUT_STRIP_TRAILING_WHITESPACE) #--------------------------------------------------------------------------------------- # Find PETSc from system environment @@ -28,17 +40,11 @@ include ${petsc_conf_rules} include ${petsc_conf_variables} INCLUDE_DIRS := \${PETSC_FC_INCLUDES} LIBRARIES := \${PETSC_WITH_EXTERNAL_LIB} -COMPILERF := \${FC} -COMPILERC := \${CC} LINKERNAME := \${FLINKER} includes: \t@echo \${INCLUDE_DIRS} extlibs: \t@echo \${LIBRARIES} -compilerf: -\t@echo \${COMPILERF} -compilerc: -\t@echo \${COMPILERC} linker: \t@echo \${LINKERNAME} ") @@ -57,16 +63,6 @@ execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_conf RESULT_VARIABLE PETSC_EXTERNAL_LIB_RETURN OUTPUT_VARIABLE petsc_external_lib OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified fortran compiler -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerf" - RESULT_VARIABLE PETSC_MPIFC_RETURN - OUTPUT_VARIABLE PETSC_MPIFC - OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified C compiler -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerc" - RESULT_VARIABLE PETSC_MPICC_RETURN - OUTPUT_VARIABLE PETSC_MPICC - OUTPUT_STRIP_TRAILING_WHITESPACE) # PETSc specified linker (Fortran compiler + PETSc linking flags) execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "linker" RESULT_VARIABLE PETSC_LINKER_RETURN @@ -91,13 +87,6 @@ message ("Found PETSC_DIR:\n${PETSC_DIR}\n" ) message ("Found PETSC_INCLUDES:\n${PETSC_INCLUDES}\n" ) message ("Found PETSC_EXTERNAL_LIB:\n${PETSC_EXTERNAL_LIB}\n") message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n" ) -message ("Found MPI Fortran Compiler:\n${PETSC_MPIFC}\n" ) -message ("Found MPI C Compiler:\n${PETSC_MPICC}\n" ) - -# set compiler commands to match PETSc (needs to be done before defining the project) -# https://cmake.org/Wiki/CMake_FAQ#How_do_I_use_a_different_compiler.3F -set (CMAKE_Fortran_COMPILER "${PETSC_MPIFC}") -set (CMAKE_C_COMPILER "${PETSC_MPICC}") #--------------------------------------------------------------------------------------- # Now start to care about DAMASK @@ -115,7 +104,8 @@ elseif (DAMASK_SOLVER STREQUAL "mesh") else () message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined") endif () -list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) +add_definitions (-DDAMASKVERSION="${DAMASK_VERSION}") +add_definitions (-DPETSc) if (CMAKE_BUILD_TYPE STREQUAL "") set (CMAKE_BUILD_TYPE "RELEASE") @@ -153,17 +143,8 @@ if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only") endif () -# Parse DAMASK version from VERSION file -find_program (CAT_EXECUTABLE NAMES cat) -execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION - RESULT_VARIABLE DAMASK_VERSION_RETURN - OUTPUT_VARIABLE DAMASK_V - OUTPUT_STRIP_TRAILING_WHITESPACE) -add_definitions (-DDAMASKVERSION="${DAMASK_V}") - -# definition of other macros -add_definitions (-DPETSc) +list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") include (Compiler-Intel) elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") From 168d6e85e1ddd948d53b7825470b9ba1f7f7bd59 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 14 Dec 2020 17:44:31 +0100 Subject: [PATCH 012/214] simplified --- CMakeLists.txt | 21 +++++---------------- 1 file changed, 5 insertions(+), 16 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 553c42400..8db6dd0c0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -40,13 +40,10 @@ include ${petsc_conf_rules} include ${petsc_conf_variables} INCLUDE_DIRS := \${PETSC_FC_INCLUDES} LIBRARIES := \${PETSC_WITH_EXTERNAL_LIB} -LINKERNAME := \${FLINKER} includes: \t@echo \${INCLUDE_DIRS} extlibs: \t@echo \${LIBRARIES} -linker: -\t@echo \${LINKERNAME} ") # CMake will execute each target in the ${petsc_config_makefile} @@ -58,16 +55,10 @@ execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_conf OUTPUT_VARIABLE petsc_includes OUTPUT_STRIP_TRAILING_WHITESPACE) # Find the PETSc external linking directory settings -# required for final linking, must be appended after the executable execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "extlibs" RESULT_VARIABLE PETSC_EXTERNAL_LIB_RETURN OUTPUT_VARIABLE petsc_external_lib OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified linker (Fortran compiler + PETSc linking flags) -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "linker" - RESULT_VARIABLE PETSC_LINKER_RETURN - OUTPUT_VARIABLE PETSC_LINKER - OUTPUT_STRIP_TRAILING_WHITESPACE) # Remove temporary makefile, no need to keep it anymore. file (REMOVE_RECURSE ${TEMPDIR}) @@ -86,7 +77,6 @@ endforeach (exlib) message ("Found PETSC_DIR:\n${PETSC_DIR}\n" ) message ("Found PETSC_INCLUDES:\n${PETSC_INCLUDES}\n" ) message ("Found PETSC_EXTERNAL_LIB:\n${PETSC_EXTERNAL_LIB}\n") -message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n" ) #--------------------------------------------------------------------------------------- # Now start to care about DAMASK @@ -94,19 +84,19 @@ message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n" ) # DAMASK solver defines project to build string(TOLOWER ${DAMASK_SOLVER} DAMASK_SOLVER) if (DAMASK_SOLVER STREQUAL "grid") - project (damask-grid Fortran C) + project (damask-grid HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C) add_definitions (-DGrid) - message ("Building Grid Solver\n") elseif (DAMASK_SOLVER STREQUAL "mesh") - project (damask-mesh Fortran C) + project (damask-mesh HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C) add_definitions (-DMesh) - message ("Building Mesh Solver\n") else () message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined") endif () add_definitions (-DDAMASKVERSION="${DAMASK_VERSION}") add_definitions (-DPETSc) +message ("\nBuilding ${CMAKE_PROJECT_NAME}\n") + if (CMAKE_BUILD_TYPE STREQUAL "") set (CMAKE_BUILD_TYPE "RELEASE") endif () @@ -155,9 +145,8 @@ else () message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") endif () - set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}") -set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${PETSC_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}") +set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_Fortran_COMPILER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}") if (CMAKE_BUILD_TYPE STREQUAL "DEBUG") set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}") From 8fbadef52476d4e523acf2689e5ebdba396876df Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 14 Dec 2020 22:37:14 +0100 Subject: [PATCH 013/214] print instead of write --- src/grid/grid_damage_spectral.f90 | 3 +-- src/grid/grid_mech_FEM.f90 | 9 ++++---- src/grid/grid_mech_spectral_basic.f90 | 9 ++++---- src/grid/grid_mech_spectral_polarisation.f90 | 9 ++++---- src/grid/grid_thermal_spectral.f90 | 3 +-- src/grid/spectral_utilities.f90 | 23 +++++++++----------- src/mesh/mesh_mech_FEM.f90 | 4 ++-- 7 files changed, 26 insertions(+), 34 deletions(-) diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 4c014f3c0..79437945b 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -203,8 +203,7 @@ function grid_damage_spectral_solution(timeinc) result(solution) call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr) if (solution%converged) & print'(/,a)', ' ... nonlocal damage converged .....................................' - write(IO_STDOUT,'(/,a,f8.6,2x,f8.6,2x,e11.4,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',& - phi_min, phi_max, stagNorm + print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage = ', phi_min, phi_max, stagNorm print'(/,a)', ' ===========================================================================' flush(IO_STDOUT) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 4394b6f81..8874b0cf3 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -510,11 +510,10 @@ subroutine formResidual(da_local,x_local, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 563b25162..05986f32e 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -472,11 +472,10 @@ subroutine formResidual(in, F, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 03780f2e0..832441a4c 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -555,11 +555,10 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if(debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 68a1c5ed1..f5d1a33bc 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -197,8 +197,7 @@ function grid_thermal_spectral_solution(timeinc) result(solution) call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr) if (solution%converged) & print'(/,a)', ' ... thermal conduction converged ..................................' - write(IO_STDOUT,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& - T_min, T_max, stagNorm + print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm print'(/,a)', ' ===========================================================================' flush(IO_STDOUT) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 1e1608d7c..27fe7fd6e 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -688,8 +688,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) if(debugGeneral) then print'(/,a)', ' ... updating masked compliance ............................................' - write(IO_STDOUT,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',& - transpose(temp99_Real)*1.0e-9_pReal + print'(/,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', & + ' Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal flush(IO_STDOUT) endif @@ -709,9 +709,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) if (debugGeneral .or. errmatinv) then write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' - write(IO_STDOUT,trim(formatString),advance='no') ' C * S (load) ', & - transpose(matmul(c_reduced,s_reduced)) - write(IO_STDOUT,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced) + print trim(formatString), ' C * S (load) ', transpose(matmul(c_reduced,s_reduced)) + print trim(formatString), ' S (load) ', transpose(s_reduced) if(errmatinv) error stop 'matrix inversion error' endif temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9]) @@ -722,7 +721,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) utilities_maskedCompliance = math_99to3333(temp99_Real) if(debugGeneral) then - write(IO_STDOUT,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') & + print'(/,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', & ' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal flush(IO_STDOUT) endif @@ -818,13 +817,11 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& - transpose(P_av)*1.e-6_pReal - if(present(rotation_BC)) & - P_av = rotation_BC%rotate(P_av) - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - transpose(P_av)*1.e-6_pReal + if (debugRotation) print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal + if(present(rotation_BC)) P_av = rotation_BC%rotate(P_av) + print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress / MPa =', transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) dPdF_max = 0.0_pReal diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index a4fa29204..14ce1f38f 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -659,8 +659,8 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), & ' @ Iteration ',PETScIter,' mechanical residual norm = ', & int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol) - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - transpose(P_av)*1.e-6_pReal + print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) end subroutine FEM_mech_converged From 2dd520b4a289a437f37f396fcf1f529688743948 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 08:06:50 +0100 Subject: [PATCH 014/214] P_aim should be independent from P_av P_av is not defined after restart or cutback. Restart with change of load case is probably still an issue --- PRIVATE | 2 +- python/damask/grid_filters.py | 4 +- src/grid/DAMASK_grid.f90 | 111 +++++++++-------- src/grid/grid_mech_FEM.f90 | 123 +++++++++---------- src/grid/grid_mech_spectral_basic.f90 | 97 ++++++++------- src/grid/grid_mech_spectral_polarisation.f90 | 107 ++++++++-------- src/grid/spectral_utilities.f90 | 2 +- src/mesh/mesh_mech_FEM.f90 | 2 - 8 files changed, 224 insertions(+), 224 deletions(-) diff --git a/PRIVATE b/PRIVATE index 08f8aea46..de65e1df5 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 08f8aea465a1b5e476b584bcae7927d113919b1d +Subproject commit de65e1df5a76362de93667e9820dbf330b56f96d diff --git a/python/damask/grid_filters.py b/python/damask/grid_filters.py index 9e06e075a..ee929b3bf 100644 --- a/python/damask/grid_filters.py +++ b/python/damask/grid_filters.py @@ -234,7 +234,7 @@ def cellsSizeOrigin_coordinates0_point(coordinates0,ordered=True): origin[_np.where(cells==1)] = 0.0 if cells.prod() != len(coordinates0): - raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.') + raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.') start = origin + delta*.5 end = origin - delta*.5 + size @@ -387,7 +387,7 @@ def cellsSizeOrigin_coordinates0_node(coordinates0,ordered=True): origin = mincorner if (cells+1).prod() != len(coordinates0): - raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.') + raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.') atol = _np.max(size)*5e-2 if not (_np.allclose(coords[0],_np.linspace(mincorner[0],maxcorner[0],cells[0]+1),atol=atol) and \ diff --git a/src/grid/DAMASK_grid.f90 b/src/grid/DAMASK_grid.f90 index a8271cffc..514443dbb 100644 --- a/src/grid/DAMASK_grid.f90 +++ b/src/grid/DAMASK_grid.f90 @@ -42,8 +42,8 @@ program DAMASK_grid !-------------------------------------------------------------------------------------------------- ! variables related to information from load case and geom file - real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) - logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors + real(pReal), dimension(9) :: temp_valueVector !< temporarily from loadcase file when reading in tensors (initialize to 0.0) + logical, dimension(9) :: temp_maskVector !< temporarily from loadcase file when reading in tensors !-------------------------------------------------------------------------------------------------- ! loop variables, convergence etc. @@ -143,8 +143,6 @@ program DAMASK_grid mech_restartWrite => grid_mech_spectral_basic_restartWrite case ('Polarisation') - if(debug_grid%contains('basic')) & - call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_spectral_polarisation_init mech_forward => grid_mech_spectral_polarisation_forward mech_solution => grid_mech_spectral_polarisation_solution @@ -152,8 +150,6 @@ program DAMASK_grid mech_restartWrite => grid_mech_spectral_polarisation_restartWrite case ('FEM') - if(debug_grid%contains('basic')) & - call IO_warning(42, ext_msg='debug Divergence') mech_init => grid_mech_FEM_init mech_forward => grid_mech_FEM_forward mech_solution => grid_mech_FEM_solution @@ -178,11 +174,11 @@ program DAMASK_grid allocate(loadCases(l)%ID(nActiveFields)) field = 1 loadCases(l)%ID(field) = FIELD_MECH_ID ! mechanical active by default - thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then + thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then field = field + 1 loadCases(l)%ID(field) = FIELD_THERMAL_ID endif thermalActive - damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then + damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then field = field + 1 loadCases(l)%ID(field) = FIELD_DAMAGE_ID endif damageActive @@ -190,33 +186,35 @@ program DAMASK_grid load_step => load_steps%get(l) step_mech => load_step%get('mechanics') - loadCases(l)%stress%myType='P' + loadCases(l)%stress%myType='' readMech: do m = 1, step_mech%length select case (step_mech%getKey(m)) - case('dot_F','L','F') ! assign values for the deformation BC matrix + case ('L','dot_F','F') ! assign values for the deformation BC matrix loadCases(l)%deformation%myType = step_mech%getKey(m) - temp_valueVector = 0.0_pReal - step_deformation => step_mech%get(m) - do j = 1, 9 - temp_maskVector(j) = step_deformation%get_asString(j) /= 'x' ! true if not a 'x' - if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j) ! read value where applicable - enddo - loadCases(l)%deformation%mask = transpose(reshape(temp_maskVector,[ 3,3])) ! mask in 3x3 notation - loadCases(l)%deformation%values = math_9to33(temp_valueVector) ! values in 3x3 notation - case('P') + temp_valueVector = 0.0_pReal - step_stress => step_mech%get(m) do j = 1, 9 - temp_maskVector(j) = step_stress%get_asString(j) /= 'x' ! true if not a 'x' - if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j) ! read value where applicable + temp_maskVector(j) = step_deformation%get_asString(j) /= 'x' + if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j) enddo - loadCases(l)%stress%mask = transpose(reshape(temp_maskVector,[ 3,3])) + loadCases(l)%deformation%mask = transpose(reshape(temp_maskVector,[3,3])) + loadCases(l)%deformation%values = math_9to33(temp_valueVector) + case ('dot_P','P') + loadCases(l)%stress%myType = step_mech%getKey(m) + step_stress => step_mech%get(m) + + temp_valueVector = 0.0_pReal + do j = 1, 9 + temp_maskVector(j) = step_stress%get_asString(j) /= 'x' + if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j) + enddo + loadCases(l)%stress%mask = transpose(reshape(temp_maskVector,[3,3])) loadCases(l)%stress%values = math_9to33(temp_valueVector) end select call loadCases(l)%rot%fromAxisAngle(step_mech%get_asFloats('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.) enddo readMech - if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/F/dot_F missing') + if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing') step_discretization => load_step%get('discretization') if(.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing') @@ -239,50 +237,60 @@ program DAMASK_grid if (any(loadCases(l)%deformation%mask(j,1:3) .eqv. .true.) .and. & any(loadCases(l)%deformation%mask(j,1:3) .eqv. .false.)) errorID = 832 ! each row should be either fully or not at all defined enddo - print*, ' L:' - else if (loadCases(l)%deformation%myType == 'F') then + endif + if (loadCases(l)%deformation%myType == 'F') then print*, ' F:' - else if (loadCases(l)%deformation%myType == 'dot_F') then - print*, ' dot_F:' + else + print*, ' '//loadCases(l)%deformation%myType//' / 1/s:' endif do i = 1, 3; do j = 1, 3 - if(loadCases(l)%deformation%mask(i,j)) then + if (loadCases(l)%deformation%mask(i,j)) then write(IO_STDOUT,'(2x,f12.7)',advance='no') loadCases(l)%deformation%values(i,j) - else - write(IO_STDOUT,'(2x,12a)',advance='no') ' x ' - endif - enddo; write(IO_STDOUT,'(/)',advance='no') - enddo - if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831 ! exclusive or masking only - if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) & - errorID = 838 ! no rotation is allowed by stress BC - print*, ' P / MPa:' - do i = 1, 3; do j = 1, 3 - if(loadCases(l)%stress%mask(i,j)) then - write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal else write(IO_STDOUT,'(2x,12a)',advance='no') ' x ' endif enddo; write(IO_STDOUT,'(/)',advance='no') enddo + if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831 + if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) & + errorID = 838 ! no rotation is allowed by stress BC + + if (loadCases(l)%stress%myType == 'P') print*, ' P / MPa:' + if (loadCases(l)%stress%myType == 'dot_P') print*, ' dot_P / MPa/s:' + + if (loadCases(l)%stress%myType /= '') then + do i = 1, 3; do j = 1, 3 + if (loadCases(l)%stress%mask(i,j)) then + write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal + else + write(IO_STDOUT,'(2x,12a)',advance='no') ' x ' + endif + enddo; write(IO_STDOUT,'(/)',advance='no') + enddo + endif if (any(dNeq(loadCases(l)%rot%asMatrix(), math_I3))) & write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',& transpose(loadCases(l)%rot%asMatrix()) - if (loadCases(l)%t < 0.0_pReal) errorID = 834 - print'(a,f0.3)', ' t: ', loadCases(l)%t - if (loadCases(l)%N < 1) errorID = 835 - print'(a,i0)', ' N: ', loadCases(l)%N - if (loadCases(l)%f_out < 1) errorID = 836 - print'(a,i0)', ' f_out: ', loadCases(l)%f_out - if (loadCases(l)%r <= 0.0) errorID = 833 - print'(a,f0.3)', ' r: ', loadCases(l)%r - + if (loadCases(l)%r <= 0.0) errorID = 833 + if (loadCases(l)%t < 0.0_pReal) errorID = 834 + if (loadCases(l)%N < 1) errorID = 835 + if (loadCases(l)%f_out < 1) errorID = 836 if (loadCases(l)%f_restart < 1) errorID = 839 + + if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then + print'(a)', ' r: 1 (constant step widths)' + else + print'(a,f0.3)', ' r: ', loadCases(l)%r + endif + print'(a,f0.3)', ' t: ', loadCases(l)%t + print'(a,i0)', ' N: ', loadCases(l)%N + print'(a,i0)', ' f_out: ', loadCases(l)%f_out if (loadCases(l)%f_restart < huge(0)) & print'(a,i0)', ' f_restart: ', loadCases(l)%f_restart if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + endif reportAndCheck enddo @@ -309,8 +317,6 @@ program DAMASK_grid writeHeader: if (interface_restartInc < 1) then open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file - if (debug_grid%contains('basic')) print'(/,a)', ' header of statistics file written out' - flush(IO_STDOUT) else writeHeader open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED', position='APPEND', status='OLD') @@ -319,6 +325,7 @@ program DAMASK_grid writeUndeformed: if (interface_restartInc < 1) then print'(/,a)', ' ... writing initial configuration to file ........................' + flush(IO_STDOUT) call CPFEM_results(0,0.0_pReal) endif writeUndeformed diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 4394b6f81..146f28567 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -31,16 +31,16 @@ module grid_mech_FEM type :: tNumerics integer :: & - itmin, & !< minimum number of iterations - itmax !< maximum number of iterations + itmin, & !< minimum number of iterations + itmax !< maximum number of iterations real(pReal) :: & - eps_div_atol, & !< absolute tolerance for equilibrium - eps_div_rtol, & !< relative tolerance for equilibrium - eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC - eps_stress_rtol !< relative tolerance for fullfillment of stress BC + eps_div_atol, & !< absolute tolerance for equilibrium + eps_div_rtol, & !< relative tolerance for equilibrium + eps_stress_atol, & !< absolute tolerance for fullfillment of stress BC + eps_stress_rtol !< relative tolerance for fullfillment of stress BC end type tNumerics - type(tNumerics) :: num ! numerics parameters. Better name? + type(tNumerics) :: num ! numerics parameters. Better name? logical :: debugRotation @@ -64,7 +64,7 @@ module grid_mech_FEM real(pReal), dimension(3,3) :: & F_aimDot = 0.0_pReal, & !< assumed rate of average deformation gradient F_aim = math_I3, & !< current prescribed deformation gradient - F_aim_lastInc = math_I3, & !< previous average deformation gradient + F_aim_lastInc = math_I3, & !< previous average deformation gradient P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress P_aim = 0.0_pReal character(len=:), allocatable :: incInfo !< time and increment information @@ -93,10 +93,8 @@ contains !-------------------------------------------------------------------------------------------------- subroutine grid_mech_FEM_init - real(pReal) :: HGCoeff = 0.0e-2_pReal - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal - real(pReal), dimension(4,8) :: & + real(pReal), parameter :: HGCoeff = 0.0e-2_pReal + real(pReal), parameter, dimension(4,8) :: & HGcomp = reshape([ 1.0_pReal, 1.0_pReal, 1.0_pReal,-1.0_pReal, & 1.0_pReal,-1.0_pReal,-1.0_pReal, 1.0_pReal, & -1.0_pReal, 1.0_pReal,-1.0_pReal, 1.0_pReal, & @@ -121,18 +119,19 @@ subroutine grid_mech_FEM_init !------------------------------------------------------------------------------------------------- ! debugging options - debug_grid => config_debug%get('grid', defaultVal=emptyList) + debug_grid => config_debug%get('grid',defaultVal=emptyList) debugRotation = debug_grid%contains('rotation') !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks num_grid => config_numerics%get('grid',defaultVal=emptyDict) + num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal) num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal) num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal) num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal) - num%itmin = num_grid%get_asInt ('itmin', defaultVal=1) - num%itmax = num_grid%get_asInt ('itmax', defaultVal=250) + num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) + num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') @@ -225,6 +224,7 @@ subroutine grid_mech_FEM_init fileHandle = HDF5_openFile(fileName) groupHandle = HDF5_openGroup(fileHandle,'solver') + call HDF5_read(groupHandle,P_aim, 'P_aim') call HDF5_read(groupHandle,F_aim, 'F_aim') call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_read(groupHandle,F_aimDot, 'F_aimDot') @@ -238,9 +238,9 @@ subroutine grid_mech_FEM_init F = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(F) - call utilities_constitutiveResponse(P_current,temp33_Real,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2 + call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2 F, & ! target F 0.0_pReal) ! time increment call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr) @@ -295,6 +295,7 @@ function grid_mech_FEM_solution(incInfoIn) result(solution) solution%iterationsNeeded = totalIter solution%termIll = terminallyIll terminallyIll = .false. + P_aim = merge(P_aim,P_av,params%stress_mask) end function grid_mech_FEM_solution @@ -302,34 +303,26 @@ end function grid_mech_FEM_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep -!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,& +subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) - logical, intent(in) :: & + logical, intent(in) :: & cutBack, & guess - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & + real(pReal), intent(in) :: & + Delta_t_old, & + Delta_t, & + t_remaining !< remaining time of current load case + type(tBoundaryCondition), intent(in) :: & stress_BC, & deformation_BC - type(rotation), intent(in) :: & + type(rotation), intent(in) :: & rotation_BC PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: & u_current,u_lastInc -!-------------------------------------------------------------------------------------------------- -! set module wide available data - params%stress_mask = stress_BC%mask - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old - call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) @@ -339,7 +332,7 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime, else C_volAvgLastInc = C_volAvg - F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) + F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components F_aim_lastInc = F_aim !----------------------------------------------------------------------------------------------- @@ -347,18 +340,18 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime, if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F F_aimDot = F_aimDot & + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask) - elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed - F_aimDot = F_aimDot & + elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed + F_aimDot = F_aimDot & + merge(deformation_BC%values,.0_pReal,deformation_BC%mask) elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed F_aimDot = F_aimDot & - + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask) + + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask) endif if (guess) then call VecWAXPY(solution_rate,-1.0_pReal,solution_lastInc,solution_current,ierr) CHKERRQ(ierr) - call VecScale(solution_rate,1.0_pReal/timeinc_old,ierr); CHKERRQ(ierr) + call VecScale(solution_rate,1.0_pReal/Delta_t_old,ierr); CHKERRQ(ierr) else call VecSet(solution_rate,0.0_pReal,ierr); CHKERRQ(ierr) endif @@ -371,23 +364,28 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime, !-------------------------------------------------------------------------------------------------- ! update average and local deformation gradients - F_aim = F_aim_lastInc + F_aimDot * timeinc - if (stress_BC%myType=='P') then - P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask) - elseif (stress_BC%myType=='dot_P') then !UNTESTED - P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask) - endif + F_aim = F_aim_lastInc + F_aimDot * Delta_t + if (stress_BC%myType=='P') P_aim = P_aim & + + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t + if (stress_BC%myType=='dot_P') P_aim = P_aim & + + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t - call VecAXPY(solution_current,timeinc,solution_rate,ierr); CHKERRQ(ierr) + call VecAXPY(solution_current,Delta_t,solution_rate,ierr); CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr);CHKERRQ(ierr) - call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr);CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! set module wide available data + params%stress_mask = stress_BC%mask + params%rotation_BC = rotation_BC + params%timeinc = Delta_t end subroutine grid_mech_FEM_forward !-------------------------------------------------------------------------------------------------- -!> @brief Age +!> @brief Update coordinates !-------------------------------------------------------------------------------------------------- subroutine grid_mech_FEM_updateCoords @@ -415,6 +413,7 @@ subroutine grid_mech_FEM_restartWrite fileHandle = HDF5_openFile(fileName,'w') groupHandle = HDF5_addGroup(fileHandle,'solver') + call HDF5_write(groupHandle,P_aim, 'P_aim') call HDF5_write(groupHandle,F_aim, 'F_aim') call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_write(groupHandle,F_aimDot, 'F_aimDot') @@ -441,11 +440,11 @@ end subroutine grid_mech_FEM_restartWrite subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr) SNES :: snes_local - PetscInt, intent(in) :: PETScIter - PetscReal, intent(in) :: & - devNull1, & - devNull2, & - fnorm + PetscInt, intent(in) :: PETScIter + PetscReal, intent(in) :: & + devNull1, & + devNull2, & + fnorm SNESConvergedReason :: reason PetscObject :: dummy PetscErrorCode :: ierr @@ -458,10 +457,10 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,i divTol = max(maxval(abs(P_av))*num%eps_div_rtol ,num%eps_div_atol) BCTol = max(maxval(abs(P_av))*num%eps_stress_rtol,num%eps_stress_atol) - if ((totalIter >= num%itmin .and. & - all([ err_div/divTol, & - err_BC /BCTol ] < 1.0_pReal)) & - .or. terminallyIll) then + if (terminallyIll .or. & + (totalIter >= num%itmin .and. & + all([ err_div/divTol, & + err_BC /BCTol ] < 1.0_pReal))) then reason = 1 elseif (totalIter >= num%itmax) then reason = -1 @@ -666,16 +665,16 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr) C_volAvg(3,3,3,3)/delta(3)**2.0_pReal)*detJ call MatZeroRowsColumns(Jac,size(rows),rows,diag,PETSC_NULL_VEC,PETSC_NULL_VEC,ierr) CHKERRQ(ierr) - call DMGetGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr) - call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) + call DMGetGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr) + call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr) ele = 0 do k = zstart, zend; do j = ystart, yend; do i = xstart, xend ele = ele + 1 x_scal(0:2,i,j,k) = discretization_IPcoords(1:3,ele) enddo; enddo; enddo - call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates) - call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr) ! get rigid body deformation modes - call DMRestoreGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr) + call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr) ! initialize to undeformed coordinates (ToDo: use ip coordinates) + call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr); CHKERRQ(ierr) ! get rigid body deformation modes + call DMRestoreGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr) call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr) diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 563b25162..4f5ceff61 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -94,8 +94,6 @@ contains subroutine grid_mech_spectral_basic_init real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: & F ! pointer to solution data @@ -118,20 +116,20 @@ subroutine grid_mech_spectral_basic_init !------------------------------------------------------------------------------------------------- ! debugging options - debug_grid => config_debug%get('grid', defaultVal=emptyList) + debug_grid => config_debug%get('grid',defaultVal=emptyList) debugRotation = debug_grid%contains('rotation') - + !------------------------------------------------------------------------------------------------- ! read numerical parameters and do sanity checks num_grid => config_numerics%get('grid',defaultVal=emptyDict) - num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.) - num%eps_div_atol = num_grid%get_asFloat ('eps_div_atol', defaultVal=1.0e-4_pReal) - num%eps_div_rtol = num_grid%get_asFloat ('eps_div_rtol', defaultVal=5.0e-4_pReal) - num%eps_stress_atol = num_grid%get_asFloat ('eps_stress_atol',defaultVal=1.0e3_pReal) - num%eps_stress_rtol = num_grid%get_asFloat ('eps_stress_rtol',defaultVal=1.0e-3_pReal) - num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) - num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) + num%update_gamma = num_grid%get_asBool ('update_gamma', defaultVal=.false.) + num%eps_div_atol = num_grid%get_asFloat('eps_div_atol', defaultVal=1.0e-4_pReal) + num%eps_div_rtol = num_grid%get_asFloat('eps_div_rtol', defaultVal=5.0e-4_pReal) + num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal) + num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal) + num%itmin = num_grid%get_asInt ('itmin',defaultVal=1) + num%itmax = num_grid%get_asInt ('itmax',defaultVal=250) if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') @@ -139,7 +137,7 @@ subroutine grid_mech_spectral_basic_init if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') - + !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc call PetscOptionsInsertString(PETSC_NULL_OPTIONS,'-mech_snes_type ngmres',ierr) @@ -149,14 +147,14 @@ subroutine grid_mech_spectral_basic_init !-------------------------------------------------------------------------------------------------- ! allocate global fields - allocate (F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) + allocate(F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal) + allocate(Fdot (3,3,grid(1),grid(2),grid3),source = 0.0_pReal) !-------------------------------------------------------------------------------------------------- ! initialize solver specific parts of PETSc call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr) call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr) - localK = 0 + localK = 0 localK(worldrank) = grid3 call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr) call DMDACreate3d(PETSC_COMM_WORLD, & @@ -189,6 +187,7 @@ subroutine grid_mech_spectral_basic_init fileHandle = HDF5_openFile(fileName) groupHandle = HDF5_openGroup(fileHandle,'solver') + call HDF5_read(groupHandle,P_aim, 'P_aim') call HDF5_read(groupHandle,F_aim, 'F_aim') call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_read(groupHandle,F_aimDot, 'F_aimDot') @@ -200,9 +199,9 @@ subroutine grid_mech_spectral_basic_init F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(reshape(F,shape(F_lastInc))) - call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 + call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 reshape(F,shape(F_lastInc)), & ! target F 0.0_pReal) ! time increment call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! deassociate pointer @@ -262,6 +261,7 @@ function grid_mech_spectral_basic_solution(incInfoIn) result(solution) solution%iterationsNeeded = totalIter solution%termIll = terminallyIll terminallyIll = .false. + P_aim = merge(P_aim,P_av,params%stress_mask) end function grid_mech_spectral_basic_solution @@ -269,32 +269,25 @@ end function grid_mech_spectral_basic_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep -!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,& +subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) - logical, intent(in) :: & + logical, intent(in) :: & cutBack, & guess - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & + real(pReal), intent(in) :: & + Delta_t_old, & + Delta_t, & + t_remaining !< remaining time of current load case + type(tBoundaryCondition), intent(in) :: & stress_BC, & deformation_BC - type(rotation), intent(in) :: & + type(rotation), intent(in) :: & rotation_BC PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: F -!-------------------------------------------------------------------------------------------------- -! set module wide available data - params%stress_mask = stress_BC%mask - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) @@ -305,7 +298,7 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo C_volAvgLastInc = C_volAvg C_minMaxAvgLastInc = C_minMaxAvg - F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) + F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components F_aim_lastInc = F_aim !----------------------------------------------------------------------------------------------- @@ -313,40 +306,45 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F F_aimDot = F_aimDot & + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask) - elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed - F_aimDot = F_aimDot & + elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed + F_aimDot = F_aimDot & + merge(deformation_BC%values,.0_pReal,deformation_BC%mask) elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed F_aimDot = F_aimDot & - + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask) + + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask) endif Fdot = utilities_calculateRate(guess, & - F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & + F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, & rotation_BC%rotate(F_aimDot,active=.true.)) F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3]) - homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3]) + homogenization_F0 = reshape(F,[3,3,1,product(grid(1:2))*grid3]) endif !-------------------------------------------------------------------------------------------------- ! update average and local deformation gradients - F_aim = F_aim_lastInc + F_aimDot * timeinc - if (stress_BC%myType=='P') then - P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask) - elseif (stress_BC%myType=='dot_P') then !UNTESTED - P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask) - endif - - F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average + F_aim = F_aim_lastInc + F_aimDot * Delta_t + if (stress_BC%myType=='P') P_aim = P_aim & + + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t + if (stress_BC%myType=='dot_P') P_aim = P_aim & + + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t + + F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average rotation_BC%rotate(F_aim,active=.true.)),[9,grid(1),grid(2),grid3]) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) +!-------------------------------------------------------------------------------------------------- +! set module wide available data + params%stress_mask = stress_BC%mask + params%rotation_BC = rotation_BC + params%timeinc = Delta_t + end subroutine grid_mech_spectral_basic_forward !-------------------------------------------------------------------------------------------------- -!> @brief Age +!> @brief Update coordinates !-------------------------------------------------------------------------------------------------- subroutine grid_mech_spectral_basic_updateCoords @@ -378,6 +376,7 @@ subroutine grid_mech_spectral_basic_restartWrite fileHandle = HDF5_openFile(fileName,'w') groupHandle = HDF5_addGroup(fileHandle,'solver') + call HDF5_write(groupHandle,P_aim, 'P_aim') call HDF5_write(groupHandle,F_aim, 'F_aim') call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_write(groupHandle,F_aimDot, 'F_aimDot') @@ -463,7 +462,7 @@ subroutine formResidual(in, F, & PetscErrorCode :: ierr call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) + call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1 ! new increment @@ -472,7 +471,7 @@ subroutine formResidual(in, F, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if (debugRotation) & + if(debugRotation) & write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 03780f2e0..d09b7fcb2 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -105,8 +105,6 @@ contains subroutine grid_mech_spectral_polarisation_init real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P - real(pReal), dimension(3,3) :: & - temp33_Real = 0.0_pReal PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: & FandF_tau, & ! overall pointer to solution data @@ -147,16 +145,16 @@ subroutine grid_mech_spectral_polarisation_init num%alpha = num_grid%get_asFloat('alpha', defaultVal=1.0_pReal) num%beta = num_grid%get_asFloat('beta', defaultVal=1.0_pReal) - if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') - if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') - if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol') - if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol') - if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') - if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') - if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') - if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') - if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha') - if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta') + if (num%eps_div_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_div_atol') + if (num%eps_div_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_div_rtol') + if (num%eps_curl_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_curl_atol') + if (num%eps_curl_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_curl_rtol') + if (num%eps_stress_atol <= 0.0_pReal) call IO_error(301,ext_msg='eps_stress_atol') + if (num%eps_stress_rtol < 0.0_pReal) call IO_error(301,ext_msg='eps_stress_rtol') + if (num%itmax <= 1) call IO_error(301,ext_msg='itmax') + if (num%itmin > num%itmax .or. num%itmin < 1) call IO_error(301,ext_msg='itmin') + if (num%alpha <= 0.0_pReal .or. num%alpha > 2.0_pReal) call IO_error(301,ext_msg='alpha') + if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal) call IO_error(301,ext_msg='beta') !-------------------------------------------------------------------------------------------------- ! set default and user defined options for PETSc @@ -211,6 +209,7 @@ subroutine grid_mech_spectral_polarisation_init fileHandle = HDF5_openFile(fileName) groupHandle = HDF5_openGroup(fileHandle,'solver') + call HDF5_read(groupHandle,P_aim, 'P_aim') call HDF5_read(groupHandle,F_aim, 'F_aim') call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_read(groupHandle,F_aimDot, 'F_aimDot') @@ -226,9 +225,9 @@ subroutine grid_mech_spectral_polarisation_init F_tau_lastInc = 2.0_pReal*F_lastInc endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(reshape(F,shape(F_lastInc))) - call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 + call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 reshape(F,shape(F_lastInc)), & ! target F 0.0_pReal) ! time increment call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) ! deassociate pointer @@ -294,6 +293,7 @@ function grid_mech_spectral_polarisation_solution(incInfoIn) result(solution) solution%iterationsNeeded = totalIter solution%termIll = terminallyIll terminallyIll = .false. + P_aim = merge(P_aim,P_av,params%stress_mask) end function grid_mech_spectral_polarisation_solution @@ -301,34 +301,27 @@ end function grid_mech_spectral_polarisation_solution !-------------------------------------------------------------------------------------------------- !> @brief forwarding routine !> @details find new boundary conditions and best F estimate for end of current timestep -!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !-------------------------------------------------------------------------------------------------- -subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,& +subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& deformation_BC,stress_BC,rotation_BC) - logical, intent(in) :: & + logical, intent(in) :: & cutBack, & guess - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & + real(pReal), intent(in) :: & + Delta_t_old, & + Delta_t, & + t_remaining !< remaining time of current load case + type(tBoundaryCondition), intent(in) :: & stress_BC, & deformation_BC - type(rotation), intent(in) :: & + type(rotation), intent(in) :: & rotation_BC PetscErrorCode :: ierr PetscScalar, pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau integer :: i, j, k real(pReal), dimension(3,3) :: F_lambda33 -!-------------------------------------------------------------------------------------------------- -! set module wide available data - params%stress_mask = stress_BC%mask - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) F => FandF_tau(0: 8,:,:,:) @@ -341,7 +334,7 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc C_volAvgLastInc = C_volAvg C_minMaxAvgLastInc = C_minMaxAvg - F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) + F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess) ! estimate deformation rate for prescribed stress components F_aim_lastInc = F_aim !----------------------------------------------------------------------------------------------- @@ -349,19 +342,19 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc if (deformation_BC%myType=='L') then ! calculate F_aimDot from given L and current F F_aimDot = F_aimDot & + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask) - elseif(deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed - F_aimDot = F_aimDot & + elseif (deformation_BC%myType=='dot_F') then ! F_aimDot is prescribed + F_aimDot = F_aimDot & + merge(deformation_BC%values,.0_pReal,deformation_BC%mask) elseif (deformation_BC%myType=='F') then ! aim at end of load case is prescribed F_aimDot = F_aimDot & - + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask) + + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask) endif Fdot = utilities_calculateRate(guess, & - F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & + F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, & rotation_BC%rotate(F_aimDot,active=.true.)) F_tauDot = utilities_calculateRate(guess, & - F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, & + F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), Delta_t_old, & rotation_BC%rotate(F_aimDot,active=.true.)) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3]) @@ -371,38 +364,41 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc !-------------------------------------------------------------------------------------------------- ! update average and local deformation gradients - F_aim = F_aim_lastInc + F_aimDot * timeinc - if (stress_BC%myType=='P') then - P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask) - elseif (stress_BC%myType=='dot_P') then !UNTESTED - P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask) - endif + F_aim = F_aim_lastInc + F_aimDot * Delta_t + if(stress_BC%myType=='P') P_aim = P_aim & + + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t + if(stress_BC%myType=='dot_P') P_aim = P_aim & + + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t - F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average + F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, & ! estimate of F at end of time+Delta_t that matches rotated F_aim on average rotation_BC%rotate(F_aim,active=.true.)),& [9,grid(1),grid(2),grid3]) if (guess) then - F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), & + F_tau = reshape(Utilities_forwardField(Delta_t,F_tau_lastInc,F_taudot), & [9,grid(1),grid(2),grid3]) ! does not have any average value as boundary condition else do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1) F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3]) - F_lambda33 = math_mul3333xx33(S_scale,matmul(F_lambda33, & - math_mul3333xx33(C_scale,& - matmul(transpose(F_lambda33),& - F_lambda33)-math_I3))*0.5_pReal) & - + math_I3 + F_lambda33 = math_I3 & + + math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, & + math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3))) F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k) enddo; enddo; enddo endif call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr) +!-------------------------------------------------------------------------------------------------- +! set module wide available data + params%stress_mask = stress_BC%mask + params%rotation_BC = rotation_BC + params%timeinc = Delta_t + end subroutine grid_mech_spectral_polarisation_forward !-------------------------------------------------------------------------------------------------- -!> @brief Age +!> @brief Update coordinates !-------------------------------------------------------------------------------------------------- subroutine grid_mech_spectral_polarisation_updateCoords @@ -436,6 +432,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite fileHandle = HDF5_openFile(fileName,'w') groupHandle = HDF5_addGroup(fileHandle,'solver') + call HDF5_write(groupHandle,F_aim, 'P_aim') call HDF5_write(groupHandle,F_aim, 'F_aim') call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc') call HDF5_write(groupHandle,F_aimDot, 'F_aimDot') @@ -480,11 +477,11 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm divTol = max(maxval(abs(P_av)) *num%eps_div_rtol ,num%eps_div_atol) BCTol = max(maxval(abs(P_av)) *num%eps_stress_rtol,num%eps_stress_atol) - if ((totalIter >= num%itmin .and. & - all([ err_div /divTol, & - err_curl/curlTol, & - err_BC /BCTol ] < 1.0_pReal)) & - .or. terminallyIll) then + if (terminallyIll .or. & + (totalIter >= num%itmin .and. & + all([ err_div /divTol, & + err_curl/curlTol, & + err_BC /BCTol ] < 1.0_pReal))) then reason = 1 elseif (totalIter >= num%itmax) then reason = -1 @@ -555,7 +552,7 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if(debugRotation) & + if (debugRotation) & write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 1e1608d7c..6d6e26cae 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -93,7 +93,7 @@ module spectral_utilities real(pReal), dimension(3,3) :: stress_BC logical, dimension(3,3) :: stress_mask type(rotation) :: rotation_BC - real(pReal) :: timeinc, timeincOld + real(pReal) :: timeinc end type tSolutionParams type :: tNumerics diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index 8aa084ac8..b6ce1e175 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -32,7 +32,6 @@ module mesh_mech_FEM type tSolutionParams type(tFieldBC) :: fieldBC real(pReal) :: timeinc - real(pReal) :: timeincOld end type tSolutionParams type(tSolutionParams) :: params @@ -302,7 +301,6 @@ type(tSolutionState) function FEM_mech_solution( & !-------------------------------------------------------------------------------------------------- ! set module wide availabe data params%timeinc = timeinc - params%timeincOld = timeinc_old params%fieldBC = fieldBC call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) From b0301239808676eac5bc59e7a41c3b629b5b7737 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 15 Dec 2020 10:16:44 +0100 Subject: [PATCH 015/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-35-g1ebd10745 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5cc60b5dd..b7128c9af 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-26-gaad123f41 +v3.0.0-alpha2-35-g1ebd10745 From 872ceac855fa1e5e50d388f0a0fb8de992b41baf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 11:26:31 +0100 Subject: [PATCH 016/214] not needed --- src/crystallite.f90 | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 66c1df607..3e8b90c38 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -135,7 +135,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine crystallite_init - logical, dimension(discretization_nIPs,discretization_Nelems) :: devNull integer :: & c, & !< counter in integration point component loop i, & !< counter in integration point loop @@ -288,8 +287,6 @@ subroutine crystallite_init enddo !$OMP END PARALLEL DO - devNull = crystallite_stress() - #ifdef DEBUG if (debugCrystallite%basic) then print'(a42,1x,i10)', ' # of elements: ', eMax @@ -321,14 +318,11 @@ function crystallite_stress() subLp0,& !< plastic velocity grad at start of crystallite inc subLi0 !< intermediate velocity grad at start of crystallite inc - todo = .false. subLp0 = crystallite_partitionedLp0 subLi0 = crystallite_partitionedLi0 - - !-------------------------------------------------------------------------------------------------- ! initialize to starting condition crystallite_subStep = 0.0_pReal @@ -435,8 +429,6 @@ function crystallite_stress() ! integrate --- requires fully defined state array (basic + dependent state) where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation - - enddo cutbackLooping ! return whether converged or not @@ -471,10 +463,10 @@ subroutine crystallite_initializeRestorationPoints(i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) plasticState(material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & - plasticState(material_phaseAt(c,e))%state0( :,material_phasememberAt(c,i,e)) + plasticState(material_phaseAt(c,e))%state0( :,material_phasememberAt(c,i,e)) do s = 1, phase_Nsources(material_phaseAt(c,e)) sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) + sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) enddo enddo From d7f035235c5052125ddd384d952a301ed30998a7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 14:01:39 +0100 Subject: [PATCH 017/214] do initialization later --- src/CPFEM.f90 | 1 + src/CPFEM2.f90 | 1 + src/crystallite.f90 | 44 +++++++++++++++++++++++++++----------------- 3 files changed, 29 insertions(+), 17 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index c49ecbcb6..58c17554a 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -93,6 +93,7 @@ subroutine CPFEM_initAll call homogenization_init call CPFEM_init call config_deallocate + call crystallite_setInitialValues ! ToDo: MD More general approach needed end subroutine CPFEM_initAll diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 994859758..5d9d24149 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -67,6 +67,7 @@ subroutine CPFEM_initAll call homogenization_init call CPFEM_init call config_deallocate + call crystallite_setInitialValues ! ToDo: MD More general approach needed end subroutine CPFEM_initAll diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3e8b90c38..0fcade113 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -115,6 +115,7 @@ module crystallite public :: & crystallite_init, & + crystallite_setInitialValues, & crystallite_stress, & crystallite_stressTangent, & crystallite_orientations, & @@ -136,9 +137,7 @@ contains subroutine crystallite_init integer :: & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e, & !< counter in element loop + p, & cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements @@ -237,19 +236,38 @@ subroutine crystallite_init phases => config_material%get('phase') allocate(output_constituent(phases%length)) - do c = 1, phases%length - phase => phases%get(c) + do p = 1, phases%length + phase => phases%get(p) mech => phase%get('mechanics',defaultVal = emptyDict) #if defined(__GFORTRAN__) - output_constituent(c)%label = output_asStrings(mech) + output_constituent(p)%label = output_asStrings(mech) #else - output_constituent(c)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) + output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) #endif enddo +#ifdef DEBUG + if (debugCrystallite%basic) then + print'(a42,1x,i10)', ' # of elements: ', eMax + print'(a42,1x,i10)', ' # of integration points/element: ', iMax + print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax + flush(IO_STDOUT) + endif +#endif + +end subroutine crystallite_init + !-------------------------------------------------------------------------------------------------- -! initialize +!> @brief Set initial values +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_setInitialValues + + integer :: & + c, & !< counter in integration point component loop + i, & !< counter in integration point loop + e !< counter in element loop + !$OMP PARALLEL DO PRIVATE(i,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) @@ -287,16 +305,8 @@ subroutine crystallite_init enddo !$OMP END PARALLEL DO -#ifdef DEBUG - if (debugCrystallite%basic) then - print'(a42,1x,i10)', ' # of elements: ', eMax - print'(a42,1x,i10)', ' # of integration points/element: ', iMax - print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax - flush(IO_STDOUT) - endif -#endif -end subroutine crystallite_init +end subroutine crystallite_setInitialValues !-------------------------------------------------------------------------------------------------- From f8756ad95ae71128c7c9fca0239f9cf9887c72bb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 17:45:11 +0100 Subject: [PATCH 018/214] simplifying no extral handling for homogeneous temperature (the memory that was saved was consumed by the extra mapping) --- src/CPFEM.f90 | 2 +- src/constitutive.f90 | 24 ++++++++++------------- src/constitutive_mech.f90 | 10 ++++++++-- src/damage_local.f90 | 8 +++----- src/damage_none.f90 | 5 +++-- src/damage_nonlocal.f90 | 8 +++----- src/grid/grid_thermal_spectral.f90 | 3 +-- src/kinematics_thermal_expansion.f90 | 4 ++-- src/material.f90 | 29 +++------------------------- src/thermal_adiabatic.f90 | 11 ++++------- src/thermal_conduction.f90 | 5 +---- src/thermal_isothermal.f90 | 7 +++---- 12 files changed, 42 insertions(+), 74 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 58c17554a..eb3243576 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -182,7 +182,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP))) case (THERMAL_conduction_ID) chosenThermal1 - temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = & + temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = & temperature_inp end select chosenThermal1 homogenization_F0(1:3,1:3,ip,elCP) = ffn diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 470ac4dc7..a60352f81 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -19,25 +19,21 @@ module constitutive implicit none private - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & !ToDo: old intel compiler complains about protected - phase_elasticity !< elasticity of each phase - - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & !ToDo: old intel compiler complains about protected + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & phase_plasticity !< plasticity of each phase - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & ! ToDo: old intel compiler complains about protected + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & phase_source, & !< active sources mechanisms of each phase - phase_kinematics, & !< active kinematic mechanisms of each phase - phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + phase_kinematics !< active kinematic mechanisms of each phase - integer, dimension(:), allocatable, public :: & ! ToDo: old intel compiler complains about protected + integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) phase_Nsources, & !< number of source mechanisms active in each phase phase_Nkinematics, & !< number of kinematic mechanisms active in each phase phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase phase_plasticityInstance, & !< instance of particular plasticity of each phase phase_elasticityInstance !< instance of particular elasticity of each phase - logical, dimension(:), allocatable, public :: & ! ToDo: old intel compiler complains about protected + logical, dimension(:), allocatable, public :: & ! ToDo: should be protected (bug in Intel Compiler) phase_localPlasticity !< flags phases with local constitutive law type(tPlasticState), allocatable, dimension(:), public :: & @@ -634,10 +630,10 @@ pure function constitutive_initialFi(ipc, ip, el) KinematicsLoop: do k = 1, phase_Nkinematics(phase) !< Warning: small initial strain assumption kinematicsType: select case (phase_kinematics(k,phase)) case (KINEMATICS_thermal_expansion_ID) kinematicsType - homog = material_homogenizationAt(el) - offset = thermalMapping(homog)%p(ip,el) - constitutive_initialFi = & - constitutive_initialFi + kinematics_thermal_expansion_initialStrain(homog,phase,offset) + homog = material_homogenizationAt(el) + offset = material_homogenizationMemberAt(ip,el) + constitutive_initialFi = constitutive_initialFi & + + kinematics_thermal_expansion_initialStrain(homog,phase,offset) end select kinematicsType enddo KinematicsLoop @@ -674,7 +670,7 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el logical :: broken ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) + tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(phase) Mp = matmul(matmul(transpose(Fi),Fi),S) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index dc3a935e3..d64ea327c 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -3,6 +3,12 @@ !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_mech + integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & + phase_elasticity !< elasticity of each phase + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + + interface module function plastic_none_init() result(myPlasticity) @@ -360,7 +366,7 @@ module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) instance, of ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) + tme = material_homogenizationMemberAt(ip,el) of = material_phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phaseAt(ipc,el)) @@ -407,7 +413,7 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & i, j, instance, of ho = material_homogenizationAt(el) - tme = thermalMapping(ho)%p(ip,el) + tme = material_homogenizationMemberAt(ip,el) Mp = matmul(matmul(transpose(Fi),Fi),S) of = material_phasememberAt(ipc,ip,el) diff --git a/src/damage_local.f90 b/src/damage_local.f90 index e63db90b0..0003bb2a8 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -75,13 +75,11 @@ subroutine damage_local_init Nmaterialpoints = count(material_homogenizationAt == h) damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=damage_initialPhi(h)) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h)) - allocate(damageState(h)%state (1,Nmaterialpoints), source=damage_initialPhi(h)) + allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - nullify(damageMapping(h)%p) damageMapping(h)%p => material_homogenizationMemberAt - deallocate(damage(h)%p) damage(h)%p => damageState(h)%state(1,:) end associate diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 2279bc06b..1cf3de6de 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -3,6 +3,7 @@ !> @brief material subroutine for constant damage field !-------------------------------------------------------------------------------------------------- module damage_none + use prec use config use material @@ -29,8 +30,8 @@ subroutine damage_none_init allocate(damageState(h)%subState0(0,Nmaterialpoints)) allocate(damageState(h)%state (0,Nmaterialpoints)) - deallocate(damage(h)%p) - allocate (damage(h)%p(1), source=damage_initialPhi(h)) + damageMapping(h)%p => material_homogenizationMemberAt + allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal) enddo diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 24a51cf54..ce97ec24a 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -78,13 +78,11 @@ subroutine damage_nonlocal_init Nmaterialpoints = count(material_homogenizationAt == h) damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=damage_initialPhi(h)) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h)) - allocate(damageState(h)%state (1,Nmaterialpoints), source=damage_initialPhi(h)) + allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - nullify(damageMapping(h)%p) damageMapping(h)%p => material_homogenizationMemberAt - deallocate(damage(h)%p) damage(h)%p => damageState(h)%state(1,:) end associate diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index f5d1a33bc..259b45f33 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -131,8 +131,7 @@ subroutine grid_thermal_spectral_init cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - T_current(i,j,k) = temperature(material_homogenizationAt(cell))% & - p(thermalMapping(material_homogenizationAt(cell))%p(1,cell)) + T_current(i,j,k) = temperature(material_homogenizationAt(cell))%p(material_homogenizationMemberAt(1,cell)) T_lastInc(i,j,k) = T_current(i,j,k) T_stagInc(i,j,k) = T_current(i,j,k) enddo; enddo; enddo diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 2b8b04d85..36a882a48 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -126,8 +126,8 @@ module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, i phase = material_phaseAt(ipc,el) homog = material_homogenizationAt(el) - T = temperature(homog)%p(thermalMapping(homog)%p(ip,el)) - TDot = temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el)) + T = temperature(homog)%p(material_homogenizationMemberAt(ip,el)) + TDot = temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el)) associate(prm => param(kinematics_thermal_expansion_instance(phase))) Li = TDot * ( & diff --git a/src/material.f90 b/src/material.f90 index b05979298..33b64e6df 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -64,17 +64,16 @@ module material homogenization_type !< type of each homogenization integer, public, protected :: & - homogenization_maxNconstituents !< max number of grains in any USED homogenization + homogenization_maxNconstituents !< max number of grains in any USED homogenization integer, dimension(:), allocatable, public, protected :: & - homogenization_Nconstituents, & !< number of grains in each homogenization + homogenization_Nconstituents, & !< number of grains in each 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 real(pReal), dimension(:), allocatable, public, protected :: & - thermal_initialT, & !< initial temperature per each homogenization - damage_initialPhi !< initial damage per each homogenization + thermal_initialT !< initial temperature per each homogenization integer, dimension(:), allocatable, public, protected :: & ! (elem) material_homogenizationAt !< homogenization ID of each element @@ -93,12 +92,7 @@ module material type(Rotation), dimension(:,:,:), allocatable, public, protected :: & material_orientation0 !< initial orientation of each grain,IP,element -! BEGIN DEPRECATED - integer, dimension(:,:), allocatable, private, target :: mappingHomogenizationConst !< mapping from material points to offset in constant state/field -! END DEPRECATED - type(tHomogMapping), allocatable, dimension(:), public :: & - thermalMapping, & !< mapping for thermal state/fields damageMapping !< mapping for damage state/fields type(group_float), allocatable, dimension(:), public :: & @@ -165,7 +159,6 @@ subroutine material_init(restart) allocate(thermalState (size(material_name_homogenization))) allocate(damageState (size(material_name_homogenization))) - allocate(thermalMapping (size(material_name_homogenization))) allocate(damageMapping (size(material_name_homogenization))) allocate(temperature (size(material_name_homogenization))) @@ -181,20 +174,6 @@ subroutine material_init(restart) call results_closeJobFile endif -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! BEGIN DEPRECATED - allocate(mappingHomogenizationConst( discretization_nIPs,discretization_Nelems),source=1) - -! hack needed to initialize field values used during constitutive initialization - do myHomog = 1, size(material_name_homogenization) - thermalMapping (myHomog)%p => mappingHomogenizationConst - damageMapping (myHomog)%p => mappingHomogenizationConst - allocate(temperature (myHomog)%p(1), source=thermal_initialT(myHomog)) - allocate(damage (myHomog)%p(1), source=damage_initialPhi(myHomog)) - allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal) - enddo -! END DEPRECATED - end subroutine material_init @@ -222,7 +201,6 @@ subroutine material_parseHomogenization allocate(thermal_typeInstance(size(material_name_homogenization)), source=0) allocate(damage_typeInstance(size(material_name_homogenization)), source=0) allocate(thermal_initialT(size(material_name_homogenization)), source=300.0_pReal) - allocate(damage_initialPhi(size(material_name_homogenization)), source=1.0_pReal) do h=1, size(material_name_homogenization) homog => material_homogenization%get(h) @@ -258,7 +236,6 @@ subroutine material_parseHomogenization if(homog%contains('damage')) then homogDamage => homog%get('damage') - damage_initialPhi(h) = homogDamage%get_asFloat('phi_0',defaultVal=1.0_pReal) select case (homogDamage%get_asString('type')) case('none') damage_type(h) = DAMAGE_none_ID diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index aa807924c..c67d004bf 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -72,12 +72,9 @@ subroutine thermal_adiabatic_init allocate(thermalState(h)%state0 (1,Nmaterialpoints), source=thermal_initialT(h)) allocate(thermalState(h)%subState0(1,Nmaterialpoints), source=thermal_initialT(h)) allocate(thermalState(h)%state (1,Nmaterialpoints), source=thermal_initialT(h)) - - thermalMapping(h)%p => material_homogenizationMemberAt - deallocate(temperature(h)%p) + temperature(h)%p => thermalState(h)%state(1,:) - deallocate(temperatureRate(h)%p) - allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) + allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) end associate enddo @@ -117,8 +114,8 @@ function thermal_adiabatic_updateState(subdt, ip, el) <= 1.0e-6_pReal*abs(thermalState(homog)%state(1,offset)), & .true.] - temperature (homog)%p(thermalMapping(homog)%p(ip,el)) = T - temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el)) = & + temperature (homog)%p(material_homogenizationMemberAt(ip,el)) = T + temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el)) = & (thermalState(homog)%state(1,offset) - thermalState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal)) end function thermal_adiabatic_updateState diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index daa7391a9..602bdab35 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -71,10 +71,7 @@ subroutine thermal_conduction_init allocate(thermalState(h)%subState0(0,Nmaterialpoints)) allocate(thermalState(h)%state (0,Nmaterialpoints)) - thermalMapping(h)%p => material_homogenizationMemberAt - deallocate(temperature (h)%p) allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h)) - deallocate(temperatureRate(h)%p) allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) end associate @@ -205,7 +202,7 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el) offset homog = material_homogenizationAt(el) - offset = thermalMapping(homog)%p(ip,el) + offset = material_homogenizationMemberAt(ip,el) temperature (homog)%p(offset) = T temperatureRate(homog)%p(offset) = Tdot diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 39c8efe91..adf2257de 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -3,6 +3,7 @@ !> @brief material subroutine for isothermal temperature field !-------------------------------------------------------------------------------------------------- module thermal_isothermal + use prec use config use material @@ -29,10 +30,8 @@ subroutine thermal_isothermal_init allocate(thermalState(h)%subState0(0,Nmaterialpoints)) allocate(thermalState(h)%state (0,Nmaterialpoints)) - deallocate(temperature (h)%p) - allocate (temperature (h)%p(1), source=thermal_initialT(h)) - deallocate(temperatureRate(h)%p) - allocate (temperatureRate(h)%p(1)) + allocate(temperature (h)%p(Nmaterialpoints),source=thermal_initialT(h)) + allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) enddo From f8e3cfe91d0334073d7a2a1c193883e5c913a13e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 19:41:47 +0100 Subject: [PATCH 019/214] not needed (was stored as restart data) --- src/CPFEM2.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 5d9d24149..a76f018f7 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -67,7 +67,8 @@ subroutine CPFEM_initAll call homogenization_init call CPFEM_init call config_deallocate - call crystallite_setInitialValues ! ToDo: MD More general approach needed + if (interface_restartInc==0) & + call crystallite_setInitialValues ! ToDo: MD More general approach needed end subroutine CPFEM_initAll From 710c217d8a472e9496e6ffd073965a5088c341df Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 15 Dec 2020 19:55:55 +0100 Subject: [PATCH 020/214] no extra mapping for damage --- src/constitutive_mech.f90 | 2 +- src/damage_local.f90 | 1 - src/damage_none.f90 | 1 - src/damage_nonlocal.f90 | 3 +-- src/kinematics_cleavage_opening.f90 | 2 +- src/kinematics_slipplane_opening.f90 | 2 +- src/material.f90 | 8 +------- src/prec.f90 | 6 +----- src/source_damage_anisoBrittle.f90 | 2 +- src/source_damage_anisoDuctile.f90 | 2 +- src/source_damage_isoDuctile.f90 | 2 +- 11 files changed, 9 insertions(+), 22 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index d64ea327c..6b3c6fce6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -332,7 +332,7 @@ module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(ipc,el)) degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(ipc,el))) case (STIFFNESS_DEGRADATION_damage_ID) degradationType - C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2 + C = C * damage(ho)%p(material_homogenizationMemberAt(ip,el))**2 end select degradationType enddo DegradationLoop diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 0003bb2a8..97eaf9a8c 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -79,7 +79,6 @@ subroutine damage_local_init allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - damageMapping(h)%p => material_homogenizationMemberAt damage(h)%p => damageState(h)%state(1,:) end associate diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 1cf3de6de..3f1144833 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -30,7 +30,6 @@ subroutine damage_none_init allocate(damageState(h)%subState0(0,Nmaterialpoints)) allocate(damageState(h)%state (0,Nmaterialpoints)) - damageMapping(h)%p => material_homogenizationMemberAt allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal) enddo diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index ce97ec24a..c4426f185 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -82,7 +82,6 @@ subroutine damage_nonlocal_init allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - damageMapping(h)%p => material_homogenizationMemberAt damage(h)%p => damageState(h)%state(1,:) end associate @@ -179,7 +178,7 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el) offset homog = material_homogenizationAt(el) - offset = damageMapping(homog)%p(ip,el) + offset = material_homogenizationMemberAt(ip,el) damage(homog)%p(offset) = phi end subroutine damage_nonlocal_putNonLocalDamage diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 66bce6a92..6fe8ed7f6 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -120,7 +120,7 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) + damageOffset = material_homogenizationMemberAt(ip,el) Ld = 0.0_pReal dLd_dTstar = 0.0_pReal diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index aa0bdfbde..b7adb6807 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -141,7 +141,7 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S phase = material_phaseAt(ipc,el) instance = kinematics_slipplane_opening_instance(phase) homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) + damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(instance)) Ld = 0.0_pReal diff --git a/src/material.f90 b/src/material.f90 index 33b64e6df..574da0d51 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -77,7 +77,7 @@ module material integer, dimension(:), allocatable, public, protected :: & ! (elem) material_homogenizationAt !< homogenization ID of each element - integer, dimension(:,:), allocatable, public, target :: & ! (ip,elem) ToDo: ugly target for mapping hack + integer, dimension(:,:), allocatable, public, protected :: & ! (ip,elem) material_homogenizationMemberAt !< position of the element within its homogenization instance integer, dimension(:,:), allocatable, public, protected :: & ! (constituent,elem) material_phaseAt !< phase ID of each element @@ -92,9 +92,6 @@ module material type(Rotation), dimension(:,:,:), allocatable, public, protected :: & material_orientation0 !< initial orientation of each grain,IP,element - type(tHomogMapping), allocatable, dimension(:), public :: & - damageMapping !< mapping for damage state/fields - type(group_float), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field @@ -159,11 +156,8 @@ subroutine material_init(restart) allocate(thermalState (size(material_name_homogenization))) allocate(damageState (size(material_name_homogenization))) - allocate(damageMapping (size(material_name_homogenization))) - allocate(temperature (size(material_name_homogenization))) allocate(damage (size(material_name_homogenization))) - allocate(temperatureRate (size(material_name_homogenization))) diff --git a/src/prec.f90 b/src/prec.f90 index 738775e3b..95b1116cd 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -54,7 +54,7 @@ module prec type, extends(tState) :: tPlasticState logical :: & nonlocal = .false. - real(pReal), pointer, dimension(:,:) :: & + real(pReal), pointer, dimension(:,:) :: & slipRate !< slip rate end type @@ -62,10 +62,6 @@ module prec type(tState), dimension(:), allocatable :: p !< tState for each active source mechanism in a phase end type - type :: tHomogMapping - integer, pointer, dimension(:,:) :: p - end type - real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal) !< minimum positive number such that 1.0 + EPSILON /= 1.0. real(pReal), private, parameter :: PREAL_MIN = tiny(0.0_pReal) !< smallest normalized floating point number diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index ca8d6ec2b..55d5546fc 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -143,7 +143,7 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) constituent = material_phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoBrittle_offset(phase) homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) + damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoBrittle_instance(phase))) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 601ec2531..912fe1387 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -125,7 +125,7 @@ module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) constituent = material_phasememberAt(ipc,ip,el) sourceOffset = source_damage_anisoDuctile_offset(phase) homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) + damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoDuctile_instance(phase))) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 1bff20570..b66e220d9 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -116,7 +116,7 @@ module subroutine source_damage_isoDuctile_dotState(ipc, ip, el) constituent = material_phasememberAt(ipc,ip,el) sourceOffset = source_damage_isoDuctile_offset(phase) homog = material_homogenizationAt(el) - damageOffset = damageMapping(homog)%p(ip,el) + damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_isoDuctile_instance(phase))) sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & From d7889aff12f6aefcd7270fb31756124fff0bbed2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 16 Dec 2020 09:13:13 +0100 Subject: [PATCH 021/214] extra function not (yet) needed --- src/CPFEM.f90 | 3 +-- src/CPFEM2.f90 | 4 +--- src/crystallite.f90 | 23 ++++++----------------- 3 files changed, 8 insertions(+), 22 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index eb3243576..76522fb16 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -89,11 +89,10 @@ subroutine CPFEM_initAll call lattice_init call material_init(.false.) call constitutive_init - call crystallite_init call homogenization_init + call crystallite_init call CPFEM_init call config_deallocate - call crystallite_setInitialValues ! ToDo: MD More general approach needed end subroutine CPFEM_initAll diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index a76f018f7..54e381d34 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -63,12 +63,10 @@ subroutine CPFEM_initAll #endif call material_init(restart=interface_restartInc>0) call constitutive_init - call crystallite_init call homogenization_init + call crystallite_init call CPFEM_init call config_deallocate - if (interface_restartInc==0) & - call crystallite_setInitialValues ! ToDo: MD More general approach needed end subroutine CPFEM_initAll diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0fcade113..31a6bde2d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -69,9 +69,9 @@ module crystallite real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable, public :: & + logical, dimension(:,:,:), allocatable, public :: & crystallite_requested !< used by upper level (homogenization) to request crystallite calculation - logical, dimension(:,:,:), allocatable :: & + logical, dimension(:,:,:), allocatable :: & crystallite_converged !< convergence flag type :: tOutput !< new requested output (per phase) @@ -115,7 +115,6 @@ module crystallite public :: & crystallite_init, & - crystallite_setInitialValues, & crystallite_stress, & crystallite_stressTangent, & crystallite_orientations, & @@ -138,6 +137,9 @@ subroutine crystallite_init integer :: & p, & + c, & !< counter in integration point component loop + i, & !< counter in integration point loop + e, & !< counter in element loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements @@ -255,19 +257,6 @@ subroutine crystallite_init endif #endif -end subroutine crystallite_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief Set initial values -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_setInitialValues - - integer :: & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e !< counter in element loop - !$OMP PARALLEL DO PRIVATE(i,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) @@ -306,7 +295,7 @@ subroutine crystallite_setInitialValues !$OMP END PARALLEL DO -end subroutine crystallite_setInitialValues +end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- From 5d9c931008f56a5c01a4fb8b6d97a0ccee86372e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 16 Dec 2020 11:21:24 +0100 Subject: [PATCH 022/214] code follows structure --- src/commercialFEM_fileList.f90 | 1 + src/homogenization.f90 | 214 ++++++-------------------- src/homogenization_mech.f90 | 199 ++++++++++++++++++++++++ src/homogenization_mech_RGC.f90 | 2 +- src/homogenization_mech_isostrain.f90 | 2 +- src/homogenization_mech_none.f90 | 4 +- 6 files changed, 252 insertions(+), 170 deletions(-) create mode 100644 src/homogenization_mech.f90 diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index d161b36eb..beabfcae1 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -52,6 +52,7 @@ #include "damage_local.f90" #include "damage_nonlocal.f90" #include "homogenization.f90" +#include "homogenization_mech.f90" #include "homogenization_mech_none.f90" #include "homogenization_mech_isostrain.f90" #include "homogenization_mech_RGC.f90" diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 347634212..5958f35fa 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -31,13 +31,15 @@ module homogenization !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point real(pReal), dimension(:,:,:,:), allocatable, public :: & - homogenization_F0, & !< def grad of IP at start of FE increment - homogenization_F !< def grad of IP to be reached at end of FE increment - real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & - homogenization_P !< first P--K stress of IP - real(pReal), dimension(:,:,:,:,:,:), allocatable, public, protected :: & - homogenization_dPdF !< tangent of first P--K stress at IP + homogenization_F0, & !< def grad of IP at start of FE increment + homogenization_F !< def grad of IP to be reached at end of FE increment + real(pReal), dimension(:,:,:,:), allocatable, public :: & !, protected :: & ! Issue with ifort + homogenization_P !< first P--K stress of IP + real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & !, protected :: & + homogenization_dPdF !< tangent of first P--K stress at IP + +!-------------------------------------------------------------------------------------------------- type :: tNumerics integer :: & nMPstate !< materialpoint state loop limit @@ -62,52 +64,37 @@ module homogenization type(tDebugOptions) :: debugHomog + +!-------------------------------------------------------------------------------------------------- interface - module subroutine mech_none_init - end subroutine mech_none_init - - module subroutine mech_isostrain_init - end subroutine mech_isostrain_init - - module subroutine mech_RGC_init(num_homogMech) + module subroutine mech_init(num_homog) class(tNode), pointer, intent(in) :: & - num_homogMech !< pointer to mechanical homogenization numerics data - end subroutine mech_RGC_init + num_homog !< pointer to mechanical homogenization numerics data + end subroutine mech_init + module subroutine mech_partition(subF,ip,el) + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + end subroutine mech_partition - module subroutine mech_isostrain_partitionDeformation(F,avgF) - real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient - real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - end subroutine mech_isostrain_partitionDeformation + module subroutine mech_homogenize(ip,el) + integer, intent(in) :: & + ip, & !< integration point + el !< element number + end subroutine mech_homogenize - module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) - real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient - real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point - integer, intent(in) :: & - instance, & - of - end subroutine mech_RGC_partitionDeformation + module subroutine mech_results(group_base,h) + character(len=*), intent(in) :: group_base + integer, intent(in) :: h - module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_isostrain_averageStressAndItsTangent - - module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) - real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point - real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point - - real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses - real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - integer, intent(in) :: instance - end subroutine mech_RGC_averageStressAndItsTangent + end subroutine mech_results +! -------- ToDo --------------------------------------------------------- module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) logical, dimension(2) :: mech_RGC_updateState real(pReal), dimension(:,:,:), intent(in) :: & @@ -122,13 +109,8 @@ module homogenization el !< element number end function mech_RGC_updateState - - module subroutine mech_RGC_results(instance,group) - integer, intent(in) :: instance !< homogenization instance - character(len=*), intent(in) :: group !< group name in HDF5 file - end subroutine mech_RGC_results - end interface +! ----------------------------------------------------------------------- public :: & homogenization_init, & @@ -145,10 +127,11 @@ subroutine homogenization_init class (tNode) , pointer :: & num_homog, & - num_homogMech, & num_homogGeneric, & debug_homogenization + print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT) + debug_homogenization => config_debug%get('homogenization', defaultVal=emptyList) debugHomog%basic = debug_homogenization%contains('basic') debugHomog%extensive = debug_homogenization%contains('extensive') @@ -163,31 +146,8 @@ subroutine homogenization_init num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) - num_homogMech => num_homog%get('mech',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) - if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init - if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init - if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech) - - if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init - if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init - - if (any(damage_type == DAMAGE_none_ID)) call damage_none_init - if (any(damage_type == DAMAGE_local_ID)) call damage_local_init - if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init - - -!-------------------------------------------------------------------------------------------------- -! allocate and initialize global variables - allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) - homogenization_F0 = spread(spread(math_I3,3,discretization_nIPs),4,discretization_Nelems) ! initialize to identity - homogenization_F = homogenization_F0 ! initialize to identity - allocate(homogenization_P(3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) - - print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT) - num%nMPstate = num_homogGeneric%get_asInt ('nMPstate', defaultVal=10) num%subStepMinHomog = num_homogGeneric%get_asFloat('subStepMin', defaultVal=1.0e-3_pReal) num%subStepSizeHomog = num_homogGeneric%get_asFloat('subStepSize', defaultVal=0.25_pReal) @@ -198,6 +158,18 @@ subroutine homogenization_init if (num%subStepSizeHomog <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeHomog') if (num%stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog') + + call mech_init(num_homog) + + if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init + if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init + if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init + + if (any(damage_type == DAMAGE_none_ID)) call damage_none_init + if (any(damage_type == DAMAGE_local_ID)) call damage_local_init + if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init + + end subroutine homogenization_init @@ -330,7 +302,7 @@ subroutine materialpoint_stressAndItsTangent(dt) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2) if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then ! requested but not yet done - call partitionDeformation(homogenization_F0(1:3,1:3,i,e) & + call mech_partition(homogenization_F0(1:3,1:3,i,e) & + (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e))& *(subStep(i,e)+subFrac(i,e)), & i,e) @@ -379,7 +351,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !$OMP PARALLEL DO elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) IpLooping4: do i = FEsolving_execIP(1),FEsolving_execIP(2) - call averageStressAndItsTangent(i,e) + call mech_homogenize(i,e) enddo IpLooping4 enddo elementLooping4 !$OMP END PARALLEL DO @@ -390,38 +362,6 @@ subroutine materialpoint_stressAndItsTangent(dt) end subroutine materialpoint_stressAndItsTangent -!-------------------------------------------------------------------------------------------------- -!> @brief partition material point def grad onto constituents -!-------------------------------------------------------------------------------------------------- -subroutine partitionDeformation(subF,ip,el) - - real(pReal), intent(in), dimension(3,3) :: & - subF - integer, intent(in) :: & - ip, & !< integration point - el !< element number - - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) - - case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_partitionedF(1:3,1:3,1,ip,el) = subF - - case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF) - - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF,& - ip, & - el) - end select chosenHomogenization - -end subroutine partitionDeformation - - !-------------------------------------------------------------------------------------------------- !> @brief update the internal state of the homogenization scheme and tell whether "done" and !> "happy" with result @@ -478,49 +418,6 @@ function updateState(subdt,subF,ip,el) end function updateState -!-------------------------------------------------------------------------------------------------- -!> @brief derive average stress and stiffness from constituent quantities -!-------------------------------------------------------------------------------------------------- -subroutine averageStressAndItsTangent(ip,el) - - integer, intent(in) :: & - ip, & !< integration point - el !< element number - integer :: c - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - - - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) - case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_stressTangent(1,ip,el) - - case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) - enddo - call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ip,el), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & - homogenization_typeInstance(material_homogenizationAt(el))) - - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) - enddo - call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ip,el), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & - homogenization_typeInstance(material_homogenizationAt(el))) - end select chosenHomogenization - -end subroutine averageStressAndItsTangent - - !-------------------------------------------------------------------------------------------------- !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- @@ -531,27 +428,12 @@ subroutine homogenization_results integer :: p character(len=:), allocatable :: group_base,group - !real(pReal), dimension(:,:,:), allocatable :: temp do p=1,size(material_name_homogenization) group_base = 'current/homogenization/'//trim(material_name_homogenization(p)) call results_closeGroup(results_addGroup(group_base)) - group = trim(group_base)//'/generic' - call results_closeGroup(results_addGroup(group)) - !temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems]) - !call results_writeDataset(group,temp,'F',& - ! 'deformation gradient','1') - !temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems]) - !call results_writeDataset(group,temp,'P',& - ! '1st Piola-Kirchhoff stress','Pa') - - group = trim(group_base)//'/mech' - call results_closeGroup(results_addGroup(group)) - select case(material_homogenization_type(p)) - case(HOMOGENIZATION_rgc_ID) - call mech_RGC_results(homogenization_typeInstance(p),group) - end select + call mech_results(group_base,p) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 new file mode 100644 index 000000000..40d26df51 --- /dev/null +++ b/src/homogenization_mech.f90 @@ -0,0 +1,199 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!> @brief Partition F and homogenize P/dPdF +!-------------------------------------------------------------------------------------------------- +submodule(homogenization) homogenization_mech + + interface + + module subroutine mech_none_init + end subroutine mech_none_init + + module subroutine mech_isostrain_init + end subroutine mech_isostrain_init + + module subroutine mech_RGC_init(num_homogMech) + class(tNode), pointer, intent(in) :: & + num_homogMech !< pointer to mechanical homogenization numerics data + end subroutine mech_RGC_init + + + module subroutine mech_isostrain_partitionDeformation(F,avgF) + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + end subroutine mech_isostrain_partitionDeformation + + module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) + real(pReal), dimension (:,:,:), intent(out) :: F !< partitioned deformation gradient + real(pReal), dimension (3,3), intent(in) :: avgF !< average deformation gradient at material point + integer, intent(in) :: & + instance, & + of + end subroutine mech_RGC_partitionDeformation + + + module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance + end subroutine mech_isostrain_averageStressAndItsTangent + + module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance) + real(pReal), dimension (3,3), intent(out) :: avgP !< average stress at material point + real(pReal), dimension (3,3,3,3), intent(out) :: dAvgPdAvgF !< average stiffness at material point + + real(pReal), dimension (:,:,:), intent(in) :: P !< partitioned stresses + real(pReal), dimension (:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + integer, intent(in) :: instance + end subroutine mech_RGC_averageStressAndItsTangent + + + module subroutine mech_RGC_results(instance,group) + integer, intent(in) :: instance !< homogenization instance + character(len=*), intent(in) :: group !< group name in HDF5 file + end subroutine mech_RGC_results + + end interface + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate variables and set parameters. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_init(num_homog) + + class(tNode), pointer, intent(in) :: & + num_homog + + class(tNode), pointer :: & + num_homogMech + + print'(/,a)', ' <<<+- homogenization_mech init -+>>>' + + allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) + homogenization_F0 = spread(spread(math_I3,3,discretization_nIPs),4,discretization_Nelems) ! initialize to identity + homogenization_F = homogenization_F0 ! initialize to identity + allocate(homogenization_P(3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) + + num_homogMech => num_homog%get('mech',defaultVal=emptyDict) + if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init + if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init + if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) call mech_RGC_init(num_homogMech) + +end subroutine mech_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Partition F onto the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_partition(subF,ip,el) + + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) + + case (HOMOGENIZATION_NONE_ID) chosenHomogenization + crystallite_partitionedF(1:3,1:3,1,ip,el) = subF + + case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + call mech_isostrain_partitionDeformation(& + crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + subF) + + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + call mech_RGC_partitionDeformation(& + crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + subF,& + ip, & + el) + + end select chosenHomogenization + +end subroutine mech_partition + + +!-------------------------------------------------------------------------------------------------- +!> @brief Average P and dPdF from the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_homogenize(ip,el) + + integer, intent(in) :: & + ip, & !< integration point + el !< element number + integer :: c + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + + + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) + + case (HOMOGENIZATION_NONE_ID) chosenHomogenization + homogenization_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_stressTangent(1,ip,el) + + case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization + do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + enddo + call mech_isostrain_averageStressAndItsTangent(& + homogenization_P(1:3,1:3,ip,el), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& + crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + dPdFs, & + homogenization_typeInstance(material_homogenizationAt(el))) + + case (HOMOGENIZATION_RGC_ID) chosenHomogenization + do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + enddo + call mech_RGC_averageStressAndItsTangent(& + homogenization_P(1:3,1:3,ip,el), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& + crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + dPdFs, & + homogenization_typeInstance(material_homogenizationAt(el))) + + end select chosenHomogenization + +end subroutine mech_homogenize + + +!-------------------------------------------------------------------------------------------------- +!> @brief Write results to file. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_results(group_base,h) + use material, only: & + material_homogenization_type => homogenization_type + + character(len=*), intent(in) :: group_base + integer, intent(in) :: h + + character(len=:), allocatable :: group + + group = trim(group_base)//'/mech' + call results_closeGroup(results_addGroup(group)) + + select case(material_homogenization_type(h)) + + case(HOMOGENIZATION_rgc_ID) + call mech_RGC_results(homogenization_typeInstance(h),group) + + end select + + !temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems]) + !call results_writeDataset(group,temp,'F',& + ! 'deformation gradient','1') + !temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems]) + !call results_writeDataset(group,temp,'P',& + ! '1st Piola-Kirchhoff stress','Pa') + +end subroutine mech_results + + +end submodule homogenization_mech diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 585752469..0a9d0ac92 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -6,7 +6,7 @@ !> @brief Relaxed grain cluster (RGC) homogenization scheme !> N_constituents is defined as p x q x r (cluster) !-------------------------------------------------------------------------------------------------- -submodule(homogenization) homogenization_mech_RGC +submodule(homogenization:homogenization_mech) homogenization_mech_RGC use rotations type :: tParameters diff --git a/src/homogenization_mech_isostrain.f90 b/src/homogenization_mech_isostrain.f90 index 751518e09..a56104647 100644 --- a/src/homogenization_mech_isostrain.f90 +++ b/src/homogenization_mech_isostrain.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme !-------------------------------------------------------------------------------------------------- -submodule(homogenization) homogenization_mech_isostrain +submodule(homogenization:homogenization_mech) homogenization_mech_isostrain enum, bind(c); enumerator :: & parallel_ID, & diff --git a/src/homogenization_mech_none.f90 b/src/homogenization_mech_none.f90 index 5b12247cd..d434d1ca0 100644 --- a/src/homogenization_mech_none.f90 +++ b/src/homogenization_mech_none.f90 @@ -4,7 +4,7 @@ !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief dummy homogenization homogenization scheme for 1 constituent per material point !-------------------------------------------------------------------------------------------------- -submodule(homogenization) homogenization_mech_none +submodule(homogenization:homogenization_mech) homogenization_mech_none contains @@ -28,7 +28,7 @@ module subroutine mech_none_init if(homogenization_Nconstituents(h) /= 1) & call IO_error(211,ext_msg='N_constituents (mech_none)') - + Nmaterialpoints = count(material_homogenizationAt == h) homogState(h)%sizeState = 0 allocate(homogState(h)%state0 (0,Nmaterialpoints)) From 3884549e194c5f5e25e71c7d510d659132c7035e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 16 Dec 2020 12:48:45 +0100 Subject: [PATCH 023/214] store field variables as 1D array first step of simplifying layout: 1) Solver translates from ip,el tuple (FEM) or cells(1),cells(2),cells(3) triple to list. 2) DAMASK iterates over all points 3) homogenization knows mapping (point,constituent) -> (instance,member) --- src/CPFEM.f90 | 18 ++++---- src/grid/grid_mech_FEM.f90 | 30 +++++++------- src/grid/grid_mech_spectral_basic.f90 | 4 +- src/grid/grid_mech_spectral_polarisation.f90 | 6 +-- src/grid/spectral_utilities.f90 | 16 ++++---- src/homogenization.f90 | 23 ++++++----- src/homogenization_mech.f90 | 23 ++++++----- src/material.f90 | 1 - src/mesh/FEM_utilities.f90 | 2 +- src/mesh/mesh_mech_FEM.f90 | 43 ++++++++++---------- 10 files changed, 86 insertions(+), 80 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 76522fb16..a19a70432 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -153,7 +153,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS H integer(pInt) elCP, & ! crystal plasticity element number - i, j, k, l, m, n, ph, homog, mySource + i, j, k, l, m, n, ph, homog, mySource,ma real(pReal), parameter :: ODD_STRESS = 1e15_pReal, & !< return value for stress if terminallyIll ODD_JACOBIAN = 1e50_pReal !< return value for jacobian if terminallyIll @@ -161,6 +161,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS elCP = mesh_FEM2DAMASK_elem(elFE) + ma = (elCP-1) * discretization_nIPs + ip + if (debugCPFEM%basic .and. elCP == debugCPFEM%element .and. ip == debugCPFEM%ip) then print'(/,a)', '#############################################' print'(a1,a22,1x,i8,a13)', '#','element', elCP, '#' @@ -184,8 +186,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = & temperature_inp end select chosenThermal1 - homogenization_F0(1:3,1:3,ip,elCP) = ffn - homogenization_F(1:3,1:3,ip,elCP) = ffn1 + homogenization_F0(1:3,1:3,ma) = ffn + homogenization_F(1:3,1:3,ma) = ffn1 if (iand(mode, CPFEM_CALCRESULTS) /= 0_pInt) then @@ -212,17 +214,17 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS else terminalIllness ! translate from P to sigma - Kirchhoff = matmul(homogenization_P(1:3,1:3,ip,elCP), transpose(homogenization_F(1:3,1:3,ip,elCP))) - J_inverse = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ip,elCP)) + Kirchhoff = matmul(homogenization_P(1:3,1:3,ma), transpose(homogenization_F(1:3,1:3,ma))) + J_inverse = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ma)) CPFEM_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.) ! translate from dP/dF to dCS/dE H = 0.0_pReal do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3 H(i,j,k,l) = H(i,j,k,l) & - + homogenization_F(j,m,ip,elCP) * homogenization_F(l,n,ip,elCP) & - * homogenization_dPdF(i,m,k,n,ip,elCP) & - - math_delta(j,l) * homogenization_F(i,m,ip,elCP) * homogenization_P(k,m,ip,elCP) & + + homogenization_F(j,m,ma) * homogenization_F(l,n,ma) & + * homogenization_dPdF(i,m,k,n,ma) & + - math_delta(j,l) * homogenization_F(i,m,ma) * homogenization_P(k,m,ma) & + 0.5_pReal * ( Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) & + Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k)) enddo; enddo; enddo; enddo; enddo; enddo diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 741ce404a..cdf806b35 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -238,7 +238,7 @@ subroutine grid_mech_FEM_init F = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(F) call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, & ! stress field, stress avg, global average of stiffness and (min+max)/2 F, & ! target F @@ -359,7 +359,7 @@ subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,& F_lastInc = F - homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3]) + homogenization_F0 = reshape(F, [3,3,product(grid(1:2))*grid3]) endif !-------------------------------------------------------------------------------------------------- @@ -557,9 +557,9 @@ subroutine formResidual(da_local,x_local, & ii = i-xstart+1; jj = j-ystart+1; kk = k-zstart+1 ele = ele + 1 f_elem = matmul(transpose(BMat),transpose(P_current(1:3,1:3,ii,jj,kk)))*detJ + & - matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,1,ele) + & - homogenization_dPdF(2,2,2,2,1,ele) + & - homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal + matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,ele) + & + homogenization_dPdF(2,2,2,2,ele) + & + homogenization_dPdF(3,3,3,3,ele))/3.0_pReal ctr = 0 do kk = 0, 1; do jj = 0, 1; do ii = 0, 1 ctr = ctr + 1 @@ -636,18 +636,18 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr) row = col ele = ele + 1 K_ele = 0.0 - K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + & - homogenization_dPdF(2,2,2,2,1,ele) + & - homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal - K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + & - homogenization_dPdF(2,2,2,2,1,ele) + & - homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal - K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + & - homogenization_dPdF(2,2,2,2,1,ele) + & - homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal + K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + & + homogenization_dPdF(2,2,2,2,ele) + & + homogenization_dPdF(3,3,3,3,ele))/3.0_pReal + K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + & + homogenization_dPdF(2,2,2,2,ele) + & + homogenization_dPdF(3,3,3,3,ele))/3.0_pReal + K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + & + homogenization_dPdF(2,2,2,2,ele) + & + homogenization_dPdF(3,3,3,3,ele))/3.0_pReal K_ele = K_ele + & matmul(transpose(BMatFull), & - matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,1,ele), & + matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,ele), & shape=[3,3,3,3], order=[2,1,4,3]),shape=[9,9]),BMatFull))*detJ call MatSetValuesStencil(Jac,24,row,24,col,K_ele,ADD_VALUES,ierr) CHKERRQ(ierr) diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index d87a22fb7..ebaaf3b55 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -199,7 +199,7 @@ subroutine grid_mech_spectral_basic_init F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(reshape(F,shape(F_lastInc))) call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 reshape(F,shape(F_lastInc)), & ! target F @@ -319,7 +319,7 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_ rotation_BC%rotate(F_aimDot,active=.true.)) F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3]) - homogenization_F0 = reshape(F,[3,3,1,product(grid(1:2))*grid3]) + homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3]) endif !-------------------------------------------------------------------------------------------------- diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 9bbb40a53..9f2a17c97 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -225,7 +225,7 @@ subroutine grid_mech_spectral_polarisation_init F_tau_lastInc = 2.0_pReal*F_lastInc endif restartRead - homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call utilities_updateCoords(reshape(F,shape(F_lastInc))) call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, & ! stress field, stress avg, global average of stiffness and (min+max)/2 reshape(F,shape(F_lastInc)), & ! target F @@ -359,7 +359,7 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3]) - homogenization_F0 = reshape(F,[3,3,1,product(grid(1:2))*grid3]) + homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3]) endif !-------------------------------------------------------------------------------------------------- @@ -604,7 +604,7 @@ subroutine formResidual(in, FandF_tau, & do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1) e = e + 1 residual_F(1:3,1:3,i,j,k) = & - math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & + math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,e) + C_scale), & residual_F(1:3,1:3,i,j,k) - matmul(F(1:3,1:3,i,j,k), & math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) & + residual_F_tau(1:3,1:3,i,j,k) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 989448dc3..c0c84233d 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -810,7 +810,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& print'(/,a)', ' ... evaluating constitutive response ......................................' flush(IO_STDOUT) - homogenization_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field call materialpoint_stressAndItsTangent(timeinc) ! calculate P field @@ -829,13 +829,13 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& dPdF_min = huge(1.0_pReal) dPdF_norm_min = huge(1.0_pReal) do i = 1, product(grid(1:2))*grid3 - if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then - dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i) - dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal) + if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then + dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i) + dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal) endif - if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then - dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i) - dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal) + if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then + dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,i) + dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal) endif end do @@ -853,7 +853,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& C_minmaxAvg = 0.5_pReal*(dPdF_max + dPdF_min) - C_volAvg = sum(sum(homogenization_dPdF,dim=6),dim=5) + C_volAvg = sum(homogenization_dPdF,dim=5) call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) if (ierr /= 0) error stop 'MPI error' C_volAvg = C_volAvg * wgt diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 5958f35fa..57478e039 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -30,12 +30,12 @@ module homogenization !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point - real(pReal), dimension(:,:,:,:), allocatable, public :: & + real(pReal), dimension(:,:,:), allocatable, public :: & homogenization_F0, & !< def grad of IP at start of FE increment homogenization_F !< def grad of IP to be reached at end of FE increment - real(pReal), dimension(:,:,:,:), allocatable, public :: & !, protected :: & ! Issue with ifort + real(pReal), dimension(:,:,:), allocatable, public :: & !, protected :: & Issue with ifort homogenization_P !< first P--K stress of IP - real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & !, protected :: & + real(pReal), dimension(:,:,:,:,:), allocatable, public :: & !, protected :: & homogenization_dPdF !< tangent of first P--K stress at IP @@ -193,6 +193,7 @@ subroutine materialpoint_stressAndItsTangent(dt) converged logical, dimension(2,discretization_nIPs,discretization_Nelems) :: & doneAndHappy + integer :: m !-------------------------------------------------------------------------------------------------- @@ -227,7 +228,7 @@ subroutine materialpoint_stressAndItsTangent(dt) any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),& FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog)) - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(m) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2) @@ -297,13 +298,14 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - !$OMP PARALLEL DO PRIVATE(myNgrains) + !$OMP PARALLEL DO PRIVATE(myNgrains,m) elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2) if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then ! requested but not yet done - call mech_partition(homogenization_F0(1:3,1:3,i,e) & - + (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e))& + m = (e-1)*discretization_nIPs + i + call mech_partition(homogenization_F0(1:3,1:3,m) & + + (homogenization_F(1:3,1:3,m)-homogenization_F0(1:3,1:3,m))& *(subStep(i,e)+subFrac(i,e)), & i,e) crystallite_dt(1:myNgrains,i,e) = dt*subStep(i,e) ! propagate materialpoint dt to grains @@ -321,16 +323,17 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! state update - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(m) elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2) if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then if (.not. converged(i,e)) then doneAndHappy(1:2,i,e) = [.true.,.false.] else + m = (e-1)*discretization_nIPs + i doneAndHappy(1:2,i,e) = updateState(dt*subStep(i,e), & - homogenization_F0(1:3,1:3,i,e) & - + (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e)) & + homogenization_F0(1:3,1:3,m) & + + (homogenization_F(1:3,1:3,m)-homogenization_F0(1:3,1:3,m)) & *(subStep(i,e)+subFrac(i,e)), & i,e) converged(i,e) = all(doneAndHappy(1:2,i,e)) ! converged if done and happy diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 40d26df51..b0641be07 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -73,10 +73,10 @@ module subroutine mech_init(num_homog) print'(/,a)', ' <<<+- homogenization_mech init -+>>>' - allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) - homogenization_F0 = spread(spread(math_I3,3,discretization_nIPs),4,discretization_Nelems) ! initialize to identity - homogenization_F = homogenization_F0 ! initialize to identity - allocate(homogenization_P(3,3,discretization_nIPs,discretization_Nelems), source=0.0_pReal) + allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) + homogenization_F0 = spread(math_I3,3,discretization_nIPs*discretization_Nelems) ! initialize to identity + homogenization_F = homogenization_F0 ! initialize to identity + allocate(homogenization_P(3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal) num_homogMech => num_homog%get('mech',defaultVal=emptyDict) if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) call mech_none_init @@ -127,23 +127,24 @@ module subroutine mech_homogenize(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c + integer :: c,m real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + m = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ip,el) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,m) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,m) = crystallite_stressTangent(1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ip,el), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& + homogenization_P(1:3,1:3,m), & + homogenization_dPdF(1:3,1:3,1:3,1:3,m),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) @@ -153,8 +154,8 @@ module subroutine mech_homogenize(ip,el) dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,ip,el), & - homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),& + homogenization_P(1:3,1:3,m), & + homogenization_dPdF(1:3,1:3,1:3,1:3,m),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) diff --git a/src/material.f90 b/src/material.f90 index 574da0d51..bb5f484f6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -140,7 +140,6 @@ contains subroutine material_init(restart) logical, intent(in) :: restart - integer :: myHomog print'(/,a)', ' <<<+- material init -+>>>'; flush(IO_STDOUT) diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index 118735e89..cb81f1f0c 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -164,7 +164,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) cutBack = .false. ! reset cutBack status - P_av = sum(sum(homogenization_P,dim=4),dim=3) * wgt ! average of P + P_av = sum(homogenization_P,dim=3) * wgt call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) end subroutine utilities_constitutiveResponse diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index eb5f862c2..e19c35998 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -316,16 +316,16 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) Vec :: x_local, f_local, xx_local PetscSection :: section PetscScalar, dimension(:), pointer :: x_scal, pf_scal - PetscScalar, target :: f_scal(cellDof) - PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) - PetscReal, pointer,dimension(:) :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer + PetscScalar, dimension(cellDof), target :: f_scal + PetscReal :: IcellJMat(dimPlex,dimPlex) + PetscReal, dimension(:),pointer :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer PetscInt :: cellStart, cellEnd, cell, field, face, & qPt, basis, comp, cidx, & - numFields - PetscReal :: detFAvg - PetscReal :: BMat(dimPlex*dimPlex,cellDof) + numFields, & + bcSize,m + PetscReal :: detFAvg, detJ + PetscReal, dimension(dimPlex*dimPlex,cellDof) :: BMat - PetscInt :: bcSize IS :: bcPoints @@ -366,6 +366,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) CHKERRQ(ierr) IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) do qPt = 0, nQuadrature-1 + m = cell*nQuadrature + qPt+1 BMat = 0.0 do basis = 0, nBasis-1 do comp = 0, dimPlex-1 @@ -375,15 +376,14 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) enddo enddo - homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = & - reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1]) + homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1]) enddo if (num%BBarStabilisation) then - detFAvg = math_det33(sum(homogenization_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature)) - do qPt = 1, nQuadrature - homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1) = & - homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1)* & - (detFAvg/math_det33(homogenization_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex)) + detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature)) + do qPt = 0, nQuadrature-1 + m = cell*nQuadrature + qPt+1 + homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) & + * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0/real(dimPlex)) enddo endif @@ -407,6 +407,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) f_scal = 0.0 do qPt = 0, nQuadrature-1 + m = cell*nQuadrature + qPt+1 BMat = 0.0 do basis = 0, nBasis-1 do comp = 0, dimPlex-1 @@ -418,7 +419,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) enddo f_scal = f_scal + & matmul(transpose(BMat), & - reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), & + reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,m)), & shape=[dimPlex*dimPlex]))*qWeights(qPt+1) enddo f_scal = f_scal*abs(detJ) @@ -463,7 +464,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) K_eB PetscInt :: cellStart, cellEnd, cell, field, face, & - qPt, basis, comp, cidx,bcSize + qPt, basis, comp, cidx,bcSize, m IS :: bcPoints @@ -506,6 +507,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) FAvg = 0.0 BMatAvg = 0.0 do qPt = 0, nQuadrature-1 + m = cell*nQuadrature + qPt + 1 BMat = 0.0 do basis = 0, nBasis-1 do comp = 0, dimPlex-1 @@ -516,7 +518,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) enddo enddo - MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), & + MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,m), & shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), & shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1) if (num%BBarStabilisation) then @@ -524,12 +526,11 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) FInv = math_inv33(F) K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex)) K_eB = K_eB - & - matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), & - shape=[dimPlex*dimPlex,1]), & + matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex*dimPlex,1]), & matmul(reshape(FInv(1:dimPlex,1:dimPlex), & shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA) - MatB = MatB + & - matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA) + MatB = MatB & + + matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[1,dimPlex*dimPlex]),MatA) FAvg = FAvg + F BMatAvg = BMatAvg + BMat else From e11be7e6007581f349de3172b5584a4574921a06 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 17 Dec 2020 10:47:56 -0500 Subject: [PATCH 024/214] preinitialize a ConfigMaterial object with 'constituents','homogenization','phase' keys --- python/damask/_configmaterial.py | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index 6de2283f4..17d8c796d 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -9,6 +9,13 @@ from . import Orientation class ConfigMaterial(Config): """Material configuration.""" + def __init__(self): + """Initialize object with all required dictionary keys.""" + super().__init__() + self['material'] = [] + self['homogenization'] = {} + self['phase'] = {} + def save(self,fname='material.yaml',**kwargs): """ Save to yaml file. @@ -274,6 +281,7 @@ class ConfigMaterial(Config): c = [{} for _ in range(length)] if constituents is None else \ [{'constituents':u} for u in ConfigMaterial._constituents(**constituents)] + if len(c) == 1: c = [copy.deepcopy(c[0]) for _ in range(length)] if length != 1 and length != len(c): From 1f021880eb62b8013620e973aaa51886f0490feb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 17 Dec 2020 21:52:12 +0100 Subject: [PATCH 025/214] pytest for temperature now fully working --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index e1a1048e1..24828314c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit e1a1048e1f593683b4b432d41455bd236008c3ad +Subproject commit 24828314c82a8bb2f011b060965cea79660c6f09 From 5b67cadb5173a65275f218c0de78ed9d17ffa2ec Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 17 Dec 2020 21:58:51 +0100 Subject: [PATCH 026/214] test not needed anymore --- .gitlab-ci.yml | 7 ------- PRIVATE | 2 +- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 4e90638c5..c67516ce2 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -269,13 +269,6 @@ Thermal: - master - release -Nonlocal_Damage_DetectChanges: - stage: grid - script: Nonlocal_Damage_DetectChanges/test.py - except: - - master - - release - Plasticity_DetectChanges: stage: grid script: Plasticity_DetectChanges/test.py diff --git a/PRIVATE b/PRIVATE index 24828314c..b6e6d9202 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 24828314c82a8bb2f011b060965cea79660c6f09 +Subproject commit b6e6d9202f27e7e5aee2a38c3529bbf9c7bdaeab From 2b54c074167005594e40c0b9a2cade10a575f569 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 17 Dec 2020 22:02:27 +0100 Subject: [PATCH 027/214] not needed anymore --- .gitlab-ci.yml | 7 ------- PRIVATE | 2 +- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index c67516ce2..ca1b2959a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -262,13 +262,6 @@ Pytest_grid: - master - release -Thermal: - stage: grid - script: Thermal/test.py - except: - - master - - release - Plasticity_DetectChanges: stage: grid script: Plasticity_DetectChanges/test.py diff --git a/PRIVATE b/PRIVATE index b6e6d9202..9a184b4a9 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit b6e6d9202f27e7e5aee2a38c3529bbf9c7bdaeab +Subproject commit 9a184b4a906d0a239febd72e50b06fb9d31fb765 From 403ac693dab87d752961bd8732ea77c8f9213204 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 17 Dec 2020 18:08:55 -0500 Subject: [PATCH 028/214] need to pass init argument to dict superclass --- python/damask/_configmaterial.py | 15 +++++++++------ .../tests/reference/ConfigMaterial/material.yaml | 10 +++++----- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index 17d8c796d..ed72aa27d 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -9,12 +9,15 @@ from . import Orientation class ConfigMaterial(Config): """Material configuration.""" - def __init__(self): - """Initialize object with all required dictionary keys.""" - super().__init__() - self['material'] = [] - self['homogenization'] = {} - self['phase'] = {} + _defaults = {'material': [], + 'homogenization': {}, + 'phase': {}} + + def __init__(self,d={}): + """Initialize object with default dictionary keys.""" + super().__init__(d) + for k,v in self._defaults.items(): + if k not in self: self[k] = v def save(self,fname='material.yaml',**kwargs): """ diff --git a/python/tests/reference/ConfigMaterial/material.yaml b/python/tests/reference/ConfigMaterial/material.yaml index 933e295b3..fbba6a631 100644 --- a/python/tests/reference/ConfigMaterial/material.yaml +++ b/python/tests/reference/ConfigMaterial/material.yaml @@ -1,10 +1,10 @@ homogenization: SX: - N_constituents: 2 - mech: {type: none} + N_constituents: 1 + mechanics: {type: none} Taylor: N_constituents: 2 - mech: {type: isostrain} + mechanics: {type: isostrain} material: - constituents: @@ -34,11 +34,11 @@ material: phase: Aluminum: lattice: cF - mech: + mechanics: output: [F, P, F_e, F_p, L_p] elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} Steel: lattice: cI - mech: + mechanics: output: [F, P, F_e, F_p, L_p] elasticity: {C_11: 233.3e9, C_12: 135.5e9, C_44: 118.0e9, type: hooke} From 5fb0e4908b9b553b33a2e5858eb2fa4afcc2709e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 18 Dec 2020 07:09:05 +0100 Subject: [PATCH 029/214] Examples reflect actual behavior --- python/damask/_configmaterial.py | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index ed72aa27d..b94e9897a 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -85,6 +85,8 @@ class ConfigMaterial(Config): fraction: 1.0 phase: Steel homogenization: SX + homogenization: {} + phase: {} """ constituents_ = {k:table.get(v) for k,v in constituents.items()} @@ -271,6 +273,8 @@ class ConfigMaterial(Config): fraction: 1.0 phase: Aluminum homogenization: SX + homogenization: {} + phase: {} """ length = -1 From 3010d11c8e919ff4fa62cf277270d45e39f62732 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 18 Dec 2020 10:51:46 +0100 Subject: [PATCH 030/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-39-g5fb0e4908 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index b7128c9af..d50c5b204 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-35-g1ebd10745 +v3.0.0-alpha2-39-g5fb0e4908 From afc53e5d9f817772dfc36989de39960dd2df066d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 18 Dec 2020 12:17:26 +0100 Subject: [PATCH 031/214] one more test migrated to pytest --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 9a184b4a9..a6a4eba5b 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 9a184b4a906d0a239febd72e50b06fb9d31fb765 +Subproject commit a6a4eba5bd3dfb2600b6bb5bed70e3e2045705bc From 35f9861818bbb3b3e6fdfd1d6f520c5fddc531c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 18 Dec 2020 15:19:04 +0100 Subject: [PATCH 032/214] Fortran standard is 2018 will not work for older compilers --- CMakeLists.txt | 76 +++------ PRIVATE | 2 +- cmake/Compiler-Intel.cmake | 2 +- python/damask/_config.py | 3 + python/tests/test_Table.py | 2 +- src/DAMASK_interface.f90 | 8 +- src/grid/grid_damage_spectral.f90 | 3 +- src/grid/grid_mech_FEM.f90 | 9 +- src/grid/grid_mech_spectral_basic.f90 | 9 +- src/grid/grid_mech_spectral_polarisation.f90 | 9 +- src/grid/grid_thermal_spectral.f90 | 3 +- src/grid/spectral_utilities.f90 | 23 ++- src/material.f90 | 2 +- src/mesh/mesh_mech_FEM.f90 | 33 +--- src/results.f90 | 169 ++++++++++--------- 15 files changed, 147 insertions(+), 206 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index dd2348fd1..8db6dd0c0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,6 +1,18 @@ -######################################################################################## -# Compiler options for building DAMASK -cmake_minimum_required (VERSION 3.10.0 FATAL_ERROR) +cmake_minimum_required (VERSION 3.10.0) +include (FindPkgConfig REQUIRED) + +# Dummy project to determine compiler names and version +project (Prerequisites LANGUAGES) +set(ENV{PKG_CONFIG_PATH} "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/pkgconfig") +pkg_search_module (PETSC REQUIRED PETSc>3.12.0) +pkg_get_variable (CMAKE_Fortran_COMPILER PETSc fcompiler) +pkg_get_variable (CMAKE_C_COMPILER PETSc ccompiler) + +find_program (CAT_EXECUTABLE NAMES cat) +execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION + RESULT_VARIABLE DAMASK_VERSION_RETURN + OUTPUT_VARIABLE DAMASK_VERSION + OUTPUT_STRIP_TRAILING_WHITESPACE) #--------------------------------------------------------------------------------------- # Find PETSc from system environment @@ -28,19 +40,10 @@ include ${petsc_conf_rules} include ${petsc_conf_variables} INCLUDE_DIRS := \${PETSC_FC_INCLUDES} LIBRARIES := \${PETSC_WITH_EXTERNAL_LIB} -COMPILERF := \${FC} -COMPILERC := \${CC} -LINKERNAME := \${FLINKER} includes: \t@echo \${INCLUDE_DIRS} extlibs: \t@echo \${LIBRARIES} -compilerf: -\t@echo \${COMPILERF} -compilerc: -\t@echo \${COMPILERC} -linker: -\t@echo \${LINKERNAME} ") # CMake will execute each target in the ${petsc_config_makefile} @@ -52,26 +55,10 @@ execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_conf OUTPUT_VARIABLE petsc_includes OUTPUT_STRIP_TRAILING_WHITESPACE) # Find the PETSc external linking directory settings -# required for final linking, must be appended after the executable execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "extlibs" RESULT_VARIABLE PETSC_EXTERNAL_LIB_RETURN OUTPUT_VARIABLE petsc_external_lib OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified fortran compiler -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerf" - RESULT_VARIABLE PETSC_MPIFC_RETURN - OUTPUT_VARIABLE PETSC_MPIFC - OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified C compiler -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerc" - RESULT_VARIABLE PETSC_MPICC_RETURN - OUTPUT_VARIABLE PETSC_MPICC - OUTPUT_STRIP_TRAILING_WHITESPACE) -# PETSc specified linker (Fortran compiler + PETSc linking flags) -execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "linker" - RESULT_VARIABLE PETSC_LINKER_RETURN - OUTPUT_VARIABLE PETSC_LINKER - OUTPUT_STRIP_TRAILING_WHITESPACE) # Remove temporary makefile, no need to keep it anymore. file (REMOVE_RECURSE ${TEMPDIR}) @@ -90,14 +77,6 @@ endforeach (exlib) message ("Found PETSC_DIR:\n${PETSC_DIR}\n" ) message ("Found PETSC_INCLUDES:\n${PETSC_INCLUDES}\n" ) message ("Found PETSC_EXTERNAL_LIB:\n${PETSC_EXTERNAL_LIB}\n") -message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n" ) -message ("Found MPI Fortran Compiler:\n${PETSC_MPIFC}\n" ) -message ("Found MPI C Compiler:\n${PETSC_MPICC}\n" ) - -# set compiler commands to match PETSc (needs to be done before defining the project) -# https://cmake.org/Wiki/CMake_FAQ#How_do_I_use_a_different_compiler.3F -set (CMAKE_Fortran_COMPILER "${PETSC_MPIFC}") -set (CMAKE_C_COMPILER "${PETSC_MPICC}") #--------------------------------------------------------------------------------------- # Now start to care about DAMASK @@ -105,17 +84,18 @@ set (CMAKE_C_COMPILER "${PETSC_MPICC}") # DAMASK solver defines project to build string(TOLOWER ${DAMASK_SOLVER} DAMASK_SOLVER) if (DAMASK_SOLVER STREQUAL "grid") - project (damask-grid Fortran C) + project (damask-grid HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C) add_definitions (-DGrid) - message ("Building Grid Solver\n") elseif (DAMASK_SOLVER STREQUAL "mesh") - project (damask-mesh Fortran C) + project (damask-mesh HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C) add_definitions (-DMesh) - message ("Building Mesh Solver\n") else () message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined") endif () -list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) +add_definitions (-DDAMASKVERSION="${DAMASK_VERSION}") +add_definitions (-DPETSc) + +message ("\nBuilding ${CMAKE_PROJECT_NAME}\n") if (CMAKE_BUILD_TYPE STREQUAL "") set (CMAKE_BUILD_TYPE "RELEASE") @@ -153,17 +133,8 @@ if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only") endif () -# Parse DAMASK version from VERSION file -find_program (CAT_EXECUTABLE NAMES cat) -execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION - RESULT_VARIABLE DAMASK_VERSION_RETURN - OUTPUT_VARIABLE DAMASK_V - OUTPUT_STRIP_TRAILING_WHITESPACE) -add_definitions (-DDAMASKVERSION="${DAMASK_V}") - -# definition of other macros -add_definitions (-DPETSc) +list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") include (Compiler-Intel) elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") @@ -174,9 +145,8 @@ else () message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") endif () - set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}") -set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${PETSC_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}") +set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_Fortran_COMPILER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}") if (CMAKE_BUILD_TYPE STREQUAL "DEBUG") set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}") diff --git a/PRIVATE b/PRIVATE index de65e1df5..e1a1048e1 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit de65e1df5a76362de93667e9820dbf330b56f96d +Subproject commit e1a1048e1f593683b4b432d41455bd236008c3ad diff --git a/cmake/Compiler-Intel.cmake b/cmake/Compiler-Intel.cmake index 719ed885b..5b551069e 100644 --- a/cmake/Compiler-Intel.cmake +++ b/cmake/Compiler-Intel.cmake @@ -20,7 +20,7 @@ endif () # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172) -set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name") +set (STANDARD_CHECK "-stand f18 -standard-semantics -assume nostd_mod_proc_name") set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel") # Link against shared Intel libraries instead of static ones diff --git a/python/damask/_config.py b/python/damask/_config.py index 24245f4bd..76955588f 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -21,6 +21,9 @@ class NiceDumper(yaml.SafeDumper): return self.represent_data(dict(data)) if isinstance(data, dict) and type(data) != dict else \ super().represent_data(data) + def ignore_aliases(self, data): + """No references.""" + return True class Config(dict): """YAML-based configuration.""" diff --git a/python/tests/test_Table.py b/python/tests/test_Table.py index ac5859ecb..8f617aff5 100644 --- a/python/tests/test_Table.py +++ b/python/tests/test_Table.py @@ -22,7 +22,7 @@ class TestTable: @pytest.mark.parametrize('N',[10,40]) def test_len(self,N): - len(Table(np.random.rand(N,3),{'X':3})) == N + assert len(Table(np.random.rand(N,3),{'X':3})) == N def test_get_scalar(self,default): d = default.get('s') diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 41f421eb8..d38020225 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -10,7 +10,7 @@ !> and working directory. !-------------------------------------------------------------------------------------------------- #define PETSC_MAJOR 3 -#define PETSC_MINOR_MIN 10 +#define PETSC_MINOR_MIN 12 #define PETSC_MINOR_MAX 14 module DAMASK_interface @@ -392,7 +392,7 @@ end function makeRelativePath subroutine catchSIGTERM(signal) bind(C) integer(C_INT), value :: signal - interface_SIGTERM = .true. + call interface_setSIGTERM(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE' @@ -417,7 +417,7 @@ end subroutine interface_setSIGTERM subroutine catchSIGUSR1(signal) bind(C) integer(C_INT), value :: signal - interface_SIGUSR1 = .true. + call interface_setSIGUSR1(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE' @@ -442,7 +442,7 @@ end subroutine interface_setSIGUSR1 subroutine catchSIGUSR2(signal) bind(C) integer(C_INT), value :: signal - interface_SIGUSR2 = .true. + call interface_setSIGUSR2(.true.) print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE' diff --git a/src/grid/grid_damage_spectral.f90 b/src/grid/grid_damage_spectral.f90 index 4c014f3c0..79437945b 100644 --- a/src/grid/grid_damage_spectral.f90 +++ b/src/grid/grid_damage_spectral.f90 @@ -203,8 +203,7 @@ function grid_damage_spectral_solution(timeinc) result(solution) call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr) if (solution%converged) & print'(/,a)', ' ... nonlocal damage converged .....................................' - write(IO_STDOUT,'(/,a,f8.6,2x,f8.6,2x,e11.4,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',& - phi_min, phi_max, stagNorm + print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage = ', phi_min, phi_max, stagNorm print'(/,a)', ' ===========================================================================' flush(IO_STDOUT) diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index 146f28567..741ce404a 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -509,11 +509,10 @@ subroutine formResidual(da_local,x_local, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index 4f5ceff61..d87a22fb7 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -471,11 +471,10 @@ subroutine formResidual(in, F, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if(debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index d09b7fcb2..9bbb40a53 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -552,11 +552,10 @@ subroutine formResidual(in, FandF_tau, & newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1 print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) - write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', transpose(F_aim) + if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.)) + print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', & + ' deformation gradient aim =', transpose(F_aim) flush(IO_STDOUT) endif newIteration diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 68a1c5ed1..f5d1a33bc 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -197,8 +197,7 @@ function grid_thermal_spectral_solution(timeinc) result(solution) call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr) if (solution%converged) & print'(/,a)', ' ... thermal conduction converged ..................................' - write(IO_STDOUT,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& - T_min, T_max, stagNorm + print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm print'(/,a)', ' ===========================================================================' flush(IO_STDOUT) diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index 6d6e26cae..989448dc3 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -688,8 +688,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) if(debugGeneral) then print'(/,a)', ' ... updating masked compliance ............................................' - write(IO_STDOUT,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',& - transpose(temp99_Real)*1.0e-9_pReal + print'(/,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', & + ' Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal flush(IO_STDOUT) endif @@ -709,9 +709,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) if (debugGeneral .or. errmatinv) then write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' - write(IO_STDOUT,trim(formatString),advance='no') ' C * S (load) ', & - transpose(matmul(c_reduced,s_reduced)) - write(IO_STDOUT,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced) + print trim(formatString), ' C * S (load) ', transpose(matmul(c_reduced,s_reduced)) + print trim(formatString), ' S (load) ', transpose(s_reduced) if(errmatinv) error stop 'matrix inversion error' endif temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9]) @@ -722,7 +721,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) utilities_maskedCompliance = math_99to3333(temp99_Real) if(debugGeneral) then - write(IO_STDOUT,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') & + print'(/,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', & ' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal flush(IO_STDOUT) endif @@ -818,13 +817,11 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - if (debugRotation) & - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& - transpose(P_av)*1.e-6_pReal - if(present(rotation_BC)) & - P_av = rotation_BC%rotate(P_av) - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - transpose(P_av)*1.e-6_pReal + if (debugRotation) print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal + if(present(rotation_BC)) P_av = rotation_BC%rotate(P_av) + print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress / MPa =', transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) dPdF_max = 0.0_pReal diff --git a/src/material.f90 b/src/material.f90 index 223ea6ed8..b05979298 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -176,7 +176,7 @@ subroutine material_init(restart) if (.not. restart) then call results_openJobFile - call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,material_name_phase) + call results_mapping_phase(material_phaseAt,material_phaseMemberAt,material_name_phase) call results_mapping_homogenization(material_homogenizationAt,material_homogenizationMemberAt,material_name_homogenization) call results_closeJobFile endif diff --git a/src/mesh/mesh_mech_FEM.f90 b/src/mesh/mesh_mech_FEM.f90 index b6ce1e175..eb5f862c2 100644 --- a/src/mesh/mesh_mech_FEM.f90 +++ b/src/mesh/mesh_mech_FEM.f90 @@ -146,14 +146,9 @@ subroutine FEM_mech_init(fieldBC) call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr) call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr) nBasis = nBasis/nc -#if (PETSC_VERSION_MINOR > 10) call DMAddField(mech_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr) call DMCreateDS(mech_mesh,ierr); CHKERRQ(ierr) -#endif call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) -#if (PETSC_VERSION_MINOR < 11) - call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr) -#endif call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr) call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr) call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr) @@ -162,11 +157,7 @@ subroutine FEM_mech_init(fieldBC) ! Setup FEM mech boundary conditions call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(mech_mesh,section,ierr); CHKERRQ(ierr) -#endif allocate(pnumComp(1), source=dimPlex) allocate(pnumDof(0:dimPlex), source = 0) do topologDim = 0, dimPlex @@ -204,14 +195,8 @@ subroutine FEM_mech_init(fieldBC) endif endif enddo; enddo -#if (PETSC_VERSION_MINOR < 11) - call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & - numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr) -#else call DMPlexCreateSection(mech_mesh,nolabel,pNumComp,pNumDof, & numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr) - -#endif CHKERRQ(ierr) call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr) do faceSet = 1, numBC @@ -266,11 +251,7 @@ subroutine FEM_mech_init(fieldBC) x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal) enddo px_scal => x_scal -#if (PETSC_VERSION_MINOR < 11) - call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr) -#else - call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) ! PETSc: cbee0a90b60958e5c50c89b1e41f4451dfa6008c -#endif + call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr) CHKERRQ(ierr) enddo @@ -353,11 +334,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) allocate(pinvcellJ(dimPlex**2)) allocate(x_scal(cellDof)) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr) -#endif call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) CHKERRQ(ierr) @@ -500,11 +477,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) -#if (PETSC_VERSION_MINOR < 12) - call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) -#else call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr) -#endif call DMGetGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr) call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) @@ -684,8 +657,8 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), & ' @ Iteration ',PETScIter,' mechanical residual norm = ', & int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol) - write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - transpose(P_av)*1.e-6_pReal + print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', & + ' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal flush(IO_STDOUT) end subroutine FEM_mech_converged diff --git a/src/results.f90 b/src/results.f90 index f15ad4e4a..ea9fd62d4 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -49,7 +49,7 @@ module results results_setLink, & results_addAttribute, & results_removeLink, & - results_mapping_constituent, & + results_mapping_phase, & results_mapping_homogenization contains @@ -461,7 +461,7 @@ end subroutine results_writeTensorDataset_int !-------------------------------------------------------------------------------------------------- !> @brief adds the unique mapping from spatial position and constituent ID to results !-------------------------------------------------------------------------------------------------- -subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) +subroutine results_mapping_phase(phaseAt,memberAtLocal,label) integer, dimension(:,:), intent(in) :: phaseAt !< phase section at (constituent,element) integer, dimension(:,:,:), intent(in) :: memberAtLocal !< phase member at (constituent,IP,element) @@ -491,6 +491,47 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int integer :: hdferr, ierr, i +!-------------------------------------------------------------------------------------------------- +! prepare MPI communication (transparent for non-MPI runs) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + memberOffset = 0 + do i=1, size(label) + memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process + 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, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process + if(ierr /= 0) error stop 'MPI error' + + call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process + if(ierr /= 0) error stop 'MPI error' +#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) + + +!--------------------------------------------------------------------------------------------------- +! 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 + !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) @@ -525,34 +566,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) call h5tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!-------------------------------------------------------------------------------------------------- -! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - memberOffset = 0 - do i=1, size(label) - memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2) ! number of points/instance of this process - 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, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - - call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if(ierr /= 0) error stop 'MPI error' - - call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if(ierr /= 0) error stop 'MPI error' -#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,hdferr,myShape) @@ -564,18 +577,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!--------------------------------------------------------------------------------------------------- -! expand phaseAt to consider IPs (is not stored per IP) - 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., hdferr) @@ -609,7 +610,7 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label) if(hdferr < 0) error stop 'HDF5 error' call h5tclose_f(position_id, hdferr) -end subroutine results_mapping_constituent +end subroutine results_mapping_phase !-------------------------------------------------------------------------------------------------- @@ -645,6 +646,48 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) integer(SIZE_T) :: type_size_string, type_size_int integer :: hdferr, ierr, i + +!-------------------------------------------------------------------------------------------------- +! prepare MPI communication (transparent for non-MPI runs) + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + memberOffset = 0 + do i=1, size(label) + memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process + 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, hdferr) + if(hdferr < 0) error stop 'HDF5 error' + + call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process + if(ierr /= 0) error stop 'MPI error' + + call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process + if(ierr /= 0) error stop 'MPI error' +#endif + + myShape = int([writeSize(worldrank)], HSIZE_T) + myOffset = int([sum(writeSize(0:worldrank-1))], HSIZE_T) + totalShape = int([sum(writeSize)], HSIZE_T) + + +!--------------------------------------------------------------------------------------------------- +! 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 + !--------------------------------------------------------------------------------------------------- ! compound type: name of phase section + position/index within results array call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr) @@ -679,34 +722,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) call h5tclose_f(dt_id, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!-------------------------------------------------------------------------------------------------- -! prepare MPI communication (transparent for non-MPI runs) - call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - memberOffset = 0 - do i=1, size(label) - memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1) ! number of points/instance of this process - 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, hdferr) - if(hdferr < 0) error stop 'HDF5 error' - - call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get output at each process - if(ierr /= 0) error stop 'MPI error' - - call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process - if(ierr /= 0) error stop 'MPI error' -#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,hdferr,myShape) @@ -718,18 +733,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label) call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr) if(hdferr < 0) error stop 'HDF5 error' -!--------------------------------------------------------------------------------------------------- -! expand phaseAt to consider IPs (is not stored per IP) - 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., hdferr) From 35b833e2adddf19b96c616a54ae217e49b16f2cb Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 18 Dec 2020 20:08:35 +0100 Subject: [PATCH 033/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-42-g6cc78cb41 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index d50c5b204..85027fcd3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-39-g5fb0e4908 +v3.0.0-alpha2-42-g6cc78cb41 From 877a489ea573d747f2126ba244ed5b49763b0c22 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 18 Dec 2020 17:41:00 +0100 Subject: [PATCH 034/214] improved tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index a6a4eba5b..313dd5de6 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit a6a4eba5bd3dfb2600b6bb5bed70e3e2045705bc +Subproject commit 313dd5de618c996cdf9ace95a096f25e757386d9 From 8dbc3d2d473816b0f7f7d1d293ecfc21fa5e7b08 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Dec 2020 17:25:57 +0100 Subject: [PATCH 035/214] no special (untested) cases any more --- PRIVATE | 2 +- src/commercialFEM_fileList.f90 | 2 - src/crystallite.f90 | 1 - src/damage_local.f90 | 172 ------------------------- src/homogenization.f90 | 36 ------ src/material.f90 | 10 -- src/thermal_adiabatic.f90 | 226 --------------------------------- src/thermal_conduction.f90 | 4 - src/thermal_isothermal.f90 | 4 - 9 files changed, 1 insertion(+), 456 deletions(-) delete mode 100644 src/damage_local.f90 delete mode 100644 src/thermal_adiabatic.f90 diff --git a/PRIVATE b/PRIVATE index 313dd5de6..45ef93dbf 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 313dd5de618c996cdf9ace95a096f25e757386d9 +Subproject commit 45ef93dbfa3e0e6fa830914b3632e188c308a099 diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index beabfcae1..a5bbe69ca 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -46,10 +46,8 @@ #include "kinematics_slipplane_opening.f90" #include "crystallite.f90" #include "thermal_isothermal.f90" -#include "thermal_adiabatic.f90" #include "thermal_conduction.f90" #include "damage_none.f90" -#include "damage_local.f90" #include "damage_nonlocal.f90" #include "homogenization.f90" #include "homogenization_mech.f90" diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 31a6bde2d..e594ef5a1 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1629,7 +1629,6 @@ subroutine crystallite_forward enddo; enddo do i = 1,size(material_name_homogenization) homogState (i)%state0 = homogState (i)%state - thermalState(i)%state0 = thermalState(i)%state damageState (i)%state0 = damageState (i)%state enddo diff --git a/src/damage_local.f90 b/src/damage_local.f90 deleted file mode 100644 index 97eaf9a8c..000000000 --- a/src/damage_local.f90 +++ /dev/null @@ -1,172 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for locally evolving damage field -!-------------------------------------------------------------------------------------------------- -module damage_local - use prec - use IO - use material - use config - use YAML_types - use constitutive - use results - - implicit none - private - - type :: tParameters - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type, private :: tNumerics - real(pReal) :: & - residualStiffness !< non-zero residual damage - end type tNumerics - - type(tparameters), dimension(:), allocatable :: & - param - - type(tNumerics), private :: num - - public :: & - damage_local_init, & - damage_local_updateState, & - damage_local_results - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine damage_local_init - - integer :: Ninstances,Nmaterialpoints,h - class(tNode), pointer :: & - num_generic, & - material_homogenization, & - homog, & - homogDamage - - print'(/,a)', ' <<<+- damage_local init -+>>>'; flush(IO_STDOUT) - -!---------------------------------------------------------------------------------------------- -! read numerics parameter and do sanity check - num_generic => config_numerics%get('generic',defaultVal=emptyDict) - num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal) - if (num%residualStiffness < 0.0_pReal) call IO_error(301,ext_msg='residualStiffness') - - Ninstances = count(damage_type == DAMAGE_local_ID) - allocate(param(Ninstances)) - - material_homogenization => config_material%get('homogenization') - do h = 1, material_homogenization%length - if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle - homog => material_homogenization%get(h) - homogDamage => homog%get('damage') - associate(prm => param(damage_typeInstance(h))) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(homogDamage) -#else - prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) - - damage(h)%p => damageState(h)%state(1,:) - - end associate - enddo - -end subroutine damage_local_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates local change in damage field -!-------------------------------------------------------------------------------------------------- -function damage_local_updateState(subdt, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - subdt - logical, dimension(2) :: & - damage_local_updateState - integer :: & - homog, & - offset - real(pReal) :: & - phi, phiDot, dPhiDot_dPhi - - homog = material_homogenizationAt(el) - offset = material_homogenizationMemberAt(ip,el) - phi = damageState(homog)%subState0(1,offset) - call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - phi = max(num%residualStiffness,min(1.0_pReal,phi + subdt*phiDot)) - - damage_local_updateState = [ abs(phi - damageState(homog)%state(1,offset)) & - <= 1.0e-2_pReal & - .or. abs(phi - damageState(homog)%state(1,offset)) & - <= 1.0e-6_pReal*abs(damageState(homog)%state(1,offset)), & - .true.] - - damageState(homog)%state(1,offset) = phi - -end function damage_local_updateState - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates homogenized local damage driving forces -!-------------------------------------------------------------------------------------------------- -subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - phi - real(pReal) :: & - phiDot, dPhiDot_dPhi - - phiDot = 0.0_pReal - dPhiDot_dPhi = 0.0_pReal - - call constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el) - - phiDot = phiDot/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end subroutine damage_local_getSourceAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine damage_local_results(homog,group) - - integer, intent(in) :: homog - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(damage_typeInstance(homog))) - outputsLoop: do o = 1,size(prm%output) - select case(prm%output(o)) - case ('phi') - call results_writeDataset(group,damage(homog)%p,prm%output(o),& - 'damage indicator','-') - end select - enddo outputsLoop - end associate - -end subroutine damage_local_results - - -end module damage_local diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 57478e039..30d9cfb90 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -15,10 +15,8 @@ module homogenization use FEsolving use discretization use thermal_isothermal - use thermal_adiabatic use thermal_conduction use damage_none - use damage_local use damage_nonlocal use results @@ -162,11 +160,9 @@ subroutine homogenization_init call mech_init(num_homog) if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_adiabatic_ID)) call thermal_adiabatic_init if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init if (any(damage_type == DAMAGE_none_ID)) call damage_none_init - if (any(damage_type == DAMAGE_local_ID)) call damage_local_init if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init @@ -212,10 +208,6 @@ subroutine materialpoint_stressAndItsTangent(dt) homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & homogState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e)) - if (thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - thermalState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e)) - if (damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & damageState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e)) @@ -245,9 +237,6 @@ subroutine materialpoint_stressAndItsTangent(dt) if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & homogState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e)) - if(thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - thermalState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e)) if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & damageState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e)) @@ -270,9 +259,6 @@ subroutine materialpoint_stressAndItsTangent(dt) if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) - if(thermalState(material_homogenizationAt(e))%sizeState > 0) & - thermalState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & - thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) if(damageState(material_homogenizationAt(e))%sizeState > 0) & damageState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) @@ -400,24 +386,6 @@ function updateState(subdt,subF,ip,el) el) end select chosenHomogenization - chosenThermal: select case (thermal_type(material_homogenizationAt(el))) - case (THERMAL_adiabatic_ID) chosenThermal - updateState = & - updateState .and. & - thermal_adiabatic_updateState(subdt, & - ip, & - el) - end select chosenThermal - - chosenDamage: select case (damage_type(material_homogenizationAt(el))) - case (DAMAGE_local_ID) chosenDamage - updateState = & - updateState .and. & - damage_local_updateState(subdt, & - ip, & - el) - end select chosenDamage - end function updateState @@ -441,8 +409,6 @@ subroutine homogenization_results group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) select case(damage_type(p)) - case(DAMAGE_LOCAL_ID) - call damage_local_results(p,group) case(DAMAGE_NONLOCAL_ID) call damage_nonlocal_results(p,group) end select @@ -450,8 +416,6 @@ subroutine homogenization_results group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) select case(thermal_type(p)) - case(THERMAL_ADIABATIC_ID) - call thermal_adiabatic_results(p,group) case(THERMAL_CONDUCTION_ID) call thermal_conduction_results(p,group) end select diff --git a/src/material.f90 b/src/material.f90 index bb5f484f6..1f2437ad3 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -41,10 +41,8 @@ module material STIFFNESS_DEGRADATION_UNDEFINED_ID, & STIFFNESS_DEGRADATION_DAMAGE_ID, & THERMAL_ISOTHERMAL_ID, & - THERMAL_ADIABATIC_ID, & THERMAL_CONDUCTION_ID, & DAMAGE_NONE_ID, & - DAMAGE_LOCAL_ID, & DAMAGE_NONLOCAL_ID, & HOMOGENIZATION_UNDEFINED_ID, & HOMOGENIZATION_NONE_ID, & @@ -86,7 +84,6 @@ module material type(tState), allocatable, dimension(:), public :: & homogState, & - thermalState, & damageState type(Rotation), dimension(:,:,:), allocatable, public, protected :: & @@ -123,10 +120,8 @@ module material STIFFNESS_DEGRADATION_UNDEFINED_ID, & STIFFNESS_DEGRADATION_DAMAGE_ID, & THERMAL_ISOTHERMAL_ID, & - THERMAL_ADIABATIC_ID, & THERMAL_CONDUCTION_ID, & DAMAGE_NONE_ID, & - DAMAGE_LOCAL_ID, & DAMAGE_NONLOCAL_ID, & HOMOGENIZATION_NONE_ID, & HOMOGENIZATION_ISOSTRAIN_ID, & @@ -152,7 +147,6 @@ subroutine material_init(restart) allocate(homogState (size(material_name_homogenization))) - allocate(thermalState (size(material_name_homogenization))) allocate(damageState (size(material_name_homogenization))) allocate(temperature (size(material_name_homogenization))) @@ -218,8 +212,6 @@ subroutine material_parseHomogenization select case (homogThermal%get_asString('type')) case('isothermal') thermal_type(h) = THERMAL_isothermal_ID - case('adiabatic') - thermal_type(h) = THERMAL_adiabatic_ID case('conduction') thermal_type(h) = THERMAL_conduction_ID case default @@ -232,8 +224,6 @@ subroutine material_parseHomogenization select case (homogDamage%get_asString('type')) case('none') damage_type(h) = DAMAGE_none_ID - case('local') - damage_type(h) = DAMAGE_local_ID case('nonlocal') damage_type(h) = DAMAGE_nonlocal_ID case default diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 deleted file mode 100644 index c67d004bf..000000000 --- a/src/thermal_adiabatic.f90 +++ /dev/null @@ -1,226 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for adiabatic temperature evolution -!-------------------------------------------------------------------------------------------------- -module thermal_adiabatic - use prec - use config - use material - use results - use constitutive - use YAML_types - use crystallite - use lattice - - implicit none - private - - type :: tParameters - character(len=pStringLen), allocatable, dimension(:) :: & - output - end type tParameters - - type(tparameters), dimension(:), allocatable :: & - param - - public :: & - thermal_adiabatic_init, & - thermal_adiabatic_updateState, & - thermal_adiabatic_getSourceAndItsTangent, & - thermal_adiabatic_getSpecificHeat, & - thermal_adiabatic_getMassDensity, & - thermal_adiabatic_results - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_init - - integer :: maxNinstances,h,Nmaterialpoints - class(tNode), pointer :: & - material_homogenization, & - homog, & - homogThermal - - print'(/,a)', ' <<<+- thermal_adiabatic init -+>>>'; flush(6) - - maxNinstances = count(thermal_type == THERMAL_adiabatic_ID) - if (maxNinstances == 0) return - - allocate(param(maxNinstances)) - - material_homogenization => config_material%get('homogenization') - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_adiabatic_ID) cycle - homog => material_homogenization%get(h) - homogThermal => homog%get('thermal') - - associate(prm => param(thermal_typeInstance(h))) - -#if defined (__GFORTRAN__) - prm%output = output_asStrings(homogThermal) -#else - prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) -#endif - - Nmaterialpoints=count(material_homogenizationAt==h) - thermalState(h)%sizeState = 1 - allocate(thermalState(h)%state0 (1,Nmaterialpoints), source=thermal_initialT(h)) - allocate(thermalState(h)%subState0(1,Nmaterialpoints), source=thermal_initialT(h)) - allocate(thermalState(h)%state (1,Nmaterialpoints), source=thermal_initialT(h)) - - temperature(h)%p => thermalState(h)%state(1,:) - allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) - - end associate - enddo - -end subroutine thermal_adiabatic_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates adiabatic change in temperature based on local heat generation model -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_updateState(subdt, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - subdt - - logical, dimension(2) :: & - thermal_adiabatic_updateState - integer :: & - homog, & - offset - real(pReal) :: & - T, Tdot, dTdot_dT - - homog = material_homogenizationAt(el) - offset = material_homogenizationMemberAt(ip,el) - - T = thermalState(homog)%subState0(1,offset) - call thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - T = T + subdt*Tdot/(thermal_adiabatic_getSpecificHeat(ip,el)*thermal_adiabatic_getMassDensity(ip,el)) - - thermal_adiabatic_updateState = [ abs(T - thermalState(homog)%state(1,offset)) & - <= 1.0e-2_pReal & - .or. abs(T - thermalState(homog)%state(1,offset)) & - <= 1.0e-6_pReal*abs(thermalState(homog)%state(1,offset)), & - .true.] - - temperature (homog)%p(material_homogenizationMemberAt(ip,el)) = T - temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el)) = & - (thermalState(homog)%state(1,offset) - thermalState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal)) - -end function thermal_adiabatic_updateState - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns heat generation rate -!-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal), intent(in) :: & - T - real(pReal), intent(out) :: & - Tdot, dTdot_dT - integer :: & - homog - - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - - homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S, crystallite_Lp, ip, el) - - Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) - dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) - -end subroutine thermal_adiabatic_getSourceAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized specific heat capacity -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_getSpecificHeat(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - - real(pReal) :: & - thermal_adiabatic_getSpecificHeat - integer :: & - grain - - thermal_adiabatic_getSpecificHeat = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat & - + lattice_c_p(material_phaseAt(grain,el)) - enddo - - thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat & - / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function thermal_adiabatic_getSpecificHeat - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns homogenized mass density -!-------------------------------------------------------------------------------------------------- -function thermal_adiabatic_getMassDensity(ip,el) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - real(pReal) :: & - thermal_adiabatic_getMassDensity - integer :: & - grain - - thermal_adiabatic_getMassDensity = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity & - + lattice_rho(material_phaseAt(grain,el)) - enddo - - thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity & - / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal) - -end function thermal_adiabatic_getMassDensity - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine thermal_adiabatic_results(homog,group) - - integer, intent(in) :: homog - character(len=*), intent(in) :: group - - integer :: o - - associate(prm => param(damage_typeInstance(homog))) - outputsLoop: do o = 1,size(prm%output) - select case(trim(prm%output(o))) - case('T') - call results_writeDataset(group,temperature(homog)%p,'T',& - 'temperature','K') - end select - enddo outputsLoop - end associate - -end subroutine thermal_adiabatic_results - -end module thermal_adiabatic diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 602bdab35..37a407101 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -66,10 +66,6 @@ subroutine thermal_conduction_init #endif Nmaterialpoints=count(material_homogenizationAt==h) - thermalState(h)%sizeState = 0 - allocate(thermalState(h)%state0 (0,Nmaterialpoints)) - allocate(thermalState(h)%subState0(0,Nmaterialpoints)) - allocate(thermalState(h)%state (0,Nmaterialpoints)) allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h)) allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index adf2257de..2a41ada49 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -25,10 +25,6 @@ subroutine thermal_isothermal_init if (thermal_type(h) /= THERMAL_isothermal_ID) cycle Nmaterialpoints = count(material_homogenizationAt == h) - thermalState(h)%sizeState = 0 - allocate(thermalState(h)%state0 (0,Nmaterialpoints)) - allocate(thermalState(h)%subState0(0,Nmaterialpoints)) - allocate(thermalState(h)%state (0,Nmaterialpoints)) allocate(temperature (h)%p(Nmaterialpoints),source=thermal_initialT(h)) allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) From eca28556aee91a036620bda636e85501fc1ceb76 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Dec 2020 17:43:37 +0100 Subject: [PATCH 036/214] not tested implement again in new structure if needed --- src/constitutive.f90 | 47 ++-------------------------- src/crystallite.f90 | 2 +- src/kinematics_thermal_expansion.f90 | 33 +++---------------- 3 files changed, 8 insertions(+), 74 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a60352f81..6dcd88f04 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -200,15 +200,6 @@ module constitutive el !< element end function plastic_dislotwin_homogenizedC - pure module function kinematics_thermal_expansion_initialStrain(homog,phase,offset) result(initialStrain) - integer, intent(in) :: & - phase, & - homog, & - offset - real(pReal), dimension(3,3) :: & - initialStrain - end function kinematics_thermal_expansion_initialStrain - module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) integer, intent(in) :: & instance, & @@ -340,7 +331,7 @@ module constitutive end interface constitutive_dependentState interface constitutive_SandItsTangents - + module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -378,7 +369,6 @@ module constitutive constitutive_LpAndItsTangents, & constitutive_dependentState, & constitutive_LiAndItsTangents, & - constitutive_initialFi, & constitutive_SandItsTangents, & constitutive_collectDotState, & constitutive_deltaState, & @@ -421,7 +411,7 @@ subroutine constitutive_init print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) - phases => config_material%get('phase') + phases => config_material%get('phase') constitutive_source_maxSizeDotState = 0 PhaseLoop2:do p = 1,phases%length !-------------------------------------------------------------------------------------------------- @@ -607,39 +597,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & end subroutine constitutive_LiAndItsTangents -!-------------------------------------------------------------------------------------------------- -!> @brief collects initial intermediate deformation gradient -!-------------------------------------------------------------------------------------------------- -pure function constitutive_initialFi(ipc, ip, el) - - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(3,3) :: & - constitutive_initialFi !< composite initial intermediate deformation gradient - integer :: & - k !< counter in kinematics loop - integer :: & - phase, & - homog, offset - - constitutive_initialFi = math_I3 - phase = material_phaseAt(ipc,el) - - KinematicsLoop: do k = 1, phase_Nkinematics(phase) !< Warning: small initial strain assumption - kinematicsType: select case (phase_kinematics(k,phase)) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - homog = material_homogenizationAt(el) - offset = material_homogenizationMemberAt(ip,el) - constitutive_initialFi = constitutive_initialFi & - + kinematics_thermal_expansion_initialStrain(homog,phase,offset) - end select kinematicsType - enddo KinematicsLoop - -end function constitutive_initialFi - - !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- diff --git a/src/crystallite.f90 b/src/crystallite.f90 index e594ef5a1..f343d16b6 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -263,7 +263,7 @@ subroutine crystallite_init crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & / math_det33(crystallite_Fp0(1:3,1:3,c,i,e))**(1.0_pReal/3.0_pReal) - crystallite_Fi0(1:3,1:3,c,i,e) = constitutive_initialFi(c,i,e) + crystallite_Fi0(1:3,1:3,c,i,e) = math_I3 crystallite_F0(1:3,1:3,c,i,e) = math_I3 crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(crystallite_Fi0(1:3,1:3,c,i,e), & crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 36a882a48..5265d6172 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -26,7 +26,7 @@ contains !-------------------------------------------------------------------------------------------------- module function kinematics_thermal_expansion_init(kinematics_length) result(myKinematics) - integer, intent(in) :: kinematics_length + integer, intent(in) :: kinematics_length logical, dimension(:,:), allocatable :: myKinematics integer :: Ninstances,p,i,k @@ -35,8 +35,8 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi phases, & phase, & kinematics, & - kinematic_type - + kinematic_type + print'(/,a)', ' <<<+- kinematics_thermal_expansion init -+>>>' myKinematics = kinematics_active('thermal_expansion',kinematics_length) @@ -50,13 +50,13 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi do p = 1, phases%length if(any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p)) - phase => phases%get(p) + phase => phases%get(p) if(count(myKinematics(:,p)) == 0) cycle kinematics => phase%get('kinematics') do k = 1, kinematics%length if(myKinematics(k,p)) then associate(prm => param(kinematics_thermal_expansion_instance(p))) - kinematic_type => kinematics%get(k) + kinematic_type => kinematics%get(k) prm%T_ref = kinematic_type%get_asFloat('T_ref', defaultVal=0.0_pReal) @@ -81,29 +81,6 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi end function kinematics_thermal_expansion_init -!-------------------------------------------------------------------------------------------------- -!> @brief report initial thermal strain based on current temperature deviation from reference -!-------------------------------------------------------------------------------------------------- -pure module function kinematics_thermal_expansion_initialStrain(homog,phase,offset) result(initialStrain) - - integer, intent(in) :: & - phase, & - homog, & - offset - - real(pReal), dimension(3,3) :: & - initialStrain !< initial thermal strain (should be small strain, though) - - associate(prm => param(kinematics_thermal_expansion_instance(phase))) - initialStrain = & - (temperature(homog)%p(offset) - prm%T_ref)**1 / 1. * prm%A(1:3,1:3,1) + & ! constant coefficient - (temperature(homog)%p(offset) - prm%T_ref)**2 / 2. * prm%A(1:3,1:3,2) + & ! linear coefficient - (temperature(homog)%p(offset) - prm%T_ref)**3 / 3. * prm%A(1:3,1:3,3) ! quadratic coefficient - end associate - -end function kinematics_thermal_expansion_initialStrain - - !-------------------------------------------------------------------------------------------------- !> @brief constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- From 0dc388ac5c8f8392d0ce3650e09ffbb1cd9a1e10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Dec 2020 17:54:54 +0100 Subject: [PATCH 037/214] limit multiphysics to FPI integration --- src/crystallite.f90 | 60 +-------------------------------------------- 1 file changed, 1 insertion(+), 59 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index f343d16b6..c294acc31 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1214,7 +1214,6 @@ subroutine integrateStateEuler(g,i,e) integer :: & p, & c, & - s, & sizeDotState logical :: & broken @@ -1233,16 +1232,10 @@ subroutine integrateStateEuler(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + plasticState(p)%dotState (1:sizeDotState,c) & * crystallite_subdt(g,i,e) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - + sourceState(p)%p(s)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - enddo broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) if(broken) return broken = integrateStress(g,i,e) @@ -1263,13 +1256,11 @@ subroutine integrateStateAdaptiveEuler(g,i,e) integer :: & p, & c, & - s, & sizeDotState logical :: & broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic - real(pReal), dimension(constitutive_source_maxSizeDotState,maxval(phase_Nsources)) :: residuum_source p = material_phaseAt(g,e) @@ -1287,14 +1278,6 @@ subroutine integrateStateAdaptiveEuler(g,i,e) residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - - residuum_source(1:sizeDotState,s) = - sourceState(p)%p(s)%dotstate(1:sizeDotState,c) & - * 0.5_pReal * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - + sourceState(p)%p(s)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) - enddo broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & @@ -1318,15 +1301,6 @@ subroutine integrateStateAdaptiveEuler(g,i,e) plasticState(p)%state(1:sizeDotState,c), & plasticState(p)%atol(1:sizeDotState)) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - crystallite_converged(g,i,e) = & - crystallite_converged(g,i,e) .and. converged(residuum_source(1:sizeDotState,s) & - + 0.5_pReal*sourceState(p)%p(s)%dotState(:,c)*crystallite_subdt(g,i,e), & - sourceState(p)%p(s)%state(1:sizeDotState,c), & - sourceState(p)%p(s)%atol(1:sizeDotState)) - enddo - end subroutine integrateStateAdaptiveEuler @@ -1403,11 +1377,9 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) n, & p, & c, & - s, & sizeDotState logical :: & broken - real(pReal), dimension(constitutive_source_maxSizeDotState,size(B),maxval(phase_Nsources)) :: source_RKdotState real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState p = material_phaseAt(g,e) @@ -1424,33 +1396,17 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) sizeDotState = plasticState(p)%sizeDotState plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - source_RKdotState(1:sizeDotState,stage,s) = sourceState(p)%p(s)%dotState(:,c) - sourceState(p)%p(s)%dotState(:,c) = A(1,stage) * source_RKdotState(1:sizeDotState,1,s) - enddo do n = 2, stage sizeDotState = plasticState(p)%sizeDotState plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) & - + A(n,stage) * source_RKdotState(1:sizeDotState,n,s) - enddo enddo sizeDotState = plasticState(p)%sizeDotState plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + plasticState(p)%dotState (1:sizeDotState,c) & * crystallite_subdt(g,i,e) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - + sourceState(p)%p(s)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - enddo broken = integrateStress(g,i,e,CC(stage)) if(broken) exit @@ -1478,20 +1434,6 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) plasticState(p)%state(1:sizeDotState,c), & plasticState(p)%atol(1:sizeDotState)) - do s = 1, phase_Nsources(p) - sizeDotState = sourceState(p)%p(s)%sizeDotState - - source_RKdotState(1:sizeDotState,size(B),s) = sourceState(p)%p(s)%dotState(:,c) - sourceState(p)%p(s)%dotState(:,c) = matmul(source_RKdotState(1:sizeDotState,1:size(B),s),B) - sourceState(p)%p(s)%state(1:sizeDotState,c) = sourceState(p)%p(s)%subState0(1:sizeDotState,c) & - + sourceState(p)%p(s)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - if(present(DB)) & - broken = broken .or. .not. converged(matmul(source_RKdotState(1:sizeDotState,1:size(DB),s),DB) & - * crystallite_subdt(g,i,e), & - sourceState(p)%p(s)%state(1:sizeDotState,c), & - sourceState(p)%p(s)%atol(1:sizeDotState)) - enddo if(broken) return broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & From d83f72dcb828e032b7e51d26627e65acbe31d43c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Dec 2020 18:22:40 +0100 Subject: [PATCH 038/214] separate collection of plastic and source state --- src/constitutive.f90 | 79 ++++++++++++++++++++++++++++++++++++++++++-- src/crystallite.f90 | 13 ++++++++ 2 files changed, 89 insertions(+), 3 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6dcd88f04..003e5251b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -371,7 +371,9 @@ module constitutive constitutive_LiAndItsTangents, & constitutive_SandItsTangents, & constitutive_collectDotState, & + constitutive_collectDotState_source, & constitutive_deltaState, & + constitutive_deltaState_source, & constitutive_damage_getRateAndItsTangents, & constitutive_thermal_getRateAndItsTangents, & constitutive_results, & @@ -655,6 +657,46 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) + +end function constitutive_collectDotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_collectDotState_source(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in) :: & + subdt !< timestep + real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & + FArray, & !< elastic deformation gradient + FpArray !< plastic deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), dimension(3,3) :: & + Mp + integer :: & + ho, & !< homogenization + tme, & !< thermal member position + i, & !< counter in source loop + instance + logical :: broken + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + instance = phase_plasticityInstance(phase) + + + broken = .false. + SourceLoop: do i = 1, phase_Nsources(phase) sourceType: select case (phase_source(i,phase)) @@ -677,7 +719,7 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el enddo SourceLoop -end function constitutive_collectDotState +end function constitutive_collectDotState_source !-------------------------------------------------------------------------------------------------- @@ -735,6 +777,37 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke end select endif +end function constitutive_deltaState + + +!-------------------------------------------------------------------------------------------------- +!> @brief for constitutive models having an instantaneous change of state +!> will return false if delta state is not needed/supported by the constitutive model +!-------------------------------------------------------------------------------------------------- +function constitutive_deltaState_source(S, Fe, Fi, ipc, ip, el, phase, of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress + Fe, & !< elastic deformation gradient + Fi !< intermediate deformation gradient + real(pReal), dimension(3,3) :: & + Mp + integer :: & + i, & + instance, & + myOffset, & + mySize + logical :: & + broken + + + broken = .false. sourceLoop: do i = 1, phase_Nsources(phase) @@ -743,7 +816,7 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & ipc, ip, el) - broken = broken .or. any(IEEE_is_NaN(sourceState(phase)%p(i)%deltaState(:,of))) + broken = any(IEEE_is_NaN(sourceState(phase)%p(i)%deltaState(:,of))) if(.not. broken) then myOffset = sourceState(phase)%p(i)%offsetDeltaState mySize = sourceState(phase)%p(i)%sizeDeltaState @@ -755,7 +828,7 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke enddo SourceLoop -end function constitutive_deltaState +end function constitutive_deltaState_source !-------------------------------------------------------------------------------------------------- diff --git a/src/crystallite.f90 b/src/crystallite.f90 index c294acc31..6ca3cc603 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1104,6 +1104,11 @@ subroutine integrateStateFPI(g,i,e) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) + broken = broken .or. constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return size_pl = plasticState(p)%sizeDotState @@ -1136,6 +1141,11 @@ subroutine integrateStateFPI(g,i,e) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) + broken = broken .or. constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& @@ -1171,6 +1181,9 @@ subroutine integrateStateFPI(g,i,e) broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + broken = broken .or. constitutive_deltaState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fe(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) exit iteration endif From 9f2c1509449a8dd4218309498340cfb2e41b7851 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 19 Dec 2020 20:31:15 +0100 Subject: [PATCH 039/214] separate integration for source and plastic state --- src/crystallite.f90 | 153 ++++++++++++++++++++++++++++++++------------ 1 file changed, 113 insertions(+), 40 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 6ca3cc603..3be9af9ee 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -417,6 +417,7 @@ function crystallite_stress() crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) crystallite_converged(c,i,e) = .false. call integrateState(c,i,e) + call integrateSourceState(c,i,e) endif enddo @@ -1104,11 +1105,6 @@ subroutine integrateStateFPI(g,i,e) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) - broken = broken .or. constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return size_pl = plasticState(p)%sizeDotState @@ -1116,22 +1112,11 @@ subroutine integrateStateFPI(g,i,e) + plasticState(p)%dotState (1:size_pl,c) & * crystallite_subdt(g,i,e) plastic_dotState(1:size_pl,2) = 0.0_pReal - do s = 1, phase_Nsources(p) - size_so(s) = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%subState0(1:size_so(s),c) & - + sourceState(p)%p(s)%dotState (1:size_so(s),c) & - * crystallite_subdt(g,i,e) - source_dotState(1:size_so(s),2,s) = 0.0_pReal - enddo iteration: do NiterationState = 1, num%nState if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) - do s = 1, phase_Nsources(p) - if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) - source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) - enddo broken = integrateStress(g,i,e) if(broken) exit iteration @@ -1141,11 +1126,6 @@ subroutine integrateStateFPI(g,i,e) crystallite_Fi(1:3,1:3,g,i,e), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) - broken = broken .or. constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& @@ -1160,30 +1140,11 @@ subroutine integrateStateFPI(g,i,e) crystallite_converged(g,i,e) = converged(r(1:size_pl), & plasticState(p)%state(1:size_pl,c), & plasticState(p)%atol(1:size_pl)) - do s = 1, phase_Nsources(p) - zeta = damper(sourceState(p)%p(s)%dotState(:,c), & - source_dotState(1:size_so(s),1,s),& - source_dotState(1:size_so(s),2,s)) - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & - + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) - r(1:size_so(s)) = sourceState(p)%p(s)%state (1:size_so(s),c) & - - sourceState(p)%p(s)%subState0(1:size_so(s),c) & - - sourceState(p)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%state(1:size_so(s),c) & - - r(1:size_so(s)) - crystallite_converged(g,i,e) = & - crystallite_converged(g,i,e) .and. converged(r(1:size_so(s)), & - sourceState(p)%p(s)%state(1:size_so(s),c), & - sourceState(p)%p(s)%atol(1:size_so(s))) - enddo if(crystallite_converged(g,i,e)) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) - broken = broken .or. constitutive_deltaState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) exit iteration endif @@ -1215,6 +1176,118 @@ subroutine integrateStateFPI(g,i,e) end subroutine integrateStateFPI +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +subroutine integrateSourceState(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + NiterationState, & !< number of iterations in state loop + p, & + c, & + s, & + size_pl + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + r ! state residuum + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & + plastic_dotState + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + do s = 1, phase_Nsources(p) + size_so(s) = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%subState0(1:size_so(s),c) & + + sourceState(p)%p(s)%dotState (1:size_so(s),c) & + * crystallite_subdt(g,i,e) + source_dotState(1:size_so(s),2,s) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) + do s = 1, phase_Nsources(p) + if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) + source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) + enddo + + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) exit iteration + + do s = 1, phase_Nsources(p) + zeta = damper(sourceState(p)%p(s)%dotState(:,c), & + source_dotState(1:size_so(s),1,s),& + source_dotState(1:size_so(s),2,s)) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & + + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) + r(1:size_so(s)) = sourceState(p)%p(s)%state (1:size_so(s),c) & + - sourceState(p)%p(s)%subState0(1:size_so(s),c) & + - sourceState(p)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(g,i,e) + sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%state(1:size_so(s),c) & + - r(1:size_so(s)) + crystallite_converged(g,i,e) = & + crystallite_converged(g,i,e) .and. converged(r(1:size_so(s)), & + sourceState(p)%p(s)%state(1:size_so(s),c), & + sourceState(p)%p(s)%atol(1:size_so(s))) + enddo + + if(crystallite_converged(g,i,e)) then + broken = constitutive_deltaState_source(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fe(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + exit iteration + endif + + enddo iteration + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end subroutine integrateSourceState + !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- From 9425184b5281f9fcc09c01c683716355687eaec3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 09:27:37 +0100 Subject: [PATCH 040/214] using new functions --- src/CPFEM.f90 | 1 + src/CPFEM2.f90 | 1 + src/constitutive.f90 | 40 ++++++++++++++++++++++++++++++++++++++++ src/crystallite.f90 | 14 +------------- src/homogenization.f90 | 1 + 5 files changed, 44 insertions(+), 13 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index a19a70432..6fc58ea0f 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -262,6 +262,7 @@ end subroutine CPFEM_general subroutine CPFEM_forward call crystallite_forward + call constitutive_forward end subroutine CPFEM_forward diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 54e381d34..325a8791e 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -99,6 +99,7 @@ end subroutine CPFEM_restartWrite subroutine CPFEM_forward call crystallite_forward + call constitutive_forward end subroutine CPFEM_forward diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 003e5251b..635f169cd 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -378,6 +378,8 @@ module constitutive constitutive_thermal_getRateAndItsTangents, & constitutive_results, & constitutive_allocateState, & + constitutive_forward, & + constitutive_restore, & plastic_nonlocal_updateCompatibility, & plastic_active, & source_active, & @@ -864,6 +866,44 @@ subroutine constitutive_allocateState(state, & end subroutine constitutive_allocateState +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_restore(i,e) + + integer, intent(in) :: & + i, & !< integration point number + e !< element number + integer :: & + c, & !< constituent number + s + + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phasememberAt(c,i,e)) = & + sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) + enddo + enddo + +end subroutine constitutive_restore + + +!-------------------------------------------------------------------------------------------------- +!> @brief Forward data after successful increment. +! ToDo: Any guessing for the current states possible? +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_forward + + integer :: i, j + + do i = 1, size(sourceState) + do j = 1,phase_Nsources(i) + sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state + enddo; enddo + +end subroutine constitutive_forward + + !-------------------------------------------------------------------------------------------------- !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 3be9af9ee..6abc31125 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -515,8 +515,7 @@ subroutine crystallite_restore(i,e,includeL) logical, intent(in) :: & includeL !< protect agains fake cutback integer :: & - c, & !< constituent number - s + c !< constituent number do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) if (includeL) then @@ -529,10 +528,6 @@ subroutine crystallite_restore(i,e,includeL) plasticState (material_phaseAt(c,e))%state( :,material_phasememberAt(c,i,e)) = & plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) - enddo enddo end subroutine crystallite_restore @@ -1198,8 +1193,6 @@ subroutine integrateSourceState(g,i,e) zeta real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & r ! state residuum - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & broken @@ -1224,7 +1217,6 @@ subroutine integrateSourceState(g,i,e) iteration: do NiterationState = 1, num%nState - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) do s = 1, phase_Nsources(p) if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) @@ -1651,10 +1643,6 @@ subroutine crystallite_forward do i = 1, size(plasticState) plasticState(i)%state0 = plasticState(i)%state enddo - do i = 1, size(sourceState) - do j = 1,phase_Nsources(i) - sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state - enddo; enddo do i = 1,size(material_name_homogenization) homogState (i)%state0 = homogState (i)%state damageState (i)%state0 = damageState (i)%state diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 30d9cfb90..4da567e4c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -255,6 +255,7 @@ subroutine materialpoint_stressAndItsTangent(dt) subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback call crystallite_restore(i,e,subStep(i,e) < 1.0_pReal) + call constitutive_restore(i,e) if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & From 613fa5f9b2047b34c647869a1838bf32f6ac22ac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 09:44:25 +0100 Subject: [PATCH 041/214] cleaning interface --- src/constitutive.f90 | 33 +++++---------------------------- src/crystallite.f90 | 20 +++----------------- 2 files changed, 8 insertions(+), 45 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 635f169cd..b2f68e5dd 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -666,7 +666,7 @@ end function constitutive_collectDotState !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_collectDotState_source(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) +function constitutive_collectDotState_source(S, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -674,28 +674,12 @@ function constitutive_collectDotState_source(S, FArray, Fi, FpArray, subdt, ipc, el, & !< element phase, & of - real(pReal), intent(in) :: & - subdt !< timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FArray, & !< elastic deformation gradient - FpArray !< plastic deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient real(pReal), intent(in), dimension(3,3) :: & S !< 2nd Piola Kirchhoff stress (vector notation) - real(pReal), dimension(3,3) :: & - Mp integer :: & - ho, & !< homogenization - tme, & !< thermal member position - i, & !< counter in source loop - instance + i !< counter in source loop logical :: broken - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - instance = phase_plasticityInstance(phase) - broken = .false. @@ -728,7 +712,7 @@ end function constitutive_collectDotState_source !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broken) +function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -738,12 +722,10 @@ function constitutive_deltaState(S, Fe, Fi, ipc, ip, el, phase, of) result(broke of real(pReal), intent(in), dimension(3,3) :: & S, & !< 2nd Piola Kirchhoff stress - Fe, & !< elastic deformation gradient Fi !< intermediate deformation gradient real(pReal), dimension(3,3) :: & Mp integer :: & - i, & instance, & myOffset, & mySize @@ -786,7 +768,7 @@ end function constitutive_deltaState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState_source(S, Fe, Fi, ipc, ip, el, phase, of) result(broken) +function constitutive_deltaState_source(Fe, ipc, ip, el, phase, of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -795,14 +777,9 @@ function constitutive_deltaState_source(S, Fe, Fi, ipc, ip, el, phase, of) resul phase, & of real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), dimension(3,3) :: & - Mp + Fe !< elastic deformation gradient integer :: & i, & - instance, & myOffset, & mySize logical :: & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 6abc31125..5378c4cbb 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1138,7 +1138,6 @@ subroutine integrateStateFPI(g,i,e) if(crystallite_converged(g,i,e)) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) exit iteration endif @@ -1200,11 +1199,7 @@ subroutine integrateSourceState(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) return do s = 1, phase_Nsources(p) @@ -1222,11 +1217,7 @@ subroutine integrateSourceState(g,i,e) source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) enddo - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) exit iteration do s = 1, phase_Nsources(p) @@ -1247,9 +1238,7 @@ subroutine integrateSourceState(g,i,e) enddo if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState_source(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + broken = constitutive_deltaState_source(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) exit iteration endif @@ -1312,7 +1301,6 @@ subroutine integrateStateEuler(g,i,e) * crystallite_subdt(g,i,e) broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) if(broken) return @@ -1358,7 +1346,6 @@ subroutine integrateStateAdaptiveEuler(g,i,e) + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) if(broken) return @@ -1515,7 +1502,6 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) if(broken) return broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) if(broken) return From dac6540a466d605bb453e99368247713d2daf1e3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 10:48:13 +0100 Subject: [PATCH 042/214] crystallite should become part of constitutive_mech --- src/constitutive.f90 | 1621 +++++++++++++++++++++++++++++++++++++++++- src/crystallite.f90 | 1621 ------------------------------------------ 2 files changed, 1610 insertions(+), 1632 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b2f68e5dd..360fb09f1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -15,9 +15,99 @@ module constitutive use discretization use geometry_plastic_nonlocal, only: & geometry_plastic_nonlocal_disable + use parallelization + use HDF5_utilities + use DAMASK_interface + use FEsolving + use results implicit none private + real(pReal), dimension(:,:,:), allocatable, public :: & + crystallite_dt !< requested time increment of each grain + real(pReal), dimension(:,:,:), allocatable :: & + crystallite_subdt, & !< substepped time increment of each grain + crystallite_subFrac, & !< already calculated fraction of increment + crystallite_subStep !< size of next integration step + type(rotation), dimension(:,:,:), allocatable :: & + crystallite_orientation !< current orientation + real(pReal), dimension(:,:,:,:,:), allocatable :: & + crystallite_F0, & !< def grad at start of FE inc + crystallite_subF, & !< def grad to be reached at end of crystallite inc + crystallite_subF0, & !< def grad at start of crystallite inc + ! + crystallite_Fe, & !< current "elastic" def grad (end of converged time step) + ! + crystallite_Fp, & !< current plastic def grad (end of converged time step) + crystallite_Fp0, & !< plastic def grad at start of FE inc + crystallite_partitionedFp0,& !< plastic def grad at start of homog inc + crystallite_subFp0,& !< plastic def grad at start of crystallite inc + ! + crystallite_Fi, & !< current intermediate def grad (end of converged time step) + crystallite_Fi0, & !< intermediate def grad at start of FE inc + crystallite_partitionedFi0,& !< intermediate def grad at start of homog inc + crystallite_subFi0,& !< intermediate def grad at start of crystallite inc + ! + crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc + crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc + ! + crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) + crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc + crystallite_partitionedLi0, & !< intermediate velocity grad at start of homog inc + ! + crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc + crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc + real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & + crystallite_P, & !< 1st Piola-Kirchhoff stress per grain + crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) + crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) + crystallite_partitionedF0 !< def grad at start of homog inc + real(pReal), dimension(:,:,:,:,:), allocatable, public :: & + crystallite_partitionedF !< def grad to be reached at end of homog inc + + logical, dimension(:,:,:), allocatable, public :: & + crystallite_requested !< used by upper level (homogenization) to request crystallite calculation + logical, dimension(:,:,:), allocatable :: & + crystallite_converged !< convergence flag + + type :: tOutput !< new requested output (per phase) + character(len=pStringLen), allocatable, dimension(:) :: & + label + end type tOutput + type(tOutput), allocatable, dimension(:) :: output_constituent + + type :: tNumerics + integer :: & + iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp + nState, & !< state loop limit + nStress !< stress loop limit + real(pReal) :: & + subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback + subStepSizeCryst, & !< size of first substep when cutback + subStepSizeLp, & !< size of first substep when cutback in Lp calculation + subStepSizeLi, & !< size of first substep when cutback in Li calculation + stepIncreaseCryst, & !< increase of next substep size when previous substep converged + rtol_crystalliteState, & !< relative tolerance in state loop + rtol_crystalliteStress, & !< relative tolerance in stress loop + atol_crystalliteStress !< absolute tolerance in stress loop + end type tNumerics + + type(tNumerics) :: num ! numerics parameters. Better name? + + type :: tDebugOptions + logical :: & + basic, & + extensive, & + selective + integer :: & + element, & + ip, & + grain + end type tDebugOptions + + type(tDebugOptions) :: debugCrystallite + + procedure(integrateStateFPI), pointer :: integrateState integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & phase_plasticity !< plasticity of each phase @@ -350,17 +440,6 @@ module constitutive end interface constitutive_SandItsTangents - type :: tDebugOptions - logical :: & - basic, & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - type(tDebugOptions) :: debugConstitutive public :: & @@ -384,6 +463,20 @@ module constitutive plastic_active, & source_active, & kinematics_active + + public :: & + crystallite_init, & + crystallite_stress, & + crystallite_stressTangent, & + crystallite_orientations, & + crystallite_push33ToRef, & + crystallite_results, & + crystallite_restartWrite, & + crystallite_restartRead, & + crystallite_forward, & + crystallite_initializeRestorationPoints, & + crystallite_windForward, & + crystallite_restore contains @@ -892,4 +985,1510 @@ subroutine constitutive_results end subroutine constitutive_results +!-------------------------------------------------------------------------------------------------- +!> @brief allocates and initialize per grain variables +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_init + + integer :: & + p, & + c, & !< counter in integration point component loop + i, & !< counter in integration point loop + e, & !< counter in element loop + cMax, & !< maximum number of integration point components + iMax, & !< maximum number of integration points + eMax !< maximum number of elements + + + class(tNode), pointer :: & + num_crystallite, & + debug_crystallite, & ! pointer to debug options for crystallite + phases, & + phase, & + mech + + print'(/,a)', ' <<<+- crystallite init -+>>>' + + debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) + debugCrystallite%basic = debug_crystallite%contains('basic') + debugCrystallite%extensive = debug_crystallite%contains('extensive') + debugCrystallite%selective = debug_crystallite%contains('selective') + debugCrystallite%element = config_debug%get_asInt('element', defaultVal=1) + debugCrystallite%ip = config_debug%get_asInt('integrationpoint', defaultVal=1) + debugCrystallite%grain = config_debug%get_asInt('grain', defaultVal=1) + + cMax = homogenization_maxNconstituents + iMax = discretization_nIPs + eMax = discretization_Nelems + + allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) + + allocate(crystallite_S0, & + crystallite_F0, crystallite_Fi0,crystallite_Fp0, & + crystallite_Li0,crystallite_Lp0, & + crystallite_partitionedS0, & + crystallite_partitionedF0,crystallite_partitionedFp0,crystallite_partitionedFi0, & + crystallite_partitionedLp0,crystallite_partitionedLi0, & + crystallite_S,crystallite_P, & + crystallite_Fe,crystallite_Fi,crystallite_Fp, & + crystallite_Li,crystallite_Lp, & + crystallite_subF,crystallite_subF0, & + crystallite_subFp0,crystallite_subFi0, & + source = crystallite_partitionedF) + + allocate(crystallite_dt(cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_subdt,crystallite_subFrac,crystallite_subStep, & + source = crystallite_dt) + + allocate(crystallite_orientation(cMax,iMax,eMax)) + + allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) + allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) + + num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) + + num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) + num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal) + num%stepIncreaseCryst = num_crystallite%get_asFloat ('stepIncrease', defaultVal=1.5_pReal) + num%subStepSizeLp = num_crystallite%get_asFloat ('subStepSizeLp', defaultVal=0.5_pReal) + num%subStepSizeLi = num_crystallite%get_asFloat ('subStepSizeLi', defaultVal=0.5_pReal) + num%rtol_crystalliteState = num_crystallite%get_asFloat ('rtol_State', defaultVal=1.0e-6_pReal) + num%rtol_crystalliteStress = num_crystallite%get_asFloat ('rtol_Stress', defaultVal=1.0e-6_pReal) + num%atol_crystalliteStress = num_crystallite%get_asFloat ('atol_Stress', defaultVal=1.0e-8_pReal) + num%iJacoLpresiduum = num_crystallite%get_asInt ('iJacoLpresiduum', defaultVal=1) + num%nState = num_crystallite%get_asInt ('nState', defaultVal=20) + num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40) + + if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') + if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') + if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') + + if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') + if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') + + if(num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') + if(num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') + if(num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') + + if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') + + if(num%nState < 1) call IO_error(301,ext_msg='nState') + if(num%nStress< 1) call IO_error(301,ext_msg='nStress') + + select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) + case('FPI') + integrateState => integrateStateFPI + case('Euler') + integrateState => integrateStateEuler + case('AdaptiveEuler') + integrateState => integrateStateAdaptiveEuler + case('RK4') + integrateState => integrateStateRK4 + case('RKCK45') + integrateState => integrateStateRKCK45 + case default + call IO_error(301,ext_msg='integrator') + end select + + phases => config_material%get('phase') + + allocate(output_constituent(phases%length)) + do p = 1, phases%length + phase => phases%get(p) + mech => phase%get('mechanics',defaultVal = emptyDict) +#if defined(__GFORTRAN__) + output_constituent(p)%label = output_asStrings(mech) +#else + output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) +#endif + enddo + +#ifdef DEBUG + if (debugCrystallite%basic) then + print'(a42,1x,i10)', ' # of elements: ', eMax + print'(a42,1x,i10)', ' # of integration points/element: ', iMax + print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax + flush(IO_STDOUT) + endif +#endif + + !$OMP PARALLEL DO PRIVATE(i,c) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) + crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & + / math_det33(crystallite_Fp0(1:3,1:3,c,i,e))**(1.0_pReal/3.0_pReal) + crystallite_Fi0(1:3,1:3,c,i,e) = math_I3 + crystallite_F0(1:3,1:3,c,i,e) = math_I3 + crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(crystallite_Fi0(1:3,1:3,c,i,e), & + crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration + crystallite_Fp(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) + crystallite_Fi(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) + crystallite_requested(c,i,e) = .true. + enddo; enddo + enddo + !$OMP END PARALLEL DO + + + crystallite_partitionedFp0 = crystallite_Fp0 + crystallite_partitionedFi0 = crystallite_Fi0 + crystallite_partitionedF0 = crystallite_F0 + crystallite_partitionedF = crystallite_F0 + + call crystallite_orientations() + + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1),FEsolving_execIP(2) + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + call constitutive_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & + crystallite_partitionedFp0(1:3,1:3,c,i,e), & + c,i,e) ! update dependent state variables to be consistent with basic states + enddo + enddo + enddo + !$OMP END PARALLEL DO + + +end subroutine crystallite_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate stress (P) +!-------------------------------------------------------------------------------------------------- +function crystallite_stress() + + logical, dimension(discretization_nIPs,discretization_Nelems) :: crystallite_stress + real(pReal) :: & + formerSubStep + integer :: & + NiterationCrystallite, & ! number of iterations in crystallite loop + c, & !< counter in integration point component loop + i, & !< counter in integration point loop + e, & !< counter in element loop + s + logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains + real(pReal), dimension(:,:,:,:,:), allocatable :: & + subLp0,& !< plastic velocity grad at start of crystallite inc + subLi0 !< intermediate velocity grad at start of crystallite inc + + todo = .false. + + subLp0 = crystallite_partitionedLp0 + subLi0 = crystallite_partitionedLi0 + +!-------------------------------------------------------------------------------------------------- +! initialize to starting condition + crystallite_subStep = 0.0_pReal + !$OMP PARALLEL DO + elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then + plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & + plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) + + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState(material_phaseAt(c,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & + sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phaseMemberAt(c,i,e)) + enddo + crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) + crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) + crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) + crystallite_subFrac(c,i,e) = 0.0_pReal + crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst + todo(c,i,e) = .true. + crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst + endif homogenizationRequestsCalculation + enddo; enddo + enddo elementLooping1 + !$OMP END PARALLEL DO + + NiterationCrystallite = 0 + cutbackLooping: do while (any(todo(:,FEsolving_execIP(1):FEsolving_execIP(2),FEsolving_execELem(1):FEsolving_execElem(2)))) + NiterationCrystallite = NiterationCrystallite + 1 + +#ifdef DEBUG + if (debugCrystallite%extensive) & + print'(a,i6)', '<< CRYST stress >> crystallite iteration ',NiterationCrystallite +#endif + !$OMP PARALLEL DO PRIVATE(formerSubStep) + elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1),FEsolving_execIP(2) + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) +!-------------------------------------------------------------------------------------------------- +! wind forward + if (crystallite_converged(c,i,e)) then + formerSubStep = crystallite_subStep(c,i,e) + crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e) + crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), & + num%stepIncreaseCryst * crystallite_subStep(c,i,e)) + + todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? + if (todo(c,i,e)) then + crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) + subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) + subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) + crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) + crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) + plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & + = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState( material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & + = sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) + enddo + endif + +!-------------------------------------------------------------------------------------------------- +! cut back (reduced time and restore) + else + crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) + crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) + crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) + crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) + if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,c,i,e) = subLp0(1:3,1:3,c,i,e) + crystallite_Li (1:3,1:3,c,i,e) = subLi0(1:3,1:3,c,i,e) + endif + plasticState (material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) & + = plasticState(material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState( material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & + = sourceState(material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) + enddo + + ! cant restore dotState here, since not yet calculated in first cutback after initialization + todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst ! still on track or already done (beyond repair) + endif + +!-------------------------------------------------------------------------------------------------- +! prepare for integration + if (todo(c,i,e)) then + crystallite_subF(1:3,1:3,c,i,e) = crystallite_subF0(1:3,1:3,c,i,e) & + + crystallite_subStep(c,i,e) *( crystallite_partitionedF (1:3,1:3,c,i,e) & + -crystallite_partitionedF0(1:3,1:3,c,i,e)) + crystallite_Fe(1:3,1:3,c,i,e) = matmul(crystallite_subF(1:3,1:3,c,i,e), & + math_inv33(matmul(crystallite_Fi(1:3,1:3,c,i,e), & + crystallite_Fp(1:3,1:3,c,i,e)))) + crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) + crystallite_converged(c,i,e) = .false. + call integrateState(c,i,e) + call integrateSourceState(c,i,e) + endif + + enddo + enddo + enddo elementLooping3 + !$OMP END PARALLEL DO + +!-------------------------------------------------------------------------------------------------- +! integrate --- requires fully defined state array (basic + dependent state) + where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further + todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation + enddo cutbackLooping + +! return whether converged or not + crystallite_stress = .false. + elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1),FEsolving_execIP(2) + crystallite_stress(i,e) = all(crystallite_converged(:,i,e)) + enddo + enddo elementLooping5 + +end function crystallite_stress + + +!-------------------------------------------------------------------------------------------------- +!> @brief Backup data for homog cutback. +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_initializeRestorationPoints(i,e) + + integer, intent(in) :: & + i, & !< integration point number + e !< element number + integer :: & + c, & !< constituent number + s + + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) + crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) + crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) + crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li0(1:3,1:3,c,i,e) + crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) + crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) + + plasticState(material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & + plasticState(material_phaseAt(c,e))%state0( :,material_phasememberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & + sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) + enddo + enddo + +end subroutine crystallite_initializeRestorationPoints + + +!-------------------------------------------------------------------------------------------------- +!> @brief Wind homog inc forward. +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_windForward(i,e) + + integer, intent(in) :: & + i, & !< integration point number + e !< element number + integer :: & + c, & !< constituent number + s + + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) + crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) + crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) + crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) + crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) + crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) + + plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & + plasticState (material_phaseAt(c,e))%state (:,material_phasememberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,e)) + sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & + sourceState(material_phaseAt(c,e))%p(s)%state (:,material_phasememberAt(c,i,e)) + enddo + enddo + +end subroutine crystallite_windForward + + +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_restore(i,e,includeL) + + integer, intent(in) :: & + i, & !< integration point number + e !< element number + logical, intent(in) :: & + includeL !< protect agains fake cutback + integer :: & + c !< constituent number + + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + if (includeL) then + crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) + crystallite_Li(1:3,1:3,c,i,e) = crystallite_partitionedLi0(1:3,1:3,c,i,e) + endif ! maybe protecting everything from overwriting makes more sense + crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) + crystallite_Fi(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) + crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) + + plasticState (material_phaseAt(c,e))%state( :,material_phasememberAt(c,i,e)) = & + plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) + enddo + +end subroutine crystallite_restore + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate tangent (dPdF). +!-------------------------------------------------------------------------------------------------- +function crystallite_stressTangent(c,i,e) result(dPdF) + + real(pReal), dimension(3,3,3,3) :: dPdF + integer, intent(in) :: & + c, & !< counter in constituent loop + i, & !< counter in integration point loop + e !< counter in element loop + integer :: & + o, & + p + + real(pReal), dimension(3,3) :: devNull, & + invSubFp0,invSubFi0,invFp,invFi, & + temp_33_1, temp_33_2, temp_33_3, temp_33_4 + real(pReal), dimension(3,3,3,3) :: dSdFe, & + dSdF, & + dSdFi, & + dLidS, & ! tangent in lattice configuration + dLidFi, & + dLpdS, & + dLpdFi, & + dFidS, & + dFpinvdF, & + rhs_3333, & + lhs_3333, & + temp_3333 + real(pReal), dimension(9,9):: temp_99 + logical :: error + + + call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, & + crystallite_Fe(1:3,1:3,c,i,e), & + crystallite_Fi(1:3,1:3,c,i,e),c,i,e) + call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & + crystallite_S (1:3,1:3,c,i,e), & + crystallite_Fi(1:3,1:3,c,i,e), & + c,i,e) + + invFp = math_inv33(crystallite_Fp(1:3,1:3,c,i,e)) + invFi = math_inv33(crystallite_Fi(1:3,1:3,c,i,e)) + invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)) + invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)) + + if (sum(abs(dLidS)) < tol_math_check) then + dFidS = 0.0_pReal + else + lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal + do o=1,3; do p=1,3 + lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & + + crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) + lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + + invFi*invFi(p,o) + rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & + - crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) + enddo; enddo + call math_invert(temp_99,error,math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=e,ip=i,g=c, & + ext_msg='inversion error in analytic tangent calculation') + dFidS = 0.0_pReal + else + dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS + endif + + call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + crystallite_S (1:3,1:3,c,i,e), & + crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration + dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS + +!-------------------------------------------------------------------------------------------------- +! calculate dSdF + temp_33_1 = transpose(matmul(invFp,invFi)) + temp_33_2 = matmul(crystallite_subF(1:3,1:3,c,i,e),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,c,i,e),invFp), invSubFi0) + + do o=1,3; do p=1,3 + rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) + temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) + enddo; enddo + lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) & + + math_mul3333xx3333(dSdFi,dFidS) + + call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=e,ip=i,g=c, & + ext_msg='inversion error in analytic tangent calculation') + dSdF = rhs_3333 + else + dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + +!-------------------------------------------------------------------------------------------------- +! calculate dFpinvdF + temp_3333 = math_mul3333xx3333(dLpdS,dSdF) + do o=1,3; do p=1,3 + dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(c,i,e) & + * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! assemble dPdF + temp_33_1 = matmul(crystallite_S(1:3,1:3,c,i,e),transpose(invFp)) + temp_33_2 = matmul(invFp,temp_33_1) + temp_33_3 = matmul(crystallite_subF(1:3,1:3,c,i,e),invFp) + temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,c,i,e)) + + dPdF = 0.0_pReal + do p=1,3 + dPdF(p,1:3,p,1:3) = transpose(temp_33_2) + enddo + do o=1,3; do p=1,3 + dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + + matmul(matmul(crystallite_subF(1:3,1:3,c,i,e), & + dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & + transpose(invFp)) & + + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) + enddo; enddo + +end function crystallite_stressTangent + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates orientations +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_orientations + + integer & + c, & !< counter in integration point component loop + i, & !< counter in integration point loop + e !< counter in element loop + + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1),FEsolving_execIP(2) + do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + call crystallite_orientation(c,i,e)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,c,i,e)))) + enddo; enddo; enddo + !$OMP END PARALLEL DO + + nonlocalPresent: if (any(plasticState%nonlocal)) then + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + if (plasticState(material_phaseAt(1,e))%nonlocal) then + do i = FEsolving_execIP(1),FEsolving_execIP(2) + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + phase_plasticityInstance(material_phaseAt(1,e)),i,e) + enddo + endif + enddo + !$OMP END PARALLEL DO + endif nonlocalPresent + +end subroutine crystallite_orientations + + +!-------------------------------------------------------------------------------------------------- +!> @brief Map 2nd order tensor to reference config +!-------------------------------------------------------------------------------------------------- +function crystallite_push33ToRef(ipc,ip,el, tensor33) + + real(pReal), dimension(3,3) :: crystallite_push33ToRef + real(pReal), dimension(3,3), intent(in) :: tensor33 + real(pReal), dimension(3,3) :: T + integer, intent(in):: & + el, & + ip, & + ipc + + T = matmul(material_orientation0(ipc,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? + transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) + crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) + +end function crystallite_push33ToRef + + +!-------------------------------------------------------------------------------------------------- +!> @brief writes crystallite results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_results + + integer :: p,o + real(pReal), allocatable, dimension(:,:,:) :: selected_tensors + real(pReal), allocatable, dimension(:,:) :: selected_rotations + character(len=:), allocatable :: group,structureLabel + + do p=1,size(material_name_phase) + group = trim('current/phase')//'/'//trim(material_name_phase(p))//'/mechanics' + + call results_closeGroup(results_addGroup(group)) + + do o = 1, size(output_constituent(p)%label) + select case (output_constituent(p)%label(o)) + case('F') + selected_tensors = select_tensors(crystallite_partitionedF,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'deformation gradient','1') + case('F_e') + selected_tensors = select_tensors(crystallite_Fe,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'elastic deformation gradient','1') + case('F_p') + selected_tensors = select_tensors(crystallite_Fp,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'plastic deformation gradient','1') + case('F_i') + selected_tensors = select_tensors(crystallite_Fi,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'inelastic deformation gradient','1') + case('L_p') + selected_tensors = select_tensors(crystallite_Lp,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'plastic velocity gradient','1/s') + case('L_i') + selected_tensors = select_tensors(crystallite_Li,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'inelastic velocity gradient','1/s') + case('P') + selected_tensors = select_tensors(crystallite_P,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'First Piola-Kirchhoff stress','Pa') + case('S') + selected_tensors = select_tensors(crystallite_S,p) + call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + 'Second Piola-Kirchhoff stress','Pa') + case('O') + select case(lattice_structure(p)) + case(lattice_ISO_ID) + structureLabel = 'aP' + case(lattice_FCC_ID) + structureLabel = 'cF' + case(lattice_BCC_ID) + structureLabel = 'cI' + case(lattice_BCT_ID) + structureLabel = 'tI' + case(lattice_HEX_ID) + structureLabel = 'hP' + case(lattice_ORT_ID) + structureLabel = 'oP' + end select + selected_rotations = select_rotations(crystallite_orientation,p) + call results_writeDataset(group,selected_rotations,output_constituent(p)%label(o),& + 'crystal orientation as quaternion','q_0 ') + call results_addAttribute('Lattice',structureLabel,group//'/'//output_constituent(p)%label(o)) + end select + enddo + enddo + + contains + + !------------------------------------------------------------------------------------------------ + !> @brief select tensors for output + !------------------------------------------------------------------------------------------------ + function select_tensors(dataset,instance) + + integer, intent(in) :: instance + real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset + real(pReal), allocatable, dimension(:,:,:) :: select_tensors + integer :: e,i,c,j + + allocate(select_tensors(3,3,count(material_phaseAt==instance)*discretization_nIPs)) + + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, discretization_nIPs + do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(c,e) == instance) then + j = j + 1 + select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) + endif + enddo + enddo + enddo + + end function select_tensors + + +!-------------------------------------------------------------------------------------------------- +!> @brief select rotations for output +!-------------------------------------------------------------------------------------------------- + function select_rotations(dataset,instance) + + integer, intent(in) :: instance + type(rotation), dimension(:,:,:), intent(in) :: dataset + real(pReal), allocatable, dimension(:,:) :: select_rotations + integer :: e,i,c,j + + allocate(select_rotations(4,count(material_phaseAt==instance)*homogenization_maxNconstituents*discretization_nIPs)) + + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, discretization_nIPs + do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(c,e) == instance) then + j = j + 1 + select_rotations(1:4,j) = dataset(c,i,e)%asQuaternion() + endif + enddo + enddo + enddo + + end function select_rotations + +end subroutine crystallite_results + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of stress (P) with time integration based on a residuum in Lp and +!> intermediate acceleration of the Newton-Raphson correction +!-------------------------------------------------------------------------------------------------- +function integrateStress(ipc,ip,el,timeFraction) result(broken) + + integer, intent(in):: el, & ! element index + ip, & ! integration point index + ipc ! grain index + real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep + + real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep + Fp_new, & ! plastic deformation gradient at end of timestep + invFp_new, & ! inverse of Fp_new + invFp_current, & ! inverse of Fp_current + Lpguess, & ! current guess for plastic velocity gradient + Lpguess_old, & ! known last good guess for plastic velocity gradient + Lp_constitutive, & ! plastic velocity gradient resulting from constitutive law + residuumLp, & ! current residuum of plastic velocity gradient + residuumLp_old, & ! last residuum of plastic velocity gradient + deltaLp, & ! direction of next guess + Fi_new, & ! gradient of intermediate deformation stages + invFi_new, & + invFi_current, & ! inverse of Fi_current + Liguess, & ! current guess for intermediate velocity gradient + Liguess_old, & ! known last good guess for intermediate velocity gradient + Li_constitutive, & ! intermediate velocity gradient resulting from constitutive law + residuumLi, & ! current residuum of intermediate velocity gradient + residuumLi_old, & ! last residuum of intermediate velocity gradient + deltaLi, & ! direction of next guess + Fe, & ! elastic deformation gradient + S, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration + A, & + B, & + temp_33 + real(pReal), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK + integer, dimension(9) :: devNull_9 ! needed for matrix inversion by LAPACK + real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme) + dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme) + real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress + dS_dFi, & + dFe_dLp, & ! partial derivative of elastic deformation gradient + dFe_dLi, & + dFi_dLi, & + dLp_dFi, & + dLi_dFi, & + dLp_dS, & + dLi_dS + real(pReal) steplengthLp, & + steplengthLi, & + dt, & ! time increment + atol_Lp, & + atol_Li, & + devNull + integer NiterationStressLp, & ! number of stress integrations + NiterationStressLi, & ! number of inner stress integrations + ierr, & ! error indicator for LAPACK + o, & + p, & + jacoCounterLp, & + jacoCounterLi ! counters to check for Jacobian update + logical :: error,broken + + broken = .true. + + if (present(timeFraction)) then + dt = crystallite_subdt(ipc,ip,el) * timeFraction + F = crystallite_subF0(1:3,1:3,ipc,ip,el) & + + (crystallite_subF(1:3,1:3,ipc,ip,el) - crystallite_subF0(1:3,1:3,ipc,ip,el)) * timeFraction + else + dt = crystallite_subdt(ipc,ip,el) + F = crystallite_subF(1:3,1:3,ipc,ip,el) + endif + + call constitutive_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & + crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) + + Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess + Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! take as first guess + + call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) + if (error) return ! error + call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,ipc,ip,el)) + if (error) return ! error + + A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp + + jacoCounterLi = 0 + steplengthLi = 1.0_pReal + residuumLi_old = 0.0_pReal + Liguess_old = Liguess + + NiterationStressLi = 0 + LiLoop: do + NiterationStressLi = NiterationStressLi + 1 + if (NiterationStressLi>num%nStress) return ! error + + invFi_new = matmul(invFi_current,math_I3 - dt*Liguess) + Fi_new = math_inv33(invFi_new) + + jacoCounterLp = 0 + steplengthLp = 1.0_pReal + residuumLp_old = 0.0_pReal + Lpguess_old = Lpguess + + NiterationStressLp = 0 + LpLoop: do + NiterationStressLp = NiterationStressLp + 1 + if (NiterationStressLp>num%nStress) return ! error + + B = math_I3 - dt*Lpguess + Fe = matmul(matmul(A,B), invFi_new) + call constitutive_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi_new, ipc, ip, el) + + call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & + S, Fi_new, ipc, ip, el) + + !* update current residuum and check for convergence of loop + atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%atol_crystalliteStress) ! minimum lower cutoff + residuumLp = Lpguess - Lp_constitutive + + if (any(IEEE_is_NaN(residuumLp))) then + return ! error + elseif (norm2(residuumLp) < atol_Lp) then ! converged if below absolute tolerance + exit LpLoop + elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... + residuumLp_old = residuumLp ! ...remember old values and... + Lpguess_old = Lpguess + steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) + else ! not converged and residuum not improved... + steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction + Lpguess = Lpguess_old & + + deltaLp * stepLengthLp + cycle LpLoop + endif + + calculateJacobiLi: if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then + jacoCounterLp = jacoCounterLp + 1 + + do o=1,3; do p=1,3 + dFe_dLp(o,1:3,p,1:3) = - dt * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + enddo; enddo + dRLp_dLp = math_eye(9) & + - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) + temp_9 = math_33to9(residuumLp) + call dgesv(9,1,dRLp_dLp,9,devNull_9,temp_9,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp + if (ierr /= 0) return ! error + deltaLp = - math_9to33(temp_9) + endif calculateJacobiLi + + Lpguess = Lpguess & + + deltaLp * steplengthLp + enddo LpLoop + + call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & + S, Fi_new, ipc, ip, el) + + !* update current residuum and check for convergence of loop + atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%atol_crystalliteStress) ! minimum lower cutoff + residuumLi = Liguess - Li_constitutive + if (any(IEEE_is_NaN(residuumLi))) then + return ! error + elseif (norm2(residuumLi) < atol_Li) then ! converged if below absolute tolerance + exit LiLoop + elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... + residuumLi_old = residuumLi ! ...remember old values and... + Liguess_old = Liguess + steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) + else ! not converged and residuum not improved... + steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction + Liguess = Liguess_old & + + deltaLi * steplengthLi + cycle LiLoop + endif + + calculateJacobiLp: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then + jacoCounterLi = jacoCounterLi + 1 + + temp_33 = matmul(matmul(A,B),invFi_current) + do o=1,3; do p=1,3 + dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current + enddo; enddo + do o=1,3; do p=1,3 + dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) + enddo; enddo + dRLi_dLi = math_eye(9) & + - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) & + + math_mul3333xx3333(dS_dFi, dFi_dLi))) & + - math_3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) + temp_9 = math_33to9(residuumLi) + call dgesv(9,1,dRLi_dLi,9,devNull_9,temp_9,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li + if (ierr /= 0) return ! error + deltaLi = - math_9to33(temp_9) + endif calculateJacobiLp + + Liguess = Liguess & + + deltaLi * steplengthLi + enddo LiLoop + + invFp_new = matmul(invFp_current,B) + call math_invert33(Fp_new,devNull,error,invFp_new) + if (error) return ! error + + crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + crystallite_S (1:3,1:3,ipc,ip,el) = S + crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess + crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess + crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + crystallite_Fi (1:3,1:3,ipc,ip,el) = Fi_new + crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + broken = .false. + +end function integrateStress + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateFPI(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + NiterationState, & !< number of iterations in state loop + p, & + c, & + s, & + size_pl + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + r ! state residuum + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & + plastic_dotState + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + size_pl = plasticState(p)%sizeDotState + plasticState(p)%state(1:size_pl,c) = plasticState(p)%subState0(1:size_pl,c) & + + plasticState(p)%dotState (1:size_pl,c) & + * crystallite_subdt(g,i,e) + plastic_dotState(1:size_pl,2) = 0.0_pReal + + iteration: do NiterationState = 1, num%nState + + if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) + plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) + + broken = integrateStress(g,i,e) + if(broken) exit iteration + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) exit iteration + + zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& + plastic_dotState(1:size_pl,2)) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) + r(1:size_pl) = plasticState(p)%state (1:size_pl,c) & + - plasticState(p)%subState0(1:size_pl,c) & + - plasticState(p)%dotState (1:size_pl,c) * crystallite_subdt(g,i,e) + plasticState(p)%state(1:size_pl,c) = plasticState(p)%state(1:size_pl,c) & + - r(1:size_pl) + crystallite_converged(g,i,e) = converged(r(1:size_pl), & + plasticState(p)%state(1:size_pl,c), & + plasticState(p)%atol(1:size_pl)) + + if(crystallite_converged(g,i,e)) then + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + exit iteration + endif + + enddo iteration + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end subroutine integrateStateFPI + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +subroutine integrateSourceState(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + NiterationState, & !< number of iterations in state loop + p, & + c, & + s, & + size_pl + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + r ! state residuum + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + if(broken) return + + do s = 1, phase_Nsources(p) + size_so(s) = sourceState(p)%p(s)%sizeDotState + sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%subState0(1:size_so(s),c) & + + sourceState(p)%p(s)%dotState (1:size_so(s),c) & + * crystallite_subdt(g,i,e) + source_dotState(1:size_so(s),2,s) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do s = 1, phase_Nsources(p) + if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) + source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) + enddo + + broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + if(broken) exit iteration + + do s = 1, phase_Nsources(p) + zeta = damper(sourceState(p)%p(s)%dotState(:,c), & + source_dotState(1:size_so(s),1,s),& + source_dotState(1:size_so(s),2,s)) + sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & + + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) + r(1:size_so(s)) = sourceState(p)%p(s)%state (1:size_so(s),c) & + - sourceState(p)%p(s)%subState0(1:size_so(s),c) & + - sourceState(p)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(g,i,e) + sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%state(1:size_so(s),c) & + - r(1:size_so(s)) + crystallite_converged(g,i,e) = & + crystallite_converged(g,i,e) .and. converged(r(1:size_so(s)), & + sourceState(p)%p(s)%state(1:size_so(s),c), & + sourceState(p)%p(s)%atol(1:size_so(s))) + enddo + + if(crystallite_converged(g,i,e)) then + broken = constitutive_deltaState_source(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) + exit iteration + endif + + enddo iteration + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end subroutine integrateSourceState + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate state with 1st order explicit Euler method +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateEuler(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + p, & + c, & + sizeDotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + crystallite_converged(g,i,e) = .not. broken + +end subroutine integrateStateEuler + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with 1st order Euler method with adaptive step size +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateAdaptiveEuler(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + p, & + c, & + sizeDotState + logical :: & + broken + + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic + + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + + residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + if(broken) return + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + + sizeDotState = plasticState(p)%sizeDotState + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%atol(1:sizeDotState)) + +end subroutine integrateStateAdaptiveEuler + + +!--------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with the classic Runge Kutta method +!--------------------------------------------------------------------------------------------------- +subroutine integrateStateRK4(g,i,e) + + integer, intent(in) :: g,i,e + + real(pReal), dimension(3,3), parameter :: & + A = reshape([& + 0.5_pReal, 0.0_pReal, 0.0_pReal, & + 0.0_pReal, 0.5_pReal, 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal],& + shape(A)) + real(pReal), dimension(3), parameter :: & + C = [0.5_pReal, 0.5_pReal, 1.0_pReal] + real(pReal), dimension(4), parameter :: & + B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + + call integrateStateRK(g,i,e,A,B,C) + +end subroutine integrateStateRK4 + + +!--------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with the Cash-Carp method +!--------------------------------------------------------------------------------------------------- +subroutine integrateStateRKCK45(g,i,e) + + integer, intent(in) :: g,i,e + + real(pReal), dimension(5,5), parameter :: & + A = reshape([& + 1._pReal/5._pReal, .0_pReal, .0_pReal, .0_pReal, .0_pReal, & + 3._pReal/40._pReal, 9._pReal/40._pReal, .0_pReal, .0_pReal, .0_pReal, & + 3_pReal/10._pReal, -9._pReal/10._pReal, 6._pReal/5._pReal, .0_pReal, .0_pReal, & + -11._pReal/54._pReal, 5._pReal/2._pReal, -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal, .0_pReal, & + 1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],& + shape(A)) + real(pReal), dimension(5), parameter :: & + C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal] + real(pReal), dimension(6), parameter :: & + B = & + [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, & + 125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], & + DB = B - & + [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& + 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] + + call integrateStateRK(g,i,e,A,B,C,DB) + +end subroutine integrateStateRKCK45 + + +!-------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an +!! embedded explicit Runge-Kutta method +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateRK(g,i,e,A,B,CC,DB) + + + real(pReal), dimension(:,:), intent(in) :: A + real(pReal), dimension(:), intent(in) :: B, CC + real(pReal), dimension(:), intent(in), optional :: DB + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + stage, & ! stage index in integration stage loop + n, & + p, & + c, & + sizeDotState + logical :: & + broken + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + do stage = 1,size(A,1) + sizeDotState = plasticState(p)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) + plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) + + do n = 2, stage + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & + + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) + enddo + + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + + broken = integrateStress(g,i,e,CC(stage)) + if(broken) exit + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + crystallite_Fi(1:3,1:3,g,i,e), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) + if(broken) exit + + enddo + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + + plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (p)%dotState(:,c) + plasticState(p)%dotState(:,c) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + if(present(DB)) & + broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & + * crystallite_subdt(g,i,e), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%atol(1:sizeDotState)) + + if(broken) return + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + crystallite_converged(g,i,e) = .not. broken + + +end subroutine integrateStateRK + + +!-------------------------------------------------------------------------------------------------- +!> @brief determines whether a point is converged +!-------------------------------------------------------------------------------------------------- +logical pure function converged(residuum,state,atol) + + real(pReal), intent(in), dimension(:) ::& + residuum, state, atol + real(pReal) :: & + rTol + + rTol = num%rTol_crystalliteState + + converged = all(abs(residuum) <= max(atol, rtol*abs(state))) + +end function converged + + +!-------------------------------------------------------------------------------------------------- +!> @brief Write current restart information (Field and constitutive data) to file. +! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_restartWrite + + integer :: i + integer(HID_T) :: fileHandle, groupHandle + character(len=pStringLen) :: fileName, datasetName + + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) + + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName,'a') + + call HDF5_write(fileHandle,crystallite_partitionedF,'F') + call HDF5_write(fileHandle,crystallite_Fp, 'F_p') + call HDF5_write(fileHandle,crystallite_Fi, 'F_i') + call HDF5_write(fileHandle,crystallite_Lp, 'L_p') + call HDF5_write(fileHandle,crystallite_Li, 'L_i') + call HDF5_write(fileHandle,crystallite_S, 'S') + + groupHandle = HDF5_addGroup(fileHandle,'phase') + do i = 1,size(material_name_phase) + write(datasetName,'(i0,a)') i,'_omega' + call HDF5_write(groupHandle,plasticState(i)%state,datasetName) + enddo + call HDF5_closeGroup(groupHandle) + + groupHandle = HDF5_addGroup(fileHandle,'homogenization') + do i = 1, size(material_name_homogenization) + write(datasetName,'(i0,a)') i,'_omega' + call HDF5_write(groupHandle,homogState(i)%state,datasetName) + enddo + call HDF5_closeGroup(groupHandle) + + call HDF5_closeFile(fileHandle) + +end subroutine crystallite_restartWrite + + +!-------------------------------------------------------------------------------------------------- +!> @brief Read data for restart +! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_restartRead + + integer :: i + integer(HID_T) :: fileHandle, groupHandle + character(len=pStringLen) :: fileName, datasetName + + print'(/,a,i0,a)', ' reading restart information of increment from file' + + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName) + + call HDF5_read(fileHandle,crystallite_F0, 'F') + call HDF5_read(fileHandle,crystallite_Fp0,'F_p') + call HDF5_read(fileHandle,crystallite_Fi0,'F_i') + call HDF5_read(fileHandle,crystallite_Lp0,'L_p') + call HDF5_read(fileHandle,crystallite_Li0,'L_i') + call HDF5_read(fileHandle,crystallite_S0, 'S') + + groupHandle = HDF5_openGroup(fileHandle,'phase') + do i = 1,size(material_name_phase) + write(datasetName,'(i0,a)') i,'_omega' + call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) + enddo + call HDF5_closeGroup(groupHandle) + + groupHandle = HDF5_openGroup(fileHandle,'homogenization') + do i = 1,size(material_name_homogenization) + write(datasetName,'(i0,a)') i,'_omega' + call HDF5_read(groupHandle,homogState(i)%state0,datasetName) + enddo + call HDF5_closeGroup(groupHandle) + + call HDF5_closeFile(fileHandle) + +end subroutine crystallite_restartRead + + +!-------------------------------------------------------------------------------------------------- +!> @brief Forward data after successful increment. +! ToDo: Any guessing for the current states possible? +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_forward + + integer :: i, j + + crystallite_F0 = crystallite_partitionedF + crystallite_Fp0 = crystallite_Fp + crystallite_Lp0 = crystallite_Lp + crystallite_Fi0 = crystallite_Fi + crystallite_Li0 = crystallite_Li + crystallite_S0 = crystallite_S + + do i = 1, size(plasticState) + plasticState(i)%state0 = plasticState(i)%state + enddo + do i = 1,size(material_name_homogenization) + homogState (i)%state0 = homogState (i)%state + damageState (i)%state0 = damageState (i)%state + enddo + +end subroutine crystallite_forward + end module constitutive diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 5378c4cbb..662dfa316 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -9,1631 +9,10 @@ !-------------------------------------------------------------------------------------------------- module crystallite - use prec - use parallelization - use IO - use HDF5_utilities - use DAMASK_interface - use config - use rotations - use math - use FEsolving - use material - use constitutive - use discretization - use lattice - use results - implicit none - private - real(pReal), dimension(:,:,:), allocatable, public :: & - crystallite_dt !< requested time increment of each grain - real(pReal), dimension(:,:,:), allocatable :: & - crystallite_subdt, & !< substepped time increment of each grain - crystallite_subFrac, & !< already calculated fraction of increment - crystallite_subStep !< size of next integration step - type(rotation), dimension(:,:,:), allocatable :: & - crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0, & !< def grad at start of FE inc - crystallite_subF, & !< def grad to be reached at end of crystallite inc - crystallite_subF0, & !< def grad at start of crystallite inc - ! - crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - ! - crystallite_Fp, & !< current plastic def grad (end of converged time step) - crystallite_Fp0, & !< plastic def grad at start of FE inc - crystallite_partitionedFp0,& !< plastic def grad at start of homog inc - crystallite_subFp0,& !< plastic def grad at start of crystallite inc - ! - crystallite_Fi, & !< current intermediate def grad (end of converged time step) - crystallite_Fi0, & !< intermediate def grad at start of FE inc - crystallite_partitionedFi0,& !< intermediate def grad at start of homog inc - crystallite_subFi0,& !< intermediate def grad at start of crystallite inc - ! - crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc - crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc - ! - crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) - crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc - crystallite_partitionedLi0, & !< intermediate velocity grad at start of homog inc - ! - crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc - crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & - crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) - crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) - crystallite_partitionedF0 !< def grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable, public :: & - crystallite_requested !< used by upper level (homogenization) to request crystallite calculation - logical, dimension(:,:,:), allocatable :: & - crystallite_converged !< convergence flag - type :: tOutput !< new requested output (per phase) - character(len=pStringLen), allocatable, dimension(:) :: & - label - end type tOutput - type(tOutput), allocatable, dimension(:) :: output_constituent - type :: tNumerics - integer :: & - iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp - nState, & !< state loop limit - nStress !< stress loop limit - real(pReal) :: & - subStepMinCryst, & !< minimum (relative) size of sub-step allowed during cutback - subStepSizeCryst, & !< size of first substep when cutback - subStepSizeLp, & !< size of first substep when cutback in Lp calculation - subStepSizeLi, & !< size of first substep when cutback in Li calculation - stepIncreaseCryst, & !< increase of next substep size when previous substep converged - rtol_crystalliteState, & !< relative tolerance in state loop - rtol_crystalliteStress, & !< relative tolerance in stress loop - atol_crystalliteStress !< absolute tolerance in stress loop - end type tNumerics - - type(tNumerics) :: num ! numerics parameters. Better name? - - type :: tDebugOptions - logical :: & - basic, & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debugCrystallite - - procedure(integrateStateFPI), pointer :: integrateState - - public :: & - crystallite_init, & - crystallite_stress, & - crystallite_stressTangent, & - crystallite_orientations, & - crystallite_push33ToRef, & - crystallite_results, & - crystallite_restartWrite, & - crystallite_restartRead, & - crystallite_forward, & - crystallite_initializeRestorationPoints, & - crystallite_windForward, & - crystallite_restore - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates and initialize per grain variables -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_init - - integer :: & - p, & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e, & !< counter in element loop - cMax, & !< maximum number of integration point components - iMax, & !< maximum number of integration points - eMax !< maximum number of elements - - - class(tNode), pointer :: & - num_crystallite, & - debug_crystallite, & ! pointer to debug options for crystallite - phases, & - phase, & - mech - - print'(/,a)', ' <<<+- crystallite init -+>>>' - - debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) - debugCrystallite%basic = debug_crystallite%contains('basic') - debugCrystallite%extensive = debug_crystallite%contains('extensive') - debugCrystallite%selective = debug_crystallite%contains('selective') - debugCrystallite%element = config_debug%get_asInt('element', defaultVal=1) - debugCrystallite%ip = config_debug%get_asInt('integrationpoint', defaultVal=1) - debugCrystallite%grain = config_debug%get_asInt('grain', defaultVal=1) - - cMax = homogenization_maxNconstituents - iMax = discretization_nIPs - eMax = discretization_Nelems - - allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) - - allocate(crystallite_S0, & - crystallite_F0, crystallite_Fi0,crystallite_Fp0, & - crystallite_Li0,crystallite_Lp0, & - crystallite_partitionedS0, & - crystallite_partitionedF0,crystallite_partitionedFp0,crystallite_partitionedFi0, & - crystallite_partitionedLp0,crystallite_partitionedLi0, & - crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Fi,crystallite_Fp, & - crystallite_Li,crystallite_Lp, & - crystallite_subF,crystallite_subF0, & - crystallite_subFp0,crystallite_subFi0, & - source = crystallite_partitionedF) - - allocate(crystallite_dt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_subdt,crystallite_subFrac,crystallite_subStep, & - source = crystallite_dt) - - allocate(crystallite_orientation(cMax,iMax,eMax)) - - allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) - allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) - - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) - - num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) - num%subStepSizeCryst = num_crystallite%get_asFloat ('subStepSize', defaultVal=0.25_pReal) - num%stepIncreaseCryst = num_crystallite%get_asFloat ('stepIncrease', defaultVal=1.5_pReal) - num%subStepSizeLp = num_crystallite%get_asFloat ('subStepSizeLp', defaultVal=0.5_pReal) - num%subStepSizeLi = num_crystallite%get_asFloat ('subStepSizeLi', defaultVal=0.5_pReal) - num%rtol_crystalliteState = num_crystallite%get_asFloat ('rtol_State', defaultVal=1.0e-6_pReal) - num%rtol_crystalliteStress = num_crystallite%get_asFloat ('rtol_Stress', defaultVal=1.0e-6_pReal) - num%atol_crystalliteStress = num_crystallite%get_asFloat ('atol_Stress', defaultVal=1.0e-8_pReal) - num%iJacoLpresiduum = num_crystallite%get_asInt ('iJacoLpresiduum', defaultVal=1) - num%nState = num_crystallite%get_asInt ('nState', defaultVal=20) - num%nStress = num_crystallite%get_asInt ('nStress', defaultVal=40) - - if(num%subStepMinCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepMinCryst') - if(num%subStepSizeCryst <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeCryst') - if(num%stepIncreaseCryst <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseCryst') - - if(num%subStepSizeLp <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLp') - if(num%subStepSizeLi <= 0.0_pReal) call IO_error(301,ext_msg='subStepSizeLi') - - if(num%rtol_crystalliteState <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState') - if(num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress') - if(num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress') - - if(num%iJacoLpresiduum < 1) call IO_error(301,ext_msg='iJacoLpresiduum') - - if(num%nState < 1) call IO_error(301,ext_msg='nState') - if(num%nStress< 1) call IO_error(301,ext_msg='nStress') - - select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) - case('FPI') - integrateState => integrateStateFPI - case('Euler') - integrateState => integrateStateEuler - case('AdaptiveEuler') - integrateState => integrateStateAdaptiveEuler - case('RK4') - integrateState => integrateStateRK4 - case('RKCK45') - integrateState => integrateStateRKCK45 - case default - call IO_error(301,ext_msg='integrator') - end select - - phases => config_material%get('phase') - - allocate(output_constituent(phases%length)) - do p = 1, phases%length - phase => phases%get(p) - mech => phase%get('mechanics',defaultVal = emptyDict) -#if defined(__GFORTRAN__) - output_constituent(p)%label = output_asStrings(mech) -#else - output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) -#endif - enddo - -#ifdef DEBUG - if (debugCrystallite%basic) then - print'(a42,1x,i10)', ' # of elements: ', eMax - print'(a42,1x,i10)', ' # of integration points/element: ', iMax - print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax - flush(IO_STDOUT) - endif -#endif - - !$OMP PARALLEL DO PRIVATE(i,c) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) - crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & - / math_det33(crystallite_Fp0(1:3,1:3,c,i,e))**(1.0_pReal/3.0_pReal) - crystallite_Fi0(1:3,1:3,c,i,e) = math_I3 - crystallite_F0(1:3,1:3,c,i,e) = math_I3 - crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(crystallite_Fi0(1:3,1:3,c,i,e), & - crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration - crystallite_Fp(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) - crystallite_Fi(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) - crystallite_requested(c,i,e) = .true. - enddo; enddo - enddo - !$OMP END PARALLEL DO - - - crystallite_partitionedFp0 = crystallite_Fp0 - crystallite_partitionedFi0 = crystallite_Fi0 - crystallite_partitionedF0 = crystallite_F0 - crystallite_partitionedF = crystallite_F0 - - call crystallite_orientations() - - !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - call constitutive_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & - crystallite_partitionedFp0(1:3,1:3,c,i,e), & - c,i,e) ! update dependent state variables to be consistent with basic states - enddo - enddo - enddo - !$OMP END PARALLEL DO - - -end subroutine crystallite_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate stress (P) -!-------------------------------------------------------------------------------------------------- -function crystallite_stress() - - logical, dimension(discretization_nIPs,discretization_Nelems) :: crystallite_stress - real(pReal) :: & - formerSubStep - integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e, & !< counter in element loop - s - logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains - real(pReal), dimension(:,:,:,:,:), allocatable :: & - subLp0,& !< plastic velocity grad at start of crystallite inc - subLi0 !< intermediate velocity grad at start of crystallite inc - - todo = .false. - - subLp0 = crystallite_partitionedLp0 - subLi0 = crystallite_partitionedLi0 - -!-------------------------------------------------------------------------------------------------- -! initialize to starting condition - crystallite_subStep = 0.0_pReal - !$OMP PARALLEL DO - elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then - plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) - - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phaseMemberAt(c,i,e)) - enddo - crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) - crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) - crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) - crystallite_subFrac(c,i,e) = 0.0_pReal - crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst - todo(c,i,e) = .true. - crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst - endif homogenizationRequestsCalculation - enddo; enddo - enddo elementLooping1 - !$OMP END PARALLEL DO - - NiterationCrystallite = 0 - cutbackLooping: do while (any(todo(:,FEsolving_execIP(1):FEsolving_execIP(2),FEsolving_execELem(1):FEsolving_execElem(2)))) - NiterationCrystallite = NiterationCrystallite + 1 - -#ifdef DEBUG - if (debugCrystallite%extensive) & - print'(a,i6)', '<< CRYST stress >> crystallite iteration ',NiterationCrystallite -#endif - !$OMP PARALLEL DO PRIVATE(formerSubStep) - elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) -!-------------------------------------------------------------------------------------------------- -! wind forward - if (crystallite_converged(c,i,e)) then - formerSubStep = crystallite_subStep(c,i,e) - crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e) - crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), & - num%stepIncreaseCryst * crystallite_subStep(c,i,e)) - - todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? - if (todo(c,i,e)) then - crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) - subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) - crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) - crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) - plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & - = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState( material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & - = sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) - enddo - endif - -!-------------------------------------------------------------------------------------------------- -! cut back (reduced time and restore) - else - crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) - crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) - crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) - crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) - if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,c,i,e) = subLp0(1:3,1:3,c,i,e) - crystallite_Li (1:3,1:3,c,i,e) = subLi0(1:3,1:3,c,i,e) - endif - plasticState (material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) & - = plasticState(material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState( material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & - = sourceState(material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) - enddo - - ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst ! still on track or already done (beyond repair) - endif - -!-------------------------------------------------------------------------------------------------- -! prepare for integration - if (todo(c,i,e)) then - crystallite_subF(1:3,1:3,c,i,e) = crystallite_subF0(1:3,1:3,c,i,e) & - + crystallite_subStep(c,i,e) *( crystallite_partitionedF (1:3,1:3,c,i,e) & - -crystallite_partitionedF0(1:3,1:3,c,i,e)) - crystallite_Fe(1:3,1:3,c,i,e) = matmul(crystallite_subF(1:3,1:3,c,i,e), & - math_inv33(matmul(crystallite_Fi(1:3,1:3,c,i,e), & - crystallite_Fp(1:3,1:3,c,i,e)))) - crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) - crystallite_converged(c,i,e) = .false. - call integrateState(c,i,e) - call integrateSourceState(c,i,e) - endif - - enddo - enddo - enddo elementLooping3 - !$OMP END PARALLEL DO - -!-------------------------------------------------------------------------------------------------- -! integrate --- requires fully defined state array (basic + dependent state) - where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further - todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation - enddo cutbackLooping - -! return whether converged or not - crystallite_stress = .false. - elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - crystallite_stress(i,e) = all(crystallite_converged(:,i,e)) - enddo - enddo elementLooping5 - -end function crystallite_stress - - -!-------------------------------------------------------------------------------------------------- -!> @brief Backup data for homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_initializeRestorationPoints(i,e) - - integer, intent(in) :: & - i, & !< integration point number - e !< element number - integer :: & - c, & !< constituent number - s - - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) - crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) - crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) - crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li0(1:3,1:3,c,i,e) - crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) - crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) - - plasticState(material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & - plasticState(material_phaseAt(c,e))%state0( :,material_phasememberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) - enddo - enddo - -end subroutine crystallite_initializeRestorationPoints - - -!-------------------------------------------------------------------------------------------------- -!> @brief Wind homog inc forward. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_windForward(i,e) - - integer, intent(in) :: & - i, & !< integration point number - e !< element number - integer :: & - c, & !< constituent number - s - - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) - crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) - crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) - crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) - crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) - - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%state (:,material_phasememberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%state (:,material_phasememberAt(c,i,e)) - enddo - enddo - -end subroutine crystallite_windForward - - -!-------------------------------------------------------------------------------------------------- -!> @brief Restore data after homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restore(i,e,includeL) - - integer, intent(in) :: & - i, & !< integration point number - e !< element number - logical, intent(in) :: & - includeL !< protect agains fake cutback - integer :: & - c !< constituent number - - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - if (includeL) then - crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) - crystallite_Li(1:3,1:3,c,i,e) = crystallite_partitionedLi0(1:3,1:3,c,i,e) - endif ! maybe protecting everything from overwriting makes more sense - crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) - crystallite_Fi(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) - crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) - - plasticState (material_phaseAt(c,e))%state( :,material_phasememberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) - enddo - -end subroutine crystallite_restore - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate tangent (dPdF). -!-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(c,i,e) result(dPdF) - - real(pReal), dimension(3,3,3,3) :: dPdF - integer, intent(in) :: & - c, & !< counter in constituent loop - i, & !< counter in integration point loop - e !< counter in element loop - integer :: & - o, & - p - - real(pReal), dimension(3,3) :: devNull, & - invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3, temp_33_4 - real(pReal), dimension(3,3,3,3) :: dSdFe, & - dSdF, & - dSdFi, & - dLidS, & ! tangent in lattice configuration - dLidFi, & - dLpdS, & - dLpdFi, & - dFidS, & - dFpinvdF, & - rhs_3333, & - lhs_3333, & - temp_3333 - real(pReal), dimension(9,9):: temp_99 - logical :: error - - - call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e),c,i,e) - call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e), & - c,i,e) - - invFp = math_inv33(crystallite_Fp(1:3,1:3,c,i,e)) - invFi = math_inv33(crystallite_Fi(1:3,1:3,c,i,e)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)) - - if (sum(abs(dLidS)) < tol_math_check) then - dFidS = 0.0_pReal - else - lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal - do o=1,3; do p=1,3 - lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) - lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & - + invFi*invFi(p,o) - rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) - enddo; enddo - call math_invert(temp_99,error,math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=e,ip=i,g=c, & - ext_msg='inversion error in analytic tangent calculation') - dFidS = 0.0_pReal - else - dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif - - call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration - dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS - -!-------------------------------------------------------------------------------------------------- -! calculate dSdF - temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,c,i,e),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,c,i,e),invFp), invSubFi0) - - do o=1,3; do p=1,3 - rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) - temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & - + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) - enddo; enddo - lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) & - + math_mul3333xx3333(dSdFi,dFidS) - - call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=e,ip=i,g=c, & - ext_msg='inversion error in analytic tangent calculation') - dSdF = rhs_3333 - else - dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - -!-------------------------------------------------------------------------------------------------- -! calculate dFpinvdF - temp_3333 = math_mul3333xx3333(dLpdS,dSdF) - do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(c,i,e) & - * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,c,i,e),transpose(invFp)) - temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,c,i,e),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,c,i,e)) - - dPdF = 0.0_pReal - do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(temp_33_2) - enddo - do o=1,3; do p=1,3 - dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,c,i,e), & - dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & - transpose(invFp)) & - + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo - -end function crystallite_stressTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates orientations -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations - - integer & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e !< counter in element loop - - !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - call crystallite_orientation(c,i,e)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,c,i,e)))) - enddo; enddo; enddo - !$OMP END PARALLEL DO - - nonlocalPresent: if (any(plasticState%nonlocal)) then - !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,e))%nonlocal) then - do i = FEsolving_execIP(1),FEsolving_execIP(2) - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,e)),i,e) - enddo - endif - enddo - !$OMP END PARALLEL DO - endif nonlocalPresent - -end subroutine crystallite_orientations - - -!-------------------------------------------------------------------------------------------------- -!> @brief Map 2nd order tensor to reference config -!-------------------------------------------------------------------------------------------------- -function crystallite_push33ToRef(ipc,ip,el, tensor33) - - real(pReal), dimension(3,3) :: crystallite_push33ToRef - real(pReal), dimension(3,3), intent(in) :: tensor33 - real(pReal), dimension(3,3) :: T - integer, intent(in):: & - el, & - ip, & - ipc - - T = matmul(material_orientation0(ipc,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) - crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) - -end function crystallite_push33ToRef - - -!-------------------------------------------------------------------------------------------------- -!> @brief writes crystallite results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_results - - integer :: p,o - real(pReal), allocatable, dimension(:,:,:) :: selected_tensors - real(pReal), allocatable, dimension(:,:) :: selected_rotations - character(len=:), allocatable :: group,structureLabel - - do p=1,size(material_name_phase) - group = trim('current/phase')//'/'//trim(material_name_phase(p))//'/mechanics' - - call results_closeGroup(results_addGroup(group)) - - do o = 1, size(output_constituent(p)%label) - select case (output_constituent(p)%label(o)) - case('F') - selected_tensors = select_tensors(crystallite_partitionedF,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'deformation gradient','1') - case('F_e') - selected_tensors = select_tensors(crystallite_Fe,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'elastic deformation gradient','1') - case('F_p') - selected_tensors = select_tensors(crystallite_Fp,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'plastic deformation gradient','1') - case('F_i') - selected_tensors = select_tensors(crystallite_Fi,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'inelastic deformation gradient','1') - case('L_p') - selected_tensors = select_tensors(crystallite_Lp,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'plastic velocity gradient','1/s') - case('L_i') - selected_tensors = select_tensors(crystallite_Li,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'inelastic velocity gradient','1/s') - case('P') - selected_tensors = select_tensors(crystallite_P,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'First Piola-Kirchhoff stress','Pa') - case('S') - selected_tensors = select_tensors(crystallite_S,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'Second Piola-Kirchhoff stress','Pa') - case('O') - select case(lattice_structure(p)) - case(lattice_ISO_ID) - structureLabel = 'aP' - case(lattice_FCC_ID) - structureLabel = 'cF' - case(lattice_BCC_ID) - structureLabel = 'cI' - case(lattice_BCT_ID) - structureLabel = 'tI' - case(lattice_HEX_ID) - structureLabel = 'hP' - case(lattice_ORT_ID) - structureLabel = 'oP' - end select - selected_rotations = select_rotations(crystallite_orientation,p) - call results_writeDataset(group,selected_rotations,output_constituent(p)%label(o),& - 'crystal orientation as quaternion','q_0 ') - call results_addAttribute('Lattice',structureLabel,group//'/'//output_constituent(p)%label(o)) - end select - enddo - enddo - - contains - - !------------------------------------------------------------------------------------------------ - !> @brief select tensors for output - !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,instance) - - integer, intent(in) :: instance - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: e,i,c,j - - allocate(select_tensors(3,3,count(material_phaseAt==instance)*discretization_nIPs)) - - j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then - j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) - endif - enddo - enddo - enddo - - end function select_tensors - - -!-------------------------------------------------------------------------------------------------- -!> @brief select rotations for output -!-------------------------------------------------------------------------------------------------- - function select_rotations(dataset,instance) - - integer, intent(in) :: instance - type(rotation), dimension(:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:) :: select_rotations - integer :: e,i,c,j - - allocate(select_rotations(4,count(material_phaseAt==instance)*homogenization_maxNconstituents*discretization_nIPs)) - - j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then - j = j + 1 - select_rotations(1:4,j) = dataset(c,i,e)%asQuaternion() - endif - enddo - enddo - enddo - - end function select_rotations - -end subroutine crystallite_results - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculation of stress (P) with time integration based on a residuum in Lp and -!> intermediate acceleration of the Newton-Raphson correction -!-------------------------------------------------------------------------------------------------- -function integrateStress(ipc,ip,el,timeFraction) result(broken) - - integer, intent(in):: el, & ! element index - ip, & ! integration point index - ipc ! grain index - real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep - - real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep - Fp_new, & ! plastic deformation gradient at end of timestep - invFp_new, & ! inverse of Fp_new - invFp_current, & ! inverse of Fp_current - Lpguess, & ! current guess for plastic velocity gradient - Lpguess_old, & ! known last good guess for plastic velocity gradient - Lp_constitutive, & ! plastic velocity gradient resulting from constitutive law - residuumLp, & ! current residuum of plastic velocity gradient - residuumLp_old, & ! last residuum of plastic velocity gradient - deltaLp, & ! direction of next guess - Fi_new, & ! gradient of intermediate deformation stages - invFi_new, & - invFi_current, & ! inverse of Fi_current - Liguess, & ! current guess for intermediate velocity gradient - Liguess_old, & ! known last good guess for intermediate velocity gradient - Li_constitutive, & ! intermediate velocity gradient resulting from constitutive law - residuumLi, & ! current residuum of intermediate velocity gradient - residuumLi_old, & ! last residuum of intermediate velocity gradient - deltaLi, & ! direction of next guess - Fe, & ! elastic deformation gradient - S, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration - A, & - B, & - temp_33 - real(pReal), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK - integer, dimension(9) :: devNull_9 ! needed for matrix inversion by LAPACK - real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme) - dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme) - real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress - dS_dFi, & - dFe_dLp, & ! partial derivative of elastic deformation gradient - dFe_dLi, & - dFi_dLi, & - dLp_dFi, & - dLi_dFi, & - dLp_dS, & - dLi_dS - real(pReal) steplengthLp, & - steplengthLi, & - dt, & ! time increment - atol_Lp, & - atol_Li, & - devNull - integer NiterationStressLp, & ! number of stress integrations - NiterationStressLi, & ! number of inner stress integrations - ierr, & ! error indicator for LAPACK - o, & - p, & - jacoCounterLp, & - jacoCounterLi ! counters to check for Jacobian update - logical :: error,broken - - broken = .true. - - if (present(timeFraction)) then - dt = crystallite_subdt(ipc,ip,el) * timeFraction - F = crystallite_subF0(1:3,1:3,ipc,ip,el) & - + (crystallite_subF(1:3,1:3,ipc,ip,el) - crystallite_subF0(1:3,1:3,ipc,ip,el)) * timeFraction - else - dt = crystallite_subdt(ipc,ip,el) - F = crystallite_subF(1:3,1:3,ipc,ip,el) - endif - - call constitutive_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & - crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) - - Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess - Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! take as first guess - - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) - if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,ipc,ip,el)) - if (error) return ! error - - A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp - - jacoCounterLi = 0 - steplengthLi = 1.0_pReal - residuumLi_old = 0.0_pReal - Liguess_old = Liguess - - NiterationStressLi = 0 - LiLoop: do - NiterationStressLi = NiterationStressLi + 1 - if (NiterationStressLi>num%nStress) return ! error - - invFi_new = matmul(invFi_current,math_I3 - dt*Liguess) - Fi_new = math_inv33(invFi_new) - - jacoCounterLp = 0 - steplengthLp = 1.0_pReal - residuumLp_old = 0.0_pReal - Lpguess_old = Lpguess - - NiterationStressLp = 0 - LpLoop: do - NiterationStressLp = NiterationStressLp + 1 - if (NiterationStressLp>num%nStress) return ! error - - B = math_I3 - dt*Lpguess - Fe = matmul(matmul(A,B), invFi_new) - call constitutive_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi_new, ipc, ip, el) - - call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - S, Fi_new, ipc, ip, el) - - !* update current residuum and check for convergence of loop - atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error - num%atol_crystalliteStress) ! minimum lower cutoff - residuumLp = Lpguess - Lp_constitutive - - if (any(IEEE_is_NaN(residuumLp))) then - return ! error - elseif (norm2(residuumLp) < atol_Lp) then ! converged if below absolute tolerance - exit LpLoop - elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... - residuumLp_old = residuumLp ! ...remember old values and... - Lpguess_old = Lpguess - steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) - else ! not converged and residuum not improved... - steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction - Lpguess = Lpguess_old & - + deltaLp * stepLengthLp - cycle LpLoop - endif - - calculateJacobiLi: if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then - jacoCounterLp = jacoCounterLp + 1 - - do o=1,3; do p=1,3 - dFe_dLp(o,1:3,p,1:3) = - dt * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - enddo; enddo - dRLp_dLp = math_eye(9) & - - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) - temp_9 = math_33to9(residuumLp) - call dgesv(9,1,dRLp_dLp,9,devNull_9,temp_9,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp - if (ierr /= 0) return ! error - deltaLp = - math_9to33(temp_9) - endif calculateJacobiLi - - Lpguess = Lpguess & - + deltaLp * steplengthLp - enddo LpLoop - - call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - S, Fi_new, ipc, ip, el) - - !* update current residuum and check for convergence of loop - atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error - num%atol_crystalliteStress) ! minimum lower cutoff - residuumLi = Liguess - Li_constitutive - if (any(IEEE_is_NaN(residuumLi))) then - return ! error - elseif (norm2(residuumLi) < atol_Li) then ! converged if below absolute tolerance - exit LiLoop - elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... - residuumLi_old = residuumLi ! ...remember old values and... - Liguess_old = Liguess - steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) - else ! not converged and residuum not improved... - steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction - Liguess = Liguess_old & - + deltaLi * steplengthLi - cycle LiLoop - endif - - calculateJacobiLp: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then - jacoCounterLi = jacoCounterLi + 1 - - temp_33 = matmul(matmul(A,B),invFi_current) - do o=1,3; do p=1,3 - dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current - enddo; enddo - do o=1,3; do p=1,3 - dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) - enddo; enddo - dRLi_dLi = math_eye(9) & - - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) & - + math_mul3333xx3333(dS_dFi, dFi_dLi))) & - - math_3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) - temp_9 = math_33to9(residuumLi) - call dgesv(9,1,dRLi_dLi,9,devNull_9,temp_9,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li - if (ierr /= 0) return ! error - deltaLi = - math_9to33(temp_9) - endif calculateJacobiLp - - Liguess = Liguess & - + deltaLi * steplengthLi - enddo LiLoop - - invFp_new = matmul(invFp_current,B) - call math_invert33(Fp_new,devNull,error,invFp_new) - if (error) return ! error - - crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,ipc,ip,el) = S - crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess - crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess - crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize - crystallite_Fi (1:3,1:3,ipc,ip,el) = Fi_new - crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) - broken = .false. - -end function integrateStress - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - NiterationState, & !< number of iterations in state loop - p, & - c, & - s, & - size_pl - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & - r ! state residuum - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - size_pl = plasticState(p)%sizeDotState - plasticState(p)%state(1:size_pl,c) = plasticState(p)%subState0(1:size_pl,c) & - + plasticState(p)%dotState (1:size_pl,c) & - * crystallite_subdt(g,i,e) - plastic_dotState(1:size_pl,2) = 0.0_pReal - - iteration: do NiterationState = 1, num%nState - - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) - - broken = integrateStress(g,i,e) - if(broken) exit iteration - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) exit iteration - - zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& - plastic_dotState(1:size_pl,2)) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & - + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(p)%state (1:size_pl,c) & - - plasticState(p)%subState0(1:size_pl,c) & - - plasticState(p)%dotState (1:size_pl,c) * crystallite_subdt(g,i,e) - plasticState(p)%state(1:size_pl,c) = plasticState(p)%state(1:size_pl,c) & - - r(1:size_pl) - crystallite_converged(g,i,e) = converged(r(1:size_pl), & - plasticState(p)%state(1:size_pl,c), & - plasticState(p)%atol(1:size_pl)) - - if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) - exit iteration - endif - - enddo iteration - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end subroutine integrateStateFPI - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -subroutine integrateSourceState(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - NiterationState, & !< number of iterations in state loop - p, & - c, & - s, & - size_pl - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) - if(broken) return - - do s = 1, phase_Nsources(p) - size_so(s) = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%subState0(1:size_so(s),c) & - + sourceState(p)%p(s)%dotState (1:size_so(s),c) & - * crystallite_subdt(g,i,e) - source_dotState(1:size_so(s),2,s) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do s = 1, phase_Nsources(p) - if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) - source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) - enddo - - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) - if(broken) exit iteration - - do s = 1, phase_Nsources(p) - zeta = damper(sourceState(p)%p(s)%dotState(:,c), & - source_dotState(1:size_so(s),1,s),& - source_dotState(1:size_so(s),2,s)) - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & - + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) - r(1:size_so(s)) = sourceState(p)%p(s)%state (1:size_so(s),c) & - - sourceState(p)%p(s)%subState0(1:size_so(s),c) & - - sourceState(p)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%state(1:size_so(s),c) & - - r(1:size_so(s)) - crystallite_converged(g,i,e) = & - crystallite_converged(g,i,e) .and. converged(r(1:size_so(s)), & - sourceState(p)%p(s)%state(1:size_so(s),c), & - sourceState(p)%p(s)%atol(1:size_so(s))) - enddo - - if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState_source(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) - exit iteration - endif - - enddo iteration - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end subroutine integrateSourceState - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate state with 1st order explicit Euler method -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - p, & - c, & - sizeDotState - logical :: & - broken - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken - -end subroutine integrateStateEuler - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with 1st order Euler method with adaptive step size -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - p, & - c, & - sizeDotState - logical :: & - broken - - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic - - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - - residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - if(broken) return - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - - sizeDotState = plasticState(p)%sizeDotState - crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) - -end subroutine integrateStateAdaptiveEuler - - -!--------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with the classic Runge Kutta method -!--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(g,i,e) - - integer, intent(in) :: g,i,e - - real(pReal), dimension(3,3), parameter :: & - A = reshape([& - 0.5_pReal, 0.0_pReal, 0.0_pReal, & - 0.0_pReal, 0.5_pReal, 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal],& - shape(A)) - real(pReal), dimension(3), parameter :: & - C = [0.5_pReal, 0.5_pReal, 1.0_pReal] - real(pReal), dimension(4), parameter :: & - B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - - call integrateStateRK(g,i,e,A,B,C) - -end subroutine integrateStateRK4 - - -!--------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with the Cash-Carp method -!--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(g,i,e) - - integer, intent(in) :: g,i,e - - real(pReal), dimension(5,5), parameter :: & - A = reshape([& - 1._pReal/5._pReal, .0_pReal, .0_pReal, .0_pReal, .0_pReal, & - 3._pReal/40._pReal, 9._pReal/40._pReal, .0_pReal, .0_pReal, .0_pReal, & - 3_pReal/10._pReal, -9._pReal/10._pReal, 6._pReal/5._pReal, .0_pReal, .0_pReal, & - -11._pReal/54._pReal, 5._pReal/2._pReal, -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal, .0_pReal, & - 1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],& - shape(A)) - real(pReal), dimension(5), parameter :: & - C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal] - real(pReal), dimension(6), parameter :: & - B = & - [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, & - 125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], & - DB = B - & - [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& - 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - - call integrateStateRK(g,i,e,A,B,C,DB) - -end subroutine integrateStateRKCK45 - - -!-------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an -!! embedded explicit Runge-Kutta method -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(g,i,e,A,B,CC,DB) - - - real(pReal), dimension(:,:), intent(in) :: A - real(pReal), dimension(:), intent(in) :: B, CC - real(pReal), dimension(:), intent(in), optional :: DB - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - stage, & ! stage index in integration stage loop - n, & - p, & - c, & - sizeDotState - logical :: & - broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - do stage = 1,size(A,1) - sizeDotState = plasticState(p)%sizeDotState - plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) - plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) - - do n = 2, stage - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & - + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) - enddo - - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - - broken = integrateStress(g,i,e,CC(stage)) - if(broken) exit - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) - if(broken) exit - - enddo - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - - plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (p)%dotState(:,c) - plasticState(p)%dotState(:,c) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - if(present(DB)) & - broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & - * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) - - if(broken) return - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken - - -end subroutine integrateStateRK - - -!-------------------------------------------------------------------------------------------------- -!> @brief determines whether a point is converged -!-------------------------------------------------------------------------------------------------- -logical pure function converged(residuum,state,atol) - - real(pReal), intent(in), dimension(:) ::& - residuum, state, atol - real(pReal) :: & - rTol - - rTol = num%rTol_crystalliteState - - converged = all(abs(residuum) <= max(atol, rtol*abs(state))) - -end function converged - - -!-------------------------------------------------------------------------------------------------- -!> @brief Write current restart information (Field and constitutive data) to file. -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartWrite - - integer :: i - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'a') - - call HDF5_write(fileHandle,crystallite_partitionedF,'F') - call HDF5_write(fileHandle,crystallite_Fp, 'F_p') - call HDF5_write(fileHandle,crystallite_Fi, 'F_i') - call HDF5_write(fileHandle,crystallite_Lp, 'L_p') - call HDF5_write(fileHandle,crystallite_Li, 'L_i') - call HDF5_write(fileHandle,crystallite_S, 'S') - - groupHandle = HDF5_addGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,plasticState(i)%state,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do i = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,homogState(i)%state,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartWrite - - -!-------------------------------------------------------------------------------------------------- -!> @brief Read data for restart -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartRead - - integer :: i - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print'(/,a,i0,a)', ' reading restart information of increment from file' - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) - - call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_Fp0,'F_p') - call HDF5_read(fileHandle,crystallite_Fi0,'F_i') - call HDF5_read(fileHandle,crystallite_Lp0,'L_p') - call HDF5_read(fileHandle,crystallite_Li0,'L_i') - call HDF5_read(fileHandle,crystallite_S0, 'S') - - groupHandle = HDF5_openGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do i = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,homogState(i)%state0,datasetName) - enddo - call HDF5_closeGroup(groupHandle) - - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartRead - - -!-------------------------------------------------------------------------------------------------- -!> @brief Forward data after successful increment. -! ToDo: Any guessing for the current states possible? -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_forward - - integer :: i, j - - crystallite_F0 = crystallite_partitionedF - crystallite_Fp0 = crystallite_Fp - crystallite_Lp0 = crystallite_Lp - crystallite_Fi0 = crystallite_Fi - crystallite_Li0 = crystallite_Li - crystallite_S0 = crystallite_S - - do i = 1, size(plasticState) - plasticState(i)%state0 = plasticState(i)%state - enddo - do i = 1,size(material_name_homogenization) - homogState (i)%state0 = homogState (i)%state - damageState (i)%state0 = damageState (i)%state - enddo - -end subroutine crystallite_forward end module crystallite From 93b9677ec82cef8a3a069733df186d71f139776d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 11:24:29 +0100 Subject: [PATCH 043/214] not needed anymore --- src/CPFEM.f90 | 1 - src/CPFEM2.f90 | 1 - src/commercialFEM_fileList.f90 | 1 - src/crystallite.f90 | 18 ------------------ src/damage_nonlocal.f90 | 1 - src/homogenization.f90 | 1 - src/thermal_conduction.f90 | 1 - 7 files changed, 24 deletions(-) delete mode 100644 src/crystallite.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 6fc58ea0f..fe8c7d1b3 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -13,7 +13,6 @@ module CPFEM use discretization_marc use material use config - use crystallite use homogenization use IO use discretization diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 325a8791e..636962948 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -21,7 +21,6 @@ module CPFEM2 use HDF5_utilities use homogenization use constitutive - use crystallite #if defined(Mesh) use FEM_quadrature use discretization_mesh diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a5bbe69ca..08e7b9c1c 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -44,7 +44,6 @@ #include "source_damage_anisoDuctile.f90" #include "kinematics_cleavage_opening.f90" #include "kinematics_slipplane_opening.f90" -#include "crystallite.f90" #include "thermal_isothermal.f90" #include "thermal_conduction.f90" #include "damage_none.f90" diff --git a/src/crystallite.f90 b/src/crystallite.f90 deleted file mode 100644 index 662dfa316..000000000 --- a/src/crystallite.f90 +++ /dev/null @@ -1,18 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH -!> @author Chen Zhang, Michigan State University -!> @brief crystallite state integration functions and reporting of results -!-------------------------------------------------------------------------------------------------- - -module crystallite - - - - - - -end module crystallite diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index c4426f185..ac4d8636a 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -7,7 +7,6 @@ module damage_nonlocal use material use config use YAML_types - use crystallite use lattice use constitutive use results diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 4da567e4c..cbab8e468 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -11,7 +11,6 @@ module homogenization use math use material use constitutive - use crystallite use FEsolving use discretization use thermal_isothermal diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 37a407101..d30e50677 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -8,7 +8,6 @@ module thermal_conduction use config use lattice use results - use crystallite use constitutive use YAML_types From 55d14fbfa8439f227c97deb589e03e0e0eca4fad Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 16:32:33 +0100 Subject: [PATCH 044/214] separating --- src/constitutive.f90 | 141 ++++++-------------------------------- src/constitutive_mech.f90 | 123 +++++++++++++++++++++++++++++++++ 2 files changed, 144 insertions(+), 120 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 360fb09f1..2845e45b7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -147,6 +147,27 @@ module constitutive module subroutine thermal_init end subroutine thermal_init + module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in) :: & + subdt !< timestep + real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & + FArray, & !< elastic deformation gradient + FpArray !< plastic deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) + + logical :: broken +end function constitutive_collectDotState + module function plastic_active(plastic_label) result(active_plastic) character(len=*), intent(in) :: plastic_label @@ -165,67 +186,6 @@ module constitutive logical, dimension(:,:), allocatable :: active_kinematics end function kinematics_active - module subroutine plastic_isotropic_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_isotropic_dotState - - module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_phenopowerlaw_dotState - - module subroutine plastic_kinehardening_dotState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_kinehardening_dotState - - module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_dislotwin_dotState - - module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - real(pReal), intent(in) :: & - T - integer, intent(in) :: & - instance, & - of - end subroutine plastic_disloTungsten_dotState - - module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - instance,of,ip,el) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F, & !< deformation gradient - Fp !< plastic deformation gradient - real(pReal), intent(in) :: & - Temperature, & !< temperature - timestep !< substepped crystallite time increment - integer, intent(in) :: & - instance, & - of, & - ip, & !< current integration point - el !< current element number - end subroutine plastic_nonlocal_dotState - module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) integer, intent(in) :: & @@ -694,66 +654,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & end subroutine constitutive_LiAndItsTangents -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - phase, & - of - real(pReal), intent(in) :: & - subdt !< timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FArray, & !< elastic deformation gradient - FpArray !< plastic deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) - real(pReal), dimension(3,3) :: & - Mp - integer :: & - ho, & !< homogenization - tme, & !< thermal member position - i, & !< counter in source loop - instance - logical :: broken - - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - instance = phase_plasticityInstance(phase) - - Mp = matmul(matmul(transpose(Fi),Fi),S) - - plasticityType: select case (phase_plasticity(phase)) - - case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_dotState(Mp,instance,of) - - case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_dotState(Mp,instance,of) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_dotState(Mp,instance,of) - - case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dotState(Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & - instance,of,ip,el) - end select plasticityType - broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) - - -end function constitutive_collectDotState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6b3c6fce6..b7c14e68d 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -133,6 +133,67 @@ submodule(constitutive) constitutive_mech el !< current element number end subroutine plastic_nonlocal_LpAndItsTangent + module subroutine plastic_isotropic_dotState(Mp,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + instance, & + of + end subroutine plastic_isotropic_dotState + + module subroutine plastic_phenopowerlaw_dotState(Mp,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + instance, & + of + end subroutine plastic_phenopowerlaw_dotState + + module subroutine plastic_kinehardening_dotState(Mp,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + instance, & + of + end subroutine plastic_kinehardening_dotState + + module subroutine plastic_dislotwin_dotState(Mp,T,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + instance, & + of + end subroutine plastic_dislotwin_dotState + + module subroutine plastic_disloTungsten_dotState(Mp,T,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + T + integer, intent(in) :: & + instance, & + of + end subroutine plastic_disloTungsten_dotState + + module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & + instance,of,ip,el) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< MandelStress + real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & + F, & !< deformation gradient + Fp !< plastic deformation gradient + real(pReal), intent(in) :: & + Temperature, & !< temperature + timestep !< substepped crystallite time increment + integer, intent(in) :: & + instance, & + of, & + ip, & !< current integration point + el !< current element number + end subroutine plastic_nonlocal_dotState + module subroutine plastic_dislotwin_dependentState(T,instance,of) integer, intent(in) :: & @@ -454,6 +515,68 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & end subroutine constitutive_plastic_LpAndItsTangents +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in) :: & + subdt !< timestep + real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & + FArray, & !< elastic deformation gradient + FpArray !< plastic deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) + real(pReal), dimension(3,3) :: & + Mp + integer :: & + ho, & !< homogenization + tme, & !< thermal member position + i, & !< counter in source loop + instance + logical :: broken + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + instance = phase_plasticityInstance(phase) + + Mp = matmul(matmul(transpose(Fi),Fi),S) + + plasticityType: select case (phase_plasticity(phase)) + + case (PLASTICITY_ISOTROPIC_ID) plasticityType + call plastic_isotropic_dotState(Mp,instance,of) + + case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType + call plastic_phenopowerlaw_dotState(Mp,instance,of) + + case (PLASTICITY_KINEHARDENING_ID) plasticityType + call plastic_kinehardening_dotState(Mp,instance,of) + + case (PLASTICITY_DISLOTWIN_ID) plasticityType + call plastic_dislotwin_dotState(Mp,temperature(ho)%p(tme),instance,of) + + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType + call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) + + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_dotState(Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & + instance,of,ip,el) + end select plasticityType + broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) + + +end function constitutive_collectDotState + + !-------------------------------------------------------------------------------------------- !> @brief writes plasticity constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------- From d92a732dcc9f12073f8227a365ff378245902b80 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 17:11:43 +0100 Subject: [PATCH 045/214] mech/plastic only --- src/constitutive.f90 | 94 +++++---------------------- src/constitutive_mech.f90 | 74 +++++++++++++++++++++ src/constitutive_plastic_nonlocal.f90 | 5 +- 3 files changed, 95 insertions(+), 78 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 2845e45b7..b7c2e08eb 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -13,8 +13,6 @@ module constitutive use results use lattice use discretization - use geometry_plastic_nonlocal, only: & - geometry_plastic_nonlocal_disable use parallelization use HDF5_utilities use DAMASK_interface @@ -169,6 +167,24 @@ module constitutive end function constitutive_collectDotState +module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress + Fi !< intermediate deformation gradient + logical :: & + broken + + +end function constitutive_deltaState + + module function plastic_active(plastic_label) result(active_plastic) character(len=*), intent(in) :: plastic_label logical, dimension(:), allocatable :: active_plastic @@ -309,24 +325,6 @@ end function constitutive_collectDotState end subroutine kinematics_thermal_expansion_LiAndItsTangent - module subroutine plastic_kinehardening_deltaState(Mp,instance,of) - real(pReal), dimension(3,3), intent(in) :: & - Mp !< Mandel stress - integer, intent(in) :: & - instance, & - of - end subroutine plastic_kinehardening_deltaState - - module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) - real(pReal), dimension(3,3), intent(in) :: & - Mp - integer, intent(in) :: & - instance, & - of, & - ip, & - el - end subroutine plastic_nonlocal_deltaState - module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -702,62 +700,6 @@ function constitutive_collectDotState_source(S, ipc, ip, el,phase,of) result(bro end function constitutive_collectDotState_source -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) - - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - phase, & - of - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), dimension(3,3) :: & - Mp - integer :: & - instance, & - myOffset, & - mySize - logical :: & - broken - - Mp = matmul(matmul(transpose(Fi),Fi),S) - instance = phase_plasticityInstance(phase) - - plasticityType: select case (phase_plasticity(phase)) - - case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_deltaState(Mp,instance,of) - broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) - - case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) - broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) - - case default - broken = .false. - - end select plasticityType - - if(.not. broken) then - select case(phase_plasticity(phase)) - case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID) - - myOffset = plasticState(phase)%offsetDeltaState - mySize = plasticState(phase)%sizeDeltaState - plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) = & - plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) + plasticState(phase)%deltaState(1:mySize,of) - end select - endif - -end function constitutive_deltaState - - !-------------------------------------------------------------------------------------------------- !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index b7c14e68d..cab4a17d8 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -220,6 +220,24 @@ submodule(constitutive) constitutive_mech el !< current element number end subroutine plastic_nonlocal_dependentState + module subroutine plastic_kinehardening_deltaState(Mp,instance,of) + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + integer, intent(in) :: & + instance, & + of + end subroutine plastic_kinehardening_deltaState + + module subroutine plastic_nonlocal_deltaState(Mp,instance,of,ip,el) + real(pReal), dimension(3,3), intent(in) :: & + Mp + integer, intent(in) :: & + instance, & + of, & + ip, & + el + end subroutine plastic_nonlocal_deltaState + module subroutine plastic_isotropic_results(instance,group) integer, intent(in) :: instance character(len=*), intent(in) :: group @@ -577,6 +595,62 @@ function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el end function constitutive_collectDotState +!-------------------------------------------------------------------------------------------------- +!> @brief for constitutive models having an instantaneous change of state +!> will return false if delta state is not needed/supported by the constitutive model +!-------------------------------------------------------------------------------------------------- +function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress + Fi !< intermediate deformation gradient + real(pReal), dimension(3,3) :: & + Mp + integer :: & + instance, & + myOffset, & + mySize + logical :: & + broken + + Mp = matmul(matmul(transpose(Fi),Fi),S) + instance = phase_plasticityInstance(phase) + + plasticityType: select case (phase_plasticity(phase)) + + case (PLASTICITY_KINEHARDENING_ID) plasticityType + call plastic_kinehardening_deltaState(Mp,instance,of) + broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) + + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) + broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) + + case default + broken = .false. + + end select plasticityType + + if(.not. broken) then + select case(phase_plasticity(phase)) + case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID) + + myOffset = plasticState(phase)%offsetDeltaState + mySize = plasticState(phase)%sizeDeltaState + plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) = & + plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) + plasticState(phase)%deltaState(1:mySize,of) + end select + endif + +end function constitutive_deltaState + + !-------------------------------------------------------------------------------------------- !> @brief writes plasticity constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------- diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index ce9e4e391..65f74b6cc 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -10,7 +10,8 @@ submodule(constitutive:constitutive_mech) plastic_nonlocal IPneighborhood => geometry_plastic_nonlocal_IPneighborhood, & IPvolume => geometry_plastic_nonlocal_IPvolume0, & IParea => geometry_plastic_nonlocal_IParea0, & - IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0 + IPareaNormal => geometry_plastic_nonlocal_IPareaNormal0, & + geometry_plastic_nonlocal_disable real(pReal), parameter :: & kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin @@ -195,7 +196,7 @@ module function plastic_nonlocal_init() result(myPlasticity) call geometry_plastic_nonlocal_disable return endif - + print*, 'Reuber et al., Acta Materialia 71:333–348, 2014' print*, 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL From 0f8396c9d350577a9ecf2a056eb79269882970b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 18:22:04 +0100 Subject: [PATCH 046/214] cleaning --- src/constitutive.f90 | 27 +++++++++------------------ 1 file changed, 9 insertions(+), 18 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b7c2e08eb..d95eb5c0a 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -25,7 +25,6 @@ module constitutive crystallite_dt !< requested time increment of each grain real(pReal), dimension(:,:,:), allocatable :: & crystallite_subdt, & !< substepped time increment of each grain - crystallite_subFrac, & !< already calculated fraction of increment crystallite_subStep !< size of next integration step type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation @@ -853,12 +852,7 @@ subroutine crystallite_init print'(/,a)', ' <<<+- crystallite init -+>>>' debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) - debugCrystallite%basic = debug_crystallite%contains('basic') debugCrystallite%extensive = debug_crystallite%contains('extensive') - debugCrystallite%selective = debug_crystallite%contains('selective') - debugCrystallite%element = config_debug%get_asInt('element', defaultVal=1) - debugCrystallite%ip = config_debug%get_asInt('integrationpoint', defaultVal=1) - debugCrystallite%grain = config_debug%get_asInt('grain', defaultVal=1) cMax = homogenization_maxNconstituents iMax = discretization_nIPs @@ -880,7 +874,7 @@ subroutine crystallite_init source = crystallite_partitionedF) allocate(crystallite_dt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_subdt,crystallite_subFrac,crystallite_subStep, & + allocate(crystallite_subdt,crystallite_subStep, & source = crystallite_dt) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -946,14 +940,10 @@ subroutine crystallite_init #endif enddo -#ifdef DEBUG - if (debugCrystallite%basic) then - print'(a42,1x,i10)', ' # of elements: ', eMax - print'(a42,1x,i10)', ' # of integration points/element: ', iMax - print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax - flush(IO_STDOUT) - endif -#endif + print'(a42,1x,i10)', ' # of elements: ', eMax + print'(a42,1x,i10)', ' # of integration points/element: ', iMax + print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax + flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(i,c) do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1011,6 +1001,7 @@ function crystallite_stress() e, & !< counter in element loop s logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains + real(pReal), dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: subFrac !ToDo: need to set some values to false for different Ngrains real(pReal), dimension(:,:,:,:,:), allocatable :: & subLp0,& !< plastic velocity grad at start of crystallite inc subLi0 !< intermediate velocity grad at start of crystallite inc @@ -1037,7 +1028,7 @@ function crystallite_stress() crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) - crystallite_subFrac(c,i,e) = 0.0_pReal + subFrac(c,i,e) = 0.0_pReal crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst todo(c,i,e) = .true. crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst @@ -1062,8 +1053,8 @@ function crystallite_stress() ! wind forward if (crystallite_converged(c,i,e)) then formerSubStep = crystallite_subStep(c,i,e) - crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e) - crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), & + subFrac(c,i,e) = subFrac(c,i,e) + crystallite_subStep(c,i,e) + crystallite_subStep(c,i,e) = min(1.0_pReal - subFrac(c,i,e), & num%stepIncreaseCryst * crystallite_subStep(c,i,e)) todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? From d0b267b240cd619db243777682242174fdc57beb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 18:24:35 +0100 Subject: [PATCH 047/214] there are module functions --- src/constitutive_mech.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index cab4a17d8..8f08aa08e 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -536,7 +536,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) +module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -599,7 +599,7 @@ end function constitutive_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) +module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point From 58f800cf3083be700b4eec0baf5a1dddeb6a2b25 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 20 Dec 2020 20:20:39 +0100 Subject: [PATCH 048/214] introduce new structure --- src/constitutive.f90 | 136 ++++++++++++++++++++++++++++--------------- 1 file changed, 88 insertions(+), 48 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index d95eb5c0a..14dde1c9f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -21,7 +21,7 @@ module constitutive implicit none private - real(pReal), dimension(:,:,:), allocatable, public :: & + real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain real(pReal), dimension(:,:,:), allocatable :: & crystallite_subdt, & !< substepped time increment of each grain @@ -40,9 +40,6 @@ module constitutive crystallite_partitionedFp0,& !< plastic def grad at start of homog inc crystallite_subFp0,& !< plastic def grad at start of crystallite inc ! - crystallite_Fi, & !< current intermediate def grad (end of converged time step) - crystallite_Fi0, & !< intermediate def grad at start of FE inc - crystallite_partitionedFi0,& !< intermediate def grad at start of homog inc crystallite_subFi0,& !< intermediate def grad at start of crystallite inc ! crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc @@ -73,6 +70,15 @@ module constitutive end type tOutput type(tOutput), allocatable, dimension(:) :: output_constituent + type :: tTensorContainer + real(pReal), dimension(:,:,:), allocatable :: data + end type + + type(tTensorContainer), dimension(:), allocatable :: & + constitutive_mech_Fi, & + constitutive_mech_Fi0, & + constitutive_mech_partionedFi0 + type :: tNumerics integer :: & iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp @@ -833,7 +839,9 @@ end subroutine constitutive_results subroutine crystallite_init integer :: & + Nconstituents, & p, & + m, & c, & !< counter in integration point component loop i, & !< counter in integration point loop e, & !< counter in element loop @@ -861,13 +869,13 @@ subroutine crystallite_init allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & - crystallite_F0, crystallite_Fi0,crystallite_Fp0, & + crystallite_F0,crystallite_Fp0, & crystallite_Li0,crystallite_Lp0, & crystallite_partitionedS0, & - crystallite_partitionedF0,crystallite_partitionedFp0,crystallite_partitionedFi0, & + crystallite_partitionedF0,crystallite_partitionedFp0,& crystallite_partitionedLp0,crystallite_partitionedLi0, & crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Fi,crystallite_Fp, & + crystallite_Fe,crystallite_Fp, & crystallite_Li,crystallite_Lp, & crystallite_subF,crystallite_subF0, & crystallite_subFp0,crystallite_subFi0, & @@ -930,7 +938,11 @@ subroutine crystallite_init phases => config_material%get('phase') allocate(output_constituent(phases%length)) + allocate(constitutive_mech_Fi(phases%length)) + allocate(constitutive_mech_Fi0(phases%length)) + allocate(constitutive_mech_partionedFi0(phases%length)) do p = 1, phases%length + Nconstituents = count(material_phaseAt == p) * discretization_nIPs phase => phases%get(p) mech => phase%get('mechanics',defaultVal = emptyDict) #if defined(__GFORTRAN__) @@ -938,6 +950,9 @@ subroutine crystallite_init #else output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) #endif + allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -945,18 +960,27 @@ subroutine crystallite_init print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax flush(IO_STDOUT) - !$OMP PARALLEL DO PRIVATE(i,c) + !$OMP PARALLEL DO PRIVATE(p,m) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) + + p = material_phaseAt(i,e) + m = material_phaseMemberAt(c,i,e) crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & / math_det33(crystallite_Fp0(1:3,1:3,c,i,e))**(1.0_pReal/3.0_pReal) - crystallite_Fi0(1:3,1:3,c,i,e) = math_I3 + constitutive_mech_Fi0(p)%data(1:3,1:3,m) = math_I3 + crystallite_F0(1:3,1:3,c,i,e) = math_I3 - crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(crystallite_Fi0(1:3,1:3,c,i,e), & + + crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(constitutive_mech_Fi0(p)%data(1:3,1:3,m), & crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration crystallite_Fp(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) - crystallite_Fi(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) + + constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) + + crystallite_requested(c,i,e) = .true. enddo; enddo enddo @@ -964,7 +988,6 @@ subroutine crystallite_init crystallite_partitionedFp0 = crystallite_Fp0 - crystallite_partitionedFi0 = crystallite_Fi0 crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 @@ -999,7 +1022,7 @@ function crystallite_stress() c, & !< counter in integration point component loop i, & !< counter in integration point loop e, & !< counter in element loop - s + s, p, m logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains real(pReal), dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: subFrac !ToDo: need to set some values to false for different Ngrains real(pReal), dimension(:,:,:,:,:), allocatable :: & @@ -1014,10 +1037,12 @@ function crystallite_stress() !-------------------------------------------------------------------------------------------------- ! initialize to starting condition crystallite_subStep = 0.0_pReal - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(p,m) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then + p = material_phaseAt(i,e) + m = material_phaseMemberAt(c,i,e) plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) @@ -1026,7 +1051,7 @@ function crystallite_stress() sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phaseMemberAt(c,i,e)) enddo crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) - crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) + crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) subFrac(c,i,e) = 0.0_pReal crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst @@ -1045,10 +1070,12 @@ function crystallite_stress() if (debugCrystallite%extensive) & print'(a,i6)', '<< CRYST stress >> crystallite iteration ',NiterationCrystallite #endif - !$OMP PARALLEL DO PRIVATE(formerSubStep) + !$OMP PARALLEL DO PRIVATE(formerSubStep,p,m) elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + p = material_phaseAt(i,e) + m = material_phaseMemberAt(c,i,e) !-------------------------------------------------------------------------------------------------- ! wind forward if (crystallite_converged(c,i,e)) then @@ -1058,12 +1085,13 @@ function crystallite_stress() num%stepIncreaseCryst * crystallite_subStep(c,i,e)) todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? + if (todo(c,i,e)) then crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) - crystallite_subFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) + crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_Fi(p)%data(1:3,1:3,m) plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) do s = 1, phase_Nsources(material_phaseAt(c,e)) @@ -1077,7 +1105,7 @@ function crystallite_stress() else crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) - crystallite_Fi (1:3,1:3,c,i,e) = crystallite_subFi0(1:3,1:3,c,i,e) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = crystallite_subFi0(1:3,1:3,c,i,e) crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback crystallite_Lp (1:3,1:3,c,i,e) = subLp0(1:3,1:3,c,i,e) @@ -1101,7 +1129,7 @@ function crystallite_stress() + crystallite_subStep(c,i,e) *( crystallite_partitionedF (1:3,1:3,c,i,e) & -crystallite_partitionedF0(1:3,1:3,c,i,e)) crystallite_Fe(1:3,1:3,c,i,e) = matmul(crystallite_subF(1:3,1:3,c,i,e), & - math_inv33(matmul(crystallite_Fi(1:3,1:3,c,i,e), & + math_inv33(matmul(constitutive_mech_Fi(p)%data(1:3,1:3,m), & crystallite_Fp(1:3,1:3,c,i,e)))) crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) crystallite_converged(c,i,e) = .false. @@ -1141,12 +1169,14 @@ subroutine crystallite_initializeRestorationPoints(i,e) e !< element number integer :: & c, & !< constituent number - s + s,p, m + p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + m = material_phaseMemberAt(c,i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) - crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi0(1:3,1:3,c,i,e) + constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li0(1:3,1:3,c,i,e) crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) @@ -1172,13 +1202,14 @@ subroutine crystallite_windForward(i,e) e !< element number integer :: & c, & !< constituent number - s - + s, p, m + p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + m = material_phaseMemberAt(c,i,e) crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - crystallite_partitionedFi0(1:3,1:3,c,i,e) = crystallite_Fi (1:3,1:3,c,i,e) + constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi(p)%data(1:3,1:3,m) crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) @@ -1204,15 +1235,17 @@ subroutine crystallite_restore(i,e,includeL) logical, intent(in) :: & includeL !< protect agains fake cutback integer :: & - c !< constituent number + c, p, m !< constituent number + p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) if (includeL) then crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) crystallite_Li(1:3,1:3,c,i,e) = crystallite_partitionedLi0(1:3,1:3,c,i,e) endif ! maybe protecting everything from overwriting makes more sense + m = material_phaseMemberAt(c,i,e) crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) - crystallite_Fi(1:3,1:3,c,i,e) = crystallite_partitionedFi0(1:3,1:3,c,i,e) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) plasticState (material_phaseAt(c,e))%state( :,material_phasememberAt(c,i,e)) = & @@ -1234,7 +1267,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) e !< counter in element loop integer :: & o, & - p + p, pp, m real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & @@ -1254,17 +1287,19 @@ function crystallite_stressTangent(c,i,e) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error + pp = material_phaseAt(i,e) + m = material_phaseMemberAt(c,i,e) call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e),c,i,e) + constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m), & c,i,e) invFp = math_inv33(crystallite_Fp(1:3,1:3,c,i,e)) - invFi = math_inv33(crystallite_Fi(1:3,1:3,c,i,e)) + invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)) @@ -1293,7 +1328,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,c,i,e), & - crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration + constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- @@ -1434,8 +1469,7 @@ subroutine crystallite_results call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'plastic deformation gradient','1') case('F_i') - selected_tensors = select_tensors(crystallite_Fi,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + call results_writeDataset(group,constitutive_mech_Fi(p)%data,output_constituent(p)%label(o),& 'inelastic deformation gradient','1') case('L_p') selected_tensors = select_tensors(crystallite_Lp,p) @@ -1593,6 +1627,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) ierr, & ! error indicator for LAPACK o, & p, & + m, & jacoCounterLp, & jacoCounterLi ! counters to check for Jacobian update logical :: error,broken @@ -1741,12 +1776,15 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error + p = material_phaseAt(ipc,el) + m = material_phaseMemberAt(ipc,ip,el) + crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) crystallite_S (1:3,1:3,ipc,ip,el) = S crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize - crystallite_Fi (1:3,1:3,ipc,ip,el) = Fi_new + constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. @@ -1786,7 +1824,7 @@ subroutine integrateStateFPI(g,i,e) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1807,7 +1845,7 @@ subroutine integrateStateFPI(g,i,e) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration @@ -1827,7 +1865,7 @@ subroutine integrateStateFPI(g,i,e) if(crystallite_converged(g,i,e)) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) exit iteration endif @@ -1979,7 +2017,7 @@ subroutine integrateStateEuler(g,i,e) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1990,7 +2028,7 @@ subroutine integrateStateEuler(g,i,e) * crystallite_subdt(g,i,e) broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) if(broken) return broken = integrateStress(g,i,e) @@ -2023,7 +2061,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -2035,7 +2073,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) if(broken) return broken = integrateStress(g,i,e) @@ -2043,7 +2081,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -2141,7 +2179,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -2167,7 +2205,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & crystallite_partitionedF0, & - crystallite_Fi(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & crystallite_partitionedFp0, & crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) if(broken) exit @@ -2191,7 +2229,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) if(broken) return broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_Fi(1:3,1:3,g,i,e),g,i,e,p,c) + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) if(broken) return broken = integrateStress(g,i,e) @@ -2235,7 +2273,6 @@ subroutine crystallite_restartWrite call HDF5_write(fileHandle,crystallite_partitionedF,'F') call HDF5_write(fileHandle,crystallite_Fp, 'F_p') - call HDF5_write(fileHandle,crystallite_Fi, 'F_i') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_Li, 'L_i') call HDF5_write(fileHandle,crystallite_S, 'S') @@ -2244,6 +2281,8 @@ subroutine crystallite_restartWrite do i = 1,size(material_name_phase) write(datasetName,'(i0,a)') i,'_omega' call HDF5_write(groupHandle,plasticState(i)%state,datasetName) + write(datasetName,'(i0,a)') i,'_F_i' + call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -2276,7 +2315,6 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_F0, 'F') call HDF5_read(fileHandle,crystallite_Fp0,'F_p') - call HDF5_read(fileHandle,crystallite_Fi0,'F_i') call HDF5_read(fileHandle,crystallite_Lp0,'L_p') call HDF5_read(fileHandle,crystallite_Li0,'L_i') call HDF5_read(fileHandle,crystallite_S0, 'S') @@ -2285,6 +2323,8 @@ subroutine crystallite_restartRead do i = 1,size(material_name_phase) write(datasetName,'(i0,a)') i,'_omega' call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) + write(datasetName,'(i0,a)') i,'_F_i' + call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -2311,12 +2351,12 @@ subroutine crystallite_forward crystallite_F0 = crystallite_partitionedF crystallite_Fp0 = crystallite_Fp crystallite_Lp0 = crystallite_Lp - crystallite_Fi0 = crystallite_Fi crystallite_Li0 = crystallite_Li crystallite_S0 = crystallite_S do i = 1, size(plasticState) plasticState(i)%state0 = plasticState(i)%state + constitutive_mech_Fi0(i) = constitutive_mech_Fi(i) enddo do i = 1,size(material_name_homogenization) homogState (i)%state0 = homogState (i)%state From 07873b24092ffc65ae4dc1c798e8680f7e5cb180 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 08:05:38 +0100 Subject: [PATCH 049/214] cleaning --- src/constitutive.f90 | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 14dde1c9f..a9e8dc0b1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -347,9 +347,7 @@ end function constitutive_deltaState module subroutine damage_results end subroutine damage_results - end interface - interface constitutive_LpAndItsTangents module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, ipc, ip, el) @@ -367,9 +365,6 @@ end function constitutive_deltaState dLp_dFi !< derivative of Lp with respect to Fi end subroutine constitutive_plastic_LpAndItsTangents - end interface constitutive_LpAndItsTangents - - interface constitutive_dependentState module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) integer, intent(in) :: & @@ -381,9 +376,7 @@ end function constitutive_deltaState Fp !< plastic deformation gradient end subroutine constitutive_plastic_dependentState - end interface constitutive_dependentState - interface constitutive_SandItsTangents module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) integer, intent(in) :: & @@ -400,7 +393,7 @@ end function constitutive_deltaState dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient end subroutine constitutive_hooke_SandItsTangents - end interface constitutive_SandItsTangents + end interface type(tDebugOptions) :: debugConstitutive @@ -408,10 +401,7 @@ end function constitutive_deltaState public :: & constitutive_init, & constitutive_homogenizedC, & - constitutive_LpAndItsTangents, & - constitutive_dependentState, & constitutive_LiAndItsTangents, & - constitutive_SandItsTangents, & constitutive_collectDotState, & constitutive_collectDotState_source, & constitutive_deltaState, & @@ -997,7 +987,7 @@ subroutine crystallite_init do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - call constitutive_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & + call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & crystallite_partitionedFp0(1:3,1:3,c,i,e), & c,i,e) ! update dependent state variables to be consistent with basic states enddo @@ -1290,7 +1280,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) pp = material_phaseAt(i,e) m = material_phaseMemberAt(c,i,e) - call constitutive_SandItsTangents(devNull,dSdFe,dSdFi, & + call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,c,i,e), & constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & @@ -1326,7 +1316,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS endif - call constitutive_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,c,i,e), & constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS @@ -1643,7 +1633,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) F = crystallite_subF(1:3,1:3,ipc,ip,el) endif - call constitutive_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & + call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess @@ -1681,10 +1671,10 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) B = math_I3 - dt*Lpguess Fe = matmul(matmul(A,B), invFi_new) - call constitutive_SandItsTangents(S, dS_dFe, dS_dFi, & + call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & Fe, Fi_new, ipc, ip, el) - call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & + call constitutive_plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & S, Fi_new, ipc, ip, el) !* update current residuum and check for convergence of loop From 43cbe622d05c6f67bc30a4b226277e9f50b1875c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 09:48:20 +0100 Subject: [PATCH 050/214] phase depends on constituent, not integration point --- src/constitutive.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a9e8dc0b1..28c68b7b2 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -954,7 +954,7 @@ subroutine crystallite_init do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(i,e) + p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & @@ -1031,7 +1031,7 @@ function crystallite_stress() elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then - p = material_phaseAt(i,e) + p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) @@ -1064,7 +1064,7 @@ function crystallite_stress() elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(i,e) + p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) !-------------------------------------------------------------------------------------------------- ! wind forward @@ -1161,9 +1161,9 @@ subroutine crystallite_initializeRestorationPoints(i,e) c, & !< constituent number s,p, m - p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - m = material_phaseMemberAt(c,i,e) + p = material_phaseAt(c,e) + m = material_phaseMemberAt(c,i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) @@ -1193,9 +1193,9 @@ subroutine crystallite_windForward(i,e) integer :: & c, & !< constituent number s, p, m - p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - m = material_phaseMemberAt(c,i,e) + p = material_phaseAt(c,e) + m = material_phaseMemberAt(c,i,e) crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) @@ -1226,13 +1226,13 @@ subroutine crystallite_restore(i,e,includeL) includeL !< protect agains fake cutback integer :: & c, p, m !< constituent number - p = material_phaseAt(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) if (includeL) then crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) crystallite_Li(1:3,1:3,c,i,e) = crystallite_partitionedLi0(1:3,1:3,c,i,e) endif ! maybe protecting everything from overwriting makes more sense + p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) @@ -1277,7 +1277,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(i,e) + pp = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & From 2ceb000002b80a28001999f08a30f5156b0cf573 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 09:59:13 +0100 Subject: [PATCH 051/214] using new structure --- src/constitutive.f90 | 69 +++++++++++++++++++++++++------------------- 1 file changed, 39 insertions(+), 30 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 28c68b7b2..75d5e098f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -45,10 +45,6 @@ module constitutive crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc ! - crystallite_Li, & !< current intermediate velocitiy grad (end of converged time step) - crystallite_Li0, & !< intermediate velocitiy grad at start of FE inc - crystallite_partitionedLi0, & !< intermediate velocity grad at start of homog inc - ! crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & @@ -77,7 +73,10 @@ module constitutive type(tTensorContainer), dimension(:), allocatable :: & constitutive_mech_Fi, & constitutive_mech_Fi0, & - constitutive_mech_partionedFi0 + constitutive_mech_partionedFi0, & + constitutive_mech_Li, & + constitutive_mech_Li0, & + constitutive_mech_partionedLi0 type :: tNumerics integer :: & @@ -859,14 +858,12 @@ subroutine crystallite_init allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & - crystallite_F0,crystallite_Fp0, & - crystallite_Li0,crystallite_Lp0, & + crystallite_F0,crystallite_Fp0,crystallite_Lp0, & crystallite_partitionedS0, & crystallite_partitionedF0,crystallite_partitionedFp0,& - crystallite_partitionedLp0,crystallite_partitionedLi0, & + crystallite_partitionedLp0, & crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Fp, & - crystallite_Li,crystallite_Lp, & + crystallite_Fe,crystallite_Fp,crystallite_Lp, & crystallite_subF,crystallite_subF0, & crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) @@ -931,6 +928,9 @@ subroutine crystallite_init allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) allocate(constitutive_mech_partionedFi0(phases%length)) + allocate(constitutive_mech_Li(phases%length)) + allocate(constitutive_mech_Li0(phases%length)) + allocate(constitutive_mech_partionedLi0(phases%length)) do p = 1, phases%length Nconstituents = count(material_phaseAt == p) * discretization_nIPs phase => phases%get(p) @@ -940,9 +940,12 @@ subroutine crystallite_init #else output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) #endif - allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedLi0(p)%data(3,3,Nconstituents)) enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -1021,8 +1024,8 @@ function crystallite_stress() todo = .false. + allocate(subLi0(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems)) subLp0 = crystallite_partitionedLp0 - subLi0 = crystallite_partitionedLi0 !-------------------------------------------------------------------------------------------------- ! initialize to starting condition @@ -1030,9 +1033,10 @@ function crystallite_stress() !$OMP PARALLEL DO PRIVATE(p,m) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) + subLi0(1:3,1:3,c,i,e) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) + homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) @@ -1079,7 +1083,7 @@ function crystallite_stress() if (todo(c,i,e)) then crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - subLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) + subLi0(1:3,1:3,c,i,e) = constitutive_mech_Li(p)%data(1:3,1:3,m) crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_Fi(p)%data(1:3,1:3,m) plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & @@ -1099,7 +1103,7 @@ function crystallite_stress() crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback crystallite_Lp (1:3,1:3,c,i,e) = subLp0(1:3,1:3,c,i,e) - crystallite_Li (1:3,1:3,c,i,e) = subLi0(1:3,1:3,c,i,e) + constitutive_mech_Li(p)%data(1:3,1:3,m) = subLi0(1:3,1:3,c,i,e) endif plasticState (material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) & = plasticState(material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) @@ -1167,7 +1171,7 @@ subroutine crystallite_initializeRestorationPoints(i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) - crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li0(1:3,1:3,c,i,e) + constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) = constitutive_mech_Li0(p)%data(1:3,1:3,m) crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) @@ -1200,7 +1204,7 @@ subroutine crystallite_windForward(i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi(p)%data(1:3,1:3,m) - crystallite_partitionedLi0(1:3,1:3,c,i,e) = crystallite_Li (1:3,1:3,c,i,e) + constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) = constitutive_mech_Li(p)%data(1:3,1:3,m) crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & @@ -1228,12 +1232,13 @@ subroutine crystallite_restore(i,e,includeL) c, p, m !< constituent number do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - if (includeL) then - crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) - crystallite_Li(1:3,1:3,c,i,e) = crystallite_partitionedLi0(1:3,1:3,c,i,e) - endif ! maybe protecting everything from overwriting makes more sense p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) + if (includeL) then + crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) + constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) + endif ! maybe protecting everything from overwriting makes more sense + crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) @@ -1466,8 +1471,7 @@ subroutine crystallite_results call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& 'plastic velocity gradient','1/s') case('L_i') - selected_tensors = select_tensors(crystallite_Li,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& + call results_writeDataset(group,constitutive_mech_Li(p)%data,output_constituent(p)%label(o),& 'inelastic velocity gradient','1/s') case('P') selected_tensors = select_tensors(crystallite_P,p) @@ -1636,8 +1640,11 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) + p = material_phaseAt(ipc,el) + m = material_phaseMemberAt(ipc,ip,el) + Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess - Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! take as first guess + Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) if (error) return ! error @@ -1772,7 +1779,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) crystallite_S (1:3,1:3,ipc,ip,el) = S crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess - crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess + constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) @@ -2264,7 +2271,6 @@ subroutine crystallite_restartWrite call HDF5_write(fileHandle,crystallite_partitionedF,'F') call HDF5_write(fileHandle,crystallite_Fp, 'F_p') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') - call HDF5_write(fileHandle,crystallite_Li, 'L_i') call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') @@ -2273,6 +2279,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,plasticState(i)%state,datasetName) write(datasetName,'(i0,a)') i,'_F_i' call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) + write(datasetName,'(i0,a)') i,'_L_i' + call HDF5_write(groupHandle,constitutive_mech_Li(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -2306,7 +2314,6 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_F0, 'F') call HDF5_read(fileHandle,crystallite_Fp0,'F_p') call HDF5_read(fileHandle,crystallite_Lp0,'L_p') - call HDF5_read(fileHandle,crystallite_Li0,'L_i') call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') @@ -2315,6 +2322,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) write(datasetName,'(i0,a)') i,'_F_i' call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) + write(datasetName,'(i0,a)') i,'_L_i' + call HDF5_read(groupHandle,constitutive_mech_Li0(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -2341,12 +2350,12 @@ subroutine crystallite_forward crystallite_F0 = crystallite_partitionedF crystallite_Fp0 = crystallite_Fp crystallite_Lp0 = crystallite_Lp - crystallite_Li0 = crystallite_Li crystallite_S0 = crystallite_S do i = 1, size(plasticState) plasticState(i)%state0 = plasticState(i)%state constitutive_mech_Fi0(i) = constitutive_mech_Fi(i) + constitutive_mech_Li0(i) = constitutive_mech_Li(i) enddo do i = 1,size(material_name_homogenization) homogState (i)%state0 = homogState (i)%state From 5fce37fb3e4effdc97cdac271add21896a912550 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 10:57:18 +0100 Subject: [PATCH 052/214] only relevant for mechanics --- src/constitutive.f90 | 600 ++------------------------------------ src/constitutive_mech.f90 | 576 ++++++++++++++++++++++++++++++++++++ 2 files changed, 599 insertions(+), 577 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 75d5e098f..58442283a 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -392,6 +392,26 @@ end function constitutive_deltaState dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient end subroutine constitutive_hooke_SandItsTangents + module subroutine integrateStateFPI(g,i,e) + integer, intent(in) :: e, i, g + end subroutine integrateStateFPI + + module subroutine integrateStateEuler(g,i,e) + integer, intent(in) :: e, i, g + end subroutine integrateStateEuler + + module subroutine integrateStateAdaptiveEuler(g,i,e) + integer, intent(in) :: e, i, g + end subroutine integrateStateAdaptiveEuler + + module subroutine integrateStateRK4(g,i,e) + integer, intent(in) :: e, i, g + end subroutine integrateStateRK4 + + module subroutine integrateStateRKCK45(g,i,e) + integer, intent(in) :: e, i, g + end subroutine integrateStateRKCK45 + end interface @@ -414,9 +434,8 @@ end function constitutive_deltaState plastic_nonlocal_updateCompatibility, & plastic_active, & source_active, & - kinematics_active - - public :: & + kinematics_active, & + converged, & crystallite_init, & crystallite_stress, & crystallite_stressTangent, & @@ -429,6 +448,7 @@ end function constitutive_deltaState crystallite_initializeRestorationPoints, & crystallite_windForward, & crystallite_restore + contains @@ -1562,338 +1582,6 @@ subroutine crystallite_results end subroutine crystallite_results -!-------------------------------------------------------------------------------------------------- -!> @brief calculation of stress (P) with time integration based on a residuum in Lp and -!> intermediate acceleration of the Newton-Raphson correction -!-------------------------------------------------------------------------------------------------- -function integrateStress(ipc,ip,el,timeFraction) result(broken) - - integer, intent(in):: el, & ! element index - ip, & ! integration point index - ipc ! grain index - real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep - - real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep - Fp_new, & ! plastic deformation gradient at end of timestep - invFp_new, & ! inverse of Fp_new - invFp_current, & ! inverse of Fp_current - Lpguess, & ! current guess for plastic velocity gradient - Lpguess_old, & ! known last good guess for plastic velocity gradient - Lp_constitutive, & ! plastic velocity gradient resulting from constitutive law - residuumLp, & ! current residuum of plastic velocity gradient - residuumLp_old, & ! last residuum of plastic velocity gradient - deltaLp, & ! direction of next guess - Fi_new, & ! gradient of intermediate deformation stages - invFi_new, & - invFi_current, & ! inverse of Fi_current - Liguess, & ! current guess for intermediate velocity gradient - Liguess_old, & ! known last good guess for intermediate velocity gradient - Li_constitutive, & ! intermediate velocity gradient resulting from constitutive law - residuumLi, & ! current residuum of intermediate velocity gradient - residuumLi_old, & ! last residuum of intermediate velocity gradient - deltaLi, & ! direction of next guess - Fe, & ! elastic deformation gradient - S, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration - A, & - B, & - temp_33 - real(pReal), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK - integer, dimension(9) :: devNull_9 ! needed for matrix inversion by LAPACK - real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme) - dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme) - real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress - dS_dFi, & - dFe_dLp, & ! partial derivative of elastic deformation gradient - dFe_dLi, & - dFi_dLi, & - dLp_dFi, & - dLi_dFi, & - dLp_dS, & - dLi_dS - real(pReal) steplengthLp, & - steplengthLi, & - dt, & ! time increment - atol_Lp, & - atol_Li, & - devNull - integer NiterationStressLp, & ! number of stress integrations - NiterationStressLi, & ! number of inner stress integrations - ierr, & ! error indicator for LAPACK - o, & - p, & - m, & - jacoCounterLp, & - jacoCounterLi ! counters to check for Jacobian update - logical :: error,broken - - broken = .true. - - if (present(timeFraction)) then - dt = crystallite_subdt(ipc,ip,el) * timeFraction - F = crystallite_subF0(1:3,1:3,ipc,ip,el) & - + (crystallite_subF(1:3,1:3,ipc,ip,el) - crystallite_subF0(1:3,1:3,ipc,ip,el)) * timeFraction - else - dt = crystallite_subdt(ipc,ip,el) - F = crystallite_subF(1:3,1:3,ipc,ip,el) - endif - - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & - crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) - - p = material_phaseAt(ipc,el) - m = material_phaseMemberAt(ipc,ip,el) - - Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess - Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess - - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) - if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,ipc,ip,el)) - if (error) return ! error - - A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp - - jacoCounterLi = 0 - steplengthLi = 1.0_pReal - residuumLi_old = 0.0_pReal - Liguess_old = Liguess - - NiterationStressLi = 0 - LiLoop: do - NiterationStressLi = NiterationStressLi + 1 - if (NiterationStressLi>num%nStress) return ! error - - invFi_new = matmul(invFi_current,math_I3 - dt*Liguess) - Fi_new = math_inv33(invFi_new) - - jacoCounterLp = 0 - steplengthLp = 1.0_pReal - residuumLp_old = 0.0_pReal - Lpguess_old = Lpguess - - NiterationStressLp = 0 - LpLoop: do - NiterationStressLp = NiterationStressLp + 1 - if (NiterationStressLp>num%nStress) return ! error - - B = math_I3 - dt*Lpguess - Fe = matmul(matmul(A,B), invFi_new) - call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi_new, ipc, ip, el) - - call constitutive_plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - S, Fi_new, ipc, ip, el) - - !* update current residuum and check for convergence of loop - atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error - num%atol_crystalliteStress) ! minimum lower cutoff - residuumLp = Lpguess - Lp_constitutive - - if (any(IEEE_is_NaN(residuumLp))) then - return ! error - elseif (norm2(residuumLp) < atol_Lp) then ! converged if below absolute tolerance - exit LpLoop - elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... - residuumLp_old = residuumLp ! ...remember old values and... - Lpguess_old = Lpguess - steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) - else ! not converged and residuum not improved... - steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction - Lpguess = Lpguess_old & - + deltaLp * stepLengthLp - cycle LpLoop - endif - - calculateJacobiLi: if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then - jacoCounterLp = jacoCounterLp + 1 - - do o=1,3; do p=1,3 - dFe_dLp(o,1:3,p,1:3) = - dt * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - enddo; enddo - dRLp_dLp = math_eye(9) & - - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) - temp_9 = math_33to9(residuumLp) - call dgesv(9,1,dRLp_dLp,9,devNull_9,temp_9,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp - if (ierr /= 0) return ! error - deltaLp = - math_9to33(temp_9) - endif calculateJacobiLi - - Lpguess = Lpguess & - + deltaLp * steplengthLp - enddo LpLoop - - call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - S, Fi_new, ipc, ip, el) - - !* update current residuum and check for convergence of loop - atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error - num%atol_crystalliteStress) ! minimum lower cutoff - residuumLi = Liguess - Li_constitutive - if (any(IEEE_is_NaN(residuumLi))) then - return ! error - elseif (norm2(residuumLi) < atol_Li) then ! converged if below absolute tolerance - exit LiLoop - elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... - residuumLi_old = residuumLi ! ...remember old values and... - Liguess_old = Liguess - steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) - else ! not converged and residuum not improved... - steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction - Liguess = Liguess_old & - + deltaLi * steplengthLi - cycle LiLoop - endif - - calculateJacobiLp: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then - jacoCounterLi = jacoCounterLi + 1 - - temp_33 = matmul(matmul(A,B),invFi_current) - do o=1,3; do p=1,3 - dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current - enddo; enddo - do o=1,3; do p=1,3 - dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) - enddo; enddo - dRLi_dLi = math_eye(9) & - - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) & - + math_mul3333xx3333(dS_dFi, dFi_dLi))) & - - math_3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) - temp_9 = math_33to9(residuumLi) - call dgesv(9,1,dRLi_dLi,9,devNull_9,temp_9,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li - if (ierr /= 0) return ! error - deltaLi = - math_9to33(temp_9) - endif calculateJacobiLp - - Liguess = Liguess & - + deltaLi * steplengthLi - enddo LiLoop - - invFp_new = matmul(invFp_current,B) - call math_invert33(Fp_new,devNull,error,invFp_new) - if (error) return ! error - - p = material_phaseAt(ipc,el) - m = material_phaseMemberAt(ipc,ip,el) - - crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,ipc,ip,el) = S - crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess - constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess - crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize - constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new - crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) - broken = .false. - -end function integrateStress - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - NiterationState, & !< number of iterations in state loop - p, & - c, & - s, & - size_pl - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & - r ! state residuum - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - size_pl = plasticState(p)%sizeDotState - plasticState(p)%state(1:size_pl,c) = plasticState(p)%subState0(1:size_pl,c) & - + plasticState(p)%dotState (1:size_pl,c) & - * crystallite_subdt(g,i,e) - plastic_dotState(1:size_pl,2) = 0.0_pReal - - iteration: do NiterationState = 1, num%nState - - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) - - broken = integrateStress(g,i,e) - if(broken) exit iteration - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) exit iteration - - zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& - plastic_dotState(1:size_pl,2)) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & - + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(p)%state (1:size_pl,c) & - - plasticState(p)%subState0(1:size_pl,c) & - - plasticState(p)%dotState (1:size_pl,c) * crystallite_subdt(g,i,e) - plasticState(p)%state(1:size_pl,c) = plasticState(p)%state(1:size_pl,c) & - - r(1:size_pl) - crystallite_converged(g,i,e) = converged(r(1:size_pl), & - plasticState(p)%state(1:size_pl,c), & - plasticState(p)%atol(1:size_pl)) - - if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) - exit iteration - endif - - enddo iteration - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end subroutine integrateStateFPI - - !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize @@ -1993,248 +1681,6 @@ subroutine integrateSourceState(g,i,e) end subroutine integrateSourceState -!-------------------------------------------------------------------------------------------------- -!> @brief integrate state with 1st order explicit Euler method -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - p, & - c, & - sizeDotState - logical :: & - broken - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken - -end subroutine integrateStateEuler - - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with 1st order Euler method with adaptive step size -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(g,i,e) - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - p, & - c, & - sizeDotState - logical :: & - broken - - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic - - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - - residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - if(broken) return - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - - sizeDotState = plasticState(p)%sizeDotState - crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) - -end subroutine integrateStateAdaptiveEuler - - -!--------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with the classic Runge Kutta method -!--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(g,i,e) - - integer, intent(in) :: g,i,e - - real(pReal), dimension(3,3), parameter :: & - A = reshape([& - 0.5_pReal, 0.0_pReal, 0.0_pReal, & - 0.0_pReal, 0.5_pReal, 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal],& - shape(A)) - real(pReal), dimension(3), parameter :: & - C = [0.5_pReal, 0.5_pReal, 1.0_pReal] - real(pReal), dimension(4), parameter :: & - B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - - call integrateStateRK(g,i,e,A,B,C) - -end subroutine integrateStateRK4 - - -!--------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with the Cash-Carp method -!--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(g,i,e) - - integer, intent(in) :: g,i,e - - real(pReal), dimension(5,5), parameter :: & - A = reshape([& - 1._pReal/5._pReal, .0_pReal, .0_pReal, .0_pReal, .0_pReal, & - 3._pReal/40._pReal, 9._pReal/40._pReal, .0_pReal, .0_pReal, .0_pReal, & - 3_pReal/10._pReal, -9._pReal/10._pReal, 6._pReal/5._pReal, .0_pReal, .0_pReal, & - -11._pReal/54._pReal, 5._pReal/2._pReal, -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal, .0_pReal, & - 1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],& - shape(A)) - real(pReal), dimension(5), parameter :: & - C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal] - real(pReal), dimension(6), parameter :: & - B = & - [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, & - 125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], & - DB = B - & - [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& - 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - - call integrateStateRK(g,i,e,A,B,C,DB) - -end subroutine integrateStateRKCK45 - - -!-------------------------------------------------------------------------------------------------- -!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an -!! embedded explicit Runge-Kutta method -!-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(g,i,e,A,B,CC,DB) - - - real(pReal), dimension(:,:), intent(in) :: A - real(pReal), dimension(:), intent(in) :: B, CC - real(pReal), dimension(:), intent(in), optional :: DB - - integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop - integer :: & - stage, & ! stage index in integration stage loop - n, & - p, & - c, & - sizeDotState - logical :: & - broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState - - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) - if(broken) return - - do stage = 1,size(A,1) - sizeDotState = plasticState(p)%sizeDotState - plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) - plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) - - do n = 2, stage - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & - + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) - enddo - - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - - broken = integrateStress(g,i,e,CC(stage)) - if(broken) exit - - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) - if(broken) exit - - enddo - if(broken) return - - sizeDotState = plasticState(p)%sizeDotState - - plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (p)%dotState(:,c) - plasticState(p)%dotState(:,c) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) - if(present(DB)) & - broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & - * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) - - if(broken) return - - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) - if(broken) return - - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken - - -end subroutine integrateStateRK - !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 8f08aa08e..dea5ed647 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -691,5 +691,581 @@ module subroutine plastic_results end subroutine plastic_results + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of stress (P) with time integration based on a residuum in Lp and +!> intermediate acceleration of the Newton-Raphson correction +!-------------------------------------------------------------------------------------------------- +function integrateStress(ipc,ip,el,timeFraction) result(broken) + + integer, intent(in):: el, & ! element index + ip, & ! integration point index + ipc ! grain index + real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep + + real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep + Fp_new, & ! plastic deformation gradient at end of timestep + invFp_new, & ! inverse of Fp_new + invFp_current, & ! inverse of Fp_current + Lpguess, & ! current guess for plastic velocity gradient + Lpguess_old, & ! known last good guess for plastic velocity gradient + Lp_constitutive, & ! plastic velocity gradient resulting from constitutive law + residuumLp, & ! current residuum of plastic velocity gradient + residuumLp_old, & ! last residuum of plastic velocity gradient + deltaLp, & ! direction of next guess + Fi_new, & ! gradient of intermediate deformation stages + invFi_new, & + invFi_current, & ! inverse of Fi_current + Liguess, & ! current guess for intermediate velocity gradient + Liguess_old, & ! known last good guess for intermediate velocity gradient + Li_constitutive, & ! intermediate velocity gradient resulting from constitutive law + residuumLi, & ! current residuum of intermediate velocity gradient + residuumLi_old, & ! last residuum of intermediate velocity gradient + deltaLi, & ! direction of next guess + Fe, & ! elastic deformation gradient + S, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration + A, & + B, & + temp_33 + real(pReal), dimension(9) :: temp_9 ! needed for matrix inversion by LAPACK + integer, dimension(9) :: devNull_9 ! needed for matrix inversion by LAPACK + real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme) + dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme) + real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress + dS_dFi, & + dFe_dLp, & ! partial derivative of elastic deformation gradient + dFe_dLi, & + dFi_dLi, & + dLp_dFi, & + dLi_dFi, & + dLp_dS, & + dLi_dS + real(pReal) steplengthLp, & + steplengthLi, & + dt, & ! time increment + atol_Lp, & + atol_Li, & + devNull + integer NiterationStressLp, & ! number of stress integrations + NiterationStressLi, & ! number of inner stress integrations + ierr, & ! error indicator for LAPACK + o, & + p, & + m, & + jacoCounterLp, & + jacoCounterLi ! counters to check for Jacobian update + logical :: error,broken + + broken = .true. + + if (present(timeFraction)) then + dt = crystallite_subdt(ipc,ip,el) * timeFraction + F = crystallite_subF0(1:3,1:3,ipc,ip,el) & + + (crystallite_subF(1:3,1:3,ipc,ip,el) - crystallite_subF0(1:3,1:3,ipc,ip,el)) * timeFraction + else + dt = crystallite_subdt(ipc,ip,el) + F = crystallite_subF(1:3,1:3,ipc,ip,el) + endif + + call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & + crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) + + p = material_phaseAt(ipc,el) + m = material_phaseMemberAt(ipc,ip,el) + + Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess + Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess + + call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) + if (error) return ! error + call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,ipc,ip,el)) + if (error) return ! error + + A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp + + jacoCounterLi = 0 + steplengthLi = 1.0_pReal + residuumLi_old = 0.0_pReal + Liguess_old = Liguess + + NiterationStressLi = 0 + LiLoop: do + NiterationStressLi = NiterationStressLi + 1 + if (NiterationStressLi>num%nStress) return ! error + + invFi_new = matmul(invFi_current,math_I3 - dt*Liguess) + Fi_new = math_inv33(invFi_new) + + jacoCounterLp = 0 + steplengthLp = 1.0_pReal + residuumLp_old = 0.0_pReal + Lpguess_old = Lpguess + + NiterationStressLp = 0 + LpLoop: do + NiterationStressLp = NiterationStressLp + 1 + if (NiterationStressLp>num%nStress) return ! error + + B = math_I3 - dt*Lpguess + Fe = matmul(matmul(A,B), invFi_new) + call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi_new, ipc, ip, el) + + call constitutive_plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & + S, Fi_new, ipc, ip, el) + + !* update current residuum and check for convergence of loop + atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%atol_crystalliteStress) ! minimum lower cutoff + residuumLp = Lpguess - Lp_constitutive + + if (any(IEEE_is_NaN(residuumLp))) then + return ! error + elseif (norm2(residuumLp) < atol_Lp) then ! converged if below absolute tolerance + exit LpLoop + elseif (NiterationStressLp == 1 .or. norm2(residuumLp) < norm2(residuumLp_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... + residuumLp_old = residuumLp ! ...remember old values and... + Lpguess_old = Lpguess + steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) + else ! not converged and residuum not improved... + steplengthLp = num%subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction + Lpguess = Lpguess_old & + + deltaLp * stepLengthLp + cycle LpLoop + endif + + calculateJacobiLi: if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then + jacoCounterLp = jacoCounterLp + 1 + + do o=1,3; do p=1,3 + dFe_dLp(o,1:3,p,1:3) = - dt * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + enddo; enddo + dRLp_dLp = math_eye(9) & + - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) + temp_9 = math_33to9(residuumLp) + call dgesv(9,1,dRLp_dLp,9,devNull_9,temp_9,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp + if (ierr /= 0) return ! error + deltaLp = - math_9to33(temp_9) + endif calculateJacobiLi + + Lpguess = Lpguess & + + deltaLp * steplengthLp + enddo LpLoop + + call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & + S, Fi_new, ipc, ip, el) + + !* update current residuum and check for convergence of loop + atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error + num%atol_crystalliteStress) ! minimum lower cutoff + residuumLi = Liguess - Li_constitutive + if (any(IEEE_is_NaN(residuumLi))) then + return ! error + elseif (norm2(residuumLi) < atol_Li) then ! converged if below absolute tolerance + exit LiLoop + elseif (NiterationStressLi == 1 .or. norm2(residuumLi) < norm2(residuumLi_old)) then ! not converged, but improved norm of residuum (always proceed in first iteration)... + residuumLi_old = residuumLi ! ...remember old values and... + Liguess_old = Liguess + steplengthLi = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) + else ! not converged and residuum not improved... + steplengthLi = num%subStepSizeLi * steplengthLi ! ...try with smaller step length in same direction + Liguess = Liguess_old & + + deltaLi * steplengthLi + cycle LiLoop + endif + + calculateJacobiLp: if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then + jacoCounterLi = jacoCounterLi + 1 + + temp_33 = matmul(matmul(A,B),invFi_current) + do o=1,3; do p=1,3 + dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current + enddo; enddo + do o=1,3; do p=1,3 + dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) + enddo; enddo + dRLi_dLi = math_eye(9) & + - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) & + + math_mul3333xx3333(dS_dFi, dFi_dLi))) & + - math_3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) + temp_9 = math_33to9(residuumLi) + call dgesv(9,1,dRLi_dLi,9,devNull_9,temp_9,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li + if (ierr /= 0) return ! error + deltaLi = - math_9to33(temp_9) + endif calculateJacobiLp + + Liguess = Liguess & + + deltaLi * steplengthLi + enddo LiLoop + + invFp_new = matmul(invFp_current,B) + call math_invert33(Fp_new,devNull,error,invFp_new) + if (error) return ! error + + p = material_phaseAt(ipc,el) + m = material_phaseMemberAt(ipc,ip,el) + + crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + crystallite_S (1:3,1:3,ipc,ip,el) = S + crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess + constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess + crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new + crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + broken = .false. + +end function integrateStress + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateFPI(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + NiterationState, & !< number of iterations in state loop + p, & + c, & + s, & + size_pl + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + r ! state residuum + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & + plastic_dotState + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + size_pl = plasticState(p)%sizeDotState + plasticState(p)%state(1:size_pl,c) = plasticState(p)%subState0(1:size_pl,c) & + + plasticState(p)%dotState (1:size_pl,c) & + * crystallite_subdt(g,i,e) + plastic_dotState(1:size_pl,2) = 0.0_pReal + + iteration: do NiterationState = 1, num%nState + + if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) + plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) + + broken = integrateStress(g,i,e) + if(broken) exit iteration + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) exit iteration + + zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& + plastic_dotState(1:size_pl,2)) + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) + r(1:size_pl) = plasticState(p)%state (1:size_pl,c) & + - plasticState(p)%subState0(1:size_pl,c) & + - plasticState(p)%dotState (1:size_pl,c) * crystallite_subdt(g,i,e) + plasticState(p)%state(1:size_pl,c) = plasticState(p)%state(1:size_pl,c) & + - r(1:size_pl) + crystallite_converged(g,i,e) = converged(r(1:size_pl), & + plasticState(p)%state(1:size_pl,c), & + plasticState(p)%atol(1:size_pl)) + + if(crystallite_converged(g,i,e)) then + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + exit iteration + endif + + enddo iteration + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end subroutine integrateStateFPI + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate state with 1st order explicit Euler method +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateEuler(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + p, & + c, & + sizeDotState + logical :: & + broken + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + crystallite_converged(g,i,e) = .not. broken + +end subroutine integrateStateEuler + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with 1st order Euler method with adaptive step size +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateAdaptiveEuler(g,i,e) + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + p, & + c, & + sizeDotState + logical :: & + broken + + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic + + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + + residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + if(broken) return + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + + sizeDotState = plasticState(p)%sizeDotState + crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState) & + + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%atol(1:sizeDotState)) + +end subroutine integrateStateAdaptiveEuler + + +!--------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with the classic Runge Kutta method +!--------------------------------------------------------------------------------------------------- +subroutine integrateStateRK4(g,i,e) + + integer, intent(in) :: g,i,e + + real(pReal), dimension(3,3), parameter :: & + A = reshape([& + 0.5_pReal, 0.0_pReal, 0.0_pReal, & + 0.0_pReal, 0.5_pReal, 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal],& + shape(A)) + real(pReal), dimension(3), parameter :: & + C = [0.5_pReal, 0.5_pReal, 1.0_pReal] + real(pReal), dimension(4), parameter :: & + B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + + call integrateStateRK(g,i,e,A,B,C) + +end subroutine integrateStateRK4 + + +!--------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with the Cash-Carp method +!--------------------------------------------------------------------------------------------------- +subroutine integrateStateRKCK45(g,i,e) + + integer, intent(in) :: g,i,e + + real(pReal), dimension(5,5), parameter :: & + A = reshape([& + 1._pReal/5._pReal, .0_pReal, .0_pReal, .0_pReal, .0_pReal, & + 3._pReal/40._pReal, 9._pReal/40._pReal, .0_pReal, .0_pReal, .0_pReal, & + 3_pReal/10._pReal, -9._pReal/10._pReal, 6._pReal/5._pReal, .0_pReal, .0_pReal, & + -11._pReal/54._pReal, 5._pReal/2._pReal, -70.0_pReal/27.0_pReal, 35.0_pReal/27.0_pReal, .0_pReal, & + 1631._pReal/55296._pReal,175._pReal/512._pReal,575._pReal/13824._pReal,44275._pReal/110592._pReal,253._pReal/4096._pReal],& + shape(A)) + real(pReal), dimension(5), parameter :: & + C = [0.2_pReal, 0.3_pReal, 0.6_pReal, 1.0_pReal, 0.875_pReal] + real(pReal), dimension(6), parameter :: & + B = & + [37.0_pReal/378.0_pReal, .0_pReal, 250.0_pReal/621.0_pReal, & + 125.0_pReal/594.0_pReal, .0_pReal, 512.0_pReal/1771.0_pReal], & + DB = B - & + [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& + 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] + + call integrateStateRK(g,i,e,A,B,C,DB) + +end subroutine integrateStateRKCK45 + + +!-------------------------------------------------------------------------------------------------- +!> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an +!! embedded explicit Runge-Kutta method +!-------------------------------------------------------------------------------------------------- +subroutine integrateStateRK(g,i,e,A,B,CC,DB) + + + real(pReal), dimension(:,:), intent(in) :: A + real(pReal), dimension(:), intent(in) :: B, CC + real(pReal), dimension(:), intent(in), optional :: DB + + integer, intent(in) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + integer :: & + stage, & ! stage index in integration stage loop + n, & + p, & + c, & + sizeDotState + logical :: & + broken + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + + p = material_phaseAt(g,e) + c = material_phaseMemberAt(g,i,e) + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) + if(broken) return + + do stage = 1,size(A,1) + sizeDotState = plasticState(p)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) + plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) + + do n = 2, stage + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & + + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) + enddo + + sizeDotState = plasticState(p)%sizeDotState + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + + broken = integrateStress(g,i,e,CC(stage)) + if(broken) exit + + broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & + crystallite_partitionedF0, & + constitutive_mech_Fi(p)%data(1:3,1:3,c), & + crystallite_partitionedFp0, & + crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) + if(broken) exit + + enddo + if(broken) return + + sizeDotState = plasticState(p)%sizeDotState + + plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (p)%dotState(:,c) + plasticState(p)%dotState(:,c) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) + plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & + + plasticState(p)%dotState (1:sizeDotState,c) & + * crystallite_subdt(g,i,e) + if(present(DB)) & + broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & + * crystallite_subdt(g,i,e), & + plasticState(p)%state(1:sizeDotState,c), & + plasticState(p)%atol(1:sizeDotState)) + + if(broken) return + + broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & + constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + if(broken) return + + broken = integrateStress(g,i,e) + crystallite_converged(g,i,e) = .not. broken + + +end subroutine integrateStateRK + + end submodule constitutive_mech From 07ccaf5fe76e05ddcaea988a27cf410bf06974ac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 12:14:09 +0100 Subject: [PATCH 053/214] some ideas ... --- src/constitutive.f90 | 13 +++++++++++++ src/constitutive_mech.f90 | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 58442283a..b5158be4e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -140,6 +140,7 @@ module constitutive interface +! == cleaned:begin ================================================================================= module subroutine mech_init end subroutine mech_init @@ -149,6 +150,18 @@ module constitutive module subroutine thermal_init end subroutine thermal_init + + module subroutine mech_results(group,ph) + character(len=*), intent(in) :: group + integer, intent(in) :: ph + end subroutine mech_results + + module subroutine mech_restart_read(fileHandle) + integer(HID_T), intent(in) :: fileHandle + end subroutine mech_restart_read + +! == cleaned:end =================================================================================== + module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index dea5ed647..acfe3a23b 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -651,6 +651,40 @@ module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(br end function constitutive_deltaState +module subroutine mech_results(group,ph) + + character(len=*), intent(in) :: group + integer, intent(in) :: ph + + select case(phase_plasticity(ph)) + + case(PLASTICITY_ISOTROPIC_ID) + call plastic_isotropic_results(phase_plasticityInstance(ph),group//'plastic') + + case(PLASTICITY_PHENOPOWERLAW_ID) + call plastic_phenopowerlaw_results(phase_plasticityInstance(ph),group//'plastic') + + case(PLASTICITY_KINEHARDENING_ID) + call plastic_kinehardening_results(phase_plasticityInstance(ph),group//'plastic') + + case(PLASTICITY_DISLOTWIN_ID) + call plastic_dislotwin_results(phase_plasticityInstance(ph),group//'plastic') + + case(PLASTICITY_DISLOTUNGSTEN_ID) + call plastic_dislotungsten_results(phase_plasticityInstance(ph),group//'plastic') + + case(PLASTICITY_NONLOCAL_ID) + call plastic_nonlocal_results(phase_plasticityInstance(ph),group//'plastic') + end select + +end subroutine mech_results + + module subroutine mech_restart_read(fileHandle) + integer(HID_T), intent(in) :: fileHandle + end subroutine mech_restart_read + + + !-------------------------------------------------------------------------------------------- !> @brief writes plasticity constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------- From b7445b007dc43329a7b3237ac13f24906d3ffb7a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 14:01:40 +0100 Subject: [PATCH 054/214] variables are now part of the same module --- src/constitutive.f90 | 7 +----- src/constitutive_mech.f90 | 50 ++++++++++----------------------------- 2 files changed, 13 insertions(+), 44 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b5158be4e..a7834852f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -162,7 +162,7 @@ module constitutive ! == cleaned:end =================================================================================== - module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) + module function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -173,12 +173,7 @@ module constitutive real(pReal), intent(in) :: & subdt !< timestep real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FArray, & !< elastic deformation gradient FpArray !< plastic deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) logical :: broken end function constitutive_collectDotState diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index acfe3a23b..bc6a3ba1a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -536,7 +536,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, ip, el,phase,of) result(broken) +module function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -547,12 +547,7 @@ module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, real(pReal), intent(in) :: & subdt !< timestep real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FArray, & !< elastic deformation gradient FpArray !< plastic deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) real(pReal), dimension(3,3) :: & Mp integer :: & @@ -561,12 +556,12 @@ module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, i, & !< counter in source loop instance logical :: broken - ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(phase) - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(constitutive_mech_Fi(phase)%data(1:3,1:3,of)),& + constitutive_mech_Fi(phase)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,ipc,ip,el)) plasticityType: select case (phase_plasticity(phase)) @@ -586,7 +581,7 @@ module function constitutive_collectDotState(S, FArray, Fi, FpArray, subdt, ipc, call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,FArray,FpArray,temperature(ho)%p(tme),subdt, & + call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,FpArray,temperature(ho)%p(tme),subdt, & instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) @@ -983,11 +978,8 @@ subroutine integrateStateFPI(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = constitutive_collectDotState(crystallite_partitionedFp0, & + crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return size_pl = plasticState(p)%sizeDotState @@ -1004,10 +996,7 @@ subroutine integrateStateFPI(g,i,e) broken = integrateStress(g,i,e) if(broken) exit iteration - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration @@ -1077,10 +1066,7 @@ subroutine integrateStateEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1121,10 +1107,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1141,10 +1124,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) broken = integrateStress(g,i,e) if(broken) return - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1239,10 +1219,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1265,10 +1242,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) broken = integrateStress(g,i,e,CC(stage)) if(broken) exit - broken = constitutive_collectDotState(crystallite_S(1:3,1:3,g,i,e), & - crystallite_partitionedF0, & - constitutive_mech_Fi(p)%data(1:3,1:3,c), & - crystallite_partitionedFp0, & + broken = constitutive_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) if(broken) exit From ceeb300061d85968ea1c233b0c89c93e2dab18e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 14:51:55 +0100 Subject: [PATCH 055/214] fixes for ifort --- src/constitutive.f90 | 2 +- src/constitutive_mech.f90 | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 58442283a..f76b94579 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -47,7 +47,7 @@ module constitutive ! crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & + real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_P, & !< 1st Piola-Kirchhoff stress per grain crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index dea5ed647..07e48b537 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -922,7 +922,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(g,i,e) +module subroutine integrateStateFPI(g,i,e) integer, intent(in) :: & e, & !< element index in element loop @@ -1027,7 +1027,7 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(g,i,e) +module subroutine integrateStateEuler(g,i,e) integer, intent(in) :: & e, & !< element index in element loop @@ -1068,7 +1068,7 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(g,i,e) +module subroutine integrateStateAdaptiveEuler(g,i,e) integer, intent(in) :: & e, & !< element index in element loop @@ -1127,7 +1127,7 @@ end subroutine integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(g,i,e) +module subroutine integrateStateRK4(g,i,e) integer, intent(in) :: g,i,e @@ -1150,7 +1150,7 @@ end subroutine integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(g,i,e) +module subroutine integrateStateRKCK45(g,i,e) integer, intent(in) :: g,i,e From c913a577d01e0b2f5887a9748fc1cd459426f94c Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 21 Dec 2020 19:15:06 +0100 Subject: [PATCH 056/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-62-gd1c7ec068 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 85027fcd3..5c2eab7c5 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-42-g6cc78cb41 +v3.0.0-alpha2-62-gd1c7ec068 From 3ea05cabadb680c16e0dead27f5f30142bd58e24 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 21 Dec 2020 21:32:13 +0100 Subject: [PATCH 057/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-68-gbc32797fa --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 85027fcd3..72db22a20 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-42-g6cc78cb41 +v3.0.0-alpha2-68-gbc32797fa From d8b57680ec0c43520f045954c7edc01c81fcb7df Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 21 Dec 2020 15:46:07 -0500 Subject: [PATCH 058/214] raise NotImplemented when using R*b instead of R@b --- python/damask/_rotation.py | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index f4d2cf248..780e81891 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -144,6 +144,11 @@ class Rotation: return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize()) + def __mul__(self,other): + """Standard multiplication is not implemented.""" + raise NotImplementedError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + + def __matmul__(self,other): """ Rotation of vector, second or fourth order tensor, or rotation object. From 2434712d7e0a556bc18721aefaba13569af5d95d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 21 Dec 2020 23:33:32 +0100 Subject: [PATCH 059/214] better matching name --- src/constitutive.f90 | 6 +++--- src/homogenization.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 205df9d55..5e99abfd3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -453,7 +453,7 @@ end function constitutive_deltaState crystallite_restartWrite, & crystallite_restartRead, & crystallite_forward, & - crystallite_initializeRestorationPoints, & + constitutive_initializeRestorationPoints, & crystallite_windForward, & crystallite_restore @@ -1184,7 +1184,7 @@ end function crystallite_stress !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine crystallite_initializeRestorationPoints(i,e) +subroutine constitutive_initializeRestorationPoints(i,e) integer, intent(in) :: & i, & !< integration point number @@ -1211,7 +1211,7 @@ subroutine crystallite_initializeRestorationPoints(i,e) enddo enddo -end subroutine crystallite_initializeRestorationPoints +end subroutine constitutive_initializeRestorationPoints !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization.f90 b/src/homogenization.f90 index cbab8e468..6ed53c13c 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -196,7 +196,7 @@ subroutine materialpoint_stressAndItsTangent(dt) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2); - call crystallite_initializeRestorationPoints(i,e) + call constitutive_initializeRestorationPoints(i,e) subFrac(i,e) = 0.0_pReal converged(i,e) = .false. ! pretend failed step ... From da558b31c15470fd949b9dcf15863cfceaf6993c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 08:45:01 +0100 Subject: [PATCH 060/214] clear responsibilities --- src/constitutive.f90 | 20 +++++++++++++---- src/constitutive_mech.f90 | 46 ++++----------------------------------- src/homogenization.f90 | 1 + src/results.f90 | 2 -- 4 files changed, 21 insertions(+), 48 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5e99abfd3..e49932cfe 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -348,9 +348,6 @@ end function constitutive_deltaState C end subroutine source_damage_isoBrittle_deltaState - module subroutine plastic_results - end subroutine plastic_results - module subroutine damage_results end subroutine damage_results @@ -844,7 +841,22 @@ end subroutine constitutive_forward !-------------------------------------------------------------------------------------------------- subroutine constitutive_results - call plastic_results + integer :: ph + character(len=:), allocatable :: group + + + group = '/current/phase/' + call results_closeGroup(results_addGroup(group)) + + do ph = 1, size(material_name_phase) + + group = group//trim(material_name_phase(ph))//'/' + call results_closeGroup(results_addGroup(group)) + + call mech_results(group,ph) + + enddo + call damage_results end subroutine constitutive_results diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index ba10ed39a..7d6ef2998 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -651,6 +651,9 @@ module subroutine mech_results(group,ph) character(len=*), intent(in) :: group integer, intent(in) :: ph + if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) & + call results_closeGroup(results_addGroup(group//'plastic')) + select case(phase_plasticity(ph)) case(PLASTICITY_ISOTROPIC_ID) @@ -670,6 +673,7 @@ module subroutine mech_results(group,ph) case(PLASTICITY_NONLOCAL_ID) call plastic_nonlocal_results(phase_plasticityInstance(ph),group//'plastic') + end select end subroutine mech_results @@ -679,48 +683,6 @@ end subroutine mech_results end subroutine mech_restart_read - -!-------------------------------------------------------------------------------------------- -!> @brief writes plasticity constitutive results to HDF5 output file -!-------------------------------------------------------------------------------------------- -module subroutine plastic_results - - integer :: p - character(len=:), allocatable :: group - - plasticityLoop: do p=1,size(material_name_phase) - group = '/current/phase/'//trim(material_name_phase(p)) - call results_closeGroup(results_addGroup(group)) - - group = trim(group)//'/plastic' - - call results_closeGroup(results_addGroup(group)) - select case(phase_plasticity(p)) - - case(PLASTICITY_ISOTROPIC_ID) - call plastic_isotropic_results(phase_plasticityInstance(p),group) - - case(PLASTICITY_PHENOPOWERLAW_ID) - call plastic_phenopowerlaw_results(phase_plasticityInstance(p),group) - - case(PLASTICITY_KINEHARDENING_ID) - call plastic_kinehardening_results(phase_plasticityInstance(p),group) - - case(PLASTICITY_DISLOTWIN_ID) - call plastic_dislotwin_results(phase_plasticityInstance(p),group) - - case(PLASTICITY_DISLOTUNGSTEN_ID) - call plastic_dislotungsten_results(phase_plasticityInstance(p),group) - - case(PLASTICITY_NONLOCAL_ID) - call plastic_nonlocal_results(phase_plasticityInstance(p),group) - end select - - enddo plasticityLoop - -end subroutine plastic_results - - !-------------------------------------------------------------------------------------------------- !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6ed53c13c..49cb0a9f7 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -399,6 +399,7 @@ subroutine homogenization_results integer :: p character(len=:), allocatable :: group_base,group + call results_closeGroup(results_addGroup('current/homogenization/')) do p=1,size(material_name_homogenization) group_base = 'current/homogenization/'//trim(material_name_homogenization(p)) diff --git a/src/results.f90 b/src/results.f90 index ea9fd62d4..6363e3efc 100644 --- a/src/results.f90 +++ b/src/results.f90 @@ -111,8 +111,6 @@ subroutine results_addIncrement(inc,time) 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')) end subroutine results_addIncrement From 831e0ce1b95bcdf7392f0acdb2c81d4246b4d85c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 08:54:32 +0100 Subject: [PATCH 061/214] sorting responsibilities --- src/CPFEM.f90 | 1 - src/CPFEM2.f90 | 1 - src/constitutive.f90 | 138 +--------------------------------- src/constitutive_mech.f90 | 153 ++++++++++++++++++++++++++++++++++++-- 4 files changed, 147 insertions(+), 146 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index fe8c7d1b3..0d8e31b46 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -277,7 +277,6 @@ subroutine CPFEM_results(inc,time) call results_openJobFile call results_addIncrement(inc,time) call constitutive_results - call crystallite_results call homogenization_results call discretization_results call results_finalizeIncrement diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 636962948..dd4be8fc2 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -114,7 +114,6 @@ subroutine CPFEM_results(inc,time) call results_openJobFile call results_addIncrement(inc,time) call constitutive_results - call crystallite_results call homogenization_results call discretization_results call results_finalizeIncrement diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e49932cfe..6d3fee622 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -446,7 +446,6 @@ end function constitutive_deltaState crystallite_stressTangent, & crystallite_orientations, & crystallite_push33ToRef, & - crystallite_results, & crystallite_restartWrite, & crystallite_restartRead, & crystallite_forward, & @@ -964,7 +963,6 @@ subroutine crystallite_init phases => config_material%get('phase') - allocate(output_constituent(phases%length)) allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) allocate(constitutive_mech_partionedFi0(phases%length)) @@ -973,13 +971,7 @@ subroutine crystallite_init allocate(constitutive_mech_partionedLi0(phases%length)) do p = 1, phases%length Nconstituents = count(material_phaseAt == p) * discretization_nIPs - phase => phases%get(p) - mech => phase%get('mechanics',defaultVal = emptyDict) -#if defined(__GFORTRAN__) - output_constituent(p)%label = output_asStrings(mech) -#else - output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) -#endif + allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) @@ -1474,134 +1466,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) end function crystallite_push33ToRef -!-------------------------------------------------------------------------------------------------- -!> @brief writes crystallite results to HDF5 output file -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_results - - integer :: p,o - real(pReal), allocatable, dimension(:,:,:) :: selected_tensors - real(pReal), allocatable, dimension(:,:) :: selected_rotations - character(len=:), allocatable :: group,structureLabel - - do p=1,size(material_name_phase) - group = trim('current/phase')//'/'//trim(material_name_phase(p))//'/mechanics' - - call results_closeGroup(results_addGroup(group)) - - do o = 1, size(output_constituent(p)%label) - select case (output_constituent(p)%label(o)) - case('F') - selected_tensors = select_tensors(crystallite_partitionedF,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'deformation gradient','1') - case('F_e') - selected_tensors = select_tensors(crystallite_Fe,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'elastic deformation gradient','1') - case('F_p') - selected_tensors = select_tensors(crystallite_Fp,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'plastic deformation gradient','1') - case('F_i') - call results_writeDataset(group,constitutive_mech_Fi(p)%data,output_constituent(p)%label(o),& - 'inelastic deformation gradient','1') - case('L_p') - selected_tensors = select_tensors(crystallite_Lp,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'plastic velocity gradient','1/s') - case('L_i') - call results_writeDataset(group,constitutive_mech_Li(p)%data,output_constituent(p)%label(o),& - 'inelastic velocity gradient','1/s') - case('P') - selected_tensors = select_tensors(crystallite_P,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'First Piola-Kirchhoff stress','Pa') - case('S') - selected_tensors = select_tensors(crystallite_S,p) - call results_writeDataset(group,selected_tensors,output_constituent(p)%label(o),& - 'Second Piola-Kirchhoff stress','Pa') - case('O') - select case(lattice_structure(p)) - case(lattice_ISO_ID) - structureLabel = 'aP' - case(lattice_FCC_ID) - structureLabel = 'cF' - case(lattice_BCC_ID) - structureLabel = 'cI' - case(lattice_BCT_ID) - structureLabel = 'tI' - case(lattice_HEX_ID) - structureLabel = 'hP' - case(lattice_ORT_ID) - structureLabel = 'oP' - end select - selected_rotations = select_rotations(crystallite_orientation,p) - call results_writeDataset(group,selected_rotations,output_constituent(p)%label(o),& - 'crystal orientation as quaternion','q_0 ') - call results_addAttribute('Lattice',structureLabel,group//'/'//output_constituent(p)%label(o)) - end select - enddo - enddo - - contains - - !------------------------------------------------------------------------------------------------ - !> @brief select tensors for output - !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,instance) - - integer, intent(in) :: instance - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: e,i,c,j - - allocate(select_tensors(3,3,count(material_phaseAt==instance)*discretization_nIPs)) - - j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then - j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) - endif - enddo - enddo - enddo - - end function select_tensors - - -!-------------------------------------------------------------------------------------------------- -!> @brief select rotations for output -!-------------------------------------------------------------------------------------------------- - function select_rotations(dataset,instance) - - integer, intent(in) :: instance - type(rotation), dimension(:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:) :: select_rotations - integer :: e,i,c,j - - allocate(select_rotations(4,count(material_phaseAt==instance)*homogenization_maxNconstituents*discretization_nIPs)) - - j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then - j = j + 1 - select_rotations(1:4,j) = dataset(c,i,e)%asQuaternion() - endif - enddo - enddo - enddo - - end function select_rotations - -end subroutine crystallite_results - - !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7d6ef2998..10a86f9b4 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -299,10 +299,16 @@ module subroutine mech_init allocate(phase_elasticity(phases%length), source = ELASTICITY_undefined_ID) allocate(phase_elasticityInstance(phases%length), source = 0) allocate(phase_NstiffnessDegradations(phases%length),source=0) + allocate(output_constituent(phases%length)) do p = 1, phases%length phase => phases%get(p) mech => phase%get('mechanics') +#if defined(__GFORTRAN__) + output_constituent(p)%label = output_asStrings(mech) +#else + output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) +#endif elastic => mech%get('elasticity') if(elastic%get_asString('type') == 'hooke') then phase_elasticity(p) = ELASTICITY_HOOKE_ID @@ -652,30 +658,32 @@ module subroutine mech_results(group,ph) integer, intent(in) :: ph if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) & - call results_closeGroup(results_addGroup(group//'plastic')) + call results_closeGroup(results_addGroup(group//'plastic/')) select case(phase_plasticity(ph)) case(PLASTICITY_ISOTROPIC_ID) - call plastic_isotropic_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_isotropic_results(phase_plasticityInstance(ph),group//'plastic/') case(PLASTICITY_PHENOPOWERLAW_ID) - call plastic_phenopowerlaw_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_phenopowerlaw_results(phase_plasticityInstance(ph),group//'plastic/') case(PLASTICITY_KINEHARDENING_ID) - call plastic_kinehardening_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_kinehardening_results(phase_plasticityInstance(ph),group//'plastic/') case(PLASTICITY_DISLOTWIN_ID) - call plastic_dislotwin_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_dislotwin_results(phase_plasticityInstance(ph),group//'plastic/') case(PLASTICITY_DISLOTUNGSTEN_ID) - call plastic_dislotungsten_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_dislotungsten_results(phase_plasticityInstance(ph),group//'plastic/') case(PLASTICITY_NONLOCAL_ID) - call plastic_nonlocal_results(phase_plasticityInstance(ph),group//'plastic') + call plastic_nonlocal_results(phase_plasticityInstance(ph),group//'plastic/') end select + call crystallite_results(group,ph) + end subroutine mech_results module subroutine mech_restart_read(fileHandle) @@ -1237,5 +1245,136 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) end subroutine integrateStateRK + +!-------------------------------------------------------------------------------------------------- +!> @brief writes crystallite results to HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine crystallite_results(group,ph) + + character(len=*), intent(in) :: group + integer, intent(in) :: ph + + integer :: ou + real(pReal), allocatable, dimension(:,:,:) :: selected_tensors + real(pReal), allocatable, dimension(:,:) :: selected_rotations + character(len=:), allocatable :: structureLabel + + + call results_closeGroup(results_addGroup(group//'/mechanics/')) + + do ou = 1, size(output_constituent(ph)%label) + + select case (output_constituent(ph)%label(ou)) + case('F') + selected_tensors = select_tensors(crystallite_partitionedF,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'deformation gradient','1') + case('F_e') + selected_tensors = select_tensors(crystallite_Fe,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'elastic deformation gradient','1') + case('F_p') + selected_tensors = select_tensors(crystallite_Fp,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'plastic deformation gradient','1') + case('F_i') + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& + 'inelastic deformation gradient','1') + case('L_p') + selected_tensors = select_tensors(crystallite_Lp,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'plastic velocity gradient','1/s') + case('L_i') + call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& + 'inelastic velocity gradient','1/s') + case('P') + selected_tensors = select_tensors(crystallite_P,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'First Piola-Kirchhoff stress','Pa') + case('S') + selected_tensors = select_tensors(crystallite_S,ph) + call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + 'Second Piola-Kirchhoff stress','Pa') + case('O') + select case(lattice_structure(ph)) + case(lattice_ISO_ID) + structureLabel = 'aP' + case(lattice_FCC_ID) + structureLabel = 'cF' + case(lattice_BCC_ID) + structureLabel = 'cI' + case(lattice_BCT_ID) + structureLabel = 'tI' + case(lattice_HEX_ID) + structureLabel = 'hP' + case(lattice_ORT_ID) + structureLabel = 'oP' + end select + selected_rotations = select_rotations(crystallite_orientation,ph) + call results_writeDataset(group//'/mechanics/',selected_rotations,output_constituent(ph)%label(ou),& + 'crystal orientation as quaternion','q_0 (q_1 q_2 q_3)') + call results_addAttribute('Lattice',structureLabel,group//'/mechanics/'//output_constituent(ph)%label(ou)) + end select + enddo + + + contains + + !------------------------------------------------------------------------------------------------ + !> @brief select tensors for output + !------------------------------------------------------------------------------------------------ + function select_tensors(dataset,instance) + + integer, intent(in) :: instance + real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset + real(pReal), allocatable, dimension(:,:,:) :: select_tensors + integer :: e,i,c,j + + allocate(select_tensors(3,3,count(material_phaseAt==instance)*discretization_nIPs)) + + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, discretization_nIPs + do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(c,e) == instance) then + j = j + 1 + select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) + endif + enddo + enddo + enddo + + end function select_tensors + + +!-------------------------------------------------------------------------------------------------- +!> @brief select rotations for output +!-------------------------------------------------------------------------------------------------- + function select_rotations(dataset,instance) + + integer, intent(in) :: instance + type(rotation), dimension(:,:,:), intent(in) :: dataset + real(pReal), allocatable, dimension(:,:) :: select_rotations + integer :: e,i,c,j + + allocate(select_rotations(4,count(material_phaseAt==instance)*homogenization_maxNconstituents*discretization_nIPs)) + + j=0 + do e = 1, size(material_phaseAt,2) + do i = 1, discretization_nIPs + do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(c,e) == instance) then + j = j + 1 + select_rotations(1:4,j) = dataset(c,i,e)%asQuaternion() + endif + enddo + enddo + enddo + + end function select_rotations + +end subroutine crystallite_results + + end submodule constitutive_mech From 0e0814dbc396a248dc021a0dde71899168a8e2e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 10:03:19 +0100 Subject: [PATCH 062/214] WIP: mechanics takes care of mechanics variables --- src/constitutive.f90 | 21 ++++++++------------- src/constitutive_mech.f90 | 18 +++++++++++++++++- 2 files changed, 25 insertions(+), 14 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6d3fee622..de38e11cf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -160,6 +160,10 @@ module constitutive integer(HID_T), intent(in) :: fileHandle end subroutine mech_restart_read + module subroutine mech_initializeRestorationPoints(ph,me) + integer, intent(in) :: ph, me + end subroutine mech_initializeRestorationPoints + ! == cleaned:end =================================================================================== module function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) @@ -197,11 +201,6 @@ module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(br end function constitutive_deltaState - module function plastic_active(plastic_label) result(active_plastic) - character(len=*), intent(in) :: plastic_label - logical, dimension(:), allocatable :: active_plastic - end function plastic_active - module function source_active(source_label,src_length) result(active_source) character(len=*), intent(in) :: source_label integer, intent(in) :: src_length @@ -437,7 +436,6 @@ end function constitutive_deltaState constitutive_forward, & constitutive_restore, & plastic_nonlocal_updateCompatibility, & - plastic_active, & source_active, & kinematics_active, & converged, & @@ -1195,20 +1193,17 @@ subroutine constitutive_initializeRestorationPoints(i,e) e !< element number integer :: & c, & !< constituent number - s,p, m + s,ph, me do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) + ph = material_phaseAt(c,e) + me = material_phaseMemberAt(c,i,e) crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) - constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) - constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) = constitutive_mech_Li0(p)%data(1:3,1:3,m) crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) - plasticState(material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & - plasticState(material_phaseAt(c,e))%state0( :,material_phasememberAt(c,i,e)) + call mech_initializeRestorationPoints(ph,me) do s = 1, phase_Nsources(material_phaseAt(c,e)) sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 10a86f9b4..7516e6ca5 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -360,7 +360,7 @@ end subroutine mech_init !-------------------------------------------------------------------------------------------------- !> @brief checks if a plastic module is active or not !-------------------------------------------------------------------------------------------------- -module function plastic_active(plastic_label) result(active_plastic) +function plastic_active(plastic_label) result(active_plastic) character(len=*), intent(in) :: plastic_label !< type of plasticity model logical, dimension(:), allocatable :: active_plastic @@ -1376,5 +1376,21 @@ subroutine crystallite_results(group,ph) end subroutine crystallite_results +!-------------------------------------------------------------------------------------------------- +!> @brief Backup data for homog cutback. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_initializeRestorationPoints(ph,me) + + integer, intent(in) :: & + ph, & + me + + constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) + plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) + +end subroutine mech_initializeRestorationPoints + + end submodule constitutive_mech From fa3d7b8dc7807672a250f9f09fcafd5aa9b99811 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 10:23:46 +0100 Subject: [PATCH 063/214] new name --- src/constitutive.f90 | 6 +++--- src/homogenization.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index de38e11cf..47a7dfc4b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -448,7 +448,7 @@ end function constitutive_deltaState crystallite_restartRead, & crystallite_forward, & constitutive_initializeRestorationPoints, & - crystallite_windForward, & + constitutive_windForward, & crystallite_restore contains @@ -1216,7 +1216,7 @@ end subroutine constitutive_initializeRestorationPoints !-------------------------------------------------------------------------------------------------- !> @brief Wind homog inc forward. !-------------------------------------------------------------------------------------------------- -subroutine crystallite_windForward(i,e) +subroutine constitutive_windForward(i,e) integer, intent(in) :: & i, & !< integration point number @@ -1242,7 +1242,7 @@ subroutine crystallite_windForward(i,e) enddo enddo -end subroutine crystallite_windForward +end subroutine constitutive_windForward !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 49cb0a9f7..dcde08f32 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -231,7 +231,7 @@ subroutine materialpoint_stressAndItsTangent(dt) steppingNeeded: if (subStep(i,e) > num%subStepMinHomog) then ! wind forward grain starting point - call crystallite_windForward(i,e) + call constitutive_windForward(i,e) if(homogState(material_homogenizationAt(e))%sizeState > 0) & homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & From 2627ed1a829577a94018d2544f4b7539fcf0b789 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 10:44:43 +0100 Subject: [PATCH 064/214] cleaning --- src/constitutive.f90 | 19 +------------------ src/constitutive_mech.f90 | 6 +++++- 2 files changed, 6 insertions(+), 19 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 47a7dfc4b..3c4e21989 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -60,11 +60,7 @@ module constitutive logical, dimension(:,:,:), allocatable :: & crystallite_converged !< convergence flag - type :: tOutput !< new requested output (per phase) - character(len=pStringLen), allocatable, dimension(:) :: & - label - end type tOutput - type(tOutput), allocatable, dimension(:) :: output_constituent + type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -201,19 +197,6 @@ module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(br end function constitutive_deltaState - module function source_active(source_label,src_length) result(active_source) - character(len=*), intent(in) :: source_label - integer, intent(in) :: src_length - logical, dimension(:,:), allocatable :: active_source - end function source_active - - module function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) - character(len=*), intent(in) :: kinematics_label - integer, intent(in) :: kinematics_length - logical, dimension(:,:), allocatable :: active_kinematics - end function kinematics_active - - module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7516e6ca5..c000e6c43 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -270,7 +270,11 @@ submodule(constitutive) constitutive_mech end interface - + type :: tOutput !< new requested output (per phase) + character(len=pStringLen), allocatable, dimension(:) :: & + label + end type tOutput + type(tOutput), allocatable, dimension(:) :: output_constituent contains From 81602dd0e0806492d6683f3ed7ec876e465386e7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 11:13:39 +0100 Subject: [PATCH 065/214] for internal use only --- src/constitutive.f90 | 20 -------------------- src/constitutive_mech.f90 | 2 +- 2 files changed, 1 insertion(+), 21 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 3c4e21989..21e2b82ee 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -162,22 +162,6 @@ module constitutive ! == cleaned:end =================================================================================== - module function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) - - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - phase, & - of - real(pReal), intent(in) :: & - subdt !< timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FpArray !< plastic deformation gradient - - logical :: broken -end function constitutive_collectDotState - module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) @@ -408,10 +392,6 @@ end function constitutive_deltaState constitutive_init, & constitutive_homogenizedC, & constitutive_LiAndItsTangents, & - constitutive_collectDotState, & - constitutive_collectDotState_source, & - constitutive_deltaState, & - constitutive_deltaState_source, & constitutive_damage_getRateAndItsTangents, & constitutive_thermal_getRateAndItsTangents, & constitutive_results, & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index c000e6c43..e18b8401a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -546,7 +546,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -module function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) +function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point From 8b2f75b99b02a6f9844d4697890a9c2f59857da7 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 22 Dec 2020 11:22:57 +0100 Subject: [PATCH 066/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-75-gac45427e9 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5c2eab7c5..3e5a7aa8c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-62-gd1c7ec068 +v3.0.0-alpha2-75-gac45427e9 From 830a61a9ffa89afa93fcc67999306ef043889979 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 11:38:29 +0100 Subject: [PATCH 067/214] systematic names --- src/constitutive.f90 | 8 ++++---- src/constitutive_mech.f90 | 18 +++++++++--------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 21e2b82ee..fe978e2ef 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -637,7 +637,7 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_collectDotState_source(S, ipc, ip, el,phase,of) result(broken) +function constitutive_source_collectDotState(S, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -676,7 +676,7 @@ function constitutive_collectDotState_source(S, ipc, ip, el,phase,of) result(bro enddo SourceLoop -end function constitutive_collectDotState_source +end function constitutive_source_collectDotState !-------------------------------------------------------------------------------------------------- @@ -1453,7 +1453,7 @@ subroutine integrateSourceState(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_source_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) return do s = 1, phase_Nsources(p) @@ -1471,7 +1471,7 @@ subroutine integrateSourceState(g,i,e) source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) enddo - broken = constitutive_collectDotState_source(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_source_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) exit iteration do s = 1, phase_Nsources(p) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index e18b8401a..0cb4d97e6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -546,7 +546,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) +function mech_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -597,7 +597,7 @@ function constitutive_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) resu broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) -end function constitutive_collectDotState +end function mech_collectDotState !-------------------------------------------------------------------------------------------------- @@ -952,7 +952,7 @@ module subroutine integrateStateFPI(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -970,7 +970,7 @@ module subroutine integrateStateFPI(g,i,e) broken = integrateStress(g,i,e) if(broken) exit iteration - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration @@ -1040,7 +1040,7 @@ module subroutine integrateStateEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1081,7 +1081,7 @@ module subroutine integrateStateAdaptiveEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1098,7 +1098,7 @@ module subroutine integrateStateAdaptiveEuler(g,i,e) broken = integrateStress(g,i,e) if(broken) return - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1193,7 +1193,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1216,7 +1216,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) broken = integrateStress(g,i,e,CC(stage)) if(broken) exit - broken = constitutive_collectDotState(crystallite_partitionedFp0, & + broken = mech_collectDotState(crystallite_partitionedFp0, & crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) if(broken) exit From 11d7f034e47d04a857aa1ef26f62aa6a9fafe461 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 12:20:00 +0100 Subject: [PATCH 068/214] code follows modular structure --- src/constitutive.f90 | 69 +++++++++++++++++++++++++++---------- src/constitutive_damage.f90 | 69 +++++++++++++++++++------------------ 2 files changed, 86 insertions(+), 52 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index fe978e2ef..e68ade06f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -152,6 +152,12 @@ module constitutive integer, intent(in) :: ph end subroutine mech_results + module subroutine damage_results(group,ph) + character(len=*), intent(in) :: group + integer, intent(in) :: ph + end subroutine damage_results + + module subroutine mech_restart_read(fileHandle) integer(HID_T), intent(in) :: fileHandle end subroutine mech_restart_read @@ -314,10 +320,6 @@ end function constitutive_deltaState C end subroutine source_damage_isoBrittle_deltaState - module subroutine damage_results - end subroutine damage_results - - module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, ipc, ip, el) @@ -468,7 +470,7 @@ end subroutine constitutive_init !-------------------------------------------------------------------------------------------------- !> @brief checks if a source mechanism is active or not !-------------------------------------------------------------------------------------------------- -module function source_active(source_label,src_length) result(active_source) +function source_active(source_label,src_length) result(active_source) character(len=*), intent(in) :: source_label !< name of source mechanism integer, intent(in) :: src_length !< max. number of sources in system @@ -499,8 +501,7 @@ end function source_active !-------------------------------------------------------------------------------------------------- !> @brief checks if a kinematic mechanism is active or not !-------------------------------------------------------------------------------------------------- - -module function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) +function kinematics_active(kinematics_label,kinematics_length) result(active_kinematics) character(len=*), intent(in) :: kinematics_label !< name of kinematic mechanism integer, intent(in) :: kinematics_length !< max. number of kinematics in system @@ -631,13 +632,10 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & end subroutine constitutive_LiAndItsTangents - - - !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_source_collectDotState(S, ipc, ip, el,phase,of) result(broken) +function constitutive_damage_collectDotState(S, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -667,6 +665,39 @@ function constitutive_source_collectDotState(S, ipc, ip, el,phase,of) result(bro case (SOURCE_damage_anisoDuctile_ID) sourceType call source_damage_anisoDuctile_dotState(ipc, ip, el) + end select sourceType + + broken = broken .or. any(IEEE_is_NaN(sourceState(phase)%p(i)%dotState(:,of))) + + enddo SourceLoop + +end function constitutive_damage_collectDotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_thermal_collectDotState(S, ipc, ip, el,phase,of) result(broken) + + integer, intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + phase, & + of + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola Kirchhoff stress (vector notation) + integer :: & + i !< counter in source loop + logical :: broken + + + broken = .false. + + SourceLoop: do i = 1, phase_Nsources(phase) + + sourceType: select case (phase_source(i,phase)) + case (SOURCE_thermal_externalheat_ID) sourceType call source_thermal_externalheat_dotState(phase,of) @@ -676,7 +707,7 @@ function constitutive_source_collectDotState(S, ipc, ip, el,phase,of) result(bro enddo SourceLoop -end function constitutive_source_collectDotState +end function constitutive_thermal_collectDotState !-------------------------------------------------------------------------------------------------- @@ -805,20 +836,18 @@ subroutine constitutive_results character(len=:), allocatable :: group - group = '/current/phase/' - call results_closeGroup(results_addGroup(group)) + call results_closeGroup(results_addGroup('/current/phase/')) do ph = 1, size(material_name_phase) - group = group//trim(material_name_phase(ph))//'/' + group = '/current/phase/'//trim(material_name_phase(ph))//'/' call results_closeGroup(results_addGroup(group)) call mech_results(group,ph) + call damage_results(group,ph) enddo - call damage_results - end subroutine constitutive_results @@ -1453,7 +1482,8 @@ subroutine integrateSourceState(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_source_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) return do s = 1, phase_Nsources(p) @@ -1471,7 +1501,8 @@ subroutine integrateSourceState(g,i,e) source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) enddo - broken = constitutive_source_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) exit iteration do s = 1, phase_Nsources(p) diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index a864ca1b8..4e23b78ea 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -1,5 +1,5 @@ !---------------------------------------------------------------------------------------------------- -!> @brief internal microstructure state for all damage sources and kinematics constitutive models +!> @brief internal microstructure state for all damage sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_damage @@ -8,7 +8,7 @@ submodule(constitutive) constitutive_damage module function source_damage_anisoBrittle_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources - end function source_damage_anisoBrittle_init + end function source_damage_anisoBrittle_init module function source_damage_anisoDuctile_init(source_length) result(mySources) integer, intent(in) :: source_length @@ -23,7 +23,7 @@ submodule(constitutive) constitutive_damage module function source_damage_isoDuctile_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources - end function source_damage_isoDuctile_init + end function source_damage_isoDuctile_init module function kinematics_cleavage_opening_init(kinematics_length) result(myKinematics) integer, intent(in) :: kinematics_length @@ -39,14 +39,14 @@ submodule(constitutive) constitutive_damage module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) integer, intent(in) :: & phase, & !< phase ID of element - constituent !< position of element within its phase instance + constituent !< position of element within its phase instance real(pReal), intent(in) :: & - phi !< damage parameter + phi !< damage parameter real(pReal), intent(out) :: & localphiDot, & dLocalphiDot_dPhi end subroutine source_damage_anisoBrittle_getRateAndItsTangent - + module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) integer, intent(in) :: & phase, & !< phase ID of element @@ -129,7 +129,7 @@ module subroutine damage_init allocate(sourceState(ph)%p(phase_Nsources(ph))) enddo - allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) + allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then @@ -141,19 +141,19 @@ module subroutine damage_init !-------------------------------------------------------------------------------------------------- ! initialize kinematic mechanisms - allocate(phase_Nkinematics(phases%length),source = 0) + allocate(phase_Nkinematics(phases%length),source = 0) do ph = 1,phases%length phase => phases%get(ph) kinematics => phase%get('kinematics',defaultVal=emptyList) phase_Nkinematics(ph) = kinematics%length enddo - - allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID) + + allocate(phase_kinematics(maxval(phase_Nkinematics),phases%length), source = KINEMATICS_undefined_ID) if(maxval(phase_Nkinematics) /= 0) then where(kinematics_cleavage_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_cleavage_opening_ID where(kinematics_slipplane_opening_init(maxval(phase_Nkinematics))) phase_kinematics = KINEMATICS_slipplane_opening_ID - endif + endif end subroutine damage_init @@ -167,7 +167,7 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi ip, & !< integration point number el !< element number real(pReal), intent(in) :: & - phi !< damage parameter + phi !< damage parameter real(pReal), intent(inout) :: & phiDot, & dPhiDot_dPhi @@ -183,7 +183,7 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi phiDot = 0.0_pReal dPhiDot_dPhi = 0.0_pReal - + do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) phase = material_phaseAt(grain,el) constituent = material_phasememberAt(grain,ip,el) @@ -217,32 +217,35 @@ end subroutine constitutive_damage_getRateAndItsTangents !---------------------------------------------------------------------------------------------- !< @brief writes damage sources results to HDF5 output file !---------------------------------------------------------------------------------------------- -module subroutine damage_results +module subroutine damage_results(group,ph) - integer :: p,i - character(len=pStringLen) :: group + character(len=*), intent(in) :: group + integer, intent(in) :: ph - do p = 1, size(material_name_phase) + integer :: so - sourceLoop: do i = 1, phase_Nsources(p) - group = trim('current/phase')//'/'//trim(material_name_phase(p)) - group = trim(group)//'/sources' - call results_closeGroup(results_addGroup(group)) + sourceLoop: do so = 1, phase_Nsources(ph) - sourceType: select case (phase_source(i,p)) + if (phase_source(so,ph) /= SOURCE_UNDEFINED_ID) & + call results_closeGroup(results_addGroup(group//'damage/')) - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_results(p,group) - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_results(p,group) - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_results(p,group) - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_results(p,group) - end select sourceType + sourceType: select case (phase_source(so,ph)) - enddo SourceLoop - enddo + case (SOURCE_damage_anisoBrittle_ID) sourceType + call source_damage_anisoBrittle_results(ph,group//'damage/') + + case (SOURCE_damage_anisoDuctile_ID) sourceType + call source_damage_anisoDuctile_results(ph,group//'damage/') + + case (SOURCE_damage_isoBrittle_ID) sourceType + call source_damage_isoBrittle_results(ph,group//'damage/') + + case (SOURCE_damage_isoDuctile_ID) sourceType + call source_damage_isoDuctile_results(ph,group//'damage/') + + end select sourceType + + enddo SourceLoop end subroutine damage_results From b452cce2f6529f5997e0b95ed96f8af2f2161908 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 19:13:30 +0100 Subject: [PATCH 069/214] only needed for mechanics --- src/constitutive.f90 | 18 ------------------ src/constitutive_mech.f90 | 3 ++- 2 files changed, 2 insertions(+), 19 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e68ade06f..b4a638575 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -61,7 +61,6 @@ module constitutive crystallite_converged !< convergence flag - type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data end type @@ -169,23 +168,6 @@ module constitutive ! == cleaned:end =================================================================================== -module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) - - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - phase, & - of - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fi !< intermediate deformation gradient - logical :: & - broken - - -end function constitutive_deltaState - module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) integer, intent(in) :: & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 0cb4d97e6..6da151c9d 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -604,7 +604,7 @@ end function mech_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -module function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) +function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -1389,6 +1389,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) ph, & me + constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) From f28fe0812e6ea8501071a2dc4d4af4e1f388fa9b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 19:24:00 +0100 Subject: [PATCH 070/214] sorting --- src/constitutive.f90 | 36 +++--------------------------------- src/constitutive_mech.f90 | 37 +++++++++++++++++++++++++++++++------ 2 files changed, 34 insertions(+), 39 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b4a638575..2423b5af8 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -351,22 +351,6 @@ module constitutive integer, intent(in) :: e, i, g end subroutine integrateStateFPI - module subroutine integrateStateEuler(g,i,e) - integer, intent(in) :: e, i, g - end subroutine integrateStateEuler - - module subroutine integrateStateAdaptiveEuler(g,i,e) - integer, intent(in) :: e, i, g - end subroutine integrateStateAdaptiveEuler - - module subroutine integrateStateRK4(g,i,e) - integer, intent(in) :: e, i, g - end subroutine integrateStateRK4 - - module subroutine integrateStateRKCK45(g,i,e) - integer, intent(in) :: e, i, g - end subroutine integrateStateRKCK45 - end interface @@ -696,7 +680,7 @@ end function constitutive_thermal_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState_source(Fe, ipc, ip, el, phase, of) result(broken) +function constitutive_damage_deltaState(Fe, ipc, ip, el, phase, of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -735,7 +719,7 @@ function constitutive_deltaState_source(Fe, ipc, ip, el, phase, of) result(broke enddo SourceLoop -end function constitutive_deltaState_source +end function constitutive_damage_deltaState !-------------------------------------------------------------------------------------------------- @@ -918,20 +902,6 @@ subroutine crystallite_init if(num%nState < 1) call IO_error(301,ext_msg='nState') if(num%nStress< 1) call IO_error(301,ext_msg='nStress') - select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) - case('FPI') - integrateState => integrateStateFPI - case('Euler') - integrateState => integrateStateEuler - case('AdaptiveEuler') - integrateState => integrateStateAdaptiveEuler - case('RK4') - integrateState => integrateStateRK4 - case('RKCK45') - integrateState => integrateStateRKCK45 - case default - call IO_error(301,ext_msg='integrator') - end select phases => config_material%get('phase') @@ -1505,7 +1475,7 @@ subroutine integrateSourceState(g,i,e) enddo if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState_source(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) + broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6da151c9d..0af2621c0 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -133,7 +133,7 @@ submodule(constitutive) constitutive_mech el !< current element number end subroutine plastic_nonlocal_LpAndItsTangent - module subroutine plastic_isotropic_dotState(Mp,instance,of) + module subroutine plastic_isotropic_dotState(Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -220,7 +220,7 @@ submodule(constitutive) constitutive_mech el !< current element number end subroutine plastic_nonlocal_dependentState - module subroutine plastic_kinehardening_deltaState(Mp,instance,of) + module subroutine plastic_kinehardening_deltaState(Mp,instance,of) real(pReal), dimension(3,3), intent(in) :: & Mp !< Mandel stress integer, intent(in) :: & @@ -289,6 +289,7 @@ module subroutine mech_init p, & stiffDegradationCtr class(tNode), pointer :: & + num_crystallite, & phases, & phase, & mech, & @@ -358,6 +359,30 @@ module subroutine mech_init phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo + num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) + + select case(num_crystallite%get_asString('integrator',defaultVal='FPI')) + + case('FPI') + integrateState => integrateStateFPI + + case('Euler') + integrateState => integrateStateEuler + + case('AdaptiveEuler') + integrateState => integrateStateAdaptiveEuler + + case('RK4') + integrateState => integrateStateRK4 + + case('RKCK45') + integrateState => integrateStateRKCK45 + + case default + call IO_error(301,ext_msg='integrator') + + end select + end subroutine mech_init @@ -1024,7 +1049,7 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -module subroutine integrateStateEuler(g,i,e) +subroutine integrateStateEuler(g,i,e) integer, intent(in) :: & e, & !< element index in element loop @@ -1062,7 +1087,7 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -module subroutine integrateStateAdaptiveEuler(g,i,e) +subroutine integrateStateAdaptiveEuler(g,i,e) integer, intent(in) :: & e, & !< element index in element loop @@ -1115,7 +1140,7 @@ end subroutine integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -module subroutine integrateStateRK4(g,i,e) +subroutine integrateStateRK4(g,i,e) integer, intent(in) :: g,i,e @@ -1138,7 +1163,7 @@ end subroutine integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -module subroutine integrateStateRKCK45(g,i,e) +subroutine integrateStateRKCK45(g,i,e) integer, intent(in) :: g,i,e From 79a8a40e6d8205203d7fb1e350d861ca84251ee0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 20:45:27 +0100 Subject: [PATCH 071/214] Fp is directly accessible --- src/constitutive_mech.f90 | 14 ++++++-------- src/constitutive_plastic_nonlocal.f90 | 25 +++++++++++-------------- 2 files changed, 17 insertions(+), 22 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 0af2621c0..b879d0fe2 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -177,13 +177,12 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_disloTungsten_dotState - module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & + module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F, & !< deformation gradient - Fp !< plastic deformation gradient + F !< deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -209,10 +208,9 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_dislotungsten_dependentState - module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) + module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) real(pReal), dimension(3,3), intent(in) :: & - F, & !< deformation gradient - Fp !< plastic deformation gradient + F !< deformation gradient integer, intent(in) :: & instance, & of, & @@ -490,7 +488,7 @@ module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType call plastic_dislotungsten_dependentState(instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,Fp,instance,of,ip,el) + call plastic_nonlocal_dependentState (F,instance,of,ip,el) end select plasticityType end subroutine constitutive_plastic_dependentState @@ -616,7 +614,7 @@ function mech_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broke call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,FpArray,temperature(ho)%p(tme),subdt, & + call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,temperature(ho)%p(tme),subdt, & instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 65f74b6cc..d6209d3a0 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -552,11 +552,10 @@ end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) +module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) real(pReal), dimension(3,3), intent(in) :: & - F, & - Fp + F integer, intent(in) :: & instance, & of, & @@ -643,8 +642,8 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el) rho0 = getRho0(instance,of,ip,el) if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then - invFp = math_inv33(Fp) - invFe = matmul(Fp,math_inv33(F)) + invFp = math_inv33(crystallite_Fp(1:3,1:3,1,ip,el)) + invFe = matmul(crystallite_Fp(1:3,1:3,1,ip,el),math_inv33(F)) rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg) rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg) @@ -973,14 +972,13 @@ end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & +module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F, & !< elastic deformation gradient - Fp !< plastic deformation gradient + F !< Deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -1147,7 +1145,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,Fp,timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(F,timestep, instance,of,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1176,11 +1174,10 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) +function rhoDotFlux(F,timestep, instance,of,ip,el) real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F, & !< elastic deformation gradient - Fp !< plastic deformation gradient + F !< Deformation gradient real(pReal), intent(in) :: & timestep !< substepped crystallite time increment integer, intent(in) :: & @@ -1293,7 +1290,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) m(1:3,:,4) = prm%slip_transverse my_F = F(1:3,1:3,1,ip,el) - my_Fe = matmul(my_F, math_inv33(Fp(1:3,1:3,1,ip,el))) + my_Fe = matmul(my_F, math_inv33(crystallite_Fp(1:3,1:3,1,ip,el))) neighbors: do n = 1,nIPneighbors @@ -1311,7 +1308,7 @@ function rhoDotFlux(F,Fp,timestep, instance,of,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el) - neighbor_Fe = matmul(neighbor_F, math_inv33(Fp(1:3,1:3,1,neighbor_ip,neighbor_el))) + neighbor_Fe = matmul(neighbor_F, math_inv33(crystallite_Fp(1:3,1:3,1,neighbor_ip,neighbor_el))) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average Favg = my_F From 3719b9a52ceb37b6534a683bfc503ec2fd79365b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 22:21:11 +0100 Subject: [PATCH 072/214] storing Lp and related fields in new structure --- src/constitutive.f90 | 99 +++++++++++++-------------- src/constitutive_mech.f90 | 39 ++++------- src/constitutive_plastic_nonlocal.f90 | 12 ++-- 3 files changed, 69 insertions(+), 81 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 2423b5af8..c71856d1a 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -35,9 +35,6 @@ module constitutive ! crystallite_Fe, & !< current "elastic" def grad (end of converged time step) ! - crystallite_Fp, & !< current plastic def grad (end of converged time step) - crystallite_Fp0, & !< plastic def grad at start of FE inc - crystallite_partitionedFp0,& !< plastic def grad at start of homog inc crystallite_subFp0,& !< plastic def grad at start of crystallite inc ! crystallite_subFi0,& !< intermediate def grad at start of crystallite inc @@ -71,7 +68,11 @@ module constitutive constitutive_mech_partionedFi0, & constitutive_mech_Li, & constitutive_mech_Li0, & - constitutive_mech_partionedLi0 + constitutive_mech_partionedLi0, & + constitutive_mech_Fp, & + constitutive_mech_Fp0, & + constitutive_mech_partionedFp0 + type :: tNumerics integer :: & @@ -320,14 +321,13 @@ module constitutive end subroutine constitutive_plastic_LpAndItsTangents - module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) + module subroutine constitutive_plastic_dependentState(F, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & - F, & !< elastic deformation gradient - Fp !< plastic deformation gradient + F !< elastic deformation gradient end subroutine constitutive_plastic_dependentState @@ -643,33 +643,22 @@ end function constitutive_damage_collectDotState !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_thermal_collectDotState(S, ipc, ip, el,phase,of) result(broken) +function constitutive_thermal_collectDotState(ph,me) result(broken) - integer, intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - phase, & - of - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) - integer :: & - i !< counter in source loop + integer, intent(in) :: ph, me logical :: broken + integer :: i + broken = .false. - SourceLoop: do i = 1, phase_Nsources(phase) + SourceLoop: do i = 1, phase_Nsources(ph) - sourceType: select case (phase_source(i,phase)) + if (phase_source(i,ph) == SOURCE_thermal_externalheat_ID) & + call source_thermal_externalheat_dotState(ph,me) - case (SOURCE_thermal_externalheat_ID) sourceType - call source_thermal_externalheat_dotState(phase,of) - - end select sourceType - - broken = broken .or. any(IEEE_is_NaN(sourceState(phase)%p(i)%dotState(:,of))) + broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(i)%dotState(:,me))) enddo SourceLoop @@ -853,12 +842,12 @@ subroutine crystallite_init allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & - crystallite_F0,crystallite_Fp0,crystallite_Lp0, & + crystallite_F0,crystallite_Lp0, & crystallite_partitionedS0, & - crystallite_partitionedF0,crystallite_partitionedFp0,& + crystallite_partitionedF0,& crystallite_partitionedLp0, & crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Fp,crystallite_Lp, & + crystallite_Fe,crystallite_Lp, & crystallite_subF,crystallite_subF0, & crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) @@ -908,6 +897,9 @@ subroutine crystallite_init allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) allocate(constitutive_mech_partionedFi0(phases%length)) + allocate(constitutive_mech_Fp(phases%length)) + allocate(constitutive_mech_Fp0(phases%length)) + allocate(constitutive_mech_partionedFp0(phases%length)) allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partionedLi0(phases%length)) @@ -917,6 +909,9 @@ subroutine crystallite_init allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedFp0(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(p)%data(3,3,Nconstituents)) allocate(constitutive_mech_partionedLi0(p)%data(3,3,Nconstituents)) @@ -933,39 +928,38 @@ subroutine crystallite_init p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) - crystallite_Fp0(1:3,1:3,c,i,e) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - crystallite_Fp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) & - / math_det33(crystallite_Fp0(1:3,1:3,c,i,e))**(1.0_pReal/3.0_pReal) + constitutive_mech_Fp0(p)%data(1:3,1:3,m) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + constitutive_mech_Fp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) & + / math_det33(constitutive_mech_Fp0(p)%data(1:3,1:3,m))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(p)%data(1:3,1:3,m) = math_I3 crystallite_F0(1:3,1:3,c,i,e) = math_I3 crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(constitutive_mech_Fi0(p)%data(1:3,1:3,m), & - crystallite_Fp0(1:3,1:3,c,i,e))) ! assuming that euler angles are given in internal strain free configuration - crystallite_Fp(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) + constitutive_mech_Fp0(p)%data(1:3,1:3,m))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) - + constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) crystallite_requested(c,i,e) = .true. enddo; enddo enddo !$OMP END PARALLEL DO - - crystallite_partitionedFp0 = crystallite_Fp0 crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 call crystallite_orientations() - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(p,m) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1),FEsolving_execIP(2) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) + p = material_phaseAt(c,e) + m = material_phaseMemberAt(c,i,e) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & - crystallite_partitionedFp0(1:3,1:3,c,i,e), & c,i,e) ! update dependent state variables to be consistent with basic states enddo enddo @@ -1018,7 +1012,7 @@ function crystallite_stress() sourceState(material_phaseAt(c,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phaseMemberAt(c,i,e)) enddo - crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) + crystallite_subFp0(1:3,1:3,c,i,e) = constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) subFrac(c,i,e) = 0.0_pReal @@ -1058,7 +1052,7 @@ function crystallite_stress() crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) subLi0(1:3,1:3,c,i,e) = constitutive_mech_Li(p)%data(1:3,1:3,m) - crystallite_subFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) + crystallite_subFp0(1:3,1:3,c,i,e) = constitutive_mech_Fp(p)%data(1:3,1:3,m) crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_Fi(p)%data(1:3,1:3,m) plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) @@ -1072,7 +1066,7 @@ function crystallite_stress() ! cut back (reduced time and restore) else crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) - crystallite_Fp (1:3,1:3,c,i,e) = crystallite_subFp0(1:3,1:3,c,i,e) + constitutive_mech_Fp(p)%data(1:3,1:3,m) = crystallite_subFp0(1:3,1:3,c,i,e) constitutive_mech_Fi(p)%data(1:3,1:3,m) = crystallite_subFi0(1:3,1:3,c,i,e) crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback @@ -1098,7 +1092,7 @@ function crystallite_stress() -crystallite_partitionedF0(1:3,1:3,c,i,e)) crystallite_Fe(1:3,1:3,c,i,e) = matmul(crystallite_subF(1:3,1:3,c,i,e), & math_inv33(matmul(constitutive_mech_Fi(p)%data(1:3,1:3,m), & - crystallite_Fp(1:3,1:3,c,i,e)))) + constitutive_mech_Fp(p)%data(1:3,1:3,m)))) crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) crystallite_converged(c,i,e) = .false. call integrateState(c,i,e) @@ -1142,7 +1136,6 @@ subroutine constitutive_initializeRestorationPoints(i,e) do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) ph = material_phaseAt(c,e) me = material_phaseMemberAt(c,i,e) - crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp0(1:3,1:3,c,i,e) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) @@ -1172,7 +1165,7 @@ subroutine constitutive_windForward(i,e) p = material_phaseAt(c,e) m = material_phaseMemberAt(c,i,e) crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) - crystallite_partitionedFp0(1:3,1:3,c,i,e) = crystallite_Fp (1:3,1:3,c,i,e) + constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp(p)%data(1:3,1:3,m) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi(p)%data(1:3,1:3,m) constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) = constitutive_mech_Li(p)%data(1:3,1:3,m) @@ -1210,7 +1203,7 @@ subroutine crystallite_restore(i,e,includeL) constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) endif ! maybe protecting everything from overwriting makes more sense - crystallite_Fp(1:3,1:3,c,i,e) = crystallite_partitionedFp0(1:3,1:3,c,i,e) + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) @@ -1264,7 +1257,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) constitutive_mech_Fi(pp)%data(1:3,1:3,m), & c,i,e) - invFp = math_inv33(crystallite_Fp(1:3,1:3,c,i,e)) + invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)) @@ -1434,7 +1427,7 @@ subroutine integrateSourceState(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = constitutive_thermal_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(p,c) broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) return @@ -1453,7 +1446,7 @@ subroutine integrateSourceState(g,i,e) source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) enddo - broken = constitutive_thermal_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(p,c) broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) if(broken) exit iteration @@ -1540,7 +1533,6 @@ subroutine crystallite_restartWrite fileHandle = HDF5_openFile(fileName,'a') call HDF5_write(fileHandle,crystallite_partitionedF,'F') - call HDF5_write(fileHandle,crystallite_Fp, 'F_p') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') @@ -1552,6 +1544,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) write(datasetName,'(i0,a)') i,'_L_i' call HDF5_write(groupHandle,constitutive_mech_Li(i)%data,datasetName) + write(datasetName,'(i0,a)') i,'_F_p' + call HDF5_write(groupHandle,constitutive_mech_Fp(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1583,7 +1577,6 @@ subroutine crystallite_restartRead fileHandle = HDF5_openFile(fileName) call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_Fp0,'F_p') call HDF5_read(fileHandle,crystallite_Lp0,'L_p') call HDF5_read(fileHandle,crystallite_S0, 'S') @@ -1595,6 +1588,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) write(datasetName,'(i0,a)') i,'_L_i' call HDF5_read(groupHandle,constitutive_mech_Li0(i)%data,datasetName) + write(datasetName,'(i0,a)') i,'_F_p' + call HDF5_read(groupHandle,constitutive_mech_Fp0(i)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1619,13 +1614,13 @@ subroutine crystallite_forward integer :: i, j crystallite_F0 = crystallite_partitionedF - crystallite_Fp0 = crystallite_Fp crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S do i = 1, size(plasticState) plasticState(i)%state0 = plasticState(i)%state constitutive_mech_Fi0(i) = constitutive_mech_Fi(i) + constitutive_mech_Fp0(i) = constitutive_mech_Fp(i) constitutive_mech_Li0(i) = constitutive_mech_Li(i) enddo do i = 1,size(material_name_homogenization) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index b879d0fe2..2faa27a5c 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -462,15 +462,14 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different plasticity constitutive models !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_dependentState(F, Fp, ipc, ip, el) +module subroutine constitutive_plastic_dependentState(F, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & - F, & !< elastic deformation gradient - Fp !< plastic deformation gradient + F !< elastic deformation gradient integer :: & ho, & !< homogenization @@ -569,7 +568,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function mech_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broken) +function mech_collectDotState(subdt, ipc, ip, el,phase,of) result(broken) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -579,8 +578,6 @@ function mech_collectDotState(FpArray, subdt, ipc, ip, el,phase,of) result(broke of real(pReal), intent(in) :: & subdt !< timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: & - FpArray !< plastic deformation gradient real(pReal), dimension(3,3) :: & Mp integer :: & @@ -793,8 +790,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) F = crystallite_subF(1:3,1:3,ipc,ip,el) endif - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el), & - crystallite_Fp(1:3,1:3,ipc,ip,el),ipc,ip,el) + call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el),ipc,ip,el) p = material_phaseAt(ipc,el) m = material_phaseMemberAt(ipc,ip,el) @@ -936,7 +932,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) crystallite_S (1:3,1:3,ipc,ip,el) = S crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess - crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + constitutive_mech_Fp(p)%data(1:3,1:3,m) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. @@ -975,8 +971,7 @@ module subroutine integrateStateFPI(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return size_pl = plasticState(p)%sizeDotState @@ -993,8 +988,7 @@ module subroutine integrateStateFPI(g,i,e) broken = integrateStress(g,i,e) if(broken) exit iteration - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) exit iteration zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& @@ -1063,8 +1057,7 @@ subroutine integrateStateEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return sizeDotState = plasticState(p)%sizeDotState @@ -1104,8 +1097,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return sizeDotState = plasticState(p)%sizeDotState @@ -1121,8 +1113,7 @@ subroutine integrateStateAdaptiveEuler(g,i,e) broken = integrateStress(g,i,e) if(broken) return - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return @@ -1216,8 +1207,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) p = material_phaseAt(g,e) c = material_phaseMemberAt(g,i,e) - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) if(broken) return do stage = 1,size(A,1) @@ -1239,8 +1229,7 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) broken = integrateStress(g,i,e,CC(stage)) if(broken) exit - broken = mech_collectDotState(crystallite_partitionedFp0, & - crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) if(broken) exit enddo @@ -1301,8 +1290,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'elastic deformation gradient','1') case('F_p') - selected_tensors = select_tensors(crystallite_Fp,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& 'plastic deformation gradient','1') case('F_i') call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& @@ -1414,6 +1402,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index d6209d3a0..0d7875291 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -563,6 +563,8 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) el integer :: & + ph, & + me, & no, & !< neighbor offset neighbor_el, & ! element number of neighboring material point neighbor_ip, & ! integration point of neighboring material point @@ -642,8 +644,10 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) rho0 = getRho0(instance,of,ip,el) if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then - invFp = math_inv33(crystallite_Fp(1:3,1:3,1,ip,el)) - invFe = matmul(crystallite_Fp(1:3,1:3,1,ip,el),math_inv33(F)) + ph = material_phaseAt(1,el) + me = material_phaseMemberAt(1,ip,el) + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFe = matmul(constitutive_mech_Fp(ph)%data(1:3,1:3,me),math_inv33(F)) rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg) rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg) @@ -1290,7 +1294,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) m(1:3,:,4) = prm%slip_transverse my_F = F(1:3,1:3,1,ip,el) - my_Fe = matmul(my_F, math_inv33(crystallite_Fp(1:3,1:3,1,ip,el))) + my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of))) neighbors: do n = 1,nIPneighbors @@ -1308,7 +1312,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el) - neighbor_Fe = matmul(neighbor_F, math_inv33(crystallite_Fp(1:3,1:3,1,neighbor_ip,neighbor_el))) + neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no))) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average Favg = my_F From 6bb8d894ca0463ed22dc7c0799fe5246b13d5ce0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 22:22:43 +0100 Subject: [PATCH 073/214] need to stay compatible with tests --- src/constitutive_damage.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 4e23b78ea..3ce614666 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -227,21 +227,21 @@ module subroutine damage_results(group,ph) sourceLoop: do so = 1, phase_Nsources(ph) if (phase_source(so,ph) /= SOURCE_UNDEFINED_ID) & - call results_closeGroup(results_addGroup(group//'damage/')) + call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_results(ph,group//'damage/') + call source_damage_anisoBrittle_results(ph,group//'sources/') case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_results(ph,group//'damage/') + call source_damage_anisoDuctile_results(ph,group//'sources/') case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_results(ph,group//'damage/') + call source_damage_isoBrittle_results(ph,group//'sources/') case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_results(ph,group//'damage/') + call source_damage_isoDuctile_results(ph,group//'sources/') end select sourceType From 916657e2f55486d16b34fedda7cb7b1fcf9b0adc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 22 Dec 2020 23:27:56 +0100 Subject: [PATCH 074/214] separating --- src/constitutive.f90 | 20 ++++++++++---------- src/constitutive_mech.f90 | 16 ++++++++++++++++ 2 files changed, 26 insertions(+), 10 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index c71856d1a..432f9d606 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -166,6 +166,10 @@ module constitutive integer, intent(in) :: ph, me end subroutine mech_initializeRestorationPoints + module subroutine constitutive_mech_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine constitutive_mech_windForward + ! == cleaned:end =================================================================================== @@ -1141,6 +1145,7 @@ subroutine constitutive_initializeRestorationPoints(i,e) crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) call mech_initializeRestorationPoints(ph,me) + do s = 1, phase_Nsources(material_phaseAt(c,e)) sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) @@ -1160,22 +1165,17 @@ subroutine constitutive_windForward(i,e) e !< element number integer :: & c, & !< constituent number - s, p, m + s, ph, me do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) + ph = material_phaseAt(c,e) + me = material_phaseMemberAt(c,i,e) crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) - constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp(p)%data(1:3,1:3,m) crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi(p)%data(1:3,1:3,m) - constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) = constitutive_mech_Li(p)%data(1:3,1:3,m) crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%state (:,material_phasememberAt(c,i,e)) + call constitutive_mech_windForward(ph,me) do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%state (:,material_phasememberAt(c,i,e)) + sourceState(ph)%p(s)%partitionedState0(:,me) = sourceState(ph)%p(s)%state(:,me) enddo enddo diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 2faa27a5c..76e7dd080 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1409,5 +1409,21 @@ module subroutine mech_initializeRestorationPoints(ph,me) end subroutine mech_initializeRestorationPoints +!-------------------------------------------------------------------------------------------------- +!> @brief Wind homog inc forward. +!-------------------------------------------------------------------------------------------------- +module subroutine constitutive_mech_windForward(ph,me) + + integer, intent(in) :: ph, me + + constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + + plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) + + +end subroutine constitutive_mech_windForward + end submodule constitutive_mech From 82eb532193a0c1f36cd903323b43e35fc0ebf9c6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 06:58:54 +0100 Subject: [PATCH 075/214] separating functionality --- src/CPFEM.f90 | 2 +- src/CPFEM2.f90 | 2 +- src/constitutive.f90 | 42 +++++++++------------------------------ src/constitutive_mech.f90 | 19 ++++++++++++++++++ src/homogenization.f90 | 17 ++++++++++++++++ 5 files changed, 47 insertions(+), 35 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 0d8e31b46..abbcce04a 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -260,7 +260,7 @@ end subroutine CPFEM_general !-------------------------------------------------------------------------------------------------- subroutine CPFEM_forward - call crystallite_forward + call homogenization_forward call constitutive_forward end subroutine CPFEM_forward diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index dd4be8fc2..44b93d1cb 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -97,7 +97,7 @@ end subroutine CPFEM_restartWrite !-------------------------------------------------------------------------------------------------- subroutine CPFEM_forward - call crystallite_forward + call homogenization_forward call constitutive_forward end subroutine CPFEM_forward diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 432f9d606..a84befcd3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -32,16 +32,11 @@ module constitutive crystallite_F0, & !< def grad at start of FE inc crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_subF0, & !< def grad at start of crystallite inc - ! crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - ! crystallite_subFp0,& !< plastic def grad at start of crystallite inc - ! crystallite_subFi0,& !< intermediate def grad at start of crystallite inc - ! crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc - ! crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & @@ -170,10 +165,11 @@ module constitutive integer, intent(in) :: ph, me end subroutine constitutive_mech_windForward + module subroutine constitutive_mech_forward + end subroutine constitutive_mech_forward + ! == cleaned:end =================================================================================== - - module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) integer, intent(in) :: & ipc, & !< component-ID of integration point @@ -381,7 +377,6 @@ module constitutive crystallite_push33ToRef, & crystallite_restartWrite, & crystallite_restartRead, & - crystallite_forward, & constitutive_initializeRestorationPoints, & constitutive_windForward, & crystallite_restore @@ -778,6 +773,12 @@ subroutine constitutive_forward integer :: i, j + crystallite_F0 = crystallite_partitionedF + crystallite_Lp0 = crystallite_Lp + crystallite_S0 = crystallite_S + + call constitutive_mech_forward() + do i = 1, size(sourceState) do j = 1,phase_Nsources(i) sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state @@ -1605,29 +1606,4 @@ subroutine crystallite_restartRead end subroutine crystallite_restartRead -!-------------------------------------------------------------------------------------------------- -!> @brief Forward data after successful increment. -! ToDo: Any guessing for the current states possible? -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_forward - - integer :: i, j - - crystallite_F0 = crystallite_partitionedF - crystallite_Lp0 = crystallite_Lp - crystallite_S0 = crystallite_S - - do i = 1, size(plasticState) - plasticState(i)%state0 = plasticState(i)%state - constitutive_mech_Fi0(i) = constitutive_mech_Fi(i) - constitutive_mech_Fp0(i) = constitutive_mech_Fp(i) - constitutive_mech_Li0(i) = constitutive_mech_Li(i) - enddo - do i = 1,size(material_name_homogenization) - homogState (i)%state0 = homogState (i)%state - damageState (i)%state0 = damageState (i)%state - enddo - -end subroutine crystallite_forward - end module constitutive diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 76e7dd080..ac3c50892 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1425,5 +1425,24 @@ module subroutine constitutive_mech_windForward(ph,me) end subroutine constitutive_mech_windForward + +!-------------------------------------------------------------------------------------------------- +!> @brief Forward data after successful increment. +! ToDo: Any guessing for the current states possible? +!-------------------------------------------------------------------------------------------------- +module subroutine constitutive_mech_forward() + + integer :: ph + + + do ph = 1, size(plasticState) + plasticState(ph)%state0 = plasticState(ph)%state + constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) + constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) + constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) + enddo + +end subroutine constitutive_mech_forward + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index dcde08f32..8ceac0eb8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -112,6 +112,7 @@ module homogenization public :: & homogenization_init, & materialpoint_stressAndItsTangent, & + homogenization_forward, & homogenization_results contains @@ -425,4 +426,20 @@ subroutine homogenization_results end subroutine homogenization_results + +!-------------------------------------------------------------------------------------------------- +!> @brief Forward data after successful increment. +! ToDo: Any guessing for the current states possible? +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_forward + + integer :: ho + + do ho = 1, size(material_name_homogenization) + homogState (ho)%state0 = homogState (ho)%state + damageState(ho)%state0 = damageState(ho)%state + enddo + +end subroutine homogenization_forward + end module homogenization From 8cf1035cf324d0105b4145d6995fc4d178221cb2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 07:07:18 +0100 Subject: [PATCH 076/214] unifying names --- src/constitutive.f90 | 100 ++++++++++++------------- src/constitutive_mech.f90 | 84 ++++++++++----------- src/constitutive_plastic_dislotwin.f90 | 10 +-- src/damage_nonlocal.f90 | 6 +- src/kinematics_cleavage_opening.f90 | 6 +- src/kinematics_slipplane_opening.f90 | 6 +- src/kinematics_thermal_expansion.f90 | 6 +- src/source_damage_anisoBrittle.f90 | 8 +- src/source_damage_anisoDuctile.f90 | 8 +- src/source_damage_isoBrittle.f90 | 8 +- src/source_damage_isoDuctile.f90 | 8 +- 11 files changed, 125 insertions(+), 125 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a84befcd3..80d5b4116 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -170,25 +170,25 @@ module constitutive ! == cleaned:end =================================================================================== - module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) + module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & S end subroutine source_damage_anisoBrittle_dotState - module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) + module subroutine source_damage_anisoDuctile_dotState(co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element end subroutine source_damage_anisoDuctile_dotState - module subroutine source_damage_isoDuctile_dotState(ipc, ip, el) + module subroutine source_damage_isoDuctile_dotState(co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element end subroutine source_damage_isoDuctile_dotState @@ -224,11 +224,11 @@ module constitutive dTDot_dT end subroutine constitutive_thermal_getRateAndItsTangents - module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) + module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) real(pReal), dimension(6,6) :: & homogenizedC integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element end function plastic_dislotwin_homogenizedC @@ -254,9 +254,9 @@ module constitutive of end subroutine plastic_isotropic_LiAndItsTangent - module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) + module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(in), dimension(3,3) :: & @@ -267,9 +267,9 @@ module constitutive dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) end subroutine kinematics_cleavage_opening_LiAndItsTangent - module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) + module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(in), dimension(3,3) :: & @@ -280,9 +280,9 @@ module constitutive dLd_dTstar !< derivative of Ld with respect to Tstar (4th-order tensor) end subroutine kinematics_slipplane_opening_LiAndItsTangent - module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) + module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(out), dimension(3,3) :: & @@ -292,9 +292,9 @@ module constitutive end subroutine kinematics_thermal_expansion_LiAndItsTangent - module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) + module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -305,9 +305,9 @@ module constitutive module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, ipc, ip, el) + S, Fi, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -321,9 +321,9 @@ module constitutive end subroutine constitutive_plastic_LpAndItsTangents - module subroutine constitutive_plastic_dependentState(F, ipc, ip, el) + module subroutine constitutive_plastic_dependentState(F, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -332,9 +332,9 @@ module constitutive - module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip, el) + module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -498,20 +498,20 @@ end function kinematics_active !> @brief returns the homogenize elasticity matrix !> ToDo: homogenizedC66 would be more consistent !-------------------------------------------------------------------------------------------------- -function constitutive_homogenizedC(ipc,ip,el) +function constitutive_homogenizedC(co,ip,el) real(pReal), dimension(6,6) :: & constitutive_homogenizedC integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType - constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) + constitutive_homogenizedC = plastic_dislotwin_homogenizedC(co,ip,el) case default plasticityType - constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(ipc,el)) + constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(co,el)) end select plasticityType end function constitutive_homogenizedC @@ -522,10 +522,10 @@ end function constitutive_homogenizedC ! ToDo: MD: S is Mi? !-------------------------------------------------------------------------------------------------- subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & - S, Fi, ipc, ip, el) + S, Fi, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -554,10 +554,10 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & dLi_dS = 0.0_pReal dLi_dFi = 0.0_pReal - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) case (PLASTICITY_isotropic_ID) plasticityType - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + of = material_phasememberAt(co,ip,el) + instance = phase_plasticityInstance(material_phaseAt(co,el)) call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) case default plasticityType my_Li = 0.0_pReal @@ -567,14 +567,14 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & Li = Li + my_Li dLi_dS = dLi_dS + my_dLi_dS - KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(ipc,el)) - kinematicsType: select case (phase_kinematics(k,material_phaseAt(ipc,el))) + KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) + kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, ipc, ip, el) + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) case (KINEMATICS_thermal_expansion_ID) kinematicsType - call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el) + call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) case default kinematicsType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -600,10 +600,10 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(S, ipc, ip, el,phase,of) result(broken) +function constitutive_damage_collectDotState(S, co, ip, el,phase,of) result(broken) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el, & !< element phase, & @@ -622,13 +622,13 @@ function constitutive_damage_collectDotState(S, ipc, ip, el,phase,of) result(bro sourceType: select case (phase_source(i,phase)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(S, ipc, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(S, co, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState(ipc, ip, el) + call source_damage_isoDuctile_dotState(co, ip, el) case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState(ipc, ip, el) + call source_damage_anisoDuctile_dotState(co, ip, el) end select sourceType @@ -668,10 +668,10 @@ end function constitutive_thermal_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_damage_deltaState(Fe, ipc, ip, el, phase, of) result(broken) +function constitutive_damage_deltaState(Fe, co, ip, el, phase, of) result(broken) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el, & !< element phase, & @@ -693,8 +693,8 @@ function constitutive_damage_deltaState(Fe, ipc, ip, el, phase, of) result(broke sourceType: select case (phase_source(i,phase)) case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & - ipc, ip, el) + call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & + co, ip, el) broken = any(IEEE_is_NaN(sourceState(phase)%p(i)%deltaState(:,of))) if(.not. broken) then myOffset = sourceState(phase)%p(i)%offsetDeltaState @@ -1382,7 +1382,7 @@ end subroutine crystallite_orientations !-------------------------------------------------------------------------------------------------- !> @brief Map 2nd order tensor to reference config !-------------------------------------------------------------------------------------------------- -function crystallite_push33ToRef(ipc,ip,el, tensor33) +function crystallite_push33ToRef(co,ip,el, tensor33) real(pReal), dimension(3,3) :: crystallite_push33ToRef real(pReal), dimension(3,3), intent(in) :: tensor33 @@ -1390,10 +1390,10 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) integer, intent(in):: & el, & ip, & - ipc + co - T = matmul(material_orientation0(ipc,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el)))) + T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? + transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index ac3c50892..124b4d608 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -416,10 +416,10 @@ end function plastic_active !> the elastic and intermediate deformation gradients using Hooke's law !-------------------------------------------------------------------------------------------------- module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi, ipc, ip, el) + Fe, Fi, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -439,10 +439,10 @@ module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & i, j ho = material_homogenizationAt(el) - C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) + C = math_66toSym3333(constitutive_homogenizedC(co,ip,el)) - DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(ipc,el)) - degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(ipc,el))) + DegradationLoop: do d = 1, phase_NstiffnessDegradations(material_phaseAt(co,el)) + degradationType: select case(phase_stiffnessDegradation(d,material_phaseAt(co,el))) case (STIFFNESS_DEGRADATION_damage_ID) degradationType C = C * damage(ho)%p(material_homogenizationMemberAt(ip,el))**2 end select degradationType @@ -462,10 +462,10 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different plasticity constitutive models !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_dependentState(F, ipc, ip, el) +module subroutine constitutive_plastic_dependentState(F, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -478,10 +478,10 @@ module subroutine constitutive_plastic_dependentState(F, ipc, ip, el) ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + of = material_phasememberAt(co,ip,el) + instance = phase_plasticityInstance(material_phaseAt(co,el)) - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType @@ -499,9 +499,9 @@ end subroutine constitutive_plastic_dependentState ! Mp in, dLp_dMp out !-------------------------------------------------------------------------------------------------- module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, ipc, ip, el) + S, Fi, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -527,10 +527,10 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & tme = material_homogenizationMemberAt(ip,el) Mp = matmul(matmul(transpose(Fi),Fi),S) - of = material_phasememberAt(ipc,ip,el) - instance = phase_plasticityInstance(material_phaseAt(ipc,el)) + of = material_phasememberAt(co,ip,el) + instance = phase_plasticityInstance(material_phaseAt(co,el)) - plasticityType: select case (phase_plasticity(material_phaseAt(ipc,el))) + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) case (PLASTICITY_NONE_ID) plasticityType Lp = 0.0_pReal @@ -568,10 +568,10 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function mech_collectDotState(subdt, ipc, ip, el,phase,of) result(broken) +function mech_collectDotState(subdt, co, ip, el,phase,of) result(broken) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el, & !< element phase, & @@ -591,7 +591,7 @@ function mech_collectDotState(subdt, ipc, ip, el,phase,of) result(broken) instance = phase_plasticityInstance(phase) Mp = matmul(matmul(transpose(constitutive_mech_Fi(phase)%data(1:3,1:3,of)),& - constitutive_mech_Fi(phase)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,ipc,ip,el)) + constitutive_mech_Fi(phase)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) plasticityType: select case (phase_plasticity(phase)) @@ -624,10 +624,10 @@ end function mech_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, ipc, ip, el, phase, of) result(broken) +function constitutive_deltaState(S, Fi, co, ip, el, phase, of) result(broken) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el, & !< element phase, & @@ -719,11 +719,11 @@ end subroutine mech_results !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -function integrateStress(ipc,ip,el,timeFraction) result(broken) +function integrateStress(co,ip,el,timeFraction) result(broken) integer, intent(in):: el, & ! element index ip, & ! integration point index - ipc ! grain index + co ! grain index real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep @@ -782,25 +782,25 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) broken = .true. if (present(timeFraction)) then - dt = crystallite_subdt(ipc,ip,el) * timeFraction - F = crystallite_subF0(1:3,1:3,ipc,ip,el) & - + (crystallite_subF(1:3,1:3,ipc,ip,el) - crystallite_subF0(1:3,1:3,ipc,ip,el)) * timeFraction + dt = crystallite_subdt(co,ip,el) * timeFraction + F = crystallite_subF0(1:3,1:3,co,ip,el) & + + (crystallite_subF(1:3,1:3,co,ip,el) - crystallite_subF0(1:3,1:3,co,ip,el)) * timeFraction else - dt = crystallite_subdt(ipc,ip,el) - F = crystallite_subF(1:3,1:3,ipc,ip,el) + dt = crystallite_subdt(co,ip,el) + F = crystallite_subF(1:3,1:3,co,ip,el) endif - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,ipc,ip,el),ipc,ip,el) + call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) - p = material_phaseAt(ipc,el) - m = material_phaseMemberAt(ipc,ip,el) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) - Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! take as first guess + Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,ipc,ip,el)) + call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,ipc,ip,el)) + call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,co,ip,el)) if (error) return ! error A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp @@ -831,10 +831,10 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) B = math_I3 - dt*Lpguess Fe = matmul(matmul(A,B), invFi_new) call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & - Fe, Fi_new, ipc, ip, el) + Fe, Fi_new, co, ip, el) call constitutive_plastic_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - S, Fi_new, ipc, ip, el) + S, Fi_new, co, ip, el) !* update current residuum and check for convergence of loop atol_Lp = max(num%rtol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error @@ -875,7 +875,7 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) enddo LpLoop call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - S, Fi_new, ipc, ip, el) + S, Fi_new, co, ip, el) !* update current residuum and check for convergence of loop atol_Li = max(num%rtol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error @@ -925,16 +925,16 @@ function integrateStress(ipc,ip,el,timeFraction) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error - p = material_phaseAt(ipc,el) - m = material_phaseMemberAt(ipc,ip,el) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) - crystallite_P (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,ipc,ip,el) = S - crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess + crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + crystallite_S (1:3,1:3,co,ip,el) = S + crystallite_Lp (1:3,1:3,co,ip,el) = Lpguess constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess constitutive_mech_Fp(p)%data(1:3,1:3,m) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new - crystallite_Fe (1:3,1:3,ipc,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress diff --git a/src/constitutive_plastic_dislotwin.f90 b/src/constitutive_plastic_dislotwin.f90 index 4234a55b8..0474427fe 100644 --- a/src/constitutive_plastic_dislotwin.f90 +++ b/src/constitutive_plastic_dislotwin.f90 @@ -485,12 +485,12 @@ end function plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- !> @brief Return the homogenized elasticity matrix. !-------------------------------------------------------------------------------------------------- -module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) +module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) real(pReal), dimension(6,6) :: & homogenizedC integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element @@ -498,9 +498,9 @@ module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) of real(pReal) :: f_unrotated - of = material_phasememberAt(ipc,ip,el) - associate(prm => param(phase_plasticityInstance(material_phaseAt(ipc,el))),& - stt => state(phase_plasticityInstance(material_phaseAT(ipc,el)))) + of = material_phasememberAt(co,ip,el) + associate(prm => param(phase_plasticityInstance(material_phaseAt(co,el))),& + stt => state(phase_plasticityInstance(material_phaseAT(co,el)))) f_unrotated = 1.0_pReal & - sum(stt%f_tw(1:prm%sum_N_tw,of)) & diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index ac4d8636a..3db63cab2 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -148,12 +148,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el) ip, & !< integration point number el !< element number integer :: & - ipc + co damage_nonlocal_getMobility = 0.0_pReal - do ipc = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(ipc,el)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(co,el)) enddo damage_nonlocal_getMobility = damage_nonlocal_getMobility/& diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 6fe8ed7f6..a29a290f8 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -99,10 +99,10 @@ end function kinematics_cleavage_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) +module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(in), dimension(3,3) :: & @@ -124,7 +124,7 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, Ld = 0.0_pReal dLd_dTstar = 0.0_pReal - associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(ipc,el)))) + associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(co,el)))) do i = 1,prm%sum_N_cl traction_crit = prm%g_crit(i)* damage(homog)%p(damageOffset)**2.0_pReal diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index b7adb6807..84edab122 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -117,10 +117,10 @@ end function kinematics_slipplane_opening_init !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el) +module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(in), dimension(3,3) :: & @@ -138,7 +138,7 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S traction_d, traction_t, traction_n, traction_crit, & udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt - phase = material_phaseAt(ipc,el) + phase = material_phaseAt(co,el) instance = kinematics_slipplane_opening_instance(phase) homog = material_homogenizationAt(el) damageOffset = material_homogenizationMemberAt(ip,el) diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 5265d6172..6d4a39632 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -84,10 +84,10 @@ end function kinematics_thermal_expansion_init !-------------------------------------------------------------------------------------------------- !> @brief constitutive equation for calculating the velocity gradient !-------------------------------------------------------------------------------------------------- -module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el) +module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el) integer, intent(in) :: & - ipc, & !< grain number + co, & !< grain number ip, & !< integration point number el !< element number real(pReal), intent(out), dimension(3,3) :: & @@ -101,7 +101,7 @@ module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, i real(pReal) :: & T, TDot - phase = material_phaseAt(ipc,el) + phase = material_phaseAt(co,el) homog = material_homogenizationAt(el) T = temperature(homog)%p(material_homogenizationMemberAt(ip,el)) TDot = temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el)) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 55d5546fc..0f923ceba 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -120,10 +120,10 @@ end function source_damage_anisoBrittle_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) +module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -139,8 +139,8 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el) real(pReal) :: & traction_d, traction_t, traction_n, traction_crit - phase = material_phaseAt(ipc,el) - constituent = material_phasememberAt(ipc,ip,el) + phase = material_phaseAt(co,el) + constituent = material_phasememberAt(co,ip,el) sourceOffset = source_damage_anisoBrittle_offset(phase) homog = material_homogenizationAt(el) damageOffset = material_homogenizationMemberAt(ip,el) diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 912fe1387..6f71fc145 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -107,10 +107,10 @@ end function source_damage_anisoDuctile_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) +module subroutine source_damage_anisoDuctile_dotState(co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element @@ -121,8 +121,8 @@ module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el) damageOffset, & homog - phase = material_phaseAt(ipc,el) - constituent = material_phasememberAt(ipc,ip,el) + phase = material_phaseAt(co,el) + constituent = material_phasememberAt(co,ip,el) sourceOffset = source_damage_anisoDuctile_offset(phase) homog = material_homogenizationAt(el) damageOffset = material_homogenizationMemberAt(ip,el) diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 7fcf17ee0..8c768b08d 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -94,10 +94,10 @@ end function source_damage_isoBrittle_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) +module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -114,8 +114,8 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el) real(pReal) :: & strainenergy - phase = material_phaseAt(ipc,el) !< phase ID at ipc,ip,el - constituent = material_phasememberAt(ipc,ip,el) !< state array offset for phase ID at ipc,ip,el + phase = material_phaseAt(co,el) !< phase ID at co,ip,el + constituent = material_phasememberAt(co,ip,el) !< state array offset for phase ID at co,ip,el sourceOffset = source_damage_isoBrittle_offset(phase) strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3) diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index b66e220d9..86222bbf9 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -98,10 +98,10 @@ end function source_damage_isoDuctile_init !-------------------------------------------------------------------------------------------------- !> @brief calculates derived quantities from state !-------------------------------------------------------------------------------------------------- -module subroutine source_damage_isoDuctile_dotState(ipc, ip, el) +module subroutine source_damage_isoDuctile_dotState(co, ip, el) integer, intent(in) :: & - ipc, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element @@ -112,8 +112,8 @@ module subroutine source_damage_isoDuctile_dotState(ipc, ip, el) damageOffset, & homog - phase = material_phaseAt(ipc,el) - constituent = material_phasememberAt(ipc,ip,el) + phase = material_phaseAt(co,el) + constituent = material_phasememberAt(co,ip,el) sourceOffset = source_damage_isoDuctile_offset(phase) homog = material_homogenizationAt(el) damageOffset = material_homogenizationMemberAt(ip,el) From fe6a82ecc19d752b878fcd503350086b327d4d76 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 07:14:07 +0100 Subject: [PATCH 077/214] unifying names --- src/constitutive.f90 | 373 +++++++++++++++++++------------------- src/constitutive_mech.f90 | 294 +++++++++++++++--------------- 2 files changed, 333 insertions(+), 334 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 80d5b4116..4d0fd5582 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -347,8 +347,8 @@ module constitutive dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient end subroutine constitutive_hooke_SandItsTangents - module subroutine integrateStateFPI(g,i,e) - integer, intent(in) :: e, i, g + module subroutine integrateStateFPI(co,ip,el) + integer, intent(in) :: co, ip, el end subroutine integrateStateFPI end interface @@ -746,19 +746,19 @@ end subroutine constitutive_allocateState !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_restore(i,e) +subroutine constitutive_restore(ip,el) integer, intent(in) :: & - i, & !< integration point number - e !< element number + ip, & !< integration point number + el !< element number integer :: & - c, & !< constituent number + co, & !< constituent number s - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo @@ -827,7 +827,6 @@ subroutine crystallite_init iMax, & !< maximum number of integration points eMax !< maximum number of elements - class(tNode), pointer :: & num_crystallite, & debug_crystallite, & ! pointer to debug options for crystallite @@ -835,6 +834,7 @@ subroutine crystallite_init phase, & mech + print'(/,a)', ' <<<+- crystallite init -+>>>' debug_crystallite => config_debug%get('crystallite', defaultVal=emptyList) @@ -986,9 +986,9 @@ function crystallite_stress() integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e, & !< counter in element loop - s, p, m + ip, & !< counter in integration point loop + el, & !< counter in element loop + s, ph, me logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains real(pReal), dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: subFrac !ToDo: need to set some values to false for different Ngrains real(pReal), dimension(:,:,:,:,:), allocatable :: & @@ -1003,27 +1003,27 @@ function crystallite_stress() !-------------------------------------------------------------------------------------------------- ! initialize to starting condition crystallite_subStep = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(p,m) - elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) - subLi0(1:3,1:3,c,i,e) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) - homogenizationRequestsCalculation: if (crystallite_requested(c,i,e)) then - plasticState (material_phaseAt(c,e))%subState0( :,material_phaseMemberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phaseMemberAt(c,i,e)) + !$OMP PARALLEL DO PRIVATE(ph,me) + elementLooping1: do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(c,el) + me = material_phaseMemberAt(c,ip,el) + subLi0(1:3,1:3,c,ip,el) = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + homogenizationRequestsCalculation: if (crystallite_requested(c,ip,el)) then + plasticState (material_phaseAt(c,el))%subState0( :,material_phaseMemberAt(c,ip,el)) = & + plasticState (material_phaseAt(c,el))%partitionedState0(:,material_phaseMemberAt(c,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%subState0( :,material_phaseMemberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phaseMemberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(c,el)) + sourceState(material_phaseAt(c,el))%p(s)%subState0( :,material_phaseMemberAt(c,ip,el)) = & + sourceState(material_phaseAt(c,el))%p(s)%partitionedState0(:,material_phaseMemberAt(c,ip,el)) enddo - crystallite_subFp0(1:3,1:3,c,i,e) = constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) - crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) - crystallite_subF0(1:3,1:3,c,i,e) = crystallite_partitionedF0(1:3,1:3,c,i,e) - subFrac(c,i,e) = 0.0_pReal - crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst - todo(c,i,e) = .true. - crystallite_converged(c,i,e) = .false. ! pretend failed step of 1/subStepSizeCryst + crystallite_subFp0(1:3,1:3,c,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,c,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,c,ip,el) = crystallite_partitionedF0(1:3,1:3,c,ip,el) + subFrac(c,ip,el) = 0.0_pReal + crystallite_subStep(c,ip,el) = 1.0_pReal/num%subStepSizeCryst + todo(c,ip,el) = .true. + crystallite_converged(c,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst endif homogenizationRequestsCalculation enddo; enddo enddo elementLooping1 @@ -1037,71 +1037,71 @@ function crystallite_stress() if (debugCrystallite%extensive) & print'(a,i6)', '<< CRYST stress >> crystallite iteration ',NiterationCrystallite #endif - !$OMP PARALLEL DO PRIVATE(formerSubStep,p,m) - elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) + !$OMP PARALLEL DO PRIVATE(formerSubStep,ph,me) + elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do c = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(c,el) + me = material_phaseMemberAt(c,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(c,i,e)) then - formerSubStep = crystallite_subStep(c,i,e) - subFrac(c,i,e) = subFrac(c,i,e) + crystallite_subStep(c,i,e) - crystallite_subStep(c,i,e) = min(1.0_pReal - subFrac(c,i,e), & - num%stepIncreaseCryst * crystallite_subStep(c,i,e)) + if (crystallite_converged(c,ip,el)) then + formerSubStep = crystallite_subStep(c,ip,el) + subFrac(c,ip,el) = subFrac(c,ip,el) + crystallite_subStep(c,ip,el) + crystallite_subStep(c,ip,el) = min(1.0_pReal - subFrac(c,ip,el), & + num%stepIncreaseCryst * crystallite_subStep(c,ip,el)) - todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal ! still time left to integrate on? + todo(c,ip,el) = crystallite_subStep(c,ip,el) > 0.0_pReal ! still time left to integrate on? - if (todo(c,i,e)) then - crystallite_subF0 (1:3,1:3,c,i,e) = crystallite_subF(1:3,1:3,c,i,e) - subLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - subLi0(1:3,1:3,c,i,e) = constitutive_mech_Li(p)%data(1:3,1:3,m) - crystallite_subFp0(1:3,1:3,c,i,e) = constitutive_mech_Fp(p)%data(1:3,1:3,m) - crystallite_subFi0(1:3,1:3,c,i,e) = constitutive_mech_Fi(p)%data(1:3,1:3,m) - plasticState( material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) & - = plasticState(material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState( material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) & - = sourceState(material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) + if (todo(c,ip,el)) then + crystallite_subF0 (1:3,1:3,c,ip,el) = crystallite_subF(1:3,1:3,c,ip,el) + subLp0(1:3,1:3,c,ip,el) = crystallite_Lp (1:3,1:3,c,ip,el) + subLi0(1:3,1:3,c,ip,el) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,c,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,c,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(c,el))%subState0(:,material_phaseMemberAt(c,ip,el)) & + = plasticState(material_phaseAt(c,el))%state( :,material_phaseMemberAt(c,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(c,el)) + sourceState( material_phaseAt(c,el))%p(s)%subState0(:,material_phaseMemberAt(c,ip,el)) & + = sourceState(material_phaseAt(c,el))%p(s)%state( :,material_phaseMemberAt(c,ip,el)) enddo endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else - crystallite_subStep(c,i,e) = num%subStepSizeCryst * crystallite_subStep(c,i,e) - constitutive_mech_Fp(p)%data(1:3,1:3,m) = crystallite_subFp0(1:3,1:3,c,i,e) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = crystallite_subFi0(1:3,1:3,c,i,e) - crystallite_S (1:3,1:3,c,i,e) = crystallite_S0 (1:3,1:3,c,i,e) - if (crystallite_subStep(c,i,e) < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,c,i,e) = subLp0(1:3,1:3,c,i,e) - constitutive_mech_Li(p)%data(1:3,1:3,m) = subLi0(1:3,1:3,c,i,e) + crystallite_subStep(c,ip,el) = num%subStepSizeCryst * crystallite_subStep(c,ip,el) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,c,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,c,ip,el) + crystallite_S (1:3,1:3,c,ip,el) = crystallite_S0 (1:3,1:3,c,ip,el) + if (crystallite_subStep(c,ip,el) < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,c,ip,el) = subLp0(1:3,1:3,c,ip,el) + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0(1:3,1:3,c,ip,el) endif - plasticState (material_phaseAt(c,e))%state( :,material_phaseMemberAt(c,i,e)) & - = plasticState(material_phaseAt(c,e))%subState0(:,material_phaseMemberAt(c,i,e)) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState( material_phaseAt(c,e))%p(s)%state( :,material_phaseMemberAt(c,i,e)) & - = sourceState(material_phaseAt(c,e))%p(s)%subState0(:,material_phaseMemberAt(c,i,e)) + plasticState (material_phaseAt(c,el))%state( :,material_phaseMemberAt(c,ip,el)) & + = plasticState(material_phaseAt(c,el))%subState0(:,material_phaseMemberAt(c,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(c,el)) + sourceState( material_phaseAt(c,el))%p(s)%state( :,material_phaseMemberAt(c,ip,el)) & + = sourceState(material_phaseAt(c,el))%p(s)%subState0(:,material_phaseMemberAt(c,ip,el)) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst ! still on track or already done (beyond repair) + todo(c,ip,el) = crystallite_subStep(c,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) endif !-------------------------------------------------------------------------------------------------- ! prepare for integration - if (todo(c,i,e)) then - crystallite_subF(1:3,1:3,c,i,e) = crystallite_subF0(1:3,1:3,c,i,e) & - + crystallite_subStep(c,i,e) *( crystallite_partitionedF (1:3,1:3,c,i,e) & - -crystallite_partitionedF0(1:3,1:3,c,i,e)) - crystallite_Fe(1:3,1:3,c,i,e) = matmul(crystallite_subF(1:3,1:3,c,i,e), & - math_inv33(matmul(constitutive_mech_Fi(p)%data(1:3,1:3,m), & - constitutive_mech_Fp(p)%data(1:3,1:3,m)))) - crystallite_subdt(c,i,e) = crystallite_subStep(c,i,e) * crystallite_dt(c,i,e) - crystallite_converged(c,i,e) = .false. - call integrateState(c,i,e) - call integrateSourceState(c,i,e) + if (todo(c,ip,el)) then + crystallite_subF(1:3,1:3,c,ip,el) = crystallite_subF0(1:3,1:3,c,ip,el) & + + crystallite_subStep(c,ip,el) *( crystallite_partitionedF (1:3,1:3,c,ip,el) & + -crystallite_partitionedF0(1:3,1:3,c,ip,el)) + crystallite_Fe(1:3,1:3,c,ip,el) = matmul(crystallite_subF(1:3,1:3,c,ip,el), & + math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + crystallite_subdt(c,ip,el) = crystallite_subStep(c,ip,el) * crystallite_dt(c,ip,el) + crystallite_converged(c,ip,el) = .false. + call integrateState(c,ip,el) + call integrateSourceState(c,ip,el) endif enddo @@ -1117,9 +1117,9 @@ function crystallite_stress() ! return whether converged or not crystallite_stress = .false. - elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - crystallite_stress(i,e) = all(crystallite_converged(:,i,e)) + elementLooping5: do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) + crystallite_stress(ip,el) = all(crystallite_converged(:,ip,el)) enddo enddo elementLooping5 @@ -1129,27 +1129,27 @@ end function crystallite_stress !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_initializeRestorationPoints(i,e) +subroutine constitutive_initializeRestorationPoints(ip,el) integer, intent(in) :: & - i, & !< integration point number - e !< element number + ip, & !< integration point number + el !< element number integer :: & - c, & !< constituent number + co, & !< constituent number s,ph, me - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - ph = material_phaseAt(c,e) - me = material_phaseMemberAt(c,i,e) - crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp0(1:3,1:3,c,i,e) - crystallite_partitionedF0(1:3,1:3,c,i,e) = crystallite_F0(1:3,1:3,c,i,e) - crystallite_partitionedS0(1:3,1:3,c,i,e) = crystallite_S0(1:3,1:3,c,i,e) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp0(1:3,1:3,co,ip,el) + crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) + crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) call mech_initializeRestorationPoints(ph,me) - do s = 1, phase_Nsources(material_phaseAt(c,e)) - sourceState(material_phaseAt(c,e))%p(s)%partitionedState0(:,material_phasememberAt(c,i,e)) = & - sourceState(material_phaseAt(c,e))%p(s)%state0( :,material_phasememberAt(c,i,e)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%state0( :,material_phasememberAt(co,ip,el)) enddo enddo @@ -1159,23 +1159,23 @@ end subroutine constitutive_initializeRestorationPoints !-------------------------------------------------------------------------------------------------- !> @brief Wind homog inc forward. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_windForward(i,e) +subroutine constitutive_windForward(ip,el) integer, intent(in) :: & - i, & !< integration point number - e !< element number + ip, & !< integration point number + el !< element number integer :: & - c, & !< constituent number + co, & !< constituent number s, ph, me - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - ph = material_phaseAt(c,e) - me = material_phaseMemberAt(c,i,e) - crystallite_partitionedF0 (1:3,1:3,c,i,e) = crystallite_partitionedF(1:3,1:3,c,i,e) - crystallite_partitionedLp0(1:3,1:3,c,i,e) = crystallite_Lp (1:3,1:3,c,i,e) - crystallite_partitionedS0 (1:3,1:3,c,i,e) = crystallite_S (1:3,1:3,c,i,e) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_partitionedF(1:3,1:3,co,ip,el) + crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) + crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) - do s = 1, phase_Nsources(material_phaseAt(c,e)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) sourceState(ph)%p(s)%partitionedState0(:,me) = sourceState(ph)%p(s)%state(:,me) enddo enddo @@ -1186,30 +1186,30 @@ end subroutine constitutive_windForward !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine crystallite_restore(i,e,includeL) +subroutine crystallite_restore(ip,el,includeL) integer, intent(in) :: & - i, & !< integration point number - e !< element number + ip, & !< integration point number + el !< element number logical, intent(in) :: & includeL !< protect agains fake cutback integer :: & - c, p, m !< constituent number + co, p, m !< constituent number - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) if (includeL) then - crystallite_Lp(1:3,1:3,c,i,e) = crystallite_partitionedLp0(1:3,1:3,c,i,e) + crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) endif ! maybe protecting everything from overwriting makes more sense constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) - crystallite_S (1:3,1:3,c,i,e) = crystallite_partitionedS0 (1:3,1:3,c,i,e) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) - plasticState (material_phaseAt(c,e))%state( :,material_phasememberAt(c,i,e)) = & - plasticState (material_phaseAt(c,e))%partitionedState0(:,material_phasememberAt(c,i,e)) + plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo end subroutine crystallite_restore @@ -1218,13 +1218,13 @@ end subroutine crystallite_restore !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(c,i,e) result(dPdF) +function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(3,3,3,3) :: dPdF integer, intent(in) :: & - c, & !< counter in constituent loop - i, & !< counter in integration point loop - e !< counter in element loop + co, & !< counter in constituent loop + ip, & !< counter in integration point loop + el !< counter in element loop integer :: & o, & p, pp, m @@ -1247,21 +1247,21 @@ function crystallite_stressTangent(c,i,e) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) + pp = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,c,i,e), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) + crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,c,i,e), & + crystallite_S (1:3,1:3,co,ip,el), & constitutive_mech_Fi(pp)%data(1:3,1:3,m), & - c,i,e) + co,ip,el) invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,c,i,e)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,c,i,e)) + invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) + invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) if (sum(abs(dLidS)) < tol_math_check) then dFidS = 0.0_pReal @@ -1269,15 +1269,15 @@ function crystallite_stressTangent(c,i,e) result(dPdF) lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal do o=1,3; do p=1,3 lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) + + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + invFi*invFi(p,o) rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(c,i,e)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) + - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) enddo; enddo call math_invert(temp_99,error,math_3333to99(lhs_3333)) if (error) then - call IO_warning(warning_ID=600,el=e,ip=i,g=c, & + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & ext_msg='inversion error in analytic tangent calculation') dFidS = 0.0_pReal else @@ -1287,27 +1287,27 @@ function crystallite_stressTangent(c,i,e) result(dPdF) endif call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,c,i,e), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),c,i,e) + crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,c,i,e),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,c,i,e),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) enddo; enddo - lhs_3333 = crystallite_subdt(c,i,e)*math_mul3333xx3333(dSdFe,temp_3333) & + lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & + math_mul3333xx3333(dSdFi,dFidS) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) if (error) then - call IO_warning(warning_ID=600,el=e,ip=i,g=c, & + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & ext_msg='inversion error in analytic tangent calculation') dSdF = rhs_3333 else @@ -1318,16 +1318,16 @@ function crystallite_stressTangent(c,i,e) result(dPdF) ! calculate dFpinvdF temp_3333 = math_mul3333xx3333(dLpdS,dSdF) do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(c,i,e) & + dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) enddo; enddo !-------------------------------------------------------------------------------------------------- ! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,c,i,e),transpose(invFp)) + temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,c,i,e),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,c,i,e)) + temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) + temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal do p=1,3 @@ -1335,7 +1335,7 @@ function crystallite_stressTangent(c,i,e) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,c,i,e), & + + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & @@ -1351,25 +1351,26 @@ end function crystallite_stressTangent subroutine crystallite_orientations integer & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e !< counter in element loop + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el !< counter in element loop + !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - call crystallite_orientation(c,i,e)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,c,i,e)))) + do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) enddo; enddo; enddo !$OMP END PARALLEL DO nonlocalPresent: if (any(plasticState%nonlocal)) then !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,e))%nonlocal) then - do i = FEsolving_execIP(1),FEsolving_execIP(2) + do el = FEsolving_execElem(1),FEsolving_execElem(2) + if (plasticState(material_phaseAt(1,el))%nonlocal) then + do ip = FEsolving_execIP(1),FEsolving_execIP(2) call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,e)),i,e) + phase_plasticityInstance(material_phaseAt(1,el)),ip,el) enddo endif enddo @@ -1403,15 +1404,15 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateSourceState(g,i,e) +subroutine integrateSourceState(co,ip,el) integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop integer :: & NiterationState, & !< number of iterations in state loop - p, & + ph, & c, & s, & size_pl @@ -1425,51 +1426,51 @@ subroutine integrateSourceState(g,i,e) logical :: & broken - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) + ph = material_phaseAt(co,el) + c = material_phaseMemberAt(co,ip,el) - broken = constitutive_thermal_collectDotState(p,c) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(ph,c) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,c) if(broken) return - do s = 1, phase_Nsources(p) - size_so(s) = sourceState(p)%p(s)%sizeDotState - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%subState0(1:size_so(s),c) & - + sourceState(p)%p(s)%dotState (1:size_so(s),c) & - * crystallite_subdt(g,i,e) + do s = 1, phase_Nsources(ph) + size_so(s) = sourceState(ph)%p(s)%sizeDotState + sourceState(ph)%p(s)%state(1:size_so(s),c) = sourceState(ph)%p(s)%subState0(1:size_so(s),c) & + + sourceState(ph)%p(s)%dotState (1:size_so(s),c) & + * crystallite_subdt(co,ip,el) source_dotState(1:size_so(s),2,s) = 0.0_pReal enddo iteration: do NiterationState = 1, num%nState - do s = 1, phase_Nsources(p) + do s = 1, phase_Nsources(ph) if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) - source_dotState(1:size_so(s),1,s) = sourceState(p)%p(s)%dotState(:,c) + source_dotState(1:size_so(s),1,s) = sourceState(ph)%p(s)%dotState(:,c) enddo - broken = constitutive_thermal_collectDotState(p,c) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,g,i,e), g,i,e,p,c) + broken = constitutive_thermal_collectDotState(ph,c) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,c) if(broken) exit iteration - do s = 1, phase_Nsources(p) - zeta = damper(sourceState(p)%p(s)%dotState(:,c), & + do s = 1, phase_Nsources(ph) + zeta = damper(sourceState(ph)%p(s)%dotState(:,c), & source_dotState(1:size_so(s),1,s),& source_dotState(1:size_so(s),2,s)) - sourceState(p)%p(s)%dotState(:,c) = sourceState(p)%p(s)%dotState(:,c) * zeta & + sourceState(ph)%p(s)%dotState(:,c) = sourceState(ph)%p(s)%dotState(:,c) * zeta & + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) - r(1:size_so(s)) = sourceState(p)%p(s)%state (1:size_so(s),c) & - - sourceState(p)%p(s)%subState0(1:size_so(s),c) & - - sourceState(p)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(g,i,e) - sourceState(p)%p(s)%state(1:size_so(s),c) = sourceState(p)%p(s)%state(1:size_so(s),c) & + r(1:size_so(s)) = sourceState(ph)%p(s)%state (1:size_so(s),c) & + - sourceState(ph)%p(s)%subState0(1:size_so(s),c) & + - sourceState(ph)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(co,ip,el) + sourceState(ph)%p(s)%state(1:size_so(s),c) = sourceState(ph)%p(s)%state(1:size_so(s),c) & - r(1:size_so(s)) - crystallite_converged(g,i,e) = & - crystallite_converged(g,i,e) .and. converged(r(1:size_so(s)), & - sourceState(p)%p(s)%state(1:size_so(s),c), & - sourceState(p)%p(s)%atol(1:size_so(s))) + crystallite_converged(co,ip,el) = & + crystallite_converged(co,ip,el) .and. converged(r(1:size_so(s)), & + sourceState(ph)%p(s)%state(1:size_so(s),c), & + sourceState(ph)%p(s)%atol(1:size_so(s))) enddo - if(crystallite_converged(g,i,e)) then - broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,g,i,e),g,i,e,p,c) + if(crystallite_converged(co,ip,el)) then + broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,c) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 124b4d608..0be59611f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -284,7 +284,7 @@ contains module subroutine mech_init integer :: & - p, & + ph, & stiffDegradationCtr class(tNode), pointer :: & num_crystallite, & @@ -304,35 +304,35 @@ module subroutine mech_init allocate(phase_NstiffnessDegradations(phases%length),source=0) allocate(output_constituent(phases%length)) - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) - output_constituent(p)%label = output_asStrings(mech) + output_constituent(ph)%label = output_asStrings(mech) #else - output_constituent(p)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) + output_constituent(ph)%label = mech%get_asStrings('output',defaultVal=emptyStringArray) #endif elastic => mech%get('elasticity') if(elastic%get_asString('type') == 'hooke') then - phase_elasticity(p) = ELASTICITY_HOOKE_ID + phase_elasticity(ph) = ELASTICITY_HOOKE_ID else call IO_error(200,ext_msg=elastic%get_asString('type')) endif stiffDegradation => mech%get('stiffness_degradation',defaultVal=emptyList) ! check for stiffness degradation mechanisms - phase_NstiffnessDegradations(p) = stiffDegradation%length + phase_NstiffnessDegradations(ph) = stiffDegradation%length enddo allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),phases%length), & source=STIFFNESS_DEGRADATION_undefined_ID) if(maxVal(phase_NstiffnessDegradations)/=0) then - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') stiffDegradation => mech%get('stiffness_degradation',defaultVal=emptyList) do stiffDegradationCtr = 1, stiffDegradation%length if(stiffDegradation%get_asString(stiffDegradationCtr) == 'damage') & - phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID + phase_stiffnessDegradation(stiffDegradationCtr,ph) = STIFFNESS_DEGRADATION_damage_ID enddo enddo endif @@ -352,9 +352,9 @@ module subroutine mech_init where(plastic_dislotungsten_init()) phase_plasticity = PLASTICITY_DISLOTUNGSTEN_ID where(plastic_nonlocal_init()) phase_plasticity = PLASTICITY_NONLOCAL_ID - do p = 1, phases%length - phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) - phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) + do ph = 1, phases%length + phase_elasticityInstance(ph) = count(phase_elasticity(1:ph) == phase_elasticity(ph)) + phase_plasticityInstance(ph) = count(phase_plasticity(1:ph) == phase_plasticity(ph)) enddo num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -397,15 +397,15 @@ function plastic_active(plastic_label) result(active_plastic) phase, & mech, & pl - integer :: p + integer :: ph phases => config_material%get('phase') allocate(active_plastic(phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') pl => mech%get('plasticity') - if(pl%get_asString('type') == plastic_label) active_plastic(p) = .true. + if(pl%get_asString('type') == plastic_label) active_plastic(ph) = .true. enddo end function plastic_active @@ -568,13 +568,13 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function mech_collectDotState(subdt, co, ip, el,phase,of) result(broken) +function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el, & !< element - phase, & + ph, & of real(pReal), intent(in) :: & subdt !< timestep @@ -588,12 +588,12 @@ function mech_collectDotState(subdt, co, ip, el,phase,of) result(broken) logical :: broken ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) - instance = phase_plasticityInstance(phase) + instance = phase_plasticityInstance(ph) - Mp = matmul(matmul(transpose(constitutive_mech_Fi(phase)%data(1:3,1:3,of)),& - constitutive_mech_Fi(phase)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) + Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& + constitutive_mech_Fi(ph)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) - plasticityType: select case (phase_plasticity(phase)) + plasticityType: select case (phase_plasticity(ph)) case (PLASTICITY_ISOTROPIC_ID) plasticityType call plastic_isotropic_dotState(Mp,instance,of) @@ -614,7 +614,7 @@ function mech_collectDotState(subdt, co, ip, el,phase,of) result(broken) call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,temperature(ho)%p(tme),subdt, & instance,of,ip,el) end select plasticityType - broken = any(IEEE_is_NaN(plasticState(phase)%dotState(:,of))) + broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,of))) end function mech_collectDotState @@ -624,13 +624,13 @@ end function mech_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, co, ip, el, phase, of) result(broken) +function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el, & !< element - phase, & + ph, & of real(pReal), intent(in), dimension(3,3) :: & S, & !< 2nd Piola Kirchhoff stress @@ -645,17 +645,17 @@ function constitutive_deltaState(S, Fi, co, ip, el, phase, of) result(broken) broken Mp = matmul(matmul(transpose(Fi),Fi),S) - instance = phase_plasticityInstance(phase) + instance = phase_plasticityInstance(ph) - plasticityType: select case (phase_plasticity(phase)) + plasticityType: select case (phase_plasticity(ph)) case (PLASTICITY_KINEHARDENING_ID) plasticityType call plastic_kinehardening_deltaState(Mp,instance,of) - broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) + broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,of))) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_deltaState(Mp,instance,of,ip,el) - broken = any(IEEE_is_NaN(plasticState(phase)%deltaState(:,of))) + broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,of))) case default broken = .false. @@ -663,13 +663,13 @@ function constitutive_deltaState(S, Fi, co, ip, el, phase, of) result(broken) end select plasticityType if(.not. broken) then - select case(phase_plasticity(phase)) + select case(phase_plasticity(ph)) case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID) - myOffset = plasticState(phase)%offsetDeltaState - mySize = plasticState(phase)%sizeDeltaState - plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) = & - plasticState(phase)%state(myOffset + 1:myOffset + mySize,of) + plasticState(phase)%deltaState(1:mySize,of) + myOffset = plasticState(ph)%offsetDeltaState + mySize = plasticState(ph)%sizeDeltaState + plasticState(ph)%state(myOffset + 1:myOffset + mySize,of) = & + plasticState(ph)%state(myOffset + 1:myOffset + mySize,of) + plasticState(ph)%deltaState(1:mySize,of) end select endif @@ -944,16 +944,16 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -module subroutine integrateStateFPI(g,i,e) +module subroutine integrateStateFPI(co,ip,el) integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop integer :: & NiterationState, & !< number of iterations in state loop - p, & - c, & + ph, & + me, & s, & size_pl integer, dimension(maxval(phase_Nsources)) :: & @@ -968,45 +968,45 @@ module subroutine integrateStateFPI(g,i,e) logical :: & broken - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) return - size_pl = plasticState(p)%sizeDotState - plasticState(p)%state(1:size_pl,c) = plasticState(p)%subState0(1:size_pl,c) & - + plasticState(p)%dotState (1:size_pl,c) & - * crystallite_subdt(g,i,e) + size_pl = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%subState0(1:size_pl,me) & + + plasticState(ph)%dotState (1:size_pl,me) & + * crystallite_subdt(co,ip,el) plastic_dotState(1:size_pl,2) = 0.0_pReal iteration: do NiterationState = 1, num%nState if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(p)%dotState(:,c) + plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(g,i,e) + broken = integrateStress(co,ip,el) if(broken) exit iteration - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) exit iteration - zeta = damper(plasticState(p)%dotState(:,c),plastic_dotState(1:size_pl,1),& + zeta = damper(plasticState(ph)%dotState(:,me),plastic_dotState(1:size_pl,1),& plastic_dotState(1:size_pl,2)) - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) * zeta & + plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(p)%state (1:size_pl,c) & - - plasticState(p)%subState0(1:size_pl,c) & - - plasticState(p)%dotState (1:size_pl,c) * crystallite_subdt(g,i,e) - plasticState(p)%state(1:size_pl,c) = plasticState(p)%state(1:size_pl,c) & + r(1:size_pl) = plasticState(ph)%state (1:size_pl,me) & + - plasticState(ph)%subState0(1:size_pl,me) & + - plasticState(ph)%dotState (1:size_pl,me) * crystallite_subdt(co,ip,el) + plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - r(1:size_pl) - crystallite_converged(g,i,e) = converged(r(1:size_pl), & - plasticState(p)%state(1:size_pl,c), & - plasticState(p)%atol(1:size_pl)) + crystallite_converged(co,ip,el) = converged(r(1:size_pl), & + plasticState(ph)%state(1:size_pl,me), & + plasticState(ph)%atol(1:size_pl)) - if(crystallite_converged(g,i,e)) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + if(crystallite_converged(co,ip,el)) then + broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration endif @@ -1041,36 +1041,36 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(g,i,e) +subroutine integrateStateEuler(co,ip,el) integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop integer :: & - p, & - c, & + ph, & + me, & sizeDotState logical :: & broken - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) return - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) & + * crystallite_subdt(co,ip,el) - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken + broken = integrateStress(co,ip,el) + crystallite_converged(co,ip,el) = .not. broken end subroutine integrateStateEuler @@ -1078,15 +1078,15 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(g,i,e) +subroutine integrateStateAdaptiveEuler(co,ip,el) integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop integer :: & - p, & - c, & + ph, & + me, & sizeDotState logical :: & broken @@ -1094,34 +1094,34 @@ subroutine integrateStateAdaptiveEuler(g,i,e) real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) return - sizeDotState = plasticState(p)%sizeDotState + sizeDotState = plasticState(ph)%sizeDotState - residuum_plastic(1:sizeDotState) = - plasticState(p)%dotstate(1:sizeDotState,c) * 0.5_pReal * crystallite_subdt(g,i,e) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotstate(1:sizeDotState,c) * crystallite_subdt(g,i,e) + residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * crystallite_subdt(co,ip,el) + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotstate(1:sizeDotState,me) * crystallite_subdt(co,ip,el) - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(g,i,e) + broken = integrateStress(co,ip,el) if(broken) return - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) return - sizeDotState = plasticState(p)%sizeDotState - crystallite_converged(g,i,e) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(p)%dotState(:,c) * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) + sizeDotState = plasticState(ph)%sizeDotState + crystallite_converged(co,ip,el) = converged(residuum_plastic(1:sizeDotState) & + + 0.5_pReal * plasticState(ph)%dotState(:,me) * crystallite_subdt(co,ip,el), & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) end subroutine integrateStateAdaptiveEuler @@ -1129,9 +1129,9 @@ end subroutine integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(g,i,e) +subroutine integrateStateRK4(co,ip,el) - integer, intent(in) :: g,i,e + integer, intent(in) :: co,ip,el real(pReal), dimension(3,3), parameter :: & A = reshape([& @@ -1144,7 +1144,7 @@ subroutine integrateStateRK4(g,i,e) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - call integrateStateRK(g,i,e,A,B,C) + call integrateStateRK(co,ip,el,A,B,C) end subroutine integrateStateRK4 @@ -1152,9 +1152,9 @@ end subroutine integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(g,i,e) +subroutine integrateStateRKCK45(co,ip,el) - integer, intent(in) :: g,i,e + integer, intent(in) :: co,ip,el real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -1174,7 +1174,7 @@ subroutine integrateStateRKCK45(g,i,e) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - call integrateStateRK(g,i,e,A,B,C,DB) + call integrateStateRK(co,ip,el,A,B,C,DB) end subroutine integrateStateRKCK45 @@ -1183,7 +1183,7 @@ end subroutine integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(g,i,e,A,B,CC,DB) +subroutine integrateStateRK(co,ip,el,A,B,CC,DB) real(pReal), dimension(:,:), intent(in) :: A @@ -1191,71 +1191,71 @@ subroutine integrateStateRK(g,i,e,A,B,CC,DB) real(pReal), dimension(:), intent(in), optional :: DB integer, intent(in) :: & - e, & !< element index in element loop - i, & !< integration point index in ip loop - g !< grain index in grain loop + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop integer :: & stage, & ! stage index in integration stage loop n, & - p, & - c, & + ph, & + me, & sizeDotState logical :: & broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState - p = material_phaseAt(g,e) - c = material_phaseMemberAt(g,i,e) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(g,i,e), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) if(broken) return do stage = 1,size(A,1) - sizeDotState = plasticState(p)%sizeDotState - plastic_RKdotState(1:sizeDotState,stage) = plasticState(p)%dotState(:,c) - plasticState(p)%dotState(:,c) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) + sizeDotState = plasticState(ph)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me) + plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) do n = 2, stage - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%dotState(:,c) = plasticState(p)%dotState(:,c) & + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) & + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - sizeDotState = plasticState(p)%sizeDotState - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) & + * crystallite_subdt(co,ip,el) - broken = integrateStress(g,i,e,CC(stage)) + broken = integrateStress(co,ip,el,CC(stage)) if(broken) exit - broken = mech_collectDotState(crystallite_subdt(g,i,e)*CC(stage), g,i,e,p,c) + broken = mech_collectDotState(crystallite_subdt(co,ip,el)*CC(stage), co,ip,el,ph,me) if(broken) exit enddo if(broken) return - sizeDotState = plasticState(p)%sizeDotState + sizeDotState = plasticState(ph)%sizeDotState - plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (p)%dotState(:,c) - plasticState(p)%dotState(:,c) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(p)%state(1:sizeDotState,c) = plasticState(p)%subState0(1:sizeDotState,c) & - + plasticState(p)%dotState (1:sizeDotState,c) & - * crystallite_subdt(g,i,e) + plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) + plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) & + * crystallite_subdt(co,ip,el) if(present(DB)) & broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & - * crystallite_subdt(g,i,e), & - plasticState(p)%state(1:sizeDotState,c), & - plasticState(p)%atol(1:sizeDotState)) + * crystallite_subdt(co,ip,el), & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) if(broken) return - broken = constitutive_deltaState(crystallite_S(1:3,1:3,g,i,e), & - constitutive_mech_Fi(p)%data(1:3,1:3,c),g,i,e,p,c) + broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(g,i,e) - crystallite_converged(g,i,e) = .not. broken + broken = integrateStress(co,ip,el) + crystallite_converged(co,ip,el) = .not. broken end subroutine integrateStateRK @@ -1396,9 +1396,7 @@ end subroutine crystallite_results !-------------------------------------------------------------------------------------------------- module subroutine mech_initializeRestorationPoints(ph,me) - integer, intent(in) :: & - ph, & - me + integer, intent(in) :: ph, me constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) @@ -1416,12 +1414,12 @@ module subroutine constitutive_mech_windForward(ph,me) integer, intent(in) :: ph, me - constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) - plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) + constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) end subroutine constitutive_mech_windForward From 7ee52afda2a5ea73b1e84ff790d37af26f3a0efd Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Wed, 23 Dec 2020 09:59:47 +0100 Subject: [PATCH 078/214] [skip ci] corrected comment on meaning of F --- src/constitutive_mech.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 0be59611f..0b6c5c77c 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -465,11 +465,11 @@ end subroutine constitutive_hooke_SandItsTangents module subroutine constitutive_plastic_dependentState(F, co, ip, el) integer, intent(in) :: & - co, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & - F !< elastic deformation gradient + F !< deformation gradient integer :: & ho, & !< homogenization @@ -501,7 +501,7 @@ end subroutine constitutive_plastic_dependentState module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, co, ip, el) integer, intent(in) :: & - co, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element real(pReal), intent(in), dimension(3,3) :: & @@ -796,7 +796,7 @@ function integrateStress(co,ip,el,timeFraction) result(broken) m = material_phaseMemberAt(co,ip,el) Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess - Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess + Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) if (error) return ! error From 2947e7c444ff9fb0d53c8d9345a9285295354b2e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 08:12:56 +0100 Subject: [PATCH 079/214] polishing --- src/constitutive.f90 | 158 +++++++++++++++++++------------------- src/constitutive_mech.f90 | 8 +- 2 files changed, 85 insertions(+), 81 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4d0fd5582..f069ac726 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1250,97 +1250,97 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) pp = material_phaseAt(co,el) m = material_phaseMemberAt(co,ip,el) - call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) - call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m), & - co,ip,el) + call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & + crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & + crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m), & + co,ip,el) - invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) - invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) + invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) + invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) + invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) + invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) - if (sum(abs(dLidS)) < tol_math_check) then - dFidS = 0.0_pReal - else - lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal - do o=1,3; do p=1,3 - lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) - lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & - + invFi*invFi(p,o) - rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) - enddo; enddo - call math_invert(temp_99,error,math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dFidS = 0.0_pReal - else - dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif + if (sum(abs(dLidS)) < tol_math_check) then + dFidS = 0.0_pReal + else + lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal + do o=1,3; do p=1,3 + lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & + + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) + lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + + invFi*invFi(p,o) + rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & + - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) + enddo; enddo + call math_invert(temp_99,error,math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dFidS = 0.0_pReal + else + dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS + endif - call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) - dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS + call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- ! calculate dSdF - temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_1 = transpose(matmul(invFp,invFi)) + temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) - do o=1,3; do p=1,3 - rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) - temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & - + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) - enddo; enddo - lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & - + math_mul3333xx3333(dSdFi,dFidS) + do o=1,3; do p=1,3 + rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) + temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) + enddo; enddo + lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & + + math_mul3333xx3333(dSdFi,dFidS) - call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dSdF = rhs_3333 - else - dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif + call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dSdF = rhs_3333 + else + dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif !-------------------------------------------------------------------------------------------------- ! calculate dFpinvdF - temp_3333 = math_mul3333xx3333(dLpdS,dSdF) - do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & - * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) - enddo; enddo + temp_3333 = math_mul3333xx3333(dLpdS,dSdF) + do o=1,3; do p=1,3 + dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & + * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) + enddo; enddo !-------------------------------------------------------------------------------------------------- ! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) - temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) + temp_33_2 = matmul(invFp,temp_33_1) + temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) + temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) - dPdF = 0.0_pReal - do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(temp_33_2) - enddo - do o=1,3; do p=1,3 - dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & - dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & - transpose(invFp)) & - + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo + dPdF = 0.0_pReal + do p=1,3 + dPdF(p,1:3,p,1:3) = transpose(temp_33_2) + enddo + do o=1,3; do p=1,3 + dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & + dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & + transpose(invFp)) & + + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) + enddo; enddo end function crystallite_stressTangent @@ -1385,14 +1385,16 @@ end subroutine crystallite_orientations !-------------------------------------------------------------------------------------------------- function crystallite_push33ToRef(co,ip,el, tensor33) - real(pReal), dimension(3,3) :: crystallite_push33ToRef real(pReal), dimension(3,3), intent(in) :: tensor33 real(pReal), dimension(3,3) :: T integer, intent(in):: & el, & ip, & co + + real(pReal), dimension(3,3) :: crystallite_push33ToRef + T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) @@ -1410,6 +1412,7 @@ subroutine integrateSourceState(co,ip,el) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + integer :: & NiterationState, & !< number of iterations in state loop ph, & @@ -1426,6 +1429,7 @@ subroutine integrateSourceState(co,ip,el) logical :: & broken + ph = material_phaseAt(co,el) c = material_phaseMemberAt(co,ip,el) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 0b6c5c77c..800e67b32 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1185,16 +1185,15 @@ end subroutine integrateStateRKCK45 !-------------------------------------------------------------------------------------------------- subroutine integrateStateRK(co,ip,el,A,B,CC,DB) - real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:), intent(in) :: B, CC real(pReal), dimension(:), intent(in), optional :: DB - integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop - integer :: & + + integer :: & stage, & ! stage index in integration stage loop n, & ph, & @@ -1202,7 +1201,8 @@ subroutine integrateStateRK(co,ip,el,A,B,CC,DB) sizeDotState logical :: & broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) From 53a7622f25a04b9a25cc4b64efeecaa072ab6115 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 08:14:42 +0100 Subject: [PATCH 080/214] consistent names --- src/constitutive.f90 | 66 ++++++++++++++++++++++---------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f069ac726..e100095ac 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1391,10 +1391,10 @@ function crystallite_push33ToRef(co,ip,el, tensor33) el, & ip, & co - + real(pReal), dimension(3,3) :: crystallite_push33ToRef - + T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) @@ -1412,12 +1412,12 @@ subroutine integrateSourceState(co,ip,el) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop - + integer :: & NiterationState, & !< number of iterations in state loop ph, & - c, & - s, & + me, & + so, & size_pl integer, dimension(maxval(phase_Nsources)) :: & size_so @@ -1431,50 +1431,50 @@ subroutine integrateSourceState(co,ip,el) ph = material_phaseAt(co,el) - c = material_phaseMemberAt(co,ip,el) + me = material_phaseMemberAt(co,ip,el) - broken = constitutive_thermal_collectDotState(ph,c) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,c) + broken = constitutive_thermal_collectDotState(ph,me) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) if(broken) return - do s = 1, phase_Nsources(ph) - size_so(s) = sourceState(ph)%p(s)%sizeDotState - sourceState(ph)%p(s)%state(1:size_so(s),c) = sourceState(ph)%p(s)%subState0(1:size_so(s),c) & - + sourceState(ph)%p(s)%dotState (1:size_so(s),c) & + do so = 1, phase_Nsources(ph) + size_so(so) = sourceState(ph)%p(so)%sizeDotState + sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + + sourceState(ph)%p(so)%dotState (1:size_so(so),me) & * crystallite_subdt(co,ip,el) - source_dotState(1:size_so(s),2,s) = 0.0_pReal + source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo iteration: do NiterationState = 1, num%nState - do s = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(s),2,s) = source_dotState(1:size_so(s),1,s) - source_dotState(1:size_so(s),1,s) = sourceState(ph)%p(s)%dotState(:,c) + do so = 1, phase_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) enddo - broken = constitutive_thermal_collectDotState(ph,c) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,c) + broken = constitutive_thermal_collectDotState(ph,me) + broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) if(broken) exit iteration - do s = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(s)%dotState(:,c), & - source_dotState(1:size_so(s),1,s),& - source_dotState(1:size_so(s),2,s)) - sourceState(ph)%p(s)%dotState(:,c) = sourceState(ph)%p(s)%dotState(:,c) * zeta & - + source_dotState(1:size_so(s),1,s)* (1.0_pReal - zeta) - r(1:size_so(s)) = sourceState(ph)%p(s)%state (1:size_so(s),c) & - - sourceState(ph)%p(s)%subState0(1:size_so(s),c) & - - sourceState(ph)%p(s)%dotState (1:size_so(s),c) * crystallite_subdt(co,ip,el) - sourceState(ph)%p(s)%state(1:size_so(s),c) = sourceState(ph)%p(s)%state(1:size_so(s),c) & - - r(1:size_so(s)) + do so = 1, phase_Nsources(ph) + zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & + - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) + sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) crystallite_converged(co,ip,el) = & - crystallite_converged(co,ip,el) .and. converged(r(1:size_so(s)), & - sourceState(ph)%p(s)%state(1:size_so(s),c), & - sourceState(ph)%p(s)%atol(1:size_so(s))) + crystallite_converged(co,ip,el) .and. converged(r(1:size_so(so)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) enddo if(crystallite_converged(co,ip,el)) then - broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,c) + broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) exit iteration endif From b5ec6048a12d5a40f62024605bf2111b5cc3cfed Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 08:20:29 +0100 Subject: [PATCH 081/214] only needed in constitutive --- src/constitutive.f90 | 26 +++++++++++++++++++++++++ src/material.f90 | 46 -------------------------------------------- 2 files changed, 26 insertions(+), 46 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e100095ac..6035e8c19 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -21,6 +21,31 @@ module constitutive implicit none private + enum, bind(c); enumerator :: & + ELASTICITY_UNDEFINED_ID, & + ELASTICITY_HOOKE_ID, & + PLASTICITY_UNDEFINED_ID, & + PLASTICITY_NONE_ID, & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & + PLASTICITY_NONLOCAL_ID, & + SOURCE_UNDEFINED_ID ,& + SOURCE_THERMAL_DISSIPATION_ID, & + SOURCE_THERMAL_EXTERNALHEAT_ID, & + SOURCE_DAMAGE_ISOBRITTLE_ID, & + SOURCE_DAMAGE_ISODUCTILE_ID, & + SOURCE_DAMAGE_ANISOBRITTLE_ID, & + SOURCE_DAMAGE_ANISODUCTILE_ID, & + KINEMATICS_UNDEFINED_ID ,& + KINEMATICS_CLEAVAGE_OPENING_ID, & + KINEMATICS_SLIPPLANE_OPENING_ID, & + KINEMATICS_THERMAL_EXPANSION_ID, & + STIFFNESS_DEGRADATION_UNDEFINED_ID, & + STIFFNESS_DEGRADATION_DAMAGE_ID + end enum real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain real(pReal), dimension(:,:,:), allocatable :: & @@ -354,6 +379,7 @@ module constitutive end interface + type(tDebugOptions) :: debugConstitutive public :: & diff --git a/src/material.f90 b/src/material.f90 index 1f2437ad3..581182d22 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -17,29 +17,6 @@ module material private enum, bind(c); enumerator :: & - ELASTICITY_UNDEFINED_ID, & - ELASTICITY_HOOKE_ID, & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & - KINEMATICS_UNDEFINED_ID ,& - KINEMATICS_CLEAVAGE_OPENING_ID, & - KINEMATICS_SLIPPLANE_OPENING_ID, & - KINEMATICS_THERMAL_EXPANSION_ID, & - STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID, & THERMAL_ISOTHERMAL_ID, & THERMAL_CONDUCTION_ID, & DAMAGE_NONE_ID, & @@ -96,29 +73,6 @@ module material public :: & material_init, & - ELASTICITY_UNDEFINED_ID, & - ELASTICITY_HOOKE_ID, & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & - KINEMATICS_UNDEFINED_ID ,& - KINEMATICS_CLEAVAGE_OPENING_ID, & - KINEMATICS_SLIPPLANE_OPENING_ID, & - KINEMATICS_THERMAL_EXPANSION_ID, & - STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID, & THERMAL_ISOTHERMAL_ID, & THERMAL_CONDUCTION_ID, & DAMAGE_NONE_ID, & From 2dcff67f692aabe7958e5979c60f8a8fcc00ad7b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 08:57:58 +0100 Subject: [PATCH 082/214] standard name --- src/constitutive.f90 | 156 +++++++++++++++++++++---------------------- 1 file changed, 78 insertions(+), 78 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6035e8c19..497d84bdf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -846,9 +846,9 @@ subroutine crystallite_init Nconstituents, & p, & m, & - c, & !< counter in integration point component loop - i, & !< counter in integration point loop - e, & !< counter in element loop + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el, & !< counter in element loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements @@ -954,19 +954,19 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(p,m) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1), FEsolving_execIP(2); do c = 1, homogenization_Nconstituents(material_homogenizationAt(e)) + do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) - constitutive_mech_Fp0(p)%data(1:3,1:3,m) = material_orientation0(c,i,e)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) + constitutive_mech_Fp0(p)%data(1:3,1:3,m) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) constitutive_mech_Fp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) & / math_det33(constitutive_mech_Fp0(p)%data(1:3,1:3,m))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(p)%data(1:3,1:3,m) = math_I3 - crystallite_F0(1:3,1:3,c,i,e) = math_I3 + crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - crystallite_Fe(1:3,1:3,c,i,e) = math_inv33(matmul(constitutive_mech_Fi0(p)%data(1:3,1:3,m), & + crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(p)%data(1:3,1:3,m), & constitutive_mech_Fp0(p)%data(1:3,1:3,m))) ! assuming that euler angles are given in internal strain free configuration constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) @@ -974,7 +974,7 @@ subroutine crystallite_init constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) - crystallite_requested(c,i,e) = .true. + crystallite_requested(co,ip,el) = .true. enddo; enddo enddo !$OMP END PARALLEL DO @@ -985,13 +985,13 @@ subroutine crystallite_init call crystallite_orientations() !$OMP PARALLEL DO PRIVATE(p,m) - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(e)) - p = material_phaseAt(c,e) - m = material_phaseMemberAt(c,i,e) - call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,c,i,e), & - c,i,e) ! update dependent state variables to be consistent with basic states + do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) + call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el), & + co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo enddo @@ -1011,7 +1011,7 @@ function crystallite_stress() formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - c, & !< counter in integration point component loop + co, & !< counter in integration point component loop ip, & !< counter in integration point loop el, & !< counter in element loop s, ph, me @@ -1031,25 +1031,25 @@ function crystallite_stress() crystallite_subStep = 0.0_pReal !$OMP PARALLEL DO PRIVATE(ph,me) elementLooping1: do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2); do c = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(c,el) - me = material_phaseMemberAt(c,ip,el) - subLi0(1:3,1:3,c,ip,el) = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) - homogenizationRequestsCalculation: if (crystallite_requested(c,ip,el)) then - plasticState (material_phaseAt(c,el))%subState0( :,material_phaseMemberAt(c,ip,el)) = & - plasticState (material_phaseAt(c,el))%partitionedState0(:,material_phaseMemberAt(c,ip,el)) + do ip = FEsolving_execIP(1),FEsolving_execIP(2); do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + subLi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then + plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(c,el)) - sourceState(material_phaseAt(c,el))%p(s)%subState0( :,material_phaseMemberAt(c,ip,el)) = & - sourceState(material_phaseAt(c,el))%p(s)%partitionedState0(:,material_phaseMemberAt(c,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) enddo - crystallite_subFp0(1:3,1:3,c,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,c,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,c,ip,el) = crystallite_partitionedF0(1:3,1:3,c,ip,el) - subFrac(c,ip,el) = 0.0_pReal - crystallite_subStep(c,ip,el) = 1.0_pReal/num%subStepSizeCryst - todo(c,ip,el) = .true. - crystallite_converged(c,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subFrac(co,ip,el) = 0.0_pReal + crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst + todo(co,ip,el) = .true. + crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst endif homogenizationRequestsCalculation enddo; enddo enddo elementLooping1 @@ -1066,68 +1066,68 @@ function crystallite_stress() !$OMP PARALLEL DO PRIVATE(formerSubStep,ph,me) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do c = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(c,el) - me = material_phaseMemberAt(c,ip,el) + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(c,ip,el)) then - formerSubStep = crystallite_subStep(c,ip,el) - subFrac(c,ip,el) = subFrac(c,ip,el) + crystallite_subStep(c,ip,el) - crystallite_subStep(c,ip,el) = min(1.0_pReal - subFrac(c,ip,el), & - num%stepIncreaseCryst * crystallite_subStep(c,ip,el)) + if (crystallite_converged(co,ip,el)) then + formerSubStep = crystallite_subStep(co,ip,el) + subFrac(co,ip,el) = subFrac(co,ip,el) + crystallite_subStep(co,ip,el) + crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac(co,ip,el), & + num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) - todo(c,ip,el) = crystallite_subStep(c,ip,el) > 0.0_pReal ! still time left to integrate on? + todo(co,ip,el) = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? - if (todo(c,ip,el)) then - crystallite_subF0 (1:3,1:3,c,ip,el) = crystallite_subF(1:3,1:3,c,ip,el) - subLp0(1:3,1:3,c,ip,el) = crystallite_Lp (1:3,1:3,c,ip,el) - subLi0(1:3,1:3,c,ip,el) = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,c,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,c,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(c,el))%subState0(:,material_phaseMemberAt(c,ip,el)) & - = plasticState(material_phaseAt(c,el))%state( :,material_phaseMemberAt(c,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(c,el)) - sourceState( material_phaseAt(c,el))%p(s)%subState0(:,material_phaseMemberAt(c,ip,el)) & - = sourceState(material_phaseAt(c,el))%p(s)%state( :,material_phaseMemberAt(c,ip,el)) + if (todo(co,ip,el)) then + crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) + subLi0(1:3,1:3,co,ip,el) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) enddo endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else - crystallite_subStep(c,ip,el) = num%subStepSizeCryst * crystallite_subStep(c,ip,el) - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,c,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,c,ip,el) - crystallite_S (1:3,1:3,c,ip,el) = crystallite_S0 (1:3,1:3,c,ip,el) - if (crystallite_subStep(c,ip,el) < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,c,ip,el) = subLp0(1:3,1:3,c,ip,el) - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0(1:3,1:3,c,ip,el) + crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0(1:3,1:3,co,ip,el) + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0(1:3,1:3,co,ip,el) endif - plasticState (material_phaseAt(c,el))%state( :,material_phaseMemberAt(c,ip,el)) & - = plasticState(material_phaseAt(c,el))%subState0(:,material_phaseMemberAt(c,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(c,el)) - sourceState( material_phaseAt(c,el))%p(s)%state( :,material_phaseMemberAt(c,ip,el)) & - = sourceState(material_phaseAt(c,el))%p(s)%subState0(:,material_phaseMemberAt(c,ip,el)) + plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo(c,ip,el) = crystallite_subStep(c,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) + todo(co,ip,el) = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) endif !-------------------------------------------------------------------------------------------------- ! prepare for integration - if (todo(c,ip,el)) then - crystallite_subF(1:3,1:3,c,ip,el) = crystallite_subF0(1:3,1:3,c,ip,el) & - + crystallite_subStep(c,ip,el) *( crystallite_partitionedF (1:3,1:3,c,ip,el) & - -crystallite_partitionedF0(1:3,1:3,c,ip,el)) - crystallite_Fe(1:3,1:3,c,ip,el) = matmul(crystallite_subF(1:3,1:3,c,ip,el), & + if (todo(co,ip,el)) then + crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(c,ip,el) = crystallite_subStep(c,ip,el) * crystallite_dt(c,ip,el) - crystallite_converged(c,ip,el) = .false. - call integrateState(c,ip,el) - call integrateSourceState(c,ip,el) + crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) + crystallite_converged(co,ip,el) = .false. + call integrateState(co,ip,el) + call integrateSourceState(co,ip,el) endif enddo From a9b674b9e947e41652ba8b3f939b13dc99d098b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 10:05:02 +0100 Subject: [PATCH 083/214] no need for separate loop --- src/constitutive.f90 | 133 +++++++++++++++++++++++++++++++++++++++++ src/homogenization.f90 | 33 ++++------ 2 files changed, 146 insertions(+), 20 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 497d84bdf..9b1bb33b3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -398,6 +398,7 @@ module constitutive converged, & crystallite_init, & crystallite_stress, & + crystallite_stress2, & crystallite_stressTangent, & crystallite_orientations, & crystallite_push33ToRef, & @@ -1152,6 +1153,138 @@ function crystallite_stress() end function crystallite_stress +!-------------------------------------------------------------------------------------------------- +!> @brief calculate stress (P) +!-------------------------------------------------------------------------------------------------- +function crystallite_stress2(co,ip,el) + + integer, intent(in) :: & + co, & + ip, & + el + + logical :: crystallite_stress2 + + real(pReal) :: & + formerSubStep + integer :: & + NiterationCrystallite, & ! number of iterations in crystallite loop + s, ph, me + logical :: todo + real(pReal) :: subFrac !ToDo: need to set some values to false for different Ngrains + real(pReal), dimension(3,3) :: & + subLp0, & !< plastic velocity grad at start of crystallite inc + subLi0 !< intermediate velocity grad at start of crystallite inc + + + + + +!-------------------------------------------------------------------------------------------------- +! initialize to starting condition + crystallite_subStep(co,ip,el) = 0.0_pReal + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then + plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + enddo + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subFrac = 0.0_pReal + crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst + todo = .true. + crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + endif homogenizationRequestsCalculation + + todo = .true. + NiterationCrystallite = 0 + cutbackLooping: do while (todo) + NiterationCrystallite = NiterationCrystallite + 1 + +!-------------------------------------------------------------------------------------------------- +! wind forward + if (crystallite_converged(co,ip,el)) then + formerSubStep = crystallite_subStep(co,ip,el) + subFrac = subFrac + crystallite_subStep(co,ip,el) + crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac, & + num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) + + todo = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? + + if (todo) then + crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + enddo + endif + +!-------------------------------------------------------------------------------------------------- +! cut back (reduced time and restore) + else + crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + endif + plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + enddo + + ! cant restore dotState here, since not yet calculated in first cutback after initialization + todo = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) + endif + +!-------------------------------------------------------------------------------------------------- +! prepare for integration + if (todo) then + crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & + math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) + crystallite_converged(co,ip,el) = .false. + call integrateState(co,ip,el) + call integrateSourceState(co,ip,el) + endif + + + +!-------------------------------------------------------------------------------------------------- +! integrate --- requires fully defined state array (basic + dependent state) + if (.not. crystallite_converged(co,ip,el) .and. crystallite_subStep(co,ip,el) > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further + todo = .true. + enddo cutbackLooping + +! return whether converged or not + crystallite_stress2 = crystallite_converged(co,ip,el) + +end function crystallite_stress2 + + !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8ceac0eb8..f7516c5b5 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -180,7 +180,7 @@ subroutine materialpoint_stressAndItsTangent(dt) NiterationMPstate, & i, & !< integration point number e, & !< element number - myNgrains + myNgrains, co real(pReal), dimension(discretization_nIPs,discretization_Nelems) :: & subFrac, & subStep @@ -285,7 +285,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - !$OMP PARALLEL DO PRIVATE(myNgrains,m) + !$OMP PARALLEL DO PRIVATE(myNgrains,m,co) elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2) @@ -300,19 +300,12 @@ subroutine materialpoint_stressAndItsTangent(dt) else crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore endif - enddo IpLooping2 - enddo elementLooping2 - !$OMP END PARALLEL DO + converged(i,e) = .true. + do co = 1, myNgrains + converged(i,e) = converged(i,e) .and. crystallite_stress2(co,i,e) + enddo -!-------------------------------------------------------------------------------------------------- -! crystallite integration - converged = crystallite_stress() !ToDo: MD not sure if that is the best logic -!-------------------------------------------------------------------------------------------------- -! state update - !$OMP PARALLEL DO PRIVATE(m) - elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2) if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then if (.not. converged(i,e)) then doneAndHappy(1:2,i,e) = [.true.,.false.] @@ -326,8 +319,8 @@ subroutine materialpoint_stressAndItsTangent(dt) converged(i,e) = all(doneAndHappy(1:2,i,e)) ! converged if done and happy endif endif - enddo IpLooping3 - enddo elementLooping3 + enddo IpLooping2 + enddo elementLooping2 !$OMP END PARALLEL DO enddo convergenceLooping @@ -339,11 +332,11 @@ subroutine materialpoint_stressAndItsTangent(dt) if (.not. terminallyIll ) then call crystallite_orientations() ! calculate crystal orientations !$OMP PARALLEL DO - elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) - IpLooping4: do i = FEsolving_execIP(1),FEsolving_execIP(2) + elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2) call mech_homogenize(i,e) - enddo IpLooping4 - enddo elementLooping4 + enddo IpLooping3 + enddo elementLooping3 !$OMP END PARALLEL DO else print'(/,a,/)', ' << HOMOG >> Material Point terminally ill' @@ -433,7 +426,7 @@ end subroutine homogenization_results !-------------------------------------------------------------------------------------------------- subroutine homogenization_forward - integer :: ho + integer :: ho do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state From ee37c75de9249490a2190943942a75d26b0fa608 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 10:41:45 +0100 Subject: [PATCH 084/214] problems with checkout Probably due to large HDF5 files --- .gitmodules | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitmodules b/.gitmodules index 5d17eb0cb..0587fff4c 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,3 +2,4 @@ path = PRIVATE url = ../PRIVATE.git branch = master + shallow = true From 44d8210f2d59750933586959e5f6d31d43bcbab4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 11:07:57 +0100 Subject: [PATCH 085/214] not needed anymore --- src/constitutive.f90 | 160 ++--------------------------------------- src/homogenization.f90 | 2 +- 2 files changed, 5 insertions(+), 157 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9b1bb33b3..6331172bf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -398,7 +398,6 @@ module constitutive converged, & crystallite_init, & crystallite_stress, & - crystallite_stress2, & crystallite_stressTangent, & crystallite_orientations, & crystallite_push33ToRef, & @@ -1005,165 +1004,14 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress() - - logical, dimension(discretization_nIPs,discretization_Nelems) :: crystallite_stress - real(pReal) :: & - formerSubStep - integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el, & !< counter in element loop - s, ph, me - logical, dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: todo !ToDo: need to set some values to false for different Ngrains - real(pReal), dimension(homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems) :: subFrac !ToDo: need to set some values to false for different Ngrains - real(pReal), dimension(:,:,:,:,:), allocatable :: & - subLp0,& !< plastic velocity grad at start of crystallite inc - subLi0 !< intermediate velocity grad at start of crystallite inc - - todo = .false. - - allocate(subLi0(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems)) - subLp0 = crystallite_partitionedLp0 - -!-------------------------------------------------------------------------------------------------- -! initialize to starting condition - crystallite_subStep = 0.0_pReal - !$OMP PARALLEL DO PRIVATE(ph,me) - elementLooping1: do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2); do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - subLi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) - homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) - subFrac(co,ip,el) = 0.0_pReal - crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst - todo(co,ip,el) = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst - endif homogenizationRequestsCalculation - enddo; enddo - enddo elementLooping1 - !$OMP END PARALLEL DO - - NiterationCrystallite = 0 - cutbackLooping: do while (any(todo(:,FEsolving_execIP(1):FEsolving_execIP(2),FEsolving_execELem(1):FEsolving_execElem(2)))) - NiterationCrystallite = NiterationCrystallite + 1 - -#ifdef DEBUG - if (debugCrystallite%extensive) & - print'(a,i6)', '<< CRYST stress >> crystallite iteration ',NiterationCrystallite -#endif - !$OMP PARALLEL DO PRIVATE(formerSubStep,ph,me) - elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) -!-------------------------------------------------------------------------------------------------- -! wind forward - if (crystallite_converged(co,ip,el)) then - formerSubStep = crystallite_subStep(co,ip,el) - subFrac(co,ip,el) = subFrac(co,ip,el) + crystallite_subStep(co,ip,el) - crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac(co,ip,el), & - num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) - - todo(co,ip,el) = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? - - if (todo(co,ip,el)) then - crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) - subLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) - subLi0(1:3,1:3,co,ip,el) = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) - enddo - endif - -!-------------------------------------------------------------------------------------------------- -! cut back (reduced time and restore) - else - crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0(1:3,1:3,co,ip,el) - endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) - enddo - - ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo(co,ip,el) = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) - endif - -!-------------------------------------------------------------------------------------------------- -! prepare for integration - if (todo(co,ip,el)) then - crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & - + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) - crystallite_converged(co,ip,el) = .false. - call integrateState(co,ip,el) - call integrateSourceState(co,ip,el) - endif - - enddo - enddo - enddo elementLooping3 - !$OMP END PARALLEL DO - -!-------------------------------------------------------------------------------------------------- -! integrate --- requires fully defined state array (basic + dependent state) - where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further - todo = .true. ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation - enddo cutbackLooping - -! return whether converged or not - crystallite_stress = .false. - elementLooping5: do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - crystallite_stress(ip,el) = all(crystallite_converged(:,ip,el)) - enddo - enddo elementLooping5 - -end function crystallite_stress - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate stress (P) -!-------------------------------------------------------------------------------------------------- -function crystallite_stress2(co,ip,el) +function crystallite_stress(co,ip,el) integer, intent(in) :: & co, & ip, & el - logical :: crystallite_stress2 + logical :: crystallite_stress real(pReal) :: & formerSubStep @@ -1280,9 +1128,9 @@ function crystallite_stress2(co,ip,el) enddo cutbackLooping ! return whether converged or not - crystallite_stress2 = crystallite_converged(co,ip,el) + crystallite_stress = crystallite_converged(co,ip,el) -end function crystallite_stress2 +end function crystallite_stress !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization.f90 b/src/homogenization.f90 index f7516c5b5..91b9a5194 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -302,7 +302,7 @@ subroutine materialpoint_stressAndItsTangent(dt) endif converged(i,e) = .true. do co = 1, myNgrains - converged(i,e) = converged(i,e) .and. crystallite_stress2(co,i,e) + converged(i,e) = converged(i,e) .and. crystallite_stress(co,i,e) enddo From 73523c8f629281e2ff72452ddfb9e2351fb65520 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 11:24:02 +0100 Subject: [PATCH 086/214] not a global variable --- src/homogenization.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 91b9a5194..8d90af515 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -220,7 +220,7 @@ subroutine materialpoint_stressAndItsTangent(dt) any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),& FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog)) - !$OMP PARALLEL DO PRIVATE(m) + !$OMP PARALLEL DO PRIVATE(m,myNgrains) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2) From 026ac07c9e67fb4952d5beeecb1f761af4de3d23 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 11:37:00 +0100 Subject: [PATCH 087/214] better use one loop --- src/homogenization.f90 | 25 +++++++++---------------- 1 file changed, 9 insertions(+), 16 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8d90af515..117c47652 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -220,7 +220,7 @@ subroutine materialpoint_stressAndItsTangent(dt) any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),& FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog)) - !$OMP PARALLEL DO PRIVATE(m,myNgrains) + !$OMP PARALLEL DO PRIVATE(m,myNgrains,NiterationMPstate) elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2) @@ -270,25 +270,18 @@ subroutine materialpoint_stressAndItsTangent(dt) requested(i,e) = .true. doneAndHappy(1:2,i,e) = [.false.,.true.] endif - enddo IpLooping1 - enddo elementLooping1 - !$OMP END PARALLEL DO + NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. & - any( requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & - .and. .not. doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & - ) .and. & - NiterationMPstate < num%nMPstate) + convergenceLooping: do while (.not. terminallyIll .and. requested(i,e) & + .and. .not. doneAndHappy(1,i,e) & + .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 !-------------------------------------------------------------------------------------------------- ! deformation partitioning - !$OMP PARALLEL DO PRIVATE(myNgrains,m,co) - elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) - IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2) + if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then ! requested but not yet done m = (e-1)*discretization_nIPs + i call mech_partition(homogenization_F0(1:3,1:3,m) & @@ -319,11 +312,11 @@ subroutine materialpoint_stressAndItsTangent(dt) converged(i,e) = all(doneAndHappy(1:2,i,e)) ! converged if done and happy endif endif - enddo IpLooping2 - enddo elementLooping2 - !$OMP END PARALLEL DO enddo convergenceLooping + enddo IpLooping1 + enddo elementLooping1 + !$OMP END PARALLEL DO NiterationHomog = NiterationHomog + 1 From fef525aee1147711e01b4c27357f8a4224fcf4fe Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 12:15:17 +0100 Subject: [PATCH 088/214] proper indentation --- src/constitutive.f90 | 145 ++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 76 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6331172bf..da115bf0f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1025,33 +1025,30 @@ function crystallite_stress(co,ip,el) subLi0 !< intermediate velocity grad at start of crystallite inc - - - !-------------------------------------------------------------------------------------------------- ! initialize to starting condition crystallite_subStep(co,ip,el) = 0.0_pReal - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) - subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then + plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) - subFrac = 0.0_pReal - crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst - todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst - endif homogenizationRequestsCalculation + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + enddo + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subFrac = 0.0_pReal + crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst + todo = .true. + crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + endif homogenizationRequestsCalculation todo = .true. NiterationCrystallite = 0 @@ -1060,70 +1057,66 @@ function crystallite_stress(co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(co,ip,el)) then - formerSubStep = crystallite_subStep(co,ip,el) - subFrac = subFrac + crystallite_subStep(co,ip,el) - crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac, & - num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) + if (crystallite_converged(co,ip,el)) then + formerSubStep = crystallite_subStep(co,ip,el) + subFrac = subFrac + crystallite_subStep(co,ip,el) + crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac, & + num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) - todo = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? + todo = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? - if (todo) then - crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) - subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) - enddo - endif + if (todo) then + crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + enddo + endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) - else - crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 - endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) - enddo + else + crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + endif + plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + enddo - ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) - endif + ! cant restore dotState here, since not yet calculated in first cutback after initialization + todo = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) + endif !-------------------------------------------------------------------------------------------------- ! prepare for integration - if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & - + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) - crystallite_converged(co,ip,el) = .false. - call integrateState(co,ip,el) - call integrateSourceState(co,ip,el) - endif + if (todo) then + crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & + math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) + crystallite_converged(co,ip,el) = .false. + call integrateState(co,ip,el) + call integrateSourceState(co,ip,el) + endif - - -!-------------------------------------------------------------------------------------------------- -! integrate --- requires fully defined state array (basic + dependent state) - if (.not. crystallite_converged(co,ip,el) .and. crystallite_subStep(co,ip,el) > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further + if (.not. crystallite_converged(co,ip,el) .and. crystallite_subStep(co,ip,el) > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further todo = .true. enddo cutbackLooping From b12f882ad4bc69ba464eecf1beb65db56f3443eb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 12:25:56 +0100 Subject: [PATCH 089/214] avoid global variables --- src/constitutive.f90 | 32 +++++++++++++------------------- src/homogenization.f90 | 23 ++++++++++------------- 2 files changed, 23 insertions(+), 32 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index da115bf0f..266a3623d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -72,8 +72,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable, public :: & - crystallite_requested !< used by upper level (homogenization) to request crystallite calculation logical, dimension(:,:,:), allocatable :: & crystallite_converged !< convergence flag @@ -889,7 +887,6 @@ subroutine crystallite_init allocate(crystallite_orientation(cMax,iMax,eMax)) - allocate(crystallite_requested(cMax,iMax,eMax), source=.false.) allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -974,7 +971,6 @@ subroutine crystallite_init constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) - crystallite_requested(co,ip,el) = .true. enddo; enddo enddo !$OMP END PARALLEL DO @@ -1033,22 +1029,20 @@ function crystallite_stress(co,ip,el) me = material_phaseMemberAt(co,ip,el) subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - homogenizationRequestsCalculation: if (crystallite_requested(co,ip,el)) then - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) - subFrac = 0.0_pReal - crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst - todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst - endif homogenizationRequestsCalculation + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + enddo + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subFrac = 0.0_pReal + crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst + todo = .true. + crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. NiterationCrystallite = 0 diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 117c47652..c0568b048 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -272,12 +272,12 @@ subroutine materialpoint_stressAndItsTangent(dt) endif - NiterationMPstate = 0 + NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested(i,e) & - .and. .not. doneAndHappy(1,i,e) & - .and. NiterationMPstate < num%nMPstate) - NiterationMPstate = NiterationMPstate + 1 + convergenceLooping: do while (.not. terminallyIll .and. requested(i,e) & + .and. .not. doneAndHappy(1,i,e) & + .and. NiterationMPstate < num%nMPstate) + NiterationMPstate = NiterationMPstate + 1 !-------------------------------------------------------------------------------------------------- ! deformation partitioning @@ -289,14 +289,11 @@ subroutine materialpoint_stressAndItsTangent(dt) *(subStep(i,e)+subFrac(i,e)), & i,e) crystallite_dt(1:myNgrains,i,e) = dt*subStep(i,e) ! propagate materialpoint dt to grains - crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents - else - crystallite_requested(1:myNgrains,i,e) = .false. ! calculation for constituents not required anymore + converged(i,e) = .true. + do co = 1, myNgrains + converged(i,e) = converged(i,e) .and. crystallite_stress(co,i,e) + enddo endif - converged(i,e) = .true. - do co = 1, myNgrains - converged(i,e) = converged(i,e) .and. crystallite_stress(co,i,e) - enddo if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then @@ -313,7 +310,7 @@ subroutine materialpoint_stressAndItsTangent(dt) endif endif - enddo convergenceLooping + enddo convergenceLooping enddo IpLooping1 enddo elementLooping1 !$OMP END PARALLEL DO From 7d6c6159a99ac6b35c8d9708922dd7ad5b2b2417 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 13:22:11 +0100 Subject: [PATCH 090/214] consisten names --- src/constitutive.f90 | 58 ++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 266a3623d..c85ae0553 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -842,8 +842,8 @@ subroutine crystallite_init integer :: & Nconstituents, & - p, & - m, & + ph, & + me, & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el, & !< counter in element loop @@ -931,18 +931,18 @@ subroutine crystallite_init allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partionedLi0(phases%length)) - do p = 1, phases%length - Nconstituents = count(material_phaseAt == p) * discretization_nIPs + do ph = 1, phases%length + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs - allocate(constitutive_mech_Fi(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fi0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedFi0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedFp0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li0(p)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedLi0(p)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedFi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedFp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partionedLi0(ph)%data(3,3,Nconstituents)) enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -950,26 +950,26 @@ subroutine crystallite_init print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax flush(IO_STDOUT) - !$OMP PARALLEL DO PRIVATE(p,m) + !$OMP PARALLEL DO PRIVATE(ph,me) do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) - constitutive_mech_Fp0(p)%data(1:3,1:3,m) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - constitutive_mech_Fp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) & - / math_det33(constitutive_mech_Fp0(p)%data(1:3,1:3,m))**(1.0_pReal/3.0_pReal) - constitutive_mech_Fi0(p)%data(1:3,1:3,m) = math_I3 + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & + / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(p)%data(1:3,1:3,m), & - constitutive_mech_Fp0(p)%data(1:3,1:3,m))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) + crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) = constitutive_mech_Fi0(p)%data(1:3,1:3,m) - constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) = constitutive_mech_Fp0(p)%data(1:3,1:3,m) + constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) enddo; enddo enddo @@ -980,12 +980,12 @@ subroutine crystallite_init call crystallite_orientations() - !$OMP PARALLEL DO PRIVATE(p,m) + !$OMP PARALLEL DO PRIVATE(ph,me) do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1),FEsolving_execIP(2) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el), & co,ip,el) ! update dependent state variables to be consistent with basic states enddo From a91a3975f68ae35863cd3bcee2c3b36927079318 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 13:31:30 +0100 Subject: [PATCH 091/214] not needed as global variable --- src/constitutive.f90 | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index c85ae0553..1a03f3c50 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -49,8 +49,7 @@ module constitutive real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain real(pReal), dimension(:,:,:), allocatable :: & - crystallite_subdt, & !< substepped time increment of each grain - crystallite_subStep !< size of next integration step + crystallite_subdt !< substepped time increment of each grain type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & @@ -882,7 +881,7 @@ subroutine crystallite_init source = crystallite_partitionedF) allocate(crystallite_dt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_subdt,crystallite_subStep, & + allocate(crystallite_subdt, & source = crystallite_dt) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -1015,16 +1014,12 @@ function crystallite_stress(co,ip,el) NiterationCrystallite, & ! number of iterations in crystallite loop s, ph, me logical :: todo - real(pReal) :: subFrac !ToDo: need to set some values to false for different Ngrains + real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & subLp0, & !< plastic velocity grad at start of crystallite inc subLi0 !< intermediate velocity grad at start of crystallite inc -!-------------------------------------------------------------------------------------------------- -! initialize to starting condition - crystallite_subStep(co,ip,el) = 0.0_pReal - ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) @@ -1040,7 +1035,7 @@ function crystallite_stress(co,ip,el) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) subFrac = 0.0_pReal - crystallite_subStep(co,ip,el) = 1.0_pReal/num%subStepSizeCryst + subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst @@ -1052,12 +1047,11 @@ function crystallite_stress(co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward if (crystallite_converged(co,ip,el)) then - formerSubStep = crystallite_subStep(co,ip,el) - subFrac = subFrac + crystallite_subStep(co,ip,el) - crystallite_subStep(co,ip,el) = min(1.0_pReal - subFrac, & - num%stepIncreaseCryst * crystallite_subStep(co,ip,el)) + formerSubStep = subStep + subFrac = subFrac + subStep + subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) - todo = crystallite_subStep(co,ip,el) > 0.0_pReal ! still time left to integrate on? + todo = subStep > 0.0_pReal ! still time left to integrate on? if (todo) then crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) @@ -1076,11 +1070,11 @@ function crystallite_stress(co,ip,el) !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) else - crystallite_subStep(co,ip,el) = num%subStepSizeCryst * crystallite_subStep(co,ip,el) + subStep = num%subStepSizeCryst * subStep constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (crystallite_subStep(co,ip,el) < 1.0_pReal) then ! actual (not initial) cutback + if (subStep < 1.0_pReal) then ! actual (not initial) cutback crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif @@ -1092,25 +1086,25 @@ function crystallite_stress(co,ip,el) enddo ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo = crystallite_subStep(co,ip,el) > num%subStepMinCryst ! still on track or already done (beyond repair) + todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) endif !-------------------------------------------------------------------------------------------------- ! prepare for integration if (todo) then crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & - + crystallite_subStep(co,ip,el) *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = crystallite_subStep(co,ip,el) * crystallite_dt(co,ip,el) + crystallite_subdt(co,ip,el) = subStep * crystallite_dt(co,ip,el) crystallite_converged(co,ip,el) = .false. call integrateState(co,ip,el) call integrateSourceState(co,ip,el) endif - if (.not. crystallite_converged(co,ip,el) .and. crystallite_subStep(co,ip,el) > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further + if (.not. crystallite_converged(co,ip,el) .and. subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further todo = .true. enddo cutbackLooping From 972e041f597b0075e8a3207d080b6e8f7bbea025 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 14:03:15 +0100 Subject: [PATCH 092/214] modernizing --- src/constitutive.f90 | 31 +++++++++++++------------------ src/homogenization_mech.f90 | 7 +++++++ 2 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 1a03f3c50..c4b97d1bd 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -22,8 +22,6 @@ module constitutive implicit none private enum, bind(c); enumerator :: & - ELASTICITY_UNDEFINED_ID, & - ELASTICITY_HOOKE_ID, & PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & @@ -42,9 +40,7 @@ module constitutive KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & - KINEMATICS_THERMAL_EXPANSION_ID, & - STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID + KINEMATICS_THERMAL_EXPANSION_ID end enum real(pReal), dimension(:,:,:), allocatable, public :: & crystallite_dt !< requested time increment of each grain @@ -691,18 +687,18 @@ end function constitutive_thermal_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_damage_deltaState(Fe, co, ip, el, phase, of) result(broken) +function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el, & !< element - phase, & + ph, & of real(pReal), intent(in), dimension(3,3) :: & Fe !< elastic deformation gradient integer :: & - i, & + so, & myOffset, & mySize logical :: & @@ -711,19 +707,19 @@ function constitutive_damage_deltaState(Fe, co, ip, el, phase, of) result(broken broken = .false. - sourceLoop: do i = 1, phase_Nsources(phase) + sourceLoop: do so = 1, phase_Nsources(ph) - sourceType: select case (phase_source(i,phase)) + sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & co, ip, el) - broken = any(IEEE_is_NaN(sourceState(phase)%p(i)%deltaState(:,of))) + broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) if(.not. broken) then - myOffset = sourceState(phase)%p(i)%offsetDeltaState - mySize = sourceState(phase)%p(i)%sizeDeltaState - sourceState(phase)%p(i)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(phase)%p(i)%state(myOffset + 1: myOffset + mySize,of) + sourceState(phase)%p(i)%deltaState(1:mySize,of) + myOffset = sourceState(ph)%p(so)%offsetDeltaState + mySize = sourceState(ph)%p(so)%sizeDeltaState + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) endif end select sourceType @@ -1405,13 +1401,12 @@ subroutine integrateSourceState(co,ip,el) NiterationState, & !< number of iterations in state loop ph, & me, & - so, & - size_pl + so integer, dimension(maxval(phase_Nsources)) :: & size_so real(pReal) :: & zeta - real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & r ! state residuum real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index b0641be07..7fff6f55b 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -4,6 +4,13 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization) homogenization_mech + + enum, bind(c); enumerator :: & + ELASTICITY_UNDEFINED_ID, & + ELASTICITY_HOOKE_ID, & + STIFFNESS_DEGRADATION_UNDEFINED_ID, & + STIFFNESS_DEGRADATION_DAMAGE_ID + end enum interface module subroutine mech_none_init From 8ac880c0addf6f8b523ccf39a890bb956bd4d729 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 14:10:26 +0100 Subject: [PATCH 093/214] don't clutter with statements that are never used --- src/homogenization.f90 | 30 +----- src/homogenization_mech_RGC.f90 | 178 +------------------------------- 2 files changed, 4 insertions(+), 204 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index c0568b048..d8119f740 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -48,20 +48,6 @@ module homogenization type(tNumerics) :: num - type :: tDebugOptions - logical :: & - basic, & - extensive, & - selective - integer :: & - element, & - ip, & - grain - end type tDebugOptions - - type(tDebugOptions) :: debugHomog - - !-------------------------------------------------------------------------------------------------- interface @@ -125,24 +111,10 @@ subroutine homogenization_init class (tNode) , pointer :: & num_homog, & - num_homogGeneric, & - debug_homogenization + num_homogGeneric print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT) - debug_homogenization => config_debug%get('homogenization', defaultVal=emptyList) - debugHomog%basic = debug_homogenization%contains('basic') - debugHomog%extensive = debug_homogenization%contains('extensive') - debugHomog%selective = debug_homogenization%contains('selective') - debugHomog%element = config_debug%get_asInt('element',defaultVal = 1) - debugHomog%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1) - debugHomog%grain = config_debug%get_asInt('grain',defaultVal = 1) - - if (debugHomog%grain < 1 & - .or. debugHomog%grain > homogenization_Nconstituents(material_homogenizationAt(debugHomog%element))) & - call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain) - - num_homog => config_numerics%get('homogenization',defaultVal=emptyDict) num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 0a9d0ac92..a89008e96 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -18,8 +18,6 @@ submodule(homogenization:homogenization_mech) homogenization_mech_RGC real(pReal), dimension(:), allocatable :: & D_alpha, & a_g - integer :: & - of_debug = 0 character(len=pStringLen), allocatable, dimension(:) :: & output end type tParameters @@ -151,12 +149,6 @@ module subroutine mech_RGC_init(num_homogMech) st0 => state0(homogenization_typeInstance(h)), & dst => dependentState(homogenization_typeInstance(h))) -#ifdef DEBUG - if (h==material_homogenizationAt(debugHomog%element)) then - prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element) - endif -#endif - #if defined (__GFORTRAN__) prm%output = output_asStrings(homogMech) #else @@ -239,17 +231,6 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of) F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation enddo F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient - -#ifdef DEBUG - if (debugHomog%extensive) then - print'(a,i3)',' Deformation gradient of grain: ',iGrain - do i = 1,3 - print'(1x,3(e15.8,1x))',(F(i,j,iGrain), j = 1,3) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif enddo end associate @@ -273,10 +254,6 @@ module procedure mech_RGC_updateState logical :: error real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax -#ifdef DEBUG - integer, dimension(3) :: stresLoc - integer, dimension(2) :: residLoc -#endif zeroTimeStep: if(dEq0(dt)) then mech_RGC_updateState = .true. ! pretend everything is fine and return @@ -303,16 +280,6 @@ module procedure mech_RGC_updateState relax = stt%relaxationVector(:,of) drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Obtained state: ' - do i = 1,size(stt%relaxationVector(:,of)) - print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of) - enddo - print*,' ' - endif -#endif - !-------------------------------------------------------------------------------------------------- ! computing interface mismatch and stress penalty tensor for all interfaces of all grains call stressPenalty(R,NN,avgF,F,ip,el,instance,of) @@ -353,13 +320,6 @@ module procedure mech_RGC_updateState enddo enddo -#ifdef DEBUG - if (debugHomog%extensive) then - print'(a,i3)',' Traction at interface: ',iNum - print'(1x,3(e15.8,1x))',(tract(iNum,j), j = 1,3) - print*,' ' - endif -#endif enddo !-------------------------------------------------------------------------------------------------- @@ -367,29 +327,12 @@ module procedure mech_RGC_updateState stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress residMax = maxval(abs(tract)) ! get the maximum of the residual -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) then - stresLoc = maxloc(abs(P)) - residLoc = maxloc(abs(tract)) - print'(a,i2,1x,i4)',' RGC residual check ... ',ip,el - print'(a,e15.8,a,i3,a,i2,i2)', ' Max stress: ',stresMax, & - '@ grain ',stresLoc(3),' in component ',stresLoc(1),stresLoc(2) - print'(a,e15.8,a,i3,a,i2)',' Max residual: ',residMax, & - ' @ iface ',residLoc(1),' in direction ',residLoc(2) - flush(IO_STDOUT) - endif -#endif - mech_RGC_updateState = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy if (residMax < num%rtol*stresMax .or. residMax < num%atol) then mech_RGC_updateState = .true. -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) & - print*, '... done and happy'; flush(IO_STDOUT) -#endif !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration @@ -406,41 +349,14 @@ module procedure mech_RGC_updateState dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) dst%relaxationRate_max(of) = maxval(abs(drelax))/dt -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) then - print'(a,e15.8)', ' Constitutive work: ',stt%work(of) - print'(a,3(1x,e15.8))', ' Magnitude mismatch: ',dst%mismatch(1,of), & - dst%mismatch(2,of), & - dst%mismatch(3,of) - print'(a,e15.8)', ' Penalty energy: ', stt%penaltyEnergy(of) - print'(a,e15.8,/)', ' Volume discrepancy: ', dst%volumeDiscrepancy(of) - print'(a,e15.8)', ' Maximum relaxation rate: ', dst%relaxationRate_max(of) - print'(a,e15.8,/)', ' Average relaxation rate: ', dst%relaxationRate_avg(of) - flush(IO_STDOUT) - endif -#endif - return !-------------------------------------------------------------------------------------------------- ! if residual blows-up => done but unhappy elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound mech_RGC_updateState = [.true.,.false.] ! with direct cut-back - -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) & - print'(a,/)', ' ... broken'; flush(IO_STDOUT) -#endif - return - - else ! proceed with computing the Jacobian and state update -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) & - print'(a,/)', ' ... not yet done'; flush(IO_STDOUT) -#endif - - endif + endif !--------------------------------------------------------------------------------------------------- ! construct the global Jacobian matrix for updating the global relaxation vector array when @@ -492,17 +408,6 @@ module procedure mech_RGC_updateState enddo enddo -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Jacobian matrix of stress' - do i = 1,3*nIntFaceTot - print'(1x,100(e11.4,1x))',(smatrix(i,j), j = 1,3*nIntFaceTot) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif - !-------------------------------------------------------------------------------------------------- ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical ! perturbation method) "pmatrix" @@ -552,16 +457,6 @@ module procedure mech_RGC_updateState pmatrix(:,ipert) = p_resid/num%pPert enddo -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Jacobian matrix of penalty' - do i = 1,3*nIntFaceTot - print'(1x,100(e11.4,1x))',(pmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif !-------------------------------------------------------------------------------------------------- ! ... of the numerical viscosity traction "rmatrix" @@ -571,48 +466,16 @@ module procedure mech_RGC_updateState (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal) ! only in the main diagonal term enddo -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Jacobian matrix of penalty' - do i = 1,3*nIntFaceTot - print'(1x,100(e11.4,1x))',(rmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif !-------------------------------------------------------------------------------------------------- ! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Jacobian matrix (total)' - do i = 1,3*nIntFaceTot - print'(1x,100(e11.4,1x))',(jmatrix(i,j), j = 1,3*nIntFaceTot) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif - !-------------------------------------------------------------------------------------------------- ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal) call math_invert(jnverse,error,jmatrix) -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Jacobian inverse' - do i = 1,3*nIntFaceTot - print'(1x,100(e11.4,1x))',(jnverse(i,j), j = 1,3*nIntFaceTot) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif - !-------------------------------------------------------------------------------------------------- ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration drelax = 0.0_pReal @@ -629,17 +492,6 @@ module procedure mech_RGC_updateState !$OMP END CRITICAL (write2out) endif -#ifdef DEBUG - if (debugHomog%extensive) then - print*, 'Returned state: ' - do i = 1,size(stt%relaxationVector(:,of)) - print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of) - enddo - print*,' ' - flush(IO_STDOUT) - endif -#endif - end associate contains @@ -676,12 +528,6 @@ module procedure mech_RGC_updateState associate(prm => param(instance)) -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) then - print'(a,2(1x,i3))', ' Correction factor: ',ip,el - print*, surfCorr - endif -#endif !----------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains @@ -717,13 +563,7 @@ module procedure mech_RGC_updateState enddo; enddo nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity) nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces) -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) then - print'(a,i2,a,i3)',' Mismatch to face: ',intFace(1),' neighbor grain: ',iGNghb - print*, transpose(nDef) - print'(a,e11.4)', ' with magnitude: ',nDefNorm - endif -#endif + !------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces @@ -735,12 +575,7 @@ module procedure mech_RGC_updateState *tanh(nDefNorm/num%xSmoo) enddo; enddo;enddo; enddo enddo interfaceLoop -#ifdef DEBUG - if (debugHomog%extensive .and. prm%of_debug == of) then - print'(a,i2)', ' Penalty of grain: ',iGrain - print*, transpose(rPen(1:3,1:3,iGrain)) - endif -#endif + enddo grainLoop @@ -783,13 +618,6 @@ module procedure mech_RGC_updateState vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr* & sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0),vDiscrep)* & gVol(i)*transpose(math_inv33(fDef(:,:,i))) - -#ifdef DEBUG - if (debugHomog%extensive .and. param(instance)%of_debug == of) then - print'(a,i2)',' Volume penalty of grain: ',i - print*, transpose(vPen(:,:,i)) - endif -#endif enddo end subroutine volumePenalty From be4616368b2caec351f438561f9c2c36ac627238 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 14:24:44 +0100 Subject: [PATCH 094/214] new names --- src/homogenization.f90 | 140 ++++++++++++++++++++--------------------- 1 file changed, 70 insertions(+), 70 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d8119f740..00bb5fc6a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -150,8 +150,8 @@ subroutine materialpoint_stressAndItsTangent(dt) integer :: & NiterationHomog, & NiterationMPstate, & - i, & !< integration point number - e, & !< element number + ip, & !< integration point number + el, & !< element number myNgrains, co real(pReal), dimension(discretization_nIPs,discretization_Nelems) :: & subFrac, & @@ -161,28 +161,28 @@ subroutine materialpoint_stressAndItsTangent(dt) converged logical, dimension(2,discretization_nIPs,discretization_Nelems) :: & doneAndHappy - integer :: m + integer :: ce !-------------------------------------------------------------------------------------------------- ! initialize restoration points - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1),FEsolving_execIP(2); + do el = FEsolving_execElem(1),FEsolving_execElem(2) + do ip = FEsolving_execIP(1),FEsolving_execIP(2); - call constitutive_initializeRestorationPoints(i,e) + call constitutive_initializeRestorationPoints(ip,el) - subFrac(i,e) = 0.0_pReal - converged(i,e) = .false. ! pretend failed step ... - subStep(i,e) = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested(i,e) = .true. ! everybody requires calculation + subFrac(ip,el) = 0.0_pReal + converged(ip,el) = .false. ! pretend failed step ... + subStep(ip,el) = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation + requested(ip,el) = .true. ! everybody requires calculation - if (homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - homogState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e)) + if (homogState(material_homogenizationAt(el))%sizeState > 0) & + homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) - if (damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - damageState(material_homogenizationAt(e))%State0( :,material_homogenizationMemberAt(i,e)) + if (damageState(material_homogenizationAt(el))%sizeState > 0) & + damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) enddo enddo @@ -192,93 +192,93 @@ subroutine materialpoint_stressAndItsTangent(dt) any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),& FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog)) - !$OMP PARALLEL DO PRIVATE(m,myNgrains,NiterationMPstate) - elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(e)) - IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2) + !$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate) + elementLooping1: do el = FEsolving_execElem(1),FEsolving_execElem(2) + myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) + IpLooping1: do ip = FEsolving_execIP(1),FEsolving_execIP(2) - if (converged(i,e)) then - subFrac(i,e) = subFrac(i,e) + subStep(i,e) - subStep(i,e) = min(1.0_pReal-subFrac(i,e),num%stepIncreaseHomog*subStep(i,e)) ! introduce flexibility for step increase/acceleration + if (converged(ip,el)) then + subFrac(ip,el) = subFrac(ip,el) + subStep(ip,el) + subStep(ip,el) = min(1.0_pReal-subFrac(ip,el),num%stepIncreaseHomog*subStep(ip,el)) ! introduce flexibility for step increase/acceleration - steppingNeeded: if (subStep(i,e) > num%subStepMinHomog) then + steppingNeeded: if (subStep(ip,el) > num%subStepMinHomog) then ! wind forward grain starting point - call constitutive_windForward(i,e) + call constitutive_windForward(ip,el) - if(homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - homogState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e)) - if(damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = & - damageState(material_homogenizationAt(e))%State (:,material_homogenizationMemberAt(i,e)) + if(homogState(material_homogenizationAt(el))%sizeState > 0) & + homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) + if(damageState(material_homogenizationAt(el))%sizeState > 0) & + damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded else - if ( (myNgrains == 1 .and. subStep(i,e) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite - num%subStepSizeHomog * subStep(i,e) <= num%subStepMinHomog ) then ! would require too small subStep + if ( (myNgrains == 1 .and. subStep(ip,el) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + num%subStepSizeHomog * subStep(ip,el) <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense if (.not. terminallyIll) then ! so first signals terminally ill... - print*, ' Integration point ', i,' at element ', e, ' terminally ill' + print*, ' Integration point ', ip,' at element ', el, ' terminally ill' endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense - subStep(i,e) = num%subStepSizeHomog * subStep(i,e) ! crystallite had severe trouble, so do a significant cutback + subStep(ip,el) = num%subStepSizeHomog * subStep(ip,el) ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(i,e,subStep(i,e) < 1.0_pReal) - call constitutive_restore(i,e) + call crystallite_restore(ip,el,subStep(ip,el) < 1.0_pReal) + call constitutive_restore(ip,el) - if(homogState(material_homogenizationAt(e))%sizeState > 0) & - homogState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & - homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) - if(damageState(material_homogenizationAt(e))%sizeState > 0) & - damageState(material_homogenizationAt(e))%State( :,material_homogenizationMemberAt(i,e)) = & - damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) + if(homogState(material_homogenizationAt(el))%sizeState > 0) & + homogState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(material_homogenizationAt(el))%sizeState > 0) & + damageState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) endif endif - if (subStep(i,e) > num%subStepMinHomog) then - requested(i,e) = .true. - doneAndHappy(1:2,i,e) = [.false.,.true.] + if (subStep(ip,el) > num%subStepMinHomog) then + requested(ip,el) = .true. + doneAndHappy(1:2,ip,el) = [.false.,.true.] endif NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested(i,e) & - .and. .not. doneAndHappy(1,i,e) & + convergenceLooping: do while (.not. terminallyIll .and. requested(ip,el) & + .and. .not. doneAndHappy(1,ip,el) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then ! requested but not yet done - m = (e-1)*discretization_nIPs + i - call mech_partition(homogenization_F0(1:3,1:3,m) & - + (homogenization_F(1:3,1:3,m)-homogenization_F0(1:3,1:3,m))& - *(subStep(i,e)+subFrac(i,e)), & - i,e) - crystallite_dt(1:myNgrains,i,e) = dt*subStep(i,e) ! propagate materialpoint dt to grains - converged(i,e) = .true. + if(requested(ip,el) .and. .not. doneAndHappy(1,ip,el)) then ! requested but not yet done + ce = (el-1)*discretization_nIPs + ip + call mech_partition(homogenization_F0(1:3,1:3,ce) & + + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& + *(subStep(ip,el)+subFrac(ip,el)), & + ip,el) + crystallite_dt(1:myNgrains,ip,el) = dt*subStep(ip,el) ! propagate materialpoint dt to grains + converged(ip,el) = .true. do co = 1, myNgrains - converged(i,e) = converged(i,e) .and. crystallite_stress(co,i,e) + converged(ip,el) = converged(ip,el) .and. crystallite_stress(co,ip,el) enddo endif - if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then - if (.not. converged(i,e)) then - doneAndHappy(1:2,i,e) = [.true.,.false.] + if (requested(ip,el) .and. .not. doneAndHappy(1,ip,el)) then + if (.not. converged(ip,el)) then + doneAndHappy(1:2,ip,el) = [.true.,.false.] else - m = (e-1)*discretization_nIPs + i - doneAndHappy(1:2,i,e) = updateState(dt*subStep(i,e), & - homogenization_F0(1:3,1:3,m) & - + (homogenization_F(1:3,1:3,m)-homogenization_F0(1:3,1:3,m)) & - *(subStep(i,e)+subFrac(i,e)), & - i,e) - converged(i,e) = all(doneAndHappy(1:2,i,e)) ! converged if done and happy + ce = (el-1)*discretization_nIPs + ip + doneAndHappy(1:2,ip,el) = updateState(dt*subStep(ip,el), & + homogenization_F0(1:3,1:3,ce) & + + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & + *(subStep(ip,el)+subFrac(ip,el)), & + ip,el) + converged(ip,el) = all(doneAndHappy(1:2,ip,el)) ! converged if done and happy endif endif @@ -294,9 +294,9 @@ subroutine materialpoint_stressAndItsTangent(dt) if (.not. terminallyIll ) then call crystallite_orientations() ! calculate crystal orientations !$OMP PARALLEL DO - elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2) - IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2) - call mech_homogenize(i,e) + elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) + call mech_homogenize(ip,el) enddo IpLooping3 enddo elementLooping3 !$OMP END PARALLEL DO From 12b1c7e641ae19672de94dbe7af04298eea3f9e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 14:37:12 +0100 Subject: [PATCH 095/214] one loop is enough --- src/constitutive_mech.f90 | 7 +++++++ src/homogenization.f90 | 23 ++++++++++------------- src/homogenization_mech.f90 | 6 ------ 3 files changed, 17 insertions(+), 19 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 800e67b32..197169c7a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -3,6 +3,13 @@ !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_mech + enum, bind(c); enumerator :: & + ELASTICITY_UNDEFINED_ID, & + ELASTICITY_HOOKE_ID, & + STIFFNESS_DEGRADATION_UNDEFINED_ID, & + STIFFNESS_DEGRADATION_DAMAGE_ID + end enum + integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & phase_elasticity !< elasticity of each phase integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 00bb5fc6a..8334e99b2 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -164,11 +164,13 @@ subroutine materialpoint_stressAndItsTangent(dt) integer :: ce -!-------------------------------------------------------------------------------------------------- -! initialize restoration points + +!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog) do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1),FEsolving_execIP(2); +!-------------------------------------------------------------------------------------------------- +! initialize restoration points call constitutive_initializeRestorationPoints(ip,el) subFrac(ip,el) = 0.0_pReal @@ -183,19 +185,12 @@ subroutine materialpoint_stressAndItsTangent(dt) if (damageState(material_homogenizationAt(el))%sizeState > 0) & damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) - enddo - enddo NiterationHomog = 0 - cutBackLooping: do while (.not. terminallyIll .and. & - any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),& - FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog)) + cutBackLooping: do while (.not. terminallyIll .and. subStep(ip,el) > num%subStepMinHomog) - !$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate) - elementLooping1: do el = FEsolving_execElem(1),FEsolving_execElem(2) myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) - IpLooping1: do ip = FEsolving_execIP(1),FEsolving_execIP(2) if (converged(ip,el)) then subFrac(ip,el) = subFrac(ip,el) + subStep(ip,el) @@ -283,14 +278,16 @@ subroutine materialpoint_stressAndItsTangent(dt) endif enddo convergenceLooping - enddo IpLooping1 - enddo elementLooping1 - !$OMP END PARALLEL DO + NiterationHomog = NiterationHomog + 1 enddo cutBackLooping + enddo + enddo + !$OMP END PARALLEL DO + if (.not. terminallyIll ) then call crystallite_orientations() ! calculate crystal orientations !$OMP PARALLEL DO diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 7fff6f55b..56f1e554f 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -5,12 +5,6 @@ submodule(homogenization) homogenization_mech - enum, bind(c); enumerator :: & - ELASTICITY_UNDEFINED_ID, & - ELASTICITY_HOOKE_ID, & - STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID - end enum interface module subroutine mech_none_init From 18458d34e969327714ad8f866663279b142275ff Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 14:57:53 +0100 Subject: [PATCH 096/214] no global variables --- src/constitutive.f90 | 11 ++++------- src/homogenization.f90 | 3 +-- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index c4b97d1bd..63f1efd3e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -42,8 +42,6 @@ module constitutive KINEMATICS_SLIPPLANE_OPENING_ID, & KINEMATICS_THERMAL_EXPANSION_ID end enum - real(pReal), dimension(:,:,:), allocatable, public :: & - crystallite_dt !< requested time increment of each grain real(pReal), dimension(:,:,:), allocatable :: & crystallite_subdt !< substepped time increment of each grain type(rotation), dimension(:,:,:), allocatable :: & @@ -876,9 +874,7 @@ subroutine crystallite_init crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) - allocate(crystallite_dt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_subdt, & - source = crystallite_dt) + allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -995,8 +991,9 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress(co,ip,el) +function crystallite_stress(dt,co,ip,el) + real(pReal), intent(in) :: dt integer, intent(in) :: & co, & ip, & @@ -1094,7 +1091,7 @@ function crystallite_stress(co,ip,el) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * crystallite_dt(co,ip,el) + crystallite_subdt(co,ip,el) = subStep * dt crystallite_converged(co,ip,el) = .false. call integrateState(co,ip,el) call integrateSourceState(co,ip,el) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8334e99b2..58311d6ad 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -255,10 +255,9 @@ subroutine materialpoint_stressAndItsTangent(dt) + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& *(subStep(ip,el)+subFrac(ip,el)), & ip,el) - crystallite_dt(1:myNgrains,ip,el) = dt*subStep(ip,el) ! propagate materialpoint dt to grains converged(ip,el) = .true. do co = 1, myNgrains - converged(ip,el) = converged(ip,el) .and. crystallite_stress(co,ip,el) + converged(ip,el) = converged(ip,el) .and. crystallite_stress(dt*subStep(ip,el),co,ip,el) enddo endif From ea25b22f13488e06a83a36a692e225ee9ebb1e1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 15:03:03 +0100 Subject: [PATCH 097/214] standard names --- src/constitutive.f90 | 33 +++++++++++++++++---------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 63f1efd3e..ad6708d72 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -407,12 +407,13 @@ contains subroutine constitutive_init integer :: & - p, & !< counter in phase loop - s !< counter in source loop + ph, & !< counter in phase loop + so !< counter in source loop class (tNode), pointer :: & debug_constitutive, & phases + debug_constitutive => config_debug%get('constitutive', defaultVal=emptyList) debugConstitutive%basic = debug_constitutive%contains('basic') debugConstitutive%extensive = debug_constitutive%contains('extensive') @@ -423,26 +424,26 @@ subroutine constitutive_init !-------------------------------------------------------------------------------------------------- ! initialize constitutive laws + print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) call mech_init call damage_init call thermal_init - print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) phases => config_material%get('phase') constitutive_source_maxSizeDotState = 0 - PhaseLoop2:do p = 1,phases%length + PhaseLoop2:do ph = 1,phases%length !-------------------------------------------------------------------------------------------------- ! partition and initialize state - plasticState(p)%partitionedState0 = plasticState(p)%state0 - plasticState(p)%state = plasticState(p)%partitionedState0 - forall(s = 1:phase_Nsources(p)) - sourceState(p)%p(s)%partitionedState0 = sourceState(p)%p(s)%state0 - sourceState(p)%p(s)%state = sourceState(p)%p(s)%partitionedState0 + plasticState(ph)%partitionedState0 = plasticState(ph)%state0 + plasticState(ph)%state = plasticState(ph)%partitionedState0 + forall(so = 1:phase_Nsources(ph)) + sourceState(ph)%p(so)%partitionedState0 = sourceState(ph)%p(so)%state0 + sourceState(ph)%p(so)%state = sourceState(ph)%p(so)%partitionedState0 end forall constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(p)%p%sizeDotState)) + maxval(sourceState(ph)%p%sizeDotState)) enddo PhaseLoop2 constitutive_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) @@ -617,26 +618,26 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(S, co, ip, el,phase,of) result(broken) +function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el, & !< element - phase, & + ph, & of real(pReal), intent(in), dimension(3,3) :: & S !< 2nd Piola Kirchhoff stress (vector notation) integer :: & - i !< counter in source loop + so !< counter in source loop logical :: broken broken = .false. - SourceLoop: do i = 1, phase_Nsources(phase) + SourceLoop: do so = 1, phase_Nsources(ph) - sourceType: select case (phase_source(i,phase)) + sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_anisoBrittle_ID) sourceType call source_damage_anisoBrittle_dotState(S, co, ip, el) ! correct stress? @@ -649,7 +650,7 @@ function constitutive_damage_collectDotState(S, co, ip, el,phase,of) result(brok end select sourceType - broken = broken .or. any(IEEE_is_NaN(sourceState(phase)%p(i)%dotState(:,of))) + broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) enddo SourceLoop From 895cad6506d8cf1b25bf97e67f9cfe177f454bf7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 17:14:26 +0100 Subject: [PATCH 098/214] only needed per point --- src/homogenization.f90 | 70 ++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 36 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 58311d6ad..fba0c4f45 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -152,31 +152,29 @@ subroutine materialpoint_stressAndItsTangent(dt) NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co - real(pReal), dimension(discretization_nIPs,discretization_Nelems) :: & + myNgrains, co, ce + real(pReal) :: & subFrac, & subStep - logical, dimension(discretization_nIPs,discretization_Nelems) :: & + logical :: & requested, & converged - logical, dimension(2,discretization_nIPs,discretization_Nelems) :: & + logical, dimension(2) :: & doneAndHappy - integer :: ce - -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog) +!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,requested,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2); + do ip = FEsolving_execIP(1),FEsolving_execIP(2) !-------------------------------------------------------------------------------------------------- ! initialize restoration points call constitutive_initializeRestorationPoints(ip,el) - subFrac(ip,el) = 0.0_pReal - converged(ip,el) = .false. ! pretend failed step ... - subStep(ip,el) = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested(ip,el) = .true. ! everybody requires calculation + subFrac = 0.0_pReal + converged = .false. ! pretend failed step ... + subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation + requested = .true. ! everybody requires calculation if (homogState(material_homogenizationAt(el))%sizeState > 0) & homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & @@ -188,15 +186,15 @@ subroutine materialpoint_stressAndItsTangent(dt) NiterationHomog = 0 - cutBackLooping: do while (.not. terminallyIll .and. subStep(ip,el) > num%subStepMinHomog) + cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) - if (converged(ip,el)) then - subFrac(ip,el) = subFrac(ip,el) + subStep(ip,el) - subStep(ip,el) = min(1.0_pReal-subFrac(ip,el),num%stepIncreaseHomog*subStep(ip,el)) ! introduce flexibility for step increase/acceleration + if (converged) then + subFrac = subFrac + subStep + subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration - steppingNeeded: if (subStep(ip,el) > num%subStepMinHomog) then + steppingNeeded: if (subStep > num%subStepMinHomog) then ! wind forward grain starting point call constitutive_windForward(ip,el) @@ -211,17 +209,17 @@ subroutine materialpoint_stressAndItsTangent(dt) endif steppingNeeded else - if ( (myNgrains == 1 .and. subStep(ip,el) <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite - num%subStepSizeHomog * subStep(ip,el) <= num%subStepMinHomog ) then ! would require too small subStep + if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense if (.not. terminallyIll) then ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense - subStep(ip,el) = num%subStepSizeHomog * subStep(ip,el) ! crystallite had severe trouble, so do a significant cutback + subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep(ip,el) < 1.0_pReal) + call crystallite_restore(ip,el,subStep < 1.0_pReal) call constitutive_restore(ip,el) if(homogState(material_homogenizationAt(el))%sizeState > 0) & @@ -233,46 +231,46 @@ subroutine materialpoint_stressAndItsTangent(dt) endif endif - if (subStep(ip,el) > num%subStepMinHomog) then - requested(ip,el) = .true. - doneAndHappy(1:2,ip,el) = [.false.,.true.] + if (subStep > num%subStepMinHomog) then + requested = .true. + doneAndHappy = [.false.,.true.] endif NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested(ip,el) & - .and. .not. doneAndHappy(1,ip,el) & + convergenceLooping: do while (.not. terminallyIll .and. requested & + .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested(ip,el) .and. .not. doneAndHappy(1,ip,el)) then ! requested but not yet done + if(requested .and. .not. doneAndHappy(1)) then ! requested but not yet done ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& - *(subStep(ip,el)+subFrac(ip,el)), & + *(subStep+subFrac), & ip,el) - converged(ip,el) = .true. + converged = .true. do co = 1, myNgrains - converged(ip,el) = converged(ip,el) .and. crystallite_stress(dt*subStep(ip,el),co,ip,el) + converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) enddo endif - if (requested(ip,el) .and. .not. doneAndHappy(1,ip,el)) then - if (.not. converged(ip,el)) then - doneAndHappy(1:2,ip,el) = [.true.,.false.] + if (requested .and. .not. doneAndHappy(1)) then + if (.not. converged) then + doneAndHappy = [.true.,.false.] else ce = (el-1)*discretization_nIPs + ip - doneAndHappy(1:2,ip,el) = updateState(dt*subStep(ip,el), & + doneAndHappy = updateState(dt*subStep, & homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & - *(subStep(ip,el)+subFrac(ip,el)), & + *(subStep+subFrac), & ip,el) - converged(ip,el) = all(doneAndHappy(1:2,ip,el)) ! converged if done and happy + converged = all(doneAndHappy) endif endif From 36affc93bf0bc2ecc96727ae3dc9837dc545000b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 23 Dec 2020 17:30:19 +0100 Subject: [PATCH 099/214] mech is responsible for stiffness --- src/constitutive.f90 | 61 ++++++++++++++++++--------------------- src/constitutive_mech.f90 | 34 +++++++++++++++++++++- 2 files changed, 61 insertions(+), 34 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ad6708d72..adb00f1c6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -21,6 +21,7 @@ module constitutive implicit none private + enum, bind(c); enumerator :: & PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & @@ -118,7 +119,7 @@ module constitutive procedure(integrateStateFPI), pointer :: integrateState - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public :: & phase_plasticity !< plasticity of each phase integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & @@ -186,6 +187,11 @@ module constitutive ! == cleaned:end =================================================================================== + module function constitutive_homogenizedC(co,ip,el) result(C) + integer, intent(in) :: co, ip, el + real(pReal), dimension(6,6) :: C + end function constitutive_homogenizedC + module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) integer, intent(in) :: & co, & !< component-ID of integration point @@ -240,14 +246,7 @@ module constitutive dTDot_dT end subroutine constitutive_thermal_getRateAndItsTangents - module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) - real(pReal), dimension(6,6) :: & - homogenizedC - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - end function plastic_dislotwin_homogenizedC + module subroutine plastic_nonlocal_updateCompatibility(orientation,instance,i,e) integer, intent(in) :: & @@ -396,7 +395,26 @@ module constitutive crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - crystallite_restore + crystallite_restore, & + PLASTICITY_UNDEFINED_ID, & + PLASTICITY_NONE_ID, & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & + PLASTICITY_NONLOCAL_ID, & + SOURCE_UNDEFINED_ID ,& + SOURCE_THERMAL_DISSIPATION_ID, & + SOURCE_THERMAL_EXTERNALHEAT_ID, & + SOURCE_DAMAGE_ISOBRITTLE_ID, & + SOURCE_DAMAGE_ISODUCTILE_ID, & + SOURCE_DAMAGE_ANISOBRITTLE_ID, & + SOURCE_DAMAGE_ANISODUCTILE_ID, & + KINEMATICS_UNDEFINED_ID ,& + KINEMATICS_CLEAVAGE_OPENING_ID, & + KINEMATICS_SLIPPLANE_OPENING_ID, & + KINEMATICS_THERMAL_EXPANSION_ID contains @@ -512,29 +530,6 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki end function kinematics_active -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenize elasticity matrix -!> ToDo: homogenizedC66 would be more consistent -!-------------------------------------------------------------------------------------------------- -function constitutive_homogenizedC(co,ip,el) - - real(pReal), dimension(6,6) :: & - constitutive_homogenizedC - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_DISLOTWIN_ID) plasticityType - constitutive_homogenizedC = plastic_dislotwin_homogenizedC(co,ip,el) - case default plasticityType - constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phaseAt(co,el)) - end select plasticityType - -end function constitutive_homogenizedC - - !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the velocity gradient ! ToDo: MD: S is Mi? diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 197169c7a..b8e2a5b5a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -9,7 +9,7 @@ submodule(constitutive) constitutive_mech STIFFNESS_DEGRADATION_UNDEFINED_ID, & STIFFNESS_DEGRADATION_DAMAGE_ID end enum - + integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & phase_elasticity !< elasticity of each phase integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & @@ -273,6 +273,15 @@ submodule(constitutive) constitutive_mech character(len=*), intent(in) :: group end subroutine plastic_nonlocal_results + module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC) + real(pReal), dimension(6,6) :: & + homogenizedC + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + end function plastic_dislotwin_homogenizedC + end interface type :: tOutput !< new requested output (per phase) @@ -1449,5 +1458,28 @@ module subroutine constitutive_mech_forward() end subroutine constitutive_mech_forward + + +!-------------------------------------------------------------------------------------------------- +!> @brief returns the homogenize elasticity matrix +!> ToDo: homogenizedC66 would be more consistent +!-------------------------------------------------------------------------------------------------- +module function constitutive_homogenizedC(co,ip,el) result(C) + + real(pReal), dimension(6,6) :: C + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) + case (PLASTICITY_DISLOTWIN_ID) plasticityType + C = plastic_dislotwin_homogenizedC(co,ip,el) + case default plasticityType + C = lattice_C66(1:6,1:6,material_phaseAt(co,el)) + end select plasticityType + +end function constitutive_homogenizedC + end submodule constitutive_mech From 935b531d271e9e6e1060e2b9a5fbbf0e5b45f95e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 08:53:02 +0100 Subject: [PATCH 100/214] cleaning+renaming --- src/constitutive.f90 | 102 ++++++++++++++++++-------------------- src/constitutive_mech.f90 | 68 ++++++++++++------------- 2 files changed, 80 insertions(+), 90 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index adb00f1c6..4e29f3f96 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -973,8 +973,7 @@ subroutine crystallite_init do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el), & - co,ip,el) ! update dependent state variables to be consistent with basic states + call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo enddo @@ -1035,66 +1034,63 @@ function crystallite_stress(dt,co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(co,ip,el)) then - formerSubStep = subStep - subFrac = subFrac + subStep - subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) + if (crystallite_converged(co,ip,el)) then + formerSubStep = subStep + subFrac = subFrac + subStep + subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) - todo = subStep > 0.0_pReal ! still time left to integrate on? - - if (todo) then - crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) - subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) - enddo - endif + todo = subStep > 0.0_pReal ! still time left to integrate on? + if (todo) then + crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + enddo + endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) - else - subStep = num%subStepSizeCryst * subStep - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 - endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) - enddo + else + subStep = num%subStepSizeCryst * subStep + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (subStep < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + endif + plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + enddo - ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) - endif + ! cant restore dotState here, since not yet calculated in first cutback after initialization + todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) + endif !-------------------------------------------------------------------------------------------------- ! prepare for integration - if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & - + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * dt - crystallite_converged(co,ip,el) = .false. - call integrateState(co,ip,el) - call integrateSourceState(co,ip,el) - endif + if (todo) then + crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & + math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + crystallite_subdt(co,ip,el) = subStep * dt + crystallite_converged(co,ip,el) = .false. + call integrateState(co,ip,el) + call integrateSourceState(co,ip,el) + endif - if (.not. crystallite_converged(co,ip,el) .and. subStep > num%subStepMinCryst) & ! do not try non-converged but fully cutbacked any further - todo = .true. enddo cutbackLooping ! return whether converged or not diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index b8e2a5b5a..6a60b4ade 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -791,6 +791,8 @@ function integrateStress(co,ip,el,timeFraction) result(broken) o, & p, & m, & + ph, & + me, & jacoCounterLp, & jacoCounterLi ! counters to check for Jacobian update logical :: error,broken @@ -808,11 +810,11 @@ function integrateStress(co,ip,el,timeFraction) result(broken) call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess - Liguess = constitutive_mech_Li(p)%data(1:3,1:3,m) ! take as first guess + Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) if (error) return ! error @@ -941,15 +943,12 @@ function integrateStress(co,ip,el,timeFraction) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) - crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) crystallite_S (1:3,1:3,co,ip,el) = S crystallite_Lp (1:3,1:3,co,ip,el) = Lpguess - constitutive_mech_Li(p)%data(1:3,1:3,m) = Liguess - constitutive_mech_Fp(p)%data(1:3,1:3,m) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize - constitutive_mech_Fi(p)%data(1:3,1:3,m) = Fi_new + constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. @@ -970,17 +969,13 @@ module subroutine integrateStateFPI(co,ip,el) NiterationState, & !< number of iterations in state loop ph, & me, & - s, & size_pl - integer, dimension(maxval(phase_Nsources)) :: & - size_so real(pReal) :: & zeta - real(pReal), dimension(max(constitutive_plasticity_maxSizeDotState,constitutive_source_maxSizeDotState)) :: & + real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & plastic_dotState - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & broken @@ -1199,10 +1194,10 @@ end subroutine integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(co,ip,el,A,B,CC,DB) +subroutine integrateStateRK(co,ip,el,A,B,C,DB) real(pReal), dimension(:,:), intent(in) :: A - real(pReal), dimension(:), intent(in) :: B, CC + real(pReal), dimension(:), intent(in) :: B, C real(pReal), dimension(:), intent(in), optional :: DB integer, intent(in) :: & el, & !< element index in element loop @@ -1242,10 +1237,10 @@ subroutine integrateStateRK(co,ip,el,A,B,CC,DB) + plasticState(ph)%dotState (1:sizeDotState,me) & * crystallite_subdt(co,ip,el) - broken = integrateStress(co,ip,el,CC(stage)) + broken = integrateStress(co,ip,el,C(stage)) if(broken) exit - broken = mech_collectDotState(crystallite_subdt(co,ip,el)*CC(stage), co,ip,el,ph,me) + broken = mech_collectDotState(crystallite_subdt(co,ip,el)*C(stage), co,ip,el,ph,me) if(broken) exit enddo @@ -1277,7 +1272,6 @@ subroutine integrateStateRK(co,ip,el,A,B,CC,DB) end subroutine integrateStateRK - !-------------------------------------------------------------------------------------------------- !> @brief writes crystallite results to HDF5 output file !-------------------------------------------------------------------------------------------------- @@ -1354,22 +1348,22 @@ subroutine crystallite_results(group,ph) !------------------------------------------------------------------------------------------------ !> @brief select tensors for output !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,instance) + function select_tensors(dataset,ph) - integer, intent(in) :: instance + integer, intent(in) :: ph real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: e,i,c,j + integer :: el,ip,co,j - allocate(select_tensors(3,3,count(material_phaseAt==instance)*discretization_nIPs)) + allocate(select_tensors(3,3,count(material_phaseAt==ph)*discretization_nIPs)) j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then + do el = 1, size(material_phaseAt,2) + do ip = 1, discretization_nIPs + do co = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(co,el) == ph) then j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,c,i,e) + select_tensors(1:3,1:3,j) = dataset(1:3,1:3,co,ip,el) endif enddo enddo @@ -1381,22 +1375,22 @@ subroutine crystallite_results(group,ph) !-------------------------------------------------------------------------------------------------- !> @brief select rotations for output !-------------------------------------------------------------------------------------------------- - function select_rotations(dataset,instance) + function select_rotations(dataset,ph) - integer, intent(in) :: instance + integer, intent(in) :: ph type(rotation), dimension(:,:,:), intent(in) :: dataset real(pReal), allocatable, dimension(:,:) :: select_rotations - integer :: e,i,c,j + integer :: el,ip,co,j - allocate(select_rotations(4,count(material_phaseAt==instance)*homogenization_maxNconstituents*discretization_nIPs)) + allocate(select_rotations(4,count(material_phaseAt==ph)*homogenization_maxNconstituents*discretization_nIPs)) j=0 - do e = 1, size(material_phaseAt,2) - do i = 1, discretization_nIPs - do c = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(c,e) == instance) then + do el = 1, size(material_phaseAt,2) + do ip = 1, discretization_nIPs + do co = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains + if (material_phaseAt(co,el) == ph) then j = j + 1 - select_rotations(1:4,j) = dataset(c,i,e)%asQuaternion() + select_rotations(1:4,j) = dataset(co,ip,el)%asQuaternion() endif enddo enddo From acc998d242e765f36e4dfd9ed568d0400d1e0584 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 10:22:41 +0100 Subject: [PATCH 101/214] should become mech only --- src/constitutive.f90 | 126 +++----------------------------------- src/constitutive_mech.f90 | 120 +++++++++++++++++++++++++++++++++++- 2 files changed, 127 insertions(+), 119 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4e29f3f96..461a67c9a 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -117,7 +117,7 @@ module constitutive type(tDebugOptions) :: debugCrystallite - procedure(integrateStateFPI), pointer :: integrateState + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public :: & phase_plasticity !< plasticity of each phase @@ -187,6 +187,12 @@ module constitutive ! == cleaned:end =================================================================================== + module function crystallite_stress(dt,co,ip,el) + real(pReal), intent(in) :: dt + integer, intent(in) :: co, ip, el + logical :: crystallite_stress + end function crystallite_stress + module function constitutive_homogenizedC(co,ip,el) result(C) integer, intent(in) :: co, ip, el real(pReal), dimension(6,6) :: C @@ -362,10 +368,6 @@ module constitutive dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient end subroutine constitutive_hooke_SandItsTangents - module subroutine integrateStateFPI(co,ip,el) - integer, intent(in) :: co, ip, el - end subroutine integrateStateFPI - end interface @@ -392,6 +394,7 @@ module constitutive crystallite_orientations, & crystallite_push33ToRef, & crystallite_restartWrite, & + integrateSourceState, & crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & @@ -983,120 +986,7 @@ subroutine crystallite_init end subroutine crystallite_init -!-------------------------------------------------------------------------------------------------- -!> @brief calculate stress (P) -!-------------------------------------------------------------------------------------------------- -function crystallite_stress(dt,co,ip,el) - real(pReal), intent(in) :: dt - integer, intent(in) :: & - co, & - ip, & - el - - logical :: crystallite_stress - - real(pReal) :: & - formerSubStep - integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop - s, ph, me - logical :: todo - real(pReal) :: subFrac,subStep - real(pReal), dimension(3,3) :: & - subLp0, & !< plastic velocity grad at start of crystallite inc - subLi0 !< intermediate velocity grad at start of crystallite inc - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) - subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) - subFrac = 0.0_pReal - subStep = 1.0_pReal/num%subStepSizeCryst - todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst - - todo = .true. - NiterationCrystallite = 0 - cutbackLooping: do while (todo) - NiterationCrystallite = NiterationCrystallite + 1 - -!-------------------------------------------------------------------------------------------------- -! wind forward - if (crystallite_converged(co,ip,el)) then - formerSubStep = subStep - subFrac = subFrac + subStep - subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) - - todo = subStep > 0.0_pReal ! still time left to integrate on? - - if (todo) then - crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) - subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) - enddo - endif -!-------------------------------------------------------------------------------------------------- -! cut back (reduced time and restore) - else - subStep = num%subStepSizeCryst * subStep - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 - endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) - enddo - - ! cant restore dotState here, since not yet calculated in first cutback after initialization - todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) - endif - -!-------------------------------------------------------------------------------------------------- -! prepare for integration - if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & - + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * dt - crystallite_converged(co,ip,el) = .false. - call integrateState(co,ip,el) - call integrateSourceState(co,ip,el) - endif - - enddo cutbackLooping - -! return whether converged or not - crystallite_stress = crystallite_converged(co,ip,el) - -end function crystallite_stress !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6a60b4ade..d448b0505 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -290,6 +290,8 @@ submodule(constitutive) constitutive_mech end type tOutput type(tOutput), allocatable, dimension(:) :: output_constituent + procedure(integrateStateFPI), pointer :: integrateState + contains @@ -959,7 +961,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -module subroutine integrateStateFPI(co,ip,el) +subroutine integrateStateFPI(co,ip,el) integer, intent(in) :: & el, & !< element index in element loop @@ -1475,5 +1477,121 @@ module function constitutive_homogenizedC(co,ip,el) result(C) end function constitutive_homogenizedC + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate stress (P) +!-------------------------------------------------------------------------------------------------- +module function crystallite_stress(dt,co,ip,el) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & + ip, & + el + + logical :: crystallite_stress + + real(pReal) :: & + formerSubStep + integer :: & + NiterationCrystallite, & ! number of iterations in crystallite loop + s, ph, me + logical :: todo + real(pReal) :: subFrac,subStep + real(pReal), dimension(3,3) :: & + subLp0, & !< plastic velocity grad at start of crystallite inc + subLi0 !< intermediate velocity grad at start of crystallite inc + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + enddo + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subFrac = 0.0_pReal + subStep = 1.0_pReal/num%subStepSizeCryst + todo = .true. + crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + + todo = .true. + NiterationCrystallite = 0 + cutbackLooping: do while (todo) + NiterationCrystallite = NiterationCrystallite + 1 + +!-------------------------------------------------------------------------------------------------- +! wind forward + if (crystallite_converged(co,ip,el)) then + formerSubStep = subStep + subFrac = subFrac + subStep + subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) + + todo = subStep > 0.0_pReal ! still time left to integrate on? + + if (todo) then + crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + enddo + endif +!-------------------------------------------------------------------------------------------------- +! cut back (reduced time and restore) + else + subStep = num%subStepSizeCryst * subStep + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (subStep < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + endif + plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & + = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) + do s = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & + = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + enddo + + ! cant restore dotState here, since not yet calculated in first cutback after initialization + todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) + endif + +!-------------------------------------------------------------------------------------------------- +! prepare for integration + if (todo) then + crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & + -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & + math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + crystallite_subdt(co,ip,el) = subStep * dt + crystallite_converged(co,ip,el) = .false. + call integrateState(co,ip,el) + call integrateSourceState(co,ip,el) + endif + + enddo cutbackLooping + +! return whether converged or not + crystallite_stress = crystallite_converged(co,ip,el) + +end function crystallite_stress + end submodule constitutive_mech From 45d318c7b4506cc2f3f38b42540d78d935b0450c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 10:36:48 +0100 Subject: [PATCH 102/214] better use explicit arguments --- src/constitutive_mech.f90 | 44 +++++++++++++++++---------------------- 1 file changed, 19 insertions(+), 25 deletions(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index d448b0505..6d15fa8f1 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -737,15 +737,15 @@ end subroutine mech_results !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -function integrateStress(co,ip,el,timeFraction) result(broken) +function integrateStress(F,Delta_t,co,ip,el) result(broken) + real(pReal), dimension(3,3), intent(in) :: F + real(pReal), intent(in) :: Delta_t integer, intent(in):: el, & ! element index ip, & ! integration point index - co ! grain index - real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep + co ! grain index - real(pReal), dimension(3,3):: F, & ! deformation gradient at end of timestep - Fp_new, & ! plastic deformation gradient at end of timestep + real(pReal), dimension(3,3):: Fp_new, & ! plastic deformation gradient at end of timestep invFp_new, & ! inverse of Fp_new invFp_current, & ! inverse of Fp_current Lpguess, & ! current guess for plastic velocity gradient @@ -783,7 +783,6 @@ function integrateStress(co,ip,el,timeFraction) result(broken) dLi_dS real(pReal) steplengthLp, & steplengthLi, & - dt, & ! time increment atol_Lp, & atol_Li, & devNull @@ -801,15 +800,6 @@ function integrateStress(co,ip,el,timeFraction) result(broken) broken = .true. - if (present(timeFraction)) then - dt = crystallite_subdt(co,ip,el) * timeFraction - F = crystallite_subF0(1:3,1:3,co,ip,el) & - + (crystallite_subF(1:3,1:3,co,ip,el) - crystallite_subF0(1:3,1:3,co,ip,el)) * timeFraction - else - dt = crystallite_subdt(co,ip,el) - F = crystallite_subF(1:3,1:3,co,ip,el) - endif - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) ph = material_phaseAt(co,el) @@ -835,7 +825,7 @@ function integrateStress(co,ip,el,timeFraction) result(broken) NiterationStressLi = NiterationStressLi + 1 if (NiterationStressLi>num%nStress) return ! error - invFi_new = matmul(invFi_current,math_I3 - dt*Liguess) + invFi_new = matmul(invFi_current,math_I3 - Delta_t*Liguess) Fi_new = math_inv33(invFi_new) jacoCounterLp = 0 @@ -848,7 +838,7 @@ function integrateStress(co,ip,el,timeFraction) result(broken) NiterationStressLp = NiterationStressLp + 1 if (NiterationStressLp>num%nStress) return ! error - B = math_I3 - dt*Lpguess + B = math_I3 - Delta_t*Lpguess Fe = matmul(matmul(A,B), invFi_new) call constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & Fe, Fi_new, co, ip, el) @@ -880,7 +870,7 @@ function integrateStress(co,ip,el,timeFraction) result(broken) jacoCounterLp = jacoCounterLp + 1 do o=1,3; do p=1,3 - dFe_dLp(o,1:3,p,1:3) = - dt * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFe_dLp(o,1:3,p,1:3) = - Delta_t * A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -Delta_t * A(i,k) invFi(l,j) enddo; enddo dRLp_dLp = math_eye(9) & - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) @@ -921,8 +911,8 @@ function integrateStress(co,ip,el,timeFraction) result(broken) temp_33 = matmul(matmul(A,B),invFi_current) do o=1,3; do p=1,3 - dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) - dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current + dFe_dLi(1:3,o,1:3,p) = -Delta_t*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -Delta_t * A(i,k) invFi(l,j) + dFi_dLi(1:3,o,1:3,p) = -Delta_t*math_I3(o,p)*invFi_current enddo; enddo do o=1,3; do p=1,3 dFi_dLi(1:3,1:3,o,p) = matmul(matmul(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) @@ -998,7 +988,7 @@ subroutine integrateStateFPI(co,ip,el) if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(co,ip,el) + broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) if(broken) exit iteration broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) @@ -1082,7 +1072,7 @@ subroutine integrateStateEuler(co,ip,el) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(co,ip,el) + broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) crystallite_converged(co,ip,el) = .not. broken end subroutine integrateStateEuler @@ -1123,7 +1113,7 @@ subroutine integrateStateAdaptiveEuler(co,ip,el) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(co,ip,el) + broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) if(broken) return broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) @@ -1215,6 +1205,7 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) logical :: & broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState + real(pReal), dimension(3,3) :: F ph = material_phaseAt(co,el) @@ -1239,7 +1230,10 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) + plasticState(ph)%dotState (1:sizeDotState,me) & * crystallite_subdt(co,ip,el) - broken = integrateStress(co,ip,el,C(stage)) + F = crystallite_subF0(1:3,1:3,co,ip,el) & + + (crystallite_subF(1:3,1:3,co,ip,el) - crystallite_subF0(1:3,1:3,co,ip,el)) * C(stage) + + broken = integrateStress(F,crystallite_subdt(co,ip,el) * C(stage),co,ip,el) if(broken) exit broken = mech_collectDotState(crystallite_subdt(co,ip,el)*C(stage), co,ip,el,ph,me) @@ -1267,7 +1261,7 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(co,ip,el) + broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) crystallite_converged(co,ip,el) = .not. broken From 3e0361227c4ed8309f1381df90e1623d2ffc3d8f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 11:20:34 +0100 Subject: [PATCH 103/214] not needed as global variable --- src/constitutive.f90 | 3 +- src/constitutive_mech.f90 | 102 ++++++++++++++++++++------------------ 2 files changed, 55 insertions(+), 50 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 461a67c9a..f4b5feca6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -50,7 +50,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc crystallite_subF, & !< def grad to be reached at end of crystallite inc - crystallite_subF0, & !< def grad at start of crystallite inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc crystallite_subFi0,& !< intermediate def grad at start of crystallite inc @@ -869,7 +868,7 @@ subroutine crystallite_init crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subF,crystallite_subF0, & + crystallite_subF, & crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6d15fa8f1..a419a9564 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -951,8 +951,10 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(co,ip,el) +subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -974,13 +976,12 @@ subroutine integrateStateFPI(co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return size_pl = plasticState(ph)%sizeDotState plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%subState0(1:size_pl,me) & - + plasticState(ph)%dotState (1:size_pl,me) & - * crystallite_subdt(co,ip,el) + + plasticState(ph)%dotState (1:size_pl,me) * Delta_t plastic_dotState(1:size_pl,2) = 0.0_pReal iteration: do NiterationState = 1, num%nState @@ -988,10 +989,10 @@ subroutine integrateStateFPI(co,ip,el) if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) + broken = integrateStress(F,Delta_t,co,ip,el) if(broken) exit iteration - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) exit iteration zeta = damper(plasticState(ph)%dotState(:,me),plastic_dotState(1:size_pl,1),& @@ -999,10 +1000,10 @@ subroutine integrateStateFPI(co,ip,el) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) r(1:size_pl) = plasticState(ph)%state (1:size_pl,me) & - - plasticState(ph)%subState0(1:size_pl,me) & - - plasticState(ph)%dotState (1:size_pl,me) * crystallite_subdt(co,ip,el) + - plasticState(ph)%subState0(1:size_pl,me) & + - plasticState(ph)%dotState (1:size_pl,me) * Delta_t plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - - r(1:size_pl) + - r(1:size_pl) crystallite_converged(co,ip,el) = converged(r(1:size_pl), & plasticState(ph)%state(1:size_pl,me), & plasticState(ph)%atol(1:size_pl)) @@ -1044,8 +1045,10 @@ end subroutine integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(co,ip,el) +subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -1060,19 +1063,18 @@ subroutine integrateStateEuler(co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) & - * crystallite_subdt(co,ip,el) + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) + broken = integrateStress(F,Delta_t,co,ip,el) crystallite_converged(co,ip,el) = .not. broken end subroutine integrateStateEuler @@ -1081,8 +1083,10 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(co,ip,el) +subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -1100,29 +1104,29 @@ subroutine integrateStateAdaptiveEuler(co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * crystallite_subdt(co,ip,el) + residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotstate(1:sizeDotState,me) * crystallite_subdt(co,ip,el) + + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) + broken = integrateStress(F,Delta_t,co,ip,el) if(broken) return - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return sizeDotState = plasticState(ph)%sizeDotState crystallite_converged(co,ip,el) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(ph)%dotState(:,me) * crystallite_subdt(co,ip,el), & + + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & plasticState(ph)%state(1:sizeDotState,me), & plasticState(ph)%atol(1:sizeDotState)) @@ -1132,8 +1136,10 @@ end subroutine integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(co,ip,el) +subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el real(pReal), dimension(3,3), parameter :: & @@ -1147,7 +1153,7 @@ subroutine integrateStateRK4(co,ip,el) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - call integrateStateRK(co,ip,el,A,B,C) + call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) end subroutine integrateStateRK4 @@ -1155,8 +1161,10 @@ end subroutine integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(co,ip,el) +subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el real(pReal), dimension(5,5), parameter :: & @@ -1177,7 +1185,7 @@ subroutine integrateStateRKCK45(co,ip,el) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - call integrateStateRK(co,ip,el,A,B,C,DB) + call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) end subroutine integrateStateRKCK45 @@ -1186,8 +1194,10 @@ end subroutine integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(co,ip,el,A,B,C,DB) +subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in) :: Delta_t real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:), intent(in) :: B, C real(pReal), dimension(:), intent(in), optional :: DB @@ -1205,16 +1215,15 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) logical :: & broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState - real(pReal), dimension(3,3) :: F ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - broken = mech_collectDotState(crystallite_subdt(co,ip,el), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t,co,ip,el,ph,me) if(broken) return - do stage = 1,size(A,1) + do stage = 1, size(A,1) sizeDotState = plasticState(ph)%sizeDotState plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) @@ -1227,16 +1236,12 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) & - * crystallite_subdt(co,ip,el) + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t - F = crystallite_subF0(1:3,1:3,co,ip,el) & - + (crystallite_subF(1:3,1:3,co,ip,el) - crystallite_subF0(1:3,1:3,co,ip,el)) * C(stage) - - broken = integrateStress(F,crystallite_subdt(co,ip,el) * C(stage),co,ip,el) + broken = integrateStress(F_0 + (F - F_0) * Delta_t,Delta_t * C(stage),co,ip,el) if(broken) exit - broken = mech_collectDotState(crystallite_subdt(co,ip,el)*C(stage), co,ip,el,ph,me) + broken = mech_collectDotState(Delta_t*C(stage),co,ip,el,ph,me) if(broken) exit enddo @@ -1247,13 +1252,12 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) & - * crystallite_subdt(co,ip,el) + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + if(present(DB)) & - broken = .not. converged( matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) & - * crystallite_subdt(co,ip,el), & - plasticState(ph)%state(1:sizeDotState,me), & - plasticState(ph)%atol(1:sizeDotState)) + broken = .not. converged(matmul(plastic_RKdotState(1:sizeDotState,1:size(DB)),DB) * Delta_t, & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) if(broken) return @@ -1261,7 +1265,7 @@ subroutine integrateStateRK(co,ip,el,A,B,C,DB) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(crystallite_subF(1:3,1:3,co,ip,el),crystallite_subdt(co,ip,el),co,ip,el) + broken = integrateStress(F,Delta_t,co,ip,el) crystallite_converged(co,ip,el) = .not. broken @@ -1494,7 +1498,8 @@ module function crystallite_stress(dt,co,ip,el) real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & subLp0, & !< plastic velocity grad at start of crystallite inc - subLi0 !< intermediate velocity grad at start of crystallite inc + subLi0, & !< intermediate velocity grad at start of crystallite inc + subF0 ph = material_phaseAt(co,el) @@ -1510,7 +1515,7 @@ module function crystallite_stress(dt,co,ip,el) enddo crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) - crystallite_subF0(1:3,1:3,co,ip,el) = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. @@ -1531,7 +1536,7 @@ module function crystallite_stress(dt,co,ip,el) todo = subStep > 0.0_pReal ! still time left to integrate on? if (todo) then - crystallite_subF0 (1:3,1:3,co,ip,el) = crystallite_subF(1:3,1:3,co,ip,el) + subF0 = crystallite_subF(1:3,1:3,co,ip,el) subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) @@ -1568,7 +1573,7 @@ module function crystallite_stress(dt,co,ip,el) !-------------------------------------------------------------------------------------------------- ! prepare for integration if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = crystallite_subF0(1:3,1:3,co,ip,el) & + crystallite_subF(1:3,1:3,co,ip,el) = subF0 & + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & -crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & @@ -1576,7 +1581,8 @@ module function crystallite_stress(dt,co,ip,el) constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt crystallite_converged(co,ip,el) = .false. - call integrateState(co,ip,el) + call integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& + crystallite_subdt(co,ip,el),co,ip,el) call integrateSourceState(co,ip,el) endif From 4bd7aa9abb79a87775d1f3f6690bfd70fbeef9df Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 11:54:09 +0100 Subject: [PATCH 104/214] typo --- src/constitutive.f90 | 28 ++++++++++++++-------------- src/constitutive_mech.f90 | 19 +++++++++---------- 2 files changed, 23 insertions(+), 24 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f4b5feca6..7e380f8cd 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -76,13 +76,13 @@ module constitutive type(tTensorContainer), dimension(:), allocatable :: & constitutive_mech_Fi, & constitutive_mech_Fi0, & - constitutive_mech_partionedFi0, & + constitutive_mech_partitionedFi0, & constitutive_mech_Li, & constitutive_mech_Li0, & - constitutive_mech_partionedLi0, & + constitutive_mech_partitionedLi0, & constitutive_mech_Fp, & constitutive_mech_Fp0, & - constitutive_mech_partionedFp0 + constitutive_mech_partitionedFp0 type :: tNumerics @@ -913,25 +913,25 @@ subroutine crystallite_init allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) - allocate(constitutive_mech_partionedFi0(phases%length)) + allocate(constitutive_mech_partitionedFi0(phases%length)) allocate(constitutive_mech_Fp(phases%length)) allocate(constitutive_mech_Fp0(phases%length)) - allocate(constitutive_mech_partionedFp0(phases%length)) + allocate(constitutive_mech_partitionedFp0(phases%length)) allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) - allocate(constitutive_mech_partionedLi0(phases%length)) + allocate(constitutive_mech_partitionedLi0(phases%length)) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedFi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedFp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partionedLi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -957,8 +957,8 @@ subroutine crystallite_init constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) enddo; enddo enddo @@ -1063,11 +1063,11 @@ subroutine crystallite_restore(ip,el,includeL) m = material_phaseMemberAt(co,ip,el) if (includeL) then crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partionedLi0(p)%data(1:3,1:3,m) + constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) endif ! maybe protecting everything from overwriting makes more sense - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partionedFi0(p)%data(1:3,1:3,m) + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index a419a9564..b2194ab93 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1409,9 +1409,9 @@ module subroutine mech_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me - constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) end subroutine mech_initializeRestorationPoints @@ -1425,9 +1425,9 @@ module subroutine constitutive_mech_windForward(ph,me) integer, intent(in) :: ph, me - constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) @@ -1504,7 +1504,7 @@ module function crystallite_stress(dt,co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - subLi0 = constitutive_mech_partionedLi0(ph)%data(1:3,1:3,me) + subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) @@ -1513,8 +1513,8 @@ module function crystallite_stress(dt,co,ip,el) sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partionedFi0(ph)%data(1:3,1:3,me) + crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) + crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst @@ -1566,7 +1566,6 @@ module function crystallite_stress(dt,co,ip,el) = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) enddo - ! cant restore dotState here, since not yet calculated in first cutback after initialization todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) endif From edef98fd067812d527d97234821d8b06e9ef7de9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Dec 2020 12:44:26 +0100 Subject: [PATCH 105/214] proper indentation --- src/homogenization.f90 | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index fba0c4f45..27fdb6064 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -184,11 +184,10 @@ subroutine materialpoint_stressAndItsTangent(dt) damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) - NiterationHomog = 0 + NiterationHomog = 0 + cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - - myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) + myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) if (converged) then subFrac = subFrac + subStep @@ -238,7 +237,6 @@ subroutine materialpoint_stressAndItsTangent(dt) NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested & .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) @@ -275,15 +273,12 @@ subroutine materialpoint_stressAndItsTangent(dt) endif enddo convergenceLooping + NiterationHomog = NiterationHomog + 1 - - NiterationHomog = NiterationHomog + 1 - - enddo cutBackLooping - - enddo + enddo cutBackLooping enddo - !$OMP END PARALLEL DO + enddo + !$OMP END PARALLEL DO if (.not. terminallyIll ) then call crystallite_orientations() ! calculate crystal orientations From 6d5c3a5d12587975c2da3eba9c95f787d5dd62de Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 24 Dec 2020 20:02:59 +0100 Subject: [PATCH 106/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-97-g10bbeb561 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 3e5a7aa8c..616042312 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-75-gac45427e9 +v3.0.0-alpha2-97-g10bbeb561 From 5f5d9ed908454b38e35617581a71c36861f85b27 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 08:43:57 +0100 Subject: [PATCH 107/214] wrong time increment --- src/constitutive_mech.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index b2194ab93..7a2224ede 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1238,7 +1238,7 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t - broken = integrateStress(F_0 + (F - F_0) * Delta_t,Delta_t * C(stage),co,ip,el) + broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),Delta_t * C(stage),co,ip,el) if(broken) exit broken = mech_collectDotState(Delta_t*C(stage),co,ip,el,ph,me) From 615909a1bc934c7057b84bfbd74ecbc2dff901d8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 09:47:20 +0100 Subject: [PATCH 108/214] consistent naming --- src/constitutive.f90 | 16 ++++++++-------- src/homogenization_mech.f90 | 24 ++++++++++++------------ 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7e380f8cd..bed21cb92 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1089,7 +1089,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) el !< counter in element loop integer :: & o, & - p, pp, m + p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & @@ -1109,19 +1109,19 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) - invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) - invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) @@ -1150,7 +1150,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 56f1e554f..e4499e9b7 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -128,35 +128,35 @@ module subroutine mech_homogenize(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c,m + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - m = (el-1)* discretization_nIPs + ip + ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,m) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,m) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) From ddb59b6ad07be5439a4ce0f0997c72c7b20bd9d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 10:19:39 +0100 Subject: [PATCH 109/214] simplified --- src/homogenization.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 27fdb6064..896e4e790 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -255,10 +255,7 @@ subroutine materialpoint_stressAndItsTangent(dt) do co = 1, myNgrains converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) enddo - endif - - if (requested .and. .not. doneAndHappy(1)) then if (.not. converged) then doneAndHappy = [.true.,.false.] else From cee04c9b5f0400d3435304331909f553db527857 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 10:22:03 +0100 Subject: [PATCH 110/214] not needed --- src/homogenization.f90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 896e4e790..fc6b115ad 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -157,13 +157,12 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac, & subStep logical :: & - requested, & converged logical, dimension(2) :: & doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,requested,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) do ip = FEsolving_execIP(1),FEsolving_execIP(2) @@ -174,7 +173,6 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac = 0.0_pReal converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested = .true. ! everybody requires calculation if (homogState(material_homogenizationAt(el))%sizeState > 0) & homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & @@ -231,13 +229,12 @@ subroutine materialpoint_stressAndItsTangent(dt) endif if (subStep > num%subStepMinHomog) then - requested = .true. doneAndHappy = [.false.,.true.] endif NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested & + convergenceLooping: do while (.not. terminallyIll & .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 @@ -245,7 +242,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested .and. .not. doneAndHappy(1)) then ! requested but not yet done + if(.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& From e8ea815d9258c02afd60a47c829e638810cda56d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 11:48:02 +0100 Subject: [PATCH 111/214] simplified --- src/CPFEM.f90 | 5 +- src/CPFEM2.f90 | 1 - src/DAMASK_marc.f90 | 1 - src/FEsolving.f90 | 15 ------ src/commercialFEM_fileList.f90 | 1 - src/constitutive.f90 | 39 +++++--------- src/grid/discretization_grid.f90 | 4 -- src/grid/grid_mech_FEM.f90 | 1 - src/grid/grid_mech_spectral_basic.f90 | 1 - src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 +- src/homogenization.f90 | 57 +++++++++++--------- src/marc/discretization_marc.f90 | 4 -- src/mesh/DAMASK_mesh.f90 | 1 - src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 6 +-- 16 files changed, 49 insertions(+), 94 deletions(-) delete mode 100644 src/FEsolving.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index abbcce04a..240688a8c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -5,7 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM use prec - use FEsolving use math use rotations use YAML_types @@ -197,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6) else validCalculation - FEsolving_execElem = elCP - FEsolving_execIP = ip if (debugCPFEM%extensive) & print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip - call materialpoint_stressAndItsTangent(dt) + call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP]) terminalIllness: if (terminallyIll) then diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 44b93d1cb..5a500875d 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -6,7 +6,6 @@ module CPFEM2 use prec use config - use FEsolving use math use rotations use YAML_types diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index ea7430c6b..0ad68445c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use DAMASK_interface use config use YAML_types - use FEsolving use discretization_marc use homogenization use CPFEM diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 deleted file mode 100644 index 3fc1482d3..000000000 --- a/src/FEsolving.f90 +++ /dev/null @@ -1,15 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief global variables for flow control -!-------------------------------------------------------------------------------------------------- -module FEsolving - - implicit none - public - - integer, dimension(2) :: & - FEsolving_execElem, & !< for ping-pong scheme always whole range, otherwise one specific element - FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - -end module FEsolving diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 08e7b9c1c..d8ab6390d 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,7 +13,6 @@ #include "math.f90" #include "quaternions.f90" #include "rotations.f90" -#include "FEsolving.f90" #include "element.f90" #include "HDF5_utilities.f90" #include "results.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index bed21cb92..b3fb0b246 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -16,7 +16,6 @@ module constitutive use parallelization use HDF5_utilities use DAMASK_interface - use FEsolving use results implicit none @@ -940,8 +939,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -967,14 +966,14 @@ subroutine crystallite_init crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 - call crystallite_orientations() !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + call crystallite_orientations(co,ip,el) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo @@ -1210,34 +1209,20 @@ end function crystallite_stressTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations +subroutine crystallite_orientations(co,ip,el) - integer & + integer, intent(in) :: & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el !< counter in element loop - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) - enddo; enddo; enddo - !$OMP END PARALLEL DO + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + + if (plasticState(material_phaseAt(1,el))%nonlocal) & + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - nonlocalPresent: if (any(plasticState%nonlocal)) then - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,el))%nonlocal) then - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - enddo - endif - enddo - !$OMP END PARALLEL DO - endif nonlocalPresent end subroutine crystallite_orientations diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 1b3700c14..48ad5b7e1 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -19,7 +19,6 @@ module discretization_grid use results use discretization use geometry_plastic_nonlocal - use FEsolving implicit none private @@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart) (grid(1)+1) * (grid(2)+1) * grid3,& ! ...unless not last process worldrank+1==worldsize)) - FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements - FEsolving_execIP = [1,1] ! parallel loop bounds set to comprise the only IP - !-------------------------------------------------------------------------------------------------- ! store geometry information for post processing if(.not. restart) then diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index cdf806b35..003f568c6 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -18,7 +18,6 @@ module grid_mech_FEM use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ebaaf3b55..9bc36165f 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_basic use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 9f2a17c97..7160c1adc 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c0c84233d..e8bae223a 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -810,9 +810,9 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& print'(/,a)', ' ... evaluating constitutive response ......................................' flush(IO_STDOUT) - homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3]) ! calculate P field P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P diff --git a/src/homogenization.f90 b/src/homogenization.f90 index fc6b115ad..13e098ac0 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -11,7 +11,6 @@ module homogenization use math use material use constitutive - use FEsolving use discretization use thermal_isothermal use thermal_conduction @@ -144,15 +143,16 @@ end subroutine homogenization_init !-------------------------------------------------------------------------------------------------- !> @brief parallelized calculation of stress and corresponding tangent at material points !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_stressAndItsTangent(dt) +subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem) real(pReal), intent(in) :: dt !< time increment + integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce + myNgrains, co, ce, ho real(pReal) :: & subFrac, & subStep @@ -162,8 +162,10 @@ subroutine materialpoint_stressAndItsTangent(dt) doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) !-------------------------------------------------------------------------------------------------- @@ -174,18 +176,19 @@ subroutine materialpoint_stressAndItsTangent(dt) converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - if (homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) + if (homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + + if (damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - if (damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) + if (converged) then subFrac = subFrac + subStep @@ -196,12 +199,12 @@ subroutine materialpoint_stressAndItsTangent(dt) ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded @@ -219,12 +222,12 @@ subroutine materialpoint_stressAndItsTangent(dt) call crystallite_restore(ip,el,subStep < 1.0_pReal) call constitutive_restore(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif endif @@ -275,10 +278,14 @@ subroutine materialpoint_stressAndItsTangent(dt) !$OMP END PARALLEL DO if (.not. terminallyIll ) then - call crystallite_orientations() ! calculate crystal orientations - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(ho,myNgrains) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1, myNgrains + call crystallite_orientations(co,ip,el) + enddo call mech_homogenize(ip,el) enddo IpLooping3 enddo elementLooping3 diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index ca0b54b73..675e57bd3 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -12,7 +12,6 @@ module discretization_marc use DAMASK_interface use IO use config - use FEsolving use element use discretization use geometry_plastic_nonlocal @@ -89,9 +88,6 @@ subroutine discretization_marc_init if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,nElems] - FEsolving_execIP = [1,elem%nIPs] - allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) call buildCells(connectivity_cell,cellNodeDefinition,& diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 1e353892c..7369520c1 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -15,7 +15,6 @@ program DAMASK_mesh use IO use math use CPFEM2 - use FEsolving use config use discretization_mesh use FEM_Utilities diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index cb81f1f0c..2f3633e11 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -160,7 +160,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) print'(/,a)', ' ... evaluating constitutive response ......................................' - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems]) ! calculate P field cutBack = .false. ! reset cutBack status diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 7dbd05e46..21c5feace 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -18,7 +18,6 @@ module discretization_mesh use config use discretization use results - use FEsolving use FEM_quadrature use YAML_types use prec @@ -30,7 +29,7 @@ module discretization_mesh mesh_Nboundaries, & mesh_NcpElemsGlobal - integer :: & + integer, public, protected :: & mesh_NcpElems !< total number of CP elements in mesh !!!! BEGIN DEPRECATED !!!!! @@ -174,9 +173,6 @@ subroutine discretization_mesh_init(restart) if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements - FEsolving_execIP = [1,mesh_maxNips] - allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call discretization_init(materialAt,& From 609d69a3e7bc41f5e6868307c7f9f35b687ca865 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 13:33:14 +0100 Subject: [PATCH 112/214] polishing --- src/homogenization.f90 | 13 +++---------- 1 file changed, 3 insertions(+), 10 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 13e098ac0..ebf5fd50d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -188,8 +188,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - - if (converged) then subFrac = subFrac + subStep subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration @@ -207,14 +205,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) then ! so first signals terminally ill... + if (.not. terminallyIll) & ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback @@ -231,10 +227,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE endif endif - if (subStep > num%subStepMinHomog) then - doneAndHappy = [.false.,.true.] - endif - + if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] NiterationMPstate = 0 convergenceLooping: do while (.not. terminallyIll & @@ -245,7 +238,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(.not. doneAndHappy(1)) then + if (.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& From 2eed6fdfdbebf6bfdc68f98062cbad6979e393ef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 16:13:31 +0100 Subject: [PATCH 113/214] not needed as global variable --- src/constitutive.f90 | 28 +++++++-------- src/constitutive_mech.f90 | 73 ++++++++++++++++----------------------- 2 files changed, 41 insertions(+), 60 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b3fb0b246..e65ce864d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -64,10 +64,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable :: & - crystallite_converged !< convergence flag - - type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data end type @@ -185,10 +181,10 @@ module constitutive ! == cleaned:end =================================================================================== - module function crystallite_stress(dt,co,ip,el) + module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: co, ip, el - logical :: crystallite_stress + logical :: converged_ end function crystallite_stress module function constitutive_homogenizedC(co,ip,el) result(C) @@ -872,10 +868,8 @@ subroutine crystallite_init source = crystallite_partitionedF) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_orientation(cMax,iMax,eMax)) - allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -1253,7 +1247,7 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateSourceState(co,ip,el) +function integrateSourceState(co,ip,el) result(broken) integer, intent(in) :: & el, & !< element index in element loop @@ -1273,12 +1267,13 @@ subroutine integrateSourceState(co,ip,el) r ! state residuum real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & - broken + broken, converged_ ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) if(broken) return @@ -1313,19 +1308,20 @@ subroutine integrateSourceState(co,ip,el) - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) - crystallite_converged(co,ip,el) = & - crystallite_converged(co,ip,el) .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) enddo - if(crystallite_converged(co,ip,el)) then + if(converged_) then broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) exit iteration endif enddo iteration + broken = broken .or. .not. converged_ + contains @@ -1349,7 +1345,7 @@ subroutine integrateSourceState(co,ip,el) end function damper -end subroutine integrateSourceState +end function integrateSourceState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7a2224ede..de6f2ae9f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -951,7 +951,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) +function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1004,11 +1004,7 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) - plasticState(ph)%dotState (1:size_pl,me) * Delta_t plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - r(1:size_pl) - crystallite_converged(co,ip,el) = converged(r(1:size_pl), & - plasticState(ph)%state(1:size_pl,me), & - plasticState(ph)%atol(1:size_pl)) - - if(crystallite_converged(co,ip,el)) then + if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration @@ -1016,7 +1012,6 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) enddo iteration - contains !-------------------------------------------------------------------------------------------------- @@ -1039,13 +1034,13 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) end function damper -end subroutine integrateStateFPI +end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1075,15 +1070,14 @@ subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken -end subroutine integrateStateEuler +end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1123,24 +1117,22 @@ subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return + broken = .not. converged(residuum_plastic(1:sizeDotState) + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) - sizeDotState = plasticState(ph)%sizeDotState - crystallite_converged(co,ip,el) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & - plasticState(ph)%state(1:sizeDotState,me), & - plasticState(ph)%atol(1:sizeDotState)) - -end subroutine integrateStateAdaptiveEuler +end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) +function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(3,3), parameter :: & A = reshape([& @@ -1153,19 +1145,20 @@ subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) -end subroutine integrateStateRK4 +end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) +function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -1185,16 +1178,16 @@ subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) -end subroutine integrateStateRKCK45 +end function integrateStateRKCK45 !-------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) +function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1205,15 +1198,14 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: broken - integer :: & + integer :: & stage, & ! stage index in integration stage loop n, & ph, & me, & sizeDotState - logical :: & - broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState @@ -1266,10 +1258,8 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken - -end subroutine integrateStateRK +end function integrateStateRK !-------------------------------------------------------------------------------------------------- @@ -1479,15 +1469,14 @@ end function constitutive_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -module function crystallite_stress(dt,co,ip,el) +module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: & co, & ip, & el - - logical :: crystallite_stress + logical :: converged_ real(pReal) :: & formerSubStep @@ -1519,7 +1508,7 @@ module function crystallite_stress(dt,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. NiterationCrystallite = 0 @@ -1528,7 +1517,7 @@ module function crystallite_stress(dt,co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(co,ip,el)) then + if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) @@ -1579,17 +1568,13 @@ module function crystallite_stress(dt,co,ip,el) math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - crystallite_converged(co,ip,el) = .false. - call integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - call integrateSourceState(co,ip,el) + converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& + crystallite_subdt(co,ip,el),co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) endif enddo cutbackLooping -! return whether converged or not - crystallite_stress = crystallite_converged(co,ip,el) - end function crystallite_stress end submodule constitutive_mech From 6efc61c4798fafd88eb2aa4c28dde82e7c07c4a1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 20:07:36 +0100 Subject: [PATCH 114/214] easier to understand --- src/constitutive.f90 | 10 +++++----- src/constitutive_mech.f90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e65ce864d..5bee8b97c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1247,8 +1247,9 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateSourceState(co,ip,el) result(broken) +function integrateSourceState(dt,co,ip,el) result(broken) + real(pReal), intent(in) :: dt integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -1281,8 +1282,7 @@ function integrateSourceState(co,ip,el) result(broken) do so = 1, phase_Nsources(ph) size_so(so) = sourceState(ph)%p(so)%sizeDotState sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) & - * crystallite_subdt(co,ip,el) + + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo @@ -1304,8 +1304,8 @@ function integrateSourceState(co,ip,el) result(broken) sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) + - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) converged_ = converged_ .and. converged(r(1:size_so(so)), & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index de6f2ae9f..51822d898 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1569,8 +1569,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) + subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif enddo cutbackLooping From a13a6624fe878c127f53de35ab263bee9be0c804 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:20:54 +0100 Subject: [PATCH 115/214] clearer logic --- src/homogenization.f90 | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ebf5fd50d..b550ae207 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -205,26 +205,24 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else - if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) & ! so first signals terminally ill... - print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - terminallyIll = .true. ! ...and kills all others - else ! cutback makes sense - subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback + if (.not. terminallyIll) & ! so first signals terminally ill... + print*, ' Integration point ', ip,' at element ', el, ' terminally ill' + terminallyIll = .true. ! ...and kills all others + else ! cutback makes sense + subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep < 1.0_pReal) - call constitutive_restore(ip,el) + call crystallite_restore(ip,el,subStep < 1.0_pReal) + call constitutive_restore(ip,el) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - endif + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From 4a839053eba299224fb7ba12b7e7638514772d16 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:25:28 +0100 Subject: [PATCH 116/214] not used was only used for reporting (see v.2.0.0) --- src/homogenization.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index b550ae207..6745cceb1 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -148,7 +148,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE real(pReal), intent(in) :: dt !< time increment integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & - NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number @@ -162,7 +161,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) myNgrains = homogenization_Nconstituents(ho) @@ -184,8 +183,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - - NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) if (converged) then @@ -261,8 +258,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE endif enddo convergenceLooping - NiterationHomog = NiterationHomog + 1 - enddo cutBackLooping enddo enddo From f861120f9102bd6788c3152f528a0c447777da39 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 21:45:31 +0100 Subject: [PATCH 117/214] separation of responsibility --- src/constitutive.f90 | 58 +++++++++++++-------------------------- src/constitutive_mech.f90 | 32 +++++++++++++++++++++ src/homogenization.f90 | 3 +- 3 files changed, 52 insertions(+), 41 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5bee8b97c..3c1f0e8c1 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -179,6 +179,14 @@ module constitutive module subroutine constitutive_mech_forward end subroutine constitutive_mech_forward + module subroutine mech_restore(ip,el,includeL) + integer, intent(in) :: & + ip, & + el + logical, intent(in) :: & + includeL + end subroutine mech_restore + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -392,8 +400,7 @@ module constitutive crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - crystallite_restore, & - PLASTICITY_UNDEFINED_ID, & + PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & @@ -756,22 +763,27 @@ end subroutine constitutive_allocateState !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_restore(ip,el) +subroutine constitutive_restore(ip,el,includeL) + logical, intent(in) :: includeL integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number - s + so + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo + call mech_restore(ip,el,includeL) + end subroutine constitutive_restore @@ -1038,38 +1050,6 @@ subroutine constitutive_windForward(ip,el) end subroutine constitutive_windForward -!-------------------------------------------------------------------------------------------------- -!> @brief Restore data after homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restore(ip,el,includeL) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - logical, intent(in) :: & - includeL !< protect agains fake cutback - integer :: & - co, p, m !< constituent number - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) - if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) - endif ! maybe protecting everything from overwriting makes more sense - - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) - - plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) - enddo - -end subroutine crystallite_restore - - !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 51822d898..3914283d2 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1577,5 +1577,37 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) end function crystallite_stress + +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_restore(ip,el,includeL) + + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + logical, intent(in) :: & + includeL !< protect agains fake cutback + integer :: & + co, p, m !< constituent number + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) + if (includeL) then + crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + endif ! maybe protecting everything from overwriting makes more sense + + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + + plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) + enddo + +end subroutine mech_restore + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6745cceb1..05fa5f690 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -211,8 +211,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep < 1.0_pReal) - call constitutive_restore(ip,el) + call constitutive_restore(ip,el,subStep < 1.0_pReal) if(homogState(ho)%sizeState > 0) & homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & From 6f4aa0ebd9f0539bc0f0ef00d4e7c2f47eba04ee Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:22:08 +0100 Subject: [PATCH 118/214] consistent names --- src/constitutive.f90 | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 3c1f0e8c1..9d2754a68 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -945,8 +945,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3) - do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -965,8 +965,8 @@ subroutine crystallite_init constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - enddo; enddo - enddo + enddo + enddo; enddo !$OMP END PARALLEL DO crystallite_partitionedF0 = crystallite_F0 @@ -990,9 +990,6 @@ subroutine crystallite_init end subroutine crystallite_init - - - !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- @@ -1003,7 +1000,7 @@ subroutine constitutive_initializeRestorationPoints(ip,el) el !< element number integer :: & co, & !< constituent number - s,ph, me + so,ph, me do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) @@ -1014,9 +1011,9 @@ subroutine constitutive_initializeRestorationPoints(ip,el) call mech_initializeRestorationPoints(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%state0( :,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) enddo enddo @@ -1033,7 +1030,7 @@ subroutine constitutive_windForward(ip,el) el !< element number integer :: & co, & !< constituent number - s, ph, me + so, ph, me do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1042,8 +1039,8 @@ subroutine constitutive_windForward(ip,el) crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(s)%partitionedState0(:,me) = sourceState(ph)%p(s)%state(:,me) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo enddo From 822fafc9b6559a1a100752d2314b163ec0bf44d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:49:08 +0100 Subject: [PATCH 119/214] subF and partitionedF should have the same value at the end of a cycle --- src/constitutive.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9d2754a68..eb94e539c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1126,8 +1126,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1158,7 +1158,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp) temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal @@ -1167,7 +1167,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & + + matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & @@ -1214,7 +1214,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) + transpose(math_inv33(crystallite_partitionedF(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef From ba9ad3a8c2098e2fb8a460f073b77294af25255d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Dec 2020 22:56:21 +0100 Subject: [PATCH 120/214] only needed in one loop --- src/constitutive.f90 | 2 -- src/constitutive_mech.f90 | 18 ++++++++---------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index eb94e539c..e34cfc015 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -48,7 +48,6 @@ module constitutive crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc - crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc crystallite_subFi0,& !< intermediate def grad at start of crystallite inc @@ -875,7 +874,6 @@ subroutine crystallite_init crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subF, & crystallite_subFp0,crystallite_subFi0, & source = crystallite_partitionedF) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 3914283d2..1dac6fffd 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1488,7 +1488,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), dimension(3,3) :: & subLp0, & !< plastic velocity grad at start of crystallite inc subLi0, & !< intermediate velocity grad at start of crystallite inc - subF0 + subF0, & + subF ph = material_phaseAt(co,el) @@ -1525,7 +1526,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) todo = subStep > 0.0_pReal ! still time left to integrate on? if (todo) then - subF0 = crystallite_subF(1:3,1:3,co,ip,el) + subF0 = subF subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) @@ -1561,15 +1562,12 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) !-------------------------------------------------------------------------------------------------- ! prepare for integration if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = subF0 & - + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + subF = subF0 & + + subStep * (crystallite_partitionedF(1:3,1:3,co,ip,el) -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - subStep * dt,co,ip,el) + converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From 820aa25e12f1606de56390eb9456e249e260b52b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:07:35 +0100 Subject: [PATCH 121/214] consistent names --- src/constitutive.f90 | 58 +++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 27 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e34cfc015..9ec21f69c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1026,9 +1026,12 @@ subroutine constitutive_windForward(ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number so, ph, me + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1055,10 +1058,10 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) co, & !< counter in constituent loop ip, & !< counter in integration point loop el !< counter in element loop + integer :: & o, & p, ph, me - real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & temp_33_1, temp_33_2, temp_33_3, temp_33_4 @@ -1077,6 +1080,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1346,7 +1350,7 @@ end function converged !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartWrite - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1360,22 +1364,22 @@ subroutine crystallite_restartWrite call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,plasticState(i)%state,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do i = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,homogState(i)%state,datasetName) + do ph = 1, size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,homogState(ph)%state,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1390,7 +1394,7 @@ end subroutine crystallite_restartWrite !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartRead - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1404,22 +1408,22 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do i = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,homogState(i)%state0,datasetName) + do ph = 1,size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) enddo call HDF5_closeGroup(groupHandle) From 830e2a3a990b8b86717973618cd7bf31f3312567 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:13:56 +0100 Subject: [PATCH 122/214] shortened --- src/homogenization.f90 | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 05fa5f690..d0f7baf5a 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -151,7 +151,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce, ho + myNgrains, co, ce, ho, me real(pReal) :: & subFrac, & subStep @@ -164,6 +164,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) + me = material_homogenizationMemberAt(ip,el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) @@ -176,12 +177,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - + homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -195,11 +193,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_windForward(ip,el) if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -214,11 +210,9 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_restore(ip,el,subStep < 1.0_pReal) if(homogState(ho)%sizeState > 0) & - homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) if(damageState(ho)%sizeState > 0) & - damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From e6f27e91b1a8a9e8cdab418fcfbc743a1b4636a2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:18:20 +0100 Subject: [PATCH 123/214] consistent names --- src/homogenization.f90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d0f7baf5a..6b2a43836 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -161,7 +161,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) me = material_homogenizationMemberAt(ip,el) @@ -321,29 +321,30 @@ subroutine homogenization_results use material, only: & material_homogenization_type => homogenization_type - integer :: p + integer :: ph character(len=:), allocatable :: group_base,group + call results_closeGroup(results_addGroup('current/homogenization/')) - do p=1,size(material_name_homogenization) - group_base = 'current/homogenization/'//trim(material_name_homogenization(p)) + do ph=1,size(material_name_homogenization) + group_base = 'current/homogenization/'//trim(material_name_homogenization(ph)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,p) + call mech_results(group_base,ph) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) - select case(damage_type(p)) + select case(damage_type(ph)) case(DAMAGE_NONLOCAL_ID) - call damage_nonlocal_results(p,group) + call damage_nonlocal_results(ph,group) end select group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) - select case(thermal_type(p)) + select case(thermal_type(ph)) case(THERMAL_CONDUCTION_ID) - call thermal_conduction_results(p,group) + call thermal_conduction_results(ph,group) end select enddo @@ -359,6 +360,7 @@ subroutine homogenization_forward integer :: ho + do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state damageState(ho)%state0 = damageState(ho)%state From 190df4830c10283b4bb83c19a438c526facb8afb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:27:48 +0100 Subject: [PATCH 124/214] simplified --- src/homogenization.f90 | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6b2a43836..2bc3545e3 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -289,18 +289,17 @@ function updateState(subdt,subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c logical, dimension(2) :: updateState + + integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - updateState = .true. - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c=1,homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + + if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo updateState = & - updateState .and. & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& @@ -309,7 +308,9 @@ function updateState(subdt,subF,ip,el) dPdFs, & ip, & el) - end select chosenHomogenization + else + updateState = .true. + endif end function updateState @@ -318,33 +319,31 @@ end function updateState !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine homogenization_results - use material, only: & - material_homogenization_type => homogenization_type - integer :: ph + integer :: ho character(len=:), allocatable :: group_base,group call results_closeGroup(results_addGroup('current/homogenization/')) - do ph=1,size(material_name_homogenization) - group_base = 'current/homogenization/'//trim(material_name_homogenization(ph)) + do ho=1,size(material_name_homogenization) + group_base = 'current/homogenization/'//trim(material_name_homogenization(ho)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,ph) + call mech_results(group_base,ho) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) - select case(damage_type(ph)) + select case(damage_type(ho)) case(DAMAGE_NONLOCAL_ID) - call damage_nonlocal_results(ph,group) + call damage_nonlocal_results(ho,group) end select group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) - select case(thermal_type(ph)) + select case(thermal_type(ho)) case(THERMAL_CONDUCTION_ID) - call thermal_conduction_results(ph,group) + call thermal_conduction_results(ho,group) end select enddo From 7d767522812c7092eaf0ff9473e97620de9fc250 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 09:55:54 +0100 Subject: [PATCH 125/214] intended hierarchy --- src/homogenization.f90 | 74 +++++++-------------------------- src/homogenization_mech.f90 | 54 ++++++++++++++++++++++++ src/homogenization_mech_RGC.f90 | 27 ++++++++---- 3 files changed, 87 insertions(+), 68 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 2bc3545e3..bc3098300 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -70,29 +70,22 @@ module homogenization end subroutine mech_homogenize module subroutine mech_results(group_base,h) - character(len=*), intent(in) :: group_base integer, intent(in) :: h - end subroutine mech_results -! -------- ToDo --------------------------------------------------------- - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - logical, dimension(2) :: mech_RGC_updateState - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function mech_RGC_updateState + module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + end function mech_updateState end interface -! ----------------------------------------------------------------------- public :: & homogenization_init, & @@ -241,11 +234,11 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy = [.true.,.false.] else ce = (el-1)*discretization_nIPs + ip - doneAndHappy = updateState(dt*subStep, & - homogenization_F0(1:3,1:3,ce) & - + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & + doneAndHappy = mech_updateState(dt*subStep, & + homogenization_F0(1:3,1:3,ce) & + + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & *(subStep+subFrac), & - ip,el) + ip,el) converged = all(doneAndHappy) endif endif @@ -276,45 +269,6 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE end subroutine materialpoint_stressAndItsTangent -!-------------------------------------------------------------------------------------------------- -!> @brief update the internal state of the homogenization scheme and tell whether "done" and -!> "happy" with result -!-------------------------------------------------------------------------------------------------- -function updateState(subdt,subF,ip,el) - - real(pReal), intent(in) :: & - subdt !< current time step - real(pReal), intent(in), dimension(3,3) :: & - subF - integer, intent(in) :: & - ip, & !< integration point - el !< element number - logical, dimension(2) :: updateState - - integer :: co - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - - - if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) - enddo - updateState = & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& - subF,& - subdt, & - dPdFs, & - ip, & - el) - else - updateState = .true. - endif - -end function updateState - - !-------------------------------------------------------------------------------------------------- !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e4499e9b7..8eda278b2 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -52,6 +52,21 @@ submodule(homogenization) homogenization_mech end subroutine mech_RGC_averageStressAndItsTangent + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function mech_RGC_updateState + + module subroutine mech_RGC_results(instance,group) integer, intent(in) :: instance !< homogenization instance character(len=*), intent(in) :: group !< group name in HDF5 file @@ -166,6 +181,45 @@ module subroutine mech_homogenize(ip,el) end subroutine mech_homogenize +!-------------------------------------------------------------------------------------------------- +!> @brief update the internal state of the homogenization scheme and tell whether "done" and +!> "happy" with result +!-------------------------------------------------------------------------------------------------- +module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + + integer :: co + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + + + if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + enddo + doneAndHappy = & + mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& + subF,& + subdt, & + dPdFs, & + ip, & + el) + else + doneAndHappy = .true. + endif + +end function mech_updateState + + !-------------------------------------------------------------------------------------------------- !> @brief Write results to file. !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index a89008e96..10148715d 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -242,7 +242,18 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module procedure mech_RGC_updateState +module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P @@ -256,7 +267,7 @@ module procedure mech_RGC_updateState real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax zeroTimeStep: if(dEq0(dt)) then - mech_RGC_updateState = .true. ! pretend everything is fine and return + doneAndHappy = .true. ! pretend everything is fine and return return endif zeroTimeStep @@ -327,12 +338,12 @@ module procedure mech_RGC_updateState stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress residMax = maxval(abs(tract)) ! get the maximum of the residual - mech_RGC_updateState = .false. + doneAndHappy = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy if (residMax < num%rtol*stresMax .or. residMax < num%atol) then - mech_RGC_updateState = .true. + doneAndHappy = .true. !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration @@ -354,7 +365,7 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! if residual blows-up => done but unhappy elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound - mech_RGC_updateState = [.true.,.false.] ! with direct cut-back + doneAndHappy = [.true.,.false.] ! with direct cut-back return endif @@ -484,7 +495,7 @@ module procedure mech_RGC_updateState enddo; enddo stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > num%maxdRelax)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large - mech_RGC_updateState = [.true.,.false.] + doneAndHappy = [.true.,.false.] !$OMP CRITICAL (write2out) print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback' print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax)) @@ -535,7 +546,7 @@ module procedure mech_RGC_updateState Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position + iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (doneAndHappy,y,z)-position interfaceLoop: do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain @@ -729,7 +740,7 @@ module procedure mech_RGC_updateState end subroutine grainDeformation -end procedure mech_RGC_updateState +end function mech_RGC_updateState !-------------------------------------------------------------------------------------------------- From d59cb81ca8172561a7c47070951dd8acd1c4b0ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 10:27:52 +0100 Subject: [PATCH 126/214] too early (depends on IP) --- src/homogenization.f90 | 5 ++--- src/homogenization_mech_RGC.f90 | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index bc3098300..52553b57b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -154,13 +154,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy - !$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) - me = material_homogenizationMemberAt(ip,el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) - + me = material_homogenizationMemberAt(ip,el) !-------------------------------------------------------------------------------------------------- ! initialize restoration points call constitutive_initializeRestorationPoints(ip,el) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 10148715d..3db4bb0f5 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -546,7 +546,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa Gmoduli = equivalentModuli(iGrain,ip,el) muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector - iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (doneAndHappy,y,z)-position + iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 intFace = getInterface(iFace,iGrain3) ! get the 4-dimensional index of the interface in local numbering system of the grain From 1ac5465d65668a7e08b72a682e073d4bb0bd7cd1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 11:03:29 +0100 Subject: [PATCH 127/214] using central functionality --- src/homogenization_mech_RGC.f90 | 57 +++++++++++---------------------- src/lattice.f90 | 34 +++++++++++--------- 2 files changed, 38 insertions(+), 53 deletions(-) diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 3db4bb0f5..04ec73845 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -8,6 +8,7 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization:homogenization_mech) homogenization_mech_RGC use rotations + use lattice type :: tParameters integer, dimension(:), allocatable :: & @@ -524,8 +525,10 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l - real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb - real(pReal), parameter :: nDefToler = 1.0e-10_pReal + real(pReal) :: muGrain,muGNghb,nDefNorm + real(pReal), parameter :: & + nDefToler = 1.0e-10_pReal, & + b = 2.5e-10_pReal ! Length of Burgers vector nGDim = param(instance)%N_constituents rPen = 0.0_pReal @@ -543,9 +546,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !----------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains grainLoop: do iGrain = 1,product(prm%N_constituents) - Gmoduli = equivalentModuli(iGrain,ip,el) - muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain - bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + muGrain = equivalentMu(iGrain,ip,el) iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 @@ -557,9 +558,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1 iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain - Gmoduli = equivalentModuli(iGNghb,ip,el) ! collect the shear modulus and Burgers vector of the neighbor - muGNghb = Gmoduli(1) - bgGNghb = Gmoduli(2) + muGNghb = equivalentMu(iGNghb,ip,el) gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor !------------------------------------------------------------------------------------------- @@ -579,7 +578,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3 - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xi_alpha & + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha & *surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) & *cosh(prm%c_alpha*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) & @@ -666,44 +665,26 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa end function surfaceCorrection - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor - !-------------------------------------------------------------------------------------------------- - function equivalentModuli(grainID,ip,el) - - real(pReal), dimension(2) :: equivalentModuli + !------------------------------------------------------------------------------------------------- + real(pReal) function equivalentMu(grainID,ip,el) integer, intent(in) :: & grainID,& ip, & !< integration point number el !< element number - real(pReal), dimension(6,6) :: elasTens - real(pReal) :: & - cEquiv_11, & - cEquiv_12, & - cEquiv_44 - - elasTens = constitutive_homogenizedC(grainID,ip,el) - - !---------------------------------------------------------------------------------------------- - ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) - cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal - cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & - elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal - cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal - equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 - - !---------------------------------------------------------------------------------------------- - ! obtain the length of Burgers vector (could be model dependend) - equivalentModuli(2) = 2.5e-10_pReal - - end function equivalentModuli - !-------------------------------------------------------------------------------------------------- + equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt') + + end function equivalentMu + + + !------------------------------------------------------------------------------------------------- !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme) - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain @@ -718,7 +699,7 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa integer, dimension(3) :: iGrain3 integer :: iGrain,iFace,i,j - !------------------------------------------------------------------------------------------------- + !----------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) diff --git a/src/lattice.f90 b/src/lattice.f90 index 676232efe..6af135e4e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -421,6 +421,8 @@ module lattice lattice_BCT_ID, & lattice_HEX_ID, & lattice_ORT_ID, & + lattice_equivalent_nu, & + lattice_equivalent_mu, & lattice_applyLatticeSymmetry33, & lattice_SchmidMatrix_slip, & lattice_SchmidMatrix_twin, & @@ -508,8 +510,8 @@ subroutine lattice_init lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) - lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') - lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_nu(p) = lattice_equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_mu(p) = lattice_equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation do i = 1, 6 @@ -2188,15 +2190,16 @@ end function getlabels !> @brief Equivalent Poisson's ratio (ν) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_nu(C,assumption) result(nu) +function lattice_equivalent_nu(C,assumption) result(nu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: K, mu, nu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then K = (C(1,1)+C(2,2)+C(3,3) +2.0_pReal*(C(1,2)+C(2,3)+C(1,3))) & / 9.0_pReal @@ -2210,25 +2213,26 @@ function equivalent_nu(C,assumption) result(nu) K = 0.0_pReal endif - mu = equivalent_mu(C,assumption) + mu = lattice_equivalent_mu(C,assumption) nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu) -end function equivalent_nu +end function lattice_equivalent_nu !-------------------------------------------------------------------------------------------------- !> @brief Equivalent shear modulus (μ) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_mu(C,assumption) result(mu) +function lattice_equivalent_mu(C,assumption) result(mu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: mu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then mu = (1.0_pReal*(C(1,1)+C(2,2)+C(3,3)) -1.0_pReal*(C(1,2)+C(2,3)+C(1,3)) +3.0_pReal*(C(4,4)+C(5,5)+C(6,6))) & / 15.0_pReal @@ -2242,7 +2246,7 @@ function equivalent_mu(C,assumption) result(mu) mu = 0.0_pReal endif -end function equivalent_mu +end function lattice_equivalent_mu !-------------------------------------------------------------------------------------------------- @@ -2266,14 +2270,14 @@ subroutine selfTest call random_number(C) C(1,1) = C(1,1) + 1.0_pReal C = applyLatticeSymmetryC66(C,'aP') - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' lambda = C(1,2) - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'voigt')),equivalent_nu(C,'voigt'),1.0e-12_pReal)) & - error stop 'equivalent_nu/voigt' - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) & - error stop 'equivalent_nu/reuss' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), & + lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), & + lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss' end subroutine selfTest From 4796afdd92f7b576c36bf62017fd8ba1b036899f Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 28 Dec 2020 12:10:21 -0500 Subject: [PATCH 128/214] fix for broken representation of no-rotation orientations and averaging weights --- python/damask/_orientation.py | 6 +++--- python/damask/_rotation.py | 14 +++++++++++--- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index 05301561f..e6434813e 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -226,9 +226,9 @@ class Orientation(Rotation): """ return super().__eq__(other) \ - and self.family == other.family \ - and self.lattice == other.lattice \ - and self.parameters == other.parameters + and hasattr(other, 'family') and self.family == other.family \ + and hasattr(other, 'lattice') and self.lattice == other.lattice \ + and hasattr(other, 'parameters') and self.parameters == other.parameters def __matmul__(self,other): diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 780e81891..8d3050ab8 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -204,8 +204,16 @@ class Rotation: def append(self,other): - """Extend rotation array along first dimension with other array.""" - return self.copy(rotation=np.vstack((self.quaternion,other.quaternion))) + """ + Extend rotation array along first dimension with other array(s). + + Parameters + ---------- + other : Rotation or list of Rotations. + + """ + return self.copy(rotation=np.vstack(tuple(map(lambda x:x.quaternion, + [self]+other if type(other) == list else [self,other])))) def flatten(self,order = 'C'): @@ -263,7 +271,7 @@ class Rotation: """Intermediate representation supporting quaternion averaging.""" return np.einsum('...i,...j',quat,quat) - if not weights: + if weights is None: weights = np.ones(self.shape,dtype=float) eig, vec = np.linalg.eig(np.sum(_M(self.quaternion) * weights[...,np.newaxis,np.newaxis],axis=-3) \ From da62daf15d37b6a1d42a1b23d171b3f82e4f6120 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Mon, 28 Dec 2020 12:26:09 -0500 Subject: [PATCH 129/214] added test for appending rotation lists; better check for type==list --- python/damask/_rotation.py | 2 +- python/tests/test_Rotation.py | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 8d3050ab8..78029b59a 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -213,7 +213,7 @@ class Rotation: """ return self.copy(rotation=np.vstack(tuple(map(lambda x:x.quaternion, - [self]+other if type(other) == list else [self,other])))) + [self]+other if isinstance(other,list) else [self,other])))) def flatten(self,order = 'C'): diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index c60029046..36e3a3ac9 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -800,6 +800,14 @@ class TestRotation: print(f'append 2x {shape} --> {s.shape}') assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] + @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)]) + def test_append_list(self,shape): + r = Rotation.from_random(shape=shape) + p = Rotation.from_random(shape=shape) + s = r.append([r,p]) + print(f'append 3x {shape} --> {s.shape}') + assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] + @pytest.mark.parametrize('quat,standardized',[ ([-1,0,0,0],[1,0,0,0]), ([-0.5,-0.5,-0.5,-0.5],[0.5,0.5,0.5,0.5]), From 6207432f7ae0e2270303248c8b1d54c7d1b59a01 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:34:14 +0100 Subject: [PATCH 130/214] modern Fortran --- src/math.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 8005b5406..6b89a9923 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -279,9 +279,12 @@ real(pReal) pure function math_LeviCivita(i,j,k) integer, intent(in) :: i,j,k - if (all([i,j,k] == [1,2,3]) .or. all([i,j,k] == [2,3,1]) .or. all([i,j,k] == [3,1,2])) then + integer :: o + + + if (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then math_LeviCivita = +1.0_pReal - elseif (all([i,j,k] == [3,2,1]) .or. all([i,j,k] == [2,1,3]) .or. all([i,j,k] == [1,3,2])) then + elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then math_LeviCivita = -1.0_pReal else math_LeviCivita = 0.0_pReal From bb9fa228ab71fba9d104947c583d91faf55fe94b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:34:34 +0100 Subject: [PATCH 131/214] 'present' propagates to called function --- src/prec.f90 | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index 95b1116cd..4d73462c4 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -108,8 +108,10 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -132,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq = .not. dEq(a,b,tol) - else - dNeq = .not. dEq(a,b) - endif + + dNeq = .not. dEq(a,b,tol) end function dNeq @@ -151,8 +150,10 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -175,11 +176,8 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq0 = .not. dEq0(a,tol) - else - dNeq0 = .not. dEq0(a) - endif + + dNeq0 = .not. dEq0(a,tol) end function dNeq0 @@ -195,8 +193,10 @@ logical elemental pure function cEq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -220,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - cNeq = .not. cEq(a,b,tol) - else - cNeq = .not. cEq(a,b) - endif + + cNeq = .not. cEq(a,b,tol) end function cNeq @@ -238,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes) real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: & prec_bytesToC_FLOAT + prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT)) end function prec_bytesToC_FLOAT @@ -252,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes) real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: & prec_bytesToC_DOUBLE + prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE)) end function prec_bytesToC_DOUBLE @@ -266,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes) integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: & prec_bytesToC_INT32_T + prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T)) end function prec_bytesToC_INT32_T @@ -280,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes) integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: & prec_bytesToC_INT64_T + prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T)) end function prec_bytesToC_INT64_T @@ -295,6 +296,7 @@ subroutine selfTest integer(pInt), dimension(1) :: i real(pReal), dimension(2) :: r + realloc_lhs_test = [1,2] if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation' From 1832646089321eae8dead848db12a26407a47731 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:35:15 +0100 Subject: [PATCH 132/214] lattice is a property of the phase --- examples/FEM/polyXtal/material.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/FEM/polyXtal/material.yaml b/examples/FEM/polyXtal/material.yaml index c7d17657d..333073150 100644 --- a/examples/FEM/polyXtal/material.yaml +++ b/examples/FEM/polyXtal/material.yaml @@ -5,8 +5,8 @@ homogenization: phase: Aluminum: + lattice: cF mechanics: - lattice: cF output: [F, P, F_e, F_p, L_p] elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} plasticity: From f2402f7ad633b66ba269ec6b7776710b2fd163ab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 21:41:48 +0100 Subject: [PATCH 133/214] consistent names --- src/constitutive.f90 | 53 ++++++++++++++++--------------- src/constitutive_mech.f90 | 63 ++++++++++++++++++------------------- src/homogenization_mech.f90 | 8 ++--- 3 files changed, 62 insertions(+), 62 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9ec21f69c..bd9ef400e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,9 +59,8 @@ module constitutive crystallite_P, & !< 1st Piola-Kirchhoff stress per grain crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) - crystallite_partitionedF0 !< def grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_partitionedF !< def grad to be reached at end of homog inc + crystallite_partitionedF0, & !< def grad at start of homog inc + crystallite_F !< def grad to be reached at end of homog inc type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -740,20 +739,21 @@ subroutine constitutive_allocateState(state, & sizeDotState, & sizeDeltaState + state%sizeState = sizeState state%sizeDotState = sizeDotState state%sizeDeltaState = sizeDeltaState state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - allocate(state%atol (sizeState), source=0.0_pReal) - allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%atol (sizeState), source=0.0_pReal) + allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) + allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) - allocate(state%deltaState(sizeDeltaState,Nconstituents), source=0.0_pReal) + allocate(state%deltaState (sizeDeltaState,Nconstituents), source=0.0_pReal) end subroutine constitutive_allocateState @@ -794,7 +794,7 @@ subroutine constitutive_forward integer :: i, j - crystallite_F0 = crystallite_partitionedF + crystallite_F0 = crystallite_F crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S @@ -841,12 +841,13 @@ subroutine crystallite_init Nconstituents, & ph, & me, & - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el, & !< counter in element loop + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el, & !< counter in element loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points - eMax !< maximum number of elements + eMax, & !< maximum number of elements + so class(tNode), pointer :: & num_crystallite, & @@ -865,7 +866,7 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & crystallite_F0,crystallite_Lp0, & @@ -875,7 +876,7 @@ subroutine crystallite_init crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & crystallite_subFp0,crystallite_subFi0, & - source = crystallite_partitionedF) + source = crystallite_F) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -968,7 +969,7 @@ subroutine crystallite_init !$OMP END PARALLEL DO crystallite_partitionedF0 = crystallite_F0 - crystallite_partitionedF = crystallite_F0 + crystallite_F = crystallite_F0 !$OMP PARALLEL DO PRIVATE(ph,me) @@ -1035,9 +1036,9 @@ subroutine constitutive_windForward(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_partitionedF(1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) + crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) + crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) + crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1128,8 +1129,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1160,7 +1161,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_partitionedF(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal @@ -1169,7 +1170,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_partitionedF(1:3,1:3,co,ip,el), & + + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & @@ -1216,7 +1217,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_partitionedF(1:3,1:3,co,ip,el)))) + transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1359,7 +1360,7 @@ subroutine crystallite_restartWrite write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') - call HDF5_write(fileHandle,crystallite_partitionedF,'F') + call HDF5_write(fileHandle,crystallite_F,'F') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1dac6fffd..96dc9809a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -800,7 +800,7 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) broken = .true. - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) + call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -959,6 +959,9 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & NiterationState, & !< number of iterations in state loop ph, & @@ -970,8 +973,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & plastic_dotState - logical :: & - broken + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1048,12 +1050,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1085,13 +1089,13 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic @@ -1105,7 +1109,7 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t + + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) @@ -1145,6 +1149,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1178,6 +1183,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1215,18 +1221,18 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) broken = mech_collectDotState(Delta_t,co,ip,el,ph,me) if(broken) return + sizeDotState = plasticState(ph)%sizeDotState + do stage = 1, size(A,1) - sizeDotState = plasticState(ph)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) do n = 2, stage - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) & - + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) + + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t @@ -1239,7 +1245,6 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) enddo if(broken) return - sizeDotState = plasticState(ph)%sizeDotState plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) @@ -1282,7 +1287,7 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_partitionedF,ph) + selected_tensors = select_tensors(crystallite_F,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') @@ -1482,7 +1487,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - s, ph, me + so, ph, me logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & @@ -1496,12 +1501,10 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) me = material_phaseMemberAt(co,ip,el) subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) @@ -1531,11 +1534,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo endif !-------------------------------------------------------------------------------------------------- @@ -1549,11 +1550,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) @@ -1563,7 +1562,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! prepare for integration if (todo) then subF = subF0 & - + subStep * (crystallite_partitionedF(1:3,1:3,co,ip,el) -crystallite_partitionedF0(1:3,1:3,co,ip,el)) + + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 8eda278b2..641e960fd 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -116,16 +116,16 @@ module subroutine mech_partition(subF,ip,el) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_partitionedF(1:3,1:3,1,ip,el) = subF + crystallite_F(1:3,1:3,1,ip,el) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization call mech_isostrain_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization call mech_RGC_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF,& ip, & el) @@ -206,7 +206,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& subF,& subdt, & From b41dc7db2893979fc1e11167dd9b11523f94d22f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 22:17:28 +0100 Subject: [PATCH 134/214] simplified --- src/constitutive.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index bd9ef400e..f69ae604c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1065,7 +1065,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3, temp_33_4 + temp_33_1, temp_33_2, temp_33_3 real(pReal), dimension(3,3,3,3) :: dSdFe, & dSdF, & dSdFi, & @@ -1160,21 +1160,20 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) - temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(temp_33_2) + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & - + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo end function crystallite_stressTangent From f08fbbaaa29658c17435794987b14063a4ca847c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Dec 2020 22:33:04 +0100 Subject: [PATCH 135/214] consistent names --- src/constitutive.f90 | 2 +- src/constitutive_mech.f90 | 34 +++++++++++++++++----------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f69ae604c..b7e587f51 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -872,7 +872,7 @@ subroutine crystallite_init crystallite_F0,crystallite_Lp0, & crystallite_partitionedS0, & crystallite_partitionedF0,& - crystallite_partitionedLp0, & + crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & crystallite_subFp0,crystallite_subFi0, & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 96dc9809a..158ed098e 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -966,13 +966,13 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) NiterationState, & !< number of iterations in state loop ph, & me, & - size_pl + sizeDotState real(pReal) :: & zeta real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState + dotState ph = material_phaseAt(co,el) @@ -981,15 +981,15 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return - size_pl = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%subState0(1:size_pl,me) & - + plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plastic_dotState(1:size_pl,2) = 0.0_pReal + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + dotState(1:sizeDotState,2) = 0.0_pReal iteration: do NiterationState = 1, num%nState - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) + if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) + dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) broken = integrateStress(F,Delta_t,co,ip,el) if(broken) exit iteration @@ -997,16 +997,16 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) exit iteration - zeta = damper(plasticState(ph)%dotState(:,me),plastic_dotState(1:size_pl,1),& - plastic_dotState(1:size_pl,2)) + zeta = damper(plasticState(ph)%dotState(:,me),dotState(1:sizeDotState,1),& + dotState(1:sizeDotState,2)) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & - + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(ph)%state (1:size_pl,me) & - - plasticState(ph)%subState0(1:size_pl,me) & - - plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - - r(1:size_pl) - if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then + + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) + r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & + - plasticState(ph)%subState0(1:sizeDotState,me) & + - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & + - r(1:sizeDotState) + if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration From f560b33db0a727423ee48b30a22a5a86e60e7c0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:13:49 +0100 Subject: [PATCH 136/214] avoid global variables --- src/constitutive.f90 | 11 ++-- src/constitutive_mech.f90 | 108 +++++++++++++++++++++----------------- 2 files changed, 65 insertions(+), 54 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index b7e587f51..808870059 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -49,8 +49,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc @@ -748,7 +746,6 @@ subroutine constitutive_allocateState(state, & allocate(state%atol (sizeState), source=0.0_pReal) allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) @@ -875,7 +872,6 @@ subroutine crystallite_init crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subFp0,crystallite_subFi0, & source = crystallite_F) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) @@ -936,6 +932,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + do so = 1, phase_Nsources(ph) + allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack + enddo enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -1095,8 +1094,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) - invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) - invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) + invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) + invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) if (sum(abs(dLidS)) < tol_math_check) then dFidS = 0.0_pReal diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 158ed098e..11ced6f40 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -737,9 +737,9 @@ end subroutine mech_results !> @brief calculation of stress (P) with time integration based on a residuum in Lp and !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- -function integrateStress(F,Delta_t,co,ip,el) result(broken) +function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) - real(pReal), dimension(3,3), intent(in) :: F + real(pReal), dimension(3,3), intent(in) :: F,subFp0,subFi0 real(pReal), intent(in) :: Delta_t integer, intent(in):: el, & ! element index ip, & ! integration point index @@ -808,9 +808,9 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess - call math_invert33(invFp_current,devNull,error,crystallite_subFp0(1:3,1:3,co,ip,el)) + call math_invert33(invFp_current,devNull,error,subFp0) if (error) return ! error - call math_invert33(invFi_current,devNull,error,crystallite_subFi0(1:3,1:3,co,ip,el)) + call math_invert33(invFi_current,devNull,error,subFi0) if (error) return ! error A = matmul(F,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp @@ -951,9 +951,10 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -982,7 +983,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t dotState(1:sizeDotState,2) = 0.0_pReal @@ -991,7 +992,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) exit iteration broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) @@ -1002,7 +1003,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & - - plasticState(ph)%subState0(1:sizeDotState,me) & + - subState0 & - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & - r(1:sizeDotState) @@ -1042,9 +1043,10 @@ end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1066,14 +1068,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) if(broken) return sizeDotState = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + + plasticState(ph)%dotState(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateEuler @@ -1081,9 +1083,10 @@ end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop @@ -1108,14 +1111,14 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) sizeDotState = plasticState(ph)%sizeDotState residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) if(broken) return broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) @@ -1131,9 +1134,10 @@ end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRK4(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1150,7 +1154,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1158,9 +1162,10 @@ end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) +function integrateStateRKCK45(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el logical :: broken @@ -1184,7 +1189,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1193,9 +1198,10 @@ end function integrateStateRKCK45 !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) +function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,DB) result(broken) - real(pReal), intent(in),dimension(3,3) :: F_0,F + real(pReal), intent(in),dimension(3,3) :: F_0,F,subFp0,subFi0 + real(pReal), intent(in),dimension(:) :: subState0 real(pReal), intent(in) :: Delta_t real(pReal), dimension(:,:), intent(in) :: A real(pReal), dimension(:), intent(in) :: B, C @@ -1233,10 +1239,10 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t - broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),Delta_t * C(stage),co,ip,el) + broken = integrateStress(F_0 + (F - F_0) * Delta_t * C(stage),subFp0,subFi0,Delta_t * C(stage),co,ip,el) if(broken) exit broken = mech_collectDotState(Delta_t*C(stage),co,ip,el,ph,me) @@ -1248,7 +1254,7 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) - plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t if(present(DB)) & @@ -1262,7 +1268,7 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) if(broken) return - broken = integrateStress(F,Delta_t,co,ip,el) + broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) end function integrateStateRK @@ -1487,33 +1493,40 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - so, ph, me + so, ph, me, sizeDotState logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & - subLp0, & !< plastic velocity grad at start of crystallite inc - subLi0, & !< intermediate velocity grad at start of crystallite inc + subFp0, & + subFi0, & + subLp0, & + subLi0, & subF0, & subF + real(pReal), dimension(:), allocatable :: subState0 ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + sizeDotState = plasticState(ph)%sizeDotState + subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + subState0 = plasticState(ph)%partitionedState0(:,me) + - plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) + subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) + subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. converged_ = .false. ! pretend failed step of 1/subStepSizeCryst + crystallite_subdt(co,ip,el) = dt todo = .true. NiterationCrystallite = 0 cutbackLooping: do while (todo) @@ -1532,9 +1545,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subF0 = subF subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) - crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) - crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) + subFp0 = constitutive_mech_Fp(ph)%data(1:3,1:3,me) + subFi0 = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + subState0 = plasticState(ph)%state(:,me) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo @@ -1543,14 +1556,14 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! cut back (reduced time and restore) else subStep = num%subStepSizeCryst * subStep - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = crystallite_subFp0(1:3,1:3,co,ip,el) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = crystallite_subFi0(1:3,1:3,co,ip,el) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) - if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 - constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = subFp0 + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 + crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + if (subStep < 1.0_pReal) then ! actual (not initial) cutback + crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) + plasticState(ph)%state(:,me) = subState0 do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo @@ -1565,8 +1578,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) - crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) + converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From 2791f3d192da8179f3f980aa56bbcbd9ddb3beb6 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 29 Dec 2020 00:33:12 +0100 Subject: [PATCH 137/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-101-gab2a4a987 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 616042312..cb10a9c4f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-97-g10bbeb561 +v3.0.0-alpha2-101-gab2a4a987 From 5f569b14121f49d421670c394dbaf2e5d3cfdae8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:39:23 +0100 Subject: [PATCH 138/214] explicit arguments instead of global variables --- src/constitutive.f90 | 13 +++++-------- src/constitutive_mech.f90 | 1 - src/homogenization.f90 | 5 +++-- src/homogenization_mech.f90 | 12 +++++++----- 4 files changed, 15 insertions(+), 16 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 808870059..fe09b3662 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -42,8 +42,7 @@ module constitutive KINEMATICS_SLIPPLANE_OPENING_ID, & KINEMATICS_THERMAL_EXPANSION_ID end enum - real(pReal), dimension(:,:,:), allocatable :: & - crystallite_subdt !< substepped time increment of each grain + type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & @@ -874,7 +873,6 @@ subroutine crystallite_init crystallite_Fe,crystallite_Lp, & source = crystallite_F) - allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -1103,11 +1101,11 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal do o=1,3; do p=1,3 lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) + + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + invFi*invFi(p,o) rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - crystallite_subdt(co,ip,el)*matmul(invSubFi0,dLidS(1:3,1:3,o,p)) + - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt enddo; enddo call math_invert(temp_99,error,math_3333to99(lhs_3333)) if (error) then @@ -1136,7 +1134,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) enddo; enddo - lhs_3333 = crystallite_subdt(co,ip,el)*math_mul3333xx3333(dSdFe,temp_3333) & + lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & + math_mul3333xx3333(dSdFi,dFidS) call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) @@ -1152,8 +1150,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) ! calculate dFpinvdF temp_3333 = math_mul3333xx3333(dLpdS,dSdF) do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = -crystallite_subdt(co,ip,el) & - * matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) + dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt enddo; enddo !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 11ced6f40..7c819c480 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1526,7 +1526,6 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) todo = .true. converged_ = .false. ! pretend failed step of 1/subStepSizeCryst - crystallite_subdt(co,ip,el) = dt todo = .true. NiterationCrystallite = 0 cutbackLooping: do while (todo) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 52553b57b..d61fa57e8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -63,7 +63,8 @@ module homogenization el !< element number end subroutine mech_partition - module subroutine mech_homogenize(ip,el) + module subroutine mech_homogenize(dt,ip,el) + real(pReal), intent(in) :: dt integer, intent(in) :: & ip, & !< integration point el !< element number @@ -257,7 +258,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE do co = 1, myNgrains call crystallite_orientations(co,ip,el) enddo - call mech_homogenize(ip,el) + call mech_homogenize(dt,ip,el) enddo IpLooping3 enddo elementLooping3 !$OMP END PARALLEL DO diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 641e960fd..e3e9cfb3e 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -138,11 +138,13 @@ end subroutine mech_partition !-------------------------------------------------------------------------------------------------- !> @brief Average P and dPdF from the individual constituents. !-------------------------------------------------------------------------------------------------- -module subroutine mech_homogenize(ip,el) +module subroutine mech_homogenize(dt,ip,el) + real(pReal), intent(in) :: dt integer, intent(in) :: & ip, & !< integration point el !< element number + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) @@ -152,11 +154,11 @@ module subroutine mech_homogenize(ip,el) case (HOMOGENIZATION_NONE_ID) chosenHomogenization homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -167,7 +169,7 @@ module subroutine mech_homogenize(ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -202,7 +204,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & From 6bba7a509aa85f773c96703c21b258a9d1740192 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 00:44:42 +0100 Subject: [PATCH 139/214] polishing --- src/constitutive.f90 | 5 +++-- src/constitutive_mech.f90 | 19 ++++++++----------- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index fe09b3662..f3f731cc6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1049,13 +1049,14 @@ end subroutine constitutive_windForward !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(co,ip,el) result(dPdF) +function crystallite_stressTangent(dt,co,ip,el) result(dPdF) - real(pReal), dimension(3,3,3,3) :: dPdF + real(pReal), intent(in) :: dt integer, intent(in) :: & co, & !< counter in constituent loop ip, & !< counter in integration point loop el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF integer :: & o, & diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7c819c480..31f8d40cc 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1492,7 +1492,6 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal) :: & formerSubStep integer :: & - NiterationCrystallite, & ! number of iterations in crystallite loop so, ph, me, sizeDotState logical :: todo real(pReal) :: subFrac,subStep @@ -1527,12 +1526,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. - NiterationCrystallite = 0 cutbackLooping: do while (todo) - NiterationCrystallite = NiterationCrystallite + 1 -!-------------------------------------------------------------------------------------------------- -! wind forward if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep @@ -1596,19 +1591,21 @@ module subroutine mech_restore(ip,el,includeL) el !< element number logical, intent(in) :: & includeL !< protect agains fake cutback + integer :: & - co, p, m !< constituent number + co, ph, me + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) if (includeL) then crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + constitutive_mech_Li(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) endif ! maybe protecting everything from overwriting makes more sense - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & From 1b85dbea80521ab7e632c900447f893f8b478d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 06:14:39 +0100 Subject: [PATCH 140/214] polishing --- src/constitutive.f90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f3f731cc6..5ed5bbdb9 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1084,8 +1084,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me), & @@ -1120,8 +1120,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) endif call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- @@ -1166,10 +1166,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & - dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & - transpose(invFp)) & + + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo From 7992ef474e06673dd208613e75ef13ac87459022 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 07:20:37 +0100 Subject: [PATCH 141/214] preparing for non-global variables --- src/constitutive.f90 | 27 +++++++++++++++++++++++---- src/constitutive_thermal.f90 | 15 +++++++-------- src/thermal_conduction.f90 | 2 +- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5ed5bbdb9..584bae3aa 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -235,15 +235,12 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) + module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kitchoff stress vector - Lp !< plastic velocity gradient real(pReal), intent(inout) :: & TDot, & dTDot_dT @@ -392,6 +389,8 @@ module constitutive crystallite_push33ToRef, & crystallite_restartWrite, & integrateSourceState, & + constitutive_mech_getLp, & + constitutive_mech_getS, & crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & @@ -1427,4 +1426,24 @@ subroutine crystallite_restartRead end subroutine crystallite_restartRead +! getter for non-mech (e.g. thermal) +function constitutive_mech_getS(co,ip,el) result(S) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + + S = crystallite_S(1:3,1:3,co,ip,el) + +end function constitutive_mech_getS + +! getter for non-mech (e.g. thermal) +function constitutive_mech_getLp(co,ip,el) result(Lp) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + + Lp = crystallite_S(1:3,1:3,co,ip,el) + +end function constitutive_mech_getLp + end module constitutive diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index a7d5d3259..1e204a197 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -68,15 +68,13 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el) +module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & - T - real(pReal), intent(in), dimension(:,:,:,:,:) :: & - S, & !< current 2nd Piola Kirchhoff stress - Lp !< plastic velocity gradient + T !< plastic velocity gradient real(pReal), intent(inout) :: & TDot, & dTDot_dT @@ -84,6 +82,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, real(pReal) :: & my_Tdot, & my_dTdot_dT + real(pReal), dimension(3,3) :: Lp, S integer :: & phase, & homog, & @@ -101,10 +100,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) case (SOURCE_thermal_dissipation_ID) + Lp = constitutive_mech_getLp(grain,ip,el) + S = constitutive_mech_getS(grain,ip,el) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - S(1:3,1:3,grain,ip,el), & - Lp(1:3,1:3,grain,ip,el), & - phase) + S, Lp, phase) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index d30e50677..09997162c 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -94,7 +94,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) dTdot_dT = 0.0_pReal homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S,crystallite_Lp ,ip, el) + call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) From 22575b15ffecca26af8f8fd9eaa0c87b3b767179 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 07:34:25 +0100 Subject: [PATCH 142/214] new (ph,me)-based data layout --- src/constitutive.f90 | 40 +++++++++++++++++++++------------------ src/constitutive_mech.f90 | 20 +++++++++++--------- 2 files changed, 33 insertions(+), 27 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 584bae3aa..9d756f535 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -48,13 +48,10 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) - crystallite_Lp0, & !< plastic velocitiy grad at start of FE inc - crystallite_partitionedLp0, & !< plastic velocity grad at start of homog inc crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) crystallite_partitionedF0, & !< def grad at start of homog inc crystallite_F !< def grad to be reached at end of homog inc @@ -65,14 +62,17 @@ module constitutive type(tTensorContainer), dimension(:), allocatable :: & constitutive_mech_Fi, & - constitutive_mech_Fi0, & - constitutive_mech_partitionedFi0, & - constitutive_mech_Li, & - constitutive_mech_Li0, & - constitutive_mech_partitionedLi0, & constitutive_mech_Fp, & + constitutive_mech_Li, & + constitutive_mech_Lp, & + constitutive_mech_Fi0, & constitutive_mech_Fp0, & - constitutive_mech_partitionedFp0 + constitutive_mech_Li0, & + constitutive_mech_Lp0, & + constitutive_mech_partitionedFi0, & + constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedLi0, & + constitutive_mech_partitionedLp0 type :: tNumerics @@ -790,7 +790,6 @@ subroutine constitutive_forward integer :: i, j crystallite_F0 = crystallite_F - crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S call constitutive_mech_forward() @@ -864,12 +863,11 @@ subroutine crystallite_init allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & - crystallite_F0,crystallite_Lp0, & + crystallite_F0, & crystallite_partitionedS0, & crystallite_partitionedF0,& - crystallite_partitionedLp0, & crystallite_S,crystallite_P, & - crystallite_Fe,crystallite_Lp, & + crystallite_Fe, & source = crystallite_F) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -917,6 +915,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partitionedLi0(phases%length)) + allocate(constitutive_mech_partitionedLp0(phases%length)) + allocate(constitutive_mech_Lp0(phases%length)) + allocate(constitutive_mech_Lp(phases%length)) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs @@ -929,6 +930,9 @@ subroutine crystallite_init allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -1000,7 +1004,6 @@ subroutine constitutive_initializeRestorationPoints(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp0(1:3,1:3,co,ip,el) crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) @@ -1033,7 +1036,6 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) @@ -1354,7 +1356,6 @@ subroutine crystallite_restartWrite fileHandle = HDF5_openFile(fileName,'a') call HDF5_write(fileHandle,crystallite_F,'F') - call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') @@ -1365,6 +1366,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_L_i' call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_p' + call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) enddo @@ -1398,7 +1401,6 @@ subroutine crystallite_restartRead fileHandle = HDF5_openFile(fileName) call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_Lp0,'L_p') call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') @@ -1409,6 +1411,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_L_i' call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_p' + call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) enddo @@ -1442,7 +1446,7 @@ function constitutive_mech_getLp(co,ip,el) result(Lp) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: Lp - Lp = crystallite_S(1:3,1:3,co,ip,el) + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getLp diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 31f8d40cc..a6d1b76b6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -805,7 +805,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - Lpguess = crystallite_Lp(1:3,1:3,co,ip,el) ! take as first guess + Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess call math_invert33(invFp_current,devNull,error,subFp0) @@ -937,9 +937,9 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) crystallite_S (1:3,1:3,co,ip,el) = S - crystallite_Lp (1:3,1:3,co,ip,el) = Lpguess + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. @@ -1307,8 +1307,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& 'inelastic deformation gradient','1') case('L_p') - selected_tensors = select_tensors(crystallite_Lp,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,output_constituent(ph)%label(ou),& 'plastic velocity gradient','1/s') case('L_i') call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& @@ -1413,6 +1412,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) end subroutine mech_initializeRestorationPoints @@ -1429,6 +1429,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) @@ -1449,6 +1450,7 @@ module subroutine constitutive_mech_forward() constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) + constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) enddo end subroutine constitutive_mech_forward @@ -1510,7 +1512,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) sizeDotState = plasticState(ph)%sizeDotState subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) - subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + subLp0 = constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) subState0 = plasticState(ph)%partitionedState0(:,me) @@ -1537,7 +1539,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) if (todo) then subF0 = subF - subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) + subLp0 = constitutive_mech_Lp(ph)%data(1:3,1:3,me) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) subFp0 = constitutive_mech_Fp(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_Fi(ph)%data(1:3,1:3,me) @@ -1554,7 +1556,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) if (subStep < 1.0_pReal) then ! actual (not initial) cutback - crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif plasticState(ph)%state(:,me) = subState0 @@ -1600,7 +1602,7 @@ module subroutine mech_restore(ip,el,includeL) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + constitutive_mech_Lp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) constitutive_mech_Li(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) endif ! maybe protecting everything from overwriting makes more sense From 0d0a81a0165fd471c50e486b24cb90b529e7c0c5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 08:08:14 +0100 Subject: [PATCH 143/214] new structure --- src/constitutive.f90 | 18 ++++++++++-------- src/constitutive_mech.f90 | 9 ++++----- 2 files changed, 14 insertions(+), 13 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9d756f535..4b87c72e3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -47,7 +47,6 @@ module constitutive crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc - crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & @@ -61,6 +60,7 @@ module constitutive end type type(tTensorContainer), dimension(:), allocatable :: & + constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & constitutive_mech_Li, & @@ -867,7 +867,6 @@ subroutine crystallite_init crystallite_partitionedS0, & crystallite_partitionedF0,& crystallite_S,crystallite_P, & - crystallite_Fe, & source = crystallite_F) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -906,6 +905,7 @@ subroutine crystallite_init phases => config_material%get('phase') + allocate(constitutive_mech_Fe(phases%length)) allocate(constitutive_mech_Fi(phases%length)) allocate(constitutive_mech_Fi0(phases%length)) allocate(constitutive_mech_partitionedFi0(phases%length)) @@ -922,6 +922,7 @@ subroutine crystallite_init Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) @@ -956,9 +957,9 @@ subroutine crystallite_init crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - crystallite_Fe(1:3,1:3,co,ip,el) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) @@ -1085,7 +1086,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - crystallite_Fe(1:3,1:3,co,ip,el), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & @@ -1186,7 +1187,8 @@ subroutine crystallite_orientations(co,ip,el) el !< counter in element loop - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& + constitutive_mech_Fe(material_phaseAt(ip,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1289,7 +1291,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(constitutive_mech_Fe(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index a6d1b76b6..06afe64fb 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -941,7 +941,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new - crystallite_Fe (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),invFi_new) + constitutive_mech_Fe(ph)%data(1:3,1:3,me)= matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress @@ -1297,8 +1297,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') - selected_tensors = select_tensors(crystallite_Fe,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& 'elastic deformation gradient','1') case('F_p') call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& @@ -1572,8 +1571,8 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) if (todo) then subF = subF0 & + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif From e19ced830bc293ae81663eca778cc3e0606d1158 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 09:26:24 +0100 Subject: [PATCH 144/214] S and related quantities in new data layout --- src/constitutive.f90 | 62 +++++++++++++++++++++------------------ src/constitutive_mech.f90 | 43 +++++++++++++-------------- 2 files changed, 54 insertions(+), 51 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 4b87c72e3..37726ce2b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -46,12 +46,9 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0, & !< def grad at start of FE inc - crystallite_S0, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc - crystallite_partitionedS0 !< 2nd Piola-Kirchhoff stress vector at start of homog inc + crystallite_F0 !< def grad at start of FE inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) crystallite_partitionedF0, & !< def grad at start of homog inc crystallite_F !< def grad to be reached at end of homog inc @@ -60,19 +57,25 @@ module constitutive end type type(tTensorContainer), dimension(:), allocatable :: & + ! current value constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & constitutive_mech_Li, & constitutive_mech_Lp, & + constitutive_mech_S, & + ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & constitutive_mech_Li0, & constitutive_mech_Lp0, & + constitutive_mech_S0, & + ! converged value at end of last homogenization increment (RGC only) constitutive_mech_partitionedFi0, & constitutive_mech_partitionedFp0, & constitutive_mech_partitionedLi0, & - constitutive_mech_partitionedLp0 + constitutive_mech_partitionedLp0, & + constitutive_mech_partitionedS0 type :: tNumerics @@ -611,7 +614,7 @@ end subroutine constitutive_LiAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) +function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -619,8 +622,6 @@ function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) el, & !< element ph, & of - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola Kirchhoff stress (vector notation) integer :: & so !< counter in source loop logical :: broken @@ -633,7 +634,7 @@ function constitutive_damage_collectDotState(S, co, ip, el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(S, co, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(constitutive_mech_getS(co,ip,el), co, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) @@ -790,7 +791,6 @@ subroutine constitutive_forward integer :: i, j crystallite_F0 = crystallite_F - crystallite_S0 = crystallite_S call constitutive_mech_forward() @@ -860,14 +860,12 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_S0, & - crystallite_F0, & - crystallite_partitionedS0, & + allocate(crystallite_F0, & crystallite_partitionedF0,& - crystallite_S,crystallite_P, & - source = crystallite_F) + crystallite_F, & + source = crystallite_P) allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -918,6 +916,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(phases%length)) allocate(constitutive_mech_Lp0(phases%length)) allocate(constitutive_mech_Lp(phases%length)) + allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_S0(phases%length)) + allocate(constitutive_mech_partitionedS0(phases%length)) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs @@ -934,6 +935,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -1006,7 +1010,6 @@ subroutine constitutive_initializeRestorationPoints(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) - crystallite_partitionedS0(1:3,1:3,co,ip,el) = crystallite_S0(1:3,1:3,co,ip,el) call mech_initializeRestorationPoints(ph,me) @@ -1037,7 +1040,6 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1086,10 +1088,10 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - constitutive_mech_Fp(ph)%data(1:3,1:3,me), & + constitutive_mech_Fe(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_S(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) @@ -1122,7 +1124,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) endif call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - crystallite_S (1:3,1:3,co,ip,el), & + constitutive_mech_S(ph)%data(1:3,1:3,me), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS @@ -1158,9 +1160,9 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF - temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) + temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) - temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) dPdF = 0.0_pReal do p=1,3 @@ -1188,7 +1190,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_Fe(material_phaseAt(ip,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1253,7 +1255,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) return do so = 1, phase_Nsources(ph) @@ -1271,7 +1273,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) @@ -1358,7 +1360,6 @@ subroutine crystallite_restartWrite fileHandle = HDF5_openFile(fileName,'a') call HDF5_write(fileHandle,crystallite_F,'F') - call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1372,6 +1373,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_S' + call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1403,7 +1406,6 @@ subroutine crystallite_restartRead fileHandle = HDF5_openFile(fileName) call HDF5_read(fileHandle,crystallite_F0, 'F') - call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1417,6 +1419,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_F_p' call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_S' + call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1438,7 +1442,7 @@ function constitutive_mech_getS(co,ip,el) result(S) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: S - S = crystallite_S(1:3,1:3,co,ip,el) + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getS diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 06afe64fb..f8f4c5254 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -609,7 +609,7 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) instance = phase_plasticityInstance(ph) Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& - constitutive_mech_Fi(ph)%data(1:3,1:3,of)),crystallite_S(1:3,1:3,co,ip,el)) + constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) plasticityType: select case (phase_plasticity(ph)) @@ -642,7 +642,7 @@ end function mech_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) +function constitutive_deltaState(co, ip, el, ph, of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -650,19 +650,19 @@ function constitutive_deltaState(S, Fi, co, ip, el, ph, of) result(broken) el, & !< element ph, & of - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola Kirchhoff stress - Fi !< intermediate deformation gradient + logical :: & + broken + real(pReal), dimension(3,3) :: & Mp integer :: & instance, & myOffset, & mySize - logical :: & - broken + - Mp = matmul(matmul(transpose(Fi),Fi),S) + Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& + constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) instance = phase_plasticityInstance(ph) plasticityType: select case (phase_plasticity(ph)) @@ -936,7 +936,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) if (error) return ! error crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) - crystallite_S (1:3,1:3,co,ip,el) = S + constitutive_mech_S(ph)%data(1:3,1:3,me) = S constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize @@ -1008,8 +1008,7 @@ function integrateStateFPI(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) resul plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & - r(1:sizeDotState) if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) exit iteration endif @@ -1071,8 +1070,7 @@ function integrateStateEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el) res plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotState(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1114,8 +1112,7 @@ function integrateStateAdaptiveEuler(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip plasticState(ph)%state(1:sizeDotState,me) = subState0 & + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1264,8 +1261,7 @@ function integrateStateRK(F_0,F,subFp0,subFi0,subState0,Delta_t,co,ip,el,A,B,C,D if(broken) return - broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_deltaState(co,ip,el,ph,me) if(broken) return broken = integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) @@ -1316,8 +1312,7 @@ subroutine crystallite_results(group,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'First Piola-Kirchhoff stress','Pa') case('S') - selected_tensors = select_tensors(crystallite_S,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,output_constituent(ph)%label(ou),& 'Second Piola-Kirchhoff stress','Pa') case('O') select case(lattice_structure(ph)) @@ -1412,6 +1407,8 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) + plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state0(:,me) end subroutine mech_initializeRestorationPoints @@ -1429,6 +1426,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S(ph)%data(1:3,1:3,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) @@ -1445,11 +1443,12 @@ module subroutine constitutive_mech_forward() do ph = 1, size(plasticState) - plasticState(ph)%state0 = plasticState(ph)%state constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) + constitutive_mech_S0(ph) = constitutive_mech_S(ph) + plasticState(ph)%state0 = plasticState(ph)%state enddo end subroutine constitutive_mech_forward @@ -1553,7 +1552,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subStep = num%subStepSizeCryst * subStep constitutive_mech_Fp(ph)%data(1:3,1:3,me) = subFp0 constitutive_mech_Fi(ph)%data(1:3,1:3,me) = subFi0 - crystallite_S (1:3,1:3,co,ip,el) = crystallite_S0 (1:3,1:3,co,ip,el) + constitutive_mech_S(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) ! why no subS0 ? is S0 of any use? if (subStep < 1.0_pReal) then ! actual (not initial) cutback constitutive_mech_Lp(ph)%data(1:3,1:3,me) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 @@ -1607,7 +1606,7 @@ module subroutine mech_restore(ip,el,includeL) constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + constitutive_mech_S(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) From 120118695d37addac10811c83a814919a5e98bfb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 12:25:03 +0100 Subject: [PATCH 145/214] encapsulate data --- src/constitutive.f90 | 17 +++++++++++++++++ src/homogenization_mech.f90 | 21 ++++++++++++--------- src/homogenization_mech_RGC.f90 | 1 - 3 files changed, 29 insertions(+), 10 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 37726ce2b..de1b5017d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -392,6 +392,7 @@ module constitutive crystallite_push33ToRef, & crystallite_restartWrite, & integrateSourceState, & + constitutive_mech_setF, & constitutive_mech_getLp, & constitutive_mech_getS, & crystallite_restartRead, & @@ -1442,18 +1443,34 @@ function constitutive_mech_getS(co,ip,el) result(S) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: S + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getS + ! getter for non-mech (e.g. thermal) function constitutive_mech_getLp(co,ip,el) result(Lp) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: Lp + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) end function constitutive_mech_getLp + +! setter for homogenization +subroutine constitutive_mech_setF(F,co,ip,el) + + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + + + crystallite_F(1:3,1:3,co,ip,el) = F + !constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + +end subroutine constitutive_mech_setF + end module constitutive diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e3e9cfb3e..e5ad95449 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -112,26 +112,29 @@ module subroutine mech_partition(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number + + integer :: co + real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_F(1:3,1:3,1,ip,el) = subF + F(1:3,1:3,1) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF) + call mech_isostrain_partitionDeformation(F,subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(& - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - subF,& - ip, & - el) + call mech_RGC_partitionDeformation(F,subF,ip,el) end select chosenHomogenization + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + call constitutive_mech_setF(F(1:3,1:3,co),co,ip,el) + enddo + + end subroutine mech_partition diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 04ec73845..931540c2e 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -523,7 +523,6 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa integer, dimension (3) :: iGrain3,iGNghb3,nGDim real(pReal), dimension (3,3) :: gDef,nDef real(pReal), dimension (3) :: nVect,surfCorr - real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l real(pReal) :: muGrain,muGNghb,nDefNorm real(pReal), parameter :: & From a5cdc8433f8ebb5dddfc2053a043ec0e61cf966b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 13:01:33 +0100 Subject: [PATCH 146/214] better readable --- src/homogenization.f90 | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index d61fa57e8..e31089177 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -169,10 +169,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) - if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) + if (homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) + if (damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -185,10 +183,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) + if(homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) + if(damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -202,10 +198,8 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_restore(ip,el,subStep < 1.0_pReal) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) + if(homogState(ho)%sizeState > 0) homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) + if(damageState(ho)%sizeState > 0) damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] From 6ec120d0040ec60c81e46eacf349cd8117346700 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 14:54:58 +0100 Subject: [PATCH 147/214] simplified - no extra state - no extra argument at the cost of less output --- PRIVATE | 2 +- src/homogenization_mech.f90 | 6 ++---- src/homogenization_mech_RGC.f90 | 34 +++++---------------------------- 3 files changed, 8 insertions(+), 34 deletions(-) diff --git a/PRIVATE b/PRIVATE index 45ef93dbf..591964dcf 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 45ef93dbfa3e0e6fa830914b3632e188c308a099 +Subproject commit 591964dcf8521d95f6cccbfe840d462c430e63d9 diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e5ad95449..db3412b8f 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -52,12 +52,11 @@ submodule(homogenization) homogenization_mech end subroutine mech_RGC_averageStressAndItsTangent - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment @@ -212,7 +211,6 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& subF,& subdt, & dPdFs, & diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index 931540c2e..580bb0268 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -24,9 +24,6 @@ submodule(homogenization:homogenization_mech) homogenization_mech_RGC end type tParameters type :: tRGCstate - real(pReal), pointer, dimension(:) :: & - work, & - penaltyEnergy real(pReal), pointer, dimension(:,:) :: & relaxationVector end type tRGCstate @@ -170,8 +167,7 @@ module subroutine mech_RGC_init(num_homogMech) nIntFaceTot = 3*( (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) & + prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) & + prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1)) - sizeState = nIntFaceTot & - + size(['avg constitutive work ','average penalty energy']) + sizeState = nIntFaceTot homogState(h)%sizeState = sizeState allocate(homogState(h)%state0 (sizeState,Nmaterialpoints), source=0.0_pReal) @@ -180,8 +176,6 @@ module subroutine mech_RGC_init(num_homogMech) stt%relaxationVector => homogState(h)%state(1:nIntFaceTot,:) st0%relaxationVector => homogState(h)%state0(1:nIntFaceTot,:) - stt%work => homogState(h)%state(nIntFaceTot+1,:) - stt%penaltyEnergy => homogState(h)%state(nIntFaceTot+2,:) allocate(dst%volumeDiscrepancy( Nmaterialpoints), source=0.0_pReal) allocate(dst%relaxationRate_avg( Nmaterialpoints), source=0.0_pReal) @@ -243,12 +237,11 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) +module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy) logical, dimension(2) :: doneAndHappy real(pReal), dimension(:,:,:), intent(in) :: & P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients + F !< partitioned deformation gradients real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses real(pReal), dimension(3,3), intent(in) :: avgF !< average F real(pReal), intent(in) :: dt !< time increment @@ -287,8 +280,8 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa !-------------------------------------------------------------------------------------------------- ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster - allocate(resid(3*nIntFaceTot), source=0.0_pReal) - allocate(tract(nIntFaceTot,3), source=0.0_pReal) + allocate(resid(3*nIntFaceTot), source=0.0_pReal) + allocate(tract(nIntFaceTot,3), source=0.0_pReal) relax = stt%relaxationVector(:,of) drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of) @@ -346,17 +339,6 @@ module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHa if (residMax < num%rtol*stresMax .or. residMax < num%atol) then doneAndHappy = .true. -!-------------------------------------------------------------------------------------------------- -! compute/update the state for postResult, i.e., all energy densities computed by time-integration - do iGrain = 1,product(prm%N_constituents) - do i = 1,3;do j = 1,3 - stt%work(of) = stt%work(of) & - + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - stt%penaltyEnergy(of) = stt%penaltyEnergy(of) & - + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal) - enddo; enddo - enddo - dst%mismatch(1:3,of) = sum(NN,2)/real(nGrain,pReal) dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal) dst%relaxationRate_max(of) = maxval(abs(drelax))/dt @@ -754,15 +736,9 @@ module subroutine mech_RGC_results(instance,group) associate(stt => state(instance), dst => dependentState(instance), prm => param(instance)) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) - case('W') - call results_writeDataset(group,stt%work,trim(prm%output(o)), & - 'work density','J/m³') case('M') call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), & 'average mismatch tensor','1') - case('R') - call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), & - 'mismatch penalty density','J/m³') case('Delta_V') call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), & 'volume discrepancy','m³') From 9e18e1d10a036e068ae603d08d11655fbf406318 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 15:44:45 +0100 Subject: [PATCH 148/214] need to be initialized --- src/constitutive.f90 | 6 +++--- src/constitutive_mech.f90 | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index de1b5017d..9ff84186c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -936,9 +936,9 @@ subroutine crystallite_init allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f8f4c5254..1b79f6d6a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -941,7 +941,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess constitutive_mech_Fp(ph)%data(1:3,1:3,me) = Fp_new / math_det33(Fp_new)**(1.0_pReal/3.0_pReal) ! regularize constitutive_mech_Fi(ph)%data(1:3,1:3,me) = Fi_new - constitutive_mech_Fe(ph)%data(1:3,1:3,me)= matmul(matmul(F,invFp_new),invFi_new) + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),invFi_new) broken = .false. end function integrateStress From e34937a0d21851308bd158a8ab017a2710829a9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 18:27:24 +0100 Subject: [PATCH 149/214] avoiding public variables --- src/constitutive.f90 | 94 ++++++++++++++------------- src/constitutive_mech.f90 | 66 +++++++++---------- src/constitutive_plastic_nonlocal.f90 | 20 ++---- src/homogenization_mech.f90 | 4 +- src/thermal_conduction.f90 | 25 ++++--- 5 files changed, 107 insertions(+), 102 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9ff84186c..59c3bf559 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -45,12 +45,8 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable :: & - crystallite_F0 !< def grad at start of FE inc real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_P, & !< 1st Piola-Kirchhoff stress per grain - crystallite_partitionedF0, & !< def grad at start of homog inc - crystallite_F !< def grad to be reached at end of homog inc + crystallite_P !< 1st Piola-Kirchhoff stress per grain type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -61,18 +57,21 @@ module constitutive constitutive_mech_Fe, & constitutive_mech_Fi, & constitutive_mech_Fp, & + constitutive_mech_F, & constitutive_mech_Li, & constitutive_mech_Lp, & constitutive_mech_S, & ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & + constitutive_mech_F0, & constitutive_mech_Li0, & constitutive_mech_Lp0, & constitutive_mech_S0, & ! converged value at end of last homogenization increment (RGC only) constitutive_mech_partitionedFi0, & constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedF0, & constitutive_mech_partitionedLi0, & constitutive_mech_partitionedLp0, & constitutive_mech_partitionedS0 @@ -339,13 +338,11 @@ module constitutive end subroutine constitutive_plastic_LpAndItsTangents - module subroutine constitutive_plastic_dependentState(F, co, ip, el) + module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< elastic deformation gradient end subroutine constitutive_plastic_dependentState @@ -394,6 +391,7 @@ module constitutive integrateSourceState, & constitutive_mech_setF, & constitutive_mech_getLp, & + constitutive_mech_getF, & constitutive_mech_getS, & crystallite_restartRead, & constitutive_initializeRestorationPoints, & @@ -789,15 +787,14 @@ end subroutine constitutive_restore !-------------------------------------------------------------------------------------------------- subroutine constitutive_forward - integer :: i, j - - crystallite_F0 = crystallite_F + integer :: ph, so + call constitutive_mech_forward() - do i = 1, size(sourceState) - do j = 1,phase_Nsources(i) - sourceState(i)%p(j)%state0 = sourceState(i)%p(j)%state + do ph = 1, size(sourceState) + do so = 1,phase_Nsources(ph) + sourceState(ph)%p(so)%state0 = sourceState(ph)%p(so)%state enddo; enddo end subroutine constitutive_forward @@ -862,12 +859,6 @@ subroutine crystallite_init eMax = discretization_Nelems allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) - - allocate(crystallite_F0, & - crystallite_partitionedF0,& - crystallite_F, & - source = crystallite_P) - allocate(crystallite_orientation(cMax,iMax,eMax)) @@ -911,6 +902,9 @@ subroutine crystallite_init allocate(constitutive_mech_Fp(phases%length)) allocate(constitutive_mech_Fp0(phases%length)) allocate(constitutive_mech_partitionedFp0(phases%length)) + allocate(constitutive_mech_F(phases%length)) + allocate(constitutive_mech_F0(phases%length)) + allocate(constitutive_mech_partitionedF0(phases%length)) allocate(constitutive_mech_Li(phases%length)) allocate(constitutive_mech_Li0(phases%length)) allocate(constitutive_mech_partitionedLi0(phases%length)) @@ -939,6 +933,9 @@ subroutine crystallite_init allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -955,28 +952,27 @@ subroutine crystallite_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & - / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 - - crystallite_F0(1:3,1:3,co,ip,el) = math_I3 - + constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) enddo enddo; enddo !$OMP END PARALLEL DO - crystallite_partitionedF0 = crystallite_F0 - crystallite_F = crystallite_F0 - !$OMP PARALLEL DO PRIVATE(ph,me) do el = 1, size(material_phaseMemberAt,3) @@ -985,7 +981,7 @@ subroutine crystallite_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) call crystallite_orientations(co,ip,el) - call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states + call constitutive_plastic_dependentState(co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo enddo @@ -1010,13 +1006,11 @@ subroutine constitutive_initializeRestorationPoints(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el) = crystallite_F0(1:3,1:3,co,ip,el) call mech_initializeRestorationPoints(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) + sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) enddo enddo @@ -1040,7 +1034,6 @@ subroutine constitutive_windForward(ip,el) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) @@ -1132,8 +1125,8 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) + temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1162,7 +1155,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) - temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) dPdF = 0.0_pReal @@ -1171,7 +1164,7 @@ function crystallite_stressTangent(dt,co,ip,el) result(dPdF) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo @@ -1207,17 +1200,17 @@ end subroutine crystallite_orientations function crystallite_push33ToRef(co,ip,el, tensor33) real(pReal), dimension(3,3), intent(in) :: tensor33 - real(pReal), dimension(3,3) :: T integer, intent(in):: & el, & ip, & co - real(pReal), dimension(3,3) :: crystallite_push33ToRef + + real(pReal), dimension(3,3) :: T T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) + transpose(math_inv33(constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1360,8 +1353,6 @@ subroutine crystallite_restartWrite write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') - call HDF5_write(fileHandle,crystallite_F,'F') - groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) write(datasetName,'(i0,a)') ph,'_omega' @@ -1376,6 +1367,8 @@ subroutine crystallite_restartWrite call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_S' call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F' + call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1406,8 +1399,6 @@ subroutine crystallite_restartRead write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName) - call HDF5_read(fileHandle,crystallite_F0, 'F') - groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) write(datasetName,'(i0,a)') ph,'_omega' @@ -1422,6 +1413,8 @@ subroutine crystallite_restartRead call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) write(datasetName,'(i0,a)') ph,'_S' call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F' + call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1461,6 +1454,18 @@ function constitutive_mech_getLp(co,ip,el) result(Lp) end function constitutive_mech_getLp +! getter for non-mech (e.g. thermal) +function constitutive_mech_getF(co,ip,el) result(F) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + + + F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF + + ! setter for homogenization subroutine constitutive_mech_setF(F,co,ip,el) @@ -1468,8 +1473,7 @@ subroutine constitutive_mech_setF(F,co,ip,el) integer, intent(in) :: co, ip, el - crystallite_F(1:3,1:3,co,ip,el) = F - !constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F end subroutine constitutive_mech_setF diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1b79f6d6a..1483e857c 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -184,12 +184,9 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_disloTungsten_dotState - module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - instance,of,ip,el) + module subroutine plastic_nonlocal_dotState(Mp,Temperature,timestep,instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -215,9 +212,7 @@ submodule(constitutive) constitutive_mech of end subroutine plastic_dislotungsten_dependentState - module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F !< deformation gradient + module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) integer, intent(in) :: & instance, & of, & @@ -480,32 +475,35 @@ end subroutine constitutive_hooke_SandItsTangents !-------------------------------------------------------------------------------------------------- !> @brief calls microstructure function of the different plasticity constitutive models !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_dependentState(F, co, ip, el) +module subroutine constitutive_plastic_dependentState(co, ip, el) integer, intent(in) :: & co, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(3,3) :: & - F !< deformation gradient integer :: & ho, & !< homogenization tme, & !< thermal member position - instance, of + instance, me + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) - of = material_phasememberAt(co,ip,el) + me = material_phasememberAt(co,ip,el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) + case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,me) + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_dependentState(instance,of) + call plastic_dislotungsten_dependentState(instance,me) + case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dependentState (F,instance,of,ip,el) + call plastic_nonlocal_dependentState(instance,me,ip,el) + end select plasticityType end subroutine constitutive_plastic_dependentState @@ -539,13 +537,13 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & ho, & !< homogenization tme !< thermal member position integer :: & - i, j, instance, of + i, j, instance, me ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) Mp = matmul(matmul(transpose(Fi),Fi),S) - of = material_phasememberAt(co,ip,el) + me = material_phasememberAt(co,ip,el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) @@ -555,22 +553,22 @@ module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & dLp_dMp = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_KINEHARDENING_ID) plasticityType - call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of) + call plastic_kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,me) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,of,ip,el) + call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, temperature(ho)%p(tme),instance,me,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,me) case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType - call plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,of) + call plastic_dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp,temperature(ho)%p(tme),instance,me) end select plasticityType @@ -586,7 +584,7 @@ end subroutine constitutive_plastic_LpAndItsTangents !-------------------------------------------------------------------------------------------------- !> @brief contains the constitutive equation for calculating the rate of change of microstructure !-------------------------------------------------------------------------------------------------- -function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) +function mech_collectDotState(subdt,co,ip,el,ph,of) result(broken) integer, intent(in) :: & co, & !< component-ID of integration point @@ -601,9 +599,9 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) integer :: & ho, & !< homogenization tme, & !< thermal member position - i, & !< counter in source loop instance logical :: broken + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(ph) @@ -629,8 +627,7 @@ function mech_collectDotState(subdt, co, ip, el,ph,of) result(broken) call plastic_disloTungsten_dotState(Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState(Mp,crystallite_partitionedF0,temperature(ho)%p(tme),subdt, & - instance,of,ip,el) + call plastic_nonlocal_dotState(Mp,temperature(ho)%p(tme),subdt,instance,of,ip,el) end select plasticityType broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,of))) @@ -798,12 +795,13 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) jacoCounterLi ! counters to check for Jacobian update logical :: error,broken - broken = .true. - call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) + broken = .true. ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + + call constitutive_plastic_dependentState(co,ip,el) Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess Liguess = constitutive_mech_Li(ph)%data(1:3,1:3,me) ! take as first guess @@ -1289,8 +1287,7 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_F,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& @@ -1405,6 +1402,7 @@ module subroutine mech_initializeRestorationPoints(ph,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S0(ph)%data(1:3,1:3,me) @@ -1424,6 +1422,7 @@ module subroutine constitutive_mech_windForward(ph,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) = constitutive_mech_Li(ph)%data(1:3,1:3,me) constitutive_mech_partitionedLp0(ph)%data(1:3,1:3,me) = constitutive_mech_Lp(ph)%data(1:3,1:3,me) constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) = constitutive_mech_S(ph)%data(1:3,1:3,me) @@ -1445,6 +1444,7 @@ module subroutine constitutive_mech_forward() do ph = 1, size(plasticState) constitutive_mech_Fi0(ph) = constitutive_mech_Fi(ph) constitutive_mech_Fp0(ph) = constitutive_mech_Fp(ph) + constitutive_mech_F0(ph) = constitutive_mech_F(ph) constitutive_mech_Li0(ph) = constitutive_mech_Li(ph) constitutive_mech_Lp0(ph) = constitutive_mech_Lp(ph) constitutive_mech_S0(ph) = constitutive_mech_S(ph) @@ -1519,7 +1519,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) enddo subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) - subF0 = crystallite_partitionedF0(1:3,1:3,co,ip,el) + subF0 = constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. @@ -1569,7 +1569,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) ! prepare for integration if (todo) then subF = subF0 & - + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) + + subStep * (constitutive_mech_F(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me)) constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) diff --git a/src/constitutive_plastic_nonlocal.f90 b/src/constitutive_plastic_nonlocal.f90 index 0d7875291..2244eb7ad 100644 --- a/src/constitutive_plastic_nonlocal.f90 +++ b/src/constitutive_plastic_nonlocal.f90 @@ -552,10 +552,8 @@ end function plastic_nonlocal_init !-------------------------------------------------------------------------------------------------- !> @brief calculates quantities characterizing the microstructure !-------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) +module subroutine plastic_nonlocal_dependentState(instance, of, ip, el) - real(pReal), dimension(3,3), intent(in) :: & - F integer, intent(in) :: & instance, & of, & @@ -647,7 +645,7 @@ module subroutine plastic_nonlocal_dependentState(F, instance, of, ip, el) ph = material_phaseAt(1,el) me = material_phaseMemberAt(1,ip,el) invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFe = matmul(constitutive_mech_Fp(ph)%data(1:3,1:3,me),math_inv33(F)) + invFe = math_inv33(constitutive_mech_Fe(ph)%data(1:3,1:3,me)) rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg) rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg) @@ -976,13 +974,11 @@ end subroutine plastic_nonlocal_deltaState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & +module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, & instance,of,ip,el) real(pReal), dimension(3,3), intent(in) :: & Mp !< MandelStress - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & Temperature, & !< temperature timestep !< substepped crystallite time increment @@ -1149,7 +1145,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Temperature,timestep, & - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) & - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have - rhoDot = rhoDotFlux(F,timestep, instance,of,ip,el) & + rhoDot = rhoDotFlux(timestep, instance,of,ip,el) & + rhoDotMultiplication & + rhoDotSingle2DipoleGlide & + rhoDotAthermalAnnihilation & @@ -1178,10 +1174,8 @@ end subroutine plastic_nonlocal_dotState !--------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !--------------------------------------------------------------------------------------------------- -function rhoDotFlux(F,timestep, instance,of,ip,el) +function rhoDotFlux(timestep,instance,of,ip,el) - real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: & - F !< Deformation gradient real(pReal), intent(in) :: & timestep !< substepped crystallite time increment integer, intent(in) :: & @@ -1293,7 +1287,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) m(1:3,:,3) = -prm%slip_transverse m(1:3,:,4) = prm%slip_transverse - my_F = F(1:3,1:3,1,ip,el) + my_F = constitutive_mech_F(ph)%data(1:3,1:3,of) my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of))) neighbors: do n = 1,nIPneighbors @@ -1311,7 +1305,7 @@ function rhoDotFlux(F,timestep, instance,of,ip,el) if (neighbor_n > 0) then ! if neighbor exists, average deformation gradient neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el)) - neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el) + neighbor_F = constitutive_mech_F(np)%data(1:3,1:3,no) neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no))) Favg = 0.5_pReal * (my_F + neighbor_F) else ! if no neighbor, take my value as average diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index db3412b8f..4a9e1856f 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -202,15 +202,17 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) + Fs(:,:,co) = constitutive_mech_getF(co,ip,el) enddo doneAndHappy = & mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + Fs, & subF,& subdt, & dPdFs, & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 09997162c..f98d36d3b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -112,14 +112,16 @@ function thermal_conduction_getConductivity(ip,el) el !< element number real(pReal), dimension(3,3) :: & thermal_conduction_getConductivity + integer :: & - grain + co thermal_conduction_getConductivity = 0.0_pReal - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getConductivity = thermal_conduction_getConductivity + & - crystallite_push33ToRef(grain,ip,el,lattice_K(:,:,material_phaseAt(grain,el))) + crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el))) enddo thermal_conduction_getConductivity = thermal_conduction_getConductivity & @@ -138,14 +140,16 @@ function thermal_conduction_getSpecificHeat(ip,el) el !< element number real(pReal) :: & thermal_conduction_getSpecificHeat + integer :: & - grain + co + thermal_conduction_getSpecificHeat = 0.0_pReal - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & - + lattice_c_p(material_phaseAt(grain,el)) + + lattice_c_p(material_phaseAt(co,el)) enddo thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat & @@ -164,15 +168,16 @@ function thermal_conduction_getMassDensity(ip,el) el !< element number real(pReal) :: & thermal_conduction_getMassDensity + integer :: & - grain + co + thermal_conduction_getMassDensity = 0.0_pReal - - do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & - + lattice_rho(material_phaseAt(grain,el)) + + lattice_rho(material_phaseAt(co,el)) enddo thermal_conduction_getMassDensity = thermal_conduction_getMassDensity & From 8572ec836812cfebfed77055a1237846828efb87 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 18:45:11 +0100 Subject: [PATCH 150/214] preparing encapsulation --- src/constitutive.f90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 59c3bf559..e39a0df2e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -1466,6 +1466,22 @@ function constitutive_mech_getF(co,ip,el) result(F) end function constitutive_mech_getF +! getter for non-thermal (e.g. mech) +function constitutive_thermal_T(co,ip,el) result(T) + + integer, intent(in) :: co, ip, el + real(pReal) :: T + + integer :: ho, tme + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + + T = temperature(ho)%p(tme) + +end function constitutive_thermal_T + + ! setter for homogenization subroutine constitutive_mech_setF(F,co,ip,el) From 39287ae61fcca9c84c2e6d5eba49cc79974124a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 19:02:22 +0100 Subject: [PATCH 151/214] distribute responsibilities --- src/constitutive.f90 | 69 ----------------------------------- src/constitutive_mech.f90 | 76 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 75 insertions(+), 70 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e39a0df2e..261e9e304 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -830,7 +830,6 @@ end subroutine constitutive_results subroutine crystallite_init integer :: & - Nconstituents, & ph, & me, & co, & !< counter in integration point component loop @@ -861,7 +860,6 @@ subroutine crystallite_init allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) @@ -895,47 +893,7 @@ subroutine crystallite_init phases => config_material%get('phase') - allocate(constitutive_mech_Fe(phases%length)) - allocate(constitutive_mech_Fi(phases%length)) - allocate(constitutive_mech_Fi0(phases%length)) - allocate(constitutive_mech_partitionedFi0(phases%length)) - allocate(constitutive_mech_Fp(phases%length)) - allocate(constitutive_mech_Fp0(phases%length)) - allocate(constitutive_mech_partitionedFp0(phases%length)) - allocate(constitutive_mech_F(phases%length)) - allocate(constitutive_mech_F0(phases%length)) - allocate(constitutive_mech_partitionedF0(phases%length)) - allocate(constitutive_mech_Li(phases%length)) - allocate(constitutive_mech_Li0(phases%length)) - allocate(constitutive_mech_partitionedLi0(phases%length)) - allocate(constitutive_mech_partitionedLp0(phases%length)) - allocate(constitutive_mech_Lp0(phases%length)) - allocate(constitutive_mech_Lp(phases%length)) - allocate(constitutive_mech_S(phases%length)) - allocate(constitutive_mech_S0(phases%length)) - allocate(constitutive_mech_partitionedS0(phases%length)) do ph = 1, phases%length - Nconstituents = count(material_phaseAt == ph) * discretization_nIPs - - allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) - allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) - allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo @@ -946,33 +904,6 @@ subroutine crystallite_init print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax flush(IO_STDOUT) - !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) - do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) - constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & - / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) - constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 - constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 - - constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration - constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) - - constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) - - enddo - enddo; enddo - !$OMP END PARALLEL DO - !$OMP PARALLEL DO PRIVATE(ph,me) do el = 1, size(material_phaseMemberAt,3) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 1483e857c..fa9a5eda6 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -297,8 +297,13 @@ contains module subroutine mech_init integer :: & + el, & + ip, & + co, & ph, & - stiffDegradationCtr + me, & + stiffDegradationCtr, & + Nconstituents class(tNode), pointer :: & num_crystallite, & phases, & @@ -317,7 +322,49 @@ module subroutine mech_init allocate(phase_NstiffnessDegradations(phases%length),source=0) allocate(output_constituent(phases%length)) + allocate(constitutive_mech_Fe(phases%length)) + allocate(constitutive_mech_Fi(phases%length)) + allocate(constitutive_mech_Fi0(phases%length)) + allocate(constitutive_mech_partitionedFi0(phases%length)) + allocate(constitutive_mech_Fp(phases%length)) + allocate(constitutive_mech_Fp0(phases%length)) + allocate(constitutive_mech_partitionedFp0(phases%length)) + allocate(constitutive_mech_F(phases%length)) + allocate(constitutive_mech_F0(phases%length)) + allocate(constitutive_mech_partitionedF0(phases%length)) + allocate(constitutive_mech_Li(phases%length)) + allocate(constitutive_mech_Li0(phases%length)) + allocate(constitutive_mech_partitionedLi0(phases%length)) + allocate(constitutive_mech_partitionedLp0(phases%length)) + allocate(constitutive_mech_Lp0(phases%length)) + allocate(constitutive_mech_Lp(phases%length)) + allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_S0(phases%length)) + allocate(constitutive_mech_partitionedS0(phases%length)) + do ph = 1, phases%length + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs + + allocate(constitutive_mech_Fi(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fe(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Fp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedFp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Li0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLi0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedLp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) + allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) @@ -350,6 +397,33 @@ module subroutine mech_init enddo endif + !$OMP PARALLEL DO PRIVATE(ph,me) + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & + / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) + constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 + constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 + + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration + constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_F(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) + + constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) + constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) = constitutive_mech_F0(ph)%data(1:3,1:3,me) + + enddo + enddo; enddo + !$OMP END PARALLEL DO + ! initialize plasticity allocate(plasticState(phases%length)) From 6a6256dd34e847c89df9776dda9df6147ffc36be Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 29 Dec 2020 21:31:22 +0100 Subject: [PATCH 152/214] separate functionality --- src/CPFEM2.f90 | 28 +++++- src/constitutive.f90 | 173 +++++------------------------------- src/constitutive_mech.f90 | 127 ++++++++++++++++++++++++++ src/homogenization_mech.f90 | 8 +- 4 files changed, 179 insertions(+), 157 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 5a500875d..b1e03659b 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -74,9 +74,22 @@ end subroutine CPFEM_initAll !-------------------------------------------------------------------------------------------------- subroutine CPFEM_init + integer(HID_T) :: fileHandle + character(len=pStringLen) :: fileName + + print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT) - if (interface_restartInc > 0) call crystallite_restartRead + + if (interface_restartInc > 0) then + print'(/,a,i0,a)', ' reading restart information of increment from file'; flush(IO_STDOUT) + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName) + + call constitutive_restartRead(fileHandle) + + call HDF5_closeFile(fileHandle) + endif end subroutine CPFEM_init @@ -85,8 +98,19 @@ end subroutine CPFEM_init !> @brief Write restart information. !-------------------------------------------------------------------------------------------------- subroutine CPFEM_restartWrite + + integer(HID_T) :: fileHandle + character(len=pStringLen) :: fileName + - call crystallite_restartWrite + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) + + write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' + fileHandle = HDF5_openFile(fileName,'a') + + call constitutive_restartWrite(fileHandle) + + call HDF5_closeFile(fileHandle) end subroutine CPFEM_restartWrite diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 261e9e304..67e8b33c8 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -184,6 +184,15 @@ module constitutive includeL end subroutine mech_restore + module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ip, & !< counter in integration point loop + el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF + end function constitutive_mech_dPdF + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -384,16 +393,16 @@ module constitutive converged, & crystallite_init, & crystallite_stress, & - crystallite_stressTangent, & + constitutive_mech_dPdF, & crystallite_orientations, & crystallite_push33ToRef, & - crystallite_restartWrite, & + constitutive_restartWrite, & + constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & constitutive_mech_getLp, & constitutive_mech_getF, & constitutive_mech_getS, & - crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & PLASTICITY_UNDEFINED_ID, & @@ -975,134 +984,6 @@ subroutine constitutive_windForward(ip,el) end subroutine constitutive_windForward -!-------------------------------------------------------------------------------------------------- -!> @brief Calculate tangent (dPdF). -!-------------------------------------------------------------------------------------------------- -function crystallite_stressTangent(dt,co,ip,el) result(dPdF) - - real(pReal), intent(in) :: dt - integer, intent(in) :: & - co, & !< counter in constituent loop - ip, & !< counter in integration point loop - el !< counter in element loop - real(pReal), dimension(3,3,3,3) :: dPdF - - integer :: & - o, & - p, ph, me - real(pReal), dimension(3,3) :: devNull, & - invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3 - real(pReal), dimension(3,3,3,3) :: dSdFe, & - dSdF, & - dSdFi, & - dLidS, & ! tangent in lattice configuration - dLidFi, & - dLpdS, & - dLpdFi, & - dFidS, & - dFpinvdF, & - rhs_3333, & - lhs_3333, & - temp_3333 - real(pReal), dimension(9,9):: temp_99 - logical :: error - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & - constitutive_mech_Fe(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & - constitutive_mech_S(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - co,ip,el) - - invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) - invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) - invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) - invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) - - if (sum(abs(dLidS)) < tol_math_check) then - dFidS = 0.0_pReal - else - lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal - do o=1,3; do p=1,3 - lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & - + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt - lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & - + invFi*invFi(p,o) - rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & - - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt - enddo; enddo - call math_invert(temp_99,error,math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dFidS = 0.0_pReal - else - dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS - endif - - call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & - constitutive_mech_S(ph)%data(1:3,1:3,me), & - constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) - dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS - -!-------------------------------------------------------------------------------------------------- -! calculate dSdF - temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) - temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) - - do o=1,3; do p=1,3 - rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) - temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & - + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) - enddo; enddo - lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & - + math_mul3333xx3333(dSdFi,dFidS) - - call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) - if (error) then - call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & - ext_msg='inversion error in analytic tangent calculation') - dSdF = rhs_3333 - else - dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) - endif - -!-------------------------------------------------------------------------------------------------- -! calculate dFpinvdF - temp_3333 = math_mul3333xx3333(dLpdS,dSdF) - do o=1,3; do p=1,3 - dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! assemble dPdF - temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) - temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) - temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) - - dPdF = 0.0_pReal - do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) - enddo - do o=1,3; do p=1,3 - dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & - + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo; enddo - -end function crystallite_stressTangent - - !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- @@ -1273,16 +1154,12 @@ end function converged !> @brief Write current restart information (Field and constitutive data) to file. ! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively !-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartWrite +subroutine constitutive_restartWrite(fileHandle) + integer(HID_T), intent(in) :: fileHandle integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName - - print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName,'a') + integer(HID_T) :: groupHandle + character(len=pStringLen) :: datasetName groupHandle = HDF5_addGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1310,25 +1187,21 @@ subroutine crystallite_restartWrite enddo call HDF5_closeGroup(groupHandle) - call HDF5_closeFile(fileHandle) -end subroutine crystallite_restartWrite +end subroutine constitutive_restartWrite !-------------------------------------------------------------------------------------------------- !> @brief Read data for restart ! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively !-------------------------------------------------------------------------------------------------- -subroutine crystallite_restartRead +subroutine constitutive_restartRead(fileHandle) + integer(HID_T), intent(in) :: fileHandle integer :: ph - integer(HID_T) :: fileHandle, groupHandle - character(len=pStringLen) :: fileName, datasetName + integer(HID_T) :: groupHandle + character(len=pStringLen) ::datasetName - print'(/,a,i0,a)', ' reading restart information of increment from file' - - write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' - fileHandle = HDF5_openFile(fileName) groupHandle = HDF5_openGroup(fileHandle,'phase') do ph = 1,size(material_name_phase) @@ -1356,9 +1229,7 @@ subroutine crystallite_restartRead enddo call HDF5_closeGroup(groupHandle) - call HDF5_closeFile(fileHandle) - -end subroutine crystallite_restartRead +end subroutine constitutive_restartRead ! getter for non-mech (e.g. thermal) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fa9a5eda6..6392fb0ee 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1688,5 +1688,132 @@ module subroutine mech_restore(ip,el,includeL) end subroutine mech_restore +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate tangent (dPdF). +!-------------------------------------------------------------------------------------------------- +module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + co, & !< counter in constituent loop + ip, & !< counter in integration point loop + el !< counter in element loop + real(pReal), dimension(3,3,3,3) :: dPdF + + integer :: & + o, & + p, ph, me + real(pReal), dimension(3,3) :: devNull, & + invSubFp0,invSubFi0,invFp,invFi, & + temp_33_1, temp_33_2, temp_33_3 + real(pReal), dimension(3,3,3,3) :: dSdFe, & + dSdF, & + dSdFi, & + dLidS, & ! tangent in lattice configuration + dLidFi, & + dLpdS, & + dLpdFi, & + dFidS, & + dFpinvdF, & + rhs_3333, & + lhs_3333, & + temp_3333 + real(pReal), dimension(9,9):: temp_99 + logical :: error + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & + constitutive_mech_Fe(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & + constitutive_mech_S(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + co,ip,el) + + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) + invSubFp0 = math_inv33(constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me)) + invSubFi0 = math_inv33(constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me)) + + if (sum(abs(dLidS)) < tol_math_check) then + dFidS = 0.0_pReal + else + lhs_3333 = 0.0_pReal; rhs_3333 = 0.0_pReal + do o=1,3; do p=1,3 + lhs_3333(1:3,1:3,o,p) = lhs_3333(1:3,1:3,o,p) & + + matmul(invSubFi0,dLidFi(1:3,1:3,o,p)) * dt + lhs_3333(1:3,o,1:3,p) = lhs_3333(1:3,o,1:3,p) & + + invFi*invFi(p,o) + rhs_3333(1:3,1:3,o,p) = rhs_3333(1:3,1:3,o,p) & + - matmul(invSubFi0,dLidS(1:3,1:3,o,p)) * dt + enddo; enddo + call math_invert(temp_99,error,math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dFidS = 0.0_pReal + else + dFidS = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + dLidS = math_mul3333xx3333(dLidFi,dFidS) + dLidS + endif + + call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & + constitutive_mech_S(ph)%data(1:3,1:3,me), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) + dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS + +!-------------------------------------------------------------------------------------------------- +! calculate dSdF + temp_33_1 = transpose(matmul(invFp,invFi)) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invSubFp0) + temp_33_3 = matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp), invSubFi0) + + do o=1,3; do p=1,3 + rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) + temp_3333(1:3,1:3,p,o) = matmul(matmul(temp_33_2,dLpdS(1:3,1:3,p,o)), invFi) & + + matmul(temp_33_3,dLidS(1:3,1:3,p,o)) + enddo; enddo + lhs_3333 = math_mul3333xx3333(dSdFe,temp_3333) * dt & + + math_mul3333xx3333(dSdFi,dFidS) + + call math_invert(temp_99,error,math_eye(9)+math_3333to99(lhs_3333)) + if (error) then + call IO_warning(warning_ID=600,el=el,ip=ip,g=co, & + ext_msg='inversion error in analytic tangent calculation') + dSdF = rhs_3333 + else + dSdF = math_mul3333xx3333(math_99to3333(temp_99),rhs_3333) + endif + +!-------------------------------------------------------------------------------------------------- +! calculate dFpinvdF + temp_3333 = math_mul3333xx3333(dLpdS,dSdF) + do o=1,3; do p=1,3 + dFpinvdF(1:3,1:3,p,o) = - matmul(invSubFp0, matmul(temp_3333(1:3,1:3,p,o),invFi)) * dt + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! assemble dPdF + temp_33_1 = matmul(constitutive_mech_S(ph)%data(1:3,1:3,me),transpose(invFp)) + temp_33_2 = matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),invFp) + temp_33_3 = matmul(temp_33_2,constitutive_mech_S(ph)%data(1:3,1:3,me)) + + dPdF = 0.0_pReal + do p=1,3 + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) + enddo + do o=1,3; do p=1,3 + dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & + + matmul(matmul(constitutive_mech_F(ph)%data(1:3,1:3,me),dFpinvdF(1:3,1:3,p,o)),temp_33_1) & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)),transpose(invFp)) & + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) + enddo; enddo + +end function constitutive_mech_dPdF + end submodule constitutive_mech diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 4a9e1856f..1d0942f3e 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -156,11 +156,11 @@ module subroutine mech_homogenize(dt,ip,el) case (HOMOGENIZATION_NONE_ID) chosenHomogenization homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(dt,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -171,7 +171,7 @@ module subroutine mech_homogenize(dt,ip,el) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(dt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & @@ -207,7 +207,7 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,co) = crystallite_stressTangent(subdt,co,ip,el) + dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el) Fs(:,:,co) = constitutive_mech_getF(co,ip,el) enddo doneAndHappy = & From 9ce932a082fc5e78f690ff2dd69da38e422a760d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 00:14:48 +0100 Subject: [PATCH 153/214] distributing tasks --- src/CPFEM2.f90 | 10 ++-- src/constitutive.f90 | 103 ++++++++++++++++---------------------- src/constitutive_mech.f90 | 60 ++++++++++++++++------ src/homogenization.f90 | 60 +++++++++++++++++++++- 4 files changed, 152 insertions(+), 81 deletions(-) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index b1e03659b..e696858cf 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -76,8 +76,8 @@ subroutine CPFEM_init integer(HID_T) :: fileHandle character(len=pStringLen) :: fileName - - + + print'(/,a)', ' <<<+- CPFEM init -+>>>'; flush(IO_STDOUT) @@ -86,6 +86,7 @@ subroutine CPFEM_init write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName) + call homogenization_restartRead(fileHandle) call constitutive_restartRead(fileHandle) call HDF5_closeFile(fileHandle) @@ -98,16 +99,17 @@ end subroutine CPFEM_init !> @brief Write restart information. !-------------------------------------------------------------------------------------------------- subroutine CPFEM_restartWrite - + integer(HID_T) :: fileHandle character(len=pStringLen) :: fileName - + print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT) write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') + call homogenization_restartWrite(fileHandle) call constitutive_restartWrite(fileHandle) call HDF5_closeFile(fileHandle) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 67e8b33c8..5dd415a47 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -15,7 +15,6 @@ module constitutive use discretization use parallelization use HDF5_utilities - use DAMASK_interface use results implicit none @@ -161,10 +160,6 @@ module constitutive end subroutine damage_results - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read - module subroutine mech_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me end subroutine mech_initializeRestorationPoints @@ -193,6 +188,16 @@ module constitutive real(pReal), dimension(3,3,3,3) :: dPdF end function constitutive_mech_dPdF + module subroutine mech_restartWrite(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mech_restartWrite + + module subroutine mech_restartRead(groupHandle,ph) + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + end subroutine mech_restartRead + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -798,7 +803,7 @@ subroutine constitutive_forward integer :: ph, so - + call constitutive_mech_forward() do ph = 1, size(sourceState) @@ -1017,7 +1022,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) ip, & co real(pReal), dimension(3,3) :: crystallite_push33ToRef - + real(pReal), dimension(3,3) :: T @@ -1152,82 +1157,58 @@ end function converged !-------------------------------------------------------------------------------------------------- !> @brief Write current restart information (Field and constitutive data) to file. -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +! ToDo: Merge data into one file for MPI !-------------------------------------------------------------------------------------------------- subroutine constitutive_restartWrite(fileHandle) integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle integer :: ph - integer(HID_T) :: groupHandle - character(len=pStringLen) :: datasetName - groupHandle = HDF5_addGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_p' - call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_S' - call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F' - call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,datasetName) + + groupHandle(1) = HDF5_addGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_phase(ph)) + + call mech_restartWrite(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + enddo - call HDF5_closeGroup(groupHandle) - - groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do ph = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_write(groupHandle,homogState(ph)%state,datasetName) - enddo - call HDF5_closeGroup(groupHandle) + call HDF5_closeGroup(groupHandle(1)) end subroutine constitutive_restartWrite !-------------------------------------------------------------------------------------------------- !> @brief Read data for restart -! ToDo: Merge data into one file for MPI, move state to constitutive and homogenization, respectively +! ToDo: Merge data into one file for MPI !-------------------------------------------------------------------------------------------------- subroutine constitutive_restartRead(fileHandle) integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle integer :: ph - integer(HID_T) :: groupHandle - character(len=pStringLen) ::datasetName - groupHandle = HDF5_openGroup(fileHandle,'phase') - do ph = 1,size(material_name_phase) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) - write(datasetName,'(i0,a)') ph,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_L_p' - call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_S' - call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,datasetName) - write(datasetName,'(i0,a)') ph,'_F' - call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,datasetName) + groupHandle(1) = HDF5_openGroup(fileHandle,'phase') + + do ph = 1, size(material_name_phase) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_phase(ph)) + + call mech_restartRead(groupHandle(2),ph) + + call HDF5_closeGroup(groupHandle(2)) + enddo - call HDF5_closeGroup(groupHandle) - groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do ph = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') ph,'_omega' - call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) - enddo - call HDF5_closeGroup(groupHandle) + call HDF5_closeGroup(groupHandle(1)) end subroutine constitutive_restartRead @@ -1273,7 +1254,7 @@ function constitutive_thermal_T(co,ip,el) result(T) integer, intent(in) :: co, ip, el real(pReal) :: T - + integer :: ho, tme ho = material_homogenizationAt(el) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 6392fb0ee..cdf3d7ea5 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -364,7 +364,7 @@ module subroutine mech_init allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_F0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_partitionedF0(ph)%data(3,3,Nconstituents)) - + phase => phases%get(ph) mech => phase%get('mechanics') #if defined(__GFORTRAN__) @@ -403,13 +403,13 @@ module subroutine mech_init ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - + constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = material_orientation0(co,ip,el)%asMatrix() ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005) constitutive_mech_Fp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) & / math_det33(constitutive_mech_Fp0(ph)%data(1:3,1:3,me))**(1.0_pReal/3.0_pReal) constitutive_mech_Fi0(ph)%data(1:3,1:3,me) = math_I3 constitutive_mech_F0(ph)%data(1:3,1:3,me) = math_I3 - + constitutive_mech_Fe(ph)%data(1:3,1:3,me) = math_inv33(matmul(constitutive_mech_Fi0(ph)%data(1:3,1:3,me), & constitutive_mech_Fp0(ph)%data(1:3,1:3,me))) ! assuming that euler angles are given in internal strain free configuration constitutive_mech_Fp(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) @@ -568,16 +568,16 @@ module subroutine constitutive_plastic_dependentState(co, ip, el) instance = phase_plasticityInstance(material_phaseAt(co,el)) plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - + case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,me) - + case (PLASTICITY_DISLOTUNGSTEN_ID) plasticityType call plastic_dislotungsten_dependentState(instance,me) - + case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dependentState(instance,me,ip,el) - + end select plasticityType end subroutine constitutive_plastic_dependentState @@ -675,7 +675,7 @@ function mech_collectDotState(subdt,co,ip,el,ph,of) result(broken) tme, & !< thermal member position instance logical :: broken - + ho = material_homogenizationAt(el) tme = material_homogenizationMemberAt(ip,el) instance = phase_plasticityInstance(ph) @@ -723,14 +723,14 @@ function constitutive_deltaState(co, ip, el, ph, of) result(broken) of logical :: & broken - + real(pReal), dimension(3,3) :: & Mp integer :: & instance, & myOffset, & mySize - + Mp = matmul(matmul(transpose(constitutive_mech_Fi(ph)%data(1:3,1:3,of)),& constitutive_mech_Fi(ph)%data(1:3,1:3,of)),constitutive_mech_S(ph)%data(1:3,1:3,of)) @@ -799,10 +799,6 @@ module subroutine mech_results(group,ph) end subroutine mech_results - module subroutine mech_restart_read(fileHandle) - integer(HID_T), intent(in) :: fileHandle - end subroutine mech_restart_read - !-------------------------------------------------------------------------------------------------- !> @brief calculation of stress (P) with time integration based on a residuum in Lp and @@ -874,7 +870,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - + call constitutive_plastic_dependentState(co,ip,el) Lpguess = constitutive_mech_Lp(ph)%data(1:3,1:3,me) ! take as first guess @@ -1815,5 +1811,39 @@ module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) end function constitutive_mech_dPdF + +module subroutine mech_restartWrite(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_write(groupHandle,plasticState(ph)%state,'omega') + call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,'F_i') + call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,'L_i') + call HDF5_write(groupHandle,constitutive_mech_Lp(ph)%data,'L_p') + call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,'F_p') + call HDF5_write(groupHandle,constitutive_mech_S(ph)%data,'S') + call HDF5_write(groupHandle,constitutive_mech_F(ph)%data,'F') + +end subroutine mech_restartWrite + + +module subroutine mech_restartRead(groupHandle,ph) + + integer(HID_T), intent(in) :: groupHandle + integer, intent(in) :: ph + + + call HDF5_read(groupHandle,plasticState(ph)%state0,'omega') + call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,'F_i') + call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,'L_i') + call HDF5_read(groupHandle,constitutive_mech_Lp0(ph)%data,'L_p') + call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,'F_p') + call HDF5_read(groupHandle,constitutive_mech_S0(ph)%data,'S') + call HDF5_read(groupHandle,constitutive_mech_F0(ph)%data,'F') + +end subroutine mech_restartRead + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index e31089177..686bb9885 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,6 +16,7 @@ module homogenization use thermal_conduction use damage_none use damage_nonlocal + use HDF5_utilities use results implicit none @@ -92,7 +93,9 @@ module homogenization homogenization_init, & materialpoint_stressAndItsTangent, & homogenization_forward, & - homogenization_results + homogenization_results, & + homogenization_restartRead, & + homogenization_restartWrite contains @@ -315,4 +318,59 @@ subroutine homogenization_forward end subroutine homogenization_forward + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartWrite(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_addGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_read(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartWrite + + +!-------------------------------------------------------------------------------------------------- +!-------------------------------------------------------------------------------------------------- +subroutine homogenization_restartRead(fileHandle) + + integer(HID_T), intent(in) :: fileHandle + + integer(HID_T), dimension(2) :: groupHandle + integer :: ho + + + groupHandle(1) = HDF5_openGroup(fileHandle,'homogenization') + + do ho = 1, size(material_name_homogenization) + + groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_homogenization(ho)) + + call HDF5_write(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech + + call HDF5_closeGroup(groupHandle(2)) + + enddo + + call HDF5_closeGroup(groupHandle(1)) + +end subroutine homogenization_restartRead + + end module homogenization From 9d09721689bdeab5d72b742bbdc124be546f1541 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 09:54:06 +0100 Subject: [PATCH 154/214] keep variables local --- src/constitutive.f90 | 127 ++++++++++------------------------- src/constitutive_mech.f90 | 84 +++++++++++++++++++++++ src/constitutive_thermal.f90 | 24 ++++++- 3 files changed, 140 insertions(+), 95 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5dd415a47..29fca2b33 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -51,31 +51,6 @@ module constitutive real(pReal), dimension(:,:,:), allocatable :: data end type - type(tTensorContainer), dimension(:), allocatable :: & - ! current value - constitutive_mech_Fe, & - constitutive_mech_Fi, & - constitutive_mech_Fp, & - constitutive_mech_F, & - constitutive_mech_Li, & - constitutive_mech_Lp, & - constitutive_mech_S, & - ! converged value at end of last solver increment - constitutive_mech_Fi0, & - constitutive_mech_Fp0, & - constitutive_mech_F0, & - constitutive_mech_Li0, & - constitutive_mech_Lp0, & - constitutive_mech_S0, & - ! converged value at end of last homogenization increment (RGC only) - constitutive_mech_partitionedFi0, & - constitutive_mech_partitionedFp0, & - constitutive_mech_partitionedF0, & - constitutive_mech_partitionedLi0, & - constitutive_mech_partitionedLp0, & - constitutive_mech_partitionedS0 - - type :: tNumerics integer :: & iJacoLpresiduum, & !< frequency of Jacobian update of residuum in Lp @@ -198,6 +173,37 @@ module constitutive integer, intent(in) :: ph end subroutine mech_restartRead + + module function constitutive_mech_getS(co,ip,el) result(S) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + end function constitutive_mech_getS + + module function constitutive_mech_getLp(co,ip,el) result(Lp) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + end function constitutive_mech_getLp + + module function constitutive_mech_getF(co,ip,el) result(F) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + end function constitutive_mech_getF + + module function constitutive_mech_getF_e(co,ip,el) result(F_e) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F_e + end function constitutive_mech_getF_e + + module function constitutive_thermal_T(co,ip,el) result(T) + integer, intent(in) :: co, ip, el + real(pReal) :: T + end function constitutive_thermal_T + + module subroutine constitutive_mech_setF(F,co,ip,el) + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + end subroutine constitutive_mech_setF + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -1001,7 +1007,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + constitutive_mech_getF_e(co,ip,el)))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1026,8 +1032,8 @@ function crystallite_push33ToRef(co,ip,el, tensor33) real(pReal), dimension(3,3) :: T - T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el))))) + T = matmul(material_orientation0(co,ip,el)%asMatrix(),transpose(math_inv33(constitutive_mech_getF(co,ip,el)))) ! ToDo: initial orientation correct? + crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1104,7 +1110,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(constitutive_mech_Fe(ph)%data(1:3,1:3,me),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(constitutive_mech_getF_e(co,ip,el),co,ip,el,ph,me) exit iteration endif @@ -1213,67 +1219,4 @@ subroutine constitutive_restartRead(fileHandle) end subroutine constitutive_restartRead -! getter for non-mech (e.g. thermal) -function constitutive_mech_getS(co,ip,el) result(S) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: S - - - S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getS - - -! getter for non-mech (e.g. thermal) -function constitutive_mech_getLp(co,ip,el) result(Lp) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: Lp - - - Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getLp - - -! getter for non-mech (e.g. thermal) -function constitutive_mech_getF(co,ip,el) result(F) - - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: F - - - F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) - -end function constitutive_mech_getF - - -! getter for non-thermal (e.g. mech) -function constitutive_thermal_T(co,ip,el) result(T) - - integer, intent(in) :: co, ip, el - real(pReal) :: T - - integer :: ho, tme - - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) - - T = temperature(ho)%p(tme) - -end function constitutive_thermal_T - - -! setter for homogenization -subroutine constitutive_mech_setF(F,co,ip,el) - - real(pReal), dimension(3,3), intent(in) :: F - integer, intent(in) :: co, ip, el - - - constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F - -end subroutine constitutive_mech_setF - end module constitutive diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index cdf3d7ea5..a1256a15d 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -15,6 +15,30 @@ submodule(constitutive) constitutive_mech integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase + type(tTensorContainer), dimension(:), allocatable :: & + ! current value + constitutive_mech_Fe, & + constitutive_mech_Fi, & + constitutive_mech_Fp, & + constitutive_mech_F, & + constitutive_mech_Li, & + constitutive_mech_Lp, & + constitutive_mech_S, & + ! converged value at end of last solver increment + constitutive_mech_Fi0, & + constitutive_mech_Fp0, & + constitutive_mech_F0, & + constitutive_mech_Li0, & + constitutive_mech_Lp0, & + constitutive_mech_S0, & + ! converged value at end of last homogenization increment (RGC only) + constitutive_mech_partitionedFi0, & + constitutive_mech_partitionedFp0, & + constitutive_mech_partitionedF0, & + constitutive_mech_partitionedLi0, & + constitutive_mech_partitionedLp0, & + constitutive_mech_partitionedS0 + interface @@ -1845,5 +1869,65 @@ module subroutine mech_restartRead(groupHandle,ph) end subroutine mech_restartRead + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getS(co,ip,el) result(S) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: S + + + S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getS + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getLp(co,ip,el) result(Lp) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: Lp + + + Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getLp + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getF(co,ip,el) result(F) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F + + + F = constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF + + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getF_e(co,ip,el) result(F_e) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: F_e + + + F_e = constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getF_e + + +! setter for homogenization +module subroutine constitutive_mech_setF(F,co,ip,el) + + real(pReal), dimension(3,3), intent(in) :: F + integer, intent(in) :: co, ip, el + + + constitutive_mech_F(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) = F + +end subroutine constitutive_mech_setF + end submodule constitutive_mech diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 1e204a197..1a05b983f 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -9,7 +9,7 @@ submodule(constitutive) constitutive_thermal integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources end function source_thermal_dissipation_init - + module function source_thermal_externalheat_init(source_length) result(mySources) integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources @@ -55,8 +55,8 @@ module subroutine thermal_init if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID - endif - + endif + !-------------------------------------------------------------------------------------------------- !initialize kinematic mechanisms if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & @@ -121,4 +121,22 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents + + +! getter for non-thermal (e.g. mech) +module function constitutive_thermal_T(co,ip,el) result(T) + + integer, intent(in) :: co, ip, el + real(pReal) :: T + + integer :: ho, tme + + ho = material_homogenizationAt(el) + tme = material_homogenizationMemberAt(ip,el) + + T = temperature(ho)%p(tme) + +end function constitutive_thermal_T + + end submodule constitutive_thermal From dd23bec9aa9c1a3c32f2907c728a645bf1038858 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 11:03:13 +0100 Subject: [PATCH 155/214] avoid global variables --- src/constitutive.f90 | 9 ++++-- src/constitutive_mech.f90 | 62 +++++++++++++++---------------------- src/homogenization_mech.f90 | 24 ++++++-------- 3 files changed, 41 insertions(+), 54 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 29fca2b33..667a23127 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -44,8 +44,6 @@ module constitutive type(rotation), dimension(:,:,:), allocatable :: & crystallite_orientation !< current orientation - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_P !< 1st Piola-Kirchhoff stress per grain type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -194,6 +192,11 @@ module constitutive real(pReal), dimension(3,3) :: F_e end function constitutive_mech_getF_e + module function constitutive_mech_getP(co,ip,el) result(P) + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: P + end function constitutive_mech_getP + module function constitutive_thermal_T(co,ip,el) result(T) integer, intent(in) :: co, ip, el real(pReal) :: T @@ -411,6 +414,7 @@ module constitutive constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & + constitutive_mech_getP, & constitutive_mech_getLp, & constitutive_mech_getF, & constitutive_mech_getS, & @@ -877,7 +881,6 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_P(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index a1256a15d..f5a5cd0a2 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -24,6 +24,7 @@ submodule(constitutive) constitutive_mech constitutive_mech_Li, & constitutive_mech_Lp, & constitutive_mech_S, & + constitutive_mech_P, & ! converged value at end of last solver increment constitutive_mech_Fi0, & constitutive_mech_Fp0, & @@ -363,6 +364,7 @@ module subroutine mech_init allocate(constitutive_mech_Lp0(phases%length)) allocate(constitutive_mech_Lp(phases%length)) allocate(constitutive_mech_S(phases%length)) + allocate(constitutive_mech_P(phases%length)) allocate(constitutive_mech_S0(phases%length)) allocate(constitutive_mech_partitionedS0(phases%length)) @@ -383,6 +385,7 @@ module subroutine mech_init allocate(constitutive_mech_Lp0(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_Lp(ph)%data(3,3,Nconstituents)) allocate(constitutive_mech_S(ph)%data(3,3,Nconstituents),source=0.0_pReal) + allocate(constitutive_mech_P(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_S0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_partitionedS0(ph)%data(3,3,Nconstituents),source=0.0_pReal) allocate(constitutive_mech_F(ph)%data(3,3,Nconstituents)) @@ -1027,7 +1030,7 @@ function integrateStress(F,subFp0,subFi0,Delta_t,co,ip,el) result(broken) call math_invert33(Fp_new,devNull,error,invFp_new) if (error) return ! error - crystallite_P (1:3,1:3,co,ip,el) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) + constitutive_mech_P(ph)%data(1:3,1:3,me) = matmul(matmul(F,invFp_new),matmul(S,transpose(invFp_new))) constitutive_mech_S(ph)%data(1:3,1:3,me) = S constitutive_mech_Lp(ph)%data(1:3,1:3,me) = Lpguess constitutive_mech_Li(ph)%data(1:3,1:3,me) = Liguess @@ -1381,29 +1384,28 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_F(ph)%data,'F',& 'deformation gradient','1') case('F_e') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fe(ph)%data,'F_e',& 'elastic deformation gradient','1') case('F_p') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fp(ph)%data,'F_p', & 'plastic deformation gradient','1') case('F_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Fi(ph)%data,'F_i', & 'inelastic deformation gradient','1') case('L_p') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Lp(ph)%data,'L_p', & 'plastic velocity gradient','1/s') case('L_i') - call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_Li(ph)%data,'L_i', & 'inelastic velocity gradient','1/s') case('P') - selected_tensors = select_tensors(crystallite_P,ph) - call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_P(ph)%data,'P', & 'First Piola-Kirchhoff stress','Pa') case('S') - call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,output_constituent(ph)%label(ou),& + call results_writeDataset(group//'/mechanics/',constitutive_mech_S(ph)%data,'S', & 'Second Piola-Kirchhoff stress','Pa') case('O') select case(lattice_structure(ph)) @@ -1430,33 +1432,6 @@ subroutine crystallite_results(group,ph) contains - !------------------------------------------------------------------------------------------------ - !> @brief select tensors for output - !------------------------------------------------------------------------------------------------ - function select_tensors(dataset,ph) - - integer, intent(in) :: ph - real(pReal), dimension(:,:,:,:,:), intent(in) :: dataset - real(pReal), allocatable, dimension(:,:,:) :: select_tensors - integer :: el,ip,co,j - - allocate(select_tensors(3,3,count(material_phaseAt==ph)*discretization_nIPs)) - - j=0 - do el = 1, size(material_phaseAt,2) - do ip = 1, discretization_nIPs - do co = 1, size(material_phaseAt,1) !ToDo: this needs to be changed for varying Ngrains - if (material_phaseAt(co,el) == ph) then - j = j + 1 - select_tensors(1:3,1:3,j) = dataset(1:3,1:3,co,ip,el) - endif - enddo - enddo - enddo - - end function select_tensors - - !-------------------------------------------------------------------------------------------------- !> @brief select rotations for output !-------------------------------------------------------------------------------------------------- @@ -1918,6 +1893,19 @@ module function constitutive_mech_getF_e(co,ip,el) result(F_e) end function constitutive_mech_getF_e + +! getter for non-mech (e.g. thermal) +module function constitutive_mech_getP(co,ip,el) result(P) + + integer, intent(in) :: co, ip, el + real(pReal), dimension(3,3) :: P + + + P = constitutive_mech_P(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + +end function constitutive_mech_getP + + ! setter for homogenization module subroutine constitutive_mech_setF(F,co,ip,el) diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 1d0942f3e..783d08dd1 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -111,7 +111,7 @@ module subroutine mech_partition(subF,ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - + integer :: co real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) @@ -149,35 +149,36 @@ module subroutine mech_homogenize(dt,ip,el) integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_P(1:3,1:3,ce) = constitutive_mech_getP(1,ip,el) homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & + Ps,dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& homogenization_P(1:3,1:3,ce), & homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& - crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - dPdFs, & + Ps,dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) end select chosenHomogenization @@ -203,21 +204,16 @@ module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) integer :: co real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el) Fs(:,:,co) = constitutive_mech_getF(co,ip,el) + Ps(:,:,co) = constitutive_mech_getP(co,ip,el) enddo - doneAndHappy = & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - Fs, & - subF,& - subdt, & - dPdFs, & - ip, & - el) + doneAndHappy = mech_RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ip,el) else doneAndHappy = .true. endif From 0dac5f84ef15259016f66a4d0f1e9e7ce14d3dfb Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:00:47 +0100 Subject: [PATCH 156/214] dummy data layout --- src/constitutive.f90 | 7 +++++++ src/constitutive_thermal.f90 | 7 +++++++ src/homogenization.f90 | 5 +++++ src/homogenization_thermal.f90 | 37 ++++++++++++++++++++++++++++++++++ 4 files changed, 56 insertions(+) create mode 100644 src/homogenization_thermal.f90 diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 667a23127..36400fca7 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -202,11 +202,17 @@ module constitutive real(pReal) :: T end function constitutive_thermal_T + module subroutine constitutive_mech_setF(F,co,ip,el) real(pReal), dimension(3,3), intent(in) :: F integer, intent(in) :: co, ip, el end subroutine constitutive_mech_setF + module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: co, ip, el + end subroutine constitutive_thermal_setT + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -414,6 +420,7 @@ module constitutive constitutive_restartRead, & integrateSourceState, & constitutive_mech_setF, & + constitutive_thermal_setT, & constitutive_mech_getP, & constitutive_mech_getLp, & constitutive_mech_getF, & diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 1a05b983f..01d517124 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -139,4 +139,11 @@ module function constitutive_thermal_T(co,ip,el) result(T) end function constitutive_thermal_T +! setter for homogenization +module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: co, ip, el +end subroutine constitutive_thermal_setT + + end submodule constitutive_thermal diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 686bb9885..df7369096 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -27,6 +27,8 @@ module homogenization !-------------------------------------------------------------------------------------------------- ! General variables for the homogenization at a material point + real(pReal), dimension(:), allocatable, public :: & + homogenization_T real(pReal), dimension(:,:,:), allocatable, public :: & homogenization_F0, & !< def grad of IP at start of FE increment homogenization_F !< def grad of IP to be reached at end of FE increment @@ -56,6 +58,9 @@ module homogenization num_homog !< pointer to mechanical homogenization numerics data end subroutine mech_init + module subroutine thermal_init + end subroutine thermal_init + module subroutine mech_partition(subF,ip,el) real(pReal), intent(in), dimension(3,3) :: & subF diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 new file mode 100644 index 000000000..59e7357b6 --- /dev/null +++ b/src/homogenization_thermal.f90 @@ -0,0 +1,37 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, KU Leuven +!-------------------------------------------------------------------------------------------------- +submodule(homogenization) homogenization_thermal + + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief Allocate variables and set parameters. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_init() + + print'(/,a)', ' <<<+- homogenization_thermal init -+>>>' + + allocate(homogenization_T(discretization_nIPs*discretization_Nelems), source=0.0_pReal) + +end subroutine thermal_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Partition T onto the individual constituents. +!-------------------------------------------------------------------------------------------------- +module subroutine thermal_partition(T,ip,el) + + real(pReal), intent(in) :: T + integer, intent(in) :: & + ip, & !< integration point + el !< element number + + + call constitutive_thermal_setT(T,1,ip,el) + +end subroutine thermal_partition + + +end submodule homogenization_thermal From bc12ac44c3ccda8616ea255a2ab173b17f989cbc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:34:00 +0100 Subject: [PATCH 157/214] basic functionality for thermal homogenization --- src/constitutive.f90 | 27 ++++++++++++----------- src/constitutive_mech.f90 | 7 +++--- src/constitutive_thermal.f90 | 42 +++++++++++++++++++++++++++--------- 3 files changed, 51 insertions(+), 25 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 36400fca7..e68d90de6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -112,13 +112,15 @@ module constitutive interface ! == cleaned:begin ================================================================================= - module subroutine mech_init + module subroutine mech_init(phases) + class(tNode), pointer :: phases end subroutine mech_init module subroutine damage_init end subroutine damage_init - module subroutine thermal_init + module subroutine thermal_init(phases) + class(tNode), pointer :: phases end subroutine thermal_init @@ -197,10 +199,10 @@ module constitutive real(pReal), dimension(3,3) :: P end function constitutive_mech_getP - module function constitutive_thermal_T(co,ip,el) result(T) - integer, intent(in) :: co, ip, el + module function thermal_T(ph,me) result(T) + integer, intent(in) :: ph,me real(pReal) :: T - end function constitutive_thermal_T + end function thermal_T module subroutine constitutive_mech_setF(F,co,ip,el) @@ -463,6 +465,8 @@ subroutine constitutive_init phases + print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) + debug_constitutive => config_debug%get('constitutive', defaultVal=emptyList) debugConstitutive%basic = debug_constitutive%contains('basic') debugConstitutive%extensive = debug_constitutive%contains('extensive') @@ -471,15 +475,14 @@ subroutine constitutive_init debugConstitutive%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1) debugConstitutive%grain = config_debug%get_asInt('grain',defaultVal = 1) -!-------------------------------------------------------------------------------------------------- -! initialize constitutive laws - print'(/,a)', ' <<<+- constitutive init -+>>>'; flush(IO_STDOUT) - call mech_init - call damage_init - call thermal_init - phases => config_material%get('phase') + + call mech_init(phases) + call damage_init + call thermal_init(phases) + + constitutive_source_maxSizeDotState = 0 PhaseLoop2:do ph = 1,phases%length !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f5a5cd0a2..97bf7d853 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -319,7 +319,10 @@ contains !> @brief Initialize mechanical field related constitutive models !> @details Initialize elasticity, plasticity and stiffness degradation models. !-------------------------------------------------------------------------------------------------- -module subroutine mech_init +module subroutine mech_init(phases) + + class(tNode), pointer :: & + phases integer :: & el, & @@ -331,7 +334,6 @@ module subroutine mech_init Nconstituents class(tNode), pointer :: & num_crystallite, & - phases, & phase, & mech, & elastic, & @@ -341,7 +343,6 @@ module subroutine mech_init !------------------------------------------------------------------------------------------------- ! initialize elasticity (hooke) !ToDO: Maybe move to elastic submodule along with function homogenizedC? - phases => config_material%get('phase') allocate(phase_elasticity(phases%length), source = ELASTICITY_undefined_ID) allocate(phase_elasticityInstance(phases%length), source = 0) allocate(phase_NstiffnessDegradations(phases%length),source=0) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 01d517124..bdcd0bc26 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -2,6 +2,12 @@ !> @brief internal microstructure state for all thermal sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal + + type :: tDataContainer + real(pReal), dimension(:), allocatable :: T + end type tDataContainer + + type(tDataContainer), dimension(:), allocatable :: current interface @@ -49,8 +55,29 @@ contains !---------------------------------------------------------------------------------------------- !< @brief initializes thermal sources and kinematics mechanism !---------------------------------------------------------------------------------------------- -module subroutine thermal_init +module subroutine thermal_init(phases) + + class(tNode), pointer :: & + phases + + integer :: & + ph, & + Nconstituents + + print'(/,a)', ' <<<+- constitutive_mech init -+>>>' + + allocate(current(phases%length)) + + + do ph = 1, phases%length + + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs + + allocate(current(ph)%T(Nconstituents)) + + enddo + ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID @@ -122,21 +149,16 @@ end subroutine constitutive_thermal_getRateAndItsTangents - ! getter for non-thermal (e.g. mech) -module function constitutive_thermal_T(co,ip,el) result(T) +module function thermal_T(ph,me) result(T) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph, me real(pReal) :: T - integer :: ho, tme - ho = material_homogenizationAt(el) - tme = material_homogenizationMemberAt(ip,el) + T = current(ph)%T(me) - T = temperature(ho)%p(tme) - -end function constitutive_thermal_T +end function thermal_T ! setter for homogenization From 8c6d759b557b8fed05b7b53c01ad7a28d349afba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 12:45:08 +0100 Subject: [PATCH 158/214] consistent naming --- src/constitutive.f90 | 31 +++++++++++++++---------------- src/constitutive_mech.f90 | 26 +++++++++++++------------- src/constitutive_thermal.f90 | 25 +++++++++++-------------- 3 files changed, 39 insertions(+), 43 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e68d90de6..05653e3b4 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -174,25 +174,25 @@ module constitutive end subroutine mech_restartRead - module function constitutive_mech_getS(co,ip,el) result(S) - integer, intent(in) :: co, ip, el + module function mech_S(ph,me) result(S) + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: S - end function constitutive_mech_getS + end function mech_S - module function constitutive_mech_getLp(co,ip,el) result(Lp) - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: Lp - end function constitutive_mech_getLp + module function mech_L_p(ph,me) result(L_p) + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p + end function mech_L_p module function constitutive_mech_getF(co,ip,el) result(F) integer, intent(in) :: co, ip, el real(pReal), dimension(3,3) :: F end function constitutive_mech_getF - module function constitutive_mech_getF_e(co,ip,el) result(F_e) - integer, intent(in) :: co, ip, el + module function mech_F_e(ph,me) result(F_e) + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: F_e - end function constitutive_mech_getF_e + end function mech_F_e module function constitutive_mech_getP(co,ip,el) result(P) integer, intent(in) :: co, ip, el @@ -421,12 +421,10 @@ module constitutive constitutive_restartWrite, & constitutive_restartRead, & integrateSourceState, & - constitutive_mech_setF, & constitutive_thermal_setT, & constitutive_mech_getP, & - constitutive_mech_getLp, & + constitutive_mech_setF, & constitutive_mech_getF, & - constitutive_mech_getS, & constitutive_initializeRestorationPoints, & constitutive_windForward, & PLASTICITY_UNDEFINED_ID, & @@ -667,7 +665,8 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(constitutive_mech_getS(co,ip,el), co, ip, el) ! correct stress? + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? case (SOURCE_damage_isoDuctile_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) @@ -1020,7 +1019,7 @@ subroutine crystallite_orientations(co,ip,el) call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(& - constitutive_mech_getF_e(co,ip,el)))) + mech_F_e(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el))))) if (plasticState(material_phaseAt(1,el))%nonlocal) & call plastic_nonlocal_updateCompatibility(crystallite_orientation, & @@ -1123,7 +1122,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) enddo if(converged_) then - broken = constitutive_damage_deltaState(constitutive_mech_getF_e(co,ip,el),co,ip,el,ph,me) + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) exit iteration endif diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 97bf7d853..f5be4863a 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1847,27 +1847,27 @@ end subroutine mech_restartRead ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getS(co,ip,el) result(S) +module function mech_S(ph,me) result(S) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: S - S = constitutive_mech_S(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + S = constitutive_mech_S(ph)%data(1:3,1:3,me) -end function constitutive_mech_getS +end function mech_S ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getLp(co,ip,el) result(Lp) +module function mech_L_p(ph,me) result(L_p) - integer, intent(in) :: co, ip, el - real(pReal), dimension(3,3) :: Lp + integer, intent(in) :: ph,me + real(pReal), dimension(3,3) :: L_p - Lp = constitutive_mech_Lp(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + L_p = constitutive_mech_Lp(ph)%data(1:3,1:3,me) -end function constitutive_mech_getLp +end function mech_L_p ! getter for non-mech (e.g. thermal) @@ -1883,15 +1883,15 @@ end function constitutive_mech_getF ! getter for non-mech (e.g. thermal) -module function constitutive_mech_getF_e(co,ip,el) result(F_e) +module function mech_F_e(ph,me) result(F_e) - integer, intent(in) :: co, ip, el + integer, intent(in) :: ph,me real(pReal), dimension(3,3) :: F_e - F_e = constitutive_mech_Fe(material_phaseAt(co,el))%data(1:3,1:3,material_phaseMemberAt(co,ip,el)) + F_e = constitutive_mech_Fe(ph)%data(1:3,1:3,me) -end function constitutive_mech_getF_e +end function mech_F_e diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index bdcd0bc26..9e2807d42 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -109,32 +109,29 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, real(pReal) :: & my_Tdot, & my_dTdot_dT - real(pReal), dimension(3,3) :: Lp, S integer :: & - phase, & + ph, & homog, & instance, & - grain, & - source, & - constituent + me, & + so, & + co homog = material_homogenizationAt(el) instance = thermal_typeInstance(homog) - do grain = 1, homogenization_Nconstituents(homog) - phase = material_phaseAt(grain,el) - constituent = material_phasememberAt(grain,ip,el) - do source = 1, phase_Nsources(phase) - select case(phase_source(source,phase)) + do co = 1, homogenization_Nconstituents(homog) + ph = material_phaseAt(co,el) + me = material_phasememberAt(co,ip,el) + do so = 1, phase_Nsources(ph) + select case(phase_source(so,ph)) case (SOURCE_thermal_dissipation_ID) - Lp = constitutive_mech_getLp(grain,ip,el) - S = constitutive_mech_getS(grain,ip,el) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - S, Lp, phase) + mech_S(ph,me),mech_L_p(ph,me), ph) case (SOURCE_thermal_externalheat_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - phase, constituent) + ph, me) case default my_Tdot = 0.0_pReal From f9f56a1755c6b64251d357c31047c98d34ce10cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 13:57:37 +0100 Subject: [PATCH 159/214] documenting --- src/constitutive.f90 | 34 ---------------------------------- src/constitutive_mech.f90 | 24 +++++++++++++++++------- src/constitutive_thermal.f90 | 26 +++++++++++++++++--------- 3 files changed, 34 insertions(+), 50 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 05653e3b4..6348c18d6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -352,23 +352,6 @@ module constitutive end subroutine source_damage_isoBrittle_deltaState - module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & - S, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S, & !< 2nd Piola-Kirchhoff stress - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Lp !< plastic velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLp_dS, & - dLp_dFi !< derivative of Lp with respect to Fi - end subroutine constitutive_plastic_LpAndItsTangents - - module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & co, & !< component-ID of integration point @@ -376,23 +359,6 @@ module constitutive el !< element end subroutine constitutive_plastic_dependentState - - - module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, co, ip, el) - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - Fe, & !< elastic deformation gradient - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress tensor - real(pReal), intent(out), dimension(3,3,3,3) :: & - dS_dFe, & !< derivative of 2nd P-K stress with respect to elastic deformation gradient - dS_dFi !< derivative of 2nd P-K stress with respect to intermediate deformation gradient - end subroutine constitutive_hooke_SandItsTangents - end interface diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index f5be4863a..fedec379f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -530,7 +530,7 @@ end function plastic_active !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic and intermediate deformation gradients using Hooke's law !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & +subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, & Fe, Fi, co, ip, el) integer, intent(in) :: & @@ -616,7 +616,7 @@ end subroutine constitutive_plastic_dependentState ! ToDo: Discuss whether it makes sense if crystallite handles the configuration conversion, i.e. ! Mp in, dLp_dMp out !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & +subroutine constitutive_plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, & S, Fi, co, ip, el) integer, intent(in) :: & co, & !< component-ID of integration point @@ -1846,7 +1846,9 @@ module subroutine mech_restartRead(groupHandle,ph) end subroutine mech_restartRead -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get first Piola-Kichhoff stress (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_S(ph,me) result(S) integer, intent(in) :: ph,me @@ -1858,7 +1860,9 @@ module function mech_S(ph,me) result(S) end function mech_S -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get plastic velocity gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_L_p(ph,me) result(L_p) integer, intent(in) :: ph,me @@ -1870,7 +1874,9 @@ module function mech_L_p(ph,me) result(L_p) end function mech_L_p -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get deformation gradient (for use by homogenization) +!---------------------------------------------------------------------------------------------- module function constitutive_mech_getF(co,ip,el) result(F) integer, intent(in) :: co, ip, el @@ -1882,7 +1888,9 @@ module function constitutive_mech_getF(co,ip,el) result(F) end function constitutive_mech_getF -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get elastic deformation gradient (for use by non-mech physics) +!---------------------------------------------------------------------------------------------- module function mech_F_e(ph,me) result(F_e) integer, intent(in) :: ph,me @@ -1895,7 +1903,9 @@ end function mech_F_e -! getter for non-mech (e.g. thermal) +!---------------------------------------------------------------------------------------------- +!< @brief Get second Piola-Kichhoff stress (for use by homogenization) +!---------------------------------------------------------------------------------------------- module function constitutive_mech_getP(co,ip,el) result(P) integer, intent(in) :: co, ip, el diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 9e2807d42..f2b61fb26 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -2,11 +2,11 @@ !> @brief internal microstructure state for all thermal sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal - + type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer - + type(tDataContainer), dimension(:), allocatable :: current interface @@ -56,10 +56,10 @@ contains !< @brief initializes thermal sources and kinematics mechanism !---------------------------------------------------------------------------------------------- module subroutine thermal_init(phases) - + class(tNode), pointer :: & phases - + integer :: & ph, & Nconstituents @@ -71,13 +71,13 @@ module subroutine thermal_init(phases) do ph = 1, phases%length - + Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(current(ph)%T(Nconstituents)) enddo - + ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID @@ -145,8 +145,9 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents - -! getter for non-thermal (e.g. mech) +!---------------------------------------------------------------------------------------------- +!< @brief Get temperature (for use by non-thermal physics) +!---------------------------------------------------------------------------------------------- module function thermal_T(ph,me) result(T) integer, intent(in) :: ph, me @@ -158,10 +159,17 @@ module function thermal_T(ph,me) result(T) end function thermal_T -! setter for homogenization +!---------------------------------------------------------------------------------------------- +!< @brief Set temperature +!---------------------------------------------------------------------------------------------- module subroutine constitutive_thermal_setT(T,co,ip,el) + real(pReal), intent(in) :: T integer, intent(in) :: co, ip, el + + + current(material_phaseAt(co,el))%T(material_phaseMemberAt(co,ip,el)) = T + end subroutine constitutive_thermal_setT From a1facadf3fb9451dbc3402e2e8c18dd975019cab Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 30 Dec 2020 18:08:19 +0100 Subject: [PATCH 160/214] needed for MSC.Marc --- src/commercialFEM_fileList.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index d8ab6390d..371c85fd3 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -52,4 +52,5 @@ #include "homogenization_mech_none.f90" #include "homogenization_mech_isostrain.f90" #include "homogenization_mech_RGC.f90" +#include "homogenization_thermal.f90" #include "CPFEM.f90" From 92ec10b2518c488ec01e3246c373005c816ed74f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 07:46:26 +0100 Subject: [PATCH 161/214] consistent names --- src/homogenization_mech.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 783d08dd1..dd3e47c59 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -113,24 +113,24 @@ module subroutine mech_partition(subF,ip,el) el !< element number integer :: co - real(pReal) :: F(3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationAt(el))) :: Fs chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - F(1:3,1:3,1) = subF + Fs(1:3,1:3,1) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - call mech_isostrain_partitionDeformation(F,subF) + call mech_isostrain_partitionDeformation(Fs,subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - call mech_RGC_partitionDeformation(F,subF,ip,el) + call mech_RGC_partitionDeformation(Fs,subF,ip,el) end select chosenHomogenization do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - call constitutive_mech_setF(F(1:3,1:3,co),co,ip,el) + call constitutive_mech_setF(Fs(1:3,1:3,co),co,ip,el) enddo From ebc4f671c88d3b3d2a12eb73464622d6ac4f63e7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 08:00:20 +0100 Subject: [PATCH 162/214] names follow structure --- src/commercialFEM_fileList.f90 | 4 ++-- ...l_dissipation.f90 => constitutive_thermal_dissipation.f90} | 4 ++-- ...externalheat.f90 => constitutive_thermal_externalheat.f90} | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) rename src/{source_thermal_dissipation.f90 => constitutive_thermal_dissipation.f90} (97%) rename src/{source_thermal_externalheat.f90 => constitutive_thermal_externalheat.f90} (98%) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 371c85fd3..a27abec79 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -33,8 +33,8 @@ #include "constitutive_plastic_disloTungsten.f90" #include "constitutive_plastic_nonlocal.f90" #include "constitutive_thermal.f90" -#include "source_thermal_dissipation.f90" -#include "source_thermal_externalheat.f90" +#include "constitutive_thermal_dissipation.f90" +#include "constitutive_thermal_externalheat.f90" #include "kinematics_thermal_expansion.f90" #include "constitutive_damage.f90" #include "source_damage_isoBrittle.f90" diff --git a/src/source_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 similarity index 97% rename from src/source_thermal_dissipation.f90 rename to src/constitutive_thermal_dissipation.f90 index f28567aa7..27653a9ef 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -4,7 +4,7 @@ !> @brief material subroutine for thermal source due to plastic dissipation !> @details to be done !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_dissipation +submodule(constitutive:constitutive_thermal) source_dissipation integer, dimension(:), allocatable :: & source_thermal_dissipation_offset, & !< which source is my current thermal dissipation mechanism? @@ -96,4 +96,4 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT end subroutine source_thermal_dissipation_getRateAndItsTangent -end submodule source_thermal_dissipation +end submodule source_dissipation diff --git a/src/source_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 similarity index 98% rename from src/source_thermal_externalheat.f90 rename to src/constitutive_thermal_externalheat.f90 index 9ba4a051b..3ef96790e 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -4,7 +4,7 @@ !> @author Philip Eisenlohr, Michigan State University !> @brief material subroutine for variable heat source !-------------------------------------------------------------------------------------------------- -submodule(constitutive:constitutive_thermal) source_thermal_externalheat +submodule(constitutive:constitutive_thermal) source_externalheat integer, dimension(:), allocatable :: & @@ -135,4 +135,4 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d end subroutine source_thermal_externalheat_getRateAndItsTangent -end submodule source_thermal_externalheat +end submodule source_externalheat From 228398e78709d9cbbbb9bf37af9a5aa40c20d3a5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 09:10:59 +0100 Subject: [PATCH 163/214] config follows structure --- src/lattice.f90 | 83 ++++++++++++++++++++++++++----------------------- 1 file changed, 44 insertions(+), 39 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 6af135e4e..c9b6d99ef 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -453,12 +453,13 @@ contains !-------------------------------------------------------------------------------------------------- subroutine lattice_init - integer :: Nphases, p,i + integer :: Nphases, ph,i class(tNode), pointer :: & phases, & phase, & mech, & - elasticity + elasticity, & + thermal print'(/,a)', ' <<<+- lattice init -+>>>'; flush(IO_STDOUT) @@ -476,67 +477,71 @@ subroutine lattice_init lattice_mu, lattice_nu,& source=[(0.0_pReal,i=1,Nphases)]) - do p = 1, phases%length - phase => phases%get(p) + do ph = 1, phases%length + phase => phases%get(ph) mech => phase%get('mechanics') elasticity => mech%get('elasticity') - lattice_C66(1,1,p) = elasticity%get_asFloat('C_11') - lattice_C66(1,2,p) = elasticity%get_asFloat('C_12') + lattice_C66(1,1,ph) = elasticity%get_asFloat('C_11') + lattice_C66(1,2,ph) = elasticity%get_asFloat('C_12') - lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) - lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) - lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) - lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) - lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) - lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) - lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) + lattice_C66(1,3,ph) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal) + lattice_C66(2,2,ph) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal) + lattice_C66(2,3,ph) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal) + lattice_C66(3,3,ph) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal) + lattice_C66(4,4,ph) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal) + lattice_C66(5,5,ph) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal) + lattice_C66(6,6,ph) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal) select case(phase%get_asString('lattice')) case('cF') - lattice_structure(p) = lattice_FCC_ID + lattice_structure(ph) = lattice_FCC_ID case('cI') - lattice_structure(p) = lattice_BCC_ID + lattice_structure(ph) = lattice_BCC_ID case('hP') - lattice_structure(p) = lattice_HEX_ID + lattice_structure(ph) = lattice_HEX_ID case('tI') - lattice_structure(p) = lattice_BCT_ID + lattice_structure(ph) = lattice_BCT_ID case('oP') - lattice_structure(p) = lattice_ORT_ID + lattice_structure(ph) = lattice_ORT_ID case('aP') - lattice_structure(p) = lattice_ISO_ID + lattice_structure(ph) = lattice_ISO_ID case default call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice')) end select - lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) + lattice_C66(1:6,1:6,ph) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,ph),phase%get_asString('lattice')) - lattice_nu(p) = lattice_equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') - lattice_mu(p) = lattice_equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') + lattice_nu(ph) = lattice_equivalent_nu(lattice_C66(1:6,1:6,ph),'voigt') + lattice_mu(ph) = lattice_equivalent_mu(lattice_C66(1:6,1:6,ph),'voigt') - lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation + lattice_C66(1:6,1:6,ph) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,ph))) ! Literature data is in Voigt notation do i = 1, 6 - if (abs(lattice_C66(i,i,p)) phase%get('thermal') + lattice_K(1,1,ph) = thermal%get_asFloat('K_11',defaultVal=0.0_pReal) + lattice_K(2,2,ph) = thermal%get_asFloat('K_22',defaultVal=0.0_pReal) + lattice_K(3,3,ph) = thermal%get_asFloat('K_33',defaultVal=0.0_pReal) + lattice_K(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,ph), & + phase%get_asString('lattice')) + lattice_c_p(ph) = thermal%get_asFloat('c_p', defaultVal=0.0_pReal) + endif + + + lattice_D(1,1,ph) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) + lattice_D(2,2,ph) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) + lattice_D(3,3,ph) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) + lattice_D(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,ph), & phase%get_asString('lattice')) - lattice_c_p(p) = phase%get_asFloat('c_p', defaultVal=0.0_pReal) - lattice_rho(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal) - - lattice_D(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal) - lattice_D(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal) - lattice_D(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal) - lattice_D(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,p), & - phase%get_asString('lattice')) - - lattice_M(p) = phase%get_asFloat('M',defaultVal=0.0_pReal) + lattice_M(ph) = phase%get_asFloat('M',defaultVal=0.0_pReal) ! SHOULD NOT BE PART OF LATTICE END call selfTest From a2d0a9e51152b302c50f670c4c77a39a30b81683 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Dec 2020 09:54:13 +0100 Subject: [PATCH 164/214] WIP: separating states --- src/constitutive.f90 | 166 ++++++++++++++++++++++++++++++----- src/constitutive_mech.f90 | 11 ++- src/constitutive_thermal.f90 | 64 ++++++++++++++ 3 files changed, 215 insertions(+), 26 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6348c18d6..a13904697 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -102,7 +102,7 @@ module constitutive type(tPlasticState), allocatable, dimension(:), public :: & plasticState type(tSourceState), allocatable, dimension(:), public :: & - sourceState + sourceState, thermalState integer, public, protected :: & @@ -139,21 +139,37 @@ module constitutive integer, intent(in) :: ph, me end subroutine mech_initializeRestorationPoints - module subroutine constitutive_mech_windForward(ph,me) + module subroutine thermal_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me - end subroutine constitutive_mech_windForward + end subroutine thermal_initializeRestorationPoints + + + module subroutine mech_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine mech_windForward + + module subroutine thermal_windForward(ph,me) + integer, intent(in) :: ph, me + end subroutine thermal_windForward + + + module subroutine mech_forward() + end subroutine mech_forward + + module subroutine thermal_forward() + end subroutine thermal_forward - module subroutine constitutive_mech_forward - end subroutine constitutive_mech_forward module subroutine mech_restore(ip,el,includeL) - integer, intent(in) :: & - ip, & - el - logical, intent(in) :: & - includeL + integer, intent(in) :: ip, el + logical, intent(in) :: includeL end subroutine mech_restore + module subroutine thermal_restore(ip,el) + integer, intent(in) :: ip, el + end subroutine thermal_restore + + module function constitutive_mech_dPdF(dt,co,ip,el) result(dPdF) real(pReal), intent(in) :: dt integer, intent(in) :: & @@ -776,6 +792,7 @@ subroutine constitutive_restore(ip,el,includeL) enddo call mech_restore(ip,el,includeL) + call thermal_restore(ip,el) end subroutine constitutive_restore @@ -784,12 +801,13 @@ end subroutine constitutive_restore !> @brief Forward data after successful increment. ! ToDo: Any guessing for the current states possible? !-------------------------------------------------------------------------------------------------- -subroutine constitutive_forward +subroutine constitutive_forward() integer :: ph, so - call constitutive_mech_forward() + call mech_forward() + call thermal_forward() do ph = 1, size(sourceState) do so = 1,phase_Nsources(ph) @@ -802,7 +820,7 @@ end subroutine constitutive_forward !-------------------------------------------------------------------------------------------------- !> @brief writes constitutive results to HDF5 output file !-------------------------------------------------------------------------------------------------- -subroutine constitutive_results +subroutine constitutive_results() integer :: ph character(len=:), allocatable :: group @@ -826,7 +844,7 @@ end subroutine constitutive_results !-------------------------------------------------------------------------------------------------- !> @brief allocates and initialize per grain variables !-------------------------------------------------------------------------------------------------- -subroutine crystallite_init +subroutine crystallite_init() integer :: & ph, & @@ -937,10 +955,12 @@ subroutine constitutive_initializeRestorationPoints(ip,el) me = material_phaseMemberAt(co,ip,el) call mech_initializeRestorationPoints(ph,me) + call thermal_initializeRestorationPoints(ph,me) - do so = 1, phase_Nsources(material_phaseAt(co,el)) + do so = 1, size(sourceState(ph)%p) sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) enddo + enddo end subroutine constitutive_initializeRestorationPoints @@ -964,10 +984,13 @@ subroutine constitutive_windForward(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - call constitutive_mech_windForward(ph,me) + call mech_windForward(ph,me) + call thermal_windForward(ph,me) + do so = 1, phase_Nsources(material_phaseAt(co,el)) sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo + enddo end subroutine constitutive_windForward @@ -1049,8 +1072,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) me = material_phaseMemberAt(co,ip,el) converged_ = .true. - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) return do so = 1, phase_Nsources(ph) @@ -1067,8 +1089,7 @@ function integrateSourceState(dt,co,ip,el) result(broken) source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) enddo - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) @@ -1122,6 +1143,111 @@ function integrateSourceState(dt,co,ip,el) result(broken) end function integrateSourceState + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +function integrateThermalState(dt,co,ip,el) result(broken) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + broken, converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) return + + do so = 1, phase_Nsources(ph) + size_so(so) = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, phase_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_thermal_collectDotState(ph,me) + broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) exit iteration + + do so = 1, phase_Nsources(ph) + zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & + - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + thermalState(ph)%p(so)%state(1:size_so(so),me), & + thermalState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) then + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) + exit iteration + endif + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateThermalState + + !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fedec379f..67b6f9fbe 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1485,7 +1485,7 @@ end subroutine mech_initializeRestorationPoints !-------------------------------------------------------------------------------------------------- !> @brief Wind homog inc forward. !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_windForward(ph,me) +module subroutine mech_windForward(ph,me) integer, intent(in) :: ph, me @@ -1499,14 +1499,14 @@ module subroutine constitutive_mech_windForward(ph,me) plasticState(ph)%partitionedState0(:,me) = plasticState(ph)%state(:,me) -end subroutine constitutive_mech_windForward +end subroutine mech_windForward !-------------------------------------------------------------------------------------------------- !> @brief Forward data after successful increment. ! ToDo: Any guessing for the current states possible? !-------------------------------------------------------------------------------------------------- -module subroutine constitutive_mech_forward() +module subroutine mech_forward() integer :: ph @@ -1521,7 +1521,7 @@ module subroutine constitutive_mech_forward() plasticState(ph)%state0 = plasticState(ph)%state enddo -end subroutine constitutive_mech_forward +end subroutine mech_forward @@ -1678,8 +1678,7 @@ module subroutine mech_restore(ip,el,includeL) constitutive_mech_Fi(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) constitutive_mech_S(ph)%data(1:3,1:3,me) = constitutive_mech_partitionedS0(ph)%data(1:3,1:3,me) - plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) + plasticState(ph)%state(:,me) = plasticState(ph)%partitionedState0(:,me) enddo end subroutine mech_restore diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index f2b61fb26..f1675f0a1 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -145,6 +145,70 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents + +module subroutine thermal_initializeRestorationPoints(ph,me) + + integer, intent(in) :: ph, me + + integer :: so + + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me) + enddo + +end subroutine thermal_initializeRestorationPoints + + + +module subroutine thermal_windForward(ph,me) + + integer, intent(in) :: ph, me + + integer :: so + + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me) + enddo + +end subroutine thermal_windForward + + +module subroutine thermal_forward() + + integer :: ph, so + + + do ph = 1, size(thermalState) + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state + enddo + enddo + +end subroutine thermal_forward + + +module subroutine thermal_restore(ip,el) + + integer, intent(in) :: ip, el + + integer :: co, ph, me, so + + + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + do so = 1, size(sourceState(ph)%p) + thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) + enddo + + enddo + +end subroutine thermal_restore + + !---------------------------------------------------------------------------------------------- !< @brief Get temperature (for use by non-thermal physics) !---------------------------------------------------------------------------------------------- From 0f28d8048b1bc7316f3f381fef96b9a9c9bd0196 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Jan 2021 17:57:11 +0100 Subject: [PATCH 165/214] KISS --- src/commercialFEM_fileList.f90 | 1 - src/quaternions.f90 | 534 --------------------------------- src/rotations.f90 | 83 +++-- 3 files changed, 57 insertions(+), 561 deletions(-) delete mode 100644 src/quaternions.f90 diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 08e7b9c1c..3e3e017eb 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -11,7 +11,6 @@ #include "config.f90" #include "LAPACK_interface.f90" #include "math.f90" -#include "quaternions.f90" #include "rotations.f90" #include "FEsolving.f90" #include "element.f90" diff --git a/src/quaternions.f90 b/src/quaternions.f90 deleted file mode 100644 index c5c43e3c1..000000000 --- a/src/quaternions.f90 +++ /dev/null @@ -1,534 +0,0 @@ -!--------------------------------------------------------------------------------------------------- -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Michigan State University -!> @brief general quaternion math, not limited to unit quaternions -!> @details w is the real part, (x, y, z) are the imaginary parts. -!> @details https://en.wikipedia.org/wiki/Quaternion -!--------------------------------------------------------------------------------------------------- -module quaternions - use prec - - implicit none - private - - real(pReal), parameter, public :: P = -1.0_pReal !< parameter for orientation conversion. - - type, public :: quaternion - real(pReal), private :: w = 0.0_pReal - real(pReal), private :: x = 0.0_pReal - real(pReal), private :: y = 0.0_pReal - real(pReal), private :: z = 0.0_pReal - - - contains - procedure, private :: add__ - procedure, private :: pos__ - generic, public :: operator(+) => add__,pos__ - - procedure, private :: sub__ - procedure, private :: neg__ - generic, public :: operator(-) => sub__,neg__ - - procedure, private :: mul_quat__ - procedure, private :: mul_scal__ - generic, public :: operator(*) => mul_quat__, mul_scal__ - - procedure, private :: div_quat__ - procedure, private :: div_scal__ - generic, public :: operator(/) => div_quat__, div_scal__ - - procedure, private :: eq__ - generic, public :: operator(==) => eq__ - - procedure, private :: neq__ - generic, public :: operator(/=) => neq__ - - procedure, private :: pow_quat__ - procedure, private :: pow_scal__ - generic, public :: operator(**) => pow_quat__, pow_scal__ - - procedure, public :: abs => abs__ - procedure, public :: conjg => conjg__ - procedure, public :: real => real__ - procedure, public :: aimag => aimag__ - - procedure, public :: homomorphed - procedure, public :: asArray - procedure, public :: inverse - - end type - - interface assignment (=) - module procedure assign_quat__ - module procedure assign_vec__ - end interface assignment (=) - - interface quaternion - module procedure init__ - end interface quaternion - - interface abs - procedure abs__ - end interface abs - - interface dot_product - procedure dot_product__ - end interface dot_product - - interface conjg - module procedure conjg__ - end interface conjg - - interface exp - module procedure exp__ - end interface exp - - interface log - module procedure log__ - end interface log - - interface real - module procedure real__ - end interface real - - interface aimag - module procedure aimag__ - end interface aimag - - public :: & - quaternions_init, & - assignment(=), & - conjg, aimag, & - log, exp, & - abs, dot_product, & - inverse, & - real - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief Do self test. -!-------------------------------------------------------------------------------------------------- -subroutine quaternions_init - - print'(/,a)', ' <<<+- quaternions init -+>>>'; flush(6) - - call selfTest - -end subroutine quaternions_init - - -!--------------------------------------------------------------------------------------------------- -!> @brief construct a quaternion from a 4-vector -!--------------------------------------------------------------------------------------------------- -type(quaternion) pure function init__(array) - - real(pReal), intent(in), dimension(4) :: array - - init__%w = array(1) - init__%x = array(2) - init__%y = array(3) - init__%z = array(4) - -end function init__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief assign a quaternion -!--------------------------------------------------------------------------------------------------- -elemental pure subroutine assign_quat__(self,other) - - type(quaternion), intent(out) :: self - type(quaternion), intent(in) :: other - - self = [other%w,other%x,other%y,other%z] - -end subroutine assign_quat__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief assign a 4-vector -!--------------------------------------------------------------------------------------------------- -pure subroutine assign_vec__(self,other) - - type(quaternion), intent(out) :: self - real(pReal), intent(in), dimension(4) :: other - - self%w = other(1) - self%x = other(2) - self%y = other(3) - self%z = other(4) - -end subroutine assign_vec__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief add a quaternion -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function add__(self,other) - - class(quaternion), intent(in) :: self,other - - add__ = [ self%w, self%x, self%y ,self%z] & - + [other%w, other%x, other%y,other%z] - -end function add__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief return (unary positive operator) -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function pos__(self) - - class(quaternion), intent(in) :: self - - pos__ = self * (+1.0_pReal) - -end function pos__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief subtract a quaternion -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function sub__(self,other) - - class(quaternion), intent(in) :: self,other - - sub__ = [ self%w, self%x, self%y ,self%z] & - - [other%w, other%x, other%y,other%z] - -end function sub__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief negate (unary negative operator) -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function neg__(self) - - class(quaternion), intent(in) :: self - - neg__ = self * (-1.0_pReal) - -end function neg__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief multiply with a quaternion -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function mul_quat__(self,other) - - class(quaternion), intent(in) :: self, other - - mul_quat__%w = self%w*other%w - self%x*other%x - self%y*other%y - self%z*other%z - mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y) - mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z) - mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x) - -end function mul_quat__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief multiply with a scalar -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function mul_scal__(self,scal) - - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal - - mul_scal__ = [self%w,self%x,self%y,self%z]*scal - -end function mul_scal__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief divide by a quaternion -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function div_quat__(self,other) - - class(quaternion), intent(in) :: self, other - - div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal)) - -end function div_quat__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief divide by a scalar -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function div_scal__(self,scal) - - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: scal - - div_scal__ = [self%w,self%x,self%y,self%z]/scal - -end function div_scal__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief test equality -!--------------------------------------------------------------------------------------------------- -logical elemental pure function eq__(self,other) - - class(quaternion), intent(in) :: self,other - - eq__ = all(dEq([ self%w, self%x, self%y, self%z], & - [other%w,other%x,other%y,other%z])) - -end function eq__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief test inequality -!--------------------------------------------------------------------------------------------------- -logical elemental pure function neq__(self,other) - - class(quaternion), intent(in) :: self,other - - neq__ = .not. self%eq__(other) - -end function neq__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief raise to the power of a quaternion -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function pow_quat__(self,expon) - - class(quaternion), intent(in) :: self - type(quaternion), intent(in) :: expon - - pow_quat__ = exp(log(self)*expon) - -end function pow_quat__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief raise to the power of a scalar -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function pow_scal__(self,expon) - - class(quaternion), intent(in) :: self - real(pReal), intent(in) :: expon - - pow_scal__ = exp(log(self)*expon) - -end function pow_scal__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief take exponential -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function exp__(a) - - class(quaternion), intent(in) :: a - real(pReal) :: absImag - - absImag = norm2(aimag(a)) - - exp__ = merge(exp(a%w) * [ cos(absImag), & - a%x/absImag * sin(absImag), & - a%y/absImag * sin(absImag), & - a%z/absImag * sin(absImag)], & - IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), & - dNeq0(absImag)) - -end function exp__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief take logarithm -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function log__(a) - - class(quaternion), intent(in) :: a - real(pReal) :: absImag - - absImag = norm2(aimag(a)) - - log__ = merge([log(abs(a)), & - a%x/absImag * acos(a%w/abs(a)), & - a%y/absImag * acos(a%w/abs(a)), & - a%z/absImag * acos(a%w/abs(a))], & - IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), & - dNeq0(absImag)) - -end function log__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief return norm -!--------------------------------------------------------------------------------------------------- -real(pReal) elemental pure function abs__(self) - - class(quaternion), intent(in) :: self - - abs__ = norm2([self%w,self%x,self%y,self%z]) - -end function abs__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief calculate dot product -!--------------------------------------------------------------------------------------------------- -real(pReal) elemental pure function dot_product__(a,b) - - class(quaternion), intent(in) :: a,b - - dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z - -end function dot_product__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief take conjugate complex -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function conjg__(self) - - class(quaternion), intent(in) :: self - - conjg__ = [self%w,-self%x,-self%y,-self%z] - -end function conjg__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief homomorph -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function homomorphed(self) - - class(quaternion), intent(in) :: self - - homomorphed = - self - -end function homomorphed - - -!--------------------------------------------------------------------------------------------------- -!> @brief return as plain array -!--------------------------------------------------------------------------------------------------- -pure function asArray(self) - - real(pReal), dimension(4) :: asArray - class(quaternion), intent(in) :: self - - asArray = [self%w,self%x,self%y,self%z] - -end function asArray - - -!--------------------------------------------------------------------------------------------------- -!> @brief real part (scalar) -!--------------------------------------------------------------------------------------------------- -pure function real__(self) - - real(pReal) :: real__ - class(quaternion), intent(in) :: self - - real__ = self%w - -end function real__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief imaginary part (3-vector) -!--------------------------------------------------------------------------------------------------- -pure function aimag__(self) - - real(pReal), dimension(3) :: aimag__ - class(quaternion), intent(in) :: self - - aimag__ = [self%x,self%y,self%z] - -end function aimag__ - - -!--------------------------------------------------------------------------------------------------- -!> @brief inverse -!--------------------------------------------------------------------------------------------------- -type(quaternion) elemental pure function inverse(self) - - class(quaternion), intent(in) :: self - - inverse = conjg(self)/abs(self)**2.0_pReal - -end function inverse - - -!-------------------------------------------------------------------------------------------------- -!> @brief check correctness of some quaternions functions -!-------------------------------------------------------------------------------------------------- -subroutine selfTest - - real(pReal), dimension(4) :: qu - type(quaternion) :: q, q_2 - - if(dNeq(abs(P),1.0_pReal)) error stop 'P not in {-1,+1}' - - call random_number(qu) - qu = (qu-0.5_pReal) * 2.0_pReal - q = quaternion(qu) - - q_2= qu - if(any(dNeq(q%asArray(),q_2%asArray()))) error stop 'assign_vec__' - - q_2 = q + q - if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) error stop 'add__' - - q_2 = q - q - if(any(dNeq0(q_2%asArray()))) error stop 'sub__' - - q_2 = q * 5.0_pReal - if(any(dNeq(q_2%asArray(),5.0_pReal*qu))) error stop 'mul__' - - q_2 = q / 0.5_pReal - if(any(dNeq(q_2%asArray(),2.0_pReal*qu))) error stop 'div__' - - q_2 = q * 0.3_pReal - if(dNeq0(abs(q)) .and. q_2 == q) error stop 'eq__' - - q_2 = q - if(q_2 /= q) error stop 'neq__' - - if(dNeq(abs(q),norm2(qu))) error stop 'abs__' - if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()),1.0e-14_pReal)) & - error stop 'abs__/*conjg' - - if(any(dNeq(q%asArray(),qu))) error stop 'eq__' - if(dNeq(q%real(), qu(1))) error stop 'real()' - if(any(dNeq(q%aimag(), qu(2:4)))) error stop 'aimag()' - - q_2 = q%homomorphed() - if(q /= q_2* (-1.0_pReal)) error stop 'homomorphed' - if(dNeq(q_2%real(), qu(1)* (-1.0_pReal))) error stop 'homomorphed/real' - if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal)))) error stop 'homomorphed/aimag' - - q_2 = conjg(q) - if(dNeq(abs(q),abs(q_2))) error stop 'conjg/abs' - if(q /= conjg(q_2)) error stop 'conjg/involution' - if(dNeq(q_2%real(), q%real())) error stop 'conjg/real' - if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal)))) error stop 'conjg/aimag' - - if(abs(q) > 0.0_pReal) then - q_2 = q * q%inverse() - if( dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal)) error stop 'inverse/real' - if(any(dNeq0(aimag(q_2), 1.0e-15_pReal))) error stop 'inverse/aimag' - - q_2 = q/abs(q) - q_2 = conjg(q_2) - inverse(q_2) - if(any(dNeq0(q_2%asArray(),1.0e-15_pReal))) error stop 'inverse/conjg' - endif - if(dNeq(dot_product(qu,qu),dot_product(q,q))) error stop 'dot_product' - -#if !(defined(__GFORTRAN__) && __GNUC__ < 9) - if (norm2(aimag(q)) > 0.0_pReal) then - if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal)) error stop 'exp/log' - if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal)) error stop 'log/exp' - endif -#endif - -end subroutine selfTest - - -end module quaternions diff --git a/src/rotations.f90 b/src/rotations.f90 index 888e73762..73f8a16a1 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -47,16 +47,16 @@ !--------------------------------------------------------------------------------------------------- module rotations - use prec use IO use math - use quaternions implicit none private + real(pReal), parameter :: P = -1.0_pReal !< parameter for orientation conversion. + type, public :: rotation - type(quaternion) :: q + real(pReal), dimension(4) :: q contains procedure, public :: asQuaternion procedure, public :: asEulers @@ -103,7 +103,6 @@ contains !-------------------------------------------------------------------------------------------------- subroutine rotations_init - call quaternions_init print'(/,a)', ' <<<+- rotations init -+>>>'; flush(IO_STDOUT) print*, 'Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015' @@ -122,7 +121,7 @@ pure function asQuaternion(self) class(rotation), intent(in) :: self real(pReal), dimension(4) :: asQuaternion - asQuaternion = self%q%asArray() + asQuaternion = self%q end function asQuaternion !--------------------------------------------------------------------------------------------------- @@ -131,7 +130,7 @@ pure function asEulers(self) class(rotation), intent(in) :: self real(pReal), dimension(3) :: asEulers - asEulers = qu2eu(self%q%asArray()) + asEulers = qu2eu(self%q) end function asEulers !--------------------------------------------------------------------------------------------------- @@ -140,7 +139,7 @@ pure function asAxisAngle(self) class(rotation), intent(in) :: self real(pReal), dimension(4) :: asAxisAngle - asAxisAngle = qu2ax(self%q%asArray()) + asAxisAngle = qu2ax(self%q) end function asAxisAngle !--------------------------------------------------------------------------------------------------- @@ -149,7 +148,7 @@ pure function asMatrix(self) class(rotation), intent(in) :: self real(pReal), dimension(3,3) :: asMatrix - asMatrix = qu2om(self%q%asArray()) + asMatrix = qu2om(self%q) end function asMatrix !--------------------------------------------------------------------------------------------------- @@ -158,7 +157,7 @@ pure function asRodrigues(self) class(rotation), intent(in) :: self real(pReal), dimension(4) :: asRodrigues - asRodrigues = qu2ro(self%q%asArray()) + asRodrigues = qu2ro(self%q) end function asRodrigues !--------------------------------------------------------------------------------------------------- @@ -167,7 +166,7 @@ pure function asHomochoric(self) class(rotation), intent(in) :: self real(pReal), dimension(3) :: asHomochoric - asHomochoric = qu2ho(self%q%asArray()) + asHomochoric = qu2ho(self%q) end function asHomochoric @@ -259,7 +258,7 @@ pure elemental function rotRot__(self,R) result(rRot) type(rotation) :: rRot class(rotation), intent(in) :: self,R - rRot = rotation(self%q*R%q) + rRot = rotation(multiply_quaternion(self%q,R%q)) call rRot%standardize() end function rotRot__ @@ -272,14 +271,14 @@ pure elemental subroutine standardize(self) class(rotation), intent(inout) :: self - if (real(self%q) < 0.0_pReal) self%q = self%q%homomorphed() + if (self%q(1) < 0.0_pReal) self%q = - self%q end subroutine standardize !--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief rotate a vector passively (default) or actively +!> @brief Rotate a vector passively (default) or actively. !--------------------------------------------------------------------------------------------------- pure function rotVector(self,v,active) result(vRot) @@ -288,9 +287,8 @@ pure function rotVector(self,v,active) result(vRot) real(pReal), intent(in), dimension(3) :: v logical, intent(in), optional :: active - real(pReal), dimension(3) :: v_normed - type(quaternion) :: q - logical :: passive + real(pReal), dimension(4) :: v_normed, q + logical :: passive if (present(active)) then passive = .not. active @@ -301,13 +299,13 @@ pure function rotVector(self,v,active) result(vRot) if (dEq0(norm2(v))) then vRot = v else - v_normed = v/norm2(v) + v_normed = [0.0_pReal,v]/norm2(v) if (passive) then - q = self%q * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * conjg(self%q) ) + q = multiply_quaternion(self%q, multiply_quaternion(v_normed, conjugate_quaternion(self%q))) else - q = conjg(self%q) * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * self%q ) + q = multiply_quaternion(conjugate_quaternion(self%q), multiply_quaternion(v_normed, self%q)) endif - vRot = q%aimag()*norm2(v) + vRot = q(2:4)*norm2(v) endif end function rotVector @@ -315,8 +313,8 @@ end function rotVector !--------------------------------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University -!> @brief rotate a rank-2 tensor passively (default) or actively -!> @details: rotation is based on rotation matrix +!> @brief Rotate a rank-2 tensor passively (default) or actively. +!> @details: Rotation is based on rotation matrix !--------------------------------------------------------------------------------------------------- pure function rotTensor2(self,T,active) result(tRot) @@ -403,7 +401,7 @@ pure elemental function misorientation(self,other) type(rotation) :: misorientation class(rotation), intent(in) :: self, other - misorientation%q = other%q * conjg(self%q) + misorientation%q = multiply_quaternion(other%q, [self%q(1),-self%q(2:4)]) end function misorientation @@ -1338,7 +1336,7 @@ end function cu2ho !-------------------------------------------------------------------------- !> @author Marc De Graef, Carnegie Mellon University !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief determine to which pyramid a point in a cubic grid belongs +!> @brief Determine to which pyramid a point in a cubic grid belongs. !-------------------------------------------------------------------------- pure function GetPyramidOrder(xyz) @@ -1362,7 +1360,39 @@ end function GetPyramidOrder !-------------------------------------------------------------------------------------------------- -!> @brief check correctness of some rotations functions +!> @brief Multiply two quaternions. +!-------------------------------------------------------------------------------------------------- +pure function multiply_quaternion(qu1,qu2) + + real(pReal), dimension(4), intent(in) :: qu1, qu2 + real(pReal), dimension(4) :: multiply_quaternion + + + multiply_quaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) - qu1(3)*qu2(3) - qu1(4)*qu2(4) + multiply_quaternion(2) = qu1(1)*qu2(2) + qu1(2)*qu2(1) + P * (qu1(3)*qu2(4) - qu1(4)*qu2(3)) + multiply_quaternion(3) = qu1(1)*qu2(3) + qu1(3)*qu2(1) + P * (qu1(4)*qu2(2) - qu1(2)*qu2(4)) + multiply_quaternion(4) = qu1(1)*qu2(4) + qu1(4)*qu2(1) + P * (qu1(2)*qu2(3) - qu1(3)*qu2(2)) + +end function multiply_quaternion + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate conjugate complex of a quaternion. +!-------------------------------------------------------------------------------------------------- +pure function conjugate_quaternion(qu) + + real(pReal), dimension(4), intent(in) :: qu + real(pReal), dimension(4) :: conjugate_quaternion + + + conjugate_quaternion = [qu(1), -qu(2), -qu(3), -qu(4)] + + +end function conjugate_quaternion + + +!-------------------------------------------------------------------------------------------------- +!> @brief Check correctness of some rotations functions. !-------------------------------------------------------------------------------------------------- subroutine selfTest @@ -1374,7 +1404,8 @@ subroutine selfTest real :: A,B integer :: i - do i=1,10 + + do i = 1, 10 #if defined(__GFORTRAN__) && __GNUC__<9 if(i<7) cycle From 6fe1ff8e393ad0af27bd3634a7774a303f304e7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 11:50:45 +0100 Subject: [PATCH 166/214] fixed test for rodrigues parametrization for angle close to 180deg, the sign of the axis does not matter --- python/damask/_rotation.py | 1 - python/tests/test_Rotation.py | 19 +++++++++++-------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 780e81891..cec3854cc 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -1052,7 +1052,6 @@ class Rotation: @staticmethod def _om2ax(om): """Rotation matrix to axis angle pair.""" - #return Rotation._qu2ax(Rotation._om2qu(om)) # HOTFIX diag_delta = -_P*np.block([om[...,1,2:3]-om[...,2,1:2], om[...,2,0:1]-om[...,0,2:3], om[...,0,1:2]-om[...,1,0:1] diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index c60029046..f8f1a3da7 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -526,7 +526,7 @@ class TestRotation: o = backward(forward(m)) u = np.array([np.pi*2,np.pi,np.pi*2]) ok = np.allclose(m,o,atol=atol) - ok = ok or np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol) + ok |= np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol) if np.isclose(m[1],0.0,atol=atol) or np.isclose(m[1],np.pi,atol=atol): sum_phi = np.unwrap([m[0]+m[2],o[0]+o[2]]) ok |= np.isclose(sum_phi[0],sum_phi[1],atol=atol) @@ -550,19 +550,22 @@ class TestRotation: assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('forward,backward',[(Rotation._ro2qu,Rotation._qu2ro), - #(Rotation._ro2om,Rotation._om2ro), - #(Rotation._ro2eu,Rotation._eu2ro), + (Rotation._ro2om,Rotation._om2ro), + (Rotation._ro2eu,Rotation._eu2ro), (Rotation._ro2ax,Rotation._ax2ro), (Rotation._ro2ho,Rotation._ho2ro), (Rotation._ro2cu,Rotation._cu2ro)]) def test_Rodrigues_internal(self,set_of_rotations,forward,backward): """Ensure invariance of conversion from Rodrigues-Frank vector and back.""" - cutoff = np.tan(np.pi*.5*(1.-1e-4)) + cutoff = np.tan(np.pi*.5*(1.-1e-5)) for rot in set_of_rotations: m = rot.as_Rodrigues_vector() o = backward(forward(m)) ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol) - ok = ok or np.isclose(m[3],0.0,atol=atol) + ok |= np.isclose(m[3],0.0,atol=atol) + if m[3] > cutoff: + ok |= np.allclose(m[:3],-1*o[:3]) + assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('forward,backward',[(Rotation._ho2qu,Rotation._qu2ho), @@ -592,7 +595,7 @@ class TestRotation: o = backward(forward(m)) ok = np.allclose(m,o,atol=atol) if np.count_nonzero(np.isclose(np.abs(o),np.pi**(2./3.)*.5)): - ok = ok or np.allclose(m*-1.,o,atol=atol) + ok |= np.allclose(m*-1.,o,atol=atol) assert ok and np.max(np.abs(o)) < np.pi**(2./3.) * 0.5 + 1.e-9, f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('vectorized, single',[(Rotation._qu2om,qu2om), @@ -719,7 +722,7 @@ class TestRotation: o = Rotation.from_axis_angle(rot.as_axis_angle()).as_axis_angle() ok = np.allclose(m,o,atol=atol) if np.isclose(m[3],np.pi,atol=atol): - ok = ok or np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol) + ok |= np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol) assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) \ and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}' @@ -740,7 +743,7 @@ class TestRotation: m = rot.as_Rodrigues_vector() o = Rotation.from_homochoric(rot.as_homochoric()*P*-1,P).as_Rodrigues_vector() ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol) - ok = ok or np.isclose(m[3],0.0,atol=atol) + ok |= np.isclose(m[3],0.0,atol=atol) assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}' @pytest.mark.parametrize('P',[1,-1]) From 35ca1ffb0a9827fbcee58e46eeb4a936b5bac792 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 12:03:40 +0100 Subject: [PATCH 167/214] consistent copy functionality --- python/damask/_config.py | 11 +++++++++++ python/damask/_configmaterial.py | 4 ++-- python/damask/_grid.py | 7 ++----- python/damask/_orientation.py | 2 +- python/damask/_rotation.py | 3 +-- python/damask/_table.py | 6 ++---- 6 files changed, 19 insertions(+), 14 deletions(-) diff --git a/python/damask/_config.py b/python/damask/_config.py index 76955588f..91be5ebf1 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -1,3 +1,4 @@ +import copy from io import StringIO import abc @@ -35,6 +36,14 @@ class Config(dict): output.seek(0) return ''.join(output.readlines()) + + def __copy__(self): + """Create deep copy.""" + return copy.deepcopy(self) + + copy = __copy__ + + @classmethod def load(cls,fname): """ @@ -52,6 +61,7 @@ class Config(dict): fhandle = fname return cls(yaml.safe_load(fhandle)) + def save(self,fname,**kwargs): """ Save to yaml file. @@ -95,6 +105,7 @@ class Config(dict): """Check for completeness.""" pass + @property @abc.abstractmethod def is_valid(self): diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index b94e9897a..43a59eb1e 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -204,7 +204,7 @@ class ConfigMaterial(Config): Limit renaming to selected constituents. """ - dup = copy.deepcopy(self) + dup = self.copy() for i,m in enumerate(dup['material']): if ID and i not in ID: continue for c in m['constituents']: @@ -228,7 +228,7 @@ class ConfigMaterial(Config): Limit renaming to selected homogenization IDs. """ - dup = copy.deepcopy(self) + dup = self.copy() for i,m in enumerate(dup['material']): if ID and i not in ID: continue try: diff --git a/python/damask/_grid.py b/python/damask/_grid.py index 8380bbc5b..76ce7ba64 100644 --- a/python/damask/_grid.py +++ b/python/damask/_grid.py @@ -57,13 +57,10 @@ class Grid: def __copy__(self): - """Copy grid.""" + """Create deep copy.""" return copy.deepcopy(self) - - def copy(self): - """Copy grid.""" - return self.__copy__() + copy = __copy__ def diff(self,other): diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index 05301561f..4bd8a1e96 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -199,7 +199,7 @@ class Orientation(Rotation): def __copy__(self,**kwargs): - """Copy.""" + """Create deep copy.""" return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion, lattice =kwargs['lattice'] if 'lattice' in kwargs else self.lattice if self.lattice is not None else self.family, diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index cec3854cc..492ca8d2d 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -78,9 +78,8 @@ class Rotation: ]) - # ToDo: Check difference __copy__ vs __deepcopy__ def __copy__(self,**kwargs): - """Copy.""" + """Create deep copy.""" return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion) copy = __copy__ diff --git a/python/damask/_table.py b/python/damask/_table.py index e6e6c4eeb..78a8a276e 100644 --- a/python/damask/_table.py +++ b/python/damask/_table.py @@ -42,12 +42,10 @@ class Table: return len(self.data) def __copy__(self): - """Copy Table.""" + """Create deep copy.""" return copy.deepcopy(self) - def copy(self): - """Copy Table.""" - return self.__copy__() + copy = __copy__ def _label_discrete(self): From 9a278daa3f2b19a4389dd7cb173974f4ccf5eee0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 12:07:02 +0100 Subject: [PATCH 168/214] copy not needed YAML writer does not write out references anymore --- python/damask/_configmaterial.py | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index 43a59eb1e..83ebdd5a5 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -1,5 +1,3 @@ -import copy - import numpy as np from . import Config @@ -289,7 +287,7 @@ class ConfigMaterial(Config): c = [{} for _ in range(length)] if constituents is None else \ [{'constituents':u} for u in ConfigMaterial._constituents(**constituents)] - if len(c) == 1: c = [copy.deepcopy(c[0]) for _ in range(length)] + if len(c) == 1: c = [c[0] for _ in range(length)] if length != 1 and length != len(c): raise ValueError('Cannot add entries of different length') @@ -301,7 +299,7 @@ class ConfigMaterial(Config): else: for i in range(len(c)): c[i][k] = v - dup = copy.deepcopy(self) + dup = self.copy() dup['material'] = dup['material'] + c if 'material' in dup else c return dup From 5f1399acc37529e5b2bfa3d12be666823259f23b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 12:09:21 +0100 Subject: [PATCH 169/214] consistent behavior with other classes python dictionary operates in-place, so wrappers for out-of-place behavior let it use like the other DAMASK classes --- python/damask/_config.py | 24 ++++++++++++++++++++++++ python/tests/test_Config.py | 4 ++++ 2 files changed, 28 insertions(+) diff --git a/python/damask/_config.py b/python/damask/_config.py index 91be5ebf1..c7e937656 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -99,6 +99,30 @@ class Config(dict): fhandle.write(yaml.dump(self,Dumper=NiceDumper,**kwargs)) + def add(self,d): + """ + Add dictionary. + + d : dict + Dictionary to append. + """ + duplicate = self.copy() + duplicate.update(d) + return duplicate + + + def delete(self,key): + """ + Delete item. + + key : dict + Label of the key to remove. + """ + duplicate = self.copy() + del duplicate[key] + return duplicate + + @property @abc.abstractmethod def is_complete(self): diff --git a/python/tests/test_Config.py b/python/tests/test_Config.py index 67c419b3e..0319fb6de 100644 --- a/python/tests/test_Config.py +++ b/python/tests/test_Config.py @@ -22,6 +22,10 @@ class TestConfig: with open(tmp_path/'config.yaml') as f: assert Config.load(f) == config + def test_add_remove(self): + config = Config() + assert config.add({'hello':'world'}).delete('hello') == config + def test_repr(self,tmp_path): config = Config() config['A'] = 1 From 80b8693a66dcc99e038a5a2a429f3e5a6e984912 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 12:10:39 +0100 Subject: [PATCH 170/214] avoid adding to existing data, i.e. when reading a file --- python/damask/_configmaterial.py | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/python/damask/_configmaterial.py b/python/damask/_configmaterial.py index 83ebdd5a5..6415ee4dc 100644 --- a/python/damask/_configmaterial.py +++ b/python/damask/_configmaterial.py @@ -11,11 +11,10 @@ class ConfigMaterial(Config): 'homogenization': {}, 'phase': {}} - def __init__(self,d={}): + def __init__(self,d=_defaults): """Initialize object with default dictionary keys.""" super().__init__(d) - for k,v in self._defaults.items(): - if k not in self: self[k] = v + def save(self,fname='material.yaml',**kwargs): """ From 98723cb0ed5155d83bf6e2605e35466d575e40bd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 15:50:15 +0100 Subject: [PATCH 171/214] need to handle special case of Re() = 0 ensuring that the real part is positive seems to be a good idea on first sight, but it would be easier to simply acknowledge that qu = -qu --- python/damask/_rotation.py | 4 +++- python/tests/test_Rotation.py | 6 ++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 492ca8d2d..4b03e8f56 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -105,8 +105,10 @@ class Rotation: Rotation to check for equality. """ + ambiguous = np.isclose(self.quaternion[...,0],0) return np.prod(self.shape,dtype=int) == np.prod(other.shape,dtype=int) \ - and np.allclose(self.quaternion,other.quaternion) + and ( np.allclose(self.quaternion,other.quaternion) \ + or np.allclose(self.quaternion[ambiguous],-1*other.quaternion[ambiguous])) @property diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index f8f1a3da7..bc6614fb9 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -786,6 +786,12 @@ class TestRotation: def test_equal(self): assert Rotation.from_random(rng_seed=1) == Rotation.from_random(rng_seed=1) + def test_equal_ambiguous(self): + qu = np.random.rand(10,4) + qu[:,0] = 0. + qu/=np.linalg.norm(qu,axis=1,keepdims=True) + assert Rotation(qu) == Rotation(-qu) + def test_inversion(self): r = Rotation.from_random() assert r == ~~r From f48a4463535761071bafeab9639122163b564750 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 15:54:41 +0100 Subject: [PATCH 172/214] compatible with scipy.spatial.transform.Rotation also introduced inplace variants and '/' as multiplicative inverse of '*' --- python/damask/_rotation.py | 85 ++++++++++++++++++++++++++++++++++- python/tests/test_Rotation.py | 39 ++++++++++++++++ 2 files changed, 122 insertions(+), 2 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 4b03e8f56..9fb83af7b 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -144,10 +144,91 @@ class Rotation: p = self.quaternion[...,1:]/np.linalg.norm(self.quaternion[...,1:],axis=-1,keepdims=True) return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize()) + def __ipow__(self,pwr): + """ + Raise quaternion to power (in-place). + + Equivalent to performing the rotation 'pwr' times. + + Parameters + ---------- + pwr : float + Power to raise quaternion to. + + """ + return self**pwr + def __mul__(self,other): - """Standard multiplication is not implemented.""" - raise NotImplementedError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + """ + Compose this rotation with other. + + Parameters + ---------- + other : damask.Rotation of shape(self.shape) + Rotation for comosition. + + """ + if isinstance(other,Rotation): + return self@other + else: + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + + def __imul__(self,other): + """ + Compose this rotation with other (in-place). + + Parameters + ---------- + other : damask.Rotation of shape(self.shape) + Rotation for comosition. + + """ + return self*other + + + def __truediv__(self,other): + """ + Compose this rotation with inverse of other. + + Parameters + ---------- + other : damask.Rotation of shape (self.shape) + Rotation to inverse composition. + + """ + if isinstance(other,Rotation): + return self@~other + else: + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + + def __itruediv__(self,other): + """ + Compose this rotation with inverse of other (in-place). + + Parameters + ---------- + other : damask.Rotation of shape (self.shape) + Rotation to inverse composition. + + """ + return self/other + + + def apply(self,other): + """ + Apply rotation to vector or second/forth order tensor field. + + Parameters + ---------- + other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Vector or tensor on which the rotation is apply + + """ + if isinstance(other,np.ndarray): + return self@other + else: + raise TypeError('Use "R1*R2" or "R1/R2", to compose rotations') def __matmul__(self,other): diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index bc6614fb9..5aed0bea2 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -974,6 +974,45 @@ class TestRotation: R_2 = Rotation.from_Euler_angles([360,0,0],degrees=True) assert np.allclose(R_1.misorientation(R_2).as_matrix(),np.eye(3)) + def test_composition(self): + a,b = (Rotation.from_random(),Rotation.from_random()) + c = a * b + a *= b + assert c == a + + def test_composition_invalid(self): + with pytest.raises(TypeError): + Rotation()*np.ones(3) + + def test_composition_inverse(self): + a,b = (Rotation.from_random(),Rotation.from_random()) + c = a / b + a /= b + assert c == a + + def test_composition_inverse_invalid(self): + with pytest.raises(TypeError): + Rotation()/np.ones(3) + + def test_power(self): + a = Rotation.from_random() + r = (np.random.rand()-.5)*4 + b = a**r + a **= r + assert a == b + + def test_invariant(self): + R = Rotation.from_random() + assert R/R == R*R**(-1) == Rotation() + + @pytest.mark.parametrize('vec',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) + def test_apply(self,vec): + assert (Rotation().from_random().apply(vec)).all() + + def test_apply_invalid(self): + with pytest.raises(TypeError): + Rotation().apply(Rotation()) + @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120]) def test_average(self,angle): R = Rotation.from_axis_angle([[0,0,1,10],[0,0,1,angle]],degrees=True) From b705be96833e4154f644a90922bcf4b8cd7561f6 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 19:27:56 +0100 Subject: [PATCH 173/214] don't mix space and tabstops --- .gitmodules | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitmodules b/.gitmodules index 0587fff4c..c415745bc 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,5 +1,5 @@ [submodule "PRIVATE"] - path = PRIVATE + path = PRIVATE url = ../PRIVATE.git branch = master - shallow = true + shallow = true From d8b4b7e0f596986f1d3aaeb72d757037a41af009 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Jan 2021 21:49:01 +0100 Subject: [PATCH 174/214] != and == work componentwise --- python/damask/_orientation.py | 19 +++++++++++++++---- python/damask/_rotation.py | 27 ++++++++++++++++++++++----- python/tests/test_Orientation.py | 9 ++++++--- python/tests/test_Rotation.py | 18 +++++++++++++----- 4 files changed, 56 insertions(+), 17 deletions(-) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index 4bd8a1e96..d5be5a751 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -225,10 +225,21 @@ class Orientation(Rotation): Orientation to check for equality. """ - return super().__eq__(other) \ - and self.family == other.family \ - and self.lattice == other.lattice \ - and self.parameters == other.parameters + matching_type = all([hasattr(other,attr) and getattr(self,attr) == getattr(other,attr) + for attr in ['family','lattice','parameters']]) + return np.logical_and(super().__eq__(other),matching_type) + + def __ne__(self,other): + """ + Not equal to other. + + Parameters + ---------- + other : Orientation + Orientation to check for equality. + + """ + return np.logical_not(self==other) def __matmul__(self,other): diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 9fb83af7b..50b7a3678 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -66,7 +66,7 @@ class Rotation: def __repr__(self): """Represent rotation as unit quaternion, rotation matrix, and Bunge-Euler angles.""" - if self == Rotation(): + if self.shape == () and self == Rotation(): return 'Rotation()' else: return f'Quaternions {self.shape}:\n'+str(self.quaternion) \ @@ -105,10 +105,27 @@ class Rotation: Rotation to check for equality. """ - ambiguous = np.isclose(self.quaternion[...,0],0) - return np.prod(self.shape,dtype=int) == np.prod(other.shape,dtype=int) \ - and ( np.allclose(self.quaternion,other.quaternion) \ - or np.allclose(self.quaternion[ambiguous],-1*other.quaternion[ambiguous])) + s = self.quaternion + o = other.quaternion + if self.shape == () == other.shape: + return np.allclose(s,o) or (np.isclose(s[0],0.0) and np.allclose(s,-1.0*o)) + else: + return np.all(np.isclose(s,o),-1) + np.all(np.isclose(s,-1.0*o),-1) * np.isclose(s[...,0],0.0) + + def __ne__(self,other): + """ + Not equal to other. + + Equality is determined taking limited floating point precision into + account. See numpy.allclose for details. + + Parameters + ---------- + other : Rotation + Rotation to check for equality. + + """ + return np.logical_not(self==other) @property diff --git a/python/tests/test_Orientation.py b/python/tests/test_Orientation.py index 5ab0361a8..436b73c04 100644 --- a/python/tests/test_Orientation.py +++ b/python/tests/test_Orientation.py @@ -25,13 +25,16 @@ class TestOrientation: @pytest.mark.parametrize('shape',[None,5,(4,6)]) def test_equal(self,lattice,shape): R = Rotation.from_random(shape) - assert Orientation(R,lattice) == Orientation(R,lattice) + assert Orientation(R,lattice) == Orientation(R,lattice) if shape is None else \ + (Orientation(R,lattice) == Orientation(R,lattice)).all() + @pytest.mark.parametrize('lattice',Orientation.crystal_families) @pytest.mark.parametrize('shape',[None,5,(4,6)]) def test_unequal(self,lattice,shape): R = Rotation.from_random(shape) - assert not(Orientation(R,lattice) != Orientation(R,lattice)) + assert not ( Orientation(R,lattice) != Orientation(R,lattice) if shape is None else \ + (Orientation(R,lattice) != Orientation(R,lattice)).any()) @pytest.mark.parametrize('a,b',[ (dict(rotation=[1,0,0,0]), @@ -403,7 +406,7 @@ class TestOrientation: def test_relationship_vectorize(self,set_of_quaternions,lattice,model): r = Orientation(rotation=set_of_quaternions[:200].reshape((50,4,4)),lattice=lattice).related(model) for i in range(200): - assert r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model) + assert (r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)).all() @pytest.mark.parametrize('model',['Bain','KS','GT','GT_prime','NW','Pitsch']) @pytest.mark.parametrize('lattice',['cF','cI']) diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 5aed0bea2..014efda99 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -783,14 +783,22 @@ class TestRotation: else: assert r.shape == shape - def test_equal(self): - assert Rotation.from_random(rng_seed=1) == Rotation.from_random(rng_seed=1) + @pytest.mark.parametrize('shape',[None,5,(4,6)]) + def test_equal(self,shape): + R = Rotation.from_random(shape,rng_seed=1) + assert R == R if shape is None else (R == R).all() + + @pytest.mark.parametrize('shape',[None,5,(4,6)]) + def test_unequal(self,shape): + R = Rotation.from_random(shape,rng_seed=1) + assert not (R != R if shape is None else (R != R).any()) + def test_equal_ambiguous(self): qu = np.random.rand(10,4) qu[:,0] = 0. qu/=np.linalg.norm(qu,axis=1,keepdims=True) - assert Rotation(qu) == Rotation(-qu) + assert (Rotation(qu) == Rotation(-qu)).all() def test_inversion(self): r = Rotation.from_random() @@ -807,7 +815,7 @@ class TestRotation: p = Rotation.from_random(shape=shape) s = r.append(p) print(f'append 2x {shape} --> {s.shape}') - assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] + assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() @pytest.mark.parametrize('quat,standardized',[ ([-1,0,0,0],[1,0,0,0]), @@ -829,7 +837,7 @@ class TestRotation: @pytest.mark.parametrize('order',['C','F']) def test_flatten_reshape(self,shape,order): r = Rotation.from_random(shape=shape) - assert r == r.flatten(order).reshape(shape,order) + assert (r == r.flatten(order).reshape(shape,order)).all() @pytest.mark.parametrize('function',[Rotation.from_quaternion, Rotation.from_Euler_angles, From acbb564afc58eaf30524cedd535de028837ea3dd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Jan 2021 07:23:14 +0100 Subject: [PATCH 175/214] restored functionalitity for adding list. got accidently lost --- python/damask/_rotation.py | 12 ++++++++++-- python/tests/test_Rotation.py | 8 ++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 50b7a3678..b7be4f16d 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -303,8 +303,16 @@ class Rotation: def append(self,other): - """Extend rotation array along first dimension with other array.""" - return self.copy(rotation=np.vstack((self.quaternion,other.quaternion))) + """ + Extend rotation array along first dimension with other array(s). + + Parameters + ---------- + other : Rotation or list of Rotations. + + """ + return self.copy(rotation=np.vstack(tuple(map(lambda x:x.quaternion, + [self]+other if isinstance(other,list) else [self,other])))) def flatten(self,order = 'C'): diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 014efda99..3def59213 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -817,6 +817,14 @@ class TestRotation: print(f'append 2x {shape} --> {s.shape}') assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() + @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)]) + def test_append_list(self,shape): + r = Rotation.from_random(shape=shape) + p = Rotation.from_random(shape=shape) + s = r.append([r,p]) + print(f'append 3x {shape} --> {s.shape}') + assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() + @pytest.mark.parametrize('quat,standardized',[ ([-1,0,0,0],[1,0,0,0]), ([-0.5,-0.5,-0.5,-0.5],[0.5,0.5,0.5,0.5]), From e8b3e0f3eea3d12ba657aaf13524f7434a07e83f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Jan 2021 10:01:24 +0100 Subject: [PATCH 176/214] fail as early as possible --- CMakeLists.txt | 2 +- src/DAMASK_interface.f90 | 6 ------ 2 files changed, 1 insertion(+), 7 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 8db6dd0c0..198528b59 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ include (FindPkgConfig REQUIRED) # Dummy project to determine compiler names and version project (Prerequisites LANGUAGES) set(ENV{PKG_CONFIG_PATH} "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/pkgconfig") -pkg_search_module (PETSC REQUIRED PETSc>3.12.0) +pkg_check_modules (PETSC REQUIRED PETSc>=3.12.0 PETSc<3.15.0) pkg_get_variable (CMAKE_Fortran_COMPILER PETSc fcompiler) pkg_get_variable (CMAKE_C_COMPILER PETSc ccompiler) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index d38020225..c43e354a2 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -54,12 +54,6 @@ subroutine DAMASK_interface_init =================================================================================================== -- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION -- =================================================================================================== -============ THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION ======================== -=============== THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION ===================== -================== THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION ================== -=================================================================================================== --- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION -- -=================================================================================================== #endif character(len=pPathLen*3+pStringLen) :: & From 69c11383cfd4e5f7d91a82b1001087bf67c21743 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 6 Jan 2021 13:37:45 +0100 Subject: [PATCH 177/214] better use function --- src/rotations.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/rotations.f90 b/src/rotations.f90 index 73f8a16a1..57dd16b53 100644 --- a/src/rotations.f90 +++ b/src/rotations.f90 @@ -401,7 +401,7 @@ pure elemental function misorientation(self,other) type(rotation) :: misorientation class(rotation), intent(in) :: self, other - misorientation%q = multiply_quaternion(other%q, [self%q(1),-self%q(2:4)]) + misorientation%q = multiply_quaternion(other%q, conjugate_quaternion(self%q)) end function misorientation From 437d91495bd54e29af1ba1b4e555a513844ea1f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 6 Jan 2021 14:24:02 +0100 Subject: [PATCH 178/214] No FEsolving --- src/CPFEM.f90 | 5 +- src/CPFEM2.f90 | 1 - src/DAMASK_marc.f90 | 1 - src/FEsolving.f90 | 15 ---- src/commercialFEM_fileList.f90 | 1 - src/constitutive.f90 | 55 ++++++-------- src/grid/discretization_grid.f90 | 4 -- src/grid/grid_mech_FEM.f90 | 1 - src/grid/grid_mech_spectral_basic.f90 | 1 - src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 +- src/homogenization.f90 | 76 +++++++++----------- src/homogenization_mech.f90 | 24 +++---- src/marc/discretization_marc.f90 | 4 -- src/mesh/DAMASK_mesh.f90 | 1 - src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 6 +- 17 files changed, 72 insertions(+), 130 deletions(-) delete mode 100644 src/FEsolving.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index abbcce04a..240688a8c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -5,7 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM use prec - use FEsolving use math use rotations use YAML_types @@ -197,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6) else validCalculation - FEsolving_execElem = elCP - FEsolving_execIP = ip if (debugCPFEM%extensive) & print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip - call materialpoint_stressAndItsTangent(dt) + call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP]) terminalIllness: if (terminallyIll) then diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 44b93d1cb..5a500875d 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -6,7 +6,6 @@ module CPFEM2 use prec use config - use FEsolving use math use rotations use YAML_types diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index ea7430c6b..0ad68445c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use DAMASK_interface use config use YAML_types - use FEsolving use discretization_marc use homogenization use CPFEM diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 deleted file mode 100644 index 3fc1482d3..000000000 --- a/src/FEsolving.f90 +++ /dev/null @@ -1,15 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief global variables for flow control -!-------------------------------------------------------------------------------------------------- -module FEsolving - - implicit none - public - - integer, dimension(2) :: & - FEsolving_execElem, & !< for ping-pong scheme always whole range, otherwise one specific element - FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - -end module FEsolving diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 08e7b9c1c..d8ab6390d 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,7 +13,6 @@ #include "math.f90" #include "quaternions.f90" #include "rotations.f90" -#include "FEsolving.f90" #include "element.f90" #include "HDF5_utilities.f90" #include "results.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7e380f8cd..b3fb0b246 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -16,7 +16,6 @@ module constitutive use parallelization use HDF5_utilities use DAMASK_interface - use FEsolving use results implicit none @@ -940,8 +939,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -967,14 +966,14 @@ subroutine crystallite_init crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 - call crystallite_orientations() !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + call crystallite_orientations(co,ip,el) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo @@ -1089,7 +1088,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) el !< counter in element loop integer :: & o, & - p, pp, m + p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & @@ -1109,19 +1108,19 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) - invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) - invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) @@ -1150,7 +1149,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- @@ -1210,34 +1209,20 @@ end function crystallite_stressTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations +subroutine crystallite_orientations(co,ip,el) - integer & + integer, intent(in) :: & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el !< counter in element loop - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) - enddo; enddo; enddo - !$OMP END PARALLEL DO + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + + if (plasticState(material_phaseAt(1,el))%nonlocal) & + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - nonlocalPresent: if (any(plasticState%nonlocal)) then - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,el))%nonlocal) then - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - enddo - endif - enddo - !$OMP END PARALLEL DO - endif nonlocalPresent end subroutine crystallite_orientations diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 1b3700c14..48ad5b7e1 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -19,7 +19,6 @@ module discretization_grid use results use discretization use geometry_plastic_nonlocal - use FEsolving implicit none private @@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart) (grid(1)+1) * (grid(2)+1) * grid3,& ! ...unless not last process worldrank+1==worldsize)) - FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements - FEsolving_execIP = [1,1] ! parallel loop bounds set to comprise the only IP - !-------------------------------------------------------------------------------------------------- ! store geometry information for post processing if(.not. restart) then diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index cdf806b35..003f568c6 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -18,7 +18,6 @@ module grid_mech_FEM use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ebaaf3b55..9bc36165f 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_basic use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 9f2a17c97..7160c1adc 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c0c84233d..e8bae223a 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -810,9 +810,9 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& print'(/,a)', ' ... evaluating constitutive response ......................................' flush(IO_STDOUT) - homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3]) ! calculate P field P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 27fdb6064..ebf5fd50d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -11,7 +11,6 @@ module homogenization use math use material use constitutive - use FEsolving use discretization use thermal_isothermal use thermal_conduction @@ -144,27 +143,29 @@ end subroutine homogenization_init !-------------------------------------------------------------------------------------------------- !> @brief parallelized calculation of stress and corresponding tangent at material points !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_stressAndItsTangent(dt) +subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem) real(pReal), intent(in) :: dt !< time increment + integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce + myNgrains, co, ce, ho real(pReal) :: & subFrac, & subStep logical :: & - requested, & converged logical, dimension(2) :: & doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,requested,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) !-------------------------------------------------------------------------------------------------- @@ -174,21 +175,19 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac = 0.0_pReal converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested = .true. ! everybody requires calculation - if (homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) + if (homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + + if (damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - if (damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) - if (converged) then subFrac = subFrac + subStep subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration @@ -198,22 +197,20 @@ subroutine materialpoint_stressAndItsTangent(dt) ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) then ! so first signals terminally ill... + if (.not. terminallyIll) & ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback @@ -221,23 +218,19 @@ subroutine materialpoint_stressAndItsTangent(dt) call crystallite_restore(ip,el,subStep < 1.0_pReal) call constitutive_restore(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif endif - if (subStep > num%subStepMinHomog) then - requested = .true. - doneAndHappy = [.false.,.true.] - endif - + if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested & + convergenceLooping: do while (.not. terminallyIll & .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 @@ -245,7 +238,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested .and. .not. doneAndHappy(1)) then ! requested but not yet done + if (.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& @@ -255,10 +248,7 @@ subroutine materialpoint_stressAndItsTangent(dt) do co = 1, myNgrains converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) enddo - endif - - if (requested .and. .not. doneAndHappy(1)) then if (.not. converged) then doneAndHappy = [.true.,.false.] else @@ -281,10 +271,14 @@ subroutine materialpoint_stressAndItsTangent(dt) !$OMP END PARALLEL DO if (.not. terminallyIll ) then - call crystallite_orientations() ! calculate crystal orientations - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(ho,myNgrains) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1, myNgrains + call crystallite_orientations(co,ip,el) + enddo call mech_homogenize(ip,el) enddo IpLooping3 enddo elementLooping3 diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 56f1e554f..e4499e9b7 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -128,35 +128,35 @@ module subroutine mech_homogenize(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c,m + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - m = (el-1)* discretization_nIPs + ip + ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,m) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,m) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index ca0b54b73..675e57bd3 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -12,7 +12,6 @@ module discretization_marc use DAMASK_interface use IO use config - use FEsolving use element use discretization use geometry_plastic_nonlocal @@ -89,9 +88,6 @@ subroutine discretization_marc_init if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,nElems] - FEsolving_execIP = [1,elem%nIPs] - allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) call buildCells(connectivity_cell,cellNodeDefinition,& diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 1e353892c..7369520c1 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -15,7 +15,6 @@ program DAMASK_mesh use IO use math use CPFEM2 - use FEsolving use config use discretization_mesh use FEM_Utilities diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index cb81f1f0c..2f3633e11 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -160,7 +160,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) print'(/,a)', ' ... evaluating constitutive response ......................................' - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems]) ! calculate P field cutBack = .false. ! reset cutBack status diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 7dbd05e46..21c5feace 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -18,7 +18,6 @@ module discretization_mesh use config use discretization use results - use FEsolving use FEM_quadrature use YAML_types use prec @@ -30,7 +29,7 @@ module discretization_mesh mesh_Nboundaries, & mesh_NcpElemsGlobal - integer :: & + integer, public, protected :: & mesh_NcpElems !< total number of CP elements in mesh !!!! BEGIN DEPRECATED !!!!! @@ -174,9 +173,6 @@ subroutine discretization_mesh_init(restart) if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements - FEsolving_execIP = [1,mesh_maxNips] - allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call discretization_init(materialAt,& From 959c18c85e4ca397453dc3db15096ef7eb3e9108 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 6 Jan 2021 14:24:52 +0100 Subject: [PATCH 179/214] No crystallite _converged --- src/CPFEM.f90 | 5 +- src/CPFEM2.f90 | 1 - src/DAMASK_marc.f90 | 1 - src/FEsolving.f90 | 15 ---- src/commercialFEM_fileList.f90 | 1 - src/constitutive.f90 | 83 ++++++++------------ src/constitutive_mech.f90 | 73 +++++++---------- src/grid/discretization_grid.f90 | 4 - src/grid/grid_mech_FEM.f90 | 1 - src/grid/grid_mech_spectral_basic.f90 | 1 - src/grid/grid_mech_spectral_polarisation.f90 | 1 - src/grid/spectral_utilities.f90 | 4 +- src/homogenization.f90 | 76 +++++++++--------- src/homogenization_mech.f90 | 24 +++--- src/marc/discretization_marc.f90 | 4 - src/mesh/DAMASK_mesh.f90 | 1 - src/mesh/FEM_utilities.f90 | 2 +- src/mesh/discretization_mesh.f90 | 6 +- 18 files changed, 113 insertions(+), 190 deletions(-) delete mode 100644 src/FEsolving.f90 diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index abbcce04a..240688a8c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -5,7 +5,6 @@ !-------------------------------------------------------------------------------------------------- module CPFEM use prec - use FEsolving use math use rotations use YAML_types @@ -197,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6) else validCalculation - FEsolving_execElem = elCP - FEsolving_execIP = ip if (debugCPFEM%extensive) & print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip - call materialpoint_stressAndItsTangent(dt) + call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP]) terminalIllness: if (terminallyIll) then diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 44b93d1cb..5a500875d 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -6,7 +6,6 @@ module CPFEM2 use prec use config - use FEsolving use math use rotations use YAML_types diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index ea7430c6b..0ad68445c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & use DAMASK_interface use config use YAML_types - use FEsolving use discretization_marc use homogenization use CPFEM diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 deleted file mode 100644 index 3fc1482d3..000000000 --- a/src/FEsolving.f90 +++ /dev/null @@ -1,15 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief global variables for flow control -!-------------------------------------------------------------------------------------------------- -module FEsolving - - implicit none - public - - integer, dimension(2) :: & - FEsolving_execElem, & !< for ping-pong scheme always whole range, otherwise one specific element - FEsolving_execIP !< for ping-pong scheme always range to max IP, otherwise one specific IP - -end module FEsolving diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 08e7b9c1c..d8ab6390d 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,7 +13,6 @@ #include "math.f90" #include "quaternions.f90" #include "rotations.f90" -#include "FEsolving.f90" #include "element.f90" #include "HDF5_utilities.f90" #include "results.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7e380f8cd..e65ce864d 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -16,7 +16,6 @@ module constitutive use parallelization use HDF5_utilities use DAMASK_interface - use FEsolving use results implicit none @@ -65,10 +64,6 @@ module constitutive real(pReal), dimension(:,:,:,:,:), allocatable, public :: & crystallite_partitionedF !< def grad to be reached at end of homog inc - logical, dimension(:,:,:), allocatable :: & - crystallite_converged !< convergence flag - - type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data end type @@ -186,10 +181,10 @@ module constitutive ! == cleaned:end =================================================================================== - module function crystallite_stress(dt,co,ip,el) + module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: co, ip, el - logical :: crystallite_stress + logical :: converged_ end function crystallite_stress module function constitutive_homogenizedC(co,ip,el) result(C) @@ -873,10 +868,8 @@ subroutine crystallite_init source = crystallite_partitionedF) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) - allocate(crystallite_orientation(cMax,iMax,eMax)) - allocate(crystallite_converged(cMax,iMax,eMax), source=.true.) num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) @@ -940,8 +933,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1), FEsolving_execIP(2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -967,14 +960,14 @@ subroutine crystallite_init crystallite_partitionedF0 = crystallite_F0 crystallite_partitionedF = crystallite_F0 - call crystallite_orientations() !$OMP PARALLEL DO PRIVATE(ph,me) - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do el = 1, size(material_phaseMemberAt,3) + do ip = 1, size(material_phaseMemberAt,2) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + call crystallite_orientations(co,ip,el) call constitutive_plastic_dependentState(crystallite_partitionedF0(1:3,1:3,co,ip,el),co,ip,el) ! update dependent state variables to be consistent with basic states enddo enddo @@ -1089,7 +1082,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) el !< counter in element loop integer :: & o, & - p, pp, m + p, ph, me real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & @@ -1109,19 +1102,19 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error - pp = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) call constitutive_hooke_SandItsTangents(devNull,dSdFe,dSdFi, & crystallite_Fe(1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) call constitutive_LiAndItsTangents(devNull,dLidS,dLidFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m), & + constitutive_mech_Fi(ph)%data(1:3,1:3,me), & co,ip,el) - invFp = math_inv33(constitutive_mech_Fp(pp)%data(1:3,1:3,m)) - invFi = math_inv33(constitutive_mech_Fi(pp)%data(1:3,1:3,m)) + invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me)) + invFi = math_inv33(constitutive_mech_Fi(ph)%data(1:3,1:3,me)) invSubFp0 = math_inv33(crystallite_subFp0(1:3,1:3,co,ip,el)) invSubFi0 = math_inv33(crystallite_subFi0(1:3,1:3,co,ip,el)) @@ -1150,7 +1143,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) call constitutive_plastic_LpAndItsTangents(devNull,dLpdS,dLpdFi, & crystallite_S (1:3,1:3,co,ip,el), & - constitutive_mech_Fi(pp)%data(1:3,1:3,m),co,ip,el) + constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el) dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS !-------------------------------------------------------------------------------------------------- @@ -1210,34 +1203,20 @@ end function crystallite_stressTangent !-------------------------------------------------------------------------------------------------- !> @brief calculates orientations !-------------------------------------------------------------------------------------------------- -subroutine crystallite_orientations +subroutine crystallite_orientations(co,ip,el) - integer & + integer, intent(in) :: & co, & !< counter in integration point component loop ip, & !< counter in integration point loop el !< counter in element loop - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) - enddo; enddo; enddo - !$OMP END PARALLEL DO + call crystallite_orientation(co,ip,el)%fromMatrix(transpose(math_rotationalPart(crystallite_Fe(1:3,1:3,co,ip,el)))) + + if (plasticState(material_phaseAt(1,el))%nonlocal) & + call plastic_nonlocal_updateCompatibility(crystallite_orientation, & + phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - nonlocalPresent: if (any(plasticState%nonlocal)) then - !$OMP PARALLEL DO - do el = FEsolving_execElem(1),FEsolving_execElem(2) - if (plasticState(material_phaseAt(1,el))%nonlocal) then - do ip = FEsolving_execIP(1),FEsolving_execIP(2) - call plastic_nonlocal_updateCompatibility(crystallite_orientation, & - phase_plasticityInstance(material_phaseAt(1,el)),ip,el) - enddo - endif - enddo - !$OMP END PARALLEL DO - endif nonlocalPresent end subroutine crystallite_orientations @@ -1268,7 +1247,7 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateSourceState(co,ip,el) +function integrateSourceState(co,ip,el) result(broken) integer, intent(in) :: & el, & !< element index in element loop @@ -1288,12 +1267,13 @@ subroutine integrateSourceState(co,ip,el) r ! state residuum real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState logical :: & - broken + broken, converged_ ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) + converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) broken = broken .or. constitutive_damage_collectDotState(crystallite_S(1:3,1:3,co,ip,el), co,ip,el,ph,me) if(broken) return @@ -1328,19 +1308,20 @@ subroutine integrateSourceState(co,ip,el) - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) - crystallite_converged(co,ip,el) = & - crystallite_converged(co,ip,el) .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) enddo - if(crystallite_converged(co,ip,el)) then + if(converged_) then broken = constitutive_damage_deltaState(crystallite_Fe(1:3,1:3,co,ip,el),co,ip,el,ph,me) exit iteration endif enddo iteration + broken = broken .or. .not. converged_ + contains @@ -1364,7 +1345,7 @@ subroutine integrateSourceState(co,ip,el) end function damper -end subroutine integrateSourceState +end function integrateSourceState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7a2224ede..de6f2ae9f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -951,7 +951,7 @@ end function integrateStress !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) +function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1004,11 +1004,7 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) - plasticState(ph)%dotState (1:size_pl,me) * Delta_t plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - r(1:size_pl) - crystallite_converged(co,ip,el) = converged(r(1:size_pl), & - plasticState(ph)%state(1:size_pl,me), & - plasticState(ph)%atol(1:size_pl)) - - if(crystallite_converged(co,ip,el)) then + if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration @@ -1016,7 +1012,6 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) enddo iteration - contains !-------------------------------------------------------------------------------------------------- @@ -1039,13 +1034,13 @@ subroutine integrateStateFPI(F_0,F,Delta_t,co,ip,el) end function damper -end subroutine integrateStateFPI +end function integrateStateFPI !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1075,15 +1070,14 @@ subroutine integrateStateEuler(F_0,F,Delta_t,co,ip,el) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken -end subroutine integrateStateEuler +end function integrateStateEuler !-------------------------------------------------------------------------------------------------- !> @brief integrate stress, state with 1st order Euler method with adaptive step size !-------------------------------------------------------------------------------------------------- -subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) +function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1123,24 +1117,22 @@ subroutine integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return + broken = .not. converged(residuum_plastic(1:sizeDotState) + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & + plasticState(ph)%state(1:sizeDotState,me), & + plasticState(ph)%atol(1:sizeDotState)) - sizeDotState = plasticState(ph)%sizeDotState - crystallite_converged(co,ip,el) = converged(residuum_plastic(1:sizeDotState) & - + 0.5_pReal * plasticState(ph)%dotState(:,me) * Delta_t, & - plasticState(ph)%state(1:sizeDotState,me), & - plasticState(ph)%atol(1:sizeDotState)) - -end subroutine integrateStateAdaptiveEuler +end function integrateStateAdaptiveEuler !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the classic Runge Kutta method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) +function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(3,3), parameter :: & A = reshape([& @@ -1153,19 +1145,20 @@ subroutine integrateStateRK4(F_0,F,Delta_t,co,ip,el) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) -end subroutine integrateStateRK4 +end function integrateStateRK4 !--------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with the Cash-Carp method !--------------------------------------------------------------------------------------------------- -subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) +function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t integer, intent(in) :: co,ip,el + logical :: broken real(pReal), dimension(5,5), parameter :: & A = reshape([& @@ -1185,16 +1178,16 @@ subroutine integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] - call integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) -end subroutine integrateStateRKCK45 +end function integrateStateRKCK45 !-------------------------------------------------------------------------------------------------- !> @brief Integrate state (including stress integration) with an explicit Runge-Kutta method or an !! embedded explicit Runge-Kutta method !-------------------------------------------------------------------------------------------------- -subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) +function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) real(pReal), intent(in),dimension(3,3) :: F_0,F real(pReal), intent(in) :: Delta_t @@ -1205,15 +1198,14 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: broken - integer :: & + integer :: & stage, & ! stage index in integration stage loop n, & ph, & me, & sizeDotState - logical :: & - broken real(pReal), dimension(constitutive_plasticity_maxSizeDotState,size(B)) :: plastic_RKdotState @@ -1266,10 +1258,8 @@ subroutine integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) if(broken) return broken = integrateStress(F,Delta_t,co,ip,el) - crystallite_converged(co,ip,el) = .not. broken - -end subroutine integrateStateRK +end function integrateStateRK !-------------------------------------------------------------------------------------------------- @@ -1479,15 +1469,14 @@ end function constitutive_homogenizedC !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -module function crystallite_stress(dt,co,ip,el) +module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: & co, & ip, & el - - logical :: crystallite_stress + logical :: converged_ real(pReal) :: & formerSubStep @@ -1519,7 +1508,7 @@ module function crystallite_stress(dt,co,ip,el) subFrac = 0.0_pReal subStep = 1.0_pReal/num%subStepSizeCryst todo = .true. - crystallite_converged(co,ip,el) = .false. ! pretend failed step of 1/subStepSizeCryst + converged_ = .false. ! pretend failed step of 1/subStepSizeCryst todo = .true. NiterationCrystallite = 0 @@ -1528,7 +1517,7 @@ module function crystallite_stress(dt,co,ip,el) !-------------------------------------------------------------------------------------------------- ! wind forward - if (crystallite_converged(co,ip,el)) then + if (converged_) then formerSubStep = subStep subFrac = subFrac + subStep subStep = min(1.0_pReal - subFrac, num%stepIncreaseCryst * subStep) @@ -1579,17 +1568,13 @@ module function crystallite_stress(dt,co,ip,el) math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - crystallite_converged(co,ip,el) = .false. - call integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - call integrateSourceState(co,ip,el) + converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& + crystallite_subdt(co,ip,el),co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) endif enddo cutbackLooping -! return whether converged or not - crystallite_stress = crystallite_converged(co,ip,el) - end function crystallite_stress end submodule constitutive_mech diff --git a/src/grid/discretization_grid.f90 b/src/grid/discretization_grid.f90 index 1b3700c14..48ad5b7e1 100644 --- a/src/grid/discretization_grid.f90 +++ b/src/grid/discretization_grid.f90 @@ -19,7 +19,6 @@ module discretization_grid use results use discretization use geometry_plastic_nonlocal - use FEsolving implicit none private @@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart) (grid(1)+1) * (grid(2)+1) * grid3,& ! ...unless not last process worldrank+1==worldsize)) - FEsolving_execElem = [1,product(myGrid)] ! parallel loop bounds set to comprise all elements - FEsolving_execIP = [1,1] ! parallel loop bounds set to comprise the only IP - !-------------------------------------------------------------------------------------------------- ! store geometry information for post processing if(.not. restart) then diff --git a/src/grid/grid_mech_FEM.f90 b/src/grid/grid_mech_FEM.f90 index cdf806b35..003f568c6 100644 --- a/src/grid/grid_mech_FEM.f90 +++ b/src/grid/grid_mech_FEM.f90 @@ -18,7 +18,6 @@ module grid_mech_FEM use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization diff --git a/src/grid/grid_mech_spectral_basic.f90 b/src/grid/grid_mech_spectral_basic.f90 index ebaaf3b55..9bc36165f 100644 --- a/src/grid/grid_mech_spectral_basic.f90 +++ b/src/grid/grid_mech_spectral_basic.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_basic use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/grid_mech_spectral_polarisation.f90 b/src/grid/grid_mech_spectral_polarisation.f90 index 9f2a17c97..7160c1adc 100644 --- a/src/grid/grid_mech_spectral_polarisation.f90 +++ b/src/grid/grid_mech_spectral_polarisation.f90 @@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation use math use rotations use spectral_utilities - use FEsolving use config use homogenization use discretization_grid diff --git a/src/grid/spectral_utilities.f90 b/src/grid/spectral_utilities.f90 index c0c84233d..e8bae223a 100644 --- a/src/grid/spectral_utilities.f90 +++ b/src/grid/spectral_utilities.f90 @@ -810,9 +810,9 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& print'(/,a)', ' ... evaluating constitutive response ......................................' flush(IO_STDOUT) - homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + homogenization_F = reshape(F,[3,3,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3]) ! calculate P field P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3]) P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt ! average of P diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 27fdb6064..ebf5fd50d 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -11,7 +11,6 @@ module homogenization use math use material use constitutive - use FEsolving use discretization use thermal_isothermal use thermal_conduction @@ -144,27 +143,29 @@ end subroutine homogenization_init !-------------------------------------------------------------------------------------------------- !> @brief parallelized calculation of stress and corresponding tangent at material points !-------------------------------------------------------------------------------------------------- -subroutine materialpoint_stressAndItsTangent(dt) +subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem) real(pReal), intent(in) :: dt !< time increment + integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce + myNgrains, co, ce, ho real(pReal) :: & subFrac, & subStep logical :: & - requested, & converged logical, dimension(2) :: & doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,requested,doneAndHappy) +!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) !-------------------------------------------------------------------------------------------------- @@ -174,21 +175,19 @@ subroutine materialpoint_stressAndItsTangent(dt) subFrac = 0.0_pReal converged = .false. ! pretend failed step ... subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation - requested = .true. ! everybody requires calculation - if (homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) + if (homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + + if (damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - if (damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State0( :,material_homogenizationMemberAt(ip,el)) NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) - myNgrains = homogenization_Nconstituents(material_homogenizationAt(el)) - if (converged) then subFrac = subFrac + subStep subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep) ! introduce flexibility for step increase/acceleration @@ -198,22 +197,20 @@ subroutine materialpoint_stressAndItsTangent(dt) ! wind forward grain starting point call constitutive_windForward(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%State (:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) endif steppingNeeded - else if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) then ! so first signals terminally ill... + if (.not. terminallyIll) & ! so first signals terminally ill... print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - endif terminallyIll = .true. ! ...and kills all others else ! cutback makes sense subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback @@ -221,23 +218,19 @@ subroutine materialpoint_stressAndItsTangent(dt) call crystallite_restore(ip,el,subStep < 1.0_pReal) call constitutive_restore(ip,el) - if(homogState(material_homogenizationAt(el))%sizeState > 0) & - homogState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(material_homogenizationAt(el))%sizeState > 0) & - damageState(material_homogenizationAt(el))%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(material_homogenizationAt(el))%subState0(:,material_homogenizationMemberAt(ip,el)) + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & + damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) endif endif - if (subStep > num%subStepMinHomog) then - requested = .true. - doneAndHappy = [.false.,.true.] - endif - + if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] NiterationMPstate = 0 - convergenceLooping: do while (.not. terminallyIll .and. requested & + convergenceLooping: do while (.not. terminallyIll & .and. .not. doneAndHappy(1) & .and. NiterationMPstate < num%nMPstate) NiterationMPstate = NiterationMPstate + 1 @@ -245,7 +238,7 @@ subroutine materialpoint_stressAndItsTangent(dt) !-------------------------------------------------------------------------------------------------- ! deformation partitioning - if(requested .and. .not. doneAndHappy(1)) then ! requested but not yet done + if (.not. doneAndHappy(1)) then ce = (el-1)*discretization_nIPs + ip call mech_partition(homogenization_F0(1:3,1:3,ce) & + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))& @@ -255,10 +248,7 @@ subroutine materialpoint_stressAndItsTangent(dt) do co = 1, myNgrains converged = converged .and. crystallite_stress(dt*subStep,co,ip,el) enddo - endif - - if (requested .and. .not. doneAndHappy(1)) then if (.not. converged) then doneAndHappy = [.true.,.false.] else @@ -281,10 +271,14 @@ subroutine materialpoint_stressAndItsTangent(dt) !$OMP END PARALLEL DO if (.not. terminallyIll ) then - call crystallite_orientations() ! calculate crystal orientations - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(ho,myNgrains) elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2) + ho = material_homogenizationAt(el) + myNgrains = homogenization_Nconstituents(ho) IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2) + do co = 1, myNgrains + call crystallite_orientations(co,ip,el) + enddo call mech_homogenize(ip,el) enddo IpLooping3 enddo elementLooping3 diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index 56f1e554f..e4499e9b7 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -128,35 +128,35 @@ module subroutine mech_homogenize(ip,el) integer, intent(in) :: & ip, & !< integration point el !< element number - integer :: c,m + integer :: co,ce real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - m = (el-1)* discretization_nIPs + ip + ce = (el-1)* discretization_nIPs + ip chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - homogenization_P(1:3,1:3,m) = crystallite_P(1:3,1:3,1,ip,el) - homogenization_dPdF(1:3,1:3,1:3,1:3,m) = crystallite_stressTangent(1,ip,el) + homogenization_P(1:3,1:3,ce) = crystallite_P(1:3,1:3,1,ip,el) + homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = crystallite_stressTangent(1,ip,el) case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_isostrain_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c = 1, homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) enddo call mech_RGC_averageStressAndItsTangent(& - homogenization_P(1:3,1:3,m), & - homogenization_dPdF(1:3,1:3,1:3,1:3,m),& + homogenization_P(1:3,1:3,ce), & + homogenization_dPdF(1:3,1:3,1:3,1:3,ce),& crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & dPdFs, & homogenization_typeInstance(material_homogenizationAt(el))) diff --git a/src/marc/discretization_marc.f90 b/src/marc/discretization_marc.f90 index ca0b54b73..675e57bd3 100644 --- a/src/marc/discretization_marc.f90 +++ b/src/marc/discretization_marc.f90 @@ -12,7 +12,6 @@ module discretization_marc use DAMASK_interface use IO use config - use FEsolving use element use discretization use geometry_plastic_nonlocal @@ -89,9 +88,6 @@ subroutine discretization_marc_init if (debug_e < 1 .or. debug_e > nElems) call IO_error(602,ext_msg='element') if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,nElems] - FEsolving_execIP = [1,elem%nIPs] - allocate(cellNodeDefinition(elem%nNodes-1)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems)) call buildCells(connectivity_cell,cellNodeDefinition,& diff --git a/src/mesh/DAMASK_mesh.f90 b/src/mesh/DAMASK_mesh.f90 index 1e353892c..7369520c1 100644 --- a/src/mesh/DAMASK_mesh.f90 +++ b/src/mesh/DAMASK_mesh.f90 @@ -15,7 +15,6 @@ program DAMASK_mesh use IO use math use CPFEM2 - use FEsolving use config use discretization_mesh use FEM_Utilities diff --git a/src/mesh/FEM_utilities.f90 b/src/mesh/FEM_utilities.f90 index cb81f1f0c..2f3633e11 100644 --- a/src/mesh/FEM_utilities.f90 +++ b/src/mesh/FEM_utilities.f90 @@ -160,7 +160,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) print'(/,a)', ' ... evaluating constitutive response ......................................' - call materialpoint_stressAndItsTangent(timeinc) ! calculate P field + call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems]) ! calculate P field cutBack = .false. ! reset cutBack status diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 7dbd05e46..21c5feace 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -18,7 +18,6 @@ module discretization_mesh use config use discretization use results - use FEsolving use FEM_quadrature use YAML_types use prec @@ -30,7 +29,7 @@ module discretization_mesh mesh_Nboundaries, & mesh_NcpElemsGlobal - integer :: & + integer, public, protected :: & mesh_NcpElems !< total number of CP elements in mesh !!!! BEGIN DEPRECATED !!!!! @@ -174,9 +173,6 @@ subroutine discretization_mesh_init(restart) if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element') if (debug_ip < 1 .or. debug_ip > mesh_maxNips) call IO_error(602,ext_msg='IP') - FEsolving_execElem = [1,mesh_NcpElems] ! parallel loop bounds set to comprise all DAMASK elements - FEsolving_execIP = [1,mesh_maxNips] - allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) call discretization_init(materialAt,& From b0e5936b7ad8892f8bad96ff6297c6dda2cbbf5f Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 6 Jan 2021 17:36:47 +0100 Subject: [PATCH 180/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-153-gf8dd5df0c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cb10a9c4f..c6d828650 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-101-gab2a4a987 +v3.0.0-alpha2-153-gf8dd5df0c From a1e80c91e22a2bb5d6f8c5d94d9234fe7a17d1e1 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 6 Jan 2021 19:28:09 +0100 Subject: [PATCH 181/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-155-g6ae574693 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cb10a9c4f..3994387c0 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-101-gab2a4a987 +v3.0.0-alpha2-155-g6ae574693 From f4e3c872a03cfda383ea1aa58cc4d970a880b4b9 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 6 Jan 2021 21:18:40 +0100 Subject: [PATCH 182/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-157-g455916bc2 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cb10a9c4f..f1a4a5928 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-101-gab2a4a987 +v3.0.0-alpha2-157-g455916bc2 From a6c46fc2b15302b90fa16f19a48f0844ec0e0158 Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 6 Jan 2021 23:13:08 +0100 Subject: [PATCH 183/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-160-g3c5fc3982 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index cb10a9c4f..f903b99b1 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-101-gab2a4a987 +v3.0.0-alpha2-160-g3c5fc3982 From 94cfe28128037cd06990a52ab0fd266ce3ed7b9b Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Wed, 6 Jan 2021 18:03:10 -0500 Subject: [PATCH 184/214] polishing help; Rotation.apply(Rotation) now acceptable. --- python/damask/_config.py | 2 +- python/damask/_rotation.py | 11 ++++------- python/tests/test_Rotation.py | 11 ++++------- 3 files changed, 9 insertions(+), 15 deletions(-) diff --git a/python/damask/_config.py b/python/damask/_config.py index c7e937656..9aa031ff0 100644 --- a/python/damask/_config.py +++ b/python/damask/_config.py @@ -115,7 +115,7 @@ class Config(dict): """ Delete item. - key : dict + key : str or scalar Label of the key to remove. """ duplicate = self.copy() diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index b7be4f16d..d68cea6d3 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -234,18 +234,15 @@ class Rotation: def apply(self,other): """ - Apply rotation to vector or second/forth order tensor field. + Apply rotation to vector, second or fourth order tensor, or rotation object. Parameters ---------- - other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) - Vector or tensor on which the rotation is apply + other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) or Rotation + Vector, tensor, or rotation object on which to apply the rotation. """ - if isinstance(other,np.ndarray): - return self@other - else: - raise TypeError('Use "R1*R2" or "R1/R2", to compose rotations') + return self@other def __matmul__(self,other): diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 3def59213..707bc0210 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -1021,13 +1021,10 @@ class TestRotation: R = Rotation.from_random() assert R/R == R*R**(-1) == Rotation() - @pytest.mark.parametrize('vec',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) - def test_apply(self,vec): - assert (Rotation().from_random().apply(vec)).all() - - def test_apply_invalid(self): - with pytest.raises(TypeError): - Rotation().apply(Rotation()) + @pytest.mark.parametrize('item',[Rotation(),np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) + def test_apply(self,item): + r = Rotation.from_random() + assert r.apply(item) == r@item if isinstance(item,Rotation) else (r.apply(item) == r@item).all() @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120]) def test_average(self,angle): From 6f65de27fcf718c98ba5a3275c5f86e63ebe5a34 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 14:59:12 +0100 Subject: [PATCH 185/214] not used was only used for reporting (see v.2.0.0) --- examples/FEM/polyXtal/material.yaml | 2 +- src/constitutive.f90 | 218 +++++++++++++--------------- src/constitutive_mech.f90 | 148 +++++++++++-------- src/homogenization.f90 | 144 ++++++------------ src/homogenization_mech.f90 | 60 +++++++- src/homogenization_mech_RGC.f90 | 82 +++++------ src/lattice.f90 | 34 +++-- src/math.f90 | 7 +- src/prec.f90 | 32 ++-- 9 files changed, 365 insertions(+), 362 deletions(-) diff --git a/examples/FEM/polyXtal/material.yaml b/examples/FEM/polyXtal/material.yaml index c7d17657d..333073150 100644 --- a/examples/FEM/polyXtal/material.yaml +++ b/examples/FEM/polyXtal/material.yaml @@ -5,8 +5,8 @@ homogenization: phase: Aluminum: + lattice: cF mechanics: - lattice: cF output: [F, P, F_e, F_p, L_p] elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke} plasticity: diff --git a/src/constitutive.f90 b/src/constitutive.f90 index e65ce864d..696611549 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -48,7 +48,6 @@ module constitutive crystallite_orientation !< current orientation real(pReal), dimension(:,:,:,:,:), allocatable :: & crystallite_F0, & !< def grad at start of FE inc - crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_Fe, & !< current "elastic" def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc crystallite_subFi0,& !< intermediate def grad at start of crystallite inc @@ -60,9 +59,8 @@ module constitutive crystallite_P, & !< 1st Piola-Kirchhoff stress per grain crystallite_Lp, & !< current plastic velocitiy grad (end of converged time step) crystallite_S, & !< current 2nd Piola-Kirchhoff stress vector (end of converged time step) - crystallite_partitionedF0 !< def grad at start of homog inc - real(pReal), dimension(:,:,:,:,:), allocatable, public :: & - crystallite_partitionedF !< def grad to be reached at end of homog inc + crystallite_partitionedF0, & !< def grad at start of homog inc + crystallite_F !< def grad to be reached at end of homog inc type :: tTensorContainer real(pReal), dimension(:,:,:), allocatable :: data @@ -179,6 +177,14 @@ module constitutive module subroutine constitutive_mech_forward end subroutine constitutive_mech_forward + module subroutine mech_restore(ip,el,includeL) + integer, intent(in) :: & + ip, & + el + logical, intent(in) :: & + includeL + end subroutine mech_restore + ! == cleaned:end =================================================================================== module function crystallite_stress(dt,co,ip,el) result(converged_) @@ -392,8 +398,7 @@ module constitutive crystallite_restartRead, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - crystallite_restore, & - PLASTICITY_UNDEFINED_ID, & + PLASTICITY_UNDEFINED_ID, & PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & @@ -734,20 +739,21 @@ subroutine constitutive_allocateState(state, & sizeDotState, & sizeDeltaState + state%sizeState = sizeState state%sizeDotState = sizeDotState state%sizeDeltaState = sizeDeltaState state%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition - allocate(state%atol (sizeState), source=0.0_pReal) - allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%atol (sizeState), source=0.0_pReal) + allocate(state%state0 (sizeState,Nconstituents), source=0.0_pReal) allocate(state%partitionedState0(sizeState,Nconstituents), source=0.0_pReal) - allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%subState0 (sizeState,Nconstituents), source=0.0_pReal) + allocate(state%state (sizeState,Nconstituents), source=0.0_pReal) - allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) + allocate(state%dotState (sizeDotState,Nconstituents), source=0.0_pReal) - allocate(state%deltaState(sizeDeltaState,Nconstituents), source=0.0_pReal) + allocate(state%deltaState (sizeDeltaState,Nconstituents), source=0.0_pReal) end subroutine constitutive_allocateState @@ -756,22 +762,27 @@ end subroutine constitutive_allocateState !-------------------------------------------------------------------------------------------------- !> @brief Restore data after homog cutback. !-------------------------------------------------------------------------------------------------- -subroutine constitutive_restore(ip,el) +subroutine constitutive_restore(ip,el,includeL) + logical, intent(in) :: includeL integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number - s + so + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo + call mech_restore(ip,el,includeL) + end subroutine constitutive_restore @@ -783,7 +794,7 @@ subroutine constitutive_forward integer :: i, j - crystallite_F0 = crystallite_partitionedF + crystallite_F0 = crystallite_F crystallite_Lp0 = crystallite_Lp crystallite_S0 = crystallite_S @@ -830,12 +841,13 @@ subroutine crystallite_init Nconstituents, & ph, & me, & - co, & !< counter in integration point component loop - ip, & !< counter in integration point loop - el, & !< counter in element loop + co, & !< counter in integration point component loop + ip, & !< counter in integration point loop + el, & !< counter in element loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements + class(tNode), pointer :: & num_crystallite, & @@ -854,23 +866,21 @@ subroutine crystallite_init iMax = discretization_nIPs eMax = discretization_Nelems - allocate(crystallite_partitionedF(3,3,cMax,iMax,eMax),source=0.0_pReal) + allocate(crystallite_F(3,3,cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_S0, & crystallite_F0,crystallite_Lp0, & crystallite_partitionedS0, & crystallite_partitionedF0,& - crystallite_partitionedLp0, & + crystallite_partitionedLp0, & crystallite_S,crystallite_P, & crystallite_Fe,crystallite_Lp, & - crystallite_subF, & crystallite_subFp0,crystallite_subFi0, & - source = crystallite_partitionedF) + source = crystallite_F) allocate(crystallite_subdt(cMax,iMax,eMax),source=0.0_pReal) allocate(crystallite_orientation(cMax,iMax,eMax)) - num_crystallite => config_numerics%get('crystallite',defaultVal=emptyDict) num%subStepMinCryst = num_crystallite%get_asFloat ('subStepMin', defaultVal=1.0e-3_pReal) @@ -933,8 +943,8 @@ subroutine crystallite_init flush(IO_STDOUT) !$OMP PARALLEL DO PRIVATE(ph,me) - do el = 1, size(material_phaseMemberAt,3) - do ip = 1, size(material_phaseMemberAt,2); do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + do el = 1, size(material_phaseMemberAt,3); do ip = 1, size(material_phaseMemberAt,2) + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -953,12 +963,12 @@ subroutine crystallite_init constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) = constitutive_mech_Fi0(ph)%data(1:3,1:3,me) constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) = constitutive_mech_Fp0(ph)%data(1:3,1:3,me) - enddo; enddo - enddo + enddo + enddo; enddo !$OMP END PARALLEL DO crystallite_partitionedF0 = crystallite_F0 - crystallite_partitionedF = crystallite_F0 + crystallite_F = crystallite_F0 !$OMP PARALLEL DO PRIVATE(ph,me) @@ -978,9 +988,6 @@ subroutine crystallite_init end subroutine crystallite_init - - - !-------------------------------------------------------------------------------------------------- !> @brief Backup data for homog cutback. !-------------------------------------------------------------------------------------------------- @@ -991,7 +998,7 @@ subroutine constitutive_initializeRestorationPoints(ip,el) el !< element number integer :: & co, & !< constituent number - s,ph, me + so,ph, me do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) @@ -1002,9 +1009,9 @@ subroutine constitutive_initializeRestorationPoints(ip,el) call mech_initializeRestorationPoints(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%state0( :,material_phasememberAt(co,ip,el)) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) = & + sourceState(material_phaseAt(co,el))%p(so)%state0( :,material_phasememberAt(co,ip,el)) enddo enddo @@ -1019,57 +1026,28 @@ subroutine constitutive_windForward(ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number + integer :: & co, & !< constituent number - s, ph, me + so, ph, me + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_partitionedF(1:3,1:3,co,ip,el) - crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp (1:3,1:3,co,ip,el) - crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) + crystallite_partitionedF0 (1:3,1:3,co,ip,el) = crystallite_F (1:3,1:3,co,ip,el) + crystallite_partitionedLp0(1:3,1:3,co,ip,el) = crystallite_Lp(1:3,1:3,co,ip,el) + crystallite_partitionedS0 (1:3,1:3,co,ip,el) = crystallite_S (1:3,1:3,co,ip,el) call constitutive_mech_windForward(ph,me) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(s)%partitionedState0(:,me) = sourceState(ph)%p(s)%state(:,me) + do so = 1, phase_Nsources(material_phaseAt(co,el)) + sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo enddo end subroutine constitutive_windForward -!-------------------------------------------------------------------------------------------------- -!> @brief Restore data after homog cutback. -!-------------------------------------------------------------------------------------------------- -subroutine crystallite_restore(ip,el,includeL) - - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - logical, intent(in) :: & - includeL !< protect agains fake cutback - integer :: & - co, p, m !< constituent number - - do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) - p = material_phaseAt(co,el) - m = material_phaseMemberAt(co,ip,el) - if (includeL) then - crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) - endif ! maybe protecting everything from overwriting makes more sense - - constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) - constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) - crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) - - plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) - enddo - -end subroutine crystallite_restore - - !-------------------------------------------------------------------------------------------------- !> @brief Calculate tangent (dPdF). !-------------------------------------------------------------------------------------------------- @@ -1080,13 +1058,13 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) co, & !< counter in constituent loop ip, & !< counter in integration point loop el !< counter in element loop + integer :: & o, & p, ph, me - real(pReal), dimension(3,3) :: devNull, & invSubFp0,invSubFi0,invFp,invFi, & - temp_33_1, temp_33_2, temp_33_3, temp_33_4 + temp_33_1, temp_33_2, temp_33_3 real(pReal), dimension(3,3,3,3) :: dSdFe, & dSdF, & dSdFi, & @@ -1102,6 +1080,7 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) real(pReal), dimension(9,9):: temp_99 logical :: error + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1149,8 +1128,8 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! calculate dSdF temp_33_1 = transpose(matmul(invFp,invFi)) - temp_33_2 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invSubFp0) - temp_33_3 = matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp), invSubFi0) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invSubFp0) + temp_33_3 = matmul(matmul(crystallite_F(1:3,1:3,co,ip,el),invFp), invSubFi0) do o=1,3; do p=1,3 rhs_3333(p,o,1:3,1:3) = matmul(dSdFe(p,o,1:3,1:3),temp_33_1) @@ -1180,21 +1159,20 @@ function crystallite_stressTangent(co,ip,el) result(dPdF) !-------------------------------------------------------------------------------------------------- ! assemble dPdF temp_33_1 = matmul(crystallite_S(1:3,1:3,co,ip,el),transpose(invFp)) - temp_33_2 = matmul(invFp,temp_33_1) - temp_33_3 = matmul(crystallite_subF(1:3,1:3,co,ip,el),invFp) - temp_33_4 = matmul(temp_33_3,crystallite_S(1:3,1:3,co,ip,el)) + temp_33_2 = matmul(crystallite_F(1:3,1:3,co,ip,el),invFp) + temp_33_3 = matmul(temp_33_2,crystallite_S(1:3,1:3,co,ip,el)) dPdF = 0.0_pReal do p=1,3 - dPdF(p,1:3,p,1:3) = transpose(temp_33_2) + dPdF(p,1:3,p,1:3) = transpose(matmul(invFp,temp_33_1)) enddo do o=1,3; do p=1,3 dPdF(1:3,1:3,p,o) = dPdF(1:3,1:3,p,o) & - + matmul(matmul(crystallite_subF(1:3,1:3,co,ip,el), & + + matmul(matmul(crystallite_F(1:3,1:3,co,ip,el), & dFpinvdF(1:3,1:3,p,o)),temp_33_1) & - + matmul(matmul(temp_33_3,dSdF(1:3,1:3,p,o)), & + + matmul(matmul(temp_33_2,dSdF(1:3,1:3,p,o)), & transpose(invFp)) & - + matmul(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) + + matmul(temp_33_3,transpose(dFpinvdF(1:3,1:3,p,o))) enddo; enddo end function crystallite_stressTangent @@ -1237,7 +1215,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) T = matmul(material_orientation0(co,ip,el)%asMatrix(), & ! ToDo: initial orientation correct? - transpose(math_inv33(crystallite_subF(1:3,1:3,co,ip,el)))) + transpose(math_inv33(crystallite_F(1:3,1:3,co,ip,el)))) crystallite_push33ToRef = matmul(transpose(T),matmul(tensor33,T)) end function crystallite_push33ToRef @@ -1247,8 +1225,9 @@ end function crystallite_push33ToRef !> @brief integrate stress, state with adaptive 1st order explicit Euler method !> using Fixed Point Iteration to adapt the stepsize !-------------------------------------------------------------------------------------------------- -function integrateSourceState(co,ip,el) result(broken) +function integrateSourceState(dt,co,ip,el) result(broken) + real(pReal), intent(in) :: dt integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop @@ -1281,8 +1260,7 @@ function integrateSourceState(co,ip,el) result(broken) do so = 1, phase_Nsources(ph) size_so(so) = sourceState(ph)%p(so)%sizeDotState sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) & - * crystallite_subdt(co,ip,el) + + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo @@ -1304,8 +1282,8 @@ function integrateSourceState(co,ip,el) result(broken) sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * crystallite_subdt(co,ip,el) + - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) converged_ = converged_ .and. converged(r(1:size_so(so)), & @@ -1371,7 +1349,7 @@ end function converged !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartWrite - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1380,27 +1358,27 @@ subroutine crystallite_restartWrite write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5' fileHandle = HDF5_openFile(fileName,'a') - call HDF5_write(fileHandle,crystallite_partitionedF,'F') + call HDF5_write(fileHandle,crystallite_F,'F') call HDF5_write(fileHandle,crystallite_Lp, 'L_p') call HDF5_write(fileHandle,crystallite_S, 'S') groupHandle = HDF5_addGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,plasticState(i)%state,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_write(groupHandle,constitutive_mech_Fi(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_write(groupHandle,constitutive_mech_Li(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_write(groupHandle,constitutive_mech_Fp(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,plasticState(ph)%state,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_write(groupHandle,constitutive_mech_Fi(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_write(groupHandle,constitutive_mech_Li(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_write(groupHandle,constitutive_mech_Fp(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_addGroup(fileHandle,'homogenization') - do i = 1, size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_write(groupHandle,homogState(i)%state,datasetName) + do ph = 1, size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_write(groupHandle,homogState(ph)%state,datasetName) enddo call HDF5_closeGroup(groupHandle) @@ -1415,7 +1393,7 @@ end subroutine crystallite_restartWrite !-------------------------------------------------------------------------------------------------- subroutine crystallite_restartRead - integer :: i + integer :: ph integer(HID_T) :: fileHandle, groupHandle character(len=pStringLen) :: fileName, datasetName @@ -1429,22 +1407,22 @@ subroutine crystallite_restartRead call HDF5_read(fileHandle,crystallite_S0, 'S') groupHandle = HDF5_openGroup(fileHandle,'phase') - do i = 1,size(material_name_phase) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,plasticState(i)%state0,datasetName) - write(datasetName,'(i0,a)') i,'_F_i' - call HDF5_read(groupHandle,constitutive_mech_Fi0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_L_i' - call HDF5_read(groupHandle,constitutive_mech_Li0(i)%data,datasetName) - write(datasetName,'(i0,a)') i,'_F_p' - call HDF5_read(groupHandle,constitutive_mech_Fp0(i)%data,datasetName) + do ph = 1,size(material_name_phase) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,plasticState(ph)%state0,datasetName) + write(datasetName,'(i0,a)') ph,'_F_i' + call HDF5_read(groupHandle,constitutive_mech_Fi0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_L_i' + call HDF5_read(groupHandle,constitutive_mech_Li0(ph)%data,datasetName) + write(datasetName,'(i0,a)') ph,'_F_p' + call HDF5_read(groupHandle,constitutive_mech_Fp0(ph)%data,datasetName) enddo call HDF5_closeGroup(groupHandle) groupHandle = HDF5_openGroup(fileHandle,'homogenization') - do i = 1,size(material_name_homogenization) - write(datasetName,'(i0,a)') i,'_omega' - call HDF5_read(groupHandle,homogState(i)%state0,datasetName) + do ph = 1,size(material_name_homogenization) + write(datasetName,'(i0,a)') ph,'_omega' + call HDF5_read(groupHandle,homogState(ph)%state0,datasetName) enddo call HDF5_closeGroup(groupHandle) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index de6f2ae9f..c48c59ec9 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -800,7 +800,7 @@ function integrateStress(F,Delta_t,co,ip,el) result(broken) broken = .true. - call constitutive_plastic_dependentState(crystallite_partitionedF(1:3,1:3,co,ip,el),co,ip,el) + call constitutive_plastic_dependentState(crystallite_F(1:3,1:3,co,ip,el),co,ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -959,19 +959,21 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & NiterationState, & !< number of iterations in state loop ph, & me, & - size_pl + sizeDotState real(pReal) :: & zeta real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: & r ! state residuum real(pReal), dimension(constitutive_plasticity_maxSizeDotState,2) :: & - plastic_dotState - logical :: & - broken + dotState + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -979,15 +981,15 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) return - size_pl = plasticState(ph)%sizeDotState - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%subState0(1:size_pl,me) & - + plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plastic_dotState(1:size_pl,2) = 0.0_pReal + sizeDotState = plasticState(ph)%sizeDotState + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + dotState(1:sizeDotState,2) = 0.0_pReal iteration: do NiterationState = 1, num%nState - if(nIterationState > 1) plastic_dotState(1:size_pl,2) = plastic_dotState(1:size_pl,1) - plastic_dotState(1:size_pl,1) = plasticState(ph)%dotState(:,me) + if(nIterationState > 1) dotState(1:sizeDotState,2) = dotState(1:sizeDotState,1) + dotState(1:sizeDotState,1) = plasticState(ph)%dotState(:,me) broken = integrateStress(F,Delta_t,co,ip,el) if(broken) exit iteration @@ -995,16 +997,16 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) broken = mech_collectDotState(Delta_t, co,ip,el,ph,me) if(broken) exit iteration - zeta = damper(plasticState(ph)%dotState(:,me),plastic_dotState(1:size_pl,1),& - plastic_dotState(1:size_pl,2)) + zeta = damper(plasticState(ph)%dotState(:,me),dotState(1:sizeDotState,1),& + dotState(1:sizeDotState,2)) plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) * zeta & - + plastic_dotState(1:size_pl,1) * (1.0_pReal - zeta) - r(1:size_pl) = plasticState(ph)%state (1:size_pl,me) & - - plasticState(ph)%subState0(1:size_pl,me) & - - plasticState(ph)%dotState (1:size_pl,me) * Delta_t - plasticState(ph)%state(1:size_pl,me) = plasticState(ph)%state(1:size_pl,me) & - - r(1:size_pl) - if (converged(r(1:size_pl),plasticState(ph)%state(1:size_pl,me),plasticState(ph)%atol(1:size_pl))) then + + dotState(1:sizeDotState,1) * (1.0_pReal - zeta) + r(1:sizeDotState) = plasticState(ph)%state (1:sizeDotState,me) & + - plasticState(ph)%subState0(1:sizeDotState,me) & + - plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t + plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%state(1:sizeDotState,me) & + - r(1:sizeDotState) + if (converged(r(1:sizeDotState),plasticState(ph)%state(1:sizeDotState,me),plasticState(ph)%atol(1:sizeDotState))) then broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) exit iteration @@ -1012,6 +1014,7 @@ function integrateStateFPI(F_0,F,Delta_t,co,ip,el) result(broken) enddo iteration + contains !-------------------------------------------------------------------------------------------------- @@ -1048,12 +1051,14 @@ function integrateStateEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken + ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) @@ -1085,13 +1090,13 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken + integer :: & ph, & me, & sizeDotState - logical :: & - broken - real(pReal), dimension(constitutive_plasticity_maxSizeDotState) :: residuum_plastic @@ -1105,7 +1110,7 @@ function integrateStateAdaptiveEuler(F_0,F,Delta_t,co,ip,el) result(broken) residuum_plastic(1:sizeDotState) = - plasticState(ph)%dotstate(1:sizeDotState,me) * 0.5_pReal * Delta_t plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & - + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t + + plasticState(ph)%dotstate(1:sizeDotState,me) * Delta_t broken = constitutive_deltaState(crystallite_S(1:3,1:3,co,ip,el), & constitutive_mech_Fi(ph)%data(1:3,1:3,me),co,ip,el,ph,me) @@ -1145,6 +1150,7 @@ function integrateStateRK4(F_0,F,Delta_t,co,ip,el) result(broken) real(pReal), dimension(4), parameter :: & B = [1.0_pReal/6.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/3.0_pReal, 1.0_pReal/6.0_pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C) end function integrateStateRK4 @@ -1178,6 +1184,7 @@ function integrateStateRKCK45(F_0,F,Delta_t,co,ip,el) result(broken) [2825.0_pReal/27648.0_pReal, .0_pReal, 18575.0_pReal/48384.0_pReal,& 13525.0_pReal/55296.0_pReal, 277.0_pReal/14336.0_pReal, 1._pReal/4._pReal] + broken = integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) end function integrateStateRKCK45 @@ -1215,18 +1222,18 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) broken = mech_collectDotState(Delta_t,co,ip,el,ph,me) if(broken) return + sizeDotState = plasticState(ph)%sizeDotState + do stage = 1, size(A,1) - sizeDotState = plasticState(ph)%sizeDotState + plastic_RKdotState(1:sizeDotState,stage) = plasticState(ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = A(1,stage) * plastic_RKdotState(1:sizeDotState,1) do n = 2, stage - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%dotState(:,me) = plasticState(ph)%dotState(:,me) & - + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) + + A(n,stage) * plastic_RKdotState(1:sizeDotState,n) enddo - sizeDotState = plasticState(ph)%sizeDotState plasticState(ph)%state(1:sizeDotState,me) = plasticState(ph)%subState0(1:sizeDotState,me) & + plasticState(ph)%dotState (1:sizeDotState,me) * Delta_t @@ -1239,7 +1246,6 @@ function integrateStateRK(F_0,F,Delta_t,co,ip,el,A,B,C,DB) result(broken) enddo if(broken) return - sizeDotState = plasticState(ph)%sizeDotState plastic_RKdotState(1:sizeDotState,size(B)) = plasticState (ph)%dotState(:,me) plasticState(ph)%dotState(:,me) = matmul(plastic_RKdotState(1:sizeDotState,1:size(B)),B) @@ -1282,7 +1288,7 @@ subroutine crystallite_results(group,ph) select case (output_constituent(ph)%label(ou)) case('F') - selected_tensors = select_tensors(crystallite_partitionedF,ph) + selected_tensors = select_tensors(crystallite_F,ph) call results_writeDataset(group//'/mechanics/',selected_tensors,output_constituent(ph)%label(ou),& 'deformation gradient','1') case('F_e') @@ -1482,25 +1488,24 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) formerSubStep integer :: & NiterationCrystallite, & ! number of iterations in crystallite loop - s, ph, me + so, ph, me logical :: todo real(pReal) :: subFrac,subStep real(pReal), dimension(3,3) :: & subLp0, & !< plastic velocity grad at start of crystallite inc subLi0, & !< intermediate velocity grad at start of crystallite inc - subF0 + subF0, & + subF ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) subLi0 = constitutive_mech_partitionedLi0(ph)%data(1:3,1:3,me) subLp0 = crystallite_partitionedLp0(1:3,1:3,co,ip,el) - plasticState (material_phaseAt(co,el))%subState0( :,material_phaseMemberAt(co,ip,el)) = & - plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(s)%subState0( :,material_phaseMemberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(s)%partitionedState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%partitionedState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) @@ -1525,16 +1530,14 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) todo = subStep > 0.0_pReal ! still time left to integrate on? if (todo) then - subF0 = crystallite_subF(1:3,1:3,co,ip,el) + subF0 = subF subLp0 = crystallite_Lp (1:3,1:3,co,ip,el) subLi0 = constitutive_mech_Li(ph)%data(1:3,1:3,me) crystallite_subFp0(1:3,1:3,co,ip,el) = constitutive_mech_Fp(ph)%data(1:3,1:3,me) crystallite_subFi0(1:3,1:3,co,ip,el) = constitutive_mech_Fi(ph)%data(1:3,1:3,me) - plasticState( material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%subState0(:,me) = plasticState(ph)%state(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo endif !-------------------------------------------------------------------------------------------------- @@ -1548,11 +1551,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) crystallite_Lp (1:3,1:3,co,ip,el) = subLp0 constitutive_mech_Li(ph)%data(1:3,1:3,me) = subLi0 endif - plasticState (material_phaseAt(co,el))%state( :,material_phaseMemberAt(co,ip,el)) & - = plasticState(material_phaseAt(co,el))%subState0(:,material_phaseMemberAt(co,ip,el)) - do s = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState( material_phaseAt(co,el))%p(s)%state( :,material_phaseMemberAt(co,ip,el)) & - = sourceState(material_phaseAt(co,el))%p(s)%subState0(:,material_phaseMemberAt(co,ip,el)) + plasticState(ph)%state(:,me) = plasticState(ph)%subState0(:,me) + do so = 1, phase_Nsources(ph) + sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) @@ -1561,21 +1562,50 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) !-------------------------------------------------------------------------------------------------- ! prepare for integration if (todo) then - crystallite_subF(1:3,1:3,co,ip,el) = subF0 & - + subStep *( crystallite_partitionedF (1:3,1:3,co,ip,el) & - -crystallite_partitionedF0(1:3,1:3,co,ip,el)) - crystallite_Fe(1:3,1:3,co,ip,el) = matmul(crystallite_subF(1:3,1:3,co,ip,el), & - math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & - constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) + subF = subF0 & + + subStep * (crystallite_F(1:3,1:3,co,ip,el) - crystallite_partitionedF0(1:3,1:3,co,ip,el)) + crystallite_Fe(1:3,1:3,co,ip,el) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & + constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) crystallite_subdt(co,ip,el) = subStep * dt - converged_ = .not. integrateState(subF0,crystallite_subF(1:3,1:3,co,ip,el),& - crystallite_subdt(co,ip,el),co,ip,el) - converged_ = converged_ .and. .not. integrateSourceState(co,ip,el) + converged_ = .not. integrateState(subF0,subF,subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) endif enddo cutbackLooping end function crystallite_stress + +!-------------------------------------------------------------------------------------------------- +!> @brief Restore data after homog cutback. +!-------------------------------------------------------------------------------------------------- +module subroutine mech_restore(ip,el,includeL) + + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + logical, intent(in) :: & + includeL !< protect agains fake cutback + integer :: & + co, p, m !< constituent number + + do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) + p = material_phaseAt(co,el) + m = material_phaseMemberAt(co,ip,el) + if (includeL) then + crystallite_Lp(1:3,1:3,co,ip,el) = crystallite_partitionedLp0(1:3,1:3,co,ip,el) + constitutive_mech_Li(p)%data(1:3,1:3,m) = constitutive_mech_partitionedLi0(p)%data(1:3,1:3,m) + endif ! maybe protecting everything from overwriting makes more sense + + constitutive_mech_Fp(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFp0(p)%data(1:3,1:3,m) + constitutive_mech_Fi(p)%data(1:3,1:3,m) = constitutive_mech_partitionedFi0(p)%data(1:3,1:3,m) + crystallite_S (1:3,1:3,co,ip,el) = crystallite_partitionedS0 (1:3,1:3,co,ip,el) + + plasticState (material_phaseAt(co,el))%state( :,material_phasememberAt(co,ip,el)) = & + plasticState (material_phaseAt(co,el))%partitionedState0(:,material_phasememberAt(co,ip,el)) + enddo + +end subroutine mech_restore + end submodule constitutive_mech diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ebf5fd50d..52553b57b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -70,29 +70,22 @@ module homogenization end subroutine mech_homogenize module subroutine mech_results(group_base,h) - character(len=*), intent(in) :: group_base integer, intent(in) :: h - end subroutine mech_results -! -------- ToDo --------------------------------------------------------- - module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) - logical, dimension(2) :: mech_RGC_updateState - real(pReal), dimension(:,:,:), intent(in) :: & - P,& !< partitioned stresses - F,& !< partitioned deformation gradients - F0 !< partitioned initial deformation gradients - real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses - real(pReal), dimension(3,3), intent(in) :: avgF !< average F - real(pReal), intent(in) :: dt !< time increment - integer, intent(in) :: & - ip, & !< integration point number - el !< element number - end function mech_RGC_updateState + module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + end function mech_updateState end interface -! ----------------------------------------------------------------------- public :: & homogenization_init, & @@ -148,11 +141,10 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE real(pReal), intent(in) :: dt !< time increment integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP integer :: & - NiterationHomog, & NiterationMPstate, & ip, & !< integration point number el, & !< element number - myNgrains, co, ce, ho + myNgrains, co, ce, ho, me real(pReal) :: & subFrac, & subStep @@ -162,12 +154,12 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy -!$OMP PARALLEL DO PRIVATE(ce,ho,myNgrains,NiterationMPstate,NiterationHomog,subFrac,converged,subStep,doneAndHappy) + !$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy) do el = FEsolving_execElem(1),FEsolving_execElem(2) ho = material_homogenizationAt(el) myNgrains = homogenization_Nconstituents(ho) do ip = FEsolving_execIP(1),FEsolving_execIP(2) - + me = material_homogenizationMemberAt(ip,el) !-------------------------------------------------------------------------------------------------- ! initialize restoration points call constitutive_initializeRestorationPoints(ip,el) @@ -177,15 +169,10 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation if (homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) - + homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) if (damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State0( :,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) - - NiterationHomog = 0 cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) if (converged) then @@ -198,33 +185,26 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_windForward(ip,el) if(homogState(ho)%sizeState > 0) & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) if(damageState(ho)%sizeState > 0) & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%State (:,material_homogenizationMemberAt(ip,el)) + damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) endif steppingNeeded - else - if ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite + elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite num%subStepSizeHomog * subStep <= num%subStepMinHomog ) then ! would require too small subStep ! cutback makes no sense - if (.not. terminallyIll) & ! so first signals terminally ill... - print*, ' Integration point ', ip,' at element ', el, ' terminally ill' - terminallyIll = .true. ! ...and kills all others - else ! cutback makes sense - subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback + if (.not. terminallyIll) & ! so first signals terminally ill... + print*, ' Integration point ', ip,' at element ', el, ' terminally ill' + terminallyIll = .true. ! ...and kills all others + else ! cutback makes sense + subStep = num%subStepSizeHomog * subStep ! crystallite had severe trouble, so do a significant cutback - call crystallite_restore(ip,el,subStep < 1.0_pReal) - call constitutive_restore(ip,el) + call constitutive_restore(ip,el,subStep < 1.0_pReal) - if(homogState(ho)%sizeState > 0) & - homogState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - homogState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - if(damageState(ho)%sizeState > 0) & - damageState(ho)%State( :,material_homogenizationMemberAt(ip,el)) = & - damageState(ho)%subState0(:,material_homogenizationMemberAt(ip,el)) - endif + if(homogState(ho)%sizeState > 0) & + homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) + if(damageState(ho)%sizeState > 0) & + damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] @@ -253,18 +233,16 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE doneAndHappy = [.true.,.false.] else ce = (el-1)*discretization_nIPs + ip - doneAndHappy = updateState(dt*subStep, & - homogenization_F0(1:3,1:3,ce) & - + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & + doneAndHappy = mech_updateState(dt*subStep, & + homogenization_F0(1:3,1:3,ce) & + + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) & *(subStep+subFrac), & - ip,el) + ip,el) converged = all(doneAndHappy) endif endif enddo convergenceLooping - NiterationHomog = NiterationHomog + 1 - enddo cutBackLooping enddo enddo @@ -290,74 +268,35 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE end subroutine materialpoint_stressAndItsTangent -!-------------------------------------------------------------------------------------------------- -!> @brief update the internal state of the homogenization scheme and tell whether "done" and -!> "happy" with result -!-------------------------------------------------------------------------------------------------- -function updateState(subdt,subF,ip,el) - - real(pReal), intent(in) :: & - subdt !< current time step - real(pReal), intent(in), dimension(3,3) :: & - subF - integer, intent(in) :: & - ip, & !< integration point - el !< element number - integer :: c - logical, dimension(2) :: updateState - real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) - - updateState = .true. - chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) - case (HOMOGENIZATION_RGC_ID) chosenHomogenization - do c=1,homogenization_Nconstituents(material_homogenizationAt(el)) - dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el) - enddo - updateState = & - updateState .and. & - mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & - crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& - subF,& - subdt, & - dPdFs, & - ip, & - el) - end select chosenHomogenization - -end function updateState - - !-------------------------------------------------------------------------------------------------- !> @brief writes homogenization results to HDF5 output file !-------------------------------------------------------------------------------------------------- subroutine homogenization_results - use material, only: & - material_homogenization_type => homogenization_type - integer :: p + integer :: ho character(len=:), allocatable :: group_base,group + call results_closeGroup(results_addGroup('current/homogenization/')) - do p=1,size(material_name_homogenization) - group_base = 'current/homogenization/'//trim(material_name_homogenization(p)) + do ho=1,size(material_name_homogenization) + group_base = 'current/homogenization/'//trim(material_name_homogenization(ho)) call results_closeGroup(results_addGroup(group_base)) - call mech_results(group_base,p) + call mech_results(group_base,ho) group = trim(group_base)//'/damage' call results_closeGroup(results_addGroup(group)) - select case(damage_type(p)) + select case(damage_type(ho)) case(DAMAGE_NONLOCAL_ID) - call damage_nonlocal_results(p,group) + call damage_nonlocal_results(ho,group) end select group = trim(group_base)//'/thermal' call results_closeGroup(results_addGroup(group)) - select case(thermal_type(p)) + select case(thermal_type(ho)) case(THERMAL_CONDUCTION_ID) - call thermal_conduction_results(p,group) + call thermal_conduction_results(ho,group) end select enddo @@ -373,6 +312,7 @@ subroutine homogenization_forward integer :: ho + do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state damageState(ho)%state0 = damageState(ho)%state diff --git a/src/homogenization_mech.f90 b/src/homogenization_mech.f90 index e4499e9b7..641e960fd 100644 --- a/src/homogenization_mech.f90 +++ b/src/homogenization_mech.f90 @@ -52,6 +52,21 @@ submodule(homogenization) homogenization_mech end subroutine mech_RGC_averageStressAndItsTangent + module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number + end function mech_RGC_updateState + + module subroutine mech_RGC_results(instance,group) integer, intent(in) :: instance !< homogenization instance character(len=*), intent(in) :: group !< group name in HDF5 file @@ -101,16 +116,16 @@ module subroutine mech_partition(subF,ip,el) chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el))) case (HOMOGENIZATION_NONE_ID) chosenHomogenization - crystallite_partitionedF(1:3,1:3,1,ip,el) = subF + crystallite_F(1:3,1:3,1,ip,el) = subF case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization call mech_isostrain_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF) case (HOMOGENIZATION_RGC_ID) chosenHomogenization call mech_RGC_partitionDeformation(& - crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & subF,& ip, & el) @@ -166,6 +181,45 @@ module subroutine mech_homogenize(ip,el) end subroutine mech_homogenize +!-------------------------------------------------------------------------------------------------- +!> @brief update the internal state of the homogenization scheme and tell whether "done" and +!> "happy" with result +!-------------------------------------------------------------------------------------------------- +module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy) + + real(pReal), intent(in) :: & + subdt !< current time step + real(pReal), intent(in), dimension(3,3) :: & + subF + integer, intent(in) :: & + ip, & !< integration point + el !< element number + logical, dimension(2) :: doneAndHappy + + integer :: co + real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el))) + + + if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) + dPdFs(:,:,:,:,co) = crystallite_stressTangent(co,ip,el) + enddo + doneAndHappy = & + mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_F(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), & + crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),& + subF,& + subdt, & + dPdFs, & + ip, & + el) + else + doneAndHappy = .true. + endif + +end function mech_updateState + + !-------------------------------------------------------------------------------------------------- !> @brief Write results to file. !-------------------------------------------------------------------------------------------------- diff --git a/src/homogenization_mech_RGC.f90 b/src/homogenization_mech_RGC.f90 index a89008e96..04ec73845 100644 --- a/src/homogenization_mech_RGC.f90 +++ b/src/homogenization_mech_RGC.f90 @@ -8,6 +8,7 @@ !-------------------------------------------------------------------------------------------------- submodule(homogenization:homogenization_mech) homogenization_mech_RGC use rotations + use lattice type :: tParameters integer, dimension(:), allocatable :: & @@ -242,7 +243,18 @@ end subroutine mech_RGC_partitionDeformation !> @brief update the internal state of the homogenization scheme and tell whether "done" and ! "happy" with result !-------------------------------------------------------------------------------------------------- -module procedure mech_RGC_updateState +module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el) result(doneAndHappy) + logical, dimension(2) :: doneAndHappy + real(pReal), dimension(:,:,:), intent(in) :: & + P,& !< partitioned stresses + F,& !< partitioned deformation gradients + F0 !< partitioned initial deformation gradients + real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF !< partitioned stiffnesses + real(pReal), dimension(3,3), intent(in) :: avgF !< average F + real(pReal), intent(in) :: dt !< time increment + integer, intent(in) :: & + ip, & !< integration point number + el !< element number integer, dimension(4) :: intFaceN,intFaceP,faceID integer, dimension(3) :: nGDim,iGr3N,iGr3P @@ -256,7 +268,7 @@ module procedure mech_RGC_updateState real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax zeroTimeStep: if(dEq0(dt)) then - mech_RGC_updateState = .true. ! pretend everything is fine and return + doneAndHappy = .true. ! pretend everything is fine and return return endif zeroTimeStep @@ -327,12 +339,12 @@ module procedure mech_RGC_updateState stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress residMax = maxval(abs(tract)) ! get the maximum of the residual - mech_RGC_updateState = .false. + doneAndHappy = .false. !-------------------------------------------------------------------------------------------------- ! If convergence reached => done and happy if (residMax < num%rtol*stresMax .or. residMax < num%atol) then - mech_RGC_updateState = .true. + doneAndHappy = .true. !-------------------------------------------------------------------------------------------------- ! compute/update the state for postResult, i.e., all energy densities computed by time-integration @@ -354,7 +366,7 @@ module procedure mech_RGC_updateState !-------------------------------------------------------------------------------------------------- ! if residual blows-up => done but unhappy elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound - mech_RGC_updateState = [.true.,.false.] ! with direct cut-back + doneAndHappy = [.true.,.false.] ! with direct cut-back return endif @@ -484,7 +496,7 @@ module procedure mech_RGC_updateState enddo; enddo stt%relaxationVector(:,of) = relax + drelax ! Updateing the state variable for the next iteration if (any(abs(drelax) > num%maxdRelax)) then ! Forcing cutback when the incremental change of relaxation vector becomes too large - mech_RGC_updateState = [.true.,.false.] + doneAndHappy = [.true.,.false.] !$OMP CRITICAL (write2out) print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback' print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax)) @@ -513,8 +525,10 @@ module procedure mech_RGC_updateState real(pReal), dimension (3) :: nVect,surfCorr real(pReal), dimension (2) :: Gmoduli integer :: iGrain,iGNghb,iFace,i,j,k,l - real(pReal) :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb - real(pReal), parameter :: nDefToler = 1.0e-10_pReal + real(pReal) :: muGrain,muGNghb,nDefNorm + real(pReal), parameter :: & + nDefToler = 1.0e-10_pReal, & + b = 2.5e-10_pReal ! Length of Burgers vector nGDim = param(instance)%N_constituents rPen = 0.0_pReal @@ -532,9 +546,7 @@ module procedure mech_RGC_updateState !----------------------------------------------------------------------------------------------- ! computing the mismatch and penalty stress tensor of all grains grainLoop: do iGrain = 1,product(prm%N_constituents) - Gmoduli = equivalentModuli(iGrain,ip,el) - muGrain = Gmoduli(1) ! collecting the equivalent shear modulus of grain - bgGrain = Gmoduli(2) ! and the lengthh of Burgers vector + muGrain = equivalentMu(iGrain,ip,el) iGrain3 = grain1to3(iGrain,prm%N_constituents) ! get the grain ID in local 3-dimensional index (x,y,z)-position interfaceLoop: do iFace = 1,6 @@ -546,9 +558,7 @@ module procedure mech_RGC_updateState where(iGNghb3 < 1) iGNghb3 = nGDim where(iGNghb3 >nGDim) iGNghb3 = 1 iGNghb = grain3to1(iGNghb3,prm%N_constituents) ! get the ID of the neighboring grain - Gmoduli = equivalentModuli(iGNghb,ip,el) ! collect the shear modulus and Burgers vector of the neighbor - muGNghb = Gmoduli(1) - bgGNghb = Gmoduli(2) + muGNghb = equivalentMu(iGNghb,ip,el) gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor !------------------------------------------------------------------------------------------- @@ -568,7 +578,7 @@ module procedure mech_RGC_updateState !------------------------------------------------------------------------------------------- ! compute the stress penalty of all interfaces do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3 - rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xi_alpha & + rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha & *surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) & *cosh(prm%c_alpha*nDefNorm) & *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) & @@ -655,44 +665,26 @@ module procedure mech_RGC_updateState end function surfaceCorrection - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor - !-------------------------------------------------------------------------------------------------- - function equivalentModuli(grainID,ip,el) - - real(pReal), dimension(2) :: equivalentModuli + !------------------------------------------------------------------------------------------------- + real(pReal) function equivalentMu(grainID,ip,el) integer, intent(in) :: & grainID,& ip, & !< integration point number el !< element number - real(pReal), dimension(6,6) :: elasTens - real(pReal) :: & - cEquiv_11, & - cEquiv_12, & - cEquiv_44 - - elasTens = constitutive_homogenizedC(grainID,ip,el) - - !---------------------------------------------------------------------------------------------- - ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) - cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal - cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & - elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal - cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal - equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 - - !---------------------------------------------------------------------------------------------- - ! obtain the length of Burgers vector (could be model dependend) - equivalentModuli(2) = 2.5e-10_pReal - - end function equivalentModuli - !-------------------------------------------------------------------------------------------------- + equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt') + + end function equivalentMu + + + !------------------------------------------------------------------------------------------------- !> @brief calculating the grain deformation gradient (the same with ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme) - !-------------------------------------------------------------------------------------------------- + !------------------------------------------------------------------------------------------------- subroutine grainDeformation(F, avgF, instance, of) real(pReal), dimension(:,:,:), intent(out) :: F !< partitioned F per grain @@ -707,7 +699,7 @@ module procedure mech_RGC_updateState integer, dimension(3) :: iGrain3 integer :: iGrain,iFace,i,j - !------------------------------------------------------------------------------------------------- + !----------------------------------------------------------------------------------------------- ! compute the deformation gradient of individual grains due to relaxations associate(prm => param(instance)) @@ -729,7 +721,7 @@ module procedure mech_RGC_updateState end subroutine grainDeformation -end procedure mech_RGC_updateState +end function mech_RGC_updateState !-------------------------------------------------------------------------------------------------- diff --git a/src/lattice.f90 b/src/lattice.f90 index 676232efe..6af135e4e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -421,6 +421,8 @@ module lattice lattice_BCT_ID, & lattice_HEX_ID, & lattice_ORT_ID, & + lattice_equivalent_nu, & + lattice_equivalent_mu, & lattice_applyLatticeSymmetry33, & lattice_SchmidMatrix_slip, & lattice_SchmidMatrix_twin, & @@ -508,8 +510,8 @@ subroutine lattice_init lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice')) - lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') - lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_nu(p) = lattice_equivalent_nu(lattice_C66(1:6,1:6,p),'voigt') + lattice_mu(p) = lattice_equivalent_mu(lattice_C66(1:6,1:6,p),'voigt') lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p))) ! Literature data is in Voigt notation do i = 1, 6 @@ -2188,15 +2190,16 @@ end function getlabels !> @brief Equivalent Poisson's ratio (ν) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_nu(C,assumption) result(nu) +function lattice_equivalent_nu(C,assumption) result(nu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: K, mu, nu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then K = (C(1,1)+C(2,2)+C(3,3) +2.0_pReal*(C(1,2)+C(2,3)+C(1,3))) & / 9.0_pReal @@ -2210,25 +2213,26 @@ function equivalent_nu(C,assumption) result(nu) K = 0.0_pReal endif - mu = equivalent_mu(C,assumption) + mu = lattice_equivalent_mu(C,assumption) nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu) -end function equivalent_nu +end function lattice_equivalent_nu !-------------------------------------------------------------------------------------------------- !> @brief Equivalent shear modulus (μ) !> @details https://doi.org/10.1143/JPSJ.20.635 !-------------------------------------------------------------------------------------------------- -function equivalent_mu(C,assumption) result(mu) +function lattice_equivalent_mu(C,assumption) result(mu) real(pReal), dimension(6,6), intent(in) :: C !< Stiffness tensor (Voigt notation) character(len=*), intent(in) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress) - real(pReal) :: mu + logical :: error real(pReal), dimension(6,6) :: S + if (IO_lc(assumption) == 'voigt') then mu = (1.0_pReal*(C(1,1)+C(2,2)+C(3,3)) -1.0_pReal*(C(1,2)+C(2,3)+C(1,3)) +3.0_pReal*(C(4,4)+C(5,5)+C(6,6))) & / 15.0_pReal @@ -2242,7 +2246,7 @@ function equivalent_mu(C,assumption) result(mu) mu = 0.0_pReal endif -end function equivalent_mu +end function lattice_equivalent_mu !-------------------------------------------------------------------------------------------------- @@ -2266,14 +2270,14 @@ subroutine selfTest call random_number(C) C(1,1) = C(1,1) + 1.0_pReal C = applyLatticeSymmetryC66(C,'aP') - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' - if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt' + if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss' lambda = C(1,2) - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'voigt')),equivalent_nu(C,'voigt'),1.0e-12_pReal)) & - error stop 'equivalent_nu/voigt' - if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) & - error stop 'equivalent_nu/reuss' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), & + lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt' + if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), & + lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss' end subroutine selfTest diff --git a/src/math.f90 b/src/math.f90 index 8005b5406..6b89a9923 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -279,9 +279,12 @@ real(pReal) pure function math_LeviCivita(i,j,k) integer, intent(in) :: i,j,k - if (all([i,j,k] == [1,2,3]) .or. all([i,j,k] == [2,3,1]) .or. all([i,j,k] == [3,1,2])) then + integer :: o + + + if (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then math_LeviCivita = +1.0_pReal - elseif (all([i,j,k] == [3,2,1]) .or. all([i,j,k] == [2,1,3]) .or. all([i,j,k] == [1,3,2])) then + elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then math_LeviCivita = -1.0_pReal else math_LeviCivita = 0.0_pReal diff --git a/src/prec.f90 b/src/prec.f90 index 95b1116cd..4d73462c4 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -108,8 +108,10 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -132,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq = .not. dEq(a,b,tol) - else - dNeq = .not. dEq(a,b) - endif + + dNeq = .not. dEq(a,b,tol) end function dNeq @@ -151,8 +150,10 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -175,11 +176,8 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - if (present(tol)) then - dNeq0 = .not. dEq0(a,tol) - else - dNeq0 = .not. dEq0(a) - endif + + dNeq0 = .not. dEq0(a,tol) end function dNeq0 @@ -195,8 +193,10 @@ logical elemental pure function cEq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol + real(pReal) :: eps + if (present(tol)) then eps = tol else @@ -220,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol) complex(pReal), intent(in) :: a,b real(pReal), intent(in), optional :: tol - if (present(tol)) then - cNeq = .not. cEq(a,b,tol) - else - cNeq = .not. cEq(a,b) - endif + + cNeq = .not. cEq(a,b,tol) end function cNeq @@ -238,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes) real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: & prec_bytesToC_FLOAT + prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT)) end function prec_bytesToC_FLOAT @@ -252,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes) real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: & prec_bytesToC_DOUBLE + prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE)) end function prec_bytesToC_DOUBLE @@ -266,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes) integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: & prec_bytesToC_INT32_T + prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T)) end function prec_bytesToC_INT32_T @@ -280,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes) integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: & prec_bytesToC_INT64_T + prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T)) end function prec_bytesToC_INT64_T @@ -295,6 +296,7 @@ subroutine selfTest integer(pInt), dimension(1) :: i real(pReal), dimension(2) :: r + realloc_lhs_test = [1,2] if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation' From 7ac8fa307818d14c8cc56473f0991ad45feae669 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 7 Jan 2021 16:37:28 +0100 Subject: [PATCH 186/214] updated PRIVATE --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 899f0ae9e..76f383c4e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 899f0ae9e25ddad62530ec8a9381cf520aad083b +Subproject commit 76f383c4e57cb41b55de9aad4d9baf209a91633d From 7b22e5364398ddcb0d80fdf561a24a21d73eb2ba Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 7 Jan 2021 16:48:31 +0100 Subject: [PATCH 187/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-173-g584c7cc3a --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c6d828650..62c706093 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-153-gf8dd5df0c +v3.0.0-alpha2-173-g584c7cc3a From f0351e403a9b307ed7cba614db3a22df5dac8213 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 7 Jan 2021 11:01:15 -0500 Subject: [PATCH 188/214] removed duplicate test --- python/tests/test_Rotation.py | 8 -------- 1 file changed, 8 deletions(-) diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 1067e8a87..707bc0210 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -825,14 +825,6 @@ class TestRotation: print(f'append 3x {shape} --> {s.shape}') assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all() - @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)]) - def test_append_list(self,shape): - r = Rotation.from_random(shape=shape) - p = Rotation.from_random(shape=shape) - s = r.append([r,p]) - print(f'append 3x {shape} --> {s.shape}') - assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...] - @pytest.mark.parametrize('quat,standardized',[ ([-1,0,0,0],[1,0,0,0]), ([-0.5,-0.5,-0.5,-0.5],[0.5,0.5,0.5,0.5]), From 52aaf2fa5e73d205703925e9645cd5d4301bd943 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Thu, 7 Jan 2021 17:04:30 +0100 Subject: [PATCH 189/214] not needed --- src/mesh/discretization_mesh.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh/discretization_mesh.f90 b/src/mesh/discretization_mesh.f90 index 67b061fa4..1320d2609 100644 --- a/src/mesh/discretization_mesh.f90 +++ b/src/mesh/discretization_mesh.f90 @@ -68,7 +68,7 @@ subroutine discretization_mesh_init(restart) integer, allocatable, dimension(:) :: chunkPos integer :: dimPlex, & mesh_Nnodes, & !< total number of nodes in mesh - j, l, k, & + j, l, & debug_element, debug_ip PetscSF :: sf DM :: globalMesh From 203c39f63ab6c85ae4114834680f343afec7eadf Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 7 Jan 2021 18:39:17 +0100 Subject: [PATCH 190/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-175-g7cc2fb5b6 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c6d828650..516d79d83 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-153-gf8dd5df0c +v3.0.0-alpha2-175-g7cc2fb5b6 From 27f4e4ce2abb980028f38509e92127ca32196593 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 22:15:18 +0100 Subject: [PATCH 191/214] separate state for thermal --- src/constitutive.f90 | 146 ++------------- src/constitutive_mech.f90 | 10 + src/constitutive_thermal.f90 | 212 ++++++++++++++++++++-- src/constitutive_thermal_dissipation.f90 | 2 +- src/constitutive_thermal_externalheat.f90 | 24 +-- src/homogenization.f90 | 12 +- src/homogenization_thermal.f90 | 4 +- src/thermal_conduction.f90 | 43 +++-- src/thermal_isothermal.f90 | 26 ++- 9 files changed, 299 insertions(+), 180 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index f9537a136..6a023022f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -90,6 +90,7 @@ module constitutive phase_kinematics !< active kinematic mechanisms of each phase integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) + thermal_Nsources, & phase_Nsources, & !< number of source mechanisms active in each phase phase_Nkinematics, & !< number of kinematic mechanisms active in each phase phase_NstiffnessDegradations, & !< number of stiffness degradation mechanisms active in each phase @@ -233,6 +234,16 @@ module constitutive ! == cleaned:end =================================================================================== + module function integrateThermalState(dt,co,ip,el) result(broken) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + logical :: broken + end function + module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt integer, intent(in) :: co, ip, el @@ -665,31 +676,6 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) end function constitutive_damage_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_thermal_collectDotState(ph,me) result(broken) - - integer, intent(in) :: ph, me - logical :: broken - - integer :: i - - - broken = .false. - - SourceLoop: do i = 1, phase_Nsources(ph) - - if (phase_source(i,ph) == SOURCE_thermal_externalheat_ID) & - call source_thermal_externalheat_dotState(ph,me) - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(i)%dotState(:,me))) - - enddo SourceLoop - -end function constitutive_thermal_collectDotState - - !-------------------------------------------------------------------------------------------------- !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model @@ -856,7 +842,7 @@ subroutine crystallite_init() cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax !< maximum number of elements - + class(tNode), pointer :: & num_crystallite, & @@ -914,6 +900,9 @@ subroutine crystallite_init() do so = 1, phase_Nsources(ph) allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack enddo + do so = 1, thermal_Nsources(ph) + allocate(thermalState(ph)%p(so)%subState0,source=thermalState(ph)%p(so)%state0) ! ToDo: hack + enddo enddo print'(a42,1x,i10)', ' # of elements: ', eMax @@ -1144,111 +1133,6 @@ function integrateSourceState(dt,co,ip,el) result(broken) end function integrateSourceState - -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -function integrateThermalState(dt,co,ip,el) result(broken) - - real(pReal), intent(in) :: dt - integer, intent(in) :: & - el, & !< element index in element loop - ip, & !< integration point index in ip loop - co !< grain index in grain loop - - integer :: & - NiterationState, & !< number of iterations in state loop - ph, & - me, & - so - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken, converged_ - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - converged_ = .true. - broken = constitutive_thermal_collectDotState(ph,me) - if(broken) return - - do so = 1, phase_Nsources(ph) - size_so(so) = thermalState(ph)%p(so)%sizeDotState - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do so = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_thermal_collectDotState(ph,me) - broken = broken .or. constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) exit iteration - - do so = 1, phase_Nsources(ph) - zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & - - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - thermalState(ph)%p(so)%state(1:size_so(so),me), & - thermalState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) then - broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) - exit iteration - endif - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end function integrateThermalState - - !-------------------------------------------------------------------------------------------------- !> @brief determines whether a point is converged !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index fccccf00c..9a065a829 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1588,6 +1588,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) + enddo subFp0 = constitutive_mech_partitionedFp0(ph)%data(1:3,1:3,me) subFi0 = constitutive_mech_partitionedFi0(ph)%data(1:3,1:3,me) subF0 = constitutive_mech_partitionedF0(ph)%data(1:3,1:3,me) @@ -1616,6 +1619,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%state(:,me) + enddo endif !-------------------------------------------------------------------------------------------------- ! cut back (reduced time and restore) @@ -1632,6 +1638,9 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) enddo + do so = 1, thermal_Nsources(ph) + thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%subState0(:,me) + enddo todo = subStep > num%subStepMinCryst ! still on track or already done (beyond repair) endif @@ -1645,6 +1654,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateThermalState(subStep * dt,co,ip,el) endif enddo cutbackLooping diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index f1675f0a1..c86a286f9 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -6,9 +6,12 @@ submodule(constitutive) constitutive_thermal type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer + integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + thermal_source type(tDataContainer), dimension(:), allocatable :: current + integer :: thermal_source_maxSizeDotState interface module function source_thermal_dissipation_init(source_length) result(mySources) @@ -60,30 +63,55 @@ module subroutine thermal_init(phases) class(tNode), pointer :: & phases + class(tNode), pointer :: & + phase, thermal, sources + integer :: & - ph, & + ph, so, & Nconstituents - print'(/,a)', ' <<<+- constitutive_mech init -+>>>' + print'(/,a)', ' <<<+- constitutive_thermal init -+>>>' allocate(current(phases%length)) + allocate(thermalState (phases%length)) + allocate(thermal_Nsources(phases%length),source = 0) do ph = 1, phases%length Nconstituents = count(material_phaseAt == ph) * discretization_nIPs allocate(current(ph)%T(Nconstituents)) + phase => phases%get(ph) + if(phase%contains('thermal')) then + thermal => phase%get('thermal') + sources => thermal%get('source',defaultVal=emptyList) + thermal_Nsources(ph) = sources%length + endif + allocate(thermalstate(ph)%p(thermal_Nsources(ph))) enddo -! initialize source mechanisms - if(maxval(phase_Nsources) /= 0) then - where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID - where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID + allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = SOURCE_undefined_ID) + + if(maxval(thermal_Nsources) /= 0) then + where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_dissipation_ID + where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_externalheat_ID endif + thermal_source_maxSizeDotState = 0 + PhaseLoop2:do ph = 1,phases%length + + do so = 1,thermal_Nsources(ph) + thermalState(ph)%p(so)%partitionedState0 = thermalState(ph)%p(so)%state0 + thermalState(ph)%p(so)%state = thermalState(ph)%p(so)%partitionedState0 + enddo + + thermal_source_maxSizeDotState = max(thermal_source_maxSizeDotState, & + maxval(thermalState(ph)%p%sizeDotState)) + enddo PhaseLoop2 + !-------------------------------------------------------------------------------------------------- !initialize kinematic mechanisms if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) & @@ -123,8 +151,8 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, do co = 1, homogenization_Nconstituents(homog) ph = material_phaseAt(co,el) me = material_phasememberAt(co,ip,el) - do so = 1, phase_Nsources(ph) - select case(phase_source(so,ph)) + do so = 1, thermal_Nsources(ph) + select case(thermal_source(so,ph)) case (SOURCE_thermal_dissipation_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & mech_S(ph,me),mech_L_p(ph,me), ph) @@ -145,6 +173,131 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, end subroutine constitutive_thermal_getRateAndItsTangents +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_thermal_collectDotState(ph,me) result(broken) + + integer, intent(in) :: ph, me + logical :: broken + + integer :: i + + + broken = .false. + + SourceLoop: do i = 1, thermal_Nsources(ph) + + if (thermal_source(i,ph) == SOURCE_thermal_externalheat_ID) & + call source_thermal_externalheat_dotState(ph,me) + + broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me))) + + enddo SourceLoop + +end function constitutive_thermal_collectDotState + + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +module function integrateThermalState(dt,co,ip,el) result(broken) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(thermal_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(thermal_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(thermal_source_maxSizeDotState,2,maxval(thermal_Nsources)) :: source_dotState + logical :: & + broken, converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) return + + do so = 1, thermal_Nsources(ph) + size_so(so) = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, thermal_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_thermal_collectDotState(ph,me) + if(broken) exit iteration + + do so = 1, thermal_Nsources(ph) + zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & + - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & + - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt + thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + thermalState(ph)%p(so)%state(1:size_so(so),me), & + thermalState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) exit iteration + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateThermalState + + module subroutine thermal_initializeRestorationPoints(ph,me) @@ -153,7 +306,7 @@ module subroutine thermal_initializeRestorationPoints(ph,me) integer :: so - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me) enddo @@ -168,7 +321,7 @@ module subroutine thermal_windForward(ph,me) integer :: so - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me) enddo @@ -181,7 +334,7 @@ module subroutine thermal_forward() do ph = 1, size(thermalState) - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state enddo enddo @@ -200,7 +353,7 @@ module subroutine thermal_restore(ip,el) ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - do so = 1, size(sourceState(ph)%p) + do so = 1, size(thermalState(ph)%p) thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) enddo @@ -237,4 +390,39 @@ module subroutine constitutive_thermal_setT(T,co,ip,el) end subroutine constitutive_thermal_setT + +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function thermal_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, thermal, & + src + integer :: p,s + + phases => config_material%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + if (phase%contains('thermal')) then + thermal => phase%get('thermal',defaultVal=emptyList) + sources => thermal%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + if(src%get_asString('type') == source_label) active_source(s,p) = .true. + enddo + endif + enddo + + +end function thermal_active + + end submodule constitutive_thermal diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 27653a9ef..44227536c 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -62,7 +62,7 @@ module function source_thermal_dissipation_init(source_length) result(mySources) src => sources%get(sourceOffset) prm%kappa = src%get_asFloat('kappa') Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,0,0,0) + call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0) end associate endif diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 3ef96790e..de1617efa 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -13,7 +13,7 @@ submodule(constitutive:constitutive_thermal) source_externalheat type :: tParameters !< container type for internal constitutive parameters real(pReal), dimension(:), allocatable :: & - t_n, & + t_n, & f_T integer :: & nIntervals @@ -31,19 +31,20 @@ contains !-------------------------------------------------------------------------------------------------- module function source_thermal_externalheat_init(source_length) result(mySources) - integer, intent(in) :: source_length + integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & - sources, & - src + sources, thermal, & + src integer :: Ninstances,sourceOffset,Nconstituents,p print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>' - mySources = source_active('thermal_externalheat',source_length) + mySources = thermal_active('externalheat',source_length) + Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -54,15 +55,16 @@ module function source_thermal_externalheat_init(source_length) result(mySources allocate(source_thermal_externalheat_instance(phases%length), source=0) do p = 1, phases%length - phase => phases%get(p) + phase => phases%get(p) if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p)) if(count(mySources(:,p)) == 0) cycle - sources => phase%get('source') + thermal => phase%get('thermal') + sources => thermal%get('source') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then source_thermal_externalheat_offset(p) = sourceOffset associate(prm => param(source_thermal_externalheat_instance(p))) - src => sources%get(sourceOffset) + src => sources%get(sourceOffset) prm%t_n = src%get_asFloats('t_n') prm%nIntervals = size(prm%t_n) - 1 @@ -70,7 +72,7 @@ module function source_thermal_externalheat_init(source_length) result(mySources prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n)) Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) + call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0) end associate endif @@ -95,7 +97,7 @@ module subroutine source_thermal_externalheat_dotState(phase, of) sourceOffset = source_thermal_externalheat_offset(phase) - sourceState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time + thermalState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal ! state is current time end subroutine source_thermal_externalheat_dotState @@ -121,7 +123,7 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d associate(prm => param(source_thermal_externalheat_instance(phase))) do interval = 1, prm%nIntervals ! scan through all rate segments - frac_time = (sourceState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) & + frac_time = (thermalState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) & / (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment if ( (frac_time < 0.0_pReal .and. interval == 1) & .or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index df7369096..8738ba6f1 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -69,6 +69,13 @@ module homogenization el !< element number end subroutine mech_partition + module subroutine thermal_partition(T,ip,el) + real(pReal), intent(in) :: T + integer, intent(in) :: & + ip, & !< integration point + el !< element number + end subroutine thermal_partition + module subroutine mech_homogenize(dt,ip,el) real(pReal), intent(in) :: dt integer, intent(in) :: & @@ -131,9 +138,10 @@ subroutine homogenization_init call mech_init(num_homog) + call thermal_init() - if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init - if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init + if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init(homogenization_T) + if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init(homogenization_T) if (any(damage_type == DAMAGE_none_ID)) call damage_none_init if (any(damage_type == DAMAGE_nonlocal_ID)) call damage_nonlocal_init diff --git a/src/homogenization_thermal.f90 b/src/homogenization_thermal.f90 index 59e7357b6..f181d97fa 100644 --- a/src/homogenization_thermal.f90 +++ b/src/homogenization_thermal.f90 @@ -11,9 +11,11 @@ contains !-------------------------------------------------------------------------------------------------- module subroutine thermal_init() + print'(/,a)', ' <<<+- homogenization_thermal init -+>>>' - allocate(homogenization_T(discretization_nIPs*discretization_Nelems), source=0.0_pReal) + allocate(homogenization_T(discretization_nIPs*discretization_Nelems)) + end subroutine thermal_init diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index f98d36d3b..0cd1678e0 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -10,6 +10,7 @@ module thermal_conduction use results use constitutive use YAML_types + use discretization implicit none private @@ -38,25 +39,28 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_init +subroutine thermal_conduction_init(T) - integer :: Ninstances,Nmaterialpoints,h + real(pReal), dimension(:), intent(inout) :: T + + integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce class(tNode), pointer :: & material_homogenization, & homog, & homogThermal - + + print'(/,a)', ' <<<+- thermal_conduction init -+>>>'; flush(6) Ninstances = count(thermal_type == THERMAL_conduction_ID) allocate(param(Ninstances)) material_homogenization => config_material%get('homogenization') - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_conduction_ID) cycle - homog => material_homogenization%get(h) + do ho = 1, size(material_name_homogenization) + if (thermal_type(ho) /= THERMAL_conduction_ID) cycle + homog => material_homogenization%get(ho) homogThermal => homog%get('thermal') - associate(prm => param(thermal_typeInstance(h))) + associate(prm => param(thermal_typeInstance(ho))) #if defined (__GFORTRAN__) prm%output = output_asStrings(homogThermal) @@ -64,14 +68,23 @@ subroutine thermal_conduction_init prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray) #endif - Nmaterialpoints=count(material_homogenizationAt==h) + Nmaterialpoints=count(material_homogenizationAt==ho) - allocate (temperature (h)%p(Nmaterialpoints), source=thermal_initialT(h)) - allocate (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal) + allocate (temperature (ho)%p(Nmaterialpoints), source=thermal_initialT(ho)) + allocate (temperatureRate(ho)%p(Nmaterialpoints), source=0.0_pReal) end associate enddo + ce = 0 + do el = 1, discretization_Nelems + do ip = 1, discretization_nIPs + ce = ce + 1 + ho = material_homogenizationAt(el) + if (thermal_type(ho) == THERMAL_conduction_ID) T(ce) = thermal_initialT(ho) + enddo + enddo + end subroutine thermal_conduction_init @@ -89,12 +102,12 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) Tdot, dTdot_dT integer :: & homog - + Tdot = 0.0_pReal dTdot_dT = 0.0_pReal homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) @@ -112,13 +125,13 @@ function thermal_conduction_getConductivity(ip,el) el !< element number real(pReal), dimension(3,3) :: & thermal_conduction_getConductivity - + integer :: & co thermal_conduction_getConductivity = 0.0_pReal - + do co = 1, homogenization_Nconstituents(material_homogenizationAt(el)) thermal_conduction_getConductivity = thermal_conduction_getConductivity + & crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el))) @@ -168,7 +181,7 @@ function thermal_conduction_getMassDensity(ip,el) el !< element number real(pReal) :: & thermal_conduction_getMassDensity - + integer :: & co diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 2a41ada49..09e35931e 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -6,6 +6,7 @@ module thermal_isothermal use prec use config use material + use discretization implicit none public @@ -15,22 +16,33 @@ contains !-------------------------------------------------------------------------------------------------- !> @brief allocates fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- -subroutine thermal_isothermal_init +subroutine thermal_isothermal_init(T) - integer :: h,Nmaterialpoints + real(pReal), dimension(:), intent(inout) :: T + + integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce print'(/,a)', ' <<<+- thermal_isothermal init -+>>>'; flush(6) - do h = 1, size(material_name_homogenization) - if (thermal_type(h) /= THERMAL_isothermal_ID) cycle + do ho = 1, size(thermal_type) + if (thermal_type(ho) /= THERMAL_isothermal_ID) cycle - Nmaterialpoints = count(material_homogenizationAt == h) + Nmaterialpoints = count(material_homogenizationAt == ho) - allocate(temperature (h)%p(Nmaterialpoints),source=thermal_initialT(h)) - allocate(temperatureRate(h)%p(Nmaterialpoints),source = 0.0_pReal) + allocate(temperature (ho)%p(Nmaterialpoints),source=thermal_initialT(ho)) + allocate(temperatureRate(ho)%p(Nmaterialpoints),source = 0.0_pReal) enddo + ce = 0 + do el = 1, discretization_Nelems + do ip = 1, discretization_nIPs + ce = ce + 1 + ho = material_homogenizationAt(el) + if (thermal_type(ho) == THERMAL_isothermal_ID) T(ce) = thermal_initialT(ho) + enddo + enddo + end subroutine thermal_isothermal_init end module thermal_isothermal From 1df409376c884e1138dc3b2eeb0b7f9eee76481b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 23:32:54 +0100 Subject: [PATCH 192/214] sourceState is now damage state --- src/constitutive.f90 | 283 ++---------------------------------- src/constitutive_damage.f90 | 193 ++++++++++++++++++++++++ src/constitutive_mech.f90 | 82 ++++++++++- 3 files changed, 286 insertions(+), 272 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 6a023022f..43d9b6b3f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -235,14 +235,22 @@ module constitutive ! == cleaned:end =================================================================================== module function integrateThermalState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop logical :: broken - end function + end function integrateThermalState + + module function integrateDamageState(dt,co,ip,el) result(broken) + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + logical :: broken + end function integrateDamageState module function crystallite_stress(dt,co,ip,el) result(converged_) real(pReal), intent(in) :: dt @@ -395,7 +403,6 @@ module constitutive public :: & constitutive_init, & constitutive_homogenizedC, & - constitutive_LiAndItsTangents, & constitutive_damage_getRateAndItsTangents, & constitutive_thermal_getRateAndItsTangents, & constitutive_results, & @@ -413,7 +420,8 @@ module constitutive crystallite_push33ToRef, & constitutive_restartWrite, & constitutive_restartRead, & - integrateSourceState, & + integrateThermalState, & + integrateDamageState, & constitutive_thermal_setT, & constitutive_mech_getP, & constitutive_mech_setF, & @@ -555,173 +563,6 @@ function kinematics_active(kinematics_label,kinematics_length) result(active_ki end function kinematics_active -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the velocity gradient -! ToDo: MD: S is Mi? -!-------------------------------------------------------------------------------------------------- -subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & - S, Fi, co, ip, el) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in), dimension(3,3) :: & - S !< 2nd Piola-Kirchhoff stress - real(pReal), intent(in), dimension(3,3) :: & - Fi !< intermediate deformation gradient - real(pReal), intent(out), dimension(3,3) :: & - Li !< intermediate velocity gradient - real(pReal), intent(out), dimension(3,3,3,3) :: & - dLi_dS, & !< derivative of Li with respect to S - dLi_dFi - - real(pReal), dimension(3,3) :: & - my_Li, & !< intermediate velocity gradient - FiInv, & - temp_33 - real(pReal), dimension(3,3,3,3) :: & - my_dLi_dS - real(pReal) :: & - detFi - integer :: & - k, i, j, & - instance, of - - Li = 0.0_pReal - dLi_dS = 0.0_pReal - dLi_dFi = 0.0_pReal - - plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) - case (PLASTICITY_isotropic_ID) plasticityType - of = material_phasememberAt(co,ip,el) - instance = phase_plasticityInstance(material_phaseAt(co,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) - case default plasticityType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select plasticityType - - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - - KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) - kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) - case (KINEMATICS_cleavage_opening_ID) kinematicsType - call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_slipplane_opening_ID) kinematicsType - call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) - case (KINEMATICS_thermal_expansion_ID) kinematicsType - call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) - case default kinematicsType - my_Li = 0.0_pReal - my_dLi_dS = 0.0_pReal - end select kinematicsType - Li = Li + my_Li - dLi_dS = dLi_dS + my_dLi_dS - enddo KinematicsLoop - - FiInv = math_inv33(Fi) - detFi = math_det33(Fi) - Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration - temp_33 = matmul(FiInv,Li) - - do i = 1,3; do j = 1,3 - dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi - dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) - dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) - enddo; enddo - -end subroutine constitutive_LiAndItsTangents - - -!-------------------------------------------------------------------------------------------------- -!> @brief contains the constitutive equation for calculating the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - integer :: & - so !< counter in source loop - logical :: broken - - - broken = .false. - - SourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_anisoBrittle_ID) sourceType - call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& - co, ip, el) ! correct stress? - - case (SOURCE_damage_isoDuctile_ID) sourceType - call source_damage_isoDuctile_dotState(co, ip, el) - - case (SOURCE_damage_anisoDuctile_ID) sourceType - call source_damage_anisoDuctile_dotState(co, ip, el) - - end select sourceType - - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) - - enddo SourceLoop - -end function constitutive_damage_collectDotState - - -!-------------------------------------------------------------------------------------------------- -!> @brief for constitutive models having an instantaneous change of state -!> will return false if delta state is not needed/supported by the constitutive model -!-------------------------------------------------------------------------------------------------- -function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) - - integer, intent(in) :: & - co, & !< component-ID of integration point - ip, & !< integration point - el, & !< element - ph, & - of - real(pReal), intent(in), dimension(3,3) :: & - Fe !< elastic deformation gradient - integer :: & - so, & - myOffset, & - mySize - logical :: & - broken - - - broken = .false. - - sourceLoop: do so = 1, phase_Nsources(ph) - - sourceType: select case (phase_source(so,ph)) - - case (SOURCE_damage_isoBrittle_ID) sourceType - call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & - co, ip, el) - broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) - if(.not. broken) then - myOffset = sourceState(ph)%p(so)%offsetDeltaState - mySize = sourceState(ph)%p(so)%sizeDeltaState - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) - endif - - end select sourceType - - enddo SourceLoop - -end function constitutive_damage_deltaState - - !-------------------------------------------------------------------------------------------------- !> @brief Allocate the components of the state structure for a given phase !-------------------------------------------------------------------------------------------------- @@ -1030,107 +871,7 @@ function crystallite_push33ToRef(co,ip,el, tensor33) end function crystallite_push33ToRef -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -function integrateSourceState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt - integer, intent(in) :: & - el, & !< element index in element loop - ip, & !< integration point index in ip loop - co !< grain index in grain loop - - integer :: & - NiterationState, & !< number of iterations in state loop - ph, & - me, & - so - integer, dimension(maxval(phase_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(constitutive_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState - logical :: & - broken, converged_ - - - ph = material_phaseAt(co,el) - me = material_phaseMemberAt(co,ip,el) - - converged_ = .true. - broken = constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) return - - do so = 1, phase_Nsources(ph) - size_so(so) = sourceState(ph)%p(so)%sizeDotState - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal - enddo - - iteration: do NiterationState = 1, num%nState - - do so = 1, phase_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_damage_collectDotState(co,ip,el,ph,me) - if(broken) exit iteration - - do so = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) then - broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) - exit iteration - endif - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - -end function integrateSourceState !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 3ce614666..be47d92b6 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -214,6 +214,111 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents + +!-------------------------------------------------------------------------------------------------- +!> @brief integrate stress, state with adaptive 1st order explicit Euler method +!> using Fixed Point Iteration to adapt the stepsize +!-------------------------------------------------------------------------------------------------- +module function integrateDamageState(dt,co,ip,el) result(broken) + + real(pReal), intent(in) :: dt + integer, intent(in) :: & + el, & !< element index in element loop + ip, & !< integration point index in ip loop + co !< grain index in grain loop + logical :: broken + + integer :: & + NiterationState, & !< number of iterations in state loop + ph, & + me, & + so + integer, dimension(maxval(phase_Nsources)) :: & + size_so + real(pReal) :: & + zeta + real(pReal), dimension(constitutive_source_maxSizeDotState) :: & + r ! state residuum + real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState + logical :: & + converged_ + + + ph = material_phaseAt(co,el) + me = material_phaseMemberAt(co,ip,el) + + converged_ = .true. + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) return + + do so = 1, phase_Nsources(ph) + size_so(so) = sourceState(ph)%p(so)%sizeDotState + sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt + source_dotState(1:size_so(so),2,so) = 0.0_pReal + enddo + + iteration: do NiterationState = 1, num%nState + + do so = 1, phase_Nsources(ph) + if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) + source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) + enddo + + broken = constitutive_damage_collectDotState(co,ip,el,ph,me) + if(broken) exit iteration + + do so = 1, phase_Nsources(ph) + zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & + source_dotState(1:size_so(so),1,so),& + source_dotState(1:size_so(so),2,so)) + sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) + r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & + - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & + - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt + sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & + - r(1:size_so(so)) + converged_ = converged_ .and. converged(r(1:size_so(so)), & + sourceState(ph)%p(so)%state(1:size_so(so),me), & + sourceState(ph)%p(so)%atol(1:size_so(so))) + enddo + + if(converged_) then + broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me) + exit iteration + endif + + enddo iteration + + broken = broken .or. .not. converged_ + + + contains + + !-------------------------------------------------------------------------------------------------- + !> @brief calculate the damping for correction of state and dot state + !-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + real(pReal), dimension(:), intent(in) ::& + current, previous, previous2 + + real(pReal) :: dot_prod12, dot_prod22 + + dot_prod12 = dot_product(current - previous, previous - previous2) + dot_prod22 = dot_product(previous - previous2, previous - previous2) + if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then + damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) + else + damper = 1.0_pReal + endif + + end function damper + +end function integrateDamageState + + !---------------------------------------------------------------------------------------------- !< @brief writes damage sources results to HDF5 output file !---------------------------------------------------------------------------------------------- @@ -250,4 +355,92 @@ module subroutine damage_results(group,ph) end subroutine damage_results +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + of + integer :: & + so !< counter in source loop + logical :: broken + + + broken = .false. + + SourceLoop: do so = 1, phase_Nsources(ph) + + sourceType: select case (phase_source(so,ph)) + + case (SOURCE_damage_anisoBrittle_ID) sourceType + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? + + case (SOURCE_damage_isoDuctile_ID) sourceType + call source_damage_isoDuctile_dotState(co, ip, el) + + case (SOURCE_damage_anisoDuctile_ID) sourceType + call source_damage_anisoDuctile_dotState(co, ip, el) + + end select sourceType + + broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) + + enddo SourceLoop + +end function constitutive_damage_collectDotState + + + +!-------------------------------------------------------------------------------------------------- +!> @brief for constitutive models having an instantaneous change of state +!> will return false if delta state is not needed/supported by the constitutive model +!-------------------------------------------------------------------------------------------------- +function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el, & !< element + ph, & + of + real(pReal), intent(in), dimension(3,3) :: & + Fe !< elastic deformation gradient + integer :: & + so, & + myOffset, & + mySize + logical :: & + broken + + + broken = .false. + + sourceLoop: do so = 1, phase_Nsources(ph) + + sourceType: select case (phase_source(so,ph)) + + case (SOURCE_damage_isoBrittle_ID) sourceType + call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & + co, ip, el) + broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) + if(.not. broken) then + myOffset = sourceState(ph)%p(so)%offsetDeltaState + mySize = sourceState(ph)%p(so)%sizeDeltaState + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & + sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) + endif + + end select sourceType + + enddo SourceLoop + +end function constitutive_damage_deltaState + + end submodule constitutive_damage diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 9a065a829..7c403eeea 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1653,7 +1653,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) constitutive_mech_Fe(ph)%data(1:3,1:3,me) = matmul(subF,math_inv33(matmul(constitutive_mech_Fi(ph)%data(1:3,1:3,me), & constitutive_mech_Fp(ph)%data(1:3,1:3,me)))) converged_ = .not. integrateState(subF0,subF,subFp0,subFi0,subState0(1:sizeDotState),subStep * dt,co,ip,el) - converged_ = converged_ .and. .not. integrateSourceState(subStep * dt,co,ip,el) + converged_ = converged_ .and. .not. integrateDamageState(subStep * dt,co,ip,el) converged_ = converged_ .and. .not. integrateThermalState(subStep * dt,co,ip,el) endif @@ -1938,5 +1938,85 @@ module subroutine constitutive_mech_setF(F,co,ip,el) end subroutine constitutive_mech_setF + +!-------------------------------------------------------------------------------------------------- +!> @brief contains the constitutive equation for calculating the velocity gradient +! ToDo: MD: S is Mi? +!-------------------------------------------------------------------------------------------------- +subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, & + S, Fi, co, ip, el) + + integer, intent(in) :: & + co, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), intent(in), dimension(3,3) :: & + S !< 2nd Piola-Kirchhoff stress + real(pReal), intent(in), dimension(3,3) :: & + Fi !< intermediate deformation gradient + real(pReal), intent(out), dimension(3,3) :: & + Li !< intermediate velocity gradient + real(pReal), intent(out), dimension(3,3,3,3) :: & + dLi_dS, & !< derivative of Li with respect to S + dLi_dFi + + real(pReal), dimension(3,3) :: & + my_Li, & !< intermediate velocity gradient + FiInv, & + temp_33 + real(pReal), dimension(3,3,3,3) :: & + my_dLi_dS + real(pReal) :: & + detFi + integer :: & + k, i, j, & + instance, of + + Li = 0.0_pReal + dLi_dS = 0.0_pReal + dLi_dFi = 0.0_pReal + + plasticityType: select case (phase_plasticity(material_phaseAt(co,el))) + case (PLASTICITY_isotropic_ID) plasticityType + of = material_phasememberAt(co,ip,el) + instance = phase_plasticityInstance(material_phaseAt(co,el)) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S ,instance,of) + case default plasticityType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select plasticityType + + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + + KinematicsLoop: do k = 1, phase_Nkinematics(material_phaseAt(co,el)) + kinematicsType: select case (phase_kinematics(k,material_phaseAt(co,el))) + case (KINEMATICS_cleavage_opening_ID) kinematicsType + call kinematics_cleavage_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) + case (KINEMATICS_slipplane_opening_ID) kinematicsType + call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S, co, ip, el) + case (KINEMATICS_thermal_expansion_ID) kinematicsType + call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, co, ip, el) + case default kinematicsType + my_Li = 0.0_pReal + my_dLi_dS = 0.0_pReal + end select kinematicsType + Li = Li + my_Li + dLi_dS = dLi_dS + my_dLi_dS + enddo KinematicsLoop + + FiInv = math_inv33(Fi) + detFi = math_det33(Fi) + Li = matmul(matmul(Fi,Li),FiInv)*detFi !< push forward to intermediate configuration + temp_33 = matmul(FiInv,Li) + + do i = 1,3; do j = 1,3 + dLi_dS(1:3,1:3,i,j) = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi + dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i) + dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i) + enddo; enddo + +end subroutine constitutive_LiAndItsTangents + end submodule constitutive_mech From 5efa6c997a2f31d163a892800fc18d065104ea99 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 7 Jan 2021 23:50:06 +0100 Subject: [PATCH 193/214] meaningful scope --- src/constitutive.f90 | 37 +---------------------------- src/constitutive_damage.f90 | 46 ++++++++++++++++++++++-------------- src/constitutive_mech.f90 | 20 +++++++++++++--- src/constitutive_thermal.f90 | 20 ++++++++++------ 4 files changed, 59 insertions(+), 64 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 43d9b6b3f..5f96e80e6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -21,21 +21,6 @@ module constitutive private enum, bind(c); enumerator :: & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & @@ -81,12 +66,7 @@ module constitutive type(tDebugOptions) :: debugCrystallite - - integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public :: & - phase_plasticity !< plasticity of each phase - - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & - phase_source, & !< active sources mechanisms of each phase + integer(kind(KINEMATICS_UNDEFINED_ID)), dimension(:,:), allocatable :: & phase_kinematics !< active kinematic mechanisms of each phase integer, dimension(:), allocatable, public :: & !< ToDo: should be protected (bug in Intel compiler) @@ -428,21 +408,6 @@ module constitutive constitutive_mech_getF, & constitutive_initializeRestorationPoints, & constitutive_windForward, & - PLASTICITY_UNDEFINED_ID, & - PLASTICITY_NONE_ID, & - PLASTICITY_ISOTROPIC_ID, & - PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_KINEHARDENING_ID, & - PLASTICITY_DISLOTWIN_ID, & - PLASTICITY_DISLOTUNGSTEN_ID, & - PLASTICITY_NONLOCAL_ID, & - SOURCE_UNDEFINED_ID ,& - SOURCE_THERMAL_DISSIPATION_ID, & - SOURCE_THERMAL_EXTERNALHEAT_ID, & - SOURCE_DAMAGE_ISOBRITTLE_ID, & - SOURCE_DAMAGE_ISODUCTILE_ID, & - SOURCE_DAMAGE_ANISOBRITTLE_ID, & - SOURCE_DAMAGE_ANISODUCTILE_ID, & KINEMATICS_UNDEFINED_ID ,& KINEMATICS_CLEAVAGE_OPENING_ID, & KINEMATICS_SLIPPLANE_OPENING_ID, & diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index be47d92b6..ea00b5c94 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -2,6 +2,16 @@ !> @brief internal microstructure state for all damage sources and kinematics constitutive models !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_damage + enum, bind(c); enumerator :: & + DAMAGE_UNDEFINED_ID, & + DAMAGE_ISOBRITTLE_ID, & + DAMAGE_ISODUCTILE_ID, & + DAMAGE_ANISOBRITTLE_ID, & + DAMAGE_ANISODUCTILE_ID + end enum + + integer(kind(DAMAGE_UNDEFINED_ID)), dimension(:,:), allocatable :: & + phase_source !< active sources mechanisms of each phase interface @@ -129,14 +139,14 @@ module subroutine damage_init allocate(sourceState(ph)%p(phase_Nsources(ph))) enddo - allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) + allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID) ! initialize source mechanisms if(maxval(phase_Nsources) /= 0) then - where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID - where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID - where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID - where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID + where(source_damage_isoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISOBRITTLE_ID + where(source_damage_isoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ISODUCTILE_ID + where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISOBRITTLE_ID + where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISODUCTILE_ID endif !-------------------------------------------------------------------------------------------------- @@ -189,16 +199,16 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi constituent = material_phasememberAt(grain,ip,el) do source = 1, phase_Nsources(phase) select case(phase_source(source,phase)) - case (SOURCE_damage_isoBrittle_ID) + case (DAMAGE_ISOBRITTLE_ID) call source_damage_isobrittle_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_isoDuctile_ID) + case (DAMAGE_ISODUCTILE_ID) call source_damage_isoductile_getRateAndItsTangent (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoBrittle_ID) + case (DAMAGE_ANISOBRITTLE_ID) call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) - case (SOURCE_damage_anisoDuctile_ID) + case (DAMAGE_ANISODUCTILE_ID) call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent) case default @@ -331,21 +341,21 @@ module subroutine damage_results(group,ph) sourceLoop: do so = 1, phase_Nsources(ph) - if (phase_source(so,ph) /= SOURCE_UNDEFINED_ID) & + if (phase_source(so,ph) /= DAMAGE_UNDEFINED_ID) & call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage' sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_anisoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_anisoBrittle_results(ph,group//'sources/') - case (SOURCE_damage_anisoDuctile_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_anisoDuctile_results(ph,group//'sources/') - case (SOURCE_damage_isoBrittle_ID) sourceType + case (DAMAGE_ANISOBRITTLE_ID) sourceType call source_damage_isoBrittle_results(ph,group//'sources/') - case (SOURCE_damage_isoDuctile_ID) sourceType + case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_isoDuctile_results(ph,group//'sources/') end select sourceType @@ -377,14 +387,14 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_anisoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& co, ip, el) ! correct stress? - case (SOURCE_damage_isoDuctile_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) - case (SOURCE_damage_anisoDuctile_ID) sourceType + case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_anisoDuctile_dotState(co, ip, el) end select sourceType @@ -425,7 +435,7 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) sourceType: select case (phase_source(so,ph)) - case (SOURCE_damage_isoBrittle_ID) sourceType + case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & co, ip, el) broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 7c403eeea..9539d0b93 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -7,12 +7,20 @@ submodule(constitutive) constitutive_mech ELASTICITY_UNDEFINED_ID, & ELASTICITY_HOOKE_ID, & STIFFNESS_DEGRADATION_UNDEFINED_ID, & - STIFFNESS_DEGRADATION_DAMAGE_ID + STIFFNESS_DEGRADATION_DAMAGE_ID, & + PLASTICITY_UNDEFINED_ID, & + PLASTICITY_NONE_ID, & + PLASTICITY_ISOTROPIC_ID, & + PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & + PLASTICITY_DISLOTWIN_ID, & + PLASTICITY_DISLOTUNGSTEN_ID, & + PLASTICITY_NONLOCAL_ID end enum - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable :: & + integer(kind(ELASTICITY_UNDEFINED_ID)), dimension(:), allocatable :: & phase_elasticity !< elasticity of each phase - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + integer(kind(STIFFNESS_DEGRADATION_UNDEFINED_ID)), dimension(:,:), allocatable :: & phase_stiffnessDegradation !< active stiffness degradation mechanisms of each phase type(tTensorContainer), dimension(:), allocatable :: & @@ -41,6 +49,12 @@ submodule(constitutive) constitutive_mech constitutive_mech_partitionedS0 + + + integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable :: & + phase_plasticity !< plasticity of each phase + + interface module function plastic_none_init() result(myPlasticity) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index c86a286f9..636d7e447 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -3,10 +3,16 @@ !---------------------------------------------------------------------------------------------------- submodule(constitutive) constitutive_thermal + enum, bind(c); enumerator :: & + THERMAL_UNDEFINED_ID ,& + THERMAL_DISSIPATION_ID, & + THERMAL_EXTERNALHEAT_ID + end enum + type :: tDataContainer real(pReal), dimension(:), allocatable :: T end type tDataContainer - integer(kind(SOURCE_undefined_ID)), dimension(:,:), allocatable :: & + integer(kind(THERMAL_UNDEFINED_ID)), dimension(:,:), allocatable :: & thermal_source type(tDataContainer), dimension(:), allocatable :: current @@ -93,11 +99,11 @@ module subroutine thermal_init(phases) allocate(thermalstate(ph)%p(thermal_Nsources(ph))) enddo - allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = SOURCE_undefined_ID) + allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID) if(maxval(thermal_Nsources) /= 0) then - where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_dissipation_ID - where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = SOURCE_thermal_externalheat_ID + where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID + where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID endif thermal_source_maxSizeDotState = 0 @@ -153,11 +159,11 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, me = material_phasememberAt(co,ip,el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) - case (SOURCE_thermal_dissipation_ID) + case (THERMAL_DISSIPATION_ID) call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & mech_S(ph,me),mech_L_p(ph,me), ph) - case (SOURCE_thermal_externalheat_ID) + case (THERMAL_EXTERNALHEAT_ID) call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & ph, me) @@ -188,7 +194,7 @@ function constitutive_thermal_collectDotState(ph,me) result(broken) SourceLoop: do i = 1, thermal_Nsources(ph) - if (thermal_source(i,ph) == SOURCE_thermal_externalheat_ID) & + if (thermal_source(i,ph) == THERMAL_EXTERNALHEAT_ID) & call source_thermal_externalheat_dotState(ph,me) broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me))) From 7239c0b226188ac102c54d1a5167ef1a8c6076a9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 00:40:21 +0100 Subject: [PATCH 194/214] explicit Euler is ok (only state is current time) --- src/constitutive.f90 | 4 +- src/constitutive_thermal.f90 | 91 ++++++------------------------------ 2 files changed, 15 insertions(+), 80 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 5f96e80e6..9e9cfe423 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -214,8 +214,8 @@ module constitutive ! == cleaned:end =================================================================================== - module function integrateThermalState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt + module function integrateThermalState(Delta_t,co,ip,el) result(broken) + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 636d7e447..e6aa7c4cf 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -204,107 +204,42 @@ function constitutive_thermal_collectDotState(ph,me) result(broken) end function constitutive_thermal_collectDotState -!-------------------------------------------------------------------------------------------------- -!> @brief integrate stress, state with adaptive 1st order explicit Euler method -!> using Fixed Point Iteration to adapt the stepsize -!-------------------------------------------------------------------------------------------------- -module function integrateThermalState(dt,co,ip,el) result(broken) - real(pReal), intent(in) :: dt +!-------------------------------------------------------------------------------------------------- +!> @brief integrate state with 1st order explicit Euler method +!-------------------------------------------------------------------------------------------------- +function integrateThermalState(Delta_t,co,ip,el) result(broken) + + real(pReal), intent(in) :: Delta_t integer, intent(in) :: & el, & !< element index in element loop ip, & !< integration point index in ip loop co !< grain index in grain loop + logical :: & + broken integer :: & - NiterationState, & !< number of iterations in state loop ph, & me, & - so - integer, dimension(maxval(thermal_Nsources)) :: & - size_so - real(pReal) :: & - zeta - real(pReal), dimension(thermal_source_maxSizeDotState) :: & - r ! state residuum - real(pReal), dimension(thermal_source_maxSizeDotState,2,maxval(thermal_Nsources)) :: source_dotState - logical :: & - broken, converged_ + so, & + sizeDotState ph = material_phaseAt(co,el) me = material_phaseMemberAt(co,ip,el) - converged_ = .true. broken = constitutive_thermal_collectDotState(ph,me) if(broken) return do so = 1, thermal_Nsources(ph) - size_so(so) = thermalState(ph)%p(so)%sizeDotState - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - + thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - source_dotState(1:size_so(so),2,so) = 0.0_pReal + sizeDotState = thermalState(ph)%p(so)%sizeDotState + thermalState(ph)%p(so)%state(1:sizeDotState,me) = thermalState(ph)%p(so)%subState0(1:sizeDotState,me) & + + thermalState(ph)%p(so)%dotState(1:sizeDotState,me) * Delta_t enddo - iteration: do NiterationState = 1, num%nState - - do so = 1, thermal_Nsources(ph) - if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = thermalState(ph)%p(so)%dotState(:,me) - enddo - - broken = constitutive_thermal_collectDotState(ph,me) - if(broken) exit iteration - - do so = 1, thermal_Nsources(ph) - zeta = damper(thermalState(ph)%p(so)%dotState(:,me), & - source_dotState(1:size_so(so),1,so),& - source_dotState(1:size_so(so),2,so)) - thermalState(ph)%p(so)%dotState(:,me) = thermalState(ph)%p(so)%dotState(:,me) * zeta & - + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = thermalState(ph)%p(so)%state (1:size_so(so),me) & - - thermalState(ph)%p(so)%subState0(1:size_so(so),me) & - - thermalState(ph)%p(so)%dotState (1:size_so(so),me) * dt - thermalState(ph)%p(so)%state(1:size_so(so),me) = thermalState(ph)%p(so)%state(1:size_so(so),me) & - - r(1:size_so(so)) - converged_ = converged_ .and. converged(r(1:size_so(so)), & - thermalState(ph)%p(so)%state(1:size_so(so),me), & - thermalState(ph)%p(so)%atol(1:size_so(so))) - enddo - - if(converged_) exit iteration - - enddo iteration - - broken = broken .or. .not. converged_ - - - contains - - !-------------------------------------------------------------------------------------------------- - !> @brief calculate the damping for correction of state and dot state - !-------------------------------------------------------------------------------------------------- - real(pReal) pure function damper(current,previous,previous2) - - real(pReal), dimension(:), intent(in) ::& - current, previous, previous2 - - real(pReal) :: dot_prod12, dot_prod22 - - dot_prod12 = dot_product(current - previous, previous - previous2) - dot_prod22 = dot_product(previous - previous2, previous - previous2) - if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then - damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22) - else - damper = 1.0_pReal - endif - - end function damper - end function integrateThermalState - module subroutine thermal_initializeRestorationPoints(ph,me) integer, intent(in) :: ph, me From 88be08ae31f49fdd007843101c4491c04f96b69a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 00:44:16 +0100 Subject: [PATCH 195/214] modified structure for thermal tests, fixed damage branching --- PRIVATE | 2 +- src/constitutive_damage.f90 | 22 +++++++++++----------- src/constitutive_thermal.f90 | 2 +- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/PRIVATE b/PRIVATE index 591964dcf..7846c7112 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 591964dcf8521d95f6cccbfe840d462c430e63d9 +Subproject commit 7846c71126705cc5d41dd79f2d595f4864434068 diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index ea00b5c94..cc2b62002 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -347,17 +347,17 @@ module subroutine damage_results(group,ph) sourceType: select case (phase_source(so,ph)) case (DAMAGE_ISOBRITTLE_ID) sourceType - call source_damage_anisoBrittle_results(ph,group//'sources/') - - case (DAMAGE_ISODUCTILE_ID) sourceType - call source_damage_anisoDuctile_results(ph,group//'sources/') - - case (DAMAGE_ANISOBRITTLE_ID) sourceType call source_damage_isoBrittle_results(ph,group//'sources/') - case (DAMAGE_ANISODUCTILE_ID) sourceType + case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_results(ph,group//'sources/') + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call source_damage_anisoBrittle_results(ph,group//'sources/') + + case (DAMAGE_ANISODUCTILE_ID) sourceType + call source_damage_anisoDuctile_results(ph,group//'sources/') + end select sourceType enddo SourceLoop @@ -387,16 +387,16 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) sourceType: select case (phase_source(so,ph)) - case (DAMAGE_ISOBRITTLE_ID) sourceType - call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& - co, ip, el) ! correct stress? - case (DAMAGE_ISODUCTILE_ID) sourceType call source_damage_isoDuctile_dotState(co, ip, el) case (DAMAGE_ANISODUCTILE_ID) sourceType call source_damage_anisoDuctile_dotState(co, ip, el) + case (DAMAGE_ANISOBRITTLE_ID) sourceType + call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),& + co, ip, el) ! correct stress? + end select sourceType broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index e6aa7c4cf..5017904df 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -208,7 +208,7 @@ end function constitutive_thermal_collectDotState !-------------------------------------------------------------------------------------------------- !> @brief integrate state with 1st order explicit Euler method !-------------------------------------------------------------------------------------------------- -function integrateThermalState(Delta_t,co,ip,el) result(broken) +module function integrateThermalState(Delta_t,co,ip,el) result(broken) real(pReal), intent(in) :: Delta_t integer, intent(in) :: & From 65bd880fdf79394e2693a49e3c681c34574fc9ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 07:10:38 +0100 Subject: [PATCH 196/214] clearerer names --- src/constitutive.f90 | 24 +++++++++--------- src/constitutive_damage.f90 | 40 +++++++++++++++--------------- src/constitutive_mech.f90 | 6 ++--- src/damage_none.f90 | 8 +++--- src/damage_nonlocal.f90 | 10 ++++---- src/homogenization.f90 | 8 +++--- src/material.f90 | 4 +-- src/source_damage_anisoBrittle.f90 | 16 ++++++------ src/source_damage_anisoDuctile.f90 | 12 ++++----- src/source_damage_isoBrittle.f90 | 24 +++++++++--------- src/source_damage_isoDuctile.f90 | 12 ++++----- 11 files changed, 82 insertions(+), 82 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 9e9cfe423..0d8e35ba3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -83,7 +83,7 @@ module constitutive type(tPlasticState), allocatable, dimension(:), public :: & plasticState type(tSourceState), allocatable, dimension(:), public :: & - sourceState, thermalState + damageState, thermalState integer, public, protected :: & @@ -454,12 +454,12 @@ subroutine constitutive_init plasticState(ph)%partitionedState0 = plasticState(ph)%state0 plasticState(ph)%state = plasticState(ph)%partitionedState0 forall(so = 1:phase_Nsources(ph)) - sourceState(ph)%p(so)%partitionedState0 = sourceState(ph)%p(so)%state0 - sourceState(ph)%p(so)%state = sourceState(ph)%p(so)%partitionedState0 + damageState(ph)%p(so)%partitionedState0 = damageState(ph)%p(so)%state0 + damageState(ph)%p(so)%state = damageState(ph)%p(so)%partitionedState0 end forall constitutive_source_maxSizeDotState = max(constitutive_source_maxSizeDotState, & - maxval(sourceState(ph)%p%sizeDotState)) + maxval(damageState(ph)%p%sizeDotState)) enddo PhaseLoop2 constitutive_plasticity_maxSizeDotState = maxval(plasticState%sizeDotState) @@ -578,8 +578,8 @@ subroutine constitutive_restore(ip,el,includeL) do co = 1,homogenization_Nconstituents(material_homogenizationAt(el)) do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & - sourceState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) + damageState(material_phaseAt(co,el))%p(so)%state( :,material_phasememberAt(co,ip,el)) = & + damageState(material_phaseAt(co,el))%p(so)%partitionedState0(:,material_phasememberAt(co,ip,el)) enddo enddo @@ -601,9 +601,9 @@ subroutine constitutive_forward() call mech_forward() call thermal_forward() - do ph = 1, size(sourceState) + do ph = 1, size(damageState) do so = 1,phase_Nsources(ph) - sourceState(ph)%p(so)%state0 = sourceState(ph)%p(so)%state + damageState(ph)%p(so)%state0 = damageState(ph)%p(so)%state enddo; enddo end subroutine constitutive_forward @@ -704,7 +704,7 @@ subroutine crystallite_init() do ph = 1, phases%length do so = 1, phase_Nsources(ph) - allocate(sourceState(ph)%p(so)%subState0,source=sourceState(ph)%p(so)%state0) ! ToDo: hack + allocate(damageState(ph)%p(so)%subState0,source=damageState(ph)%p(so)%state0) ! ToDo: hack enddo do so = 1, thermal_Nsources(ph) allocate(thermalState(ph)%p(so)%subState0,source=thermalState(ph)%p(so)%state0) ! ToDo: hack @@ -753,8 +753,8 @@ subroutine constitutive_initializeRestorationPoints(ip,el) call mech_initializeRestorationPoints(ph,me) call thermal_initializeRestorationPoints(ph,me) - do so = 1, size(sourceState(ph)%p) - sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state0(:,me) + do so = 1, size(damageState(ph)%p) + damageState(ph)%p(so)%partitionedState0(:,me) = damageState(ph)%p(so)%state0(:,me) enddo enddo @@ -784,7 +784,7 @@ subroutine constitutive_windForward(ip,el) call thermal_windForward(ph,me) do so = 1, phase_Nsources(material_phaseAt(co,el)) - sourceState(ph)%p(so)%partitionedState0(:,me) = sourceState(ph)%p(so)%state(:,me) + damageState(ph)%p(so)%partitionedState0(:,me) = damageState(ph)%p(so)%state(:,me) enddo enddo diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index cc2b62002..85500e260 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -129,14 +129,14 @@ module subroutine damage_init phases => config_material%get('phase') - allocate(sourceState (phases%length)) + allocate(damageState (phases%length)) allocate(phase_Nsources(phases%length),source = 0) ! same for kinematics do ph = 1,phases%length phase => phases%get(ph) sources => phase%get('source',defaultVal=emptyList) phase_Nsources(ph) = sources%length - allocate(sourceState(ph)%p(phase_Nsources(ph))) + allocate(damageState(ph)%p(phase_Nsources(ph))) enddo allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID) @@ -262,9 +262,9 @@ module function integrateDamageState(dt,co,ip,el) result(broken) if(broken) return do so = 1, phase_Nsources(ph) - size_so(so) = sourceState(ph)%p(so)%sizeDotState - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - + sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt + size_so(so) = damageState(ph)%p(so)%sizeDotState + damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%subState0(1:size_so(so),me) & + + damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt source_dotState(1:size_so(so),2,so) = 0.0_pReal enddo @@ -272,26 +272,26 @@ module function integrateDamageState(dt,co,ip,el) result(broken) do so = 1, phase_Nsources(ph) if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so) - source_dotState(1:size_so(so),1,so) = sourceState(ph)%p(so)%dotState(:,me) + source_dotState(1:size_so(so),1,so) = damageState(ph)%p(so)%dotState(:,me) enddo broken = constitutive_damage_collectDotState(co,ip,el,ph,me) if(broken) exit iteration do so = 1, phase_Nsources(ph) - zeta = damper(sourceState(ph)%p(so)%dotState(:,me), & + zeta = damper(damageState(ph)%p(so)%dotState(:,me), & source_dotState(1:size_so(so),1,so),& source_dotState(1:size_so(so),2,so)) - sourceState(ph)%p(so)%dotState(:,me) = sourceState(ph)%p(so)%dotState(:,me) * zeta & + damageState(ph)%p(so)%dotState(:,me) = damageState(ph)%p(so)%dotState(:,me) * zeta & + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta) - r(1:size_so(so)) = sourceState(ph)%p(so)%state (1:size_so(so),me) & - - sourceState(ph)%p(so)%subState0(1:size_so(so),me) & - - sourceState(ph)%p(so)%dotState (1:size_so(so),me) * dt - sourceState(ph)%p(so)%state(1:size_so(so),me) = sourceState(ph)%p(so)%state(1:size_so(so),me) & + r(1:size_so(so)) = damageState(ph)%p(so)%state (1:size_so(so),me) & + - damageState(ph)%p(so)%subState0(1:size_so(so),me) & + - damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt + damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%state(1:size_so(so),me) & - r(1:size_so(so)) converged_ = converged_ .and. converged(r(1:size_so(so)), & - sourceState(ph)%p(so)%state(1:size_so(so),me), & - sourceState(ph)%p(so)%atol(1:size_so(so))) + damageState(ph)%p(so)%state(1:size_so(so),me), & + damageState(ph)%p(so)%atol(1:size_so(so))) enddo if(converged_) then @@ -399,7 +399,7 @@ function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken) end select sourceType - broken = broken .or. any(IEEE_is_NaN(sourceState(ph)%p(so)%dotState(:,of))) + broken = broken .or. any(IEEE_is_NaN(damageState(ph)%p(so)%dotState(:,of))) enddo SourceLoop @@ -438,12 +438,12 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) case (DAMAGE_ISOBRITTLE_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(co,ip,el), Fe, & co, ip, el) - broken = any(IEEE_is_NaN(sourceState(ph)%p(so)%deltaState(:,of))) + broken = any(IEEE_is_NaN(damageState(ph)%p(so)%deltaState(:,of))) if(.not. broken) then - myOffset = sourceState(ph)%p(so)%offsetDeltaState - mySize = sourceState(ph)%p(so)%sizeDeltaState - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & - sourceState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + sourceState(ph)%p(so)%deltaState(1:mySize,of) + myOffset = damageState(ph)%p(so)%offsetDeltaState + mySize = damageState(ph)%p(so)%sizeDeltaState + damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = & + damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + damageState(ph)%p(so)%deltaState(1:mySize,of) endif end select sourceType diff --git a/src/constitutive_mech.f90 b/src/constitutive_mech.f90 index 9539d0b93..8bc85354f 100644 --- a/src/constitutive_mech.f90 +++ b/src/constitutive_mech.f90 @@ -1600,7 +1600,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%partitionedState0(:,me) + damageState(ph)%p(so)%subState0(:,me) = damageState(ph)%p(so)%partitionedState0(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me) @@ -1631,7 +1631,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) subFi0 = constitutive_mech_Fi(ph)%data(1:3,1:3,me) subState0 = plasticState(ph)%state(:,me) do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%subState0(:,me) = sourceState(ph)%p(so)%state(:,me) + damageState(ph)%p(so)%subState0(:,me) = damageState(ph)%p(so)%state(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%subState0(:,me) = thermalState(ph)%p(so)%state(:,me) @@ -1650,7 +1650,7 @@ module function crystallite_stress(dt,co,ip,el) result(converged_) endif plasticState(ph)%state(:,me) = subState0 do so = 1, phase_Nsources(ph) - sourceState(ph)%p(so)%state(:,me) = sourceState(ph)%p(so)%subState0(:,me) + damageState(ph)%p(so)%state(:,me) = damageState(ph)%p(so)%subState0(:,me) enddo do so = 1, thermal_Nsources(ph) thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%subState0(:,me) diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 3f1144833..078d42af7 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -25,10 +25,10 @@ subroutine damage_none_init if (damage_type(h) /= DAMAGE_NONE_ID) cycle Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 0 - allocate(damageState(h)%state0 (0,Nmaterialpoints)) - allocate(damageState(h)%subState0(0,Nmaterialpoints)) - allocate(damageState(h)%state (0,Nmaterialpoints)) + damageState_h(h)%sizeState = 0 + allocate(damageState_h(h)%state0 (0,Nmaterialpoints)) + allocate(damageState_h(h)%subState0(0,Nmaterialpoints)) + allocate(damageState_h(h)%state (0,Nmaterialpoints)) allocate (damage(h)%p(Nmaterialpoints), source=1.0_pReal) diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 3db63cab2..4423c1e3a 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -76,12 +76,12 @@ subroutine damage_nonlocal_init #endif Nmaterialpoints = count(material_homogenizationAt == h) - damageState(h)%sizeState = 1 - allocate(damageState(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) - allocate(damageState(h)%state (1,Nmaterialpoints), source=1.0_pReal) + damageState_h(h)%sizeState = 1 + allocate(damageState_h(h)%state0 (1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(h)%subState0(1,Nmaterialpoints), source=1.0_pReal) + allocate(damageState_h(h)%state (1,Nmaterialpoints), source=1.0_pReal) - damage(h)%p => damageState(h)%state(1,:) + damage(h)%p => damageState_h(h)%state(1,:) end associate enddo diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 8738ba6f1..9112562b9 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -186,7 +186,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE subStep = 1.0_pReal/num%subStepSizeHomog ! ... larger then the requested calculation if (homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State0(:,me) - if (damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State0(:,me) + if (damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State0(:,me) cutBackLooping: do while (.not. terminallyIll .and. subStep > num%subStepMinHomog) @@ -200,7 +200,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_windForward(ip,el) if(homogState(ho)%sizeState > 0) homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me) - if(damageState(ho)%sizeState > 0) damageState(ho)%subState0(:,me) = damageState(ho)%State(:,me) + if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State(:,me) endif steppingNeeded elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. & ! single grain already tried internal subStepping in crystallite @@ -215,7 +215,7 @@ subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execE call constitutive_restore(ip,el,subStep < 1.0_pReal) if(homogState(ho)%sizeState > 0) homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me) - if(damageState(ho)%sizeState > 0) damageState(ho)%State(:,me) = damageState(ho)%subState0(:,me) + if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%State(:,me) = damageState_h(ho)%subState0(:,me) endif if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.] @@ -326,7 +326,7 @@ subroutine homogenization_forward do ho = 1, size(material_name_homogenization) homogState (ho)%state0 = homogState (ho)%state - damageState(ho)%state0 = damageState(ho)%state + damageState_h(ho)%state0 = damageState_h(ho)%state enddo end subroutine homogenization_forward diff --git a/src/material.f90 b/src/material.f90 index 581182d22..16116ca91 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -61,7 +61,7 @@ module material type(tState), allocatable, dimension(:), public :: & homogState, & - damageState + damageState_h type(Rotation), dimension(:,:,:), allocatable, public, protected :: & material_orientation0 !< initial orientation of each grain,IP,element @@ -101,7 +101,7 @@ subroutine material_init(restart) allocate(homogState (size(material_name_homogenization))) - allocate(damageState (size(material_name_homogenization))) + allocate(damageState_h (size(material_name_homogenization))) allocate(temperature (size(material_name_homogenization))) allocate(damage (size(material_name_homogenization))) diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 0f923ceba..7c00c6580 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -101,9 +101,9 @@ module function source_damage_anisoBrittle_init(source_length) result(mySources) if (any(prm%s_crit < 0.0_pReal)) extmsg = trim(extmsg)//' s_crit' Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol' end associate @@ -146,7 +146,7 @@ module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoBrittle_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal + damageState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal do i = 1, prm%sum_N_cl traction_d = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i)) traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i)) @@ -154,8 +154,8 @@ module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el) traction_crit = prm%g_crit(i)*damage(homog)%p(damageOffset)**2.0_pReal - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & - = sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) & + = damageState(phase)%p(sourceOffset)%dotState(1,constituent) & + prm%dot_o / prm%s_crit(i) & * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + & (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + & @@ -185,7 +185,7 @@ module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, d sourceOffset = source_damage_anisoBrittle_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -204,7 +204,7 @@ module subroutine source_damage_anisoBrittle_results(phase,group) integer :: o associate(prm => param(source_damage_anisoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) + stt => damageState(phase)%p(source_damage_anisoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 6f71fc145..7ec06cb62 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -87,9 +87,9 @@ module function source_damage_anisoDuctile_init(source_length) result(mySources) if (any(prm%gamma_crit < 0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit' Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol' end associate @@ -128,7 +128,7 @@ module subroutine source_damage_anisoDuctile_dotState(co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_anisoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) & = sum(plasticState(phase)%slipRate(:,constituent)/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit) end associate @@ -154,7 +154,7 @@ module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, d sourceOffset = source_damage_anisoDuctile_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -173,7 +173,7 @@ module subroutine source_damage_anisoDuctile_results(phase,group) integer :: o associate(prm => param(source_damage_anisoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) + stt => damageState(phase)%p(source_damage_anisoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index 8c768b08d..1721b0201 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -74,9 +74,9 @@ module function source_damage_isoBrittle_init(source_length) result(mySources) if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit' Nconstituents = count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,1) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,1) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol' end associate @@ -124,13 +124,13 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el) strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit - if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent) + if (strainenergy > damageState(phase)%p(sourceOffset)%subState0(1,constituent)) then + damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + strainenergy - damageState(phase)%p(sourceOffset)%state(1,constituent) else - sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = & - sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - & - sourceState(phase)%p(sourceOffset)%state(1,constituent) + damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = & + damageState(phase)%p(sourceOffset)%subState0(1,constituent) - & + damageState(phase)%p(sourceOffset)%state(1,constituent) endif end associate @@ -158,8 +158,8 @@ module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLo associate(prm => param(source_damage_isoBrittle_instance(phase))) localphiDot = 1.0_pReal & - - phi*sourceState(phase)%p(sourceOffset)%state(1,constituent) - dLocalphiDot_dPhi = - sourceState(phase)%p(sourceOffset)%state(1,constituent) + - phi*damageState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = - damageState(phase)%p(sourceOffset)%state(1,constituent) end associate end subroutine source_damage_isoBrittle_getRateAndItsTangent @@ -176,7 +176,7 @@ module subroutine source_damage_isoBrittle_results(phase,group) integer :: o associate(prm => param(source_damage_isoBrittle_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state) + stt => damageState(phase)%p(source_damage_isoBrittle_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index 86222bbf9..dd2910182 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -78,9 +78,9 @@ module function source_damage_isoDuctile_init(source_length) result(mySources) if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit' Nconstituents=count(material_phaseAt==p) * discretization_nIPs - call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0) - sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) - if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' + call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0) + damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal) + if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol' end associate @@ -119,7 +119,7 @@ module subroutine source_damage_isoDuctile_dotState(co, ip, el) damageOffset = material_homogenizationMemberAt(ip,el) associate(prm => param(source_damage_isoDuctile_instance(phase))) - sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = & + damageState(phase)%p(sourceOffset)%dotState(1,constituent) = & sum(plasticState(phase)%slipRate(:,constituent))/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit end associate @@ -145,7 +145,7 @@ module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLo sourceOffset = source_damage_isoDuctile_offset(phase) - dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent) + dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent) localphiDot = 1.0_pReal & + dLocalphiDot_dPhi*phi @@ -164,7 +164,7 @@ module subroutine source_damage_isoDuctile_results(phase,group) integer :: o associate(prm => param(source_damage_isoDuctile_instance(phase)), & - stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state) + stt => damageState(phase)%p(source_damage_isoDuctile_offset(phase))%state) outputsLoop: do o = 1,size(prm%output) select case(trim(prm%output(o))) case ('f_phi') From 6c62e186deccb414cec8681b298816e35e33df37 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 07:37:51 +0100 Subject: [PATCH 197/214] separte functionality --- src/constitutive.f90 | 31 +---------------------- src/constitutive_damage.f90 | 31 +++++++++++++++++++++++ src/constitutive_thermal_dissipation.f90 | 20 ++++++++------- src/constitutive_thermal_externalheat.f90 | 3 +-- 4 files changed, 44 insertions(+), 41 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 0d8e35ba3..111e68fdf 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -369,7 +369,7 @@ module constitutive module subroutine constitutive_plastic_dependentState(co,ip,el) integer, intent(in) :: & - co, & !< component-ID of integration point + co, & !< component-ID of integration point ip, & !< integration point el !< element end subroutine constitutive_plastic_dependentState @@ -390,7 +390,6 @@ module constitutive constitutive_forward, & constitutive_restore, & plastic_nonlocal_updateCompatibility, & - source_active, & kinematics_active, & converged, & crystallite_init, & @@ -466,35 +465,7 @@ subroutine constitutive_init end subroutine constitutive_init -!-------------------------------------------------------------------------------------------------- -!> @brief checks if a source mechanism is active or not -!-------------------------------------------------------------------------------------------------- -function source_active(source_label,src_length) result(active_source) - character(len=*), intent(in) :: source_label !< name of source mechanism - integer, intent(in) :: src_length !< max. number of sources in system - logical, dimension(:,:), allocatable :: active_source - - class(tNode), pointer :: & - phases, & - phase, & - sources, & - src - integer :: p,s - - phases => config_material%get('phase') - allocate(active_source(src_length,phases%length), source = .false. ) - do p = 1, phases%length - phase => phases%get(p) - sources => phase%get('source',defaultVal=emptyList) - do s = 1, sources%length - src => sources%get(s) - if(src%get_asString('type') == source_label) active_source(s,p) = .true. - enddo - enddo - - -end function source_active !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_damage.f90 b/src/constitutive_damage.f90 index 85500e260..8c9104946 100644 --- a/src/constitutive_damage.f90 +++ b/src/constitutive_damage.f90 @@ -453,4 +453,35 @@ function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken) end function constitutive_damage_deltaState +!-------------------------------------------------------------------------------------------------- +!> @brief checks if a source mechanism is active or not +!-------------------------------------------------------------------------------------------------- +function source_active(source_label,src_length) result(active_source) + + character(len=*), intent(in) :: source_label !< name of source mechanism + integer, intent(in) :: src_length !< max. number of sources in system + logical, dimension(:,:), allocatable :: active_source + + class(tNode), pointer :: & + phases, & + phase, & + sources, & + src + integer :: p,s + + phases => config_material%get('phase') + allocate(active_source(src_length,phases%length), source = .false. ) + do p = 1, phases%length + phase => phases%get(p) + sources => phase%get('source',defaultVal=emptyList) + do s = 1, sources%length + src => sources%get(s) + if(src%get_asString('type') == source_label) active_source(s,p) = .true. + enddo + enddo + + +end function source_active + + end submodule constitutive_damage diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 44227536c..f15d1cfe9 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -27,19 +27,20 @@ contains !-------------------------------------------------------------------------------------------------- module function source_thermal_dissipation_init(source_length) result(mySources) - integer, intent(in) :: source_length + integer, intent(in) :: source_length logical, dimension(:,:), allocatable :: mySources class(tNode), pointer :: & phases, & phase, & - sources, & - src + sources, thermal, & + src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- source_thermal_dissipation init -+>>>' + print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' + + mySources = thermal_active('dissipation',source_length) - mySources = source_active('thermal_dissipation',source_length) Ninstances = count(mySources) print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT) if(Ninstances == 0) return @@ -50,16 +51,17 @@ module function source_thermal_dissipation_init(source_length) result(mySources) allocate(source_thermal_dissipation_instance(phases%length), source=0) do p = 1, phases%length - phase => phases%get(p) - if(count(mySources(:,p)) == 0) cycle + phase => phases%get(p) if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p)) - sources => phase%get('source') + if(count(mySources(:,p)) == 0) cycle + thermal => phase%get('thermal') + sources => thermal%get('source') do sourceOffset = 1, sources%length if(mySources(sourceOffset,p)) then source_thermal_dissipation_offset(p) = sourceOffset associate(prm => param(source_thermal_dissipation_instance(p))) + src => sources%get(sourceOffset) - src => sources%get(sourceOffset) prm%kappa = src%get_asFloat('kappa') Nconstituents = count(material_phaseAt==p) * discretization_nIPs call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0) diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index de1617efa..2a3ec7362 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -41,7 +41,7 @@ module function source_thermal_externalheat_init(source_length) result(mySources src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- source_thermal_externalHeat init -+>>>' + print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' mySources = thermal_active('externalheat',source_length) @@ -74,7 +74,6 @@ module function source_thermal_externalheat_init(source_length) result(mySources Nconstituents = count(material_phaseAt==p) * discretization_nIPs call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0) end associate - endif enddo enddo From d494c2d81e66ceb770d7e902f262ba337c3fd6d9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 08:26:17 +0100 Subject: [PATCH 198/214] better to read --- src/constitutive.f90 | 3 +-- src/constitutive_thermal.f90 | 2 +- src/thermal_conduction.f90 | 5 +---- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 111e68fdf..250f7f99e 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -305,6 +305,7 @@ module constitutive orientation !< crystal orientation end subroutine plastic_nonlocal_updateCompatibility + module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,instance,of) real(pReal), dimension(3,3), intent(out) :: & Li !< inleastic velocity gradient @@ -466,8 +467,6 @@ end subroutine constitutive_init - - !-------------------------------------------------------------------------------------------------- !> @brief checks if a kinematic mechanism is active or not !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 5017904df..a716a0c55 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -136,7 +136,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, el !< element number real(pReal), intent(in) :: & T !< plastic velocity gradient - real(pReal), intent(inout) :: & + real(pReal), intent(out) :: & TDot, & dTDot_dT diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 0cd1678e0..02649b1ad 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -103,10 +103,7 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) integer :: & homog - Tdot = 0.0_pReal - dTdot_dT = 0.0_pReal - - homog = material_homogenizationAt(el) + homog = material_homogenizationAt(el) call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) From 350466dd5f18aad38d11bb1cf49dd71591524d6f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 8 Jan 2021 08:57:30 +0100 Subject: [PATCH 199/214] not needed --- src/DAMASK_marc.f90 | 3 ++- src/constitutive.f90 | 7 +++--- src/constitutive_thermal.f90 | 27 +++++++++-------------- src/constitutive_thermal_dissipation.f90 | 6 ++--- src/constitutive_thermal_externalheat.f90 | 6 ++--- src/grid/grid_thermal_spectral.f90 | 4 ++-- src/thermal_conduction.f90 | 10 ++++----- 7 files changed, 26 insertions(+), 37 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0ad68445c..7c002e63c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -364,7 +364,8 @@ subroutine flux(f,ts,n,time) real(pReal), dimension(2), intent(out) :: & f - call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) + f(2) = 0.0_pReal + call thermal_conduction_getSourceAndItsTangent(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) end subroutine flux diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 250f7f99e..0b58e524f 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -283,15 +283,14 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number real(pReal), intent(in) :: & T - real(pReal), intent(inout) :: & - TDot, & - dTDot_dT + real(pReal), intent(out) :: & + TDot end subroutine constitutive_thermal_getRateAndItsTangents diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index a716a0c55..721d6925c 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -36,7 +36,7 @@ submodule(constitutive) constitutive_thermal end function kinematics_thermal_expansion_init - module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) + module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar,Lp,phase) integer, intent(in) :: & phase !< phase ID of element real(pReal), intent(in), dimension(3,3) :: & @@ -44,17 +44,15 @@ submodule(constitutive) constitutive_thermal real(pReal), intent(in), dimension(3,3) :: & Lp !< plastic velocuty gradient for a given element real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot end subroutine source_thermal_dissipation_getRateAndItsTangent - module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) + module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase,of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot end subroutine source_thermal_externalheat_getRateAndItsTangent end interface @@ -129,7 +127,7 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) +module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) integer, intent(in) :: & ip, & !< integration point number @@ -137,12 +135,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, real(pReal), intent(in) :: & T !< plastic velocity gradient real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot real(pReal) :: & - my_Tdot, & - my_dTdot_dT + my_Tdot integer :: & ph, & homog, & @@ -154,25 +150,22 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, homog = material_homogenizationAt(el) instance = thermal_typeInstance(homog) + TDot = 0.0_pReal do co = 1, homogenization_Nconstituents(homog) ph = material_phaseAt(co,el) me = material_phasememberAt(co,ip,el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) case (THERMAL_DISSIPATION_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - mech_S(ph,me),mech_L_p(ph,me), ph) + call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) case (THERMAL_EXTERNALHEAT_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, & - ph, me) + call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, ph,me) case default my_Tdot = 0.0_pReal - my_dTdot_dT = 0.0_pReal end select Tdot = Tdot + my_Tdot - dTdot_dT = dTdot_dT + my_dTdot_dT enddo enddo diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index f15d1cfe9..88b170f27 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -78,7 +78,7 @@ end function source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- !> @brief Ninstancess dissipation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase) +module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, Lp, phase) integer, intent(in) :: & phase @@ -88,12 +88,10 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT Lp real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot associate(prm => param(source_thermal_dissipation_instance(phase))) TDot = prm%kappa*sum(abs(Tstar*Lp)) - dTDot_dT = 0.0_pReal end associate end subroutine source_thermal_dissipation_getRateAndItsTangent diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 2a3ec7362..853f1e7dd 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -104,14 +104,13 @@ end subroutine source_thermal_externalheat_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of) +module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & - TDot, & - dTDot_dT + TDot integer :: & sourceOffset, interval @@ -131,7 +130,6 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries... ! ...or extrapolate if outside of bounds enddo - dTDot_dT = 0.0 end associate end subroutine source_thermal_externalheat_getRateAndItsTangent diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index 259b45f33..aa3c38e4c 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -256,7 +256,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) PetscObject :: dummy PetscErrorCode :: ierr integer :: i, j, k, cell - real(pReal) :: Tdot, dTdot_dT + real(pReal) :: Tdot T_current = x_scal !-------------------------------------------------------------------------------------------------- @@ -278,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T_current(i,j,k), 1, cell) + call thermal_conduction_getSourceAndItsTangent(Tdot, T_current(i,j,k), 1, cell) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) & + thermal_conduction_getMassDensity (1,cell)* & thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 02649b1ad..4d6869d04 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -91,7 +91,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- !> @brief return heat generation rate !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) +subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number @@ -99,15 +99,15 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el) real(pReal), intent(in) :: & T real(pReal), intent(out) :: & - Tdot, dTdot_dT - integer :: & + Tdot + + integer :: & homog homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, ip, el) + call constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) - dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal) end subroutine thermal_conduction_getSourceAndItsTangent From 0d291235b0242b6f751e71c0d1aa3a4a73429c66 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Fri, 8 Jan 2021 18:14:36 +0100 Subject: [PATCH 200/214] updated PRIVATE --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 76f383c4e..9282365fd 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 76f383c4e57cb41b55de9aad4d9baf209a91633d +Subproject commit 9282365fd54ccff1e8e57f4ea38967d733a4adc0 From fc7f919c231bb0b6e0973efcdecc8836ab496259 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 8 Jan 2021 21:37:15 +0100 Subject: [PATCH 201/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-230-g0fc670d01 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 62c706093..f123674b3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-173-g584c7cc3a +v3.0.0-alpha2-230-g0fc670d01 From 209d59534aa865ab474d3544238e5d3966538ad0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 9 Jan 2021 17:19:48 +0100 Subject: [PATCH 202/214] copy and paste error --- src/constitutive_thermal_dissipation.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 88b170f27..9153915ca 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -37,7 +37,7 @@ module function source_thermal_dissipation_init(source_length) result(mySources) src integer :: Ninstances,sourceOffset,Nconstituents,p - print'(/,a)', ' <<<+- thermal_externalheat init -+>>>' + print'(/,a)', ' <<<+- thermal_dissipation init -+>>>' mySources = thermal_active('dissipation',source_length) From 2b91bad53ee63d9b8701244fa7c516d3084d0c80 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 10 Jan 2021 10:17:16 +0100 Subject: [PATCH 203/214] https://stackoverflow.com/questions/14950378 --- src/C_routines.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/C_routines.c b/src/C_routines.c index 4b07c0ee0..3d62a87c2 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -43,7 +43,7 @@ void gethostname_c(char hostname[], int *stat){ void getusername_c(char username[], int *stat){ - struct passwd *pw = getpwuid(geteuid()); + struct passwd *pw = getpwuid(getuid()); if(pw && strlen(pw->pw_name) <= STRLEN){ strncpy(username,pw->pw_name,STRLEN+1); *stat = 0; From b5bfb1dba9c88cb26c5d6040056d798d51556437 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 11 Jan 2021 16:13:59 +0100 Subject: [PATCH 204/214] tangent is not included anymore --- src/DAMASK_marc.f90 | 2 +- src/constitutive.f90 | 6 +++--- src/constitutive_thermal.f90 | 16 ++++++++-------- src/constitutive_thermal_dissipation.f90 | 4 ++-- src/constitutive_thermal_externalheat.f90 | 4 ++-- src/grid/grid_thermal_spectral.f90 | 2 +- src/thermal_conduction.f90 | 8 ++++---- 7 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 7c002e63c..0f9d37ddb 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -365,7 +365,7 @@ subroutine flux(f,ts,n,time) f f(2) = 0.0_pReal - call thermal_conduction_getSourceAndItsTangent(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) + call thermal_conduction_getSource(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1))) end subroutine flux diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 0b58e524f..c6415a883 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -283,7 +283,7 @@ module constitutive dPhiDot_dPhi end subroutine constitutive_damage_getRateAndItsTangents - module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) + module subroutine constitutive_thermal_getRate(TDot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number el !< element number @@ -291,7 +291,7 @@ module constitutive T real(pReal), intent(out) :: & TDot - end subroutine constitutive_thermal_getRateAndItsTangents + end subroutine constitutive_thermal_getRate @@ -384,7 +384,7 @@ module constitutive constitutive_init, & constitutive_homogenizedC, & constitutive_damage_getRateAndItsTangents, & - constitutive_thermal_getRateAndItsTangents, & + constitutive_thermal_getRate, & constitutive_results, & constitutive_allocateState, & constitutive_forward, & diff --git a/src/constitutive_thermal.f90 b/src/constitutive_thermal.f90 index 721d6925c..9787cb0e4 100644 --- a/src/constitutive_thermal.f90 +++ b/src/constitutive_thermal.f90 @@ -36,7 +36,7 @@ submodule(constitutive) constitutive_thermal end function kinematics_thermal_expansion_init - module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar,Lp,phase) + module subroutine thermal_dissipation_getRate(TDot, Tstar,Lp,phase) integer, intent(in) :: & phase !< phase ID of element real(pReal), intent(in), dimension(3,3) :: & @@ -45,15 +45,15 @@ submodule(constitutive) constitutive_thermal Lp !< plastic velocuty gradient for a given element real(pReal), intent(out) :: & TDot - end subroutine source_thermal_dissipation_getRateAndItsTangent + end subroutine thermal_dissipation_getRate - module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase,of) + module subroutine thermal_externalheat_getRate(TDot, phase,of) integer, intent(in) :: & phase, & of real(pReal), intent(out) :: & TDot - end subroutine source_thermal_externalheat_getRateAndItsTangent + end subroutine thermal_externalheat_getRate end interface @@ -127,7 +127,7 @@ end subroutine thermal_init !---------------------------------------------------------------------------------------------- !< @brief calculates thermal dissipation rate !---------------------------------------------------------------------------------------------- -module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) +module subroutine constitutive_thermal_getRate(TDot, T, ip, el) integer, intent(in) :: & ip, & !< integration point number @@ -157,10 +157,10 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) do so = 1, thermal_Nsources(ph) select case(thermal_source(so,ph)) case (THERMAL_DISSIPATION_ID) - call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) + call thermal_dissipation_getRate(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph) case (THERMAL_EXTERNALHEAT_ID) - call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, ph,me) + call thermal_externalheat_getRate(my_Tdot, ph,me) case default my_Tdot = 0.0_pReal @@ -169,7 +169,7 @@ module subroutine constitutive_thermal_getRateAndItsTangents(TDot, T, ip, el) enddo enddo -end subroutine constitutive_thermal_getRateAndItsTangents +end subroutine constitutive_thermal_getRate !-------------------------------------------------------------------------------------------------- diff --git a/src/constitutive_thermal_dissipation.f90 b/src/constitutive_thermal_dissipation.f90 index 9153915ca..ae2d5735e 100644 --- a/src/constitutive_thermal_dissipation.f90 +++ b/src/constitutive_thermal_dissipation.f90 @@ -78,7 +78,7 @@ end function source_thermal_dissipation_init !-------------------------------------------------------------------------------------------------- !> @brief Ninstancess dissipation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, Lp, phase) +module subroutine thermal_dissipation_getRate(TDot, Tstar, Lp, phase) integer, intent(in) :: & phase @@ -94,6 +94,6 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, Tstar, L TDot = prm%kappa*sum(abs(Tstar*Lp)) end associate -end subroutine source_thermal_dissipation_getRateAndItsTangent +end subroutine thermal_dissipation_getRate end submodule source_dissipation diff --git a/src/constitutive_thermal_externalheat.f90 b/src/constitutive_thermal_externalheat.f90 index 853f1e7dd..2e8c02f8c 100644 --- a/src/constitutive_thermal_externalheat.f90 +++ b/src/constitutive_thermal_externalheat.f90 @@ -104,7 +104,7 @@ end subroutine source_thermal_externalheat_dotState !-------------------------------------------------------------------------------------------------- !> @brief returns local heat generation rate !-------------------------------------------------------------------------------------------------- -module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, of) +module subroutine thermal_externalheat_getRate(TDot, phase, of) integer, intent(in) :: & phase, & @@ -132,6 +132,6 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, phase, enddo end associate -end subroutine source_thermal_externalheat_getRateAndItsTangent +end subroutine thermal_externalheat_getRate end submodule source_externalheat diff --git a/src/grid/grid_thermal_spectral.f90 b/src/grid/grid_thermal_spectral.f90 index aa3c38e4c..9d804ec56 100644 --- a/src/grid/grid_thermal_spectral.f90 +++ b/src/grid/grid_thermal_spectral.f90 @@ -278,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr) cell = 0 do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1) cell = cell + 1 - call thermal_conduction_getSourceAndItsTangent(Tdot, T_current(i,j,k), 1, cell) + call thermal_conduction_getSource(Tdot, T_current(i,j,k), 1, cell) scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) & + thermal_conduction_getMassDensity (1,cell)* & thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k) - & diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 4d6869d04..79fe0d6cd 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -25,7 +25,7 @@ module thermal_conduction public :: & thermal_conduction_init, & - thermal_conduction_getSourceAndItsTangent, & + thermal_conduction_getSource, & thermal_conduction_getConductivity, & thermal_conduction_getSpecificHeat, & thermal_conduction_getMassDensity, & @@ -91,7 +91,7 @@ end subroutine thermal_conduction_init !-------------------------------------------------------------------------------------------------- !> @brief return heat generation rate !-------------------------------------------------------------------------------------------------- -subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) +subroutine thermal_conduction_getSource(Tdot, T,ip,el) integer, intent(in) :: & ip, & !< integration point number @@ -105,11 +105,11 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, T,ip,el) homog homog = material_homogenizationAt(el) - call constitutive_thermal_getRateAndItsTangents(TDot, T,ip,el) + call constitutive_thermal_getRate(TDot, T,ip,el) Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal) -end subroutine thermal_conduction_getSourceAndItsTangent +end subroutine thermal_conduction_getSource !-------------------------------------------------------------------------------------------------- From dc55aa002a05c48ded960260e933d3cfe05f961d Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 12 Jan 2021 14:13:26 +0100 Subject: [PATCH 205/214] updated test repo --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 9282365fd..f6fd3227e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 9282365fd54ccff1e8e57f4ea38967d733a4adc0 +Subproject commit f6fd3227ec0f9c03fbf991bf7f8732b22ae96530 From 72c940a46d0f338bd54c554284388493be46f376 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Jan 2021 17:02:13 +0100 Subject: [PATCH 206/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-255-g1e50fcc77 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f123674b3..7e44dd77b 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-230-g0fc670d01 +v3.0.0-alpha2-255-g1e50fcc77 From 66af1f1818425d7c25375ccb1b28b981afb51d66 Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 12 Jan 2021 23:33:27 +0100 Subject: [PATCH 207/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-258-g715504ee5 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 7e44dd77b..364cb0e13 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-255-g1e50fcc77 +v3.0.0-alpha2-258-g715504ee5 From 2d6e6a2370230834521a2ecac4d892ce73dffeca Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Tue, 12 Jan 2021 18:56:40 -0500 Subject: [PATCH 208/214] Rotation composition uses "*"; application of Rotation to object uses "@"; "apply()" works on both --- python/damask/_orientation.py | 23 +++++----- python/damask/_rotation.py | 83 +++++++++++++++++++++-------------- python/tests/test_Rotation.py | 4 +- 3 files changed, 65 insertions(+), 45 deletions(-) diff --git a/python/damask/_orientation.py b/python/damask/_orientation.py index d5be5a751..cf31f4089 100644 --- a/python/damask/_orientation.py +++ b/python/damask/_orientation.py @@ -242,24 +242,25 @@ class Orientation(Rotation): return np.logical_not(self==other) - def __matmul__(self,other): + def __mul__(self,other): """ - Rotation of vector, second or fourth order tensor, or rotation object. + Compose this orientation with other. Parameters ---------- - other : numpy.ndarray, Rotation, or Orientation - Vector, second or fourth order tensor, or rotation object that is rotated. + other : Rotation or Orientation + Object for composition. Returns ------- - other_rot : numpy.ndarray or Rotation - Rotated vector, second or fourth order tensor, or rotation object. + composition : Orientation + Compound rotation self*other, i.e. first other then self rotation. """ - return self.copy(rotation=Rotation.__matmul__(self,Rotation(other.quaternion))) \ - if isinstance(other,self.__class__) else \ - Rotation.__matmul__(self,other) + if isinstance(other,Orientation) or isinstance(other,Rotation): + return self.copy(rotation=Rotation.__mul__(self,Rotation(other.quaternion))) + else: + raise TypeError('Use "O@b", i.e. matmul, to apply Orientation "O" to object "b"') @classmethod @@ -440,7 +441,7 @@ class Orientation(Rotation): raise ValueError('Missing crystal symmetry') o = self.symmetry_operations.broadcast_to(self.symmetry_operations.shape+self.shape,mode='right') - return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left')) + return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left')) @property @@ -619,7 +620,7 @@ class Orientation(Rotation): o,lattice = self.relation_operations(model,return_lattice=True) target = Orientation(lattice=lattice) o = o.broadcast_to(o.shape+self.shape,mode='right') - return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'), + return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'), lattice=lattice, b = self.b if target.ratio['b'] is None else self.a*target.ratio['b'], c = self.c if target.ratio['c'] is None else self.a*target.ratio['c'], diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index ace2a3dba..b5b393971 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -35,6 +35,11 @@ class Rotation: - b = Q @ a - b = np.dot(Q.as_matrix(),a) + Compound rotations R1 (first) and R2 (second): + + - R = R2 * R1 + - R = Rotation.from_matrix(np.dot(R2.as_matrix(),R1.as_matrix()) + References ---------- D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015 @@ -96,8 +101,8 @@ class Rotation: """ Equal to other. - Equality is determined taking limited floating point precision into - account. See numpy.allclose for details. + Equality is determined taking limited floating point precision into account. + See numpy.allclose for details. Parameters ---------- @@ -182,14 +187,25 @@ class Rotation: Parameters ---------- - other : damask.Rotation of shape(self.shape) - Rotation for comosition. + other : Rotation of shape(self.shape) + Rotation for composition. + + Returns + ------- + composition : Rotation + Compound rotation self*other, i.e. first other then self rotation. """ if isinstance(other,Rotation): - return self@other + q_m = self.quaternion[...,0:1] + p_m = self.quaternion[...,1:] + q_o = other.quaternion[...,0:1] + p_o = other.quaternion[...,1:] + q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,))) + p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o) + return Rotation(np.block([q,p]))._standardize() else: - raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') def __imul__(self,other): """ @@ -197,8 +213,8 @@ class Rotation: Parameters ---------- - other : damask.Rotation of shape(self.shape) - Rotation for comosition. + other : Rotation of shape(self.shape) + Rotation for composition. """ return self*other @@ -213,11 +229,16 @@ class Rotation: other : damask.Rotation of shape (self.shape) Rotation to inverse composition. + Returns + ------- + composition : Rotation + Compound rotation self*(~other), i.e. first inverse of other then self rotation. + """ if isinstance(other,Rotation): - return self@~other + return self*~other else: - raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') + raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"') def __itruediv__(self,other): """ @@ -225,7 +246,7 @@ class Rotation: Parameters ---------- - other : damask.Rotation of shape (self.shape) + other : Rotation of shape (self.shape) Rotation to inverse composition. """ @@ -234,41 +255,39 @@ class Rotation: def apply(self,other): """ - Apply rotation to vector, second or fourth order tensor, or rotation object. + Apply rotation to Rotation, vector, second order tensor, or fourth order tensor. Parameters ---------- - other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) or Rotation - Vector, tensor, or rotation object on which to apply the rotation. + other : Rotation or numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Rotation, vector, or tensor on which to apply the rotation. + + Returns + ------- + rotated : Rotation or numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Composed rotation or rotated vector/tensor, i.e. transformed to frame defined by rotation. """ - return self@other + return self*other if isinstance(other,Rotation) else self@other def __matmul__(self,other): """ - Rotation of vector, second or fourth order tensor, or rotation object. + Rotation of vector, second order tensor, or fourth order tensor. Parameters ---------- - other : numpy.ndarray or Rotation - Vector, second or fourth order tensor, or rotation object that is rotated. + other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Vector or tensor on which to apply the rotation. Returns ------- - other_rot : numpy.ndarray or Rotation - Rotated vector, second or fourth order tensor, or rotation object. + rotated : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) + Rotated vector or tensor, i.e. transformed to frame defined by rotation. """ if isinstance(other,Rotation): - q_m = self.quaternion[...,0:1] - p_m = self.quaternion[...,1:] - q_o = other.quaternion[...,0:1] - p_o = other.quaternion[...,1:] - q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,))) - p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o) - return Rotation(np.block([q,p]))._standardize() - + raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"') elif isinstance(other,np.ndarray): if self.shape + (3,) == other.shape: q_m = self.quaternion[...,0] @@ -392,7 +411,7 @@ class Rotation: Rotation to which the misorientation is computed. """ - return other@~self + return other*~self ################################################################################################ @@ -915,7 +934,7 @@ class Rotation: np.sqrt(1-u**2)*np.sin(Theta), u, omega]) - return Rotation.from_axis_angle(p) @ center + return Rotation.from_axis_angle(p) * center @staticmethod @@ -966,8 +985,8 @@ class Rotation: f[::2,:3] *= -1 # flip half the rotation axes to negative sense return R_align.broadcast_to(N) \ - @ Rotation.from_axis_angle(p,normalize=True) \ - @ Rotation.from_axis_angle(f) + * Rotation.from_axis_angle(p,normalize=True) \ + * Rotation.from_axis_angle(f) #################################################################################################### diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index 707bc0210..ff4894632 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -956,7 +956,7 @@ class TestRotation: def test_rotate_inverse(self): R = Rotation.from_random() - assert np.allclose(np.eye(3),(~R@R).as_matrix()) + assert np.allclose(np.eye(3),(~R*R).as_matrix()) @pytest.mark.parametrize('data',[np.random.rand(3), np.random.rand(3,3), @@ -1024,7 +1024,7 @@ class TestRotation: @pytest.mark.parametrize('item',[Rotation(),np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) def test_apply(self,item): r = Rotation.from_random() - assert r.apply(item) == r@item if isinstance(item,Rotation) else (r.apply(item) == r@item).all() + assert r.apply(item) == r*item if isinstance(item,Rotation) else (r.apply(item) == r@item).all() @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120]) def test_average(self,angle): From f4247e0f3559370b56d894394b3c3cc84200ba62 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Jan 2021 09:35:42 +0100 Subject: [PATCH 209/214] simpler (and scipy compatible) --- python/damask/_rotation.py | 26 +++++--------------------- python/tests/test_Rotation.py | 4 ++-- 2 files changed, 7 insertions(+), 23 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index b5b393971..0c6824c35 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -253,24 +253,6 @@ class Rotation: return self/other - def apply(self,other): - """ - Apply rotation to Rotation, vector, second order tensor, or fourth order tensor. - - Parameters - ---------- - other : Rotation or numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) - Rotation, vector, or tensor on which to apply the rotation. - - Returns - ------- - rotated : Rotation or numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3) - Composed rotation or rotated vector/tensor, i.e. transformed to frame defined by rotation. - - """ - return self*other if isinstance(other,Rotation) else self@other - - def __matmul__(self,other): """ Rotation of vector, second order tensor, or fourth order tensor. @@ -286,9 +268,7 @@ class Rotation: Rotated vector or tensor, i.e. transformed to frame defined by rotation. """ - if isinstance(other,Rotation): - raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"') - elif isinstance(other,np.ndarray): + if isinstance(other,np.ndarray): if self.shape + (3,) == other.shape: q_m = self.quaternion[...,0] p_m = self.quaternion[...,1:] @@ -308,9 +288,13 @@ class Rotation: return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other) else: raise ValueError('Can only rotate vectors, 2nd order tensors, and 4th order tensors') + elif isinstance(other,Rotation): + raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"') else: raise TypeError(f'Cannot rotate {type(other)}') + apply = __matmul__ + def _standardize(self): """Standardize quaternion (ensure positive real hemisphere).""" diff --git a/python/tests/test_Rotation.py b/python/tests/test_Rotation.py index ff4894632..6bee44e7f 100644 --- a/python/tests/test_Rotation.py +++ b/python/tests/test_Rotation.py @@ -1021,10 +1021,10 @@ class TestRotation: R = Rotation.from_random() assert R/R == R*R**(-1) == Rotation() - @pytest.mark.parametrize('item',[Rotation(),np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) + @pytest.mark.parametrize('item',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))]) def test_apply(self,item): r = Rotation.from_random() - assert r.apply(item) == r*item if isinstance(item,Rotation) else (r.apply(item) == r@item).all() + assert (r.apply(item) == r@item).all() @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120]) def test_average(self,angle): From 196902948f6612e48d14c6ecb567a550ca8ab9d4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Jan 2021 09:50:58 +0100 Subject: [PATCH 210/214] simplified --- python/damask/_rotation.py | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/python/damask/_rotation.py b/python/damask/_rotation.py index 0c6824c35..441fb5b01 100644 --- a/python/damask/_rotation.py +++ b/python/damask/_rotation.py @@ -70,17 +70,9 @@ class Rotation: def __repr__(self): - """Represent rotation as unit quaternion, rotation matrix, and Bunge-Euler angles.""" - if self.shape == () and self == Rotation(): - return 'Rotation()' - else: - return f'Quaternions {self.shape}:\n'+str(self.quaternion) \ - if self.quaternion.shape != (4,) else \ - '\n'.join([ - 'Quaternion: (real={:.3f}, imag=<{:+.3f}, {:+.3f}, {:+.3f}>)'.format(*(self.quaternion)), - 'Matrix:\n{}'.format(np.round(self.as_matrix(),8)), - 'Bunge Eulers / deg: ({:3.2f}, {:3.2f}, {:3.2f})'.format(*self.as_Euler_angles(degrees=True)), - ]) + """Represent rotation as unit quaternion(s).""" + return f'Quaternion{" " if self.quaternion.shape == (4,) else "s of shape "+str(self.quaternion.shape)+chr(10)}'\ + + str(self.quaternion) def __copy__(self,**kwargs): @@ -150,35 +142,31 @@ class Rotation: return dup - def __pow__(self,pwr): + def __pow__(self,exp): """ - Raise quaternion to power. - - Equivalent to performing the rotation 'pwr' times. + Perform the rotation 'exp' times. Parameters ---------- - pwr : float - Power to raise quaternion to. + exp : float + Exponent. """ phi = np.arccos(self.quaternion[...,0:1]) p = self.quaternion[...,1:]/np.linalg.norm(self.quaternion[...,1:],axis=-1,keepdims=True) - return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize()) + return self.copy(rotation=Rotation(np.block([np.cos(exp*phi),np.sin(exp*phi)*p]))._standardize()) - def __ipow__(self,pwr): + def __ipow__(self,exp): """ - Raise quaternion to power (in-place). - - Equivalent to performing the rotation 'pwr' times. + Perform the rotation 'exp' times (in-place). Parameters ---------- - pwr : float - Power to raise quaternion to. + exp : float + Exponent. """ - return self**pwr + return self**exp def __mul__(self,other): From 4c35da8627cb14255be645d26e9161bf2816bbcd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Jan 2021 11:33:28 +0100 Subject: [PATCH 211/214] simplified --- python/damask/_grid.py | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/python/damask/_grid.py b/python/damask/_grid.py index 76ce7ba64..0edec05f9 100644 --- a/python/damask/_grid.py +++ b/python/damask/_grid.py @@ -763,24 +763,19 @@ class Grid: if fill is None: fill = np.nanmax(self.material) + 1 dtype = float if np.isnan(fill) or int(fill) != fill or self.material.dtype==np.float else int - Eulers = R.as_Euler_angles(degrees=True) - material_in = self.material.copy() - + material = self.material # These rotations are always applied in the reference coordinate system, i.e. (z,x,z) not (z,x',z'') # see https://www.cs.utexas.edu/~theshark/courses/cs354/lectures/cs354-14.pdf - for angle,axes in zip(Eulers[::-1], [(0,1),(1,2),(0,1)]): - material_out = ndimage.rotate(material_in,angle,axes,order=0, - prefilter=False,output=dtype,cval=fill) - if np.prod(material_in.shape) == np.prod(material_out.shape): - # avoid scipy interpolation errors for rotations close to multiples of 90° - material_in = np.rot90(material_in,k=np.rint(angle/90.).astype(int),axes=axes) - else: - material_in = material_out + for angle,axes in zip(R.as_Euler_angles(degrees=True)[::-1], [(0,1),(1,2),(0,1)]): + material_temp = ndimage.rotate(material,angle,axes,order=0,prefilter=False,output=dtype,cval=fill) + # avoid scipy interpolation errors for rotations close to multiples of 90° + material = material_temp if np.prod(material_temp.shape) != np.prod(material.shape) else \ + np.rot90(material,k=np.rint(angle/90.).astype(int),axes=axes) - origin = self.origin-(np.asarray(material_in.shape)-self.cells)*.5 * self.size/self.cells + origin = self.origin-(np.asarray(material.shape)-self.cells)*.5 * self.size/self.cells - return Grid(material = material_in, - size = self.size/self.cells*np.asarray(material_in.shape), + return Grid(material = material, + size = self.size/self.cells*np.asarray(material.shape), origin = origin, comments = self.comments+[util.execution_stamp('Grid','rotate')], ) From 4b0b28805435861ba6b4917fb90104cae22c667d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 13 Jan 2021 12:25:06 +0100 Subject: [PATCH 212/214] 2021! 10 years of DAMASK --- LICENSE | 2 +- PRIVATE | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/LICENSE b/LICENSE index 3ffc3b9e3..4290d15bd 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-20 Max-Planck-Institut für Eisenforschung GmbH +Copyright 2011-21 Max-Planck-Institut für Eisenforschung GmbH DAMASK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by diff --git a/PRIVATE b/PRIVATE index 7846c7112..1d0c95c5c 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 7846c71126705cc5d41dd79f2d595f4864434068 +Subproject commit 1d0c95c5c1c0e7e6f57bdfc94b695e47a6ad6c60 From c01fbe79bec51716ed92dfb3749a88fa0398c01f Mon Sep 17 00:00:00 2001 From: Test User Date: Wed, 13 Jan 2021 19:31:03 +0100 Subject: [PATCH 213/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-279-g8182c9c54 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 364cb0e13..6e2dff56f 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-258-g715504ee5 +v3.0.0-alpha2-279-g8182c9c54 From c32b90417241e927a5522b4a5dfe4d9c8d1b9016 Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 14 Jan 2021 22:38:59 +0100 Subject: [PATCH 214/214] [skip ci] updated version information after successful test of v3.0.0-alpha2-292-g589178668 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e2dff56f..5a4014717 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v3.0.0-alpha2-279-g8182c9c54 +v3.0.0-alpha2-292-g589178668