From 695b331db09542ca241502489b08a24ccdfd756d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 18 Jan 2019 23:09:46 +0100 Subject: [PATCH] takeover from old 46-XXX branch --- src/crystallite.f90 | 264 +++++++++++++++++++------------------------- 1 file changed, 111 insertions(+), 153 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 2d25ae94f..cadca932f 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -43,7 +43,6 @@ module crystallite crystallite_Tstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of FE inc ToDo: Should be called S, 3x3 crystallite_partionedTstar0_v !< 2nd Piola-Kirchhoff stress vector at start of homog inc ToDo: Should be called S, 3x3 real(pReal), dimension(:,:,:,:), allocatable, private :: & - crystallite_subTstar0_v, & !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_orientation, & !< orientation as quaternion crystallite_orientation0, & !< initial orientation as quaternion crystallite_rotation !< grain rotation away from initial orientation as axis-angle (in degrees) in crystal reference frame @@ -205,7 +204,6 @@ subroutine crystallite_init ! ToDo (when working on homogenization): should be 3x3 tensor called S allocate(crystallite_Tstar0_v(6,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_partionedTstar0_v(6,cMax,iMax,eMax), source=0.0_pReal) - allocate(crystallite_subTstar0_v(6,cMax,iMax,eMax), source=0.0_pReal) allocate(crystallite_Tstar_v(6,cMax,iMax,eMax), source=0.0_pReal) ! --------------------------------------------------------------------------- @@ -398,16 +396,16 @@ subroutine crystallite_init crystallite_orientation0 = crystallite_orientation ! store initial orientations for calculation of grain rotations !$OMP PARALLEL DO - do e = FEsolving_execElem(1),FEsolving_execElem(2) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) - call constitutive_microstructure(crystallite_orientation, & ! pass orientation to constitutive module - crystallite_Fe(1:3,1:3,c,i,e), & - crystallite_Fp(1:3,1:3,c,i,e), & - c,i,e) ! update dependent state variables to be consistent with basic states - enddo - enddo + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do c = 1_pInt,homogenization_Ngrains(mesh_element(3,e)) + call constitutive_microstructure(crystallite_orientation, & + crystallite_Fe(1:3,1:3,c,i,e), & + crystallite_Fp(1:3,1:3,c,i,e), & + c,i,e) ! update dependent state variables to be consistent with basic states + enddo enddo + enddo !$OMP END PARALLEL DO devNull = crystallite_stress() @@ -862,12 +860,12 @@ subroutine crystallite_stressTangent() do p=1_pInt, 3_pInt crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33_1) enddo - do concurrent(p=1_pInt:3_pInt, o=1_pInt:3_pInt) + forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + & math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33_2) + & math_mul33x33(math_mul33x33(temp_33_3,dSdF(1:3,1:3,p,o)),transpose(crystallite_invFp(1:3,1:3,c,i,e))) + & math_mul33x33(temp_33_4,transpose(dFpinvdF(1:3,1:3,p,o))) - enddo + end forall enddo; enddo enddo elementLooping @@ -1037,22 +1035,14 @@ logical function integrateStress(& use math, only: math_mul33x33, & math_mul33xx33, & math_mul3333xx3333, & - math_mul66x6, & - math_mul99x99, & math_inv33, & math_det33, & math_I3, & math_identity2nd, & - math_Mandel66to3333, & - math_Mandel6to33, & - math_Mandel33to6, & - math_Plain3333to99, & - math_Plain33to9, & - math_Plain9to33, & - math_Plain99to3333 -#ifdef DEBUG - use mesh, only: mesh_element -#endif + math_sym33to6, & + math_3333to99, & + math_33to9, & + math_9to33 implicit none integer(pInt), intent(in):: el, & ! element index @@ -1060,10 +1050,7 @@ logical function integrateStress(& 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 - Fp_current, & ! plastic deformation gradient at start of timestep - Fi_current, & ! intermediate deformation gradient at start of timestep Fp_new, & ! plastic deformation gradient at end of timestep Fe_new, & ! elastic deformation gradient at end of timestep invFp_new, & ! inverse of Fp_new @@ -1083,17 +1070,16 @@ logical function integrateStress(& residuumLi, & ! current residuum of intermediate velocity gradient residuumLi_old, & ! last residuum of intermediate velocity gradient deltaLi, & ! direction of next guess - Tstar, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration + S, & ! 2nd Piola-Kirchhoff Stress in plastic (lattice) configuration A, & B, & Fe, & ! elastic deformation gradient temp_33 - real(pReal), dimension(6):: Tstar_v ! 2nd Piola-Kirchhoff Stress in Mandel-Notation real(pReal), dimension(9):: work ! needed for matrix inversion by LAPACK - integer(pInt), dimension(9) :: ipiv ! needed for matrix inversion by LAPACK - real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for NEwton-Raphson scheme) + integer(pInt), dimension(9) :: devNull ! needed for matrix inversion by LAPACK + real(pReal), dimension(9,9) :: dRLp_dLp, & ! partial derivative of residuum (Jacobian for Newton-Raphson scheme) dRLp_dLp2, & ! working copy of dRdLp - dRLi_dLi ! partial derivative of residuumI (Jacobian for NEwton-Raphson scheme) + dRLi_dLi ! partial derivative of residuumI (Jacobian for Newton-Raphson scheme) real(pReal), dimension(3,3,3,3):: dS_dFe, & ! partial derivative of 2nd Piola-Kirchhoff stress dS_dFi, & dFe_dLp, & ! partial derivative of elastic deformation gradient @@ -1128,8 +1114,6 @@ logical function integrateStress(& 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 dt = crystallite_subdt(ipc,ip,el) * timeFraction Fg_new = crystallite_subF0(1:3,1:3,ipc,ip,el) & @@ -1141,47 +1125,36 @@ logical function integrateStress(& !* feed local variables - - Fp_current = crystallite_subFp0(1:3,1:3,ipc,ip,el) ! "Fp_current" is only used as temp var here... - Lpguess = crystallite_Lp (1:3,1:3,ipc,ip,el) ! ... and take it as first guess - Fi_current = crystallite_subFi0(1:3,1:3,ipc,ip,el) ! intermediate configuration, assume decomposition as F = Fe Fi Fp - Liguess = crystallite_Li (1:3,1:3,ipc,ip,el) ! ... and take it as first guess + Lpguess = crystallite_Lp(1:3,1:3,ipc,ip,el) ! ... and take it as first guess + Liguess = crystallite_Li(1:3,1:3,ipc,ip,el) ! ... and take it as first guess Liguess_old = Liguess - - !* inversion of Fp_current... - - invFp_current = math_inv33(Fp_current) + invFp_current = math_inv33(crystallite_subFp0(1:3,1:3,ipc,ip,el)) failedInversionFp: if (all(dEq0(invFp_current))) then #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 ipc ',& - el,'(',mesh_element(1,el),')',ip,ipc - if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & - write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fp_current(1:3,1:3)) - endif + if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of current Fp at el ip ipc ',& + el,ip,ipc + if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & + write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> current Fp ',transpose(crystallite_subFp0(1:3,1:3,ipc,ip,el)) #endif return endif failedInversionFp A = math_mul33x33(Fg_new,invFp_current) ! intermediate tensor needed later to calculate dFe_dLp - !* inversion of Fi_current... - - invFi_current = math_inv33(Fi_current) + invFi_current = math_inv33(crystallite_subFi0(1:3,1:3,ipc,ip,el)) failedInversionFi: if (all(dEq0(invFi_current))) then #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 - if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & - write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fi_current(1:3,1:3)) - endif + if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of current Fi at el ip ipc ',& + el,ip,ipc + if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & + write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> current Fi ',transpose(crystallite_subFi0(1:3,1:3,ipc,ip,el)) #endif return endif failedInversionFi - !* start LpLoop with normal step length - + !* start Li loop with normal step length NiterationStressLi = 0_pInt jacoCounterLi = 0_pInt steplengthLi = 1.0_pReal @@ -1189,82 +1162,73 @@ logical function integrateStress(& LiLoop: do NiterationStressLi = NiterationStressLi + 1_pInt - IloopsExeced: if (NiterationStressLi > nStress) then + LiLoopLimit: if (NiterationStressLi > nStress) then #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 + write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached Li loop limit',nStress, & + ' at el ip ipc ', el,ip,ipc #endif return - endif IloopsExeced + endif LiLoopLimit invFi_new = math_mul33x33(invFi_current,math_I3 - dt*Liguess) Fi_new = math_inv33(invFi_new) detInvFi = math_det33(invFi_new) + !* start Lp loop with normal step length NiterationStressLp = 0_pInt jacoCounterLp = 0_pInt steplengthLp = 1.0_pReal residuumLp_old = 0.0_pReal Lpguess_old = Lpguess - LpLoop: do ! inner stress integration loop for consistency with Fi + LpLoop: do NiterationStressLp = NiterationStressLp + 1_pInt - loopsExeced: if (NiterationStressLp > nStress) then + LpLoopLimit: if (NiterationStressLp > nStress) then #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 + write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached Lp loop limit',nStress, & + ' at el ip ipc ', el,ip,ipc #endif return - endif loopsExeced + endif LpLoopLimit !* calculate (elastic) 2nd Piola--Kirchhoff stress tensor and its tangent from constitutive law B = math_I3 - dt*Lpguess - Fe = math_mul33x33(math_mul33x33(A,B), invFi_new) ! current elastic deformation tensor - call constitutive_SandItsTangents(Tstar, dS_dFe, dS_dFi, & - 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) + Fe = math_mul33x33(math_mul33x33(A,B), invFi_new) + call constitutive_SandItsTangents(S, dS_dFe, dS_dFi, & + Fe, Fi_new, ipc, ip, el) ! call constitutive law to calculate 2nd Piola-Kirchhoff stress and its derivative in unloaded configuration !* calculate plastic velocity gradient and its tangent from constitutive law + call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & + math_sym33to6(S), Fi_new, ipc, ip, el) #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,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', transpose(Lpguess) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', transpose(Fi_new) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', transpose(Fe) - write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v - endif -#endif - call constitutive_LpAndItsTangents(Lp_constitutive, dLp_dS, dLp_dFi, & - Tstar_v, Fi_new, ipc, ip, el) - -#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,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> S', transpose(S) write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', transpose(Lp_constitutive) endif #endif - !* update current residuum and check for convergence of loop - - aTolLp = max(rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error - aTol_crystalliteStress) ! minimum lower cutoff + aTolLp = max(rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), & ! absolute tolerance from largest acceptable relative error + aTol_crystalliteStress) ! minimum lower cutoff residuumLp = Lpguess - Lp_constitutive - if (any(IEEE_is_NaN(residuumLp))) then ! NaN in residuum... + if (any(IEEE_is_NaN(residuumLp))) then #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, & - ' ; iteration ', NiterationStressLp,& - ' >> returning..!' + write(6,'(a,i8,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN for Lp-residuum at el ip ipc ', & + el,ip,ipc, & + ' ; iteration ', NiterationStressLp,& + ' >> returning..!' #endif return ! ...me = .false. to inform integrator about problem elseif (norm2(residuumLp) < aTolLp) then ! converged if below absolute tolerance @@ -1276,7 +1240,7 @@ logical function integrateStress(& steplengthLp = 1.0_pReal ! ...proceed with normal step length (calculate new search direction) else ! not converged and residuum not improved... steplengthLp = subStepSizeLp * steplengthLp ! ...try with smaller step length in same direction - Lpguess = Lpguess_old + steplengthLp * deltaLp + 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) & @@ -1289,40 +1253,38 @@ logical function integrateStress(& !* calculate Jacobian for correction term - if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then - dFe_dLp = 0.0_pReal forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) & - dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) + dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) dFe_dLp = - dt * dFe_dLp dRLp_dLp = math_identity2nd(9_pInt) & - - math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) + - math_3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dS,dS_dFe),dFe_dLp)) #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_dS', math_Plain3333to99(dLp_dS) - write(6,'(a,1x,e20.10)') '<< CRYST >> dLp_dS norm', norm2(math_Plain3333to99(dLp_dS)) + write(6,'(a,/,9(12x,9(e12.4,1x)/))') '<< CRYST >> dLp_dS', math_3333to99(dLp_dS) + write(6,'(a,1x,e20.10)') '<< CRYST >> dLp_dS norm', norm2(math_3333to99(dLp_dS)) 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)) + 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 + dRLp_dLp2 = dRLp_dLp ! will be overwritten in first call to LAPACK routine + work = math_33to9(residuumLp) + call dgesv(9,1,dRLp_dLp2,9,devNull,work,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp if (ierr /= 0_pInt) then #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 dR/dLp inversion at el (elFE) ip ipc ', & - el,'(',mesh_element(1,el),')',ip,ipc + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip ipc ', & + el,ip,ipc 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,*) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dR_dLp',transpose(dRLp_dLp) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_Plain3333to99(dFe_dLp)) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dS_dFe_constitutive',transpose(math_Plain3333to99(dS_dFe)) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dS_constitutive',transpose(math_Plain3333to99(dLp_dS)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_3333to99(dFe_dLp)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dS_dFe_constitutive',transpose(math_3333to99(dS_dFe)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dS_constitutive',transpose(math_3333to99(dLp_dS)) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',transpose(A) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',transpose(B) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',transpose(Lp_constitutive) @@ -1332,18 +1294,17 @@ logical function integrateStress(& #endif return endif - deltaLp = - math_plain9to33(work) + deltaLp = - math_9to33(work) endif - jacoCounterLp = jacoCounterLp + 1_pInt ! increase counter for jaco update + jacoCounterLp = jacoCounterLp + 1_pInt Lpguess = Lpguess + steplengthLp * deltaLp enddo LpLoop !* calculate intermediate velocity gradient and its tangent from constitutive law - call constitutive_LiAndItsTangents(Li_constitutive, dLi_dS, dLi_dFi, & - Tstar_v, Fi_new, ipc, ip, el) + math_sym33to6(S), Fi_new, ipc, ip, el) #ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & @@ -1353,12 +1314,19 @@ logical function integrateStress(& write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', transpose(Liguess) endif #endif - !* update current residuum and check for convergence of loop + !* update current residuum and check for convergence of loop aTolLi = max(rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), & ! absolute tolerance from largest acceptable relative error aTol_crystalliteStress) ! minimum lower cutoff residuumLi = Liguess - Li_constitutive if (any(IEEE_is_NaN(residuumLi))) then ! NaN in residuum... +#ifdef DEBUG + if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & + write(6,'(a,i8,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN for Li-residuum at el ip ipc ', & + el,ip,ipc, & + ' ; iteration ', NiterationStressLi,& + ' >> returning..!' +#endif return ! ...me = .false. to inform integrator about problem elseif (norm2(residuumLi) < aTolLi) then ! converged if below absolute tolerance exit LiLoop ! ...leave iteration loop @@ -1374,11 +1342,8 @@ logical function integrateStress(& endif !* calculate Jacobian for correction term - if (mod(jacoCounterLi, iJacoLpresiduum) == 0_pInt) then temp_33 = math_mul33x33(math_mul33x33(A,B),invFi_current) - dFe_dLi = 0.0_pReal - dFi_dLi = 0.0_pReal forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33 ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j) dFi_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*invFi_current @@ -1387,24 +1352,24 @@ logical function integrateStress(& dFi_dLi(1:3,1:3,o,p) = math_mul33x33(math_mul33x33(Fi_new,dFi_dLi(1:3,1:3,o,p)),Fi_new) dRLi_dLi = math_identity2nd(9_pInt) & - - math_Plain3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) + & - math_mul3333xx3333(dS_dFi, dFi_dLi))) & - - math_Plain3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) - work = math_plain33to9(residuumLi) - call dgesv(9,1,dRLi_dLi,9,ipiv,work,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li + - math_3333to99(math_mul3333xx3333(dLi_dS, math_mul3333xx3333(dS_dFe, dFe_dLi) + & + math_mul3333xx3333(dS_dFi, dFi_dLi))) & + - math_3333to99(math_mul3333xx3333(dLi_dFi, dFi_dLi)) + work = math_33to9(residuumLi) + call dgesv(9,1,dRLi_dLi,9,devNull,work,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li if (ierr /= 0_pInt) then #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 dR/dLi inversion at el (elFE) ip ipc ', & - el,'(',mesh_element(1,el),')',ip,ipc + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on dR/dLi inversion at el ip ipc ', & + el,ip,ipc 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,*) write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dR_dLi',transpose(dRLi_dLi) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_Plain3333to99(dFe_dLi)) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dS_dFi_constitutive',transpose(math_Plain3333to99(dS_dFi)) - write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dS_constitutive',transpose(math_Plain3333to99(dLi_dS)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_3333to99(dFe_dLi)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dS_dFi_constitutive',transpose(math_3333to99(dS_dFi)) + write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dS_constitutive',transpose(math_3333to99(dLi_dS)) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',transpose(Li_constitutive) write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',transpose(Liguess) endif @@ -1413,23 +1378,22 @@ logical function integrateStress(& return endif - deltaLi = - math_plain9to33(work) + deltaLi = - math_9to33(work) endif - jacoCounterLi = jacoCounterLi + 1_pInt ! increase counter for jaco update + jacoCounterLi = jacoCounterLi + 1_pInt Liguess = Liguess + steplengthLi * deltaLi enddo LiLoop !* calculate new plastic and elastic deformation gradient - invFp_new = math_mul33x33(invFp_current,B) - invFp_new = invFp_new / math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize by det + invFp_new = invFp_new / math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize Fp_new = math_inv33(invFp_new) failedInversionInvFp: if (all(dEq0(Fp_new))) then #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 (elFE) ip ipc ',& - el,'(',mesh_element(1,el),')',ip,ipc, ' ; iteration ', NiterationStressLp + write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip ipc ', & + el,ip,ipc 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)) & @@ -1438,28 +1402,22 @@ logical function integrateStress(& #endif return endif failedInversionInvFp - Fe_new = math_mul33x33(math_mul33x33(Fg_new,invFp_new),invFi_new) ! calc resulting Fe + Fe_new = math_mul33x33(math_mul33x33(Fg_new,invFp_new),invFi_new) - !* calculate 1st Piola-Kirchhoff stress - - crystallite_P(1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), & - math_mul33x33(math_Mandel6to33(Tstar_v), & - transpose(invFp_new))) - - !* store local values in global variables - - crystallite_Lp(1:3,1:3,ipc,ip,el) = Lpguess - crystallite_Li(1:3,1:3,ipc,ip,el) = Liguess - crystallite_Tstar_v(1:6,ipc,ip,el) = Tstar_v - crystallite_Fp(1:3,1:3,ipc,ip,el) = Fp_new - crystallite_Fi(1:3,1:3,ipc,ip,el) = Fi_new - crystallite_Fe(1:3,1:3,ipc,ip,el) = Fe_new +!-------------------------------------------------------------------------------------------------- +! stress integration was successful + integrateStress = .true. + crystallite_P (1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), & + math_mul33x33(S,transpose(invFp_new))) + crystallite_Tstar_v (1:6,ipc,ip,el) = math_sym33to6(S) + crystallite_Lp (1:3,1:3,ipc,ip,el) = Lpguess + crystallite_Li (1:3,1:3,ipc,ip,el) = Liguess + crystallite_Fp (1:3,1:3,ipc,ip,el) = Fp_new + crystallite_Fi (1:3,1:3,ipc,ip,el) = Fi_new + crystallite_Fe (1:3,1:3,ipc,ip,el) = Fe_new crystallite_invFp(1:3,1:3,ipc,ip,el) = invFp_new crystallite_invFi(1:3,1:3,ipc,ip,el) = invFi_new - !* set return flag to true - - integrateStress = .true. #ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -1468,7 +1426,7 @@ logical function integrateStress(& write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', & math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), transpose(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', & - transpose(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order + transpose(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)) write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)) endif