223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

white space adjustments

This commit is contained in:
Martin Diehl 2019-06-15 18:27:38 +02:00
parent f54a6cdc3b
commit 6370dd1a43
1 changed files with 809 additions and 819 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/homogenization_mech_RGC.f90
View File

@ -364,8 +364,7 @@ module procedure mech_RGC_updateState
residMax = maxval(abs(tract)) ! get the maximum of the residual residMax = maxval(abs(tract)) ! get the maximum of the residual
#ifdef DEBUG #ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) then
.and. prm%of_debug == of) then
stresLoc = maxloc(abs(P)) stresLoc = maxloc(abs(P))
residLoc = maxloc(abs(tract)) residLoc = maxloc(abs(tract))
write(6,'(1x,a)')' ' write(6,'(1x,a)')' '
@ -385,9 +384,8 @@ module procedure mech_RGC_updateState
if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then
mech_RGC_updateState = .true. mech_RGC_updateState = .true.
#ifdef DEBUG #ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) &
.and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy' write(6,'(1x,a55,/)')'... done and happy'; flush(6)
flush(6)
#endif #endif
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -406,8 +404,7 @@ module procedure mech_RGC_updateState
dst%relaxationRate_max(of) = maxval(abs(drelax))/dt dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
#ifdef DEBUG #ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) then
.and. prm%of_debug == of) then
write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of) write(6,'(1x,a30,1x,e15.8)') 'Constitutive work: ',stt%work(of)
write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), & write(6,'(1x,a30,3(1x,e15.8))')'Magnitude mismatch: ',dst%mismatch(1,of), &
dst%mismatch(2,of), & dst%mismatch(2,of), &
@ -428,18 +425,16 @@ module procedure mech_RGC_updateState
mech_RGC_updateState = [.true.,.false.] ! with direct cut-back mech_RGC_updateState = [.true.,.false.] ! with direct cut-back
#ifdef DEBUG #ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) &
.and. prm%of_debug == of) write(6,'(1x,a,/)') '... broken' write(6,'(1x,a,/)') '... broken'; flush(6)
flush(6)
#endif #endif
return return
else ! proceed with computing the Jacobian and state update else ! proceed with computing the Jacobian and state update
#ifdef DEBUG #ifdef DEBUG
if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of) &
.and. prm%of_debug == of) write(6,'(1x,a,/)') '... not yet done' write(6,'(1x,a,/)') '... not yet done'; flush(6)
flush(6)
#endif #endif
endif endif
@ -645,9 +640,9 @@ module procedure mech_RGC_updateState
end associate end associate
contains contains
!-------------------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------------------
!> @brief calculate stress-like penalty due to deformation mismatch !> @brief calculate stress-like penalty due to deformation mismatch
!-------------------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------------------
subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of) subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty real(pReal), dimension (:,:,:), intent(out) :: rPen !< stress-like penalty
@ -673,7 +668,7 @@ module procedure mech_RGC_updateState
rPen = 0.0_pReal rPen = 0.0_pReal
nMis = 0.0_pReal nMis = 0.0_pReal
!-------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
! get the correction factor the modulus of penalty stress representing the evolution of area of ! get the correction factor the modulus of penalty stress representing the evolution of area of
! the interfaces due to deformations ! the interfaces due to deformations
@ -682,8 +677,7 @@ module procedure mech_RGC_updateState
associate(prm => param(instance)) associate(prm => param(instance))
#ifdef DEBUG #ifdef DEBUG
debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 & debugActive = iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 .and. prm%of_debug == of
.and. prm%of_debug == of
if (debugActive) then if (debugActive) then
write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el write(6,'(1x,a20,2(1x,i3))')'Correction factor: ',ip,el
@ -691,7 +685,7 @@ module procedure mech_RGC_updateState
endif endif
#endif #endif
!-------------------------------------------------------------------------------------------------- !-----------------------------------------------------------------------------------------------
! computing the mismatch and penalty stress tensor of all grains ! computing the mismatch and penalty stress tensor of all grains
grainLoop: do iGrain = 1,product(prm%Nconstituents) grainLoop: do iGrain = 1,product(prm%Nconstituents)
Gmoduli = equivalentModuli(iGrain,ip,el) Gmoduli = equivalentModuli(iGrain,ip,el)
@ -713,7 +707,7 @@ module procedure mech_RGC_updateState
bgGNghb = Gmoduli(2) bgGNghb = Gmoduli(2)
gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain)) ! difference/jump in deformation gradeint across the neighbor
!-------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------
! compute the mismatch tensor of all interfaces ! compute the mismatch tensor of all interfaces
nDefNorm = 0.0_pReal nDefNorm = 0.0_pReal
nDef = 0.0_pReal nDef = 0.0_pReal
@ -733,7 +727,7 @@ module procedure mech_RGC_updateState
endif endif
#endif #endif
!-------------------------------------------------------------------------------------------------- !-------------------------------------------------------------------------------------------
! compute the stress penalty of all interfaces ! compute the stress penalty of all interfaces
do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3 do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3
rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha & rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xiAlpha &
@ -757,9 +751,9 @@ module procedure mech_RGC_updateState
end subroutine stressPenalty end subroutine stressPenalty
!-------------------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------------------
!> @brief calculate stress-like penalty due to volume discrepancy !> @brief calculate stress-like penalty due to volume discrepancy
!-------------------------------------------------------------------------------------------------- !------------------------------------------------------------------------------------------------
subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of) subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of)
real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume real(pReal), dimension (:,:,:), intent(out) :: vPen ! stress-like penalty due to volume
@ -775,7 +769,7 @@ module procedure mech_RGC_updateState
real(pReal), dimension(size(vPen,3)) :: gVol real(pReal), dimension(size(vPen,3)) :: gVol
integer :: i integer :: i
!-------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
! compute the volumes of grains and of cluster ! compute the volumes of grains and of cluster
vDiscrep = math_det33(fAvg) ! compute the volume of the cluster vDiscrep = math_det33(fAvg) ! compute the volume of the cluster
do i = 1,nGrain do i = 1,nGrain
@ -784,7 +778,7 @@ module procedure mech_RGC_updateState
! the volume of the cluster and the the total volume of grains ! the volume of the cluster and the the total volume of grains
enddo enddo
!-------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
! calculate the stress and penalty due to volume discrepancy ! calculate the stress and penalty due to volume discrepancy
vPen = 0.0_pReal vPen = 0.0_pReal
do i = 1,nGrain do i = 1,nGrain
@ -855,7 +849,7 @@ module procedure mech_RGC_updateState
elasTens = constitutive_homogenizedC(grainID,ip,el) elasTens = constitutive_homogenizedC(grainID,ip,el)
!-------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005) ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005)
cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal
cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + & cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + &
@ -863,7 +857,7 @@ module procedure mech_RGC_updateState
cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal
equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44 equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44
!-------------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
! obtain the length of Burgers vector (could be model dependend) ! obtain the length of Burgers vector (could be model dependend)
equivalentModuli(2) = 2.5e-10_pReal equivalentModuli(2) = 2.5e-10_pReal
@ -933,7 +927,6 @@ end subroutine mech_RGC_averageStressAndItsTangent
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief writes results to HDF5 output file !> @brief writes results to HDF5 output file
! ToDo: check wheter units are correct
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module subroutine mech_RGC_results(instance,group) module subroutine mech_RGC_results(instance,group)
#if defined(PETSc) || defined(DAMASK_HDF5) #if defined(PETSc) || defined(DAMASK_HDF5)
@ -990,8 +983,6 @@ pure function relaxationVector(intFace,instance,of)
integer :: iNum integer :: iNum
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! collect the interface relaxation vector from the global state array ! collect the interface relaxation vector from the global state array
@ -1040,9 +1031,8 @@ pure function getInterface(iFace,iGrain3)
integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array integer, dimension(3), intent(in) :: iGrain3 !< grain ID in 3D array
integer, intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3) integer, intent(in) :: iFace !< face index (1..6) mapped like (-e1,-e2,-e3,+e1,+e2,+e3) or iDir = (-1,-2,-3,1,2,3)
integer :: iDir integer :: iDir !< direction of interface normal
!* Direction of interface normal
iDir = (int(real(iFace-1,pReal)/2.0_pReal)+1)*(-1)**iFace iDir = (int(real(iFace-1,pReal)/2.0_pReal)+1)*(-1)**iFace
getInterface(1) = iDir getInterface(1) = iDir