diff --git a/src/crystallite.f90 b/src/crystallite.f90 index af69b1727..0d3eef17e 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -69,7 +69,7 @@ module crystallite crystallite_subS0, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_invFp, & !< inverse of current plastic def grad (end of converged time step) crystallite_subFp0,& !< plastic def grad at start of crystallite inc - crystallite_invFi, & !< inverse of current intermediate def grad (end of converged time step) + crystallite_invFi, & !< inverse of current intermediate def grad crystallite_subFi0,& !< intermediate def grad at start of crystallite inc crystallite_subF, & !< def grad to be reached at end of crystallite inc crystallite_subF0, & !< def grad at start of crystallite inc @@ -78,12 +78,11 @@ module crystallite real(pReal), dimension(:,:,:,:,:,:,:), allocatable, public :: & crystallite_dPdF !< current individual dPdF per grain (end of converged time step) logical, dimension(:,:,:), allocatable, public :: & - crystallite_requested !< flag to request crystallite calculation - logical, dimension(:,:,:), allocatable, public, protected :: & - crystallite_converged !< convergence flag + crystallite_requested !< used by upper level (homogenization) to request crystallite calculation logical, dimension(:,:,:), allocatable, private :: & - crystallite_localPlasticity, & !< indicates this grain to have purely local constitutive law - crystallite_todo !< flag to indicate need for further computation + crystallite_converged, & !< convergence flag + crystallite_todo, & !< flag to indicate need for further computation + crystallite_localPlasticity !< indicates this grain to have purely local constitutive law enum, bind(c) enumerator :: undefined_ID, & @@ -999,13 +998,11 @@ function crystallite_postResults(ipc, ip, el) mySize, & n - crystID = microstructure_crystallite(mesh_element(4,el)) crystallite_postResults = 0.0_pReal - c = 0_pInt - crystallite_postResults(c+1) = real(crystallite_sizePostResults(crystID),pReal) ! size of results from cryst - c = c + 1_pInt + crystallite_postResults(1) = real(crystallite_sizePostResults(crystID),pReal) ! header-like information (length) + c = 1_pInt do o = 1_pInt,crystallite_Noutput(crystID) mySize = 0_pInt @@ -1612,12 +1609,6 @@ subroutine integrateStateFPI() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo at start of state integration' -#endif - - ! --+>> PREGUESS FOR STATE <<+-- call update_dotState(1.0_pReal) call update_state(1.0_pReal) @@ -1807,11 +1798,6 @@ subroutine integrateStateFPI() !$OMP ENDDO !$OMP END PARALLEL -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & - ' grains converged after state integration #', NiterationState -#endif ! --- NON-LOCAL CONVERGENCE CHECK --- @@ -1820,20 +1806,11 @@ subroutine integrateStateFPI() crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged endif -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) then - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & - ' grains converged after non-local check' - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_todo(:,:,:)), & - ' grains todo after state integration #', NiterationState - endif -#endif ! --- CHECK IF DONE WITH INTEGRATION --- - doneWithIntegration = .true. elemLoop: do e = eIter(1),eIter(2) - do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains + do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then doneWithIntegration = .false. exit elemLoop @@ -1843,6 +1820,29 @@ subroutine integrateStateFPI() enddo crystalliteLooping + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief calculate the damping for correction of state and dot state +!-------------------------------------------------------------------------------------------------- + real(pReal) pure function damper(current,previous,previous2) + + implicit none + 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(current - previous2, previous - previous2) + if (dot_prod22 > 0.0_pReal .and. (dot_prod12 < 0.0_pReal .or. dot_product(current,previous) < 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 @@ -2119,17 +2119,6 @@ end subroutine integrateStateAdaptiveEuler subroutine integrateStateRK4() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use mesh, only: & mesh_element, & mesh_NcpElems @@ -2331,10 +2320,6 @@ subroutine integrateStateRKCK45() singleRun ! flag indicating computation for single (g,i,e) triple eIter = FEsolving_execElem(1:2) -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,1x,i1)') '<< CRYST >> Runge--Kutta step',1 -#endif ! --- LOOP ITERATOR FOR ELEMENT, GRAIN, IP --- do e = eIter(1),eIter(2) @@ -2483,22 +2468,6 @@ subroutine integrateStateRKCK45() abs(sourceStateResiduum(1:mySizeSourceDotState,mySource,g,i,e)) < & sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo - -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt& - .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& - .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i8,1x,i3,1x,i3,/)') '<< CRYST >> updateState at el ip ipc ',e,i,g - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> absolute residuum tolerance', & - plasticStateResiduum(1:mySizePlasticDotState,g,i,e) / plasticState(p)%aTolState(1:mySizePlasticDotState) - write(6,'(a,/,(12x,12(f12.1,1x)),/)') '<< CRYST >> relative residuum tolerance', & - relPlasticStateResiduum(1:mySizePlasticDotState,g,i,e) / rTol_crystalliteState - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> dotState', & - plasticState(p)%dotState(1:mySizePlasticDotState,cc) - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & - plasticState(p)%state(1:mySizePlasticDotState,cc) - endif -#endif endif enddo; enddo; enddo !$OMP ENDDO @@ -2511,10 +2480,6 @@ subroutine integrateStateRKCK45() ! --- nonlocal convergence check --- -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a,i2,/)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), ' grains converged' ! if not requesting Integration of just a single IP -#endif if ((.not. singleRun) .and. any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) & ! any non-local not yet converged (or broken)... crystallite_converged = crystallite_converged .and. crystallite_localPlasticity ! ...restart all non-local as not converged