don't clutter with statements that are never used
This commit is contained in:
Martin Diehl
parent
972e041f59
commit
8ac880c0ad
|
|
@ -48,20 +48,6 @@ module homogenization
|
|||
|
||||
type(tNumerics) :: num
|
||||
|
||||
type :: tDebugOptions
|
||||
logical :: &
|
||||
basic, &
|
||||
extensive, &
|
||||
selective
|
||||
integer :: &
|
||||
element, &
|
||||
ip, &
|
||||
grain
|
||||
end type tDebugOptions
|
||||
|
||||
type(tDebugOptions) :: debugHomog
|
||||
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
interface
|
||||
|
||||
|
|
@ -125,24 +111,10 @@ subroutine homogenization_init
|
|||
|
||||
class (tNode) , pointer :: &
|
||||
num_homog, &
|
||||
num_homogGeneric, &
|
||||
debug_homogenization
|
||||
num_homogGeneric
|
||||
|
||||
print'(/,a)', ' <<<+- homogenization init -+>>>'; flush(IO_STDOUT)
|
||||
|
||||
debug_homogenization => config_debug%get('homogenization', defaultVal=emptyList)
|
||||
debugHomog%basic = debug_homogenization%contains('basic')
|
||||
debugHomog%extensive = debug_homogenization%contains('extensive')
|
||||
debugHomog%selective = debug_homogenization%contains('selective')
|
||||
debugHomog%element = config_debug%get_asInt('element',defaultVal = 1)
|
||||
debugHomog%ip = config_debug%get_asInt('integrationpoint',defaultVal = 1)
|
||||
debugHomog%grain = config_debug%get_asInt('grain',defaultVal = 1)
|
||||
|
||||
if (debugHomog%grain < 1 &
|
||||
.or. debugHomog%grain > homogenization_Nconstituents(material_homogenizationAt(debugHomog%element))) &
|
||||
call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain)
|
||||
|
||||
|
||||
num_homog => config_numerics%get('homogenization',defaultVal=emptyDict)
|
||||
num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
|
||||
|
||||
|
|
|
|||
|
|
@ -18,8 +18,6 @@ submodule(homogenization:homogenization_mech) homogenization_mech_RGC
|
|||
real(pReal), dimension(:), allocatable :: &
|
||||
D_alpha, &
|
||||
a_g
|
||||
integer :: &
|
||||
of_debug = 0
|
||||
character(len=pStringLen), allocatable, dimension(:) :: &
|
||||
output
|
||||
end type tParameters
|
||||
|
|
@ -151,12 +149,6 @@ module subroutine mech_RGC_init(num_homogMech)
|
|||
st0 => state0(homogenization_typeInstance(h)), &
|
||||
dst => dependentState(homogenization_typeInstance(h)))
|
||||
|
||||
#ifdef DEBUG
|
||||
if (h==material_homogenizationAt(debugHomog%element)) then
|
||||
prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element)
|
||||
endif
|
||||
#endif
|
||||
|
||||
#if defined (__GFORTRAN__)
|
||||
prm%output = output_asStrings(homogMech)
|
||||
#else
|
||||
|
|
@ -239,17 +231,6 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
|
|||
F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j) ! calculating deformation relaxations due to interface relaxation
|
||||
enddo
|
||||
F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF ! resulting relaxed deformation gradient
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print'(a,i3)',' Deformation gradient of grain: ',iGrain
|
||||
do i = 1,3
|
||||
print'(1x,3(e15.8,1x))',(F(i,j,iGrain), j = 1,3)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
enddo
|
||||
|
||||
end associate
|
||||
|
|
@ -273,10 +254,6 @@ module procedure mech_RGC_updateState
|
|||
logical :: error
|
||||
real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
|
||||
real(pReal), dimension(:), allocatable :: resid,relax,p_relax,p_resid,drelax
|
||||
#ifdef DEBUG
|
||||
integer, dimension(3) :: stresLoc
|
||||
integer, dimension(2) :: residLoc
|
||||
#endif
|
||||
|
||||
zeroTimeStep: if(dEq0(dt)) then
|
||||
mech_RGC_updateState = .true. ! pretend everything is fine and return
|
||||
|
|
@ -303,16 +280,6 @@ module procedure mech_RGC_updateState
|
|||
relax = stt%relaxationVector(:,of)
|
||||
drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Obtained state: '
|
||||
do i = 1,size(stt%relaxationVector(:,of))
|
||||
print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
|
||||
enddo
|
||||
print*,' '
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! computing interface mismatch and stress penalty tensor for all interfaces of all grains
|
||||
call stressPenalty(R,NN,avgF,F,ip,el,instance,of)
|
||||
|
|
@ -353,13 +320,6 @@ module procedure mech_RGC_updateState
|
|||
enddo
|
||||
enddo
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print'(a,i3)',' Traction at interface: ',iNum
|
||||
print'(1x,3(e15.8,1x))',(tract(iNum,j), j = 1,3)
|
||||
print*,' '
|
||||
endif
|
||||
#endif
|
||||
enddo
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
|
|
@ -367,29 +327,12 @@ module procedure mech_RGC_updateState
|
|||
stresMax = maxval(abs(P)) ! get the maximum of first Piola-Kirchhoff (material) stress
|
||||
residMax = maxval(abs(tract)) ! get the maximum of the residual
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) then
|
||||
stresLoc = maxloc(abs(P))
|
||||
residLoc = maxloc(abs(tract))
|
||||
print'(a,i2,1x,i4)',' RGC residual check ... ',ip,el
|
||||
print'(a,e15.8,a,i3,a,i2,i2)', ' Max stress: ',stresMax, &
|
||||
'@ grain ',stresLoc(3),' in component ',stresLoc(1),stresLoc(2)
|
||||
print'(a,e15.8,a,i3,a,i2)',' Max residual: ',residMax, &
|
||||
' @ iface ',residLoc(1),' in direction ',residLoc(2)
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
mech_RGC_updateState = .false.
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! If convergence reached => done and happy
|
||||
if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
|
||||
mech_RGC_updateState = .true.
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) &
|
||||
print*, '... done and happy'; flush(IO_STDOUT)
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! compute/update the state for postResult, i.e., all energy densities computed by time-integration
|
||||
|
|
@ -406,41 +349,14 @@ module procedure mech_RGC_updateState
|
|||
dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal)
|
||||
dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) then
|
||||
print'(a,e15.8)', ' Constitutive work: ',stt%work(of)
|
||||
print'(a,3(1x,e15.8))', ' Magnitude mismatch: ',dst%mismatch(1,of), &
|
||||
dst%mismatch(2,of), &
|
||||
dst%mismatch(3,of)
|
||||
print'(a,e15.8)', ' Penalty energy: ', stt%penaltyEnergy(of)
|
||||
print'(a,e15.8,/)', ' Volume discrepancy: ', dst%volumeDiscrepancy(of)
|
||||
print'(a,e15.8)', ' Maximum relaxation rate: ', dst%relaxationRate_max(of)
|
||||
print'(a,e15.8,/)', ' Average relaxation rate: ', dst%relaxationRate_avg(of)
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
return
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! if residual blows-up => done but unhappy
|
||||
elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then ! try to restart when residual blows up exceeding maximum bound
|
||||
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) &
|
||||
print'(a,/)', ' ... broken'; flush(IO_STDOUT)
|
||||
#endif
|
||||
|
||||
return
|
||||
|
||||
else ! proceed with computing the Jacobian and state update
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) &
|
||||
print'(a,/)', ' ... not yet done'; flush(IO_STDOUT)
|
||||
#endif
|
||||
|
||||
endif
|
||||
endif
|
||||
|
||||
!---------------------------------------------------------------------------------------------------
|
||||
! construct the global Jacobian matrix for updating the global relaxation vector array when
|
||||
|
|
@ -492,17 +408,6 @@ module procedure mech_RGC_updateState
|
|||
enddo
|
||||
enddo
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Jacobian matrix of stress'
|
||||
do i = 1,3*nIntFaceTot
|
||||
print'(1x,100(e11.4,1x))',(smatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
|
||||
! perturbation method) "pmatrix"
|
||||
|
|
@ -552,16 +457,6 @@ module procedure mech_RGC_updateState
|
|||
pmatrix(:,ipert) = p_resid/num%pPert
|
||||
enddo
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Jacobian matrix of penalty'
|
||||
do i = 1,3*nIntFaceTot
|
||||
print'(1x,100(e11.4,1x))',(pmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! ... of the numerical viscosity traction "rmatrix"
|
||||
|
|
@ -571,48 +466,16 @@ module procedure mech_RGC_updateState
|
|||
(abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal) ! only in the main diagonal term
|
||||
enddo
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Jacobian matrix of penalty'
|
||||
do i = 1,3*nIntFaceTot
|
||||
print'(1x,100(e11.4,1x))',(rmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix
|
||||
allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Jacobian matrix (total)'
|
||||
do i = 1,3*nIntFaceTot
|
||||
print'(1x,100(e11.4,1x))',(jmatrix(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! computing the update of the state variable (relaxation vectors) using the Jacobian matrix
|
||||
allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
|
||||
call math_invert(jnverse,error,jmatrix)
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Jacobian inverse'
|
||||
do i = 1,3*nIntFaceTot
|
||||
print'(1x,100(e11.4,1x))',(jnverse(i,j), j = 1,3*nIntFaceTot)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration
|
||||
drelax = 0.0_pReal
|
||||
|
|
@ -629,17 +492,6 @@ module procedure mech_RGC_updateState
|
|||
!$OMP END CRITICAL (write2out)
|
||||
endif
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive) then
|
||||
print*, 'Returned state: '
|
||||
do i = 1,size(stt%relaxationVector(:,of))
|
||||
print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
|
||||
enddo
|
||||
print*,' '
|
||||
flush(IO_STDOUT)
|
||||
endif
|
||||
#endif
|
||||
|
||||
end associate
|
||||
|
||||
contains
|
||||
|
|
@ -676,12 +528,6 @@ module procedure mech_RGC_updateState
|
|||
|
||||
associate(prm => param(instance))
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) then
|
||||
print'(a,2(1x,i3))', ' Correction factor: ',ip,el
|
||||
print*, surfCorr
|
||||
endif
|
||||
#endif
|
||||
|
||||
!-----------------------------------------------------------------------------------------------
|
||||
! computing the mismatch and penalty stress tensor of all grains
|
||||
|
|
@ -717,13 +563,7 @@ module procedure mech_RGC_updateState
|
|||
enddo; enddo
|
||||
nDefNorm = max(nDefToler,sqrt(nDefNorm)) ! approximation to zero mismatch if mismatch is zero (singularity)
|
||||
nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm ! total amount of mismatch experienced by the grain (at all six interfaces)
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) then
|
||||
print'(a,i2,a,i3)',' Mismatch to face: ',intFace(1),' neighbor grain: ',iGNghb
|
||||
print*, transpose(nDef)
|
||||
print'(a,e11.4)', ' with magnitude: ',nDefNorm
|
||||
endif
|
||||
#endif
|
||||
|
||||
|
||||
!-------------------------------------------------------------------------------------------
|
||||
! compute the stress penalty of all interfaces
|
||||
|
|
@ -735,12 +575,7 @@ module procedure mech_RGC_updateState
|
|||
*tanh(nDefNorm/num%xSmoo)
|
||||
enddo; enddo;enddo; enddo
|
||||
enddo interfaceLoop
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. prm%of_debug == of) then
|
||||
print'(a,i2)', ' Penalty of grain: ',iGrain
|
||||
print*, transpose(rPen(1:3,1:3,iGrain))
|
||||
endif
|
||||
#endif
|
||||
|
||||
|
||||
enddo grainLoop
|
||||
|
||||
|
|
@ -783,13 +618,6 @@ module procedure mech_RGC_updateState
|
|||
vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr* &
|
||||
sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0),vDiscrep)* &
|
||||
gVol(i)*transpose(math_inv33(fDef(:,:,i)))
|
||||
|
||||
#ifdef DEBUG
|
||||
if (debugHomog%extensive .and. param(instance)%of_debug == of) then
|
||||
print'(a,i2)',' Volume penalty of grain: ',i
|
||||
print*, transpose(vPen(:,:,i))
|
||||
endif
|
||||
#endif
|
||||
enddo
|
||||
|
||||
end subroutine volumePenalty
|
||||
|
|
|
|||
Loading…
Reference in New Issue