crystallite: restoration of last known good Lp_guess

CPFEM_Taylor: exit whenever cutback limit exceeded
This commit is contained in:
Luc Hantcherli 2008-04-28 16:04:08 +00:00
parent cdb2dd8808
commit 9626c25bfb
2 changed files with 38 additions and 17 deletions

View File

@ -249,7 +249,14 @@
CPFEM_dt,cp_en,CPFEM_in,grain,.true.,& CPFEM_dt,cp_en,CPFEM_in,grain,.true.,&
CPFEM_Temperature(CPFEM_in,cp_en),& CPFEM_Temperature(CPFEM_in,cp_en),&
CPFEM_ffn1_bar(:,:,CPFEM_in,cp_en),CPFEM_ffn_bar(:,:,CPFEM_in,cp_en),& CPFEM_ffn1_bar(:,:,CPFEM_in,cp_en),CPFEM_ffn_bar(:,:,CPFEM_in,cp_en),&
CPFEM_Fp_old(:,:,grain,CPFEM_in,cp_en),constitutive_state_old(:,grain,CPFEM_in,cp_en)) CPFEM_Fp_old(:,:,grain,CPFEM_in,cp_en),constitutive_state_old(:,grain,CPFEM_in,cp_en))
if (msg /= 'ok') then ! solution not reached --> exit
write(6,*) 'grain loop failed to converge @ EL:',cp_en,' IP:',CPFEM_in
call IO_error(600)
return
endif
volfrac = constitutive_matVolFrac(grain,CPFEM_in,cp_en)*constitutive_texVolFrac(grain,CPFEM_in,cp_en) volfrac = constitutive_matVolFrac(grain,CPFEM_in,cp_en)*constitutive_texVolFrac(grain,CPFEM_in,cp_en)
CPFEM_PK1_bar(:,:,CPFEM_in,cp_en) = CPFEM_PK1_bar(:,:,CPFEM_in,cp_en) + volfrac*PK1 CPFEM_PK1_bar(:,:,CPFEM_in,cp_en) = CPFEM_PK1_bar(:,:,CPFEM_in,cp_en) + volfrac*PK1
if (updateJaco) CPFEM_dPdF_bar(:,:,:,:,CPFEM_in,cp_en) = & if (updateJaco) CPFEM_dPdF_bar(:,:,:,:,CPFEM_in,cp_en) = &

View File

