From ca99734cd45c835e4559a33880699c3f6dc620ba Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:30:53 -0400 Subject: [PATCH 01/54] added DEBUG declaration for BUILDTYPE=DEBUG --- CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/CMakeLists.txt b/CMakeLists.txt index 9770996b1..f5d6546a9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -124,6 +124,7 @@ endif () # Predefined sets for OPTIMIZATION/OPENMP based on BUILD_TYPE if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG" OR "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" ) + set (DEBUG_FLAGS "${DEBUG_FLAGS} -DDEBUG") set (PARALLEL "OFF") set (OPTI "OFF") elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "RELEASE") From f3292507b5000d71139f40618c3e2d11b9c56145 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:32:07 -0400 Subject: [PATCH 02/54] added more debugging messages and switched to DEBUG as flag --- src/crystallite.f90 | 66 ++++++++++++++++++++++++++++----------------- 1 file changed, 42 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index c5bd4d979..bb36bafe5 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -790,7 +790,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (.not. crystallite_localPlasticity(1,neighboring_i,neighboring_e) & .and. .not. crystallite_converged(1,neighboring_i,neighboring_e)) then crystallite_neighborEnforcedCutback(i,e) = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a12,i5,1x,i2,a,i5,1x,i2)') '<< CRYST >> ', neighboring_e,neighboring_i, & ' enforced cutback at ',e,i @@ -825,7 +825,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (.not. crystallite_localPlasticity(1,neighboring_i,neighboring_e) & .and. .not. crystallite_converged(1,neighboring_i,neighboring_e)) then crystallite_syncSubFrac(i,e) = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a12,i5,1x,i2,a,i5,1x,i2)') '<< CRYST >> ',neighboring_e,neighboring_i, & ' enforced time synchronization at ',e,i @@ -933,7 +933,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_todo(c,i,e) = .true. endif !$OMP FLUSH(crystallite_todo) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & @@ -983,7 +983,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! cant restore dotState here, since not yet calculated in first cutback after initialization crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) !$OMP FLUSH(crystallite_todo) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt) then if (crystallite_todo(c,i,e)) then write(6,'(a,f12.8,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent & @@ -1050,6 +1050,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! --- integrate --- requires fully defined state array (basic + dependent state) if (any(crystallite_todo)) then + if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then + write(6,'(/,a,i3)') '<< CRYST >> doing integrate state ',numerics_integrator(numerics_integrationMode) + flush(6) + endif select case(numerics_integrator(numerics_integrationMode)) case(1_pInt) call crystallite_integrateStateFPI() @@ -1389,7 +1393,7 @@ subroutine crystallite_integrateStateRK4() * crystallite_subdt(g,i,e) * timeStepFraction(n) enddo -#ifndef _OPENMP +#ifdef DEBUG if (n == 4 & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & @@ -1780,7 +1784,7 @@ subroutine crystallite_integrateStateRKCK45() ! --- dot state and RK dot state--- -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,1x,i1)') '<< CRYST >> Runge--Kutta step',stage+1_pInt #endif @@ -1929,7 +1933,7 @@ subroutine crystallite_integrateStateRKCK45() sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo -#ifndef _OPENMP +#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 @@ -2313,7 +2317,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP FLUSH(relPlasticStateResiduum) !$OMP FLUSH(relSourceStateResiduum) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& @@ -2509,7 +2513,7 @@ eIter = FEsolving_execElem(1:2) * crystallite_subdt(g,i,e) enddo -#ifndef _OPENMP +#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 @@ -2690,6 +2694,9 @@ subroutine crystallite_integrateStateFPI() singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) + 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' + !-------------------------------------------------------------------------------------------------- ! initialize dotState if (.not. singleRun) then @@ -2742,6 +2749,8 @@ subroutine crystallite_integrateStateFPI() NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%dotState(:,c))) enddo if (NaN) then ! NaN occured in any dotState + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & + write(6,*) '<< CRYST >> ',plasticState(p)%dotState(:,c) if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a non-local... !$OMP CRITICAL (checkTodo) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) @@ -2755,6 +2764,9 @@ subroutine crystallite_integrateStateFPI() !$OMP ENDDO ! --- UPDATE STATE --- + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & + write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo after preguess of state' + !$OMP DO PRIVATE(mySizePlasticDotState,mySizeSourceDotState,p,c) 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 @@ -2810,10 +2822,16 @@ subroutine crystallite_integrateStateFPI() ! --- STRESS INTEGRATION --- + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & + write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo before stress integration' + !$OMP DO 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 !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + + + crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! broken non-local... @@ -2958,13 +2976,14 @@ subroutine crystallite_integrateStateFPI() * (1.0_pReal - sourceStateDamper) enddo -#ifndef _OPENMP +#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,i2,1x,i3,/)') '<< CRYST >> update state at el ip g ',e,i,g write(6,'(a,f6.1,/)') '<< CRYST >> plasticstatedamper ',plasticStatedamper write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> plastic state residuum',plasticStateResiduum(1:mySizePlasticDotState) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> abstol dotstate',plasticState(p)%aTolState(1:mySizePlasticDotState) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state',tempPlasticState(1:mySizePlasticDotState) endif #endif @@ -3116,7 +3135,7 @@ logical function crystallite_stateJump(ipc,ip,el) sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c) enddo -#ifndef _OPENMP +#ifdef DEBUG if (any(dNeq0(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c))) & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -3289,14 +3308,13 @@ logical function crystallite_integrateStress(& !* be pessimistic crystallite_integrateStress = .false. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress at el ip ipc ',el,ip,ipc #endif - !* only integrate over fraction of timestep? if (present(timeFraction)) then @@ -3322,7 +3340,7 @@ logical function crystallite_integrateStress(& invFp_current = math_inv33(Fp_current) failedInversionFp: if (all(dEq0(invFp_current))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip g ',& el,'(',mesh_element(1,el),')',ip,ipc @@ -3338,7 +3356,7 @@ logical function crystallite_integrateStress(& invFi_current = math_inv33(Fi_current) failedInversionFi: if (all(dEq0(invFi_current))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',& el,'(',mesh_element(1,el),')',ip,ipc @@ -3359,7 +3377,7 @@ logical function crystallite_integrateStress(& LiLoop: do NiterationStressLi = NiterationStressLi + 1_pInt IloopsExeced: if (NiterationStressLi > nStress) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached inelastic loop limit',nStress, & ' at el (elFE) ip ipc ', el,mesh_element(1,el),ip,ipc @@ -3380,7 +3398,7 @@ logical function crystallite_integrateStress(& LpLoop: do ! inner stress integration loop for consistency with Fi NiterationStressLp = NiterationStressLp + 1_pInt loopsExeced: if (NiterationStressLp > nStress) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached loop limit',nStress, & ' at el (elFE) ip ipc ', el,mesh_element(1,el),ip,ipc @@ -3413,7 +3431,7 @@ logical function crystallite_integrateStress(& !$OMP END CRITICAL (debugTimingLpTangent) endif -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3431,7 +3449,7 @@ logical function crystallite_integrateStress(& residuumLp = Lpguess - Lp_constitutive if (any(IEEE_is_NaN(residuumLp))) then ! NaN in residuum... -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el (elFE) ip ipc ', & el,mesh_element(1,el),ip,ipc, & @@ -3466,7 +3484,7 @@ logical function crystallite_integrateStress(& work = math_plain33to9(residuumLp) call dgesv(9,1,dRLp_dLp2,9,ipiv,work,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp if (ierr /= 0_pInt) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip ipc ', & el,mesh_element(1,el),ip,ipc @@ -3507,7 +3525,7 @@ logical function crystallite_integrateStress(& call constitutive_LiAndItsTangent(Li_constitutive, dLi_dT3333, dLi_dFi3333, & Tstar_v, Fi_new, ipc, ip, el) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3555,7 +3573,7 @@ logical function crystallite_integrateStress(& work = math_plain33to9(residuumLi) call dgesv(9,1,dRLi_dLi,9,ipiv,work,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li if (ierr /= 0_pInt) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLi inversion at el ip ipc ', & el,mesh_element(1,el),ip,ipc @@ -3595,7 +3613,7 @@ logical function crystallite_integrateStress(& invFp_new = invFp_new / math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize by det Fp_new = math_inv33(invFp_new) failedInversionInvFp: if (all(dEq0(Fp_new))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip ipc ',& el,mesh_element(1,el),ip,ipc, ' ; iteration ', NiterationStressLp @@ -3629,7 +3647,7 @@ logical function crystallite_integrateStress(& !* set return flag to true crystallite_integrateStress = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then From 80bed8b8aa2571faf5475499d8ade999b79da31f Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:32:52 -0400 Subject: [PATCH 03/54] improved math_expand algorithm --- src/math.f90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/math.f90 b/src/math.f90 index 1bf903ced..e9c921cd0 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -74,6 +74,7 @@ module math public :: & math_init, & math_qsort, & + math_expand, & math_range, & math_identity2nd, & math_identity4th, & @@ -382,14 +383,12 @@ pure function math_expand(what,how) real(pReal), dimension(:), intent(in) :: what integer(pInt), dimension(:), intent(in) :: how real(pReal), dimension(sum(how)) :: math_expand - integer(pInt) :: i,j,o + integer(pInt) :: i,o - o = 0_pInt + o = 1_pInt do i = 1, size(how) - do j = 1, how(i) - o = o + 1_pInt - math_expand(o) = what(1+mod(i-1,size(what))) - enddo + math_expand(o:o+how(i)-1_pInt) = what(1+mod(i-1,size(what))) + o = o + how(i) enddo end function math_expand From fb4aadbafa14b02a75d4bb087d7071726aa99dee Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:33:39 -0400 Subject: [PATCH 04/54] moved deltaState to group of contigous memory pointers --- src/prec.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/prec.f90 b/src/prec.f90 index 671e15990..44e9d7ac1 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -45,14 +45,14 @@ module prec sizePostResults = 0_pInt !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState - real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/doState. However, they will never point to something, but are rather allocated and, hence, contiguous + real(pReal), pointer, dimension(:,:), contiguous :: & ! a pointer is needed here because we might point to state/dot/deltaState. However, they will never point to something, but are rather allocated and, hence, contiguous state, & !< state - dotState, & !< state rate - state0 + state0, & !< state at beginning of increment + dotState, & !< rate of state change + deltaState !< increment of state change real(pReal), allocatable, dimension(:,:) :: & partionedState0, & subState0, & - deltaState, & previousDotState, & !< state rate of previous xxxx previousDotState2, & !< state rate two xxxx ago RK4dotState From a153443239979162d9c11a5253946204be9c07ed Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:34:18 -0400 Subject: [PATCH 05/54] clarified comment --- src/plastic_isotropic.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index bea9c616e..36529630c 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -61,7 +61,7 @@ module plastic_isotropic accumulatedShear end type type, private :: tIsotropicAbsTol !< internal alias for abs tolerance in state - real(pReal), pointer :: & ! scalars along NipcMyInstance + real(pReal), pointer :: & ! scalars flowstress, & accumulatedShear end type From d6cf3c4dd4b9038b46ff38c4dabebd07f720783b Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:35:36 -0400 Subject: [PATCH 06/54] reduced size of aTolState from sizeState to sizeDotState asb tolerance check is only meaningful for the state part affected by dotState --- src/plastic_phenopowerlaw.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index a7c7b10e6..c7fbd2adb 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -575,11 +575,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) - allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeDotState), source=0.0_pReal) allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then From 81bcc729934b65c8d819064c3e595ef811eb829d Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 29 Sep 2017 18:36:28 -0400 Subject: [PATCH 07/54] first shot at kinematic hardening constitutive law --- src/CMakeLists.txt | 1 + src/constitutive.f90 | 63 +- src/material.f90 | 5 + src/plastic_kinematichardening.f90 | 936 +++++++++++++++++++++++++++++ 4 files changed, 989 insertions(+), 16 deletions(-) create mode 100644 src/plastic_kinematichardening.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb1448028..435928a24 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -74,6 +74,7 @@ add_library (PLASTIC OBJECT "plastic_disloUCLA.f90" "plastic_isotropic.f90" "plastic_phenopowerlaw.f90" + "plastic_kinematichardening.f90" "plastic_titanmod.f90" "plastic_nonlocal.f90" "plastic_none.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index de8f61c2a..b9fd350b3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -70,6 +70,7 @@ subroutine constitutive_init() PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & + PLASTICITY_kinehardening_ID, & PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & @@ -93,6 +94,7 @@ subroutine constitutive_init() PLASTICITY_NONE_label, & PLASTICITY_ISOTROPIC_label, & PLASTICITY_PHENOPOWERLAW_label, & + PLASTICITY_KINEHARDENING_label, & PLASTICITY_PHENOPLUS_label, & PLASTICITY_DISLOTWIN_label, & PLASTICITY_DISLOUCLA_label, & @@ -113,6 +115,7 @@ subroutine constitutive_init() use plastic_none use plastic_isotropic use plastic_phenopowerlaw + use plastic_kinehardening use plastic_phenoplus use plastic_dislotwin use plastic_disloucla @@ -158,6 +161,7 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_PHENOPLUS_ID)) call plastic_phenoplus_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) @@ -218,6 +222,11 @@ subroutine constitutive_init() thisNoutput => plastic_phenopowerlaw_Noutput thisOutput => plastic_phenopowerlaw_output thisSize => plastic_phenopowerlaw_sizePostResult + case (PLASTICITY_KINEHARDENING_ID) plasticityType + outputName = PLASTICITY_KINEHARDENING_label + thisNoutput => plastic_kinehardening_Noutput + thisOutput => plastic_kinehardening_output + thisSize => plastic_kinehardening_sizePostResult case (PLASTICITY_PHENOPLUS_ID) plasticityType outputName = PLASTICITY_PHENOPLUS_label thisNoutput => plastic_phenoplus_Noutput @@ -501,6 +510,7 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & @@ -510,6 +520,8 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v plastic_isotropic_LpAndItsTangent use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_LpAndItsTangent + use plastic_kinehardening, only: & + plastic_kinehardening_LpAndItsTangent use plastic_phenoplus, only: & plastic_phenoplus_LpAndItsTangent use plastic_dislotwin, only: & @@ -557,23 +569,25 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v Lp = 0.0_pReal dLp_dMstar = 0.0_pReal case (PLASTICITY_ISOTROPIC_ID) plasticityType - call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) + call plastic_isotropic_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType - call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) + call plastic_phenopowerlaw_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) + call plastic_phenoplus_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme),ip,el) + call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v, & + temperature(ho)%p(tme),ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme),ipc,ip,el) + call plastic_dislotwin_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v, & + temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType - call plastic_disloucla_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme), ipc,ip,el) + call plastic_disloucla_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v, & + temperature(ho)%p(tme), ipc,ip,el) case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme), ipc,ip,el) + call plastic_titanmod_LpAndItsTangent (Lp,dLp_dMstar,Mstar_v, & + temperature(ho)%p(tme), ipc,ip,el) end select plasticityType dLp_dTstar3333 = math_Plain99to3333(dLp_dMstar) @@ -757,7 +771,7 @@ end function constitutive_initialFi !-------------------------------------------------------------------------------------------------- !> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to !> the elastic deformation gradient depending on the selected elastic law (so far no case switch -!! because only hooke is implemented +!! because only Hooke is implemented !-------------------------------------------------------------------------------------------------- subroutine constitutive_TandItsTangent(T, dT_dFe, dT_dFi, Fe, Fi, ipc, ip, el) use prec, only: & @@ -884,6 +898,7 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & + PLASTICITY_kinehardening_ID, & PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & @@ -897,6 +912,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra plastic_isotropic_dotState use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_dotState + use plastic_kinehardening, only: & + plastic_kinehardening_dotState use plastic_phenoplus, only: & plastic_phenoplus_dotState use plastic_dislotwin, only: & @@ -950,6 +967,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra call plastic_isotropic_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + call plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPLUS_ID) plasticityType call plastic_phenoplus_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType @@ -1009,10 +1028,13 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el) phase_source, & phase_Nsources, & material_phase, & + PLASTICITY_KINEHARDENING_ID, & PLASTICITY_NONLOCAL_ID, & SOURCE_damage_isoBrittle_ID, & SOURCE_vacancy_irradiation_ID, & SOURCE_vacancy_thermalfluc_ID + use plastic_kinehardening, only: & + plastic_kinehardening_deltaState use plastic_nonlocal, only: & plastic_nonlocal_deltaState use source_damage_isoBrittle, only: & @@ -1041,15 +1063,18 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el) if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) - if(phase_plasticity(material_phase(ipc,ip,el)) == PLASTICITY_NONLOCAL_ID) & - call plastic_nonlocal_deltaState(Tstar_v,ip,el) - + plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + call plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) + case (PLASTICITY_NONLOCAL_ID) plasticityType + call plastic_nonlocal_deltaState(Tstar_v,ip,el) + end select plasticityType SourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & - ipc, ip, el) + ipc, ip, el) case (SOURCE_vacancy_irradiation_ID) sourceType call source_vacancy_irradiation_deltaState(ipc, ip, el) case (SOURCE_vacancy_thermalfluc_ID) sourceType @@ -1093,6 +1118,7 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & + PLASTICITY_KINEHARDENING_ID, & PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & @@ -1106,6 +1132,8 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) plastic_isotropic_postResults use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_postResults + use plastic_kinehardening, only: & + plastic_kinehardening_postResults use plastic_phenoplus, only: & plastic_phenoplus_postResults use plastic_dislotwin, only: & @@ -1160,6 +1188,9 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) + case (PLASTICITY_KINEHARDENING_ID) plasticityType + constitutive_postResults(startPos:endPos) = & + plastic_kinehardening_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPLUS_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) diff --git a/src/material.f90 b/src/material.f90 index a77c4871a..cc970fb33 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -25,6 +25,7 @@ module material PLASTICITY_none_label = 'none', & PLASTICITY_isotropic_label = 'isotropic', & PLASTICITY_phenopowerlaw_label = 'phenopowerlaw', & + PLASTICITY_kinehardening_label = 'kinehardening', & PLASTICITY_phenoplus_label = 'phenoplus', & PLASTICITY_dislotwin_label = 'dislotwin', & PLASTICITY_disloucla_label = 'disloucla', & @@ -74,6 +75,7 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & + PLASTICITY_kinehardening_ID, & PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & @@ -312,6 +314,7 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & + PLASTICITY_kinehardening_ID, & PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & @@ -985,6 +988,8 @@ subroutine material_parsePhase(fileUnit,myPart) phase_plasticity(section) = PLASTICITY_ISOTROPIC_ID case (PLASTICITY_PHENOPOWERLAW_label) phase_plasticity(section) = PLASTICITY_PHENOPOWERLAW_ID + case (PLASTICITY_KINEHARDENING_label) + phase_plasticity(section) = PLASTICITY_KINEHARDENING_ID case (PLASTICITY_PHENOPLUS_label) phase_plasticity(section) = PLASTICITY_PHENOPLUS_ID case (PLASTICITY_DISLOTWIN_label) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 new file mode 100644 index 000000000..691bbda91 --- /dev/null +++ b/src/plastic_kinematichardening.f90 @@ -0,0 +1,936 @@ +!------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Introducing Voce-type kinematic hardening rule into crystal phenopowerlaw plasticity +!! formulation using a power law fitting +!-------------------------------------------------------------------------------------------------- +module plastic_kinehardening + use prec, only: & + pReal,& + pInt + + implicit none + private + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_kinehardening_sizePostResults !< cumulative size of post results + + integer(pInt), dimension(:,:), allocatable, target, public :: & + plastic_kinehardening_sizePostResult !< size of each post result output + + character(len=64), dimension(:,:), allocatable, target, public :: & + plastic_kinehardening_output !< name of each post result output + + integer(pInt), dimension(:), allocatable, target, public :: & + plastic_kinehardening_Noutput !< number of outputs per instance + + integer(pInt), dimension(:), allocatable, public, protected :: & + plastic_kinehardening_totalNslip !< no. of slip system used in simulation + + + integer(pInt), dimension(:,:), allocatable, private :: & + plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family) + + + enum, bind(c) + enumerator :: undefined_ID, & + crss_ID, & !< critical resolved stress + crss_back_ID, & !< critical resolved back stress + sense_ID, & !< sense of acting shear stress (-1 or +1) + chi0_ID, & !< backstress at last switch of stress sense (positive?) + gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?) + accshear_ID, & + sumGamma_ID, & + shearrate_ID, & + resolvedstress_ID + + end enum + + + type, private :: tParameters !< container type for internal constitutive parameters + integer(kind(undefined_ID)), dimension(:), allocatable, private :: & + outputID !< ID of each post result output + + real(pReal) :: & + gdot0, & !< reference shear strain rate for slip (input parameter) + n_slip, & !< stress exponent for slip (input parameter) + aTolResistance, & + aTolShear + + + real(pReal), dimension(:), allocatable, private :: & + tau0, & !< initial critical shear stress for slip (input parameter, per family) + theta0, & !< initial hardening rate of forward stress for each slip + theta1, & !< asymptotic hardening rate of forward stress for each slip > + theta0_b, & !< initial hardening rate of back stress for each slip > + theta1_b, & !< asymptotic hardening rate of back stress for each slip > + tau1, & + tau1_b, & + interaction_slipslip, & !< latent hardening matrix + nonSchmidCoeff + + real(pReal), dimension(:,:), allocatable, private :: & + hardeningMatrix_SlipSlip + end type + + type, private :: tKinehardeningState + real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance + crss, & !< critical resolved stress + crss_back, & !< critical resolved back stress + sense, & !< sense of acting shear stress (-1 or +1) + chi0, & !< backstress at last switch of stress sense + gamma0, & !< accumulated shear at last switch of stress sense + accshear !< accumulated (absolute) shear + + real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance + sumGamma !< accumulated shear across all systems + end type + + type(tParameters), dimension(:), allocatable, private :: & + param !< containers of constitutive parameters (len Ninstance) + + type(tKinehardeningState), allocatable, dimension(:), private :: & + dotState, & + deltaState, & + state, & + state0 + + + public :: & + plastic_kinehardening_init, & + plastic_kinehardening_LpAndItsTangent, & + plastic_kinehardening_dotState, & + plastic_kinehardening_deltaState, & + plastic_kinehardening_postResults + private :: & + plastic_kinehardening_shearRates + + +contains + + + +!-------------------------------------------------------------------------------------------------- +!> @brief module initialization +!> @details reads in material parameters, allocates arrays, and does sanity checks +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_init(fileUnit) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use prec, only: & + dEq0 + use debug, only: & + debug_level, & + debug_constitutive,& + debug_levelBasic + use math, only: & + math_Mandel3333to66, & + math_Voigt66to3333, & + math_expand + use IO, only: & + IO_read, & + IO_lc, & + IO_getTag, & + IO_isBlank, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_warning, & + IO_error, & + IO_timeStamp, & + IO_EOF + use material, only: & + PLASTICITY_kinehardening_label, & + PLASTICITY_kinehardening_ID, & + phase_plasticity, & + phase_plasticityInstance, & + phase_Noutput, & + material_phase, & + plasticState, & + MATERIAL_partPhase + use lattice + use numerics,only: & + numerics_integrator + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: & + o, j, k, f, & + output_ID, & + phase, & + instance, & + maxNinstance, & + NipcMyPhase, & + Nchunks_SlipSlip = 0_pInt, Nchunks_SlipFamilies = 0_pInt, & + Nchunks_nonSchmid = 0_pInt, & + offset_slip, index_myFamily, index_otherFamily, & + startIndex, endIndex, & + mySize, nSlip, nSlipFamilies, & + sizeDotState, & + sizeState, & + sizeDeltaState + + real(pReal), dimension(:), allocatable :: tempPerSlip + + character(len=65536) :: & + tag = '', & + line = '', & + extmsg = '' + character(len=64) :: & + outputtag = '' + + write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + maxNinstance = int(count(phase_plasticity == PLASTICITY_KINEHARDENING_ID),pInt) + if (maxNinstance == 0_pInt) return + + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & + write(6,'(a,1x,i5,/)') '# instances:',maxNinstance + + allocate(plastic_kinehardening_sizePostResults(maxNinstance), source=0_pInt) + allocate(plastic_kinehardening_sizePostResult(maxval(phase_Noutput),maxNinstance), & + source=0_pInt) + allocate(plastic_kinehardening_output(maxval(phase_Noutput),maxNinstance)) + plastic_kinehardening_output = '' + allocate(plastic_kinehardening_Noutput(maxNinstance), source=0_pInt) + allocate(plastic_kinehardening_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) + allocate(plastic_kinehardening_totalNslip(maxNinstance), source=0_pInt) + allocate(param(maxNinstance)) ! one container of parameters per instance + + rewind(fileUnit) + phase = 0_pInt + do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to + line = IO_read(fileUnit) + enddo + + parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part + line = IO_read(fileUnit) + if (IO_isBlank(line)) cycle ! skip empty lines + if (IO_getTag(line,'<','>') /= '') then ! stop at next part + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + if (IO_getTag(line,'[',']') /= '') then ! next phase + phase = phase + 1_pInt ! advance phase section counter + if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then + instance = phase_plasticityInstance(phase) ! count instances of my constitutive law + Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase + Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) + Nchunks_nonSchmid = lattice_NnonSchmid(phase) + allocate(param(instance)%outputID(phase_Noutput(phase)), source=0_pInt) ! allocate space for IDs of every requested output + allocate(param(instance)%tau0 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%theta0 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%theta1 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%theta0_b(Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%theta1_b(Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%interaction_slipslip(Nchunks_SlipSlip), source=0.0_pReal) + allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid), source=0.0_pReal) + if(allocated(tempPerSlip)) deallocate(tempPerSlip) + allocate(tempPerSlip(Nchunks_SlipFamilies)) + endif + cycle ! skip to next line + endif + if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran + instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase + chunkPos = IO_stringPos(line) + tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key + select case(tag) + case ('(output)') + outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) + output_ID = undefined_ID + select case(outputtag) + case ('resistance') + output_ID = crss_ID + case ('backstress') + output_ID = crss_back_ID + case ('sense') + output_ID = sense_ID + case ('chi0') + output_ID = chi0_ID + case ('gamma0') + output_ID = gamma0_ID + case ('accumulatedshear') + output_ID = accshear_ID + case ('totalshear') + output_ID = sumGamma_ID + case ('shearrate') + output_ID = shearrate_ID + case ('resolvedstress') + output_ID = resolvedstress_ID + end select + + if (output_ID /= undefined_ID) then + plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt + plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = outputtag + param(instance)%outputID (plastic_kinehardening_Noutput(instance)) = output_ID + endif +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of slip families + case ('nslip') + if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & + call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') + if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & + call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') + Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) + do j = 1_pInt, Nchunks_SlipFamilies + plastic_kinehardening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) + enddo + + case ('tau0','tau1','tau1_b','theta0','theta1','theta0_b','theta1_b') + tempPerSlip = 0.0_pReal + do j = 1_pInt, Nchunks_SlipFamilies + if (plastic_kinehardening_Nslip(j,instance) > 0_pInt) & + tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + select case(tag) + case ('tau0') + param(instance)%tau0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau1') + param(instance)%tau1(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('tau1_b') + param(instance)%tau1_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('theta0') + param(instance)%theta0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('theta1') + param(instance)%theta1(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('theta0_b') + param(instance)%theta0_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('theta1_b') + param(instance)%theta1_b(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + end select + +!-------------------------------------------------------------------------------------------------- +! parameters depending on number of interactions + case ('interaction_slipslip') + if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') + do j = 1_pInt, Nchunks_SlipSlip + param(instance)%interaction_slipslip(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo + case ('nonSchmidCoeff') + if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & + call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') + do j = 1_pInt,Nchunks_nonSchmid + param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) + enddo +!-------------------------------------------------------------------------------------------------- +! parameters independent of number of slip families + case ('gdot0') + param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt) + + case ('n_slip') + param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) + + case ('aTolResistance') + param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) + + case ('aTolShear') + param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) + + case default + + end select + endif; endif + enddo parsingFile + +!-------------------------------------------------------------------------------------------------- +! allocation of variables whose size depends on the total number of active slip systems + allocate(state(maxNinstance)) + allocate(state0(maxNinstance)) + allocate(dotState(maxNinstance)) + allocate(deltaState(maxNinstance)) + + + initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config + myPhase2: if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! only consider my phase + NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase + instance = phase_plasticityInstance(phase) ! which instance of my phase + plastic_kinehardening_Nslip(1:lattice_maxNslipFamily,instance) = & + min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested + plastic_kinehardening_Nslip(1:lattice_maxNslipFamily,instance)) + + plastic_kinehardening_totalNslip(instance) = sum(plastic_kinehardening_Nslip(:,instance)) ! how many slip systems altogether + nSlipFamilies = count(plastic_kinehardening_Nslip(:,instance) > 0_pInt) + nSlip = plastic_kinehardening_totalNslip(instance) ! total number of active slip systems + +!-------------------------------------------------------------------------------------------------- +! sanity checks + + if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & + .and. param(instance)%tau0(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' tau0' + if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & + .and. param(instance)%tau1(1:nSlipFamilies) <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1' + if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & + .and. param(instance)%tau1_b(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' tau1_b' + if (param(instance)%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0' + if (param(instance)%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip' + if (param(instance)%aTolResistance <= 0.0_pReal) param(instance)%aTolResistance = 1.0_pReal ! default absolute tolerance 1 Pa + if (param(instance)%aTolShear <= 0.0_pReal) param(instance)%aTolShear = 1.0e-6_pReal ! default absolute tolerance 1e-6 + if (extmsg /= '') then + extmsg = trim(extmsg)//' ('//PLASTICITY_KINEHARDENING_label//')' ! prepare error message identifier + call IO_error(211_pInt,ip=instance,ext_msg=extmsg) + endif + + allocate(param(instance)%hardeningMatrix_SlipSlip(nSlip,nSlip), source=0.0_pReal) + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X + index_myFamily = sum(plastic_kinehardening_Nslip(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_kinehardening_Nslip(f,instance) ! loop over (active) systems in my family (slip) + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_kinehardening_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_kinehardening_Nslip(o,instance) ! loop over (active) systems in other family (slip) + param(instance)%hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase)) + enddo; enddo + enddo; enddo + + +!-------------------------------------------------------------------------------------------------- +! Determine size of postResults array + + outputsLoop: do o = 1_pInt,plastic_kinehardening_Noutput(instance) + select case(param(instance)%outputID(o)) + case(crss_ID, & !< critical resolved stress + crss_back_ID, & !< critical resolved back stress + sense_ID, & !< sense of acting shear stress (-1 or +1) + chi0_ID, & !< backstress at last switch of stress sense + gamma0_ID, & !< accumulated shear at last switch of stress sense + accshear_ID, & + shearrate_ID, & + resolvedstress_ID) + mySize = nSlip + case(sumGamma_ID) + mySize = 1_pInt + case default + end select + + outputFound: if (mySize > 0_pInt) then + plastic_kinehardening_sizePostResult(o,instance) = mySize + plastic_kinehardening_sizePostResults(instance) = plastic_kinehardening_sizePostResults(instance) + mySize + endif outputFound + enddo outputsLoop +!-------------------------------------------------------------------------------------------------- +! allocate state arrays + sizeDotState = nSlip & !< crss + + nSlip & !< crss_back + + nSlip & !< accumulated (absolute) shear + + 1_pInt !< sum(gamma) + + sizeDeltaState = nSlip & !< sense of acting shear stress (-1 or +1) + + nSlip & !< backstress at last switch of stress sense + + nSlip !< accumulated shear at last switch of stress sense + + sizeState = sizeDotState + sizeDeltaState + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizePostResults = plastic_kinehardening_sizePostResults(instance) + plasticState(phase)%nSlip = nSlip + + allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%aTolState (sizeDotState), source=0.0_pReal) + allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) ! allocate space for deltaState + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + + offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt + plasticState(phase)%slipRate => & + plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%accumulatedSlip => & + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + + do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X + index_myFamily = sum(plastic_kinehardening_Nslip(1:f-1_pInt,instance)) + do j = 1_pInt,plastic_kinehardening_Nslip(f,instance) ! loop over (active) systems in my family (slip) + do o = 1_pInt,lattice_maxNslipFamily + index_otherFamily = sum(plastic_kinehardening_Nslip(1:o-1_pInt,instance)) + do k = 1_pInt,plastic_kinehardening_Nslip(o,instance) ! loop over (active) systems in other family (slip) + param(instance)%hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & + param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,phase))+j, & + sum(lattice_NslipSystem(1:o-1,phase))+k, & + phase)) + enddo; enddo + enddo; enddo + +!---------------------------------------------------------------------------------------------- +!locally define dotState alias + + endindex = 0_pInt + o = endIndex ! offset of dotstate index relative to state index + + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%crss => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%crss => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + dotState(instance)%crss => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%crss = spread(math_expand(param(instance)%tau0,& + plastic_kinehardening_Nslip(:,instance)), & + 2, NipcMyPhase) + plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolResistance + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%crss_back => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%crss_back => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + dotState(instance)%crss_back => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%crss_back = 0.0_pReal + plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolResistance + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%accshear => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%accshear => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + dotState(instance)%accshear => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%accshear = 0.0_pReal + plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolShear + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumGamma => plasticState(phase)%state (startIndex ,1:NipcMyPhase) + state0 (instance)%sumGamma => plasticState(phase)%state0 (startIndex ,1:NipcMyPhase) + dotState(instance)%sumGamma => plasticState(phase)%dotState (startIndex-o ,1:NipcMyPhase) + + state0(instance)%sumGamma = 0.0_pReal + plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolShear + +!---------------------------------------------------------------------------------------------- +!locally define deltaState alias + o = endIndex + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%sense => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%sense => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + deltaState(instance)%sense => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%sense = 0.0_pReal + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%chi0 => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%chi0 => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + deltaState(instance)%chi0 => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%chi0 = 0.0_pReal + +! ............................................. + startIndex = endIndex + 1_pInt + endIndex = endIndex + nSlip + state (instance)%gamma0 => plasticState(phase)%state (startIndex :endIndex ,1:NipcMyPhase) + state0 (instance)%gamma0 => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) + deltaState(instance)%gamma0 => plasticState(phase)%deltaState(startIndex-o:endIndex-o,1:NipcMyPhase) + + state0(instance)%gamma0 = 0.0_pReal + + endif myPhase2 + enddo initializeInstances + +end subroutine plastic_kinehardening_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of shear rates (\dot \gamma) +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & + Tstar_v,ph,instance,of) + + use lattice, only: & + lattice_NslipSystem, & + lattice_Sslip_v, & + lattice_maxNslipFamily, & + lattice_NnonSchmid + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ph, & !< phase ID + instance, & !< instance of that phase + of !< index of phaseMember + real(pReal), dimension(plastic_kinehardening_totalNslip(instance)), intent(out) :: & + gdot_pos, & !< shear rates from positive line segments + gdot_neg, & !< shear rates from negative line segments + tau_pos, & !< shear stress on positive line segments + tau_neg !< shear stress on negative line segments + + integer(pInt) :: & + index_myFamily, & + f,i,j,k + real(pReal) :: & + tau + + + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) + j = j + 1_pInt + tau_pos(j) = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + tau_neg(j) = tau_pos(j) + nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) + tau_pos(j) = tau_pos(j) + param(instance)%nonSchmidCoeff(k)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+0,index_myFamily+i,ph)) + tau_neg(j) = tau_neg(j) + param(instance)%nonSchmidCoeff(k)* & + dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) + enddo nonSchmidSystems + enddo slipSystems + enddo slipFamilies + + gdot_pos = 0.5_pReal * param(instance)%gdot0 * & + (abs(tau_pos-state(instance)%crss_back(:,of))/state(instance)%crss(:,of))**param(instance)%n_slip & + *sign(1.0_pReal,tau_pos) + gdot_neg = 0.5_pReal * param(instance)%gdot0 * & + (abs(tau_neg-state(instance)%crss_back(:,of))/state(instance)%crss(:,of))**param(instance)%n_slip & + *sign(1.0_pReal,tau_neg) + +end subroutine plastic_kinehardening_shearRates + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates plastic velocity gradient and its tangent +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, & + Tstar_v,ipc,ip,el) + use prec, only: & + dNeq0 + use math, only: & + math_Plain3333to99, & + math_Mandel6to33 + use lattice, only: & + lattice_Sslip, & !< schmid matrix + lattice_Sslip_v, & + lattice_maxNslipFamily, & + lattice_NslipSystem, & + lattice_NnonSchmid + use material, only: & + phaseAt, phasememberAt, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(3,3), intent(out) :: & + Lp !< plastic velocity gradient + real(pReal), dimension(9,9), intent(out) :: & + dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress + + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + + integer(pInt) :: & + instance, & + index_myFamily, & + f,i,j,k,l,m,n, & + of, & + ph + + real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: & + gdot_pos,gdot_neg, & + tau_pos,tau_neg + real(pReal) :: & + dgdot_dtau_pos,dgdot_dtau_neg + real(pReal), dimension(3,3,3,3) :: & + dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor + real(pReal), dimension(3,3,2) :: & + nonSchmid_tensor + + ph = phaseAt(ipc,ip,el) !< figures phase for each material point + of = phasememberAt(ipc,ip,el) !< index of the positions of each constituent of material point, phasememberAt is a function in material that helps figure them out + instance = phase_plasticityInstance(ph) + + Lp = 0.0_pReal + dLp_dTstar3333 = 0.0_pReal + dLp_dTstar99 = 0.0_pReal + + call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & + Tstar_v,ph,instance,of) + + j = 0_pInt ! reading and marking the starting index for each slip family + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) + j = j + 1_pInt + + ! build nonSchmid tensor + nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) + do k = 1,lattice_NnonSchmid(ph) + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + enddo + + Lp = Lp + (gdot_pos(j)+gdot_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! sum of all gdot*SchmidTensor gives Lp + + ! Calculation of the tangent of Lp ! sensitivity of Lp + if (dNeq0(gdot_pos(j))) then + dgdot_dtau_pos = gdot_pos(j)*param(instance)%n_slip/(tau_pos(j)-state(instance)%crss_back(j,of)) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtau_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,1) + endif + + if (dNeq0(gdot_neg(j))) then + dgdot_dtau_neg = gdot_neg(j)*param(instance)%n_slip/(tau_neg(j)-state(instance)%crss_back(j,of)) + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & + dgdot_dtau_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,2) + endif + enddo slipSystems + enddo slipFamilies + +end subroutine plastic_kinehardening_LpAndItsTangent + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates (instantaneous) incremental change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) + use prec, only: & + dNeq + use material, only: & + phaseAt, & + phasememberAt, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in):: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element + real(pReal), dimension(6) :: & + Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: & + gdot_pos,gdot_neg, & + tau_pos,tau_neg, & + sense + integer(pInt) :: & + ph, & + instance, & !< instance of my instance (unique number of my constitutive model) + of, & + j !< shortcut notation for offset position in state array + + ph = phaseAt(ipc,ip,el) + of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember + instance = phase_plasticityInstance(ph) + + call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & + Tstar_v,ph,instance,of) + + sense = sign(1.0_pReal,gdot_pos+gdot_neg) ! current sense of shear direction +!-------------------------------------------------------------------------------------------------- +! switch in sense of shear? + do j = 1,plastic_kinehardening_totalNslip(instance) + if (dNeq(sense(j),state(instance)%sense(j,of),0.1_pReal)) then + deltaState(instance)%sense (j,of) = sense(j) - state(instance)%sense(j,of) ! switch sense + deltaState(instance)%chi0 (j,of) = abs(state(instance)%crss_back(j,of)) - state(instance)%chi0(j,of) ! remember current backstress magnitude + deltaState(instance)%gamma0(j,of) = state(instance)%accshear(j,of) - state(instance)%gamma0(j,of) ! remember current accumulated shear + endif + enddo + +end subroutine plastic_kinehardening_deltaState + + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates the rate of change of microstructure +!-------------------------------------------------------------------------------------------------- +subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) + use lattice, only: & + lattice_Sslip_v, & + lattice_maxNslipFamily, & + lattice_NslipSystem, & + lattice_NnonSchmid + use material, only: & + material_phase, & + phaseAt, phasememberAt, & + plasticState, & + phase_plasticityInstance + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation, vector form + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + integer(pInt) :: & + instance,ph, & + f,i,j,k, & + index_Gamma,index_myFamily,index_otherFamily, & + nSlip, & + offset_accshear, & + of + + real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_pos,gdot_neg, & + tau_pos,tau_neg + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + nSlip = plastic_kinehardening_totalNslip(instance) + + call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & + Tstar_v,ph,instance,of) + + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) + j = j+1_pInt + dotState(instance)%crss(j,of) = & ! evolution of slip resistance j + dot_product(param(instance)%hardeningMatrix_SlipSlip(j,1:nSlip),abs(gdot_pos+gdot_neg)) * & + ( param(instance)%theta1(f) + & + (param(instance)%theta0(f) - param(instance)%theta1(f) & + + param(instance)%theta0(f)*param(instance)%theta1(f)*state(instance)%sumGamma(of)/param(instance)%tau1(f)) & + *exp(-state(instance)%sumGamma(of)*param(instance)%theta0(f)/param(instance)%tau1(f)) & ! V term depending on the harding law + ) + dotState(instance)%crss_back(j,of) = & ! evolution of back stress resistance j + dot_product(param(instance)%hardeningMatrix_SlipSlip(j,1:nSlip),abs(gdot_pos+gdot_neg)) * & + ( param(instance)%theta1_b(f) + & + (param(instance)%theta0_b(f) - param(instance)%theta1_b(f) & + + param(instance)%theta0_b(f)*param(instance)%theta1_b(f)/(param(instance)%tau1_b(f)+state(instance)%chi0(j,of)) & + *(state(instance)%accshear(j,of)-state(instance)%gamma0(j,of))) & + *exp(-(state(instance)%accshear(j,of)-state(instance)%gamma0(j,of)) & + *param(instance)%theta0_b(f)/(param(instance)%tau1_b(f)+state(instance)%chi0(j,of))) & + ) ! V term depending on the harding law for back stress + + dotState(instance)%accshear(j,of) = abs(gdot_pos(j)+gdot_neg(j)) + dotState(instance)%sumGamma(of) = dotState(instance)%sumGamma(of) + dotState(instance)%accshear(j,of) + enddo slipSystems + enddo slipFamilies + +end subroutine plastic_kinehardening_dotState + +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el) + use material, only: & + material_phase, & + plasticState, & + phaseAt, phasememberAt, & + phase_plasticityInstance + use lattice, only: & + lattice_Sslip_v, & + lattice_maxNslipFamily, & + lattice_NslipSystem, & + lattice_NnonSchmid + + implicit none + real(pReal), dimension(6), intent(in) :: & + Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation + integer(pInt), intent(in) :: & + ipc, & !< component-ID of integration point + ip, & !< integration point + el !< element !< microstructure state + + real(pReal), dimension(plastic_kinehardening_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + plastic_kinehardening_postResults + + integer(pInt) :: & + instance,ph, of, & + nSlip,& + o,f,i,c,j,k, & + index_Gamma,index_accshear,index_myFamily + + real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + gdot_pos,gdot_neg, & + tau_pos,tau_neg + + of = phasememberAt(ipc,ip,el) + ph = phaseAt(ipc,ip,el) + instance = phase_plasticityInstance(ph) + + nSlip = plastic_kinehardening_totalNslip(instance) + + plastic_kinehardening_postResults = 0.0_pReal + c = 0_pInt + + call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & + Tstar_v,ph,instance,of) + + outputsLoop: do o = 1_pInt,plastic_kinehardening_Noutput(instance) + select case(param(instance)%outputID(o)) + case (crss_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%crss(:,of) + c = c + nSlip + + case(crss_back_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%crss_back(:,of) + c = c + nSlip + + case (sense_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%sense(:,of) + c = c + nSlip + + case (chi0_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%chi0(:,of) + c = c + nSlip + + case (gamma0_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%gamma0(:,of) + c = c + nSlip + + case (accshear_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = state(instance)%accshear(:,of) + c = c + nSlip + + case (sumGamma_ID) + plastic_kinehardening_postResults(c+1_pInt) = state(instance)%sumGamma(of) + c = c + 1_pInt + + case (shearrate_ID) + plastic_kinehardening_postResults(c+1_pInt:c+nSlip) = gdot_pos+gdot_neg + c = c + nSlip + + case (resolvedstress_ID) + j = 0_pInt + slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family + slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) + j = j + 1_pInt + plastic_kinehardening_postResults(c+j) = & + dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) + enddo slipSystems + enddo slipFamilies + c = c + nSlip + + end select + enddo outputsLoop + +end function plastic_kinehardening_postResults + +end module plastic_kinehardening From 2f5d81e1116fea85f6ed17a146cc6ad77eb703dd Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Tue, 3 Oct 2017 17:18:34 -0400 Subject: [PATCH 08/54] beautified debug output --- src/spectral_utilities.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 0773a9065..d1b397002 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -818,7 +818,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) enddo enddo if(debugGeneral .or. errmatinv) then - write(formatString, '(I16.16)') size_reduced + write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' write(6,trim(formatString),advance='no') ' C * S (load) ', & transpose(matmul(c_reduced,s_reduced)) @@ -832,7 +832,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) temp99_real = 0.0_pReal endif if(debugGeneral) & - write(6,'(/,a,/,9(9(2x,f12.7,1x)/),/)',advance='no') ' Masked Compliance (load) * GPa =', & + write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') ' Masked Compliance (load) / GPa =', & transpose(temp99_Real*1.e9_pReal) flush(6) utilities_maskedCompliance = math_Plain99to3333(temp99_Real) From 23f9f03ca895aaa2aefe7673333b3351cf9d15b3 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Mon, 6 Nov 2017 18:09:04 -0500 Subject: [PATCH 09/54] refined debug output --- src/crystallite.f90 | 20 ++++++++++---------- src/debug.f90 | 14 ++++++++------ src/homogenization.f90 | 9 +++++---- 3 files changed, 23 insertions(+), 20 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 781bb205c..821404e0d 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -984,7 +984,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) !$OMP FLUSH(crystallite_todo) #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt) then + if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then if (crystallite_todo(c,i,e)) then write(6,'(a,f12.8,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent & &with new crystallite_subStep: ',& @@ -1040,10 +1040,10 @@ subroutine crystallite_stressAndItsTangent(updateJaco) endif timeSyncing2 if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,e12.5)') '<< CRYST >> min(subStep) ',minval(crystallite_subStep) - write(6,'(a,e12.5)') '<< CRYST >> max(subStep) ',maxval(crystallite_subStep) - write(6,'(a,e12.5)') '<< CRYST >> min(subFrac) ',minval(crystallite_subFrac) - write(6,'(a,e12.5,/)') '<< CRYST >> max(subFrac) ',maxval(crystallite_subFrac) + write(6,'(/,a,f8.5)') '<< CRYST >> min(subStep) ',minval(crystallite_subStep) + write(6,'(a,f8.5)') '<< CRYST >> max(subStep) ',maxval(crystallite_subStep) + write(6,'(a,f8.5)') '<< CRYST >> min(subFrac) ',minval(crystallite_subFrac) + write(6,'(a,f8.5,/)') '<< CRYST >> max(subFrac) ',maxval(crystallite_subFrac) flush(6) endif @@ -1051,7 +1051,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (any(crystallite_todo)) then if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,i3)') '<< CRYST >> doing integrate state ',numerics_integrator(numerics_integrationMode) + write(6,'(/,a,i3)') '<< CRYST >> using state integrator ',numerics_integrator(numerics_integrationMode) flush(6) endif select case(numerics_integrator(numerics_integrationMode)) @@ -3043,8 +3043,8 @@ subroutine crystallite_integrateStateFPI() !$OMP END PARALLEL 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 + write(6,'(a,i8,a,i2)') '<< CRYST >> ', count(crystallite_converged(:,:,:)), & + ' grains converged after state integration #', NiterationState ! --- NON-LOCAL CONVERGENCE CHECK --- @@ -3157,8 +3157,8 @@ logical function crystallite_stateJump(ipc,ip,el) write(6,'(a,i8,1x,i2,1x,i3, /)') '<< CRYST >> update state at el ip ipc ',el,ip,ipc write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> deltaState', plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & - plasticState(p)%state(myOffsetSourceDeltaState + 1_pInt : & - myOffsetSourceDeltaState + mySizeSourceDeltaState,c) + plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & + myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) endif #endif diff --git a/src/debug.f90 b/src/debug.f90 index 03a0d6f08..691b8ab5f 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -439,13 +439,15 @@ subroutine debug_info write(6,'(a15,i10,1x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) endif debugOutputHomog - debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0) then - write(6,'(2/,a,/)') ' Extreme values of returned stress and jacobian' + debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & + .and. any(debug_stressMinLocation /= 0_pInt) & + .and. any(debug_stressMaxLocation /= 0_pInt) ) then + write(6,'(2/,a,/)') ' Extreme values of returned stress and Jacobian' write(6,'(a39)') ' value el ip' - write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation - write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation - write(6,'(a14,1x,e12.3,1x,i6,1x,i4)') ' jacobian min :', debug_jacobianMin, debug_jacobianMinLocation - write(6,'(a14,1x,e12.3,1x,i6,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' stress min :', debug_stressMin, debug_stressMinLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' max :', debug_stressMax, debug_stressMaxLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4)') ' Jacobian min :', debug_jacobianMin, debug_jacobianMinLocation + write(6,'(a14,1x,e12.3,1x,i8,1x,i4,/)') ' max :', debug_jacobianMax, debug_jacobianMaxLocation endif debugOutputCPFEM !$OMP END CRITICAL (write2out) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 93fe50631..8b7da3b28 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -538,6 +538,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) debug_level, & debug_homogenization, & debug_levelBasic, & + debug_levelExtensive, & debug_levelSelective, & debug_e, & debug_i, & @@ -634,8 +635,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) converged: if ( materialpoint_converged(i,e) ) then -#ifndef _OPENMP - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & +#ifdef DEBUG + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i) & .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0_pInt)) then write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & @@ -737,8 +738,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback !$OMP FLUSH(materialpoint_subStep) -#ifndef _OPENMP - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & +#ifdef DEBUG + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i) & .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0_pInt)) then write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & From 2b4a02467160275449ff077589fecfbb228aa316 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Mon, 6 Nov 2017 18:11:02 -0500 Subject: [PATCH 10/54] renamed "tau0" to "crss0" --- src/plastic_kinematichardening.f90 | 52 ++++++++++++++++++++++++------ 1 file changed, 43 insertions(+), 9 deletions(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 691bbda91..c18c4d9ba 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -58,7 +58,7 @@ module plastic_kinehardening real(pReal), dimension(:), allocatable, private :: & - tau0, & !< initial critical shear stress for slip (input parameter, per family) + crss0, & !< initial critical shear stress for slip (input parameter, per family) theta0, & !< initial hardening rate of forward stress for each slip theta1, & !< asymptotic hardening rate of forward stress for each slip > theta0_b, & !< initial hardening rate of back stress for each slip > @@ -221,7 +221,7 @@ subroutine plastic_kinehardening_init(fileUnit) Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) allocate(param(instance)%outputID(phase_Noutput(phase)), source=0_pInt) ! allocate space for IDs of every requested output - allocate(param(instance)%tau0 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%theta0 (Nchunks_SlipFamilies), source=0.0_pReal) @@ -281,15 +281,15 @@ subroutine plastic_kinehardening_init(fileUnit) plastic_kinehardening_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) enddo - case ('tau0','tau1','tau1_b','theta0','theta1','theta0_b','theta1_b') + case ('crss0','tau1','tau1_b','theta0','theta1','theta0_b','theta1_b') tempPerSlip = 0.0_pReal do j = 1_pInt, Nchunks_SlipFamilies if (plastic_kinehardening_Nslip(j,instance) > 0_pInt) & tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo select case(tag) - case ('tau0') - param(instance)%tau0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) + case ('crss0') + param(instance)%crss0(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) case ('tau1') param(instance)%tau1(1:Nchunks_SlipFamilies) = tempPerSlip(1:Nchunks_SlipFamilies) case ('tau1_b') @@ -362,7 +362,7 @@ subroutine plastic_kinehardening_init(fileUnit) ! sanity checks if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & - .and. param(instance)%tau0(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' tau0' + .and. param(instance)%crss0(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' crss0' if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & .and. param(instance)%tau1(1:nSlipFamilies) <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1' if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt & @@ -431,6 +431,7 @@ subroutine plastic_kinehardening_init(fileUnit) plasticState(phase)%sizeState = sizeState plasticState(phase)%sizeDotState = sizeDotState plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeDotState plasticState(phase)%sizePostResults = plastic_kinehardening_sizePostResults(instance) plasticState(phase)%nSlip = nSlip @@ -482,7 +483,7 @@ subroutine plastic_kinehardening_init(fileUnit) state0 (instance)%crss => plasticState(phase)%state0 (startIndex :endIndex ,1:NipcMyPhase) dotState(instance)%crss => plasticState(phase)%dotState (startIndex-o:endIndex-o,1:NipcMyPhase) - state0(instance)%crss = spread(math_expand(param(instance)%tau0,& + state0(instance)%crss = spread(math_expand(param(instance)%crss0,& plastic_kinehardening_Nslip(:,instance)), & 2, NipcMyPhase) plasticState(phase)%aTolState(startIndex-o:endIndex-o) = param(instance)%aTolResistance @@ -717,6 +718,11 @@ end subroutine plastic_kinehardening_LpAndItsTangent subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) use prec, only: & dNeq + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective use material, only: & phaseAt, & phasememberAt, & @@ -749,13 +755,39 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) Tstar_v,ph,instance,of) sense = sign(1.0_pReal,gdot_pos+gdot_neg) ! current sense of shear direction + +#ifdef DEBUG + if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'a') '======= kinehardening delta state =======' + endif +#endif + !-------------------------------------------------------------------------------------------------- ! switch in sense of shear? do j = 1,plastic_kinehardening_totalNslip(instance) +#ifdef DEBUG + if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'i2,1x,f7.4,1x,f7.4') j,sense(j),state(instance)%sense(j,of) + endif +#endif if (dNeq(sense(j),state(instance)%sense(j,of),0.1_pReal)) then deltaState(instance)%sense (j,of) = sense(j) - state(instance)%sense(j,of) ! switch sense deltaState(instance)%chi0 (j,of) = abs(state(instance)%crss_back(j,of)) - state(instance)%chi0(j,of) ! remember current backstress magnitude deltaState(instance)%gamma0(j,of) = state(instance)%accshear(j,of) - state(instance)%gamma0(j,of) ! remember current accumulated shear +#ifdef DEBUG + if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i) & + .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then + write(6,'a') 'change of sense!' + write(6,*) deltaState(instance)%sense (j,of), & + deltaState(instance)%chi0(j,of), & + deltaState(instance)%gamma0(j,of) + endif +#endif endif enddo @@ -789,7 +821,7 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) integer(pInt) :: & instance,ph, & f,i,j,k, & - index_Gamma,index_myFamily,index_otherFamily, & + index_myFamily,index_otherFamily, & nSlip, & offset_accshear, & of @@ -803,6 +835,8 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) instance = phase_plasticityInstance(ph) nSlip = plastic_kinehardening_totalNslip(instance) + dotState(instance)%sumGamma(of) = 0.0_pReal + call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & Tstar_v,ph,instance,of) @@ -864,7 +898,7 @@ function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el) instance,ph, of, & nSlip,& o,f,i,c,j,k, & - index_Gamma,index_accshear,index_myFamily + index_myFamily real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & gdot_pos,gdot_neg, & From 2caf8b7ffdc200703a28d12f940c908d55370406 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Mon, 6 Nov 2017 22:10:04 -0500 Subject: [PATCH 11/54] delete extra variable --- src/plastic_kinematichardening.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index c18c4d9ba..37d5041b9 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -582,8 +582,6 @@ subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & integer(pInt) :: & index_myFamily, & f,i,j,k - real(pReal) :: & - tau j = 0_pInt @@ -722,7 +720,9 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) debug_level, & debug_constitutive, & debug_levelExtensive, & - debug_levelSelective + debug_levelSelective, & + debug_e, & + debug_i use material, only: & phaseAt, & phasememberAt, & @@ -758,9 +758,9 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i) & + .and. ((el == debug_e .and. ip == debug_i) & .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'a') '======= kinehardening delta state =======' + write(6,'(a)') '======= kinehardening delta state =======' endif #endif @@ -769,9 +769,9 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) do j = 1,plastic_kinehardening_totalNslip(instance) #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i) & + .and. ((el == debug_e .and. ip == debug_i) & .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'i2,1x,f7.4,1x,f7.4') j,sense(j),state(instance)%sense(j,of) + write(6,'(i2,1x,f7.4,1x,f7.4)') j,sense(j),state(instance)%sense(j,of) endif #endif if (dNeq(sense(j),state(instance)%sense(j,of),0.1_pReal)) then @@ -780,9 +780,9 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) deltaState(instance)%gamma0(j,of) = state(instance)%accshear(j,of) - state(instance)%gamma0(j,of) ! remember current accumulated shear #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((e == debug_e .and. i == debug_i) & + .and. ((el == debug_e .and. ip == debug_i) & .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'a') 'change of sense!' + write(6,'(a)') 'change of sense!' write(6,*) deltaState(instance)%sense (j,of), & deltaState(instance)%chi0(j,of), & deltaState(instance)%gamma0(j,of) From 2b8baa2f01576da2c9074c50059a1bfb23fc30ca Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Tue, 14 Nov 2017 12:25:55 -0500 Subject: [PATCH 12/54] fixed backstress rate of change based on its own slip system evolution and its sense --- src/plastic_kinematichardening.f90 | 139 +++++++++++++++++++---------- 1 file changed, 92 insertions(+), 47 deletions(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 37d5041b9..a82d9066a 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -1,6 +1,6 @@ -!------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Zhuowen Zhao, Michigan State University !> @brief Introducing Voce-type kinematic hardening rule into crystal phenopowerlaw plasticity !! formulation using a power law fitting !-------------------------------------------------------------------------------------------------- @@ -51,6 +51,12 @@ module plastic_kinehardening outputID !< ID of each post result output real(pReal) :: & + ! F0, & +! mu, & +! mu0, & +! tau_hat0, & +! p1, & +! q1, & gdot0, & !< reference shear strain rate for slip (input parameter) n_slip, & !< stress exponent for slip (input parameter) aTolResistance, & @@ -319,7 +325,25 @@ subroutine plastic_kinehardening_init(fileUnit) param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip families +! parameters independent of number of slip families + ! case ('F0') +! param(instance)%F0 = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('mu') +! param(instance)%mu = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('mu0') +! param(instance)%mu0 = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('tau_hat0') +! param(instance)%tau_hat0 = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('p1') +! param(instance)%p1 = IO_floatValue(line,chunkPos,2_pInt) +! +! case ('q1') +! param(instance)%q1 = IO_floatValue(line,chunkPos,2_pInt) + case ('gdot0') param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt) @@ -375,21 +399,6 @@ subroutine plastic_kinehardening_init(fileUnit) extmsg = trim(extmsg)//' ('//PLASTICITY_KINEHARDENING_label//')' ! prepare error message identifier call IO_error(211_pInt,ip=instance,ext_msg=extmsg) endif - - allocate(param(instance)%hardeningMatrix_SlipSlip(nSlip,nSlip), source=0.0_pReal) - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_kinehardening_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_kinehardening_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_kinehardening_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_kinehardening_Nslip(o,instance) ! loop over (active) systems in other family (slip) - param(instance)%hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k) = & - param(instance)%interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase)) - enddo; enddo - enddo; enddo !-------------------------------------------------------------------------------------------------- @@ -455,8 +464,9 @@ subroutine plastic_kinehardening_init(fileUnit) plasticState(phase)%slipRate => & plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) + allocate(param(instance)%hardeningMatrix_SlipSlip(nSlip,nSlip), source=0.0_pReal) do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X index_myFamily = sum(plastic_kinehardening_Nslip(1:f-1_pInt,instance)) do j = 1_pInt,plastic_kinehardening_Nslip(f,instance) ! loop over (active) systems in my family (slip) @@ -601,11 +611,37 @@ subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & enddo slipFamilies gdot_pos = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_pos-state(instance)%crss_back(:,of))/state(instance)%crss(:,of))**param(instance)%n_slip & + (abs(tau_pos-state(instance)%sense(:,of)*state(instance)%crss_back(:,of))/ & + state(instance)%crss(:,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_pos) gdot_neg = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_neg-state(instance)%crss_back(:,of))/state(instance)%crss(:,of))**param(instance)%n_slip & + (abs(tau_neg-state(instance)%sense(:,of)*state(instance)%crss_back(:,of))/ & + state(instance)%crss(:,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_neg) + +! gdot_pos = 0.5_pReal * param(instance)%gdot0 * & +! exp(-param(instance)%F0/(1.38e-23*298.15)* & +! (1-((abs(tau_pos-state(instance)%crss_back(:,of)) & +! -state(instance)%crss(:,of)*param(instance)%mu/param(instance)%mu) / & +! !---------------------------------------------------------------------------- +! param(instance)%tau_hat0*param(instance)%mu/param(instance)%mu & +! )**param(instance)%p1 & +! )**param(instance)%q1 & +! )*sign(1.0_pReal,(tau_pos-state(instance)%crss_back(:,of))) +! +! +! +! gdot_neg = 0.5_pReal * param(instance)%gdot0 * & +! exp(-param(instance)%F0/(1.38e-23*298.15)* & +! (1-((abs(tau_neg-state(instance)%crss_back(:,of)) & +! -state(instance)%crss(:,of)*param(instance)%mu/param(instance)%mu) / & +! !---------------------------------------------------------------------------- +! param(instance)%tau_hat0*param(instance)%mu/param(instance)%mu & +! )**param(instance)%p1 & +! )**param(instance)%q1 & +! )*sign(1.0_pReal,(tau_neg-state(instance)%crss_back(:,of))) + + end subroutine plastic_kinehardening_shearRates @@ -617,9 +653,18 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, & Tstar_v,ipc,ip,el) use prec, only: & dNeq0 + use debug, only: & + debug_level, & + debug_constitutive, & + debug_levelExtensive, & + debug_levelSelective, & + debug_e, & + debug_i, & + debug_g use math, only: & math_Plain3333to99, & - math_Mandel6to33 + math_Mandel6to33, & + math_transpose33 use lattice, only: & lattice_Sslip, & !< schmid matrix lattice_Sslip_v, & @@ -671,6 +716,7 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, & call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & Tstar_v,ph,instance,of) + j = 0_pInt ! reading and marking the starting index for each slip family slipFamilies: do f = 1_pInt,lattice_maxNslipFamily index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family @@ -681,33 +727,37 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, & nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) do k = 1,lattice_NnonSchmid(ph) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k)*& - lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,1) = & + nonSchmid_tensor(1:3,1:3,1) + param(instance)%nonSchmidCoeff(k) * & + lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) + nonSchmid_tensor(1:3,1:3,2) = & + nonSchmid_tensor(1:3,1:3,2) + param(instance)%nonSchmidCoeff(k) * & + lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - Lp = Lp + (gdot_pos(j)+gdot_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! sum of all gdot*SchmidTensor gives Lp + Lp = Lp + (gdot_pos(j)+gdot_neg(j))*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! sum of all gdot*SchmidTensor gives Lp ! Calculation of the tangent of Lp ! sensitivity of Lp if (dNeq0(gdot_pos(j))) then dgdot_dtau_pos = gdot_pos(j)*param(instance)%n_slip/(tau_pos(j)-state(instance)%crss_back(j,of)) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtau_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,1) + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtau_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,1) endif if (dNeq0(gdot_neg(j))) then dgdot_dtau_neg = gdot_neg(j)*param(instance)%n_slip/(tau_neg(j)-state(instance)%crss_back(j,of)) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & - dgdot_dtau_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & - nonSchmid_tensor(m,n,2) + dLp_dTstar3333(k,l,m,n) = & + dLp_dTstar3333(k,l,m,n) + dgdot_dtau_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & + nonSchmid_tensor(m,n,2) endif enddo slipSystems enddo slipFamilies + dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) + end subroutine plastic_kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- @@ -722,7 +772,8 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) debug_levelExtensive, & debug_levelSelective, & debug_e, & - debug_i + debug_i, & + debug_g use material, only: & phaseAt, & phasememberAt, & @@ -758,7 +809,7 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i) & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(a)') '======= kinehardening delta state =======' endif @@ -769,7 +820,7 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) do j = 1,plastic_kinehardening_totalNslip(instance) #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i) & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(i2,1x,f7.4,1x,f7.4)') j,sense(j),state(instance)%sense(j,of) endif @@ -778,16 +829,10 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) deltaState(instance)%sense (j,of) = sense(j) - state(instance)%sense(j,of) ! switch sense deltaState(instance)%chi0 (j,of) = abs(state(instance)%crss_back(j,of)) - state(instance)%chi0(j,of) ! remember current backstress magnitude deltaState(instance)%gamma0(j,of) = state(instance)%accshear(j,of) - state(instance)%gamma0(j,of) ! remember current accumulated shear -#ifdef DEBUG - if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & - .and. ((el == debug_e .and. ip == debug_i) & - .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then - write(6,'(a)') 'change of sense!' - write(6,*) deltaState(instance)%sense (j,of), & - deltaState(instance)%chi0(j,of), & - deltaState(instance)%gamma0(j,of) - endif -#endif + else + deltaState(instance)%sense (j,of) = 0.0_pReal ! no change + deltaState(instance)%chi0 (j,of) = 0.0_pReal + deltaState(instance)%gamma0(j,of) = 0.0_pReal endif enddo @@ -852,7 +897,7 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) *exp(-state(instance)%sumGamma(of)*param(instance)%theta0(f)/param(instance)%tau1(f)) & ! V term depending on the harding law ) dotState(instance)%crss_back(j,of) = & ! evolution of back stress resistance j - dot_product(param(instance)%hardeningMatrix_SlipSlip(j,1:nSlip),abs(gdot_pos+gdot_neg)) * & + state(instance)%sense(j,of)*abs(gdot_pos(j)+gdot_neg(j)) * & ( param(instance)%theta1_b(f) + & (param(instance)%theta0_b(f) - param(instance)%theta1_b(f) & + param(instance)%theta0_b(f)*param(instance)%theta1_b(f)/(param(instance)%tau1_b(f)+state(instance)%chi0(j,of)) & From dcf9e139d0d603d3245b9b95c518c6c703cc8d56 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Wed, 13 Dec 2017 19:18:45 -0500 Subject: [PATCH 13/54] question marks on those files --- src/DAMASK_spectral.f90 | 82 +++++++++++++++++++------------------ src/crystallite.f90 | 70 +++++++++++++++++++++++-------- src/spectral_mech_Basic.f90 | 39 +++++++++--------- 3 files changed, 114 insertions(+), 77 deletions(-) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index f32bfb7b3..39eb77bc7 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -442,8 +442,9 @@ program DAMASK_spectral if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') if (.not. appendToOutFile) then ! if not restarting, write 0th increment + write(6,'(1/,a)') ' ... writing initial configuration to file ........................' do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & + outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(resUnit, & reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & @@ -453,7 +454,6 @@ program DAMASK_spectral if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position - write(6,'(1/,a)') ' ... writing initial configuration to file ........................' endif !-------------------------------------------------------------------------------------------------- ! loopping over loadcases @@ -487,19 +487,22 @@ program DAMASK_spectral endif endif timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step - - forwarding: if (totalIncsCounter >= restartInc) then - stepFraction = 0_pInt + ! QUESTION: what happens to inc-counter when cutbacklevel is not zero? not clear where half an inc gets incremented..? + skipping: if (totalIncsCounter < restartInc) then ! not yet at restart inc? + time = time + timeinc ! just advance time, skip already performed calculation + guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference + else skipping + stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel !-------------------------------------------------------------------------------------------------- -! loop over sub incs - subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt) - time = time + timeinc ! forward time - stepFraction = stepFraction + 1_pInt - remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc +! loop over sub step + subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) + remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time + time = time + timeinc ! forward target time + stepFraction = stepFraction + 1_pInt ! count step !-------------------------------------------------------------------------------------------------- -! report begin of new increment +! report begin of new step write(6,'(/,a)') ' ###########################################################################' write(6,'(1x,a,es12.5'//& ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& @@ -582,33 +585,33 @@ program DAMASK_spectral solres(field) = spectral_damage_solution(timeinc,timeIncOld,remainingLoadCaseTime) end select + if (.not. solres(field)%converged) exit ! no solution found + enddo stagIter = stagIter + 1_pInt - stagIterate = stagIter < stagItMax .and. & - all(solres(:)%converged) .and. & - .not. all(solres(:)%stagConverged) + stagIterate = stagIter < stagItMax & + .and. all(solres(:)%converged) & + .and. .not. all(solres(:)%stagConverged) enddo !-------------------------------------------------------------------------------------------------- ! check solution cutBack = .False. - if(solres(1)%termIll .or. .not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found - if (cutBackLevel < maxCutBack) then ! do cut back - write(6,'(/,a)') ' cut back detected' - cutBack = .True. + + if (solres(1)%termIll & + .or. .not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found + ! QUESTION: why termIll checked only for first field? only one that can be mechanic? + if (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? + write(6,'(/,a)') ' cutting back ' + cutBack = .true. stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator cutBackLevel = cutBackLevel + 1_pInt time = time - timeinc ! rewind time timeinc = timeinc/2.0_pReal - elseif (solres(1)%termIll) then ! material point model cannot find a solution, exit in any casy - call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) - close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written - elseif (continueCalculation == 1_pInt) then + elseif (continueCalculation == 1_pInt .and. .not. solres(1)%termIll) then guess = .true. ! accept non converged BVP solution - else ! default behavior, exit if spectral solver does not converge + else ! material point model cannot find a solution call IO_warning(850_pInt) call MPI_file_close(resUnit,ierr) close(statUnit) @@ -617,6 +620,7 @@ program DAMASK_spectral else guess = .true. ! start guessing after first converged (sub)inc endif + if (.not. cutBack) then if (worldrank == 0) then write(statUnit,*) totalIncsCounter, time, cutBackLevel, & @@ -624,23 +628,26 @@ program DAMASK_spectral flush(statUnit) endif endif - enddo subIncLooping + enddo subStepLooping + cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc - if(all(solres(:)%converged)) then ! report converged inc + + if (all(solres(:)%converged)) then convergedCounter = convergedCounter + 1_pInt - write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc ' increment ', totalIncsCounter, ' converged' else - write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc - ' increment ', totalIncsCounter, ' NOT converged' notConvergedCounter = notConvergedCounter + 1_pInt + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc + ' increment ', totalIncsCounter, ' NOT converged' endif; flush(6) + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency if (worldrank == 0) & write(6,'(1/,a)') ' ... writing results to file ......................................' call materialpoint_postResults() call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') + if (ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) @@ -652,15 +659,12 @@ program DAMASK_spectral enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif - if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving - mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! first call to CPFEM_general will write? - restartWrite = .true. - lastRestartWritten = inc + if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + restartWrite = .true. ! set restart parameter for FEsolving + lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif - else forwarding - time = time + timeinc - guess = .true. - endif forwarding + endif skipping enddo incLooping enddo loadCaseLooping diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 2f451d953..5a8919b79 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -986,7 +986,9 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) !$OMP FLUSH(crystallite_todo) #ifdef DEBUG - if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & + .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & + .or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then if (crystallite_todo(c,i,e)) then write(6,'(a,f12.8,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent & &with new crystallite_subStep: ',& @@ -1047,6 +1049,11 @@ subroutine crystallite_stressAndItsTangent(updateJaco) write(6,'(a,f8.5)') '<< CRYST >> min(subFrac) ',minval(crystallite_subFrac) write(6,'(a,f8.5,/)') '<< CRYST >> max(subFrac) ',maxval(crystallite_subFrac) flush(6) + if (iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt) then + write(6,'(/,a,f8.5,1x,a,1x,f8.5,1x,a)') '<< CRYST >> subFrac + subStep = ',& + crystallite_subFrac(debug_g,debug_i,debug_e),'+',crystallite_subStep(debug_g,debug_i,debug_e),'@selective' + flush(6) + endif endif ! --- integrate --- requires fully defined state array (basic + dependent state) @@ -2752,7 +2759,7 @@ subroutine crystallite_integrateStateFPI() enddo if (NaN) then ! NaN occured in any dotState if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,*) '<< CRYST >> ',plasticState(p)%dotState(:,c) + write(6,*) '<< CRYST >> dotstate ',plasticState(p)%dotState(:,c) if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a non-local... !$OMP CRITICAL (checkTodo) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) @@ -2831,9 +2838,6 @@ subroutine crystallite_integrateStateFPI() 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 !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - - - crystallite_todo(g,i,e) = crystallite_integrateStress(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! broken non-local... @@ -2984,8 +2988,11 @@ subroutine crystallite_integrateStateFPI() .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3,/)') '<< CRYST >> update state at el ip g ',e,i,g write(6,'(a,f6.1,/)') '<< CRYST >> plasticstatedamper ',plasticStatedamper - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> plastic state residuum',plasticStateResiduum(1:mySizePlasticDotState) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> plastic state residuum',& + abs(plasticStateResiduum(1:mySizePlasticDotState)) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> abstol dotstate',plasticState(p)%aTolState(1:mySizePlasticDotState) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> reltol dotstate',rTol_crystalliteState* & + abs(tempPlasticState(1:mySizePlasticDotState)) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state',tempPlasticState(1:mySizePlasticDotState) endif #endif @@ -3202,9 +3209,9 @@ end function crystallite_push33ToRef !> intermediate acceleration of the Newton-Raphson correction !-------------------------------------------------------------------------------------------------- logical function crystallite_integrateStress(& - ipc,& ! grain number - ip,& ! integration point number - el,& ! element number + ipc,& ! grain number + ip,& ! integration point number + el,& ! element number timeFraction & ) use, intrinsic :: & @@ -3255,10 +3262,10 @@ logical function crystallite_integrateStress(& use mesh, only: mesh_element implicit none - integer(pInt), intent(in):: el, & ! element index - ip, & ! integration point index - ipc ! grain index - real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep + integer(pInt), intent(in):: el, & ! element index + ip, & ! integration point index + ipc ! grain index + real(pReal), optional, intent(in) :: timeFraction ! fraction of timestep !*** local variables ***! real(pReal), dimension(3,3):: Fg_new, & ! deformation gradient at end of timestep @@ -3419,7 +3426,7 @@ logical function crystallite_integrateStress(& #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached loop limit',nStress, & - ' at el (elFE) ip ipc ', el,mesh_element(1,el),ip,ipc + ' at el (elFE) ip ipc ', el,'(',mesh_element(1,el),')',ip,ipc #endif return endif loopsExeced @@ -3428,7 +3435,8 @@ logical function crystallite_integrateStress(& B = math_I3 - dt*Lpguess Fe = math_mul33x33(math_mul33x33(A,B), invFi_new) ! current elastic deformation tensor - call constitutive_TandItsTangent(Tstar, dT_dFe3333, dT_dFi3333, Fe, Fi_new, ipc, ip, el) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration + call constitutive_TandItsTangent(Tstar, dT_dFe3333, dT_dFi3333, & + Fe, Fi_new, ipc, ip, el) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration Tstar_v = math_Mandel33to6(Tstar) !* calculate plastic velocity gradient and its tangent from constitutive law @@ -3436,6 +3444,17 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) +#ifdef DEBUG + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & + .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', math_transpose33(Fi_new) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', math_transpose33(Fe) + write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v + endif +#endif call constitutive_LpAndItsTangent(Lp_constitutive, dLp_dT3333, dLp_dFi3333, & Tstar_v, Fi_new, ipc, ip, el) @@ -3453,9 +3472,7 @@ logical function crystallite_integrateStress(& if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then - write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) - write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess) + write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive) endif #endif @@ -3485,6 +3502,13 @@ logical function crystallite_integrateStress(& else ! not converged and residuum not improved... steplengthLp = subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction Lpguess = Lpguess_old + steplengthLp * deltaLp +#ifdef DEBUG + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & + .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,1x,f7.4)') '<< CRYST >> linear search for Lpguess with step', steplengthLp + endif +#endif cycle LpLoop endif @@ -3498,6 +3522,16 @@ logical function crystallite_integrateStress(& dFe_dLp3333 = - dt * dFe_dLp3333 dRLp_dLp = math_identity2nd(9_pInt) & - math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dT3333,dT_dFe3333),dFe_dLp3333)) +#ifdef DEBUG + if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & + .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & + .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then + write(6,'(a,/,9(12x,9(e12.4,1x)/))') '<< CRYST >> dLp_dT', math_Plain3333to99(dLp_dT3333) + write(6,'(a,1x,e20.10)') '<< CRYST >> dLp_dT norm', norm2(math_Plain3333to99(dLp_dT3333)) + write(6,'(a,/,9(12x,9(e12.4,1x)/))') '<< CRYST >> dRLp_dLp', dRLp_dLp - math_identity2nd(9_pInt) + write(6,'(a,1x,e20.10)') '<< CRYST >> dRLp_dLp norm', norm2(dRLp_dLp - math_identity2nd(9_pInt)) + endif +#endif dRLp_dLp2 = dRLp_dLp ! will be overwritten in first call to LAPACK routine work = math_plain33to9(residuumLp) call dgesv(9,1,dRLp_dLp2,9,ipiv,work,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 55403ee7c..ea6526091 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -196,8 +196,9 @@ subroutine basicPETSc_init .false., & math_I3) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc + ! QUESTION: why not writing back right after reading (l.189)? - restartRead: if (restartInc > 1_pInt) then + restartRead: if (restartInc > 1_pInt) then ! QUESTION: are those values not calc'ed by constitutiveResponse? why reading from file? if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading more values of increment', restartInc - 1_pInt, 'from file' @@ -220,8 +221,7 @@ end subroutine basicPETSc_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the Basic PETSC scheme with internal iterations !-------------------------------------------------------------------------------------------------- -type(tSolutionState) function & - basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) +type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) use IO, only: & IO_error use numerics, only: & @@ -283,9 +283,8 @@ type(tSolutionState) function & CHKERRQ(ierr) basicPETSc_solution%termIll = terminallyIll terminallyIll = .false. - BasicPETSc_solution%converged =.true. if (reason == -4) call IO_error(893_pInt) - if (reason < 1) basicPETSC_solution%converged = .false. + BasicPETSc_solution%converged = reason > 0 basicPETSC_solution%iterationsNeeded = totalIter end function BasicPETSc_solution @@ -343,8 +342,8 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment - newIteration: if(totalIter <= PETScIter) then + if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment + newIteration: if (totalIter <= PETScIter) then !-------------------------------------------------------------------------------------------------- ! report begin of new iteration totalIter = totalIter + 1_pInt @@ -480,10 +479,10 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation character(len=1024) :: rankStr - call DMDAVecGetArrayF90(da,solution_vec,F,ierr) + call DMDAVecGetArrayF90(da,solution_vec,F,ierr) ! get F from PETSc data structure !-------------------------------------------------------------------------------------------------- ! restart information for spectral solver - if (restartWrite) then + if (restartWrite) then ! QUESTION: where is this logical properly set? write(6,'(/,a)') ' writing converged results for restart' flush(6) write(rankStr,'(a1,i0)')'_',worldrank @@ -506,23 +505,23 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation endif endif - call utilities_updateIPcoords(F) + call utilities_updateIPcoords(F) ! QUESTION: why do this even when cutback happened?? - if (cutBack) then - F_aim = F_aim_lastInc - F = reshape(F_lastInc, [9,grid(1),grid(2),grid3]) + if (cutBack) then ! reset to former inc's values + F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) ! QUESTION: purpose of resetting this when updating in line 541? + F_aim = F_aim_lastInc C_volAvg = C_volAvgLastInc else - ForwardData = .True. + ForwardData = .true. ! QUESTION: who is resetting this? C_volAvgLastInc = C_volAvg !-------------------------------------------------------------------------------------------------- ! calculate rate for aim - if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F + if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim) - elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed + elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed f_aimDot = deformation_BC%maskFloat * deformation_BC%values - elseif(deformation_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = deformation_BC%maskFloat * (deformation_BC%values -F_aim)/loadCaseTime + elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed + f_aimDot = deformation_BC%maskFloat * (deformation_BC%values - F_aim)/loadCaseTime endif if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old F_aim_lastInc = F_aim @@ -531,8 +530,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation ! update coordinates and rate and forward last inc call utilities_updateIPcoords(F) Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) + timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) ! QUESTION: what do we need Fdot for and why is it not restored at cutback? + F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3]) endif F_aim = F_aim + f_aimDot * timeinc From 14c0503a7e1ffc0141553cc8728edcce97808b40 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Thu, 14 Dec 2017 16:51:58 -0500 Subject: [PATCH 14/54] change tag to all lowercase; make pheno hardeing only depend on its own system --- src/plastic_kinematichardening.f90 | 8 ++++---- src/plastic_phenopowerlaw.f90 | 16 +++++++++------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index a82d9066a..3bd35aaea 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -1,7 +1,7 @@ !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Zhuowen Zhao, Michigan State University -!> @brief Introducing Voce-type kinematic hardening rule into crystal phenopowerlaw plasticity +!> @brief Introducing Voce-type kinematic hardening rule into crystal plasticity !! formulation using a power law fitting !-------------------------------------------------------------------------------------------------- module plastic_kinehardening @@ -318,7 +318,7 @@ subroutine plastic_kinehardening_init(fileUnit) do j = 1_pInt, Nchunks_SlipSlip param(instance)%interaction_slipslip(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo - case ('nonSchmidCoeff') + case ('nonschmidcoeff') if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_KINEHARDENING_label//')') do j = 1_pInt,Nchunks_nonSchmid @@ -350,10 +350,10 @@ subroutine plastic_kinehardening_init(fileUnit) case ('n_slip') param(instance)%n_slip = IO_floatValue(line,chunkPos,2_pInt) - case ('aTolResistance') + case ('atol_resistance') param(instance)%aTolResistance = IO_floatValue(line,chunkPos,2_pInt) - case ('aTolShear') + case ('atol_shear') param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt) case default diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 319f1b585..facc76ff1 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -987,13 +987,15 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + plastic_phenopowerlaw_H_int(f,instance) ! modified no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenopowerlaw_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) + left_SlipSlip(j) = (1.0_pReal + plastic_phenopowerlaw_H_int(f,instance)) & + *abs(1.0_pReal-plasticState(ph)%state(j,of) / & ! no system-dependent left part + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & + **plastic_phenopowerlaw_a_slip(instance)& + *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) + left_SlipTwin(j) = 1.0_pReal + right_SlipSlip(j) = 1.0_pReal ! system-dependent part (beta summation) + right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- From 88376568707bb07eaf13099cddc788b5b0d4ab4f Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Tue, 9 Jan 2018 15:17:51 -0500 Subject: [PATCH 15/54] added "plastic_kinematichardeing.f90" to commercialFEM_fileList Changed outputID type --- src/commercialFEM_fileList.f90 | 1 + src/plastic_kinematichardening.f90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 51848ece5..f57f03467 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -28,6 +28,7 @@ #include "plastic_none.f90" #include "plastic_isotropic.f90" #include "plastic_phenopowerlaw.f90" +#include "plastic_kinematichardening.f90" #include "plastic_dislotwin.f90" #include "plastic_disloUCLA.f90" #include "plastic_nonlocal.f90" diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 3bd35aaea..04ac60b9e 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -226,8 +226,8 @@ subroutine plastic_kinehardening_init(fileUnit) Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) - allocate(param(instance)%outputID(phase_Noutput(phase)), source=0_pInt) ! allocate space for IDs of every requested output - allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal) + allocate(param(instance)%outputID(phase_Noutput(phase)), source=0) ! allocate space for IDs of every requested output + allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%theta0 (Nchunks_SlipFamilies), source=0.0_pReal) From bc9c647aadb4abfb628818a85850a9f2172bf7a2 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Tue, 9 Jan 2018 17:25:16 -0500 Subject: [PATCH 16/54] assign outputID type to undifined --- src/plastic_kinematichardening.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 04ac60b9e..c457c1344 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -226,7 +226,7 @@ subroutine plastic_kinehardening_init(fileUnit) Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) Nchunks_nonSchmid = lattice_NnonSchmid(phase) - allocate(param(instance)%outputID(phase_Noutput(phase)), source=0) ! allocate space for IDs of every requested output + allocate(param(instance)%outputID(phase_Noutput(phase)), source=undefined_ID) ! allocate space for IDs of every requested output allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal) allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal) From 93073ed6616f230069b8499aaf7aa5d4b049fb43 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 18 Jan 2018 10:47:52 -0500 Subject: [PATCH 17/54] summarized multiple logicals into one --- src/homogenization.f90 | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 5a30a72c8..2f4124c2b 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -16,7 +16,7 @@ module homogenization ! General variables for the homogenization at a material point implicit none private - real(pReal), dimension(:,:,:,:), allocatable, public :: & + real(pReal), dimension(:,:,:,:), allocatable, public :: & materialpoint_F0, & !< def grad of IP at start of FE increment materialpoint_F, & !< def grad of IP to be reached at end of FE increment materialpoint_P !< first P--K stress of IP @@ -128,7 +128,7 @@ subroutine homogenization_init integer(pInt), dimension(:) , pointer :: thisNoutput character(len=64), dimension(:,:), pointer :: thisOutput character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready - logical :: knownHomogenization, knownThermal, knownDamage, knownVacancyflux, knownPorosity, knownHydrogenflux + logical :: valid !-------------------------------------------------------------------------------------------------- @@ -199,7 +199,7 @@ subroutine homogenization_init do p = 1,material_Nhomogenization if (any(material_homog == p)) then i = homogenization_typeInstance(p) ! which instance of this homogenization type - knownHomogenization = .true. ! assume valid + valid = .true. ! assume valid select case(homogenization_type(p)) ! split per homogenization type case (HOMOGENIZATION_NONE_ID) outputName = HOMOGENIZATION_NONE_label @@ -217,10 +217,10 @@ subroutine homogenization_init thisOutput => homogenization_RGC_output thisSize => homogenization_RGC_sizePostResult case default - knownHomogenization = .false. + valid = .false. end select write(FILEUNIT,'(/,a,/)') '['//trim(homogenization_name(p))//']' - if (knownHomogenization) then + if (valid) then write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName) write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p) if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then @@ -230,7 +230,7 @@ subroutine homogenization_init endif endif i = thermal_typeInstance(p) ! which instance of this thermal type - knownThermal = .true. ! assume valid + valid = .true. ! assume valid select case(thermal_type(p)) ! split per thermal type case (THERMAL_isothermal_ID) outputName = THERMAL_isothermal_label @@ -248,9 +248,9 @@ subroutine homogenization_init thisOutput => thermal_conduction_output thisSize => thermal_conduction_sizePostResult case default - knownThermal = .false. + valid = .false. end select - if (knownThermal) then + if (valid) then write(FILEUNIT,'(a)') '(thermal)'//char(9)//trim(outputName) if (thermal_type(p) /= THERMAL_isothermal_ID) then do e = 1,thisNoutput(i) @@ -259,7 +259,7 @@ subroutine homogenization_init endif endif i = damage_typeInstance(p) ! which instance of this damage type - knownDamage = .true. ! assume valid + valid = .true. ! assume valid select case(damage_type(p)) ! split per damage type case (DAMAGE_none_ID) outputName = DAMAGE_none_label @@ -277,9 +277,9 @@ subroutine homogenization_init thisOutput => damage_nonlocal_output thisSize => damage_nonlocal_sizePostResult case default - knownDamage = .false. + valid = .false. end select - if (knownDamage) then + if (valid) then write(FILEUNIT,'(a)') '(damage)'//char(9)//trim(outputName) if (damage_type(p) /= DAMAGE_none_ID) then do e = 1,thisNoutput(i) @@ -288,7 +288,7 @@ subroutine homogenization_init endif endif i = vacancyflux_typeInstance(p) ! which instance of this vacancy flux type - knownVacancyflux = .true. ! assume valid + valid = .true. ! assume valid select case(vacancyflux_type(p)) ! split per vacancy flux type case (VACANCYFLUX_isoconc_ID) outputName = VACANCYFLUX_isoconc_label @@ -306,9 +306,9 @@ subroutine homogenization_init thisOutput => vacancyflux_cahnhilliard_output thisSize => vacancyflux_cahnhilliard_sizePostResult case default - knownVacancyflux = .false. + valid = .false. end select - if (knownVacancyflux) then + if (valid) then write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName) if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then do e = 1,thisNoutput(i) @@ -317,7 +317,7 @@ subroutine homogenization_init endif endif i = porosity_typeInstance(p) ! which instance of this porosity type - knownPorosity = .true. ! assume valid + valid = .true. ! assume valid select case(porosity_type(p)) ! split per porosity type case (POROSITY_none_ID) outputName = POROSITY_none_label @@ -330,9 +330,9 @@ subroutine homogenization_init thisOutput => porosity_phasefield_output thisSize => porosity_phasefield_sizePostResult case default - knownPorosity = .false. + valid = .false. end select - if (knownPorosity) then + if (valid) then write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName) if (porosity_type(p) /= POROSITY_none_ID) then do e = 1,thisNoutput(i) @@ -341,7 +341,7 @@ subroutine homogenization_init endif endif i = hydrogenflux_typeInstance(p) ! which instance of this hydrogen flux type - knownHydrogenflux = .true. ! assume valid + valid = .true. ! assume valid select case(hydrogenflux_type(p)) ! split per hydrogen flux type case (HYDROGENFLUX_isoconc_ID) outputName = HYDROGENFLUX_isoconc_label @@ -354,9 +354,9 @@ subroutine homogenization_init thisOutput => hydrogenflux_cahnhilliard_output thisSize => hydrogenflux_cahnhilliard_sizePostResult case default - knownHydrogenflux = .false. + valid = .false. end select - if (knownHydrogenflux) then + if (valid) then write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName) if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then do e = 1,thisNoutput(i) From b36151cc32f1c7f0b5e7225e65ef825a15fc8791 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 18 Jan 2018 11:14:06 -0500 Subject: [PATCH 18/54] fixing spectral cutback hiccup and multiple cleanups flush(6) at better places, added dedicated CPFEM_age subroutine, cleaned up cutback logic, fixed broken assignment of old timeinc, continueCalculation is now a logical, rearrnaged interfaces for utilities_constitutiveResponse and utilities_calculateRate, handling of stressBC more understandable, added more comments and explanations --- src/CPFEM.f90 | 3 +- src/CPFEM2.f90 | 158 +++++++------- src/DAMASK_spectral.f90 | 122 +++++------ src/numerics.f90 | 14 +- src/spectral_mech_AL.f90 | 30 +-- src/spectral_mech_Basic.f90 | 321 +++++++++++++++-------------- src/spectral_mech_Polarisation.f90 | 32 ++- src/spectral_utilities.f90 | 111 +++++----- 8 files changed, 381 insertions(+), 410 deletions(-) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b3848a9eb..e34b5baa8 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -162,6 +162,7 @@ subroutine CPFEM_init write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + flush(6) endif mainProcess ! initialize stress and jacobian to zero @@ -242,8 +243,8 @@ subroutine CPFEM_init write(6,'(a32,1x,6(i8,1x))') 'CPFEM_dcsdE: ', shape(CPFEM_dcsdE) write(6,'(a32,1x,6(i8,1x),/)') 'CPFEM_dcsdE_knownGood: ', shape(CPFEM_dcsdE_knownGood) write(6,'(a32,l1)') 'symmetricSolver: ', symmetricSolver + flush(6) endif - flush(6) end subroutine CPFEM_init diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 0ac916046..a16aee54f 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -9,7 +9,7 @@ module CPFEM2 private public :: & - CPFEM_general, & + CPFEM_age, & CPFEM_initAll contains @@ -127,6 +127,7 @@ subroutine CPFEM_init write(6,'(/,a)') ' <<<+- CPFEM init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + flush(6) endif mainProcess ! *** restore the last converged values of each essential variable from the binary file @@ -194,7 +195,6 @@ subroutine CPFEM_init restartRead = .false. endif - flush(6) end subroutine CPFEM_init @@ -202,7 +202,7 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- !> @brief perform initialization at first call, update variables and call the actual material model !-------------------------------------------------------------------------------------------------- -subroutine CPFEM_general(age, dt) +subroutine CPFEM_age() use prec, only: & pReal, & pInt @@ -215,7 +215,6 @@ subroutine CPFEM_general(age, dt) debug_levelExtensive, & debug_levelSelective use FEsolving, only: & - terminallyIll, & restartWrite use math, only: & math_identity2nd, & @@ -254,114 +253,99 @@ subroutine CPFEM_general(age, dt) crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v - use homogenization, only: & - materialpoint_stressAndItsTangent, & - materialpoint_postResults use IO, only: & IO_write_jobRealFile, & IO_warning use DAMASK_interface implicit none - real(pReal), intent(in) :: dt !< time increment - logical, intent(in) :: age !< age results integer(pInt) :: i, k, l, m, ph, homog, mySource - character(len=1024) :: rankStr + character(len=32) :: rankStr - !*** age results and write restart data if requested - if (age) then - crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) - crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation - crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity - crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation - crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity - crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness - crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress +if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> aging states' - forall ( i = 1:size(plasticState )) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array - do i = 1, size(sourceState) - do mySource = 1,phase_Nsources(i) - sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array - enddo; enddo - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> aging states' +crystallite_F0 = crystallite_partionedF ! crystallite deformation (_subF is perturbed...) +crystallite_Fp0 = crystallite_Fp ! crystallite plastic deformation +crystallite_Lp0 = crystallite_Lp ! crystallite plastic velocity +crystallite_Fi0 = crystallite_Fi ! crystallite intermediate deformation +crystallite_Li0 = crystallite_Li ! crystallite intermediate velocity +crystallite_dPdF0 = crystallite_dPdF ! crystallite stiffness +crystallite_Tstar0_v = crystallite_Tstar_v ! crystallite 2nd Piola Kirchhoff stress - do homog = 1_pInt, material_Nhomogenization - homogState (homog)%state0 = homogState (homog)%state - thermalState (homog)%state0 = thermalState (homog)%state - damageState (homog)%state0 = damageState (homog)%state - vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state - hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state - enddo +forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array +do i = 1, size(sourceState) + do mySource = 1,phase_Nsources(i) + sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array +enddo; enddo - if (restartWrite) then - if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & - write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' - - write(rankStr,'(a1,i0)')'_',worldrank +do homog = 1_pInt, material_Nhomogenization + homogState (homog)%state0 = homogState (homog)%state + thermalState (homog)%state0 = thermalState (homog)%state + damageState (homog)%state0 = damageState (homog)%state + vacancyfluxState (homog)%state0 = vacancyfluxState (homog)%state + hydrogenfluxState(homog)%state0 = hydrogenfluxState(homog)%state +enddo - call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) - write (777,rec=1) material_phase - close (777) +if (restartWrite) then + if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> writing state variables of last converged step to binary files' - call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) - write (777,rec=1) crystallite_F0 - close (777) + write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) - write (777,rec=1) crystallite_Fp0 - close (777) + call IO_write_jobRealFile(777,'recordedPhase'//trim(rankStr),size(material_phase)) + write (777,rec=1) material_phase; close (777) - call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) - write (777,rec=1) crystallite_Fi0 - close (777) + call IO_write_jobRealFile(777,'convergedF'//trim(rankStr),size(crystallite_F0)) + write (777,rec=1) crystallite_F0; close (777) - call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) - write (777,rec=1) crystallite_Lp0 - close (777) + call IO_write_jobRealFile(777,'convergedFp'//trim(rankStr),size(crystallite_Fp0)) + write (777,rec=1) crystallite_Fp0; close (777) - call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) - write (777,rec=1) crystallite_Li0 - close (777) + call IO_write_jobRealFile(777,'convergedFi'//trim(rankStr),size(crystallite_Fi0)) + write (777,rec=1) crystallite_Fi0; close (777) - call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0)) - write (777,rec=1) crystallite_dPdF0 - close (777) + call IO_write_jobRealFile(777,'convergedLp'//trim(rankStr),size(crystallite_Lp0)) + write (777,rec=1) crystallite_Lp0; close (777) - call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) - write (777,rec=1) crystallite_Tstar0_v - close (777) + call IO_write_jobRealFile(777,'convergedLi'//trim(rankStr),size(crystallite_Li0)) + write (777,rec=1) crystallite_Li0; close (777) - call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) - m = 0_pInt - writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) - do k = 1_pInt, plasticState(ph)%sizeState - do l = 1, size(plasticState(ph)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) plasticState(ph)%state0(k,l) - enddo; enddo - enddo writePlasticityInstances - close (777) + call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0)) + write (777,rec=1) crystallite_dPdF0; close (777) - call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) - m = 0_pInt - writeHomogInstances: do homog = 1_pInt, material_Nhomogenization - do k = 1_pInt, homogState(homog)%sizeState - do l = 1, size(homogState(homog)%state0(1,:)) - m = m+1_pInt - write(777,rec=m) homogState(homog)%state0(k,l) - enddo; enddo - enddo writeHomogInstances - close (777) + call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v)) + write (777,rec=1) crystallite_Tstar0_v; close (777) - endif - endif + call IO_write_jobRealFile(777,'convergedStateConst'//trim(rankStr)) + m = 0_pInt + writePlasticityInstances: do ph = 1_pInt, size(phase_plasticity) + do k = 1_pInt, plasticState(ph)%sizeState + do l = 1, size(plasticState(ph)%state0(1,:)) + m = m+1_pInt + write(777,rec=m) plasticState(ph)%state0(k,l) + enddo; enddo + enddo writePlasticityInstances + close (777) - if (.not. terminallyIll) & - call materialpoint_stressAndItsTangent(.True., dt) + call IO_write_jobRealFile(777,'convergedStateHomog'//trim(rankStr)) + m = 0_pInt + writeHomogInstances: do homog = 1_pInt, material_Nhomogenization + do k = 1_pInt, homogState(homog)%sizeState + do l = 1, size(homogState(homog)%state0(1,:)) + m = m+1_pInt + write(777,rec=m) homogState(homog)%state0(k,l) + enddo; enddo + enddo writeHomogInstances + close (777) -end subroutine CPFEM_general +endif + +if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) & + write(6,'(a)') '<< CPFEM >> done aging states' + +end subroutine CPFEM_age end module CPFEM2 diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index f32bfb7b3..ac3fbf5a2 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -442,8 +442,9 @@ program DAMASK_spectral if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') if (.not. appendToOutFile) then ! if not restarting, write 0th increment + write(6,'(1/,a)') ' ... writing initial configuration to file ........................' do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output - outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & + outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(resUnit, & reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & @@ -453,24 +454,23 @@ program DAMASK_spectral if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position - write(6,'(1/,a)') ' ... writing initial configuration to file ........................' endif !-------------------------------------------------------------------------------------------------- -! loopping over loadcases +! looping over loadcases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) time0 = time ! currentLoadCase start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc !-------------------------------------------------------------------------------------------------- -! loop oper incs defined in input file for current currentLoadCase +! loop over incs defined in input file for current currentLoadCase incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs totalIncsCounter = totalIncsCounter + 1_pInt !-------------------------------------------------------------------------------------------------- ! forwarding time - timeIncOld = timeinc + timeIncOld = timeinc ! last timeinc that brought former inc to an end if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale - timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used + timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale @@ -486,20 +486,23 @@ program DAMASK_spectral real(loadCases(currentLoadCase)%incs ,pReal))) endif endif - timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step + timeinc = timeinc / real(subStepFactor,pReal)**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step - forwarding: if (totalIncsCounter >= restartInc) then - stepFraction = 0_pInt + skipping: if (totalIncsCounter < restartInc) then ! not yet at restart inc? + time = time + timeinc ! just advance time, skip already performed calculation + guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference + else skipping + stepFraction = 0_pInt ! fraction scaled by stepFactor**cutLevel !-------------------------------------------------------------------------------------------------- -! loop over sub incs - subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt) - time = time + timeinc ! forward time - stepFraction = stepFraction + 1_pInt - remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc +! loop over sub step + subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel) + remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time + time = time + timeinc ! forward target time + stepFraction = stepFraction + 1_pInt ! count step !-------------------------------------------------------------------------------------------------- -! report begin of new increment +! report begin of new step write(6,'(/,a)') ' ###########################################################################' write(6,'(1x,a,es12.5'//& ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& @@ -509,11 +512,11 @@ program DAMASK_spectral 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& '-', stepFraction, '/', subStepFactor**cutBackLevel,& ' of load case ', currentLoadCase,'/',size(loadCases) - flush(6) write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//& ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& '-',stepFraction, '/', subStepFactor**cutBackLevel + flush(6) !-------------------------------------------------------------------------------------------------- ! forward fields @@ -542,7 +545,7 @@ program DAMASK_spectral end select case(FIELD_THERMAL_ID); call spectral_thermal_forward() - case(FIELD_DAMAGE_ID); call spectral_damage_forward() + case(FIELD_DAMAGE_ID); call spectral_damage_forward() end select enddo @@ -582,65 +585,64 @@ program DAMASK_spectral solres(field) = spectral_damage_solution(timeinc,timeIncOld,remainingLoadCaseTime) end select + if (.not. solres(field)%converged) exit ! no solution found + enddo stagIter = stagIter + 1_pInt - stagIterate = stagIter < stagItMax .and. & - all(solres(:)%converged) .and. & - .not. all(solres(:)%stagConverged) + stagIterate = stagIter < stagItMax & + .and. all(solres(:)%converged) & + .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration enddo !-------------------------------------------------------------------------------------------------- -! check solution - cutBack = .False. - if(solres(1)%termIll .or. .not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found - if (cutBackLevel < maxCutBack) then ! do cut back - write(6,'(/,a)') ' cut back detected' - cutBack = .True. - stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator - cutBackLevel = cutBackLevel + 1_pInt - time = time - timeinc ! rewind time - timeinc = timeinc/2.0_pReal - elseif (solres(1)%termIll) then ! material point model cannot find a solution, exit in any casy - call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) - close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written - elseif (continueCalculation == 1_pInt) then - guess = .true. ! accept non converged BVP solution - else ! default behavior, exit if spectral solver does not converge - call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) - close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written - endif - else +! check solution for either advance or retry + + if ( (continueCalculation .or. all(solres(:)%converged .and. solres(:)%stagConverged)) & ! don't care or did converge + .and. .not. solres(1)%termIll) then ! and acceptable solution found + timeIncOld = timeinc + cutBack = .false. guess = .true. ! start guessing after first converged (sub)inc - endif - if (.not. cutBack) then if (worldrank == 0) then write(statUnit,*) totalIncsCounter, time, cutBackLevel, & - solres%converged, solres%iterationsNeeded ! write statistics about accepted solution + solres%converged, solres%iterationsNeeded flush(statUnit) endif + elseif (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? + cutBack = .true. + stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1_pInt + time = time - timeinc ! rewind time + timeinc = timeinc/real(subStepFactor,pReal) ! cut timestep + write(6,'(/,a)') ' cutting back ' + else ! no more options to continue + call IO_warning(850_pInt) + call MPI_file_close(resUnit,ierr) + close(statUnit) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif - enddo subIncLooping + + enddo subStepLooping + cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc - if(all(solres(:)%converged)) then ! report converged inc + + if (all(solres(:)%converged)) then convergedCounter = convergedCounter + 1_pInt - write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report converged inc ' increment ', totalIncsCounter, ' converged' else - write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc - ' increment ', totalIncsCounter, ' NOT converged' notConvergedCounter = notConvergedCounter + 1_pInt + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc + ' increment ', totalIncsCounter, ' NOT converged' endif; flush(6) + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency if (worldrank == 0) & write(6,'(1/,a)') ' ... writing results to file ......................................' + flush(6) call materialpoint_postResults() call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) @@ -652,15 +654,12 @@ program DAMASK_spectral enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position endif - if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving - mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! first call to CPFEM_general will write? - restartWrite = .true. - lastRestartWritten = inc + if ( loadCases(currentLoadCase)%restartFrequency > 0_pInt & ! writing of restart info requested ... + .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ... and at frequency of writing restart information + restartWrite = .true. ! set restart parameter for FEsolving + lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif - else forwarding - time = time + timeinc - guess = .true. - endif forwarding + endif skipping enddo incLooping enddo loadCaseLooping @@ -673,6 +672,7 @@ program DAMASK_spectral real(convergedCounter, pReal)/& real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & ' %) increments converged!' + flush(6) call MPI_file_close(resUnit,ierr) close(statUnit) diff --git a/src/numerics.f90 b/src/numerics.f90 index 70c7f3c30..8392ac61c 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -120,9 +120,9 @@ module numerics petsc_options = '' integer(pInt), protected, public :: & fftw_planner_flag = 32_pInt, & !< conversion of fftw_plan_mode to integer, basically what is usually done in the include file of fftw - continueCalculation = 0_pInt, & !< 0: exit if BVP solver does not converge, 1: continue calculation if BVP solver does not converge divergence_correction = 2_pInt !< correct divergence calculation in fourier space 0: no correction, 1: size scaled to 1, 2: size scaled to Npoints logical, protected, public :: & + continueCalculation = .false., & !< false:exit if BVP solver does not converge, true: continue calculation despite BVP solver not converging memory_efficient = .true., & !< for fast execution (pre calculation of gamma_hat), Default .true.: do not precalculate update_gamma = .false. !< update gamma operator with current stiffness, Default .false.: use initial stiffness #endif @@ -424,9 +424,9 @@ subroutine numerics_init case ('err_stress_tolabs') err_stress_tolabs = IO_floatValue(line,chunkPos,2_pInt) case ('continuecalculation') - continueCalculation = IO_intValue(line,chunkPos,2_pInt) + continueCalculation = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('memory_efficient') - memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + memory_efficient = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('fftw_timelimit') fftw_timelimit = IO_floatValue(line,chunkPos,2_pInt) case ('fftw_plan_mode') @@ -436,7 +436,7 @@ subroutine numerics_init case ('divergence_correction') divergence_correction = IO_intValue(line,chunkPos,2_pInt) case ('update_gamma') - update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt + update_gamma = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('petsc_options') petsc_options = trim(line(chunkPos(4):)) case ('spectralsolver','myspectralsolver') @@ -599,7 +599,7 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! spectral parameters #ifdef Spectral - write(6,'(a24,1x,i8)') ' continueCalculation: ',continueCalculation + write(6,'(a24,1x,L8)') ' continueCalculation: ',continueCalculation write(6,'(a24,1x,L8)') ' memory_efficient: ',memory_efficient write(6,'(a24,1x,i8)') ' divergence_correction: ',divergence_correction write(6,'(a24,1x,a)') ' spectral_derivative: ',trim(spectral_derivative) @@ -698,8 +698,6 @@ subroutine numerics_init if (err_hydrogenflux_tolabs <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolabs') if (err_hydrogenflux_tolrel <= 0.0_pReal) call IO_error(301_pInt,ext_msg='err_hydrogenflux_tolrel') #ifdef Spectral - if (continueCalculation /= 0_pInt .and. & - continueCalculation /= 1_pInt) call IO_error(301_pInt,ext_msg='continueCalculation') if (divergence_correction < 0_pInt .or. & divergence_correction > 2_pInt) call IO_error(301_pInt,ext_msg='divergence_correction') if (update_gamma .and. & @@ -713,7 +711,7 @@ subroutine numerics_init if (polarAlpha <= 0.0_pReal .or. & polarAlpha > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarAlpha') if (polarBeta < 0.0_pReal .or. & - polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta') + polarBeta > 2.0_pReal) call IO_error(301_pInt,ext_msg='polarBeta') #endif end subroutine numerics_init diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 6d0fff286..4695d4faa 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -213,8 +213,9 @@ subroutine AL_init endif restart call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) + call Utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & + reshape(F,shape(F_lastInc)), 0.0_pReal, math_I3) + nullify(F) nullify(F_lambda) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc @@ -364,12 +365,10 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) DMDALocalInfo, dimension(& DMDA_LOCAL_INFO_SIZE) :: & in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + PetscScalar, & + target, dimension(3,3,2, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal + PetscScalar, & + target, dimension(3,3,2, X_RANGE, Y_RANGE, Z_RANGE), intent(out) :: f_scal PetscScalar, pointer, dimension(:,:,:,:,:) :: & F, & F_lambda, & @@ -441,8 +440,9 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_lambda/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) + + call Utilities_constitutiveResponse(residual_F,P_av,C_volAvg,C_minMaxAvg, & + F - residual_F_lambda/polarBeta,params%timeinc, params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) ForwardData = .False. @@ -655,10 +655,12 @@ subroutine AL_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stre !-------------------------------------------------------------------------------------------------- ! update coordinates and rate and forward last inc call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lambdaDot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3])) + Fdot = Utilities_calculateRate(guess, & + F_lastInc, reshape(F, [3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) + F_lambdaDot = Utilities_calculateRate(guess, & + F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_lambda_lastInc = reshape(F_lambda,[3,3,grid(1),grid(2),grid3]) endif diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 55403ee7c..acdcbee3a 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -39,16 +39,16 @@ module spectral_mech_basic ! stress, stiffness and compliance average etc. real(pReal), private, dimension(3,3) :: & F_aim = math_I3, & - F_aim_lastIter = math_I3, & F_aim_lastInc = math_I3, & P_av = 0.0_pReal, & - F_aimDot=0.0_pReal + F_aimDot = 0.0_pReal character(len=1024), private :: incInfo real(pReal), private, dimension(3,3,3,3) :: & C_volAvg = 0.0_pReal, & !< current volume average stiffness C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - S = 0.0_pReal !< current compliance (filled up with zeros) + C_minMaxAvgLastInc = 0.0_pReal, & !< previous (min+max)/2 stiffness + S = 0.0_pReal !< current compliance (filled up with zeros) real(pReal), private :: err_stress, err_div logical, private :: ForwardData integer(pInt), private :: & @@ -69,7 +69,7 @@ module spectral_mech_basic contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields and fills them with data, potentially from restart info +!> @brief allocates all necessary fields and fills them with data, potentially from restart info !-------------------------------------------------------------------------------------------------- subroutine basicPETSc_init #ifdef __GFORTRAN__ @@ -90,6 +90,8 @@ subroutine basicPETSc_init use numerics, only: & worldrank, & worldsize + use homogenization, only: & + materialpoint_F0 use DAMASK_interface, only: & getSolverJobName use spectral_utilities, only: & @@ -172,14 +174,11 @@ subroutine basicPETSc_init flush(6) write(rankStr,'(a1,i0)')'_',worldrank call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F - close (777) + read (777,rec=1) F; close (777) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc - close (777) + read (777,rec=1) F_lastInc; close (777) call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot - close (777) + read (777,rec=1) f_aimDot; close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc elseif (restartInc == 1_pInt) then restart @@ -187,41 +186,36 @@ subroutine basicPETSc_init F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) endif restart + materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal, & - P, & - C_volAvg,C_minMaxAvg, & ! global average of stiffness and (min+max)/2 - temp33_Real, & - .false., & - math_I3) + call Utilities_constitutiveResponse(P, temp33_Real, 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 + math_I3) ! no rotation of boundary condition call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! write data back to PETSc + ! QUESTION: why not writing back right after reading (l.189)? - restartRead: if (restartInc > 1_pInt) then + restartRead: if (restartInc > 1_pInt) then ! QUESTION: are those values not calc'ed by constitutiveResponse? why reading from file? if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & - 'reading more values of increment', restartInc - 1_pInt, 'from file' + 'reading more values of increment', restartInc-1_pInt, 'from file' flush(6) call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg - close (777) + read (777,rec=1) C_volAvg; close (777) call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc - close (777) + read (777,rec=1) C_volAvgLastInc; close (777) call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg - close (777) + read (777,rec=1) C_minMaxAvg; close (777) endif restartRead - call Utilities_updateGamma(C_minmaxAvg,.True.) + call Utilities_updateGamma(C_minmaxAvg,.true.) end subroutine basicPETSc_init !-------------------------------------------------------------------------------------------------- !> @brief solution for the Basic PETSC scheme with internal iterations !-------------------------------------------------------------------------------------------------- -type(tSolutionState) function & - basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) +type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) use IO, only: & IO_error use numerics, only: & @@ -238,13 +232,13 @@ type(tSolutionState) function & !-------------------------------------------------------------------------------------------------- ! input data for solution - real(pReal), intent(in) :: & - timeinc, & !< increment in time for current solution - timeinc_old !< increment in time of last increment - type(tBoundaryCondition), intent(in) :: & - stress_BC character(len=*), intent(in) :: & incInfoIn + real(pReal), intent(in) :: & + timeinc, & !< increment time for current solution + timeinc_old !< increment time of last successful increment + type(tBoundaryCondition), intent(in) :: & + stress_BC real(pReal), dimension(3,3), intent(in) :: rotation_BC !-------------------------------------------------------------------------------------------------- @@ -279,14 +273,13 @@ type(tSolutionState) function & !-------------------------------------------------------------------------------------------------- ! check convergence - call SNESGetConvergedReason(snes,reason,ierr) - CHKERRQ(ierr) + call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr) + + BasicPETSc_solution%converged = reason > 0 + basicPETSC_solution%iterationsNeeded = totalIter basicPETSc_solution%termIll = terminallyIll terminallyIll = .false. - BasicPETSc_solution%converged =.true. - if (reason == -4) call IO_error(893_pInt) - if (reason < 1) basicPETSC_solution%converged = .false. - basicPETSC_solution%iterationsNeeded = totalIter + if (reason == -4) call IO_error(893_pInt) ! MPI error end function BasicPETSc_solution @@ -322,19 +315,18 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) terminallyIll implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: & - in - PetscScalar, dimension(3,3, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, dimension(3,3, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in + PetscScalar, & + dimension(3,3, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal !< what is this? + PetscScalar, & + dimension(3,3, X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: f_scal !< what is this? PetscInt :: & PETScIter, & nfuncs PetscObject :: dummy PetscErrorCode :: ierr + real(pReal), dimension(3,3) :: & + deltaF_aim external :: & SNESGetNumberFunctionEvals, & @@ -343,46 +335,45 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - if(nfuncs== 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment - newIteration: if(totalIter <= PETScIter) then + if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment !-------------------------------------------------------------------------------------------------- -! report begin of new iteration +! begin of new iteration + newIteration: if (totalIter <= PETScIter) then totalIter = totalIter + 1_pInt - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') trim(incInfo), & - ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax + write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') & + trim(incInfo), ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim (lab) =', & - math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' deformation gradient aim =', & - math_transpose33(F_aim) + write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & + ' deformation gradient aim (lab) =', math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) + write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & + ' deformation gradient aim =', math_transpose33(F_aim) flush(6) endif newIteration !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response - call Utilities_constitutiveResponse(F_lastInc,x_scal,params%timeinc, & - f_scal,C_volAvg,C_minmaxAvg,P_av,ForwardData,params%rotation_BC) + call Utilities_constitutiveResponse(f_scal,P_av,C_volAvg,C_minmaxAvg, & + x_scal,params%timeinc, params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - ForwardData = .false. !-------------------------------------------------------------------------------------------------- ! stress BC handling - F_aim_lastIter = F_aim - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc - err_stress = maxval(abs(mask_stress * (P_av - params%stress_BC))) ! mask = 0.0 for no bc + deltaF_aim = math_mul3333xx33(S, P_av - params%stress_BC) + F_aim = F_aim - deltaF_aim + err_stress = maxval(abs(mask_stress * (P_av - params%stress_BC))) ! mask = 0.0 when no stress bc !-------------------------------------------------------------------------------------------------- ! updated deformation gradient using fix point algorithm of basic scheme tensorField_real = 0.0_pReal tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = f_scal - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() - call utilities_fourierGammaConvolution(math_rotate_backward33(F_aim_lastIter-F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() + call utilities_FFTtensorForward() ! FFT forward of global "tensorField_real" + err_div = Utilities_divergenceRMS() ! divRMS of tensorField_fourier + call utilities_fourierGammaConvolution(math_rotate_backward33(deltaF_aim,params%rotation_BC)) ! convolution of Gamma and tensorField_fourier, with arg + call utilities_FFTtensorBackward() ! FFT backward of global tensorField_fourier !-------------------------------------------------------------------------------------------------- ! constructing residual - f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) + f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) ! Gamma*P gives correction towards div(P) = 0, so needs to be zero, too end subroutine BasicPETSc_formResidual @@ -443,106 +434,120 @@ end subroutine BasicPETSc_converged !-------------------------------------------------------------------------------------------------- !> @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 BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC) - use math, only: & - math_mul33x33 ,& - math_rotate_backward33 - use numerics, only: & - worldrank - use mesh, only: & - grid, & - grid3 - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - Utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite + use math, only: & + math_mul33x33 ,& + math_rotate_backward33 + use numerics, only: & + worldrank + use homogenization, only: & + materialpoint_F0 + use mesh, only: & + grid, & + grid3 + use CPFEM2, only: & + CPFEM_age + use spectral_utilities, only: & + Utilities_calculateRate, & + Utilities_forwardField, & + Utilities_updateIPcoords, & + tBoundaryCondition, & + cutBack + use IO, only: & + IO_write_JobRealFile + use FEsolving, only: & + restartWrite - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - stress_BC, & - deformation_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - PetscErrorCode :: ierr - PetscScalar, pointer :: F(:,:,:,:) + implicit none + logical, intent(in) :: & + guess + real(pReal), intent(in) :: & + timeinc_old, & + timeinc, & + loadCaseTime !< remaining time of current load case + type(tBoundaryCondition), intent(in) :: & + stress_BC, & + deformation_BC + real(pReal), dimension(3,3), intent(in) ::& + rotation_BC + PetscErrorCode :: ierr + PetscScalar, pointer :: F(:,:,:,:) - character(len=1024) :: rankStr + character(len=32) :: rankStr - call DMDAVecGetArrayF90(da,solution_vec,F,ierr) -!-------------------------------------------------------------------------------------------------- -! restart information for spectral solver - if (restartWrite) then - write(6,'(/,a)') ' writing converged results for restart' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F - close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc - close (777) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot - close(777) - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg - close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc - close(777) - endif - endif + call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) + + if (cutBack) then + C_volAvg = C_volAvgLastInc ! QUESTION: where is this required? + C_minMaxAvg = C_minMaxAvgLastInc ! QUESTION: where is this required? + else + !-------------------------------------------------------------------------------------------------- + ! restart information for spectral solver + if (restartWrite) then ! QUESTION: where is this logical properly set? + write(6,'(/,a)') ' writing converged results for restart' + flush(6) - call utilities_updateIPcoords(F) + if (worldrank == 0_pInt) then + call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) + write (777,rec=1) C_volAvg; close(777) + call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) + write (777,rec=1) C_volAvgLastInc; close(777) + call IO_write_jobRealFile(777,'C_minMaxAvg',size(C_volAvg)) + write (777,rec=1) C_minMaxAvg; close(777) + call IO_write_jobRealFile(777,'C_minMaxAvgLastInc',size(C_volAvgLastInc)) + write (777,rec=1) C_minMaxAvgLastInc; close(777) + endif - if (cutBack) then - F_aim = F_aim_lastInc - F = reshape(F_lastInc, [9,grid(1),grid(2),grid3]) - C_volAvg = C_volAvgLastInc - else - ForwardData = .True. - C_volAvgLastInc = C_volAvg -!-------------------------------------------------------------------------------------------------- -! calculate rate for aim - if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F - f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim) - elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed - f_aimDot = deformation_BC%maskFloat * deformation_BC%values - elseif(deformation_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = deformation_BC%maskFloat * (deformation_BC%values -F_aim)/loadCaseTime - endif - if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old - F_aim_lastInc = F_aim + write(rankStr,'(a1,i0)')'_',worldrank + call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file + write (777,rec=1) F; close (777) + call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file + write (777,rec=1) F_lastInc; close (777) + endif + + call CPFEM_age() ! age state and kinematics + call utilities_updateIPcoords(F) + + C_volAvgLastInc = C_volAvg + C_minMaxAvgLastInc = C_minMaxAvg + + if (guess) then ! QUESTION: better with a = L ? x:y + F_aimDot = stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old ! initialize with correction based on last inc + else + F_aimDot = 0.0_pReal + endif + F_aim_lastInc = F_aim + !-------------------------------------------------------------------------------------------------- + ! calculate rate for aim + if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim_lastInc) + elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * deformation_BC%values + elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed + F_aimDot = & + F_aimDot + deformation_BC%maskFloat * (deformation_BC%values - F_aim_lastInc)/loadCaseTime + endif + + + Fdot = Utilities_calculateRate(guess, & + F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & + math_rotate_backward33(f_aimDot,rotation_BC)) + F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) ! winding F forward + materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent + endif !-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) - endif - - F_aim = F_aim + f_aimDot * timeinc - -!-------------------------------------------------------------------------------------------------- -! update local deformation gradient - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim - math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) - call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) - +! update average and local deformation gradients + F_aim = F_aim_lastInc + f_aimDot * timeinc + F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average + math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) + call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) + end subroutine BasicPETSc_forward !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index ecf707d46..fc65f14cf 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -213,8 +213,8 @@ subroutine Polarisation_init endif restart call Utilities_updateIPcoords(reshape(F,shape(F_lastInc))) - call Utilities_constitutiveResponse(F_lastInc, reshape(F,shape(F_lastInc)), & - 0.0_pReal,P,C_volAvg,C_minMaxAvg,temp33_Real,.false.,math_I3) + call Utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, & + reshape(F,shape(F_lastInc)),0.0_pReal,math_I3) nullify(F) nullify(F_tau) call DMDAVecRestoreArrayF90(da,solution_vec,xx_psc,ierr); CHKERRQ(ierr) ! write data back to PETSc @@ -364,12 +364,10 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) DMDALocalInfo, dimension(& DMDA_LOCAL_INFO_SIZE) :: & in - PetscScalar, target, dimension(3,3,2, & - XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: & - x_scal - PetscScalar, target, dimension(3,3,2, & - X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: & - f_scal + PetscScalar, & + target, dimension(3,3,2, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal + PetscScalar, & + target, dimension(3,3,2, X_RANGE, Y_RANGE, Z_RANGE), intent(out) :: f_scal PetscScalar, pointer, dimension(:,:,:,:,:) :: & F, & F_tau, & @@ -440,8 +438,8 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) !-------------------------------------------------------------------------------------------------- ! evaluate constitutive response P_avLastEval = P_av - call Utilities_constitutiveResponse(F_lastInc,F - residual_F_tau/polarBeta,params%timeinc, & - residual_F,C_volAvg,C_minMaxAvg,P_av,ForwardData,params%rotation_BC) + call Utilities_constitutiveResponse(residual_F,P_av,C_volAvg,C_minMaxAvg, & + F - residual_F_tau/polarBeta,params%timeinc,params%rotation_BC) call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) ForwardData = .False. @@ -654,13 +652,13 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati !-------------------------------------------------------------------------------------------------- ! update coordinates and rate and forward last inc call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc, & - reshape(F,[3,3,grid(1),grid(2),grid3])) - F_tauDot = Utilities_calculateRate(math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC), & - timeinc_old,guess,F_tau_lastInc, & - reshape(F_tau,[3,3,grid(1),grid(2),grid3])) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) + Fdot = Utilities_calculateRate(guess, & + F_lastInc, reshape(F, [3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33( f_aimDot,rotation_BC)) + F_tauDot = Utilities_calculateRate(guess, & + F_tau_lastInc, reshape(F_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, & + math_rotate_backward33(2.0_pReal*f_aimDot,rotation_BC)) + F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3]) endif diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 1bbf2e608..3295aa2bd 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -16,7 +16,7 @@ module spectral_utilities #include include 'fftw3-mpi.f03' - logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill + logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill integer(pInt), public, parameter :: maxPhaseFields = 2_pInt integer(pInt), public :: nActiveFields = 0_pInt @@ -799,7 +799,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) call math_invert(size_reduced, c_reduced, s_reduced, errmatinv) ! invert reduced stiffness if (any(IEEE_is_NaN(s_reduced))) errmatinv = .true. - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') + if (errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') temp99_Real = 0.0_pReal ! fill up compliance with zeros k = 0_pInt do n = 1_pInt,9_pInt @@ -817,28 +817,30 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) sTimesC = matmul(c_reduced,s_reduced) do m=1_pInt, size_reduced do n=1_pInt, size_reduced - if(m==n .and. abs(sTimesC(m,n)) > (1.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! diagonal elements of S*C should be 1 - if(m/=n .and. abs(sTimesC(m,n)) > (0.0_pReal + 10.0e-12_pReal)) errmatinv = .true. ! off diagonal elements of S*C should be 0 + errmatinv = errmatinv & + .or. (m==n .and. abs(sTimesC(m,n)-1.0_pReal) > 1.0e-12_pReal) & ! diagonal elements of S*C should be 1 + .or. (m/=n .and. abs(sTimesC(m,n)) > 1.0e-12_pReal) ! off-diagonal elements of S*C should be 0 enddo enddo - if(debugGeneral .or. errmatinv) then - write(formatString, '(I16.16)') size_reduced + if (debugGeneral .or. errmatinv) then + write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' write(6,trim(formatString),advance='no') ' C * S (load) ', & transpose(matmul(c_reduced,s_reduced)) write(6,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced) + if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') endif - if(errmatinv) call IO_error(error_ID=400_pInt,ext_msg='utilities_maskedCompliance') deallocate(c_reduced) deallocate(s_reduced) deallocate(sTimesC) else temp99_real = 0.0_pReal endif - if(debugGeneral) & - write(6,'(/,a,/,9(9(2x,f12.7,1x)/),/)',advance='no') ' Masked Compliance (load) * GPa =', & - transpose(temp99_Real*1.e9_pReal) - flush(6) + if(debugGeneral) then + write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') & + ' Masked Compliance (load) / GPa =', transpose(temp99_Real*1.e-9_pReal) + flush(6) + endif utilities_maskedCompliance = math_Plain99to3333(temp99_Real) end function utilities_maskedCompliance @@ -924,10 +926,10 @@ end subroutine utilities_fourierTensorDivergence !-------------------------------------------------------------------------------------------------- -!> @brief calculates constitutive response +!> @brief calculate constitutive response from materialpoint_F0 to F during timeinc !-------------------------------------------------------------------------------------------------- -subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & - P,C_volAvg,C_minmaxAvg,P_av,forwardData,rotation_BC) +subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,& + F,timeinc,rotation_BC) use IO, only: & IO_error use debug, only: & @@ -940,31 +942,22 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & use mesh, only: & grid,& grid3 - use FEsolving, only: & - restartWrite - use CPFEM2, only: & - CPFEM_general use homogenization, only: & - materialpoint_F0, & materialpoint_F, & materialpoint_P, & - materialpoint_dPdF + materialpoint_dPdF, & + materialpoint_stressAndItsTangent implicit none - real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - F_lastInc, & !< target deformation gradient - F !< previous deformation gradient - real(pReal), intent(in) :: timeinc !< loading time - logical, intent(in) :: forwardData !< age results - real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame - real(pReal),intent(out), dimension(3,3,3,3) :: C_volAvg, C_minmaxAvg !< average stiffness real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress real(pReal),intent(out), dimension(3,3,grid(1),grid(2),grid3) :: P !< PK stress - logical :: & - age + real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: F !< deformation gradient target !< previous deformation gradient + real(pReal), intent(in) :: timeinc !< loading time + real(pReal), intent(in), dimension(3,3) :: rotation_BC !< rotation of load frame + integer(pInt) :: & j,k,ierr real(pReal), dimension(3,3,3,3) :: max_dPdF, min_dPdF @@ -975,17 +968,9 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & write(6,'(/,a)') ' ... evaluating constitutive response ......................................' flush(6) - age = .False. - - if (forwardData) then ! aging results - age = .True. - materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) - endif - if (cutBack) age = .False. ! restore saved variables - - materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) - call debug_reset() ! this has no effect on rank >0 - + + materialpoint_F = reshape(F,[3,3,1,product(grid(1:2))*grid3]) ! set materialpoint target F to estimated field + !-------------------------------------------------------------------------------------------------- ! calculate bounds of det(F) and report if(debugGeneral) then @@ -1002,7 +987,19 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & flush(6) endif - call CPFEM_general(age,timeinc) + call debug_reset() ! this has no effect on rank >0 + call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field + + P = reshape(materialpoint_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(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& + math_transpose33(P_av)*1.e-6_pReal + P_av = math_rotate_forward33(P_av,rotation_BC) + write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& + math_transpose33(P_av)*1.e-6_pReal + flush(6) max_dPdF = 0.0_pReal max_dPdF_norm = 0.0_pReal @@ -1020,38 +1017,24 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & end do call MPI_Allreduce(MPI_IN_PLACE,max_dPdF,81,MPI_DOUBLE,MPI_MAX,PETSC_COMM_WORLD,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max') + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce max') call MPI_Allreduce(MPI_IN_PLACE,min_dPdF,81,MPI_DOUBLE,MPI_MIN,PETSC_COMM_WORLD,ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min') + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_Allreduce min') C_minmaxAvg = 0.5_pReal*(max_dPdF + min_dPdF) - C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt + C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) call debug_info() ! this has no effect on rank >0 - restartWrite = .false. ! reset restartWrite status - cutBack = .false. ! reset cutBack status - - P = reshape(materialpoint_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(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - P_av = math_rotate_forward33(P_av,rotation_BC) - write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& - math_transpose33(P_av)*1.e-6_pReal - flush(6) - end subroutine utilities_constitutiveResponse !-------------------------------------------------------------------------------------------------- !> @brief calculates forward rate, either guessing or just add delta/timeinc !-------------------------------------------------------------------------------------------------- -pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,field) +pure function utilities_calculateRate(heterogeneous,field0,field,dt,avRate) use mesh, only: & grid3, & grid @@ -1059,17 +1042,17 @@ pure function utilities_calculateRate(avRate,timeinc_old,guess,field_lastInc,fie implicit none real(pReal), intent(in), dimension(3,3) :: avRate !< homogeneous addon real(pReal), intent(in) :: & - timeinc_old !< timeinc of last step + dt !< timeinc between field0 and field logical, intent(in) :: & - guess !< guess along former trajectory + heterogeneous !< calculate field of rates real(pReal), intent(in), dimension(3,3,grid(1),grid(2),grid3) :: & - field_lastInc, & !< data of previous step + field0, & !< data of previous step field !< data of current step real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: & utilities_calculateRate - if (guess) then - utilities_calculateRate = (field-field_lastInc) / timeinc_old + if (heterogeneous) then + utilities_calculateRate = (field-field0) / dt else utilities_calculateRate = spread(spread(spread(avRate,3,grid(1)),4,grid(2)),5,grid3) endif From 307aa7e7d16b94c2f8c55f6e8b95aff6f86cb457 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 18 Jan 2018 18:16:16 -0500 Subject: [PATCH 19/54] fixed forgotten file writing of F_aimDot --- src/spectral_mech_Basic.f90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index acdcbee3a..7269c79eb 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -168,17 +168,18 @@ subroutine basicPETSc_init call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with restart: if (restartInc > 1_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & + if (iand(debug_level(debug_spectral),debug_spectralRestart) /= 0) then write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & 'reading values of increment ', restartInc - 1_pInt, ' from file' - flush(6) + flush(6) + endif write(rankStr,'(a1,i0)')'_',worldrank call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) read (777,rec=1) F; close (777) call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) read (777,rec=1) F_lastInc; close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(f_aimDot)) - read (777,rec=1) f_aimDot; close (777) + call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) + read (777,rec=1) F_aimDot; close (777) F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc elseif (restartInc == 1_pInt) then restart @@ -499,6 +500,8 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation write (777,rec=1) C_minMaxAvg; close(777) call IO_write_jobRealFile(777,'C_minMaxAvgLastInc',size(C_volAvgLastInc)) write (777,rec=1) C_minMaxAvgLastInc; close(777) + call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) + write (777,rec=1) F_aimDot; close(777) endif write(rankStr,'(a1,i0)')'_',worldrank @@ -522,10 +525,10 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation F_aim_lastInc = F_aim !-------------------------------------------------------------------------------------------------- ! calculate rate for aim - if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F + if (deformation_BC%myType=='l') then ! calculate F_aimDot from given L and current F F_aimDot = & F_aimDot + deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim_lastInc) - elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed + elseif(deformation_BC%myType=='fdot') then ! F_aimDot is prescribed F_aimDot = & F_aimDot + deformation_BC%maskFloat * deformation_BC%values elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed @@ -536,14 +539,14 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation Fdot = Utilities_calculateRate(guess, & F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & - math_rotate_backward33(f_aimDot,rotation_BC)) + math_rotate_backward33(F_aimDot,rotation_BC)) F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) ! winding F forward materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent endif !-------------------------------------------------------------------------------------------------- ! update average and local deformation gradients - F_aim = F_aim_lastInc + f_aimDot * timeinc + F_aim = F_aim_lastInc + F_aimDot * timeinc F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) From f26fd1d1dc4f5567fcc9269c3598232710c0b649 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Wed, 14 Feb 2018 22:13:10 -0500 Subject: [PATCH 20/54] Fixed a physics issue: sense change with respect to difference between resolved stress and backstress --- lib/damask/util.py | 0 src/DAMASK_spectral.f90 | 51 +------------ src/crystallite.f90 | 0 src/math.f90 | 0 src/plastic_kinematichardening.f90 | 18 +++-- src/spectral_mech_Basic.f90 | 114 +---------------------------- src/spectral_utilities.f90 | 14 +--- 7 files changed, 18 insertions(+), 179 deletions(-) mode change 100755 => 100644 lib/damask/util.py mode change 100755 => 100644 src/DAMASK_spectral.f90 mode change 100755 => 100644 src/crystallite.f90 mode change 100755 => 100644 src/math.f90 mode change 100755 => 100644 src/spectral_utilities.f90 diff --git a/lib/damask/util.py b/lib/damask/util.py old mode 100755 new mode 100644 diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 old mode 100755 new mode 100644 index 3b5fedf18..5cda40249 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -522,13 +522,9 @@ program DAMASK_spectral real(loadCases(currentLoadCase)%incs ,pReal))) endif endif -<<<<<<< HEAD - timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step - ! QUESTION: what happens to inc-counter when cutbacklevel is not zero? not clear where half an inc gets incremented..? -======= + timeinc = timeinc / real(subStepFactor,pReal)**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step ->>>>>>> spectralSolver-cutbackfix skipping: if (totalIncsCounter < restartInc) then ! not yet at restart inc? time = time + timeinc ! just advance time, skip already performed calculation guess = .true. ! QUESTION:why forced guessing instead of inheriting loadcase preference @@ -633,38 +629,7 @@ program DAMASK_spectral stagIter = stagIter + 1_pInt stagIterate = stagIter < stagItMax & .and. all(solres(:)%converged) & -<<<<<<< HEAD - .and. .not. all(solres(:)%stagConverged) - enddo -!-------------------------------------------------------------------------------------------------- -! check solution - cutBack = .False. - - if (solres(1)%termIll & - .or. .not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found - ! QUESTION: why termIll checked only for first field? only one that can be mechanic? - if (cutBackLevel < maxCutBack) then ! further cutbacking tolerated? - write(6,'(/,a)') ' cutting back ' - cutBack = .true. - stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator - cutBackLevel = cutBackLevel + 1_pInt - time = time - timeinc ! rewind time - timeinc = timeinc/2.0_pReal - elseif (continueCalculation == 1_pInt .and. .not. solres(1)%termIll) then - guess = .true. ! accept non converged BVP solution - else ! material point model cannot find a solution - call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) - close(statUnit) - call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written - endif - else - guess = .true. ! start guessing after first converged (sub)inc - endif - - if (.not. cutBack) then -======= .and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration enddo @@ -676,7 +641,6 @@ program DAMASK_spectral timeIncOld = timeinc cutBack = .false. guess = .true. ! start guessing after first converged (sub)inc ->>>>>>> spectralSolver-cutbackfix if (worldrank == 0) then write(statUnit,*) totalIncsCounter, time, cutBackLevel, & solres%converged, solres%iterationsNeeded @@ -695,10 +659,7 @@ program DAMASK_spectral close(statUnit) call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif -<<<<<<< HEAD -======= ->>>>>>> spectralSolver-cutbackfix enddo subStepLooping cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc @@ -719,11 +680,8 @@ program DAMASK_spectral flush(6) call materialpoint_postResults() call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) -<<<<<<< HEAD - if (ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') -======= + if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') ->>>>>>> spectralSolver-cutbackfix do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) @@ -740,9 +698,7 @@ program DAMASK_spectral restartWrite = .true. ! set restart parameter for FEsolving lastRestartWritten = inc ! QUESTION: first call to CPFEM_general will write? endif -<<<<<<< HEAD - endif skipping -======= + else forwarding time = time + timeinc guess = .true. @@ -812,7 +768,6 @@ program DAMASK_spectral call quit(0_pInt) endif endif ->>>>>>> development enddo incLooping enddo loadCaseLooping diff --git a/src/crystallite.f90 b/src/crystallite.f90 old mode 100755 new mode 100644 diff --git a/src/math.f90 b/src/math.f90 old mode 100755 new mode 100644 diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index c457c1344..6d7812a74 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -1,5 +1,5 @@ !-------------------------------------------------------------------------------------------------- -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Michigan State University !> @author Zhuowen Zhao, Michigan State University !> @brief Introducing Voce-type kinematic hardening rule into crystal plasticity !! formulation using a power law fitting @@ -611,13 +611,13 @@ subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & enddo slipFamilies gdot_pos = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_pos-state(instance)%sense(:,of)*state(instance)%crss_back(:,of))/ & + (abs(tau_pos-state(instance)%crss_back(:,of))/ & state(instance)%crss(:,of))**param(instance)%n_slip & - *sign(1.0_pReal,tau_pos) + *sign(1.0_pReal,tau_pos-state(instance)%crss_back(:,of)) gdot_neg = 0.5_pReal * param(instance)%gdot0 * & - (abs(tau_neg-state(instance)%sense(:,of)*state(instance)%crss_back(:,of))/ & + (abs(tau_neg-state(instance)%crss_back(:,of))/ & state(instance)%crss(:,of))**param(instance)%n_slip & - *sign(1.0_pReal,tau_neg) + *sign(1.0_pReal,tau_neg-state(instance)%crss_back(:,of)) ! gdot_pos = 0.5_pReal * param(instance)%gdot0 * & ! exp(-param(instance)%F0/(1.38e-23*298.15)* & @@ -765,7 +765,8 @@ end subroutine plastic_kinehardening_LpAndItsTangent !-------------------------------------------------------------------------------------------------- subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) use prec, only: & - dNeq + dNeq, & + dEq0 use debug, only: & debug_level, & debug_constitutive, & @@ -804,8 +805,9 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el) call plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & Tstar_v,ph,instance,of) - - sense = sign(1.0_pReal,gdot_pos+gdot_neg) ! current sense of shear direction + sense = merge(state(instance)%sense(:,of), & ! keep existing... + sign(1.0_pReal,gdot_pos+gdot_neg), & ! ...or have a defined + dEq0(gdot_pos+gdot_neg,1e-10_pReal)) ! current sense of shear direction #ifdef DEBUG if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt & diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 0ee977f6a..0b3409b52 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -280,13 +280,8 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old, basicPETSC_solution%iterationsNeeded = totalIter basicPETSc_solution%termIll = terminallyIll terminallyIll = .false. -<<<<<<< HEAD - if (reason == -4) call IO_error(893_pInt) - BasicPETSc_solution%converged = reason > 0 - basicPETSC_solution%iterationsNeeded = totalIter -======= if (reason == -4) call IO_error(893_pInt) ! MPI error ->>>>>>> spectralSolver-cutbackfix + end function BasicPETSc_solution @@ -343,10 +338,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment -<<<<<<< HEAD - newIteration: if (totalIter <= PETScIter) then -======= ->>>>>>> spectralSolver-cutbackfix !-------------------------------------------------------------------------------------------------- ! begin of new iteration newIteration: if (totalIter <= PETScIter) then @@ -449,106 +440,6 @@ end subroutine BasicPETSc_converged !> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates !-------------------------------------------------------------------------------------------------- subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC) -<<<<<<< HEAD - use math, only: & - math_mul33x33 ,& - math_rotate_backward33 - use numerics, only: & - worldrank - use mesh, only: & - grid, & - grid3 - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - Utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite - - implicit none - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - stress_BC, & - deformation_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - logical, intent(in) :: & - guess - PetscErrorCode :: ierr - PetscScalar, pointer :: F(:,:,:,:) - - character(len=1024) :: rankStr - - call DMDAVecGetArrayF90(da,solution_vec,F,ierr) ! get F from PETSc data structure -!-------------------------------------------------------------------------------------------------- -! restart information for spectral solver - if (restartWrite) then ! QUESTION: where is this logical properly set? - write(6,'(/,a)') ' writing converged results for restart' - flush(6) - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F - close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc - close (777) - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot - close(777) - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg - close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc - close(777) - endif - endif - - call utilities_updateIPcoords(F) ! QUESTION: why do this even when cutback happened?? - - if (cutBack) then ! reset to former inc's values - F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) ! QUESTION: purpose of resetting this when updating in line 541? - F_aim = F_aim_lastInc - C_volAvg = C_volAvgLastInc - else - ForwardData = .true. ! QUESTION: who is resetting this? - C_volAvgLastInc = C_volAvg -!-------------------------------------------------------------------------------------------------- -! calculate rate for aim - if (deformation_BC%myType=='l') then ! calculate f_aimDot from given L and current F - f_aimDot = deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim) - elseif(deformation_BC%myType=='fdot') then ! f_aimDot is prescribed - f_aimDot = deformation_BC%maskFloat * deformation_BC%values - elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed - f_aimDot = deformation_BC%maskFloat * (deformation_BC%values - F_aim)/loadCaseTime - endif - if (guess) f_aimDot = f_aimDot + stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old - F_aim_lastInc = F_aim - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call utilities_updateIPcoords(F) - Fdot = Utilities_calculateRate(math_rotate_backward33(f_aimDot,rotation_BC), & - timeinc_old,guess,F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3])) ! QUESTION: what do we need Fdot for and why is it not restored at cutback? - F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3]) - endif - - F_aim = F_aim + f_aimDot * timeinc - -!-------------------------------------------------------------------------------------------------- -! update local deformation gradient - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! ensure that it matches rotated F_aim - math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) - call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) - -======= use math, only: & math_mul33x33 ,& math_rotate_backward33 @@ -660,8 +551,7 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3]) call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) - ->>>>>>> spectralSolver-cutbackfix + end subroutine BasicPETSc_forward !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 old mode 100755 new mode 100644 index 3bcc914a4..a66fa558e --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -823,11 +823,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) .or. (m/=n .and. abs(sTimesC(m,n)) > 1.0e-12_pReal) ! off-diagonal elements of S*C should be 0 enddo enddo -<<<<<<< HEAD - if(debugGeneral .or. errmatinv) then -======= + if (debugGeneral .or. errmatinv) then ->>>>>>> spectralSolver-cutbackfix write(formatString, '(i2)') size_reduced formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))' write(6,trim(formatString),advance='no') ' C * S (load) ', & @@ -841,18 +838,13 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C) else temp99_real = 0.0_pReal endif -<<<<<<< HEAD - if(debugGeneral) & - write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') ' Masked Compliance (load) / GPa =', & - transpose(temp99_Real*1.e9_pReal) - flush(6) -======= + if(debugGeneral) then write(6,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') & ' Masked Compliance (load) / GPa =', transpose(temp99_Real*1.e-9_pReal) flush(6) endif ->>>>>>> spectralSolver-cutbackfix + utilities_maskedCompliance = math_Plain99to3333(temp99_Real) end function utilities_maskedCompliance From 12adcec41ef7c1e87e1fe3d4e82b4c309336ae16 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Fri, 9 Mar 2018 18:36:34 -0500 Subject: [PATCH 21/54] updated PRIVATE submodule to new state --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5e97c9ac2..8546f9bda 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5e97c9ac2fa4f7748a1bc040c15889623a3afd1f +Subproject commit 8546f9bda04b58c3b26979048288a8a01f607876 From ea9434432e71d03fa57e4e8eae587061713bb3e0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 9 Apr 2018 15:04:37 +0200 Subject: [PATCH 22/54] added reference for the tungsten model --- src/plastic_disloUCLA.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 9c0a6c494..8d44d28c8 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -176,6 +176,8 @@ subroutine plastic_disloUCLA_init(fileUnit) real(pReal), dimension(:), allocatable :: tempPerSlip write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' + write(6,'(/,a)') ' Cereceda et. al, International Journal of Plasticity 78, 2016, 242-256' + write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 0701b535fc086d0381a86927bf03e09a7628eb01 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Mon, 16 Apr 2018 16:14:17 +0200 Subject: [PATCH 23/54] DAMASK overview reference independently of selected solver --- src/DAMASK_abaqus_exp.f | 1 + src/DAMASK_abaqus_std.f | 1 + src/DAMASK_marc.f90 | 1 + src/spectral_interface.f90 | 1 + 4 files changed, 4 insertions(+) diff --git a/src/DAMASK_abaqus_exp.f b/src/DAMASK_abaqus_exp.f index 1fab2472d..dc755f2e8 100644 --- a/src/DAMASK_abaqus_exp.f +++ b/src/DAMASK_abaqus_exp.f @@ -37,6 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_exp -+>>>' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_abaqus_std.f b/src/DAMASK_abaqus_std.f index d15682c58..cf60781ce 100644 --- a/src/DAMASK_abaqus_std.f +++ b/src/DAMASK_abaqus_std.f @@ -37,6 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 27640e5f2..fe636dc52 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -54,6 +54,7 @@ subroutine DAMASK_interface_init call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index b45e8316c..677ab8220 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -115,6 +115,7 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& From afcaafa798e01bbe5607fa3e42548e9484548ba7 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 08:20:41 +0200 Subject: [PATCH 24/54] Reference for homogenization_RGC added --- src/homogenization_RGC.f90 | 2 ++ 1 file changed, 2 insertions(+) mode change 100644 => 100755 src/homogenization_RGC.f90 diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 old mode 100644 new mode 100755 index 611268393..6cf584a53 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -116,6 +116,8 @@ subroutine homogenization_RGC_init(fileUnit) line = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' + write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' + write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006.' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 3bd09fe837f97a10790bbd41765cc71e178a7349 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 17 Apr 2018 14:42:04 +0200 Subject: [PATCH 25/54] fixed typo --- src/homogenization_RGC.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 611268393..e1f4f4cee 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -69,7 +69,7 @@ module homogenization_RGC contains !-------------------------------------------------------------------------------------------------- -!> @brief allocates all neccessary fields, reads information from material configuration file +!> @brief allocates all necessary fields, reads information from material configuration file !-------------------------------------------------------------------------------------------------- subroutine homogenization_RGC_init(fileUnit) #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 From 86683674c08941b237ef624577c4dd9b615479a5 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 14:52:50 +0200 Subject: [PATCH 26/54] mod --- src/DAMASK_spectral.f90 | 1 + src/homogenization_RGC.f90 | 6 ++++-- src/spectral_damage.f90 | 2 ++ src/spectral_mech_AL.f90 | 2 ++ src/spectral_mech_Basic.f90 | 2 ++ src/spectral_mech_Polarisation.f90 | 2 ++ src/spectral_thermal.f90 | 2 ++ src/spectral_utilities.f90 | 2 ++ 8 files changed, 17 insertions(+), 2 deletions(-) mode change 100755 => 100644 src/homogenization_RGC.f90 diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 068aebbc6..c68511cb7 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -161,6 +161,7 @@ program DAMASK_spectral ! init DAMASK (all modules) call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 old mode 100755 new mode 100644 index 6cf584a53..0d84af38b --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -116,8 +116,10 @@ subroutine homogenization_RGC_init(fileUnit) line = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' - write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006.' + write(6,'(/,a)') ' Tjahjanto et. al, International Journal of Material Forming, 2(1):939–942, 2009 ' + write(6,'(/,a)') ' doi: 10.1007/s12289-009-0619-1 ' + write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010 ' + write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 1ac3c4c73..1618f854a 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -103,6 +103,8 @@ subroutine spectral_damage_init() SNESVISetVariableBounds write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' + write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 27a1def0c..91c93bb53 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -147,6 +147,8 @@ subroutine AL_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 171eeacad..82f2576d9 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -135,6 +135,8 @@ subroutine basicPETSc_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index acd713c70..a3b1e9f7e 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -145,6 +145,8 @@ subroutine Polarisation_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index f89184543..a3dd468a4 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -103,6 +103,8 @@ subroutine spectral_thermal_init mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' + write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" endif mainProcess diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index e3383f3d1..18e628bd4 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -216,6 +216,8 @@ subroutine utilities_init() tensorSize = 9_C_INTPTR_T write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' + write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2012.09.012 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From d6d9d6e1bbc8ff157273d1c27760d2fc1bfc215e Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 15:07:16 +0200 Subject: [PATCH 27/54] edit --- src/homogenization_RGC.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 0d84af38b..47505c3e5 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -117,9 +117,9 @@ subroutine homogenization_RGC_init(fileUnit) write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' write(6,'(/,a)') ' Tjahjanto et. al, International Journal of Material Forming, 2(1):939–942, 2009 ' - write(6,'(/,a)') ' doi: 10.1007/s12289-009-0619-1 ' + write(6,'(/,a)') ' doi: 10.1007/s12289-009-0619-1 ' write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010 ' - write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006 ' + write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 41967da684bd240ac61628fe25f7a6d20d3e6da2 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 15:09:12 +0200 Subject: [PATCH 28/54] edit --- src/spectral_damage.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 1618f854a..ad4df0a57 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -104,7 +104,7 @@ subroutine spectral_damage_init() write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From fc3abd4f399b6220eb57b458052a4514270dfe14 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 15:22:18 +0200 Subject: [PATCH 29/54] References for spectral solvers --- src/spectral_interface.f90 | 2 +- src/spectral_mech_AL.f90 | 6 +++--- src/spectral_mech_Basic.f90 | 6 +++--- src/spectral_mech_Polarisation.f90 | 6 +++--- src/spectral_thermal.f90 | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index 677ab8220..ba644ea9c 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -115,7 +115,7 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 91c93bb53..86e38c81c 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -147,9 +147,9 @@ subroutine AL_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 82f2576d9..080874ec1 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -135,9 +135,9 @@ subroutine basicPETSc_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index a3b1e9f7e..cafddd611 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -145,9 +145,9 @@ subroutine Polarisation_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" !-------------------------------------------------------------------------------------------------- diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index a3dd468a4..51805cc4b 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -103,9 +103,9 @@ subroutine spectral_thermal_init mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' + write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" endif mainProcess From 258be943c754d528fae34b2148426757665c6409 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 15:25:27 +0200 Subject: [PATCH 30/54] No tab allowed --- src/spectral_thermal.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 51805cc4b..b021f0c48 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -104,7 +104,7 @@ subroutine spectral_thermal_init mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" endif mainProcess From b7d622c32db1eb0900011845bd8908d2f741aa92 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Tue, 17 Apr 2018 15:39:08 +0200 Subject: [PATCH 31/54] No tab allowed --- src/spectral_damage.f90 | 4 ++-- src/spectral_utilities.f90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index ad4df0a57..03bb5766b 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -103,8 +103,8 @@ subroutine spectral_damage_init() SNESVISetVariableBounds write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 18e628bd4..c5497c613 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -215,9 +215,9 @@ subroutine utilities_init() vecSize = 3_C_INTPTR_T, & tensorSize = 9_C_INTPTR_T - write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' - write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2012.09.012 ' + write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' + write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013 ' + write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2012.09.012 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 3fca8da6aa0fc78ac90c232b088af83cad4ecaad Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Tue, 17 Apr 2018 15:51:59 +0200 Subject: [PATCH 32/54] Citations in plastic_twin --- src/plastic_dislotwin.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index c7aaf5400..68c45fd8e 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -265,6 +265,10 @@ subroutine plastic_dislotwin_init(fileUnit) real(pReal), dimension(:), allocatable :: tempPerSlip, tempPerTwin, tempPerTrans write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' + write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004' + write(6,'(/,a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' + write(6,'(/,a)') ' F.Roters et. al , Computational Materials Science, 39:91–95, 2007' + write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 90a1af509660391a7624621aa0e62d298d5822b6 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 18 Apr 2018 14:18:48 +0200 Subject: [PATCH 33/54] Cited HybridIA algorithm --- src/IO.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/IO.f90 b/src/IO.f90 index 9e8033f73..0812977b8 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -560,6 +560,9 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA = 0.0_pReal ! initialize return value for case of error write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) + write(6,'(/,a)') 'Eisenlohr et.al, Computational Materials Science, 42(4):670–678, 2008' + write(6,'(/,a)') 'https://doi.org/10.1016/j.commatsci.2007.09.015' + !-------------------------------------------------------------------------------------------------- ! parse header of ODF file From 451e9f245a7ed7a478a01b1d88d73ee8933c8c0f Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 18 Apr 2018 15:01:03 +0200 Subject: [PATCH 34/54] Removing some typos in citations --- src/DAMASK_abaqus_exp.f | 2 +- src/DAMASK_abaqus_std.f | 2 +- src/DAMASK_marc.f90 | 2 +- src/homogenization_RGC.f90 | 8 ++++---- src/plastic_isotropic.f90 | 2 ++ src/spectral_mech_AL.f90 | 4 ++-- src/spectral_mech_Basic.f90 | 4 ++-- src/spectral_mech_Polarisation.f90 | 4 ++-- src/spectral_thermal.f90 | 4 ++-- src/spectral_utilities.f90 | 4 ++-- 10 files changed, 19 insertions(+), 17 deletions(-) diff --git a/src/DAMASK_abaqus_exp.f b/src/DAMASK_abaqus_exp.f index dc755f2e8..a8a3a7496 100644 --- a/src/DAMASK_abaqus_exp.f +++ b/src/DAMASK_abaqus_exp.f @@ -37,7 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_exp -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_abaqus_std.f b/src/DAMASK_abaqus_std.f index cf60781ce..fafe339f3 100644 --- a/src/DAMASK_abaqus_std.f +++ b/src/DAMASK_abaqus_std.f @@ -37,7 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index fe636dc52..034aaf6f2 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -54,7 +54,7 @@ subroutine DAMASK_interface_init call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index acf8f5a0f..6595b4093 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -116,10 +116,10 @@ subroutine homogenization_RGC_init(fileUnit) line = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(/,a)') ' Tjahjanto et. al, International Journal of Material Forming, 2(1):939–942, 2009 ' - write(6,'(/,a)') ' doi: 10.1007/s12289-009-0619-1 ' - write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010 ' - write(6,'(/,a)') ' doi: 10.1088/0965-0393/18/1/015006 ' + write(6,'(/,a)') ' Tjahjanto et. al, International Journal of Material Forming, 2(1):939–942, 2009' + write(6,'(/,a)') ' https://doi.org/10.1007/s12289-009-0619-1' + write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' + write(6,'(/,a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 2ba1238b2..0bd207c63 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -150,6 +150,8 @@ subroutine plastic_isotropic_init(fileUnit) integer(pInt) :: NipcMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' + write(6,'(/,a)') ' Ma et.al, Computational Materials Science, 109:323–329, 2015' + write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2015.07.041' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index 86e38c81c..be950e6d8 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -147,8 +147,8 @@ subroutine AL_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index 080874ec1..c0e45eda9 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -135,8 +135,8 @@ subroutine basicPETSc_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index cafddd611..89fd8a6e0 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -145,8 +145,8 @@ subroutine Polarisation_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2014.02.006 ' + write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index b021f0c48..14207d6f4 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -103,8 +103,8 @@ subroutine spectral_thermal_init mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' - write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' + write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press,' + write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" endif mainProcess diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index c5497c613..db54f0361 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -216,8 +216,8 @@ subroutine utilities_init() tensorSize = 9_C_INTPTR_T write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' - write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013 ' - write(6,'(/,a)') ' doi: 10.1016/j.ijplas.2012.09.012 ' + write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013' + write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 71d23274e744a2f8d561439c45227b46fde8464e Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 18 Apr 2018 15:22:19 +0200 Subject: [PATCH 35/54] A citation on twinning was missing --- src/plastic_dislotwin.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 68c45fd8e..ebba33f65 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -269,6 +269,8 @@ subroutine plastic_dislotwin_init(fileUnit) write(6,'(/,a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' write(6,'(/,a)') ' F.Roters et. al , Computational Materials Science, 39:91–95, 2007' write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' + write(6,'(/,a)') ' Wong et.al, Acta Materialia, 118:140–151, 2016' + write(6,'(/,a)') ' https://doi.org/10.1016/j.actamat.2016.07.032' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From 488ff6bb2d73633501f2b5ae034c5a7b43a92188 Mon Sep 17 00:00:00 2001 From: Sharan Roongta Date: Wed, 18 Apr 2018 15:30:54 +0200 Subject: [PATCH 36/54] Rectifying a typo --- src/IO.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/IO.f90 b/src/IO.f90 index 0812977b8..263ad82cb 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -560,7 +560,7 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA = 0.0_pReal ! initialize return value for case of error write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) - write(6,'(/,a)') 'Eisenlohr et.al, Computational Materials Science, 42(4):670–678, 2008' + write(6,'(/,a)') 'Eisenlohr et. al, Computational Materials Science, 42(4):670–678, 2008' write(6,'(/,a)') 'https://doi.org/10.1016/j.commatsci.2007.09.015' From e90861956de798022818b0b96d769eb117a17408 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Sun, 22 Apr 2018 09:32:59 +0200 Subject: [PATCH 37/54] "et al." instead of "et. al" abbreviates "et alii", meaning "and others" --- src/DAMASK_abaqus_exp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/DAMASK_abaqus_exp.f b/src/DAMASK_abaqus_exp.f index a8a3a7496..cfd02cbed 100644 --- a/src/DAMASK_abaqus_exp.f +++ b/src/DAMASK_abaqus_exp.f @@ -37,7 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_exp -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& From 35a4fdc3580247a90473730e585a0e894d189b89 Mon Sep 17 00:00:00 2001 From: Yi-Chin Yang Date: Sun, 22 Apr 2018 10:07:49 +0200 Subject: [PATCH 38/54] "et al." instead of "et. al" abbreviates "et alii", meaning "and others" --- src/DAMASK_abaqus_std.f | 2 +- src/DAMASK_marc.f90 | 2 +- src/DAMASK_spectral.f90 | 2 +- src/IO.f90 | 2 +- src/homogenization_RGC.f90 | 4 ++-- src/plastic_disloUCLA.f90 | 2 +- src/plastic_dislotwin.f90 | 4 ++-- src/plastic_isotropic.f90 | 2 +- src/spectral_damage.f90 | 2 +- src/spectral_interface.f90 | 2 +- src/spectral_mech_AL.f90 | 2 +- src/spectral_mech_Basic.f90 | 2 +- src/spectral_mech_Polarisation.f90 | 2 +- src/spectral_thermal.f90 | 2 +- src/spectral_utilities.f90 | 2 +- 15 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/DAMASK_abaqus_std.f b/src/DAMASK_abaqus_std.f index fafe339f3..e91cbb0bb 100644 --- a/src/DAMASK_abaqus_std.f +++ b/src/DAMASK_abaqus_std.f @@ -37,7 +37,7 @@ subroutine DAMASK_interface_init dateAndTime ! type default integer call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 034aaf6f2..81465350c 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -54,7 +54,7 @@ subroutine DAMASK_interface_init call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index c68511cb7..5bb882e2d 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -161,7 +161,7 @@ program DAMASK_spectral ! init DAMASK (all modules) call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/IO.f90 b/src/IO.f90 index 263ad82cb..7291f36ad 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -560,7 +560,7 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA = 0.0_pReal ! initialize return value for case of error write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) - write(6,'(/,a)') 'Eisenlohr et. al, Computational Materials Science, 42(4):670–678, 2008' + write(6,'(/,a)') 'Eisenlohr et al., Computational Materials Science, 42(4):670–678, 2008' write(6,'(/,a)') 'https://doi.org/10.1016/j.commatsci.2007.09.015' diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 6595b4093..fe9885215 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -116,9 +116,9 @@ subroutine homogenization_RGC_init(fileUnit) line = '' write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(/,a)') ' Tjahjanto et. al, International Journal of Material Forming, 2(1):939–942, 2009' + write(6,'(/,a)') ' Tjahjanto et al., International Journal of Material Forming, 2(1):939–942, 2009' write(6,'(/,a)') ' https://doi.org/10.1007/s12289-009-0619-1' - write(6,'(/,a)') ' Tjahjanto et. al, Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' + write(6,'(/,a)') ' Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering, 18:015006, 2010' write(6,'(/,a)') ' https://doi.org/10.1088/0965-0393/18/1/015006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 8d44d28c8..514652397 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -176,7 +176,7 @@ subroutine plastic_disloUCLA_init(fileUnit) real(pReal), dimension(:), allocatable :: tempPerSlip write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOUCLA_label//' init -+>>>' - write(6,'(/,a)') ' Cereceda et. al, International Journal of Plasticity 78, 2016, 242-256' + write(6,'(/,a)') ' Cereceda et al., International Journal of Plasticity 78, 2016, 242-256' write(6,'(/,a)') ' http://dx.doi.org/10.1016/j.ijplas.2015.09.002' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index ebba33f65..e0da954a6 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -267,9 +267,9 @@ subroutine plastic_dislotwin_init(fileUnit) write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004' write(6,'(/,a)') ' https://doi.org/10.1016/j.actamat.2004.04.012' - write(6,'(/,a)') ' F.Roters et. al , Computational Materials Science, 39:91–95, 2007' + write(6,'(/,a)') ' F.Roters et al., Computational Materials Science, 39:91–95, 2007' write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2006.04.014' - write(6,'(/,a)') ' Wong et.al, Acta Materialia, 118:140–151, 2016' + write(6,'(/,a)') ' Wong et al., Acta Materialia, 118:140–151, 2016' write(6,'(/,a)') ' https://doi.org/10.1016/j.actamat.2016.07.032' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 0bd207c63..4679d654d 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -150,7 +150,7 @@ subroutine plastic_isotropic_init(fileUnit) integer(pInt) :: NipcMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>' - write(6,'(/,a)') ' Ma et.al, Computational Materials Science, 109:323–329, 2015' + write(6,'(/,a)') ' Ma et al., Computational Materials Science, 109:323–329, 2015' write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2015.07.041' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index 03bb5766b..c6caf410d 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -103,7 +103,7 @@ subroutine spectral_damage_init() SNESVISetVariableBounds write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press, ' + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, ' write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 ' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index ba644ea9c..eca92df9d 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -115,7 +115,7 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Roters et. al, Computational Materials Science, 2018' + write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 index be950e6d8..67eda6f42 100644 --- a/src/spectral_mech_AL.f90 +++ b/src/spectral_mech_AL.f90 @@ -147,7 +147,7 @@ subroutine AL_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index c0e45eda9..bef70153d 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -135,7 +135,7 @@ subroutine basicPETSc_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index 89fd8a6e0..02e0e0ab8 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -145,7 +145,7 @@ subroutine Polarisation_init SNESSetFromOptions write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, International Journal of Plasticity, 66:31–45, 2015' + write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 14207d6f4..ff318f395 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -103,7 +103,7 @@ subroutine spectral_thermal_init mainProcess: if (worldrank == 0_pInt) then write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' - write(6,'(/,a)') ' Shanthraj et. al, Handbook of Mechanics of Materials, volume in press,' + write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,' write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index db54f0361..4289d7829 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -216,7 +216,7 @@ subroutine utilities_init() tensorSize = 9_C_INTPTR_T write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' - write(6,'(/,a)') ' Eisenlohr et. al, International Journal of Plasticity, 46:37–53, 2013' + write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity, 46:37–53, 2013' write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" From ac6cbe2920f9fbc4a765f5ce2950125ae26f84a2 Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 23 Apr 2018 04:51:22 +0200 Subject: [PATCH 39/54] [skip ci] updated version information after successful test of v2.0.1-1136-ge588fe3 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 35415784e..5cf2a8f37 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-1115-gb429068 +v2.0.1-1136-ge588fe3 From fcac08cdcef0ad09e50e516ad3b453f753026ca5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 23 Apr 2018 21:31:57 +0200 Subject: [PATCH 40/54] helps to identify the PETSc version --- DAMASK_prerequisites.sh | 1 + 1 file changed, 1 insertion(+) diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 12dd9bd07..3f5e25a71 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -68,6 +68,7 @@ echo PYTHONPATH: $PYTHONPATH echo SHELL: $SHELL echo PETSC_ARCH: $PETSC_ARCH echo PETSC_DIR: $PETSC_DIR +ls $PETSC_DIR/lib echo echo ============================================================================================== echo Python From 58f9fab0902c7504042e4646d4c5f9a4c31d8e1f Mon Sep 17 00:00:00 2001 From: Test User Date: Tue, 24 Apr 2018 06:50:08 +0200 Subject: [PATCH 41/54] [skip ci] updated version information after successful test of v2.0.1-1138-gfcac08c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 5cf2a8f37..488dd8695 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-1136-ge588fe3 +v2.0.1-1138-gfcac08c From 7bc736aad7292953cb781d8dc13f4a5216b2b915 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Wed, 25 Apr 2018 13:26:38 -0400 Subject: [PATCH 42/54] killed modification not relevant to kinematic hardening --- src/plastic_phenopowerlaw.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 64520fdc6..229d03c26 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -579,11 +579,11 @@ subroutine plastic_phenopowerlaw_init(fileUnit) plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) + allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%aTolState (sizeDotState), source=0.0_pReal) allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) if (any(numerics_integrator == 1_pInt)) then @@ -987,15 +987,13 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) j = j+1_pInt - left_SlipSlip(j) = (1.0_pReal + plastic_phenopowerlaw_H_int(f,instance)) & - *abs(1.0_pReal-plasticState(ph)%state(j,of) / & ! no system-dependent left part - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenopowerlaw_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) - left_SlipTwin(j) = 1.0_pReal - right_SlipSlip(j) = 1.0_pReal ! system-dependent part (beta summation) - + left_SlipSlip(j) = 1.0_pReal + plastic_phenopowerlaw_H_int(f,instance) ! modified no system-dependent left part + left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part + right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & + **plastic_phenopowerlaw_a_slip(instance)& + *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & + (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) right_TwinSlip(j) = 1.0_pReal ! no system-dependent part !-------------------------------------------------------------------------------------------------- From 43a711f2c1e889cf494b4a8b38ba43edfbb9bdf6 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Wed, 25 Apr 2018 14:21:28 -0400 Subject: [PATCH 43/54] updated PRIVATE? --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index af8516892..8546f9bda 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit af851689285b8c1a633495219abd9dbbd5a11c69 +Subproject commit 8546f9bda04b58c3b26979048288a8a01f607876 From 4c42510ad6145834b7f263e695afc666ba02c564 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Thu, 26 Apr 2018 14:11:45 +0200 Subject: [PATCH 44/54] compiles without AL solver --- src/CMakeLists.txt | 1 - src/DAMASK_spectral.f90 | 23 +- src/spectral_mech_AL.f90 | 723 --------------------------------------- 3 files changed, 2 insertions(+), 745 deletions(-) delete mode 100644 src/spectral_mech_AL.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eade66e17..fa7ee1ae8 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -165,7 +165,6 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral") add_library(SPECTRAL_SOLVER OBJECT "spectral_thermal.f90" "spectral_damage.f90" - "spectral_mech_AL.f90" "spectral_mech_Polarisation.f90" "spectral_mech_Basic.f90") add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 5bb882e2d..c5bf70397 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -80,7 +80,6 @@ program DAMASK_spectral FIELD_THERMAL_ID, & FIELD_DAMAGE_ID use spectral_mech_Basic - use spectral_mech_AL use spectral_mech_Polarisation use spectral_damage use spectral_thermal @@ -367,11 +366,7 @@ program DAMASK_spectral select case (spectral_solver) case (DAMASK_spectral_SolverBasicPETSc_label) call basicPETSc_init - case (DAMASK_spectral_SolverAL_label) - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') - call AL_init - + case (DAMASK_spectral_SolverPolarisation_label) if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & call IO_warning(42_pInt, ext_msg='debug Divergence') @@ -534,12 +529,7 @@ program DAMASK_spectral deformation_BC = loadCases(currentLoadCase)%deformation, & stress_BC = loadCases(currentLoadCase)%stress, & rotation_BC = loadCases(currentLoadCase)%rotation) - case (DAMASK_spectral_SolverAL_label) - call AL_forward (& - guess,timeinc,timeIncOld,remainingLoadCaseTime, & - deformation_BC = loadCases(currentLoadCase)%deformation, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) + case (DAMASK_spectral_SolverPolarisation_label) call Polarisation_forward (& guess,timeinc,timeIncOld,remainingLoadCaseTime, & @@ -568,12 +558,6 @@ program DAMASK_spectral stress_BC = loadCases(currentLoadCase)%stress, & rotation_BC = loadCases(currentLoadCase)%rotation) - case (DAMASK_spectral_SolverAL_label) - solres(field) = AL_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - case (DAMASK_spectral_SolverPolarisation_label) solres(field) = Polarisation_solution (& incInfo,timeinc,timeIncOld, & @@ -702,8 +686,6 @@ subroutine quit(stop_id) pInt use spectral_mech_Basic, only: & BasicPETSC_destroy - use spectral_mech_AL, only: & - AL_destroy use spectral_mech_Polarisation, only: & Polarisation_destroy use spectral_damage, only: & @@ -727,7 +709,6 @@ subroutine quit(stop_id) MPI_finalize call BasicPETSC_destroy() - call AL_destroy() call Polarisation_destroy() call spectral_damage_destroy() call spectral_thermal_destroy() diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 deleted file mode 100644 index 67eda6f42..000000000 --- a/src/spectral_mech_AL.f90 +++ /dev/null @@ -1,723 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH -!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief AL scheme solver -!-------------------------------------------------------------------------------------------------- -module spectral_mech_AL - use prec, only: & - pInt, & - pReal - use math, only: & - math_I3 - use spectral_utilities, only: & - tSolutionState, & - tSolutionParams - - implicit none - private -#include - - character (len=*), parameter, public :: & - DAMASK_spectral_solverAL_label = 'al' - -!-------------------------------------------------------------------------------------------------- -! derived types - type(tSolutionParams), private :: params - real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! PETSc data - DM, private :: da - SNES, private :: snes - Vec, private :: solution_vec - -!-------------------------------------------------------------------------------------------------- -! common pointwise data - real(pReal), private, dimension(:,:,:,:,:), allocatable :: & - F_lastInc, & !< field of previous compatible deformation gradients - F_lambda_lastInc, & !< field of previous incompatible deformation gradient - Fdot, & !< field of assumed rate of compatible deformation gradient - F_lambdaDot !< field of assumed rate of incopatible deformation gradient - -!-------------------------------------------------------------------------------------------------- -! stress, stiffness and compliance average etc. - real(pReal), private, 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_av = 0.0_pReal, & !< average incompatible def grad field - P_av = 0.0_pReal, & !< average 1st Piola--Kirchhoff stress - P_avLastEval = 0.0_pReal !< average 1st Piola--Kirchhoff stress last call of CPFEM_general - - character(len=1024), private :: incInfo !< time and increment information - - real(pReal), private, dimension(3,3,3,3) :: & - C_volAvg = 0.0_pReal, & !< current volume average stiffness - C_volAvgLastInc = 0.0_pReal, & !< previous volume average stiffness - C_minMaxAvg = 0.0_pReal, & !< current (min+max)/2 stiffness - C_minMaxAvgLastInc = 0.0_pReal, & !< previous (min+max)/2 stiffness - S = 0.0_pReal, & !< current compliance (filled up with zeros) - C_scale = 0.0_pReal, & - S_scale = 0.0_pReal - - real(pReal), private :: & - err_BC, & !< deviation from stress BC - err_curl, & !< RMS of curl of F - err_div !< RMS of div of P - - integer(pInt), private :: & - totalIter = 0_pInt !< total iteration in current increment - - public :: & - AL_init, & - AL_solution, & - AL_forward, & - AL_destroy - external :: & - PETScFinalize, & - MPI_Abort, & - MPI_Bcast, & - MPI_Allreduce - -contains - -!-------------------------------------------------------------------------------------------------- -!> @brief allocates all necessary fields and fills them with data, potentially from restart info -!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc) -!-------------------------------------------------------------------------------------------------- -subroutine AL_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use IO, only: & - IO_intOut, & - IO_read_realFile, & - IO_timeStamp - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRestart - use FEsolving, only: & - restartInc - use numerics, only: & - worldrank, & - worldsize - use homogenization, only: & - materialpoint_F0 - use DAMASK_interface, only: & - getSolverJobName - use spectral_utilities, only: & - Utilities_constitutiveResponse, & - Utilities_updateGamma, & - Utilities_updateIPcoords, & - wgt - use mesh, only: & - grid, & - grid3 - use math, only: & - math_invSym3333 - - implicit none - 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_lambda, & ! overall pointer to solution data - F, & ! specific (sub)pointer - F_lambda ! specific (sub)pointer - - integer(pInt), dimension(:), allocatable :: localK - integer(pInt) :: proc - character(len=1024) :: rankStr - - external :: & - SNESCreate, & - SNESSetOptionsPrefix, & - DMDACreate3D, & - SNESSetDM, & - DMCreateGlobalVector, & - DMDASNESSetFunctionLocal, & - SNESGetConvergedReason, & - SNESSetConvergenceTest, & - SNESSetFromOptions - - write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' - write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015' - write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - -!-------------------------------------------------------------------------------------------------- -! 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_lambda_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal) - allocate (F_lambdaDot (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) - allocate(localK(worldsize), source = 0); localK(worldrank+1) = grid3 - do proc = 1, worldsize - call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) - enddo - call DMDACreate3d(PETSC_COMM_WORLD, & - DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary - DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point - grid(1),grid(2),grid(3), & ! global grid - 1 , 1, worldsize, & - 18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap) - grid(1),grid(2),localK, & ! local grid - da,ierr) ! handle, error - CHKERRQ(ierr) - call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da - call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) - call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector - CHKERRQ(ierr) - call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" - CHKERRQ(ierr) - call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments - -!-------------------------------------------------------------------------------------------------- -! init fields - call DMDAVecGetArrayF90(da,solution_vec,FandF_lambda,ierr); CHKERRQ(ierr) ! places pointer on PETSc data - F => FandF_lambda( 0: 8,:,:,:) - F_lambda => FandF_lambda( 9:17,:,:,:) - - restart: if (restartInc > 0_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart) /= 0) then - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') & - 'reading values of increment ', restartInc, ' from file' - flush(6) - endif - write(rankStr,'(a1,i0)')'_',worldrank - call IO_read_realFile(777,'F'//trim(rankStr),trim(getSolverJobName()),size(F)) - read (777,rec=1) F; close (777) - call IO_read_realFile(777,'F_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lastInc)) - read (777,rec=1) F_lastInc; close (777) - call IO_read_realFile(777,'F_lambda'//trim(rankStr),trim(getSolverJobName()),size(F_lambda)) - read (777,rec=1) F_lambda; close (777) - call IO_read_realFile(777,'F_lambda_lastInc'//trim(rankStr),trim(getSolverJobName()),size(F_lambda_lastInc)) - read (777,rec=1) F_lambda_lastInc; close (777) - call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot)) - read (777,rec=1) F_aimDot; close (777) - F_aim = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3]) ! average of F - F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt ! average of F_lastInc - elseif (restartInc == 0_pInt) then restart - F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3) ! initialize to identity - F = reshape(F_lastInc,[9,grid(1),grid(2),grid3]) - F_lambda = F - F_lambda_lastInc = F_lastInc - endif restart - - materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent - call Utilities_updateIPcoords(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 - reshape(F,shape(F_lastInc)), & ! target F - 0.0_pReal, & ! time increment - math_I3) ! no rotation of boundary condition - nullify(F) - nullify(F_lambda) - call DMDAVecRestoreArrayF90(da,solution_vec,FandF_lambda,ierr); CHKERRQ(ierr) ! write data back to PETSc - - restartRead: if (restartInc > 0_pInt) then - if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0 .and. worldrank == 0_pInt) & - write(6,'(/,a,'//IO_intOut(restartInc)//',a)') & - 'reading more values of increment ', restartInc, ' from file' - flush(6) - call IO_read_realFile(777,'C_volAvg',trim(getSolverJobName()),size(C_volAvg)) - read (777,rec=1) C_volAvg; close (777) - call IO_read_realFile(777,'C_volAvgLastInc',trim(getSolverJobName()),size(C_volAvgLastInc)) - read (777,rec=1) C_volAvgLastInc; close (777) - call IO_read_realFile(777,'C_ref',trim(getSolverJobName()),size(C_minMaxAvg)) - read (777,rec=1) C_minMaxAvg; close (777) - endif restartRead - - call Utilities_updateGamma(C_minMaxAvg,.true.) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - -end subroutine AL_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief solution for the AL scheme with internal iterations -!-------------------------------------------------------------------------------------------------- -type(tSolutionState) function AL_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC) - use IO, only: & - IO_error - use numerics, only: & - update_gamma - use math, only: & - math_invSym3333 - use spectral_utilities, only: & - tBoundaryCondition, & - Utilities_maskedCompliance, & - Utilities_updateGamma - use FEsolving, only: & - restartWrite, & - terminallyIll - - implicit none - -!-------------------------------------------------------------------------------------------------- -! input data for solution - character(len=*), intent(in) :: & - incInfoIn - real(pReal), intent(in) :: & - timeinc, & !< increment time for current solution - timeinc_old !< increment time of last successful increment - type(tBoundaryCondition), intent(in) :: & - stress_BC - real(pReal), dimension(3,3), intent(in) :: rotation_BC - -!-------------------------------------------------------------------------------------------------- -! PETSc Data - PetscErrorCode :: ierr - SNESConvergedReason :: reason - - external :: & - SNESSolve, & - SNESGetConvergedReason - - incInfo = incInfoIn - -!-------------------------------------------------------------------------------------------------- -! update stiffness (and gamma operator) - S = Utilities_maskedCompliance(rotation_BC,stress_BC%maskLogical,C_volAvg) - if (update_gamma) then - call Utilities_updateGamma(C_minMaxAvg,restartWrite) - C_scale = C_minMaxAvg - S_scale = math_invSym3333(C_minMaxAvg) - endif - -!-------------------------------------------------------------------------------------------------- -! set module wide availabe data - mask_stress = stress_BC%maskFloat - params%stress_BC = stress_BC%values - params%rotation_BC = rotation_BC - params%timeinc = timeinc - params%timeincOld = timeinc_old - -!-------------------------------------------------------------------------------------------------- -! solve BVP - call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr); CHKERRQ(ierr) - -!-------------------------------------------------------------------------------------------------- -! check convergence - call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr) - - AL_solution%converged = reason > 0 - AL_solution%iterationsNeeded = totalIter - AL_solution%termIll = terminallyIll - terminallyIll = .false. - if (reason == -4) call IO_error(893_pInt) ! MPI error - -end function AL_solution - - -!-------------------------------------------------------------------------------------------------- -!> @brief forms the AL residual vector -!-------------------------------------------------------------------------------------------------- -subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - polarAlpha, & - polarBeta - use mesh, only: & - grid, & - grid3 - use IO, only: & - IO_intOut - use math, only: & - math_rotate_backward33, & - math_transpose33, & - math_mul3333xx33, & - math_invSym3333, & - math_mul33x33 - use debug, only: & - debug_level, & - debug_spectral, & - debug_spectralRotation - use spectral_utilities, only: & - wgt, & - tensorField_real, & - utilities_FFTtensorForward, & - utilities_fourierGammaConvolution, & - utilities_FFTtensorBackward, & - Utilities_constitutiveResponse, & - Utilities_divergenceRMS, & - Utilities_curlRMS - use homogenization, only: & - materialpoint_dPdF - use FEsolving, only: & - terminallyIll - - implicit none - DMDALocalInfo, dimension(DMDA_LOCAL_INFO_SIZE) :: in - PetscScalar, & - target, dimension(3,3,2, XG_RANGE,YG_RANGE,ZG_RANGE), intent(in) :: x_scal !< what is this? - PetscScalar, & - target, dimension(3,3,2, X_RANGE,Y_RANGE,Z_RANGE), intent(out) :: f_scal !< what is this? - PetscScalar, pointer, dimension(:,:,:,:,:) :: & - F, & - F_lambda, & - residual_F, & - residual_F_lambda - PetscInt :: & - PETScIter, & - nfuncs - PetscObject :: dummy - PetscErrorCode :: ierr - integer(pInt) :: & - i, j, k, e - - external :: & - SNESGetNumberFunctionEvals, & - SNESGetIterationNumber - - F => x_scal(1:3,1:3,1,& - XG_RANGE,YG_RANGE,ZG_RANGE) - F_lambda => x_scal(1:3,1:3,2,& - XG_RANGE,YG_RANGE,ZG_RANGE) - residual_F => f_scal(1:3,1:3,1,& - X_RANGE, Y_RANGE, Z_RANGE) - residual_F_lambda => f_scal(1:3,1:3,2,& - X_RANGE, Y_RANGE, Z_RANGE) - - F_av = sum(sum(sum(F,dim=5),dim=4),dim=3) * wgt - call MPI_Allreduce(MPI_IN_PLACE,F_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) - - call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) - call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) - - if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1_pInt ! new increment -!-------------------------------------------------------------------------------------------------- -! begin of new iteration - newIteration: if (totalIter <= PETScIter) then - totalIter = totalIter + 1_pInt - write(6,'(1x,a,3(a,'//IO_intOut(itmax)//'))') & - trim(incInfo), ' @ Iteration ', itmin, '≤',totalIter, '≤', itmax - if (iand(debug_level(debug_spectral),debug_spectralRotation) /= 0) & - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim (lab) =', math_transpose33(math_rotate_backward33(F_aim,params%rotation_BC)) - write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') & - ' deformation gradient aim =', math_transpose33(F_aim) - flush(6) - endif newIteration - -!-------------------------------------------------------------------------------------------------- -! - tensorField_real = 0.0_pReal - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - tensorField_real(1:3,1:3,i,j,k) = & - polarBeta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -& - polarAlpha*math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3)) - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! doing convolution in Fourier space - call utilities_FFTtensorForward() - call utilities_fourierGammaConvolution(math_rotate_backward33(polarBeta*F_aim,params%rotation_BC)) - call utilities_FFTtensorBackward() - -!-------------------------------------------------------------------------------------------------- -! constructing F_lambda residual - residual_F_lambda = polarBeta*F - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) !< eq (16) in doi: 10.1016/j.ijplas.2014.02.006 - -!-------------------------------------------------------------------------------------------------- -! evaluate constitutive response - P_avLastEval = P_av - - call Utilities_constitutiveResponse(residual_F,P_av,C_volAvg,C_minMaxAvg, & - F - residual_F_lambda/polarBeta,params%timeinc, params%rotation_BC) - call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) - -!-------------------------------------------------------------------------------------------------- -! calculate divergence - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = residual_F !< stress field in disguise - call utilities_FFTtensorForward() - err_div = Utilities_divergenceRMS() !< root mean squared error in divergence of stress - -!-------------------------------------------------------------------------------------------------- -! constructing residual - e = 0_pInt - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - e = e + 1_pInt - residual_F(1:3,1:3,i,j,k) = math_mul3333xx33(math_invSym3333(materialpoint_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), & - residual_F(1:3,1:3,i,j,k) - & - math_mul33x33(F(1:3,1:3,i,j,k), & - math_mul3333xx33(C_scale,F_lambda(1:3,1:3,i,j,k) - math_I3))) & - + residual_F_lambda(1:3,1:3,i,j,k) !< eq (16) in doi: 10.1016/j.ijplas.2014.02.006 - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! calculating curl - tensorField_real = 0.0_pReal - tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) = F - call utilities_FFTtensorForward() - err_curl = Utilities_curlRMS() - - nullify(F) - nullify(F_lambda) - nullify(residual_F) - nullify(residual_F_lambda) -end subroutine AL_formResidual - - -!-------------------------------------------------------------------------------------------------- -!> @brief convergence check -!-------------------------------------------------------------------------------------------------- -subroutine AL_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) - use numerics, only: & - itmax, & - itmin, & - err_div_tolRel, & - err_div_tolAbs, & - err_curl_tolRel, & - err_curl_tolAbs, & - err_stress_tolRel, & - err_stress_tolAbs - use math, only: & - math_mul3333xx33 - use FEsolving, only: & - terminallyIll - - implicit none - SNES :: snes_local - PetscInt :: PETScIter - PetscReal :: & - xnorm, & - snorm, & - fnorm - SNESConvergedReason :: reason - PetscObject :: dummy - PetscErrorCode :: ierr - real(pReal) :: & - curlTol, & - divTol, & - BCTol - -!-------------------------------------------------------------------------------------------------- -! stress BC handling - F_aim = F_aim - math_mul3333xx33(S, ((P_av - params%stress_BC))) ! S = 0.0 for no bc - err_BC = maxval(abs((1.0_pReal-mask_stress) * math_mul3333xx33(C_scale,F_aim-F_av) + & - mask_stress * (P_av-params%stress_BC))) ! mask = 0.0 for no bc - -!-------------------------------------------------------------------------------------------------- -! error calculation - curlTol = max(maxval(abs(F_aim-math_I3))*err_curl_tolRel ,err_curl_tolAbs) - divTol = max(maxval(abs(P_av)) *err_div_tolRel ,err_div_tolAbs) - BCTol = max(maxval(abs(P_av)) *err_stress_tolRel,err_stress_tolAbs) - - converged: if ((totalIter >= itmin .and. & - all([ err_div /divTol, & - err_curl/curlTol, & - err_BC /BCTol ] < 1.0_pReal)) & - .or. terminallyIll) then - reason = 1 - elseif (totalIter >= itmax) then converged - reason = -1 - else converged - reason = 0 - endif converged - -!-------------------------------------------------------------------------------------------------- -! report - write(6,'(1/,a)') ' ... reporting .............................................................' - write(6,'(/,a,f12.2,a,es8.2,a,es9.2,a)') ' error divergence = ', & - err_div/divTol, ' (',err_div, ' / m, tol = ',divTol,')' - write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error curl = ', & - err_curl/curlTol,' (',err_curl,' -, tol = ',curlTol,')' - write(6, '(a,f12.2,a,es8.2,a,es9.2,a)') ' error BC = ', & - err_BC/BCTol, ' (',err_BC, ' Pa, tol = ',BCTol,')' - write(6,'(/,a)') ' ===========================================================================' - flush(6) - -end subroutine AL_converged - -!-------------------------------------------------------------------------------------------------- -!> @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 AL_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC) - use math, only: & - math_mul33x33, & - math_mul3333xx33, & - math_transpose33, & - math_rotate_backward33 - use numerics, only: & - worldrank - use homogenization, only: & - materialpoint_F0 - use mesh, only: & - grid, & - grid3 - use CPFEM2, only: & - CPFEM_age - use spectral_utilities, only: & - Utilities_calculateRate, & - Utilities_forwardField, & - Utilities_updateIPcoords, & - tBoundaryCondition, & - cutBack - use IO, only: & - IO_write_JobRealFile - use FEsolving, only: & - restartWrite - - implicit none - logical, intent(in) :: & - guess - real(pReal), intent(in) :: & - timeinc_old, & - timeinc, & - loadCaseTime !< remaining time of current load case - type(tBoundaryCondition), intent(in) :: & - stress_BC, & - deformation_BC - real(pReal), dimension(3,3), intent(in) ::& - rotation_BC - PetscErrorCode :: ierr - PetscScalar, dimension(:,:,:,:), pointer :: FandF_lambda, F, F_lambda - integer(pInt) :: i, j, k - real(pReal), dimension(3,3) :: F_lambda33 - character(len=32) :: rankStr - -!-------------------------------------------------------------------------------------------------- -! update coordinates and rate and forward last inc - call DMDAVecGetArrayF90(da,solution_vec,FandF_lambda,ierr); CHKERRQ(ierr) - F => FandF_lambda( 0: 8,:,:,:) - F_lambda => FandF_lambda( 9:17,:,:,:) - - if (cutBack) then - C_volAvg = C_volAvgLastInc ! QUESTION: where is this required? - C_minMaxAvg = C_minMaxAvgLastInc ! QUESTION: where is this required? - else - !-------------------------------------------------------------------------------------------------- - ! restart information for spectral solver - if (restartWrite) then ! QUESTION: where is this logical properly set? - write(6,'(/,a)') ' writing converged results for restart' - flush(6) - - if (worldrank == 0_pInt) then - call IO_write_jobRealFile(777,'C_volAvg',size(C_volAvg)) - write (777,rec=1) C_volAvg; close(777) - call IO_write_jobRealFile(777,'C_volAvgLastInc',size(C_volAvgLastInc)) - write (777,rec=1) C_volAvgLastInc; close(777) - ! call IO_write_jobRealFile(777,'C_minMaxAvg',size(C_volAvg)) - ! write (777,rec=1) C_minMaxAvg; close(777) - ! call IO_write_jobRealFile(777,'C_minMaxAvgLastInc',size(C_volAvgLastInc)) - ! write (777,rec=1) C_minMaxAvgLastInc; close(777) - call IO_write_jobRealFile(777,'F_aimDot',size(F_aimDot)) - write (777,rec=1) F_aimDot; close(777) - endif - - write(rankStr,'(a1,i0)')'_',worldrank - call IO_write_jobRealFile(777,'F'//trim(rankStr),size(F)) ! writing deformation gradient field to file - write (777,rec=1) F; close (777) - call IO_write_jobRealFile(777,'F_lastInc'//trim(rankStr),size(F_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lastInc; close (777) - call IO_write_jobRealFile(777,'F_lambda'//trim(rankStr),size(F_lambda)) ! writing deformation gradient field to file - write (777,rec=1) F_lambda; close (777) - call IO_write_jobRealFile(777,'F_lambda_lastInc'//trim(rankStr),size(F_lambda_lastInc)) ! writing F_lastInc field to file - write (777,rec=1) F_lambda_lastInc; close (777) - endif - - call CPFEM_age() ! age state and kinematics - call utilities_updateIPcoords(F) - - C_volAvgLastInc = C_volAvg - C_minMaxAvgLastInc = C_minMaxAvg - - if (guess) then ! QUESTION: better with a = L ? x:y - F_aimDot = stress_BC%maskFloat * (F_aim - F_aim_lastInc)/timeinc_old ! initialize with correction based on last inc - else - F_aimDot = 0.0_pReal - endif - F_aim_lastInc = F_aim - !-------------------------------------------------------------------------------------------------- - ! calculate rate for aim - if (deformation_BC%myType=='l') then ! calculate F_aimDot from given L and current F - F_aimDot = & - F_aimDot + deformation_BC%maskFloat * math_mul33x33(deformation_BC%values, F_aim_lastInc) - elseif(deformation_BC%myType=='fdot') then ! F_aimDot is prescribed - F_aimDot = & - F_aimDot + deformation_BC%maskFloat * deformation_BC%values - elseif (deformation_BC%myType=='f') then ! aim at end of load case is prescribed - F_aimDot = & - F_aimDot + deformation_BC%maskFloat * (deformation_BC%values - F_aim_lastInc)/loadCaseTime - endif - - - Fdot = Utilities_calculateRate(guess, & - F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, & - math_rotate_backward33(F_aimDot,rotation_BC)) - F_lambdaDot = Utilities_calculateRate(guess, & - F_lambda_lastInc,reshape(F_lambda,[3,3,grid(1),grid(2),grid3]), timeinc_old, & - math_rotate_backward33(F_aimDot,rotation_BC)) - F_lastInc = reshape(F, [3,3,grid(1),grid(2),grid3]) ! winding F forward - F_lambda_lastInc = reshape(F_lambda, [3,3,grid(1),grid(2),grid3]) ! winding F_lambda forward - materialpoint_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3]) ! set starting condition for materialpoint_stressAndItsTangent - endif - -!-------------------------------------------------------------------------------------------------- -! update average and local deformation gradients - F_aim = F_aim_lastInc + F_aimDot * timeinc - - F = reshape(Utilities_forwardField(timeinc,F_lastInc,Fdot, & ! estimate of F at end of time+timeinc that matches rotated F_aim on average - math_rotate_backward33(F_aim,rotation_BC)),& - [9,grid(1),grid(2),grid3]) - if (guess) then - F_lambda = reshape(Utilities_forwardField(timeinc,F_lambda_lastInc,F_lambdadot), & - [9,grid(1),grid(2),grid3]) ! does not have any average value as boundary condition - else - do k = 1_pInt, grid3; do j = 1_pInt, grid(2); do i = 1_pInt, grid(1) - F_lambda33 = reshape(F_lambda(1:9,i,j,k),[3,3]) - F_lambda33 = math_mul3333xx33(S_scale,math_mul33x33(F_lambda33, & - math_mul3333xx33(C_scale,& - math_mul33x33(math_transpose33(F_lambda33),& - F_lambda33) -math_I3))*0.5_pReal)& - + math_I3 - F_lambda(1:9,i,j,k) = reshape(F_lambda33,[9]) - enddo; enddo; enddo - endif - - nullify(F) - nullify(F_lambda) - call DMDAVecRestoreArrayF90(da,solution_vec,FandF_lambda,ierr); CHKERRQ(ierr) - -end subroutine AL_forward - -!-------------------------------------------------------------------------------------------------- -!> @brief destroy routine -!-------------------------------------------------------------------------------------------------- -subroutine AL_destroy() - use spectral_utilities, only: & - Utilities_destroy - - implicit none - PetscErrorCode :: ierr - - external :: & - VecDestroy, & - SNESDestroy, & - DMDestroy - - call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) - call SNESDestroy(snes,ierr); CHKERRQ(ierr) - call DMDestroy(da,ierr); CHKERRQ(ierr) - -end subroutine AL_destroy - -end module spectral_mech_AL From f4842be34716cdbeb8e3b5ba2a67e123dacdcf15 Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Thu, 26 Apr 2018 14:18:12 +0200 Subject: [PATCH 45/54] AL solver should not be referenced any more in example files --- examples/ConfigFiles/numerics.config | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/ConfigFiles/numerics.config b/examples/ConfigFiles/numerics.config index ab8903927..3a654513e 100644 --- a/examples/ConfigFiles/numerics.config +++ b/examples/ConfigFiles/numerics.config @@ -67,7 +67,7 @@ maxCutBack 3 # maximum cut back level (0: 1, 1: 0.5, 2 memory_efficient 1 # Precalculate Gamma-operator (81 double per point) update_gamma 0 # Update Gamma-operator with current dPdF (not possible if memory_efficient=1) divergence_correction 2 # Use size-independent divergence criterion -spectralsolver basicPETSc # Type of spectral solver (basicPETSc: basic with PETSc, AL: augmented Lagrange) +spectralsolver basicPETSc # Type of spectral solver (basicPETSc/polarisation) spectralfilter none # Type of filtering method to mitigate Gibb's phenomenon (none, cosine, ...) petsc_options -snes_type ngmres -snes_ngmres_anderson # PetSc solver options regridMode 0 # 0: no regrid; 1: regrid if DAMASK doesn't converge; 2: regrid if DAMASK or BVP Solver doesn't converge From 8f36c4cf80417037040da1489b7c13f1d97043bb Mon Sep 17 00:00:00 2001 From: Jaeyong Jung Date: Thu, 26 Apr 2018 14:44:23 +0200 Subject: [PATCH 46/54] AL solver does not exist any more, use tests without it --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index af8516892..1be57fb53 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit af851689285b8c1a633495219abd9dbbd5a11c69 +Subproject commit 1be57fb53826778157c053ec8e5209cdc1f6f67b From 7d4fda9fcc4047451fdb9a3889f30cab6b87bf1a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 18:19:07 +0200 Subject: [PATCH 47/54] testing still contained AL related tests --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 1be57fb53..fabeb8be1 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 1be57fb53826778157c053ec8e5209cdc1f6f67b +Subproject commit fabeb8be15020e66377fd6c7cb83f819a81b9283 From 5f28fa02cc538943d7f6369a608f58a1b92e86f7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 26 Apr 2018 23:12:29 +0200 Subject: [PATCH 48/54] one more remaining al-related test caused trouble --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index fabeb8be1..186d61315 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit fabeb8be15020e66377fd6c7cb83f819a81b9283 +Subproject commit 186d61315bb1329deb0a8d871c4ea1b1c3dee2a5 From 726f90aff38d8909d52eef450e9a4c717f740905 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 27 Apr 2018 13:53:05 +0200 Subject: [PATCH 49/54] [skip ci] updated version information after successful test of v2.0.1-1144-g5f28fa0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 488dd8695..6e37920c9 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-1138-gfcac08c +v2.0.1-1144-g5f28fa0 From 362b958a8f8a0897ddcdcdec8db863c92391aaf9 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Tue, 1 May 2018 16:04:09 -0400 Subject: [PATCH 50/54] pulled most recent testing scripts --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 8546f9bda..186d61315 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 8546f9bda04b58c3b26979048288a8a01f607876 +Subproject commit 186d61315bb1329deb0a8d871c4ea1b1c3dee2a5 From 76e6fa24fbda3931591e65188419868829232653 Mon Sep 17 00:00:00 2001 From: Zhuowen Zhao Date: Thu, 3 May 2018 22:39:49 -0400 Subject: [PATCH 51/54] added check to the "Plasticity_DetectChanges" test and removed commented-out parts for kinematic hardening --- src/plastic_kinematichardening.f90 | 54 ++---------------------------- 1 file changed, 3 insertions(+), 51 deletions(-) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 6d7812a74..c33a14db6 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -51,12 +51,6 @@ module plastic_kinehardening outputID !< ID of each post result output real(pReal) :: & - ! F0, & -! mu, & -! mu0, & -! tau_hat0, & -! p1, & -! q1, & gdot0, & !< reference shear strain rate for slip (input parameter) n_slip, & !< stress exponent for slip (input parameter) aTolResistance, & @@ -325,25 +319,6 @@ subroutine plastic_kinehardening_init(fileUnit) param(instance)%nonSchmidCoeff(j) = IO_floatValue(line,chunkPos,1_pInt+j) enddo !-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip families - ! case ('F0') -! param(instance)%F0 = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('mu') -! param(instance)%mu = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('mu0') -! param(instance)%mu0 = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('tau_hat0') -! param(instance)%tau_hat0 = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('p1') -! param(instance)%p1 = IO_floatValue(line,chunkPos,2_pInt) -! -! case ('q1') -! param(instance)%q1 = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0') param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt) @@ -619,29 +594,6 @@ subroutine plastic_kinehardening_shearRates(gdot_pos,gdot_neg,tau_pos,tau_neg, & state(instance)%crss(:,of))**param(instance)%n_slip & *sign(1.0_pReal,tau_neg-state(instance)%crss_back(:,of)) -! gdot_pos = 0.5_pReal * param(instance)%gdot0 * & -! exp(-param(instance)%F0/(1.38e-23*298.15)* & -! (1-((abs(tau_pos-state(instance)%crss_back(:,of)) & -! -state(instance)%crss(:,of)*param(instance)%mu/param(instance)%mu) / & -! !---------------------------------------------------------------------------- -! param(instance)%tau_hat0*param(instance)%mu/param(instance)%mu & -! )**param(instance)%p1 & -! )**param(instance)%q1 & -! )*sign(1.0_pReal,(tau_pos-state(instance)%crss_back(:,of))) -! -! -! -! gdot_neg = 0.5_pReal * param(instance)%gdot0 * & -! exp(-param(instance)%F0/(1.38e-23*298.15)* & -! (1-((abs(tau_neg-state(instance)%crss_back(:,of)) & -! -state(instance)%crss(:,of)*param(instance)%mu/param(instance)%mu) / & -! !---------------------------------------------------------------------------- -! param(instance)%tau_hat0*param(instance)%mu/param(instance)%mu & -! )**param(instance)%p1 & -! )**param(instance)%q1 & -! )*sign(1.0_pReal,(tau_neg-state(instance)%crss_back(:,of))) - - end subroutine plastic_kinehardening_shearRates @@ -891,14 +843,14 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el) slipFamilies: do f = 1_pInt,lattice_maxNslipFamily slipSystems: do i = 1_pInt,plastic_kinehardening_Nslip(f,instance) j = j+1_pInt - dotState(instance)%crss(j,of) = & ! evolution of slip resistance j + dotState(instance)%crss(j,of) = & ! evolution of slip resistance j dot_product(param(instance)%hardeningMatrix_SlipSlip(j,1:nSlip),abs(gdot_pos+gdot_neg)) * & ( param(instance)%theta1(f) + & (param(instance)%theta0(f) - param(instance)%theta1(f) & + param(instance)%theta0(f)*param(instance)%theta1(f)*state(instance)%sumGamma(of)/param(instance)%tau1(f)) & - *exp(-state(instance)%sumGamma(of)*param(instance)%theta0(f)/param(instance)%tau1(f)) & ! V term depending on the harding law + *exp(-state(instance)%sumGamma(of)*param(instance)%theta0(f)/param(instance)%tau1(f)) & ! V term depending on the harding law ) - dotState(instance)%crss_back(j,of) = & ! evolution of back stress resistance j + dotState(instance)%crss_back(j,of) = & ! evolution of back stress resistance j state(instance)%sense(j,of)*abs(gdot_pos(j)+gdot_neg(j)) * & ( param(instance)%theta1_b(f) + & (param(instance)%theta0_b(f) - param(instance)%theta1_b(f) & From 08dbb766db8cd3bf6e51e07dda1dbc5693b80e3b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 4 May 2018 06:30:09 +0200 Subject: [PATCH 52/54] test suite should include kinehardening plasticity type --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 186d61315..13c8b129e 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 186d61315bb1329deb0a8d871c4ea1b1c3dee2a5 +Subproject commit 13c8b129e6d9ded04d0ac6cdc2fd0d50e17c57ed From 635c9a316f8e9f0137d7cd4cb5de8b6f0ecdf822 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 4 May 2018 11:25:57 +0200 Subject: [PATCH 53/54] test for kinematic hardeing failed due to missing reference file --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 13c8b129e..b7d1d3091 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 13c8b129e6d9ded04d0ac6cdc2fd0d50e17c57ed +Subproject commit b7d1d309146e017caa5744333c2e4a4532a6fc20 From 00a8f5b6f4036a50837405e3ee72e3d65b7e79d0 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 5 May 2018 07:30:31 +0200 Subject: [PATCH 54/54] [skip ci] updated version information after successful test of v2.0.1-1183-g991c917 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e37920c9..6ac87b4cc 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-1144-g5f28fa0 +v2.0.1-1183-g991c917