polishing (partly redoing changes that got lost when going to rev 3000)
This commit is contained in:
Martin Diehl
parent
51e7f9eed9
commit
fcb89f7e75
|
|
@ -43,9 +43,6 @@ OTHERSTATES = ['velocityEdgePos ', &
|
|||
real(pReal), parameter, private :: &
|
||||
KB = 1.38e-23_pReal !< Physical parameter, Boltzmann constant in J/Kelvin
|
||||
|
||||
|
||||
!* Definition of global variables
|
||||
|
||||
integer(pInt), dimension(:), allocatable, public, protected :: &
|
||||
constitutive_nonlocal_sizeDotState, & !< number of dotStates = number of basic state variables
|
||||
constitutive_nonlocal_sizeDependentState, & !< number of dependent state variables
|
||||
|
|
@ -1552,15 +1549,16 @@ if (.not. phase_localPlasticity(phase) .and. shortRangeStressCorrection(instance
|
|||
|
||||
rhoExcessGradient_over_rho = 0.0_pReal
|
||||
forall (c = 1_pInt:2_pInt) &
|
||||
rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) + sum(neighbor_rhoTotal(c,s,:))) &
|
||||
/ real(1_pInt + nRealNeighbors,pReal)
|
||||
rhoTotal(c) = (sum(abs(rhoSgl(s,[2*c-1,2*c,2*c+3,2*c+4]))) + rhoDip(s,c) &
|
||||
+ sum(neighbor_rhoTotal(c,s,:))) / real(1_pInt + nRealNeighbors,pReal)
|
||||
forall (c = 1_pInt:2_pInt, rhoTotal(c) > 0.0_pReal) &
|
||||
rhoExcessGradient_over_rho(c) = rhoExcessGradient(c) / rhoTotal(c)
|
||||
|
||||
!* gives the local stress correction when multiplied with a factor
|
||||
|
||||
tauBack(s) = - lattice_mu(phase) * burgers(s,instance) / (2.0_pReal * pi) &
|
||||
* (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(phase)) + rhoExcessGradient_over_rho(2))
|
||||
* (rhoExcessGradient_over_rho(1) / (1.0_pReal - lattice_nu(phase)) &
|
||||
+ rhoExcessGradient_over_rho(2))
|
||||
|
||||
enddo
|
||||
endif
|
||||
|
|
@ -2036,7 +2034,6 @@ ns = totalNslip(instance)
|
|||
|
||||
!*** shortcut to state variables
|
||||
|
||||
|
||||
forall (s = 1_pInt:ns, t = 1_pInt:4_pInt)
|
||||
rhoSgl(s,t) = max(state%p(iRhoU(s,t,instance)), 0.0_pReal) ! ensure positive single mobile densities
|
||||
rhoSgl(s,t+4_pInt) = state%p(iRhoB(s,t,instance))
|
||||
|
|
@ -2091,43 +2088,7 @@ dUpper(1:ns,1) = lattice_mu(phase) * burgers(1:ns,instance) &
|
|||
dUpper(1:ns,2) = lattice_mu(phase) * burgers(1:ns,instance) / (4.0_pReal * pi * abs(tau))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
!in the test there is an FPE exception. Divistion by zero?
|
||||
!in the test there is an FPE exception. Division by zero?
|
||||
forall (c = 1_pInt:2_pInt) &
|
||||
dUpper(1:ns,c) = min(1.0_pReal / sqrt(rhoSgl(1:ns,2*c-1) + rhoSgl(1:ns,2*c) &
|
||||
+ abs(rhoSgl(1:ns,2*c+3)) + abs(rhoSgl(1:ns,2*c+4)) + rhoDip(1:ns,c)), &
|
||||
|
|
@ -2140,10 +2101,12 @@ deltaDUpper = dUpper - dUpperOld
|
|||
|
||||
deltaRhoDipole2SingleStress = 0.0_pReal
|
||||
forall (c=1_pInt:2_pInt, s=1_pInt:ns, deltaDUpper(s,c) < 0.0_pReal) &
|
||||
deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) / (dUpperOld(s,c) - dLower(s,c))
|
||||
deltaRhoDipole2SingleStress(s,8_pInt+c) = rhoDip(s,c) * deltaDUpper(s,c) &
|
||||
/ (dUpperOld(s,c) - dLower(s,c))
|
||||
|
||||
forall (t=1_pInt:4_pInt) &
|
||||
deltaRhoDipole2SingleStress(1_pInt:ns,t) = -0.5_pReal * deltaRhoDipole2SingleStress(1_pInt:ns,(t-1_pInt)/2_pInt+9_pInt)
|
||||
deltaRhoDipole2SingleStress(1_pInt:ns,t) = -0.5_pReal &
|
||||
* deltaRhoDipole2SingleStress(1_pInt:ns,(t-1_pInt)/2_pInt+9_pInt)
|
||||
|
||||
|
||||
|
||||
|
|
@ -2674,7 +2637,6 @@ endif
|
|||
!*** formation by glide
|
||||
|
||||
do c = 1_pInt,2_pInt
|
||||
|
||||
rhoDotSingle2DipoleGlide(1:ns,2*c-1) = -2.0_pReal * dUpper(1:ns,c) / burgers(1:ns,instance) &
|
||||
* (rhoSgl(1:ns,2*c-1) * abs(gdot(1:ns,2*c)) & ! negative mobile --> positive mobile
|
||||
+ rhoSgl(1:ns,2*c) * abs(gdot(1:ns,2*c-1)) & ! positive mobile --> negative mobile
|
||||
|
|
@ -2724,7 +2686,8 @@ vClimb = atomicVolume(instance) * selfDiffusion / ( KB * Temperature ) &
|
|||
* 2.0_pReal / ( dUpper(1:ns,1) + dLower(1:ns,1) )
|
||||
forall (s = 1_pInt:ns, dUpper(s,1) > dLower(s,1)) &
|
||||
rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * vClimb(s) / (dUpper(s,1) - dLower(s,1)), &
|
||||
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) - rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
|
||||
- rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
|
||||
- rhoDotSingle2DipoleGlide(s,9)) ! make sure that we do not annihilate more dipoles than we have
|
||||
|
||||
|
||||
|
||||
|
|
@ -2753,14 +2716,18 @@ endif
|
|||
if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt &
|
||||
.and. ((debug_e == el .and. debug_i == ip .and. debug_g == ipc)&
|
||||
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then
|
||||
write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', rhoDotMultiplication(1:ns,1:4) * timestep
|
||||
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', rhoDotFlux(1:ns,1:8) * timestep
|
||||
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', rhoDotSingle2DipoleGlide * timestep
|
||||
write(6,'(a,/,4(12x,12(e12.5,1x),/))') '<< CONST >> dislocation multiplication', &
|
||||
rhoDotMultiplication(1:ns,1:4) * timestep
|
||||
write(6,'(a,/,8(12x,12(e12.5,1x),/))') '<< CONST >> dislocation flux', &
|
||||
rhoDotFlux(1:ns,1:8) * timestep
|
||||
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> dipole formation by glide', &
|
||||
rhoDotSingle2DipoleGlide * timestep
|
||||
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> athermal dipole annihilation', &
|
||||
rhoDotAthermalAnnihilation * timestep
|
||||
write(6,'(a,/,2(12x,12(e12.5,1x),/))') '<< CONST >> thermally activated dipole annihilation', &
|
||||
rhoDotThermalAnnihilation(1:ns,9:10) * timestep
|
||||
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> total density change', rhoDot * timestep
|
||||
write(6,'(a,/,10(12x,12(e12.5,1x),/))') '<< CONST >> total density change', &
|
||||
rhoDot * timestep
|
||||
write(6,'(a,/,10(12x,12(f12.5,1x),/))') '<< CONST >> relative density change', &
|
||||
rhoDot(1:ns,1:8) * timestep / (abs(rhoSglOriginal)+1.0e-10), &
|
||||
rhoDot(1:ns,9:10) * timestep / (rhoDipOriginal+1.0e-10)
|
||||
|
|
@ -2830,8 +2797,6 @@ integer(pInt), intent(in) :: i, & !
|
|||
real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
||||
orientation ! crystal orientation in quaternions
|
||||
|
||||
!* output variables
|
||||
|
||||
!* local variables
|
||||
integer(pInt) Nneighbors, & ! number of neighbors
|
||||
n, & ! neighbor index
|
||||
|
|
@ -2997,62 +2962,59 @@ use lattice, only: lattice_mu, &
|
|||
|
||||
implicit none
|
||||
|
||||
|
||||
!*** input variables
|
||||
integer(pInt), intent(in) :: ipc, & ! current grain ID
|
||||
ip, & ! current integration point
|
||||
el ! current element
|
||||
integer(pInt), intent(in) :: ipc, & !< current grain ID
|
||||
ip, & !< current integration point
|
||||
el !< current element
|
||||
real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
||||
Fe ! elastic deformation gradient
|
||||
Fe !< elastic deformation gradient
|
||||
type(p_vec), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: &
|
||||
state ! microstructural state
|
||||
|
||||
!*** input/output variables
|
||||
state !< microstructural state
|
||||
|
||||
!*** output variables
|
||||
real(pReal), dimension(3,3) :: constitutive_nonlocal_dislocationstress
|
||||
|
||||
!*** local variables
|
||||
integer(pInt) neighbor_el, & ! element number of neighbor material point
|
||||
neighbor_ip, & ! integration point of neighbor material point
|
||||
instance, & ! my instance of this plasticity
|
||||
neighbor_instance, & ! instance of this plasticity of neighbor material point
|
||||
integer(pInt) neighbor_el, & !< element number of neighbor material point
|
||||
neighbor_ip, & !< integration point of neighbor material point
|
||||
instance, & !< my instance of this plasticity
|
||||
neighbor_instance, & !< instance of this plasticity of neighbor material point
|
||||
phase, &
|
||||
neighbor_phase, &
|
||||
ns, & ! total number of active slip systems at my material point
|
||||
neighbor_ns, & ! total number of active slip systems at neighbor material point
|
||||
c, & ! index of dilsocation character (edge, screw)
|
||||
s, & ! slip system index
|
||||
t, & ! index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-)
|
||||
ns, & !< total number of active slip systems at my material point
|
||||
neighbor_ns, & !< total number of active slip systems at neighbor material point
|
||||
c, & !< index of dilsocation character (edge, screw)
|
||||
s, & !< slip system index
|
||||
t, & !< index of dilsocation type (e+, e-, s+, s-, used e+, used e-, used s+, used s-)
|
||||
dir, &
|
||||
deltaX, deltaY, deltaZ, &
|
||||
side, &
|
||||
j
|
||||
integer(pInt), dimension(2,3) :: periodicImages
|
||||
real(pReal) x, y, z, & ! coordinates of connection vector in neighbor lattice frame
|
||||
xsquare, ysquare, zsquare, & ! squares of respective coordinates
|
||||
distance, & ! length of connection vector
|
||||
segmentLength, & ! segment length of dislocations
|
||||
real(pReal) x, y, z, & !< coordinates of connection vector in neighbor lattice frame
|
||||
xsquare, ysquare, zsquare, & !< squares of respective coordinates
|
||||
distance, & !< length of connection vector
|
||||
segmentLength, & !< segment length of dislocations
|
||||
lambda, &
|
||||
R, Rsquare, Rcube, &
|
||||
denominator, &
|
||||
flipSign, &
|
||||
neighbor_ipVolumeSideLength, &
|
||||
detFe
|
||||
real(pReal), dimension(3) :: connection, & ! connection vector between me and my neighbor in the deformed configuration
|
||||
connection_neighborLattice, & ! connection vector between me and my neighbor in the lattice configuration of my neighbor
|
||||
connection_neighborSlip, & ! connection vector between me and my neighbor in the slip system frame of my neighbor
|
||||
real(pReal), dimension(3) :: connection, & !< connection vector between me and my neighbor in the deformed configuration
|
||||
connection_neighborLattice, & !< connection vector between me and my neighbor in the lattice configuration of my neighbor
|
||||
connection_neighborSlip, & !< connection vector between me and my neighbor in the slip system frame of my neighbor
|
||||
maxCoord, minCoord, &
|
||||
meshSize, &
|
||||
coords, & ! x,y,z coordinates of cell center of ip volume
|
||||
neighbor_coords ! x,y,z coordinates of cell center of neighbor ip volume
|
||||
real(pReal), dimension(3,3) :: sigma, & ! dislocation stress for one slip system in neighbor material point's slip system frame
|
||||
Tdislo_neighborLattice, & ! dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point
|
||||
invFe, & ! inverse of my elastic deformation gradient
|
||||
coords, & !< x,y,z coordinates of cell center of ip volume
|
||||
neighbor_coords !< x,y,z coordinates of cell center of neighbor ip volume
|
||||
real(pReal), dimension(3,3) :: sigma, & !< dislocation stress for one slip system in neighbor material point's slip system frame
|
||||
Tdislo_neighborLattice, & !< dislocation stress as 2nd Piola-Kirchhoff stress at neighbor material point
|
||||
invFe, & !< inverse of my elastic deformation gradient
|
||||
neighbor_invFe, &
|
||||
neighborLattice2myLattice ! mapping from neighbor MPs lattice configuration to my lattice configuration
|
||||
neighborLattice2myLattice !< mapping from neighbor MPs lattice configuration to my lattice configuration
|
||||
real(pReal), dimension(2,2,maxval(totalNslip)) :: &
|
||||
neighbor_rhoExcess ! excess density at neighbor material point (edge/screw,mobile/dead,slipsystem)
|
||||
neighbor_rhoExcess !< excess density at neighbor material point (edge/screw,mobile/dead,slipsystem)
|
||||
real(pReal), dimension(2,maxval(totalNslip)) :: &
|
||||
rhoExcessDead
|
||||
real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el))),8) :: &
|
||||
|
|
@ -3149,9 +3111,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
!* and add up the stress contributions from egde and screw excess on these slip systems (if significant)
|
||||
|
||||
do s = 1_pInt,neighbor_ns
|
||||
if (all(abs(neighbor_rhoExcess(:,:,s)) < significantRho(instance))) then
|
||||
cycle ! not significant
|
||||
endif
|
||||
if (all(abs(neighbor_rhoExcess(:,:,s)) < significantRho(instance))) cycle ! not significant
|
||||
|
||||
|
||||
!* map the connection vector from the lattice into the slip system frame
|
||||
|
|
@ -3163,9 +3123,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
!* edge contribution to stress
|
||||
sigma = 0.0_pReal
|
||||
|
||||
x = connection_neighborSlip(1)
|
||||
y = connection_neighborSlip(2)
|
||||
z = connection_neighborSlip(3)
|
||||
[x,y,z] = connection_neighborSlip
|
||||
xsquare = x * x
|
||||
ysquare = y * y
|
||||
zsquare = z * z
|
||||
|
|
@ -3174,7 +3132,8 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
if (abs(neighbor_rhoExcess(1,j,s)) < significantRho(instance)) then
|
||||
cycle
|
||||
elseif (j > 1_pInt) then
|
||||
x = connection_neighborSlip(1) + sign(0.5_pReal * segmentLength, &
|
||||
x = connection_neighborSlip(1) &
|
||||
+ sign(0.5_pReal * segmentLength, &
|
||||
state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,1,neighbor_instance)) &
|
||||
- state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,2,neighbor_instance)))
|
||||
xsquare = x * x
|
||||
|
|
@ -3187,9 +3146,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
Rsquare = R * R
|
||||
Rcube = Rsquare * R
|
||||
denominator = R * (R + flipSign * lambda)
|
||||
if (denominator == 0.0_pReal) then
|
||||
exit ipLoop
|
||||
endif
|
||||
if (denominator == 0.0_pReal) exit ipLoop
|
||||
|
||||
sigma(1,1) = sigma(1,1) - real(side,pReal) &
|
||||
* flipSign * z / denominator &
|
||||
|
|
@ -3220,7 +3177,8 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
if (abs(neighbor_rhoExcess(2,j,s)) < significantRho(instance)) then
|
||||
cycle
|
||||
elseif (j > 1_pInt) then
|
||||
y = connection_neighborSlip(2) + sign(0.5_pReal * segmentLength, &
|
||||
y = connection_neighborSlip(2)
|
||||
+ sign(0.5_pReal * segmentLength, &
|
||||
state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,3,neighbor_instance)) &
|
||||
- state(ipc,neighbor_ip,neighbor_el)%p(iRhoB(s,4,neighbor_instance)))
|
||||
ysquare = y * y
|
||||
|
|
@ -3233,20 +3191,18 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
Rsquare = R * R
|
||||
Rcube = Rsquare * R
|
||||
denominator = R * (R + flipSign * lambda)
|
||||
if (denominator == 0.0_pReal) then
|
||||
exit ipLoop
|
||||
endif
|
||||
if (denominator == 0.0_pReal) exit ipLoop
|
||||
|
||||
sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z * (1.0_pReal - lattice_nu(phase)) / denominator &
|
||||
sigma(1,2) = sigma(1,2) - real(side,pReal) * flipSign * z &
|
||||
* (1.0_pReal - lattice_nu(phase)) / denominator &
|
||||
* neighbor_rhoExcess(2,j,s)
|
||||
sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y * (1.0_pReal - lattice_nu(phase)) / denominator &
|
||||
sigma(1,3) = sigma(1,3) + real(side,pReal) * flipSign * y &
|
||||
* (1.0_pReal - lattice_nu(phase)) / denominator &
|
||||
* neighbor_rhoExcess(2,j,s)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
if (all(abs(sigma) < 1.0e-10_pReal)) then ! SIGMA IS NOT A REAL STRESS, THATS WHY WE NEED A REALLY SMALL VALUE HERE
|
||||
cycle
|
||||
endif
|
||||
if (all(abs(sigma) < 1.0e-10_pReal)) cycle ! SIGMA IS NOT A REAL STRESS, THATS WHY WE NEED A REALLY SMALL VALUE HERE
|
||||
|
||||
!* copy symmetric parts
|
||||
|
||||
|
|
@ -3279,9 +3235,7 @@ ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))
|
|||
+ state(ipc,ip,el)%p(iRhoB(s,2*c,instance)) ! negative deads (here we use symmetry: if this has negative sign it is treated as positive density at positive position instead of negative density at negative position)
|
||||
|
||||
do s = 1_pInt,ns
|
||||
if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) then
|
||||
cycle ! not significant
|
||||
endif
|
||||
if (all(abs(rhoExcessDead(:,s)) < significantRho(instance))) cycle ! not significant
|
||||
sigma = 0.0_pReal ! all components except for sigma13 are zero
|
||||
sigma(1,3) = - (rhoExcessDead(1,s) + rhoExcessDead(2,s) * (1.0_pReal - lattice_nu(phase))) &
|
||||
* neighbor_ipVolumeSideLength * lattice_mu(phase) * burgers(s,instance) &
|
||||
|
|
|
|||
Loading…
Reference in New Issue