@ -89,19 +89,21 @@ CONTAINS
state_new = state_bestguess ! try best available guess for state state_new = state_bestguess ! try best available guess for state
call TimeIntegration(msg,Lp,Fp_new,Fe_new,P,state_new,post_results,.true., & ! def gradients and PK2 at end of time step call TimeIntegration(msg,Lp,Fp_new,Fe_new,P,state_new,post_results,.true., & ! def gradients and PK2 at end of time step
dt_aim,cp_en,ip,grain,Temperature,Fg_aim,Fp_current,state_current,0) dt_aim,cp_en,ip,grain,Temperature,Fg_aim,Fp_current,state_current,0_pInt)
! !
if (msg == 'ok') then if (msg == 'ok') then
cuttedBack = .false. ! no cut back required cuttedBack = .false. ! no cut back required
guessNew = .false. ! keep the Lp guessNew = .false. ! keep the Lp
subFrac = subFrac + subStep subFrac = subFrac + subStep
subStep = 1.0_pReal - subFrac ! try one go subStep = 1.0_pReal - subFrac ! try one go
if (debugger) write (6,*) '--------- one go -----------++##'
else else
nCutbacks = nCutbacks + 1 ! record additional cutback nCutbacks = nCutbacks + 1 ! record additional cutback
cuttedBack = .true. ! encountered problems --> cuttedBack = .true. ! encountered problems -->
guessNew = .true. ! redo plastic Lp guess guessNew = .true. ! redo plastic Lp guess
subStep = subStep / 2.0_pReal ! cut time step in half subStep = subStep / 2.0_pReal ! cut time step in half
state_bestguess = state_current ! current state is then best guess state_bestguess = state_current ! current state is then best guess
if (debugger) write (6,*) '>>>>>>>>>>>>>>>>>>>> cutback <<<<<<<<<<<<<<<<<<<<<<'
endif endif
enddo ! potential substepping enddo ! potential substepping
! !
@ -116,7 +118,7 @@ CONTAINS
Lp_pert = Lp Lp_pert = Lp
state_pert = state_new ! initial guess from end of time step state_pert = state_new ! initial guess from end of time step
call TimeIntegration(msg,Lp_pert,Fp_pert,Fe_pert,P_pert,state_pert,post_results,.false., & ! def gradients and PK2 at end of time step call TimeIntegration(msg,Lp_pert,Fp_pert,Fe_pert,P_pert,state_pert,post_results,.false., & ! def gradients and PK2 at end of time step
dt_aim,cp_en,ip,grain,Temperature,Fg_pert,Fp_current,state_current,1) dt_aim,cp_en,ip,grain,Temperature,Fg_pert,Fp_current,state_current,1_pInt)
if (msg == 'ok') & if (msg == 'ok') &
dPdF(:,:,k,l) = (P_pert-P)/pert_Fg ! constructing tangent dP_ij/dFg_kl only if valid forward difference dPdF(:,:,k,l) = (P_pert-P)/pert_Fg ! constructing tangent dP_ij/dFg_kl only if valid forward difference
! otherwise leave component unchanged ! otherwise leave component unchanged
@ -158,7 +160,8 @@ CONTAINS
use constitutive, only: constitutive_Nstatevars,& use constitutive, only: constitutive_Nstatevars,&
constitutive_homogenizedC,constitutive_dotState,constitutive_LpAndItsTangent,& constitutive_homogenizedC,constitutive_dotState,constitutive_LpAndItsTangent,&
constitutive_Nresults,constitutive_Microstructure,constitutive_post_results constitutive_Nresults,constitutive_Microstructure,constitutive_post_results
use math use math
use IO
implicit none implicit none
! !
character(len=*) msg character(len=*) msg
@ -204,7 +207,9 @@ Outer: do ! outer iteration: State
! !
iInner = 0_pInt iInner = 0_pInt
leapfrog = 1.0_pReal ! correction as suggested by invdRdLp-step leapfrog = 1.0_pReal ! correction as suggested by invdRdLp-step
maxleap = 1024.0_pReal ! preassign maximum acceleration level maxleap = 1024.0_pReal ! preassign maximum acceleration level
Lpguess_old = Lpguess ! consider present Lpguess good
! !
Inner: do ! inner iteration: Lp Inner: do ! inner iteration: Lp
iInner = iInner+1 iInner = iInner+1
@ -212,8 +217,8 @@ Inner: do ! inner iteration: Lp
msg = 'limit Inner iteration' msg = 'limit Inner iteration'
debug_InnerLoopDistribution(nInner) = debug_InnerLoopDistribution(nInner)+1 debug_InnerLoopDistribution(nInner) = debug_InnerLoopDistribution(nInner)+1
return return
endif endif
B = math_i3 - dt*Lpguess B = math_i3 - dt*Lpguess
BT = transpose(B) BT = transpose(B)
AB = matmul(A,B) AB = matmul(A,B)
@ -224,10 +229,12 @@ Inner: do ! inner iteration: Lp
forall(i=1:3) Tstar_v(i) = Tstar_v(i)-p_hydro ! subtract hydrostatic pressure forall(i=1:3) Tstar_v(i) = Tstar_v(i)-p_hydro ! subtract hydrostatic pressure
call constitutive_LpAndItsTangent(Lp,dLp, & call constitutive_LpAndItsTangent(Lp,dLp, &
Tstar_v,state,Temperature,grain,ip,cp_en) Tstar_v,state,Temperature,grain,ip,cp_en)
Rinner = Lpguess - Lp ! update current residuum
if (not(any(Rinner.NE.Rinner)) .and. & ! exclude all NaN in residuum Rinner = Lpguess - Lp ! update current residuum
if (not(any(Rinner.NE.Rinner)) .and. & ! exclude any NaN in residuum
( (maxval(abs(Rinner)) < abstol_Inner) .or. & ! below abs tol .or. ( (maxval(abs(Rinner)) < abstol_Inner) .or. & ! below abs tol .or.
( any(abs(dt*Lpguess) > relevantStrain) .and. & ! worth checking? .and. ( any(abs(dt*Lpguess) > relevantStrain) .and. & ! worth checking? .and.
maxval(abs(Rinner/Lpguess),abs(dt*Lpguess) > relevantStrain) < reltol_Inner & ! below rel tol maxval(abs(Rinner/Lpguess),abs(dt*Lpguess) > relevantStrain) < reltol_Inner & ! below rel tol
@ -236,14 +243,20 @@ Inner: do ! inner iteration: Lp
) & ) &
exit Inner ! convergence exit Inner ! convergence
! !
! check for acceleration/deceleration in Newton--Raphson correction ! check for acceleration/deceleration in Newton--Raphson correction
if (leapfrog > 1.0_pReal .and. &
if (any(Rinner.NE.Rinner) .and. & ! NaN occured at regular speed
leapfrog == 1.0) then
Lpguess = Lpguess_old ! restore known good guess
msg = 'NaN present' ! croak for cutback
return
elseif (leapfrog > 1.0_pReal .and. & ! at fast pace ?
(sum(Rinner*Rinner) > sum(Rinner_old*Rinner_old) .or. & ! worse residuum (sum(Rinner*Rinner) > sum(Rinner_old*Rinner_old) .or. & ! worse residuum
sum(Rinner*Rinner_old) < 0.0_pReal) .or. & ! residuum changed sign (overshoot) sum(Rinner*Rinner_old) < 0.0_pReal) .or. & ! residuum changed sign (overshoot)
any(Rinner.NE.Rinner) ) then ! NaN any(Rinner.NE.Rinner) ) then ! NaN
maxleap = 0.5_pReal * leapfrog ! limit next acceleration maxleap = 0.5_pReal * leapfrog ! limit next acceleration
leapfrog = 1.0_pReal ! grinding halt leapfrog = 1.0_pReal ! grinding halt
! if (debugger) write(6,*) 'grinding HALT'
else ! better residuum else ! better residuum
dTdLp = 0.0_pReal ! calc dT/dLp dTdLp = 0.0_pReal ! calc dT/dLp
forall (i=1:3,j=1:3,k=1:3,l=1:3,m=1:3,n=1:3) & forall (i=1:3,j=1:3,k=1:3,l=1:3,m=1:3,n=1:3) &
@ -259,11 +272,12 @@ Inner: do ! inner iteration: Lp
endif endif
! !
Rinner_old = Rinner ! remember current residuum Rinner_old = Rinner ! remember current residuum
Lpguess_old = Lpguess ! remember current Lp guess Lpguess_old = Lpguess ! remember current Lp guess
if (iInner > 1 .and. leapfrog < maxleap) leapfrog = 2.0_pReal * leapfrog ! accelerate if (iInner > 1 .and. leapfrog < maxleap) &
leapfrog = 2.0_pReal * leapfrog ! accelerate if ok
endif endif
! !
Lpguess = Lpguess_old ! start from current guess Lpguess = Lpguess_old ! start from current guess
Rinner = Rinner_old ! use current residuum Rinner = Rinner_old ! use current residuum
forall (i=1:3,j=1:3,k=1:3,l=1:3) & ! leapfrog to updated Lpguess forall (i=1:3,j=1:3,k=1:3,l=1:3) & ! leapfrog to updated Lpguess
Lpguess(i,j) = Lpguess(i,j) - leapfrog*invdRdLp(3*(i-1)+j,3*(k-1)+l)*Rinner(k,l) Lpguess(i,j) = Lpguess(i,j) - leapfrog*invdRdLp(3*(i-1)+j,3*(k-1)+l)*Rinner(k,l)