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

now with first draft of nonlocal constitutive law 

debugging memory leak closed
debugging counters corrected

center of gravity stored in mesh

state updated is now split into a collecting loop and an execution

updateState and updateTemperature fill sequentially separate logicals and evaluate afterwards to converged

added 3x3 transposition function, norm for 3x1 matrix and 33x3 matrix multiplication in math

non-converged crystallite triggers materialpoint cutback (used to respond elastically)

non-converged materialpoint raises terminal illness which in turn renders whole FE increment useless by means of odd stress/stiffness and thus waits for FE cutback
This commit is contained in:
Christoph Kords 2009-08-11 16:31:57 +00:00
parent 4689966c79
commit 8ed3ddc03b
15 changed files with 1695 additions and 359 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
code/CPFEM.f90
View File

@ -73,6 +73,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
use FEsolving, only: FE_init, & use FEsolving, only: FE_init, &
parallelExecution, & parallelExecution, &
outdatedFFN1, & outdatedFFN1, &
terminallyIll, &
cycleCounter, & cycleCounter, &
theInc, & theInc, &
theCycle, & theCycle, &
@ -201,7 +202,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
j = 1:mesh_maxNips, & j = 1:mesh_maxNips, &
k = 1:mesh_NcpElems ) & k = 1:mesh_NcpElems ) &
constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites
write(6,'(a10,/,4(3(f20.8,x),/))') 'aged state',constitutive_state(1,1,1)%p write(6,'(a10,/,4(3(e20.8,x),/))') 'aged state',constitutive_state(1,1,1)%p
do k = 1,mesh_NcpElems do k = 1,mesh_NcpElems
do j = 1,mesh_maxNips do j = 1,mesh_maxNips
if (homogenization_sizeState(j,k) > 0_pInt) & if (homogenization_sizeState(j,k) > 0_pInt) &
@ -211,10 +212,11 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
endif endif
! deformation gradient outdated or any actual deformation gradient differs more than relevantStrain from the stored one ! deformation gradient outdated or any actual deformation gradient differs more than relevantStrain from the stored one
if (outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(:,:,IP,cp_en)) > relevantStrain)) then if (terminallyIll .or. outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(:,:,IP,cp_en)) > relevantStrain)) then
if (.not. outdatedFFN1) & if (.not. terminallyIll .and. .not. outdatedFFN1) then
write(6,'(a11,x,i5,x,i2,x,a10,/,3(3(f10.3,x),/))') 'outdated at',cp_en,IP,'FFN1 now:',ffn1(:,1),ffn1(:,2),ffn1(:,3) write(6,'(a11,x,i5,x,i2,x,a10,/,3(3(f10.3,x),/))') 'outdated at',cp_en,IP,'FFN1 now:',ffn1(:,1),ffn1(:,2),ffn1(:,3)
outdatedFFN1 = .true. outdatedFFN1 = .true.
endif
CPFEM_cs(1:ngens,IP,cp_en) = CPFEM_odd_stress CPFEM_cs(1:ngens,IP,cp_en) = CPFEM_odd_stress
CPFEM_dcsde(1:ngens,1:ngens,IP,cp_en) = CPFEM_odd_jacobian*math_identity2nd(ngens) CPFEM_dcsde(1:ngens,1:ngens,IP,cp_en) = CPFEM_odd_jacobian*math_identity2nd(ngens)
@ -240,25 +242,29 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
CPFEM_calc_done = .true. CPFEM_calc_done = .true.
endif endif
if (terminallyIll) then
CPFEM_cs(1:ngens,IP,cp_en) = CPFEM_odd_stress
CPFEM_dcsde(1:ngens,1:ngens,IP,cp_en) = CPFEM_odd_jacobian*math_identity2nd(ngens)
else
! translate from P to CS ! translate from P to CS
Kirchhoff = math_mul33x33(materialpoint_P(:,:,IP, cp_en),transpose(materialpoint_F(:,:,IP, cp_en))) Kirchhoff = math_mul33x33(materialpoint_P(:,:,IP, cp_en),transpose(materialpoint_F(:,:,IP, cp_en)))
J_inverse = 1.0_pReal/math_det3x3(materialpoint_F(:,:,IP, cp_en)) J_inverse = 1.0_pReal/math_det3x3(materialpoint_F(:,:,IP, cp_en))
CPFEM_cs(1:ngens,IP,cp_en) = math_Mandel33to6(J_inverse*Kirchhoff) CPFEM_cs(1:ngens,IP,cp_en) = math_Mandel33to6(J_inverse*Kirchhoff)
! translate from dP/dF to dCS/dE ! translate from dP/dF to dCS/dE
H = 0.0_pReal H = 0.0_pReal
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) &
H(i,j,k,l) = H(i,j,k,l) + & H(i,j,k,l) = H(i,j,k,l) + &
materialpoint_F(j,m,IP,cp_en) * & materialpoint_F(j,m,IP,cp_en) * &
materialpoint_F(l,n,IP,cp_en) * & materialpoint_F(l,n,IP,cp_en) * &
materialpoint_dPdF(i,m,k,n,IP,cp_en) - & materialpoint_dPdF(i,m,k,n,IP,cp_en) - &
math_I3(j,l)*materialpoint_F(i,m,IP,cp_en)*materialpoint_P(k,m,IP,cp_en) + & math_I3(j,l)*materialpoint_F(i,m,IP,cp_en)*materialpoint_P(k,m,IP,cp_en) + &
0.5_pReal*(math_I3(i,k)*Kirchhoff(j,l) + math_I3(j,l)*Kirchhoff(i,k) + & 0.5_pReal*(math_I3(i,k)*Kirchhoff(j,l) + math_I3(j,l)*Kirchhoff(i,k) + &
math_I3(i,l)*Kirchhoff(j,k) + math_I3(j,k)*Kirchhoff(i,l)) math_I3(i,l)*Kirchhoff(j,k) + math_I3(j,k)*Kirchhoff(i,l))
forall(i=1:3,j=1:3,k=1:3,l=1:3) & forall(i=1:3,j=1:3,k=1:3,l=1:3) &
H_sym(i,j,k,l)= 0.25_pReal*(H(i,j,k,l)+H(j,i,k,l)+H(i,j,l,k)+H(j,i,l,k)) ! where to use the symmetric version?? H_sym(i,j,k,l)= 0.25_pReal*(H(i,j,k,l)+H(j,i,k,l)+H(i,j,l,k)+H(j,i,l,k)) ! where to use the symmetric version??
CPFEM_dcsde(1:ngens,1:ngens,IP,cp_en) = math_Mandel3333to66(J_inverse*H) CPFEM_dcsde(1:ngens,1:ngens,IP,cp_en) = math_Mandel3333to66(J_inverse*H)
endif
endif endif
! --+>> COLLECTION OF FEM DATA AND RETURN OF ODD STRESS AND JACOBIAN <<+-- ! --+>> COLLECTION OF FEM DATA AND RETURN OF ODD STRESS AND JACOBIAN <<+--

2
code/FEsolving.f90
View File

@ -9,7 +9,7 @@
integer(pInt) cycleCounter integer(pInt) cycleCounter
integer(pInt) theInc,theCycle,theLovl integer(pInt) theInc,theCycle,theLovl
real(pReal) theTime real(pReal) theTime
logical :: lastIncConverged = .false.,outdatedByNewInc = .false.,outdatedFFN1 = .false. logical :: lastIncConverged = .false.,outdatedByNewInc = .false.,outdatedFFN1 = .false.,terminallyIll = .false.
logical :: symmetricSolver = .false. logical :: symmetricSolver = .false.
logical :: parallelExecution = .true. logical :: parallelExecution = .true.
integer(pInt), dimension(:,:), allocatable :: FEsolving_execIP integer(pInt), dimension(:,:), allocatable :: FEsolving_execIP

5
code/IO.f90
View File

@ -858,7 +858,7 @@ endfunction
case (265) case (265)
msg = 'Limit for crystallite loop too small' msg = 'Limit for crystallite loop too small'
case (266) case (266)
msg = 'Limit for state loop too small' msg = 'Limit for crystallite state loop too small'
case (267) case (267)
msg = 'Limit for stress loop too small' msg = 'Limit for stress loop too small'
case (268) case (268)
@ -884,6 +884,9 @@ endfunction
case (277) case (277)
msg = 'Non-positive relevant mismatch in RGC' msg = 'Non-positive relevant mismatch in RGC'
case (279)
msg = 'Limit for materialpoint state loop too small'
case (300) case (300)
msg = 'This material can only be used with elements with three direct stress components' msg = 'This material can only be used with elements with three direct stress components'
case (500) case (500)

139
code/constitutive.f90
View File

@ -16,11 +16,14 @@ MODULE constitutive
type(p_vec), dimension(:,:,:), allocatable :: constitutive_state0, & ! pointer array to microstructure at start of FE inc type(p_vec), dimension(:,:,:), allocatable :: constitutive_state0, & ! pointer array to microstructure at start of FE inc
constitutive_partionedState0, & ! pointer array to microstructure at start of homogenization inc constitutive_partionedState0, & ! pointer array to microstructure at start of homogenization inc
constitutive_subState0, & ! pointer array to microstructure at start of crystallite inc constitutive_subState0, & ! pointer array to microstructure at start of crystallite inc
constitutive_state ! pointer array to current microstructure (end of converged time step) constitutive_state, & ! pointer array to current microstructure (end of converged time step)
constitutive_dotState ! pointer array to evolution of current microstructure
integer(pInt), dimension(:,:,:), allocatable :: constitutive_sizeDotState, & ! size of dotState array integer(pInt), dimension(:,:,:), allocatable :: constitutive_sizeDotState, & ! size of dotState array
constitutive_sizeState, & ! size of state array per grain constitutive_sizeState, & ! size of state array per grain
constitutive_sizePostResults ! size of postResults array per grain constitutive_sizePostResults ! size of postResults array per grain
integer(pInt) constitutive_maxSizeDotState,constitutive_maxSizeState,constitutive_maxSizePostResults integer(pInt) constitutive_maxSizeDotState, &
constitutive_maxSizeState, &
constitutive_maxSizePostResults
CONTAINS CONTAINS
!**************************************** !****************************************
@ -28,8 +31,8 @@ CONTAINS
!* - constitutive_homogenizedC !* - constitutive_homogenizedC
!* - constitutive_microstructure !* - constitutive_microstructure
!* - constitutive_LpAndItsTangent !* - constitutive_LpAndItsTangent
!* - constitutive_dotState !* - constitutive_collectDotState
!* - constitutive_dotTemperature !* - constitutive_collectDotTemperature
!* - constitutive_postResults !* - constitutive_postResults
!**************************************** !****************************************
@ -46,6 +49,7 @@ subroutine constitutive_init()
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
integer(pInt), parameter :: fileunit = 200 integer(pInt), parameter :: fileunit = 200
integer(pInt) e,i,g,p,myInstance,myNgrains integer(pInt) e,i,g,p,myInstance,myNgrains
@ -58,6 +62,7 @@ subroutine constitutive_init()
call constitutive_j2_init(fileunit) ! parse all phases of this constitution call constitutive_j2_init(fileunit) ! parse all phases of this constitution
call constitutive_phenopowerlaw_init(fileunit) call constitutive_phenopowerlaw_init(fileunit)
call constitutive_dislobased_init(fileunit) call constitutive_dislobased_init(fileunit)
call constitutive_nonlocal_init(fileunit)
close(fileunit) close(fileunit)
@ -78,6 +83,9 @@ subroutine constitutive_init()
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
thisOutput => constitutive_dislobased_output thisOutput => constitutive_dislobased_output
thisSize => constitutive_dislobased_sizePostResult thisSize => constitutive_dislobased_sizePostResult
case (constitutive_nonlocal_label)
thisOutput => constitutive_nonlocal_output
thisSize => constitutive_nonlocal_sizePostResult
case default case default
knownConstitution = .false. knownConstitution = .false.
end select end select
@ -101,10 +109,10 @@ subroutine constitutive_init()
allocate(constitutive_partionedState0(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) allocate(constitutive_partionedState0(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
allocate(constitutive_subState0(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) allocate(constitutive_subState0(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
allocate(constitutive_state(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) allocate(constitutive_state(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
allocate(constitutive_sizeDotState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeDotState = 0_pInt allocate(constitutive_dotState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems))
allocate(constitutive_sizeState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeState = 0_pInt allocate(constitutive_sizeDotState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeDotState = 0_pInt
allocate(constitutive_sizePostResults(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizePostResults = 0_pInt allocate(constitutive_sizeState(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)) ; constitutive_sizeState = 0_pInt
allocate(constitutive_sizePostResults(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems)); constitutive_sizePostResults = 0_pInt
do e = 1,mesh_NcpElems ! loop over elements do e = 1,mesh_NcpElems ! loop over elements
myNgrains = homogenization_Ngrains(mesh_element(3,e)) myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = 1,FE_Nips(mesh_element(2,e)) ! loop over IPs do i = 1,FE_Nips(mesh_element(2,e)) ! loop over IPs
@ -117,28 +125,41 @@ subroutine constitutive_init()
allocate(constitutive_partionedState0(g,i,e)%p(constitutive_j2_sizeState(myInstance))) allocate(constitutive_partionedState0(g,i,e)%p(constitutive_j2_sizeState(myInstance)))
allocate(constitutive_subState0(g,i,e)%p(constitutive_j2_sizeState(myInstance))) allocate(constitutive_subState0(g,i,e)%p(constitutive_j2_sizeState(myInstance)))
allocate(constitutive_state(g,i,e)%p(constitutive_j2_sizeState(myInstance))) allocate(constitutive_state(g,i,e)%p(constitutive_j2_sizeState(myInstance)))
allocate(constitutive_dotState(g,i,e)%p(constitutive_j2_sizeDotState(myInstance)))
constitutive_state0(g,i,e)%p = constitutive_j2_stateInit(myInstance) constitutive_state0(g,i,e)%p = constitutive_j2_stateInit(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_j2_sizeDotState(myInstance)
constitutive_sizeState(g,i,e) = constitutive_j2_sizeState(myInstance) constitutive_sizeState(g,i,e) = constitutive_j2_sizeState(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_j2_sizeDotState(myInstance)
constitutive_sizePostResults(g,i,e) = constitutive_j2_sizePostResults(myInstance) constitutive_sizePostResults(g,i,e) = constitutive_j2_sizePostResults(myInstance)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
allocate(constitutive_state0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance))) allocate(constitutive_state0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance)))
allocate(constitutive_partionedState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance))) allocate(constitutive_partionedState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance)))
allocate(constitutive_subState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance))) allocate(constitutive_subState0(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance)))
allocate(constitutive_state(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance))) allocate(constitutive_state(g,i,e)%p(constitutive_phenopowerlaw_sizeState(myInstance)))
allocate(constitutive_dotState(g,i,e)%p(constitutive_phenopowerlaw_sizeDotState(myInstance)))
constitutive_state0(g,i,e)%p = constitutive_phenopowerlaw_stateInit(myInstance) constitutive_state0(g,i,e)%p = constitutive_phenopowerlaw_stateInit(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_phenopowerlaw_sizeDotState(myInstance)
constitutive_sizeState(g,i,e) = constitutive_phenopowerlaw_sizeState(myInstance) constitutive_sizeState(g,i,e) = constitutive_phenopowerlaw_sizeState(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_phenopowerlaw_sizeDotState(myInstance)
constitutive_sizePostResults(g,i,e) = constitutive_phenopowerlaw_sizePostResults(myInstance) constitutive_sizePostResults(g,i,e) = constitutive_phenopowerlaw_sizePostResults(myInstance)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
allocate(constitutive_state0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance))) allocate(constitutive_state0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance)))
allocate(constitutive_partionedState0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance))) allocate(constitutive_partionedState0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance)))
allocate(constitutive_subState0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance))) allocate(constitutive_subState0(g,i,e)%p(constitutive_dislobased_sizeState(myInstance)))
allocate(constitutive_state(g,i,e)%p(constitutive_dislobased_sizeState(myInstance))) allocate(constitutive_state(g,i,e)%p(constitutive_dislobased_sizeState(myInstance)))
allocate(constitutive_dotState(g,i,e)%p(constitutive_dislobased_sizeDotState(myInstance)))
constitutive_state0(g,i,e)%p = constitutive_dislobased_stateInit(myInstance) constitutive_state0(g,i,e)%p = constitutive_dislobased_stateInit(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_dislobased_sizeDotState(myInstance)
constitutive_sizeState(g,i,e) = constitutive_dislobased_sizeState(myInstance) constitutive_sizeState(g,i,e) = constitutive_dislobased_sizeState(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_dislobased_sizeDotState(myInstance)
constitutive_sizePostResults(g,i,e) = constitutive_dislobased_sizePostResults(myInstance) constitutive_sizePostResults(g,i,e) = constitutive_dislobased_sizePostResults(myInstance)
case (constitutive_nonlocal_label)
allocate(constitutive_state0(g,i,e)%p(constitutive_nonlocal_sizeState(myInstance)))
allocate(constitutive_partionedState0(g,i,e)%p(constitutive_nonlocal_sizeState(myInstance)))
allocate(constitutive_subState0(g,i,e)%p(constitutive_nonlocal_sizeState(myInstance)))
allocate(constitutive_state(g,i,e)%p(constitutive_nonlocal_sizeState(myInstance)))
allocate(constitutive_dotState(g,i,e)%p(constitutive_nonlocal_sizeDotState(myInstance)))
constitutive_state0(g,i,e)%p = constitutive_nonlocal_stateInit(myInstance)
constitutive_sizeState(g,i,e) = constitutive_nonlocal_sizeState(myInstance)
constitutive_sizeDotState(g,i,e) = constitutive_nonlocal_sizeDotState(myInstance)
constitutive_sizePostResults(g,i,e) = constitutive_nonlocal_sizePostResults(myInstance)
case default case default
call IO_error(200,material_phase(g,i,e)) ! unknown constitution call IO_error(200,material_phase(g,i,e)) ! unknown constitution
end select end select
@ -146,8 +167,9 @@ subroutine constitutive_init()
enddo enddo
enddo enddo
enddo enddo
constitutive_maxSizeDotState = maxval(constitutive_sizeDotState)
constitutive_maxSizeState = maxval(constitutive_sizeState) constitutive_maxSizeState = maxval(constitutive_sizeState)
constitutive_maxSizeDotState = maxval(constitutive_sizeDotState)
constitutive_maxSizePostResults = maxval(constitutive_sizePostResults) constitutive_maxSizePostResults = maxval(constitutive_sizePostResults)
write(6,*) write(6,*)
@ -157,6 +179,7 @@ subroutine constitutive_init()
write(6,'(a32,x,7(i5,x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0) write(6,'(a32,x,7(i5,x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0)
write(6,'(a32,x,7(i5,x))') 'constitutive_subState0: ', shape(constitutive_subState0) write(6,'(a32,x,7(i5,x))') 'constitutive_subState0: ', shape(constitutive_subState0)
write(6,'(a32,x,7(i5,x))') 'constitutive_state: ', shape(constitutive_state) write(6,'(a32,x,7(i5,x))') 'constitutive_state: ', shape(constitutive_state)
write(6,'(a32,x,7(i5,x))') 'constitutive_dotState: ', shape(constitutive_dotState)
write(6,'(a32,x,7(i5,x))') 'constitutive_sizeState: ', shape(constitutive_sizeState) write(6,'(a32,x,7(i5,x))') 'constitutive_sizeState: ', shape(constitutive_sizeState)
write(6,'(a32,x,7(i5,x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState) write(6,'(a32,x,7(i5,x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState)
write(6,'(a32,x,7(i5,x))') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults) write(6,'(a32,x,7(i5,x))') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults)
@ -166,7 +189,7 @@ subroutine constitutive_init()
return return
end subroutine endsubroutine
function constitutive_homogenizedC(ipc,ip,el) function constitutive_homogenizedC(ipc,ip,el)
@ -183,6 +206,7 @@ function constitutive_homogenizedC(ipc,ip,el)
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
@ -190,19 +214,26 @@ function constitutive_homogenizedC(ipc,ip,el)
real(pReal), dimension(6,6) :: constitutive_homogenizedC real(pReal), dimension(6,6) :: constitutive_homogenizedC
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
constitutive_homogenizedC = constitutive_j2_homogenizedC(constitutive_state,ipc,ip,el) constitutive_homogenizedC = constitutive_j2_homogenizedC(constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
constitutive_homogenizedC = constitutive_phenopowerlaw_homogenizedC(constitutive_state,ipc,ip,el) constitutive_homogenizedC = constitutive_phenopowerlaw_homogenizedC(constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
constitutive_homogenizedC = constitutive_dislobased_homogenizedC(constitutive_state,ipc,ip,el) constitutive_homogenizedC = constitutive_dislobased_homogenizedC(constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
constitutive_homogenizedC = constitutive_nonlocal_homogenizedC(constitutive_state,ipc,ip,el)
end select end select
return return
end function endfunction
subroutine constitutive_microstructure(Temperature,ipc,ip,el) subroutine constitutive_microstructure(Temperature,Fp,ipc,ip,el)
!********************************************************************* !*********************************************************************
!* This function calculates from state needed variables * !* This function calculates from state needed variables *
!* INPUT: * !* INPUT: *
@ -212,30 +243,43 @@ subroutine constitutive_microstructure(Temperature,ipc,ip,el)
!* - ip : current integration point * !* - ip : current integration point *
!* - el : current element * !* - el : current element *
!********************************************************************* !*********************************************************************
use prec, only: pReal,pInt use prec, only: pReal,pInt
use material, only: phase_constitution,material_phase use material, only: phase_constitution, &
material_phase, &
homogenization_maxNgrains
use mesh, only: mesh_NcpElems, &
mesh_maxNips
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
integer(pInt) ipc,ip,el integer(pInt), intent(in) :: ipc,ip,el
real(pReal) Temperature real(pReal), intent(in) :: Temperature
real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: Fp
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
call constitutive_j2_microstructure(Temperature,constitutive_state,ipc,ip,el) call constitutive_j2_microstructure(Temperature,constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
call constitutive_phenopowerlaw_microstructure(Temperature,constitutive_state,ipc,ip,el) call constitutive_phenopowerlaw_microstructure(Temperature,constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
call constitutive_dislobased_microstructure(Temperature,constitutive_state,ipc,ip,el) call constitutive_dislobased_microstructure(Temperature,constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
call constitutive_nonlocal_microstructure(Temperature, Fp, constitutive_state,ipc,ip,el)
end select end select
end subroutine endsubroutine
subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,ip,el) subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, Temperature, ipc, ip, el)
!********************************************************************* !*********************************************************************
!* This subroutine contains the constitutive equation for * !* This subroutine contains the constitutive equation for *
!* calculating the velocity gradient * !* calculating the velocity gradient *
@ -253,6 +297,7 @@ subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,i
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
@ -263,19 +308,26 @@ subroutine constitutive_LpAndItsTangent(Lp,dLp_dTstar, Tstar_v,Temperature,ipc,i
real(pReal), dimension(9,9) :: dLp_dTstar real(pReal), dimension(9,9) :: dLp_dTstar
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el) call constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
call constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el) call constitutive_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el) call constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
call constitutive_nonlocal_LpAndItsTangent(Lp, dLp_dTstar, Tstar_v, Temperature, constitutive_state, ipc, ip, el)
end select end select
return return
end subroutine endsubroutine
function constitutive_dotState(Tstar_v,Temperature,ipc,ip,el) subroutine constitutive_collectDotState(Tstar_v, Fp, invFp, Temperature, ipc, ip, el)
!********************************************************************* !*********************************************************************
!* This subroutine contains the constitutive equation for * !* This subroutine contains the constitutive equation for *
!* calculating the rate of change of microstructure * !* calculating the rate of change of microstructure *
@ -289,28 +341,37 @@ function constitutive_dotState(Tstar_v,Temperature,ipc,ip,el)
!* - constitutive_dotState : evolution of state variable * !* - constitutive_dotState : evolution of state variable *
!********************************************************************* !*********************************************************************
use prec, only: pReal,pInt use prec, only: pReal,pInt
use debug
use material, only: phase_constitution,material_phase use material, only: phase_constitution,material_phase
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
integer(pInt) ipc,ip,el integer(pInt) ipc,ip,el
real(pReal) Temperature real(pReal) Temperature
real(pReal), dimension(3,3) :: Fp, invFp
real(pReal), dimension(6) :: Tstar_v real(pReal), dimension(6) :: Tstar_v
real(pReal), dimension(constitutive_sizeDotState(ipc,ip,el)) :: constitutive_dotState
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
constitutive_dotState = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotState(ipc,ip,el)%p = constitutive_j2_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
constitutive_dotState = constitutive_phenopowerlaw_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotState(ipc,ip,el)%p = constitutive_phenopowerlaw_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
constitutive_dotState = constitutive_dislobased_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotState(ipc,ip,el)%p = constitutive_dislobased_dotState(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
call constitutive_nonlocal_dotState(constitutive_dotState,Tstar_v,Fp,invFp,Temperature,constitutive_state,ipc,ip,el)
end select end select
return return
end function endsubroutine
function constitutive_dotTemperature(Tstar_v,Temperature,ipc,ip,el) function constitutive_dotTemperature(Tstar_v,Temperature,ipc,ip,el)
@ -331,25 +392,32 @@ function constitutive_dotTemperature(Tstar_v,Temperature,ipc,ip,el)
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
integer(pInt) ipc,ip,el integer(pInt) ipc,ip,el
real(pReal) Temperature real(pReal) Temperature
real(pReal), dimension(6) :: Tstar_v
real(pReal) constitutive_dotTemperature real(pReal) constitutive_dotTemperature
real(pReal), dimension(6) :: Tstar_v
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
constitutive_dotTemperature = constitutive_j2_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotTemperature = constitutive_j2_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
constitutive_dotTemperature = constitutive_phenopowerlaw_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotTemperature = constitutive_phenopowerlaw_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
constitutive_dotTemperature = constitutive_dislobased_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el) constitutive_dotTemperature = constitutive_dislobased_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
constitutive_dotTemperature = constitutive_nonlocal_dotTemperature(Tstar_v,Temperature,constitutive_state,ipc,ip,el)
end select end select
return return
end function endfunction
pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el) pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
@ -367,6 +435,7 @@ pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
use constitutive_j2 use constitutive_j2
use constitutive_phenopowerlaw use constitutive_phenopowerlaw
use constitutive_dislobased use constitutive_dislobased
use constitutive_nonlocal
implicit none implicit none
!* Definition of variables !* Definition of variables
@ -377,17 +446,23 @@ pure function constitutive_postResults(Tstar_v,Temperature,dt,ipc,ip,el)
constitutive_postResults = 0.0_pReal constitutive_postResults = 0.0_pReal
select case (phase_constitution(material_phase(ipc,ip,el))) select case (phase_constitution(material_phase(ipc,ip,el)))
case (constitutive_j2_label) case (constitutive_j2_label)
constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el) constitutive_postResults = constitutive_j2_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
case (constitutive_phenopowerlaw_label) case (constitutive_phenopowerlaw_label)
constitutive_postResults = constitutive_phenopowerlaw_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el) constitutive_postResults = constitutive_phenopowerlaw_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
case (constitutive_dislobased_label) case (constitutive_dislobased_label)
constitutive_postResults = constitutive_dislobased_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el) constitutive_postResults = constitutive_dislobased_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
case (constitutive_nonlocal_label)
constitutive_postResults = constitutive_nonlocal_postResults(Tstar_v,Temperature,dt,constitutive_state,ipc,ip,el)
end select end select
return return
end function endfunction
END MODULE END MODULE

1113
code/constitutive_nonlocal.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

325
code/crystallite.f90
View File

@ -34,6 +34,7 @@ real(pReal), dimension (:,:,:,:), allocatable :: crystallite_Tstar_v, &
crystallite_subTstar0_v ! 2nd Piola-Kirchhoff stress vector at start of crystallite inc crystallite_subTstar0_v ! 2nd Piola-Kirchhoff stress vector at start of crystallite inc
real(pReal), dimension (:,:,:,:,:), allocatable :: crystallite_Fe, & ! current "elastic" def grad (end of converged time step) real(pReal), dimension (:,:,:,:,:), allocatable :: crystallite_Fe, & ! current "elastic" def grad (end of converged time step)
crystallite_Fp, & ! current plastic def grad (end of converged time step) crystallite_Fp, & ! current plastic def grad (end of converged time step)
crystallite_invFp, & ! inverse of current plastic def grad (end of converged time step)
crystallite_Fp0, & ! plastic def grad at start of FE inc crystallite_Fp0, & ! plastic def grad at start of FE inc
crystallite_partionedFp0,& ! plastic def grad at start of homog inc crystallite_partionedFp0,& ! plastic def grad at start of homog inc
crystallite_subFp0,& ! plastic def grad at start of crystallite inc crystallite_subFp0,& ! plastic def grad at start of crystallite inc
@ -53,7 +54,10 @@ real(pReal), dimension (:,:,:,:,:,:,:), allocatable :: crystallite_dPdF, &
logical, dimension (:,:,:), allocatable :: crystallite_localConstitution, & ! indicates this grain to have purely local constitutive law logical, dimension (:,:,:), allocatable :: crystallite_localConstitution, & ! indicates this grain to have purely local constitutive law
crystallite_requested, & ! flag to request crystallite calculation crystallite_requested, & ! flag to request crystallite calculation
crystallite_onTrack, & ! flag to indicate ongoing calculation crystallite_onTrack, & ! flag to indicate ongoing calculation
crystallite_converged ! convergence flag crystallite_converged, & ! convergence flag
crystallite_stateConverged, & ! flag indicating convergence of state
crystallite_temperatureConverged, & ! flag indicating convergence of temperature
crystallite_nonfinished ! requested and ontrack but not converged
CONTAINS CONTAINS
@ -99,38 +103,42 @@ subroutine crystallite_init(Temperature)
iMax = mesh_maxNips iMax = mesh_maxNips
eMax = mesh_NcpElems eMax = mesh_NcpElems
allocate(crystallite_Temperature(gMax,iMax,eMax)); crystallite_Temperature = Temperature allocate(crystallite_Temperature(gMax,iMax,eMax)); crystallite_Temperature = Temperature
allocate(crystallite_P(3,3,gMax,iMax,eMax)); crystallite_P = 0.0_pReal allocate(crystallite_P(3,3,gMax,iMax,eMax)); crystallite_P = 0.0_pReal
allocate(crystallite_Fe(3,3,gMax,iMax,eMax)); crystallite_Fe = 0.0_pReal allocate(crystallite_Fe(3,3,gMax,iMax,eMax)); crystallite_Fe = 0.0_pReal
allocate(crystallite_Fp(3,3,gMax,iMax,eMax)); crystallite_Fp = 0.0_pReal allocate(crystallite_Fp(3,3,gMax,iMax,eMax)); crystallite_Fp = 0.0_pReal
allocate(crystallite_Lp(3,3,gMax,iMax,eMax)); crystallite_Lp = 0.0_pReal allocate(crystallite_invFp(3,3,gMax,iMax,eMax)); crystallite_invFp = 0.0_pReal
allocate(crystallite_Tstar_v(6,gMax,iMax,eMax)); crystallite_Tstar_v = 0.0_pReal allocate(crystallite_Lp(3,3,gMax,iMax,eMax)); crystallite_Lp = 0.0_pReal
allocate(crystallite_F0(3,3,gMax,iMax,eMax)); crystallite_F0 = 0.0_pReal allocate(crystallite_Tstar_v(6,gMax,iMax,eMax)); crystallite_Tstar_v = 0.0_pReal
allocate(crystallite_Fp0(3,3,gMax,iMax,eMax)); crystallite_Fp0 = 0.0_pReal allocate(crystallite_F0(3,3,gMax,iMax,eMax)); crystallite_F0 = 0.0_pReal
allocate(crystallite_Lp0(3,3,gMax,iMax,eMax)); crystallite_Lp0 = 0.0_pReal allocate(crystallite_Fp0(3,3,gMax,iMax,eMax)); crystallite_Fp0 = 0.0_pReal
allocate(crystallite_Tstar0_v(6,gMax,iMax,eMax)); crystallite_Tstar0_v = 0.0_pReal allocate(crystallite_Lp0(3,3,gMax,iMax,eMax)); crystallite_Lp0 = 0.0_pReal
allocate(crystallite_partionedTemperature0(gMax,iMax,eMax)); crystallite_partionedTemperature0 = 0.0_pReal allocate(crystallite_Tstar0_v(6,gMax,iMax,eMax)); crystallite_Tstar0_v = 0.0_pReal
allocate(crystallite_partionedF(3,3,gMax,iMax,eMax)); crystallite_partionedF = 0.0_pReal allocate(crystallite_partionedTemperature0(gMax,iMax,eMax)); crystallite_partionedTemperature0 = 0.0_pReal
allocate(crystallite_partionedF0(3,3,gMax,iMax,eMax)); crystallite_partionedF0 = 0.0_pReal allocate(crystallite_partionedF(3,3,gMax,iMax,eMax)); crystallite_partionedF = 0.0_pReal
allocate(crystallite_partionedFp0(3,3,gMax,iMax,eMax)); crystallite_partionedFp0 = 0.0_pReal allocate(crystallite_partionedF0(3,3,gMax,iMax,eMax)); crystallite_partionedF0 = 0.0_pReal
allocate(crystallite_partionedLp0(3,3,gMax,iMax,eMax)); crystallite_partionedLp0 = 0.0_pReal allocate(crystallite_partionedFp0(3,3,gMax,iMax,eMax)); crystallite_partionedFp0 = 0.0_pReal
allocate(crystallite_partionedTstar0_v(6,gMax,iMax,eMax)); crystallite_partionedTstar0_v = 0.0_pReal allocate(crystallite_partionedLp0(3,3,gMax,iMax,eMax)); crystallite_partionedLp0 = 0.0_pReal
allocate(crystallite_subTemperature0(gMax,iMax,eMax)); crystallite_subTemperature0 = 0.0_pReal allocate(crystallite_partionedTstar0_v(6,gMax,iMax,eMax)); crystallite_partionedTstar0_v = 0.0_pReal
allocate(crystallite_subF(3,3,gMax,iMax,eMax)); crystallite_subF = 0.0_pReal allocate(crystallite_subTemperature0(gMax,iMax,eMax)); crystallite_subTemperature0 = 0.0_pReal
allocate(crystallite_subF0(3,3,gMax,iMax,eMax)); crystallite_subF0 = 0.0_pReal allocate(crystallite_subF(3,3,gMax,iMax,eMax)); crystallite_subF = 0.0_pReal
allocate(crystallite_subFp0(3,3,gMax,iMax,eMax)); crystallite_subFp0 = 0.0_pReal allocate(crystallite_subF0(3,3,gMax,iMax,eMax)); crystallite_subF0 = 0.0_pReal
allocate(crystallite_subLp0(3,3,gMax,iMax,eMax)); crystallite_subLp0 = 0.0_pReal allocate(crystallite_subFp0(3,3,gMax,iMax,eMax)); crystallite_subFp0 = 0.0_pReal
allocate(crystallite_subTstar0_v(6,gMax,iMax,eMax)); crystallite_subTstar0_v = 0.0_pReal allocate(crystallite_subLp0(3,3,gMax,iMax,eMax)); crystallite_subLp0 = 0.0_pReal
allocate(crystallite_dPdF(3,3,3,3,gMax,iMax,eMax)); crystallite_dPdF = 0.0_pReal allocate(crystallite_subTstar0_v(6,gMax,iMax,eMax)); crystallite_subTstar0_v = 0.0_pReal
allocate(crystallite_fallbackdPdF(3,3,3,3,gMax,iMax,eMax)); crystallite_fallbackdPdF = 0.0_pReal allocate(crystallite_dPdF(3,3,3,3,gMax,iMax,eMax)); crystallite_dPdF = 0.0_pReal
allocate(crystallite_dt(gMax,iMax,eMax)); crystallite_dt = 0.0_pReal allocate(crystallite_fallbackdPdF(3,3,3,3,gMax,iMax,eMax)); crystallite_fallbackdPdF = 0.0_pReal
allocate(crystallite_subdt(gMax,iMax,eMax)); crystallite_subdt = 0.0_pReal allocate(crystallite_dt(gMax,iMax,eMax)); crystallite_dt = 0.0_pReal
allocate(crystallite_subFrac(gMax,iMax,eMax)); crystallite_subFrac = 0.0_pReal allocate(crystallite_subdt(gMax,iMax,eMax)); crystallite_subdt = 0.0_pReal
allocate(crystallite_subStep(gMax,iMax,eMax)); crystallite_subStep = 0.0_pReal allocate(crystallite_subFrac(gMax,iMax,eMax)); crystallite_subFrac = 0.0_pReal
allocate(crystallite_localConstitution(gMax,iMax,eMax)); crystallite_localConstitution = .true. allocate(crystallite_subStep(gMax,iMax,eMax)); crystallite_subStep = 0.0_pReal
allocate(crystallite_requested(gMax,iMax,eMax)); crystallite_requested = .false. allocate(crystallite_localConstitution(gMax,iMax,eMax)); crystallite_localConstitution = .true.
allocate(crystallite_onTrack(gMax,iMax,eMax)); crystallite_onTrack = .false. allocate(crystallite_requested(gMax,iMax,eMax)); crystallite_requested = .false.
allocate(crystallite_converged(gMax,iMax,eMax)); crystallite_converged = .true. allocate(crystallite_onTrack(gMax,iMax,eMax)); crystallite_onTrack = .true.
allocate(crystallite_converged(gMax,iMax,eMax)); crystallite_converged = .true.
allocate(crystallite_stateConverged(gMax,iMax,eMax)); crystallite_stateConverged = .false.
allocate(crystallite_temperatureConverged(gMax,iMax,eMax)); crystallite_temperatureConverged = .false.
allocate(crystallite_nonfinished(gMax,iMax,eMax)); crystallite_nonfinished = .true.
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over all cp elements do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over all cp elements
@ -158,39 +166,43 @@ subroutine crystallite_init(Temperature)
write(6,*) write(6,*)
write(6,*) '<<<+- crystallite init -+>>>' write(6,*) '<<<+- crystallite init -+>>>'
write(6,*) write(6,*)
write(6,'(a32,x,7(i5,x))') 'crystallite_Nresults: ', crystallite_Nresults write(6,'(a35,x,7(i5,x))') 'crystallite_Nresults: ', crystallite_Nresults
write(6,'(a32,x,7(i5,x))') 'crystallite_Temperature ', shape(crystallite_Temperature) write(6,*)
write(6,'(a32,x,7(i5,x))') 'crystallite_Fe: ', shape(crystallite_Fe) write(6,'(a35,x,7(i5,x))') 'crystallite_Temperature: ', shape(crystallite_Temperature)
write(6,'(a32,x,7(i5,x))') 'crystallite_Fp: ', shape(crystallite_Fp) write(6,'(a35,x,7(i5,x))') 'crystallite_Fe: ', shape(crystallite_Fe)
write(6,'(a32,x,7(i5,x))') 'crystallite_Lp: ', shape(crystallite_Lp) write(6,'(a35,x,7(i5,x))') 'crystallite_Fp: ', shape(crystallite_Fp)
write(6,'(a32,x,7(i5,x))') 'crystallite_F0: ', shape(crystallite_F0) write(6,'(a35,x,7(i5,x))') 'crystallite_Lp: ', shape(crystallite_Lp)
write(6,'(a32,x,7(i5,x))') 'crystallite_Fp0: ', shape(crystallite_Fp0) write(6,'(a35,x,7(i5,x))') 'crystallite_F0: ', shape(crystallite_F0)
write(6,'(a32,x,7(i5,x))') 'crystallite_Lp0: ', shape(crystallite_Lp0) write(6,'(a35,x,7(i5,x))') 'crystallite_Fp0: ', shape(crystallite_Fp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedF: ', shape(crystallite_partionedF) write(6,'(a35,x,7(i5,x))') 'crystallite_Lp0: ', shape(crystallite_Lp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedTemp0: ', shape(crystallite_partionedTemperature0) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedF: ', shape(crystallite_partionedF)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedF0: ', shape(crystallite_partionedF0) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedTemp0: ', shape(crystallite_partionedTemperature0)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedF0: ', shape(crystallite_partionedF0)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedFp0: ', shape(crystallite_partionedFp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_subF: ', shape(crystallite_subF) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedLp0: ', shape(crystallite_partionedLp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_subTemperature0: ', shape(crystallite_subTemperature0) write(6,'(a35,x,7(i5,x))') 'crystallite_subF: ', shape(crystallite_subF)
write(6,'(a32,x,7(i5,x))') 'crystallite_subF0: ', shape(crystallite_subF0) write(6,'(a35,x,7(i5,x))') 'crystallite_subTemperature0: ', shape(crystallite_subTemperature0)
write(6,'(a32,x,7(i5,x))') 'crystallite_subFp0: ', shape(crystallite_subFp0) write(6,'(a35,x,7(i5,x))') 'crystallite_subF0: ', shape(crystallite_subF0)
write(6,'(a32,x,7(i5,x))') 'crystallite_subLp0: ', shape(crystallite_subLp0) write(6,'(a35,x,7(i5,x))') 'crystallite_subFp0: ', shape(crystallite_subFp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_P: ', shape(crystallite_P) write(6,'(a35,x,7(i5,x))') 'crystallite_subLp0: ', shape(crystallite_subLp0)
write(6,'(a32,x,7(i5,x))') 'crystallite_Tstar_v: ', shape(crystallite_Tstar_v) write(6,'(a35,x,7(i5,x))') 'crystallite_P: ', shape(crystallite_P)
write(6,'(a32,x,7(i5,x))') 'crystallite_Tstar0_v: ', shape(crystallite_Tstar0_v) write(6,'(a35,x,7(i5,x))') 'crystallite_Tstar_v: ', shape(crystallite_Tstar_v)
write(6,'(a32,x,7(i5,x))') 'crystallite_partionedTstar0_v: ', shape(crystallite_partionedTstar0_v) write(6,'(a35,x,7(i5,x))') 'crystallite_Tstar0_v: ', shape(crystallite_Tstar0_v)
write(6,'(a32,x,7(i5,x))') 'crystallite_subTstar0_v: ', shape(crystallite_subTstar0_v) write(6,'(a35,x,7(i5,x))') 'crystallite_partionedTstar0_v: ', shape(crystallite_partionedTstar0_v)
write(6,'(a32,x,7(i5,x))') 'crystallite_dPdF: ', shape(crystallite_dPdF) write(6,'(a35,x,7(i5,x))') 'crystallite_subTstar0_v: ', shape(crystallite_subTstar0_v)
write(6,'(a32,x,7(i5,x))') 'crystallite_fallbackdPdF: ', shape(crystallite_fallbackdPdF) write(6,'(a35,x,7(i5,x))') 'crystallite_dPdF: ', shape(crystallite_dPdF)
write(6,'(a32,x,7(i5,x))') 'crystallite_dt: ', shape(crystallite_dt) write(6,'(a35,x,7(i5,x))') 'crystallite_fallbackdPdF: ', shape(crystallite_fallbackdPdF)
write(6,'(a32,x,7(i5,x))') 'crystallite_subdt: ', shape(crystallite_subdt) write(6,'(a35,x,7(i5,x))') 'crystallite_dt: ', shape(crystallite_dt)
write(6,'(a32,x,7(i5,x))') 'crystallite_subFrac: ', shape(crystallite_subFrac) write(6,'(a35,x,7(i5,x))') 'crystallite_subdt: ', shape(crystallite_subdt)
write(6,'(a32,x,7(i5,x))') 'crystallite_subStep: ', shape(crystallite_subStep) write(6,'(a35,x,7(i5,x))') 'crystallite_subFrac: ', shape(crystallite_subFrac)
write(6,'(a32,x,7(i5,x))') 'crystallite_localConstitution: ', shape(crystallite_localConstitution) write(6,'(a35,x,7(i5,x))') 'crystallite_subStep: ', shape(crystallite_subStep)
write(6,'(a32,x,7(i5,x))') 'crystallite_requested: ', shape(crystallite_requested) write(6,'(a35,x,7(i5,x))') 'crystallite_localConstitution: ', shape(crystallite_localConstitution)
write(6,'(a32,x,7(i5,x))') 'crystallite_onTrack: ', shape(crystallite_onTrack) write(6,'(a35,x,7(i5,x))') 'crystallite_requested: ', shape(crystallite_requested)
write(6,'(a32,x,7(i5,x))') 'crystallite_converged: ', shape(crystallite_converged) write(6,'(a35,x,7(i5,x))') 'crystallite_onTrack: ', shape(crystallite_onTrack)
write(6,'(a35,x,7(i5,x))') 'crystallite_converged: ', shape(crystallite_converged)
write(6,'(a35,x,7(i5,x))') 'crystallite_stateConverged: ', shape(crystallite_stateConverged)
write(6,'(a35,x,7(i5,x))') 'crystallite_temperatureConverged: ', shape(crystallite_temperatureConverged)
write(6,'(a35,x,7(i5,x))') 'crystallite_nonfinished: ', shape(crystallite_nonfinished)
write(6,*) write(6,*)
write(6,*) 'Number of non-local grains: ',count(.not. crystallite_localConstitution) write(6,*) 'Number of non-local grains: ',count(.not. crystallite_localConstitution)
call flush(6) call flush(6)
@ -219,7 +231,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
nCryst nCryst
use debug, only: debugger, & use debug, only: debugger, &
debug_CrystalliteLoopDistribution, & debug_CrystalliteLoopDistribution, &
debug_StateLoopDistribution, & debug_CrystalliteStateLoopDistribution, &
debug_StiffnessStateLoopDistribution debug_StiffnessStateLoopDistribution
use IO, only: IO_warning use IO, only: IO_warning
use math, only: math_inv3x3, & use math, only: math_inv3x3, &
@ -235,10 +247,14 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
use material, only: homogenization_Ngrains use material, only: homogenization_Ngrains
use constitutive, only: constitutive_maxSizeState, & use constitutive, only: constitutive_maxSizeState, &
constitutive_sizeState, & constitutive_sizeState, &
constitutive_sizeDotState, &
constitutive_state, & constitutive_state, &
constitutive_subState0, & constitutive_subState0, &
constitutive_partionedState0, & constitutive_partionedState0, &
constitutive_homogenizedC constitutive_homogenizedC, &
constitutive_dotState, &
constitutive_collectDotState, &
constitutive_dotTemperature
implicit none implicit none
@ -258,7 +274,8 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
myLp, & ! local copy of the plastic velocity gradient myLp, & ! local copy of the plastic velocity gradient
myP ! local copy of the 1st Piola-Kirchhoff stress tensor myP ! local copy of the 1st Piola-Kirchhoff stress tensor
real(pReal), dimension(6) :: myTstar_v ! local copy of the 2nd Piola-Kirchhoff stress vector real(pReal), dimension(6) :: myTstar_v ! local copy of the 2nd Piola-Kirchhoff stress vector
real(pReal), dimension(constitutive_maxSizeState) :: myState ! local copy of the state real(pReal), dimension(constitutive_maxSizeState) :: myState, & ! local copy of the state
myDotState ! local copy of dotState
integer(pInt) NiterationCrystallite, & ! number of iterations in crystallite loop integer(pInt) NiterationCrystallite, & ! number of iterations in crystallite loop
NiterationState ! number of iterations in state loop NiterationState ! number of iterations in state loop
integer(pInt) e, & ! element index integer(pInt) e, & ! element index
@ -267,8 +284,11 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
k, & k, &
l, & l, &
myNgrains, & myNgrains, &
mySizeState mySizeState, &
logical onTrack, & ! flag indicating wether we are still on track mySizeDotState
logical onTrack, & ! flag indicating whether we are still on track
temperatureConverged, & ! flag indicating if temperature converged
stateConverged, & ! flag indicating if state converged
converged ! flag indicating if iteration converged converged ! flag indicating if iteration converged
@ -313,22 +333,19 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
NiterationCrystallite = 0_pInt NiterationCrystallite = 0_pInt
do while (any(crystallite_subStep(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMin)) ! cutback loop for crystallites do while (any(crystallite_subStep(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMin)) ! cutback loop for crystallites
NiterationCrystallite = NiterationCrystallite + 1
if (any(.not. crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) .and. & ! any non-converged grain if (any(.not. crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) .and. & ! any non-converged grain
.not. crystallite_localConstitution(:,:,FEsolving_execELem(1):FEsolving_execElem(2))) ) & ! has non-local constitution? .not. crystallite_localConstitution(:,:,FEsolving_execELem(1):FEsolving_execElem(2))) ) & ! has non-local constitution?
crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) = & crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) = &
crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) .and. & crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) .and. &
crystallite_localConstitution(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) ! reset non-local grains' convergence status crystallite_localConstitution(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) ! reset non-local grains' convergence status
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e)) myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains do g = 1,myNgrains
debugger = (e == 1 .and. i == 1 .and. g == 1)
if (crystallite_converged(g,i,e)) then if (crystallite_converged(g,i,e)) then
if (debugger) then if (debugger) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
@ -347,11 +364,17 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_subLp0(:,:,g,i,e) = crystallite_Lp(:,:,g,i,e) ! ...plastic velocity gradient crystallite_subLp0(:,:,g,i,e) = crystallite_Lp(:,:,g,i,e) ! ...plastic velocity gradient
constitutive_subState0(g,i,e)%p = constitutive_state(g,i,e)%p ! ...microstructure constitutive_subState0(g,i,e)%p = constitutive_state(g,i,e)%p ! ...microstructure
crystallite_subTstar0_v(:,g,i,e) = crystallite_Tstar_v(:,g,i,e) ! ...2nd PK stress crystallite_subTstar0_v(:,g,i,e) = crystallite_Tstar_v(:,g,i,e) ! ...2nd PK stress
else ! already at final time
!$OMP CRITICAL (distributionCrystallite)
debug_CrystalliteLoopDistribution(min(nCryst+1,NiterationCrystallite)) = &
debug_CrystalliteLoopDistribution(min(nCryst+1,NiterationCrystallite)) + 1
!$OMPEND CRITICAL (distributionCrystallite)
endif endif
else else
crystallite_subStep(g,i,e) = 0.5_pReal * crystallite_subStep(g,i,e) ! cut step in half and restore... crystallite_subStep(g,i,e) = 0.5_pReal * crystallite_subStep(g,i,e) ! cut step in half and restore...
crystallite_Temperature(g,i,e) = crystallite_subTemperature0(g,i,e) ! ...temperature crystallite_Temperature(g,i,e) = crystallite_subTemperature0(g,i,e) ! ...temperature
crystallite_Fp(:,:,g,i,e) = crystallite_subFp0(:,:,g,i,e) ! ...plastic def grad crystallite_Fp(:,:,g,i,e) = crystallite_subFp0(:,:,g,i,e) ! ...plastic def grad
crystallite_invFp(:,:,g,i,e) = math_inv3x3(crystallite_Fp(:,:,g,i,e))
crystallite_Lp(:,:,g,i,e) = crystallite_subLp0(:,:,g,i,e) ! ...plastic velocity grad crystallite_Lp(:,:,g,i,e) = crystallite_subLp0(:,:,g,i,e) ! ...plastic velocity grad
constitutive_state(g,i,e)%p = constitutive_subState0(g,i,e)%p ! ...microstructure constitutive_state(g,i,e)%p = constitutive_subState0(g,i,e)%p ! ...microstructure
crystallite_Tstar_v(:,g,i,e) = crystallite_subTstar0_v(:,g,i,e) ! ...2nd PK stress crystallite_Tstar_v(:,g,i,e) = crystallite_subTstar0_v(:,g,i,e) ! ...2nd PK stress
@ -367,8 +390,8 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_onTrack(g,i,e) = crystallite_subStep(g,i,e) > subStepMin ! still on track or already done (beyond repair) crystallite_onTrack(g,i,e) = crystallite_subStep(g,i,e) > subStepMin ! still on track or already done (beyond repair)
if (crystallite_onTrack(g,i,e)) then ! specify task (according to substep) if (crystallite_onTrack(g,i,e)) then ! specify task (according to substep)
crystallite_subF(:,:,g,i,e) = crystallite_subF0(:,:,g,i,e) + & crystallite_subF(:,:,g,i,e) = crystallite_subF0(:,:,g,i,e) + &
crystallite_subStep(g,i,e) * & crystallite_subStep(g,i,e) * &
(crystallite_partionedF(:,:,g,i,e) - crystallite_partionedF0(:,:,g,i,e)) (crystallite_partionedF(:,:,g,i,e) - crystallite_partionedF0(:,:,g,i,e))
crystallite_subdt(g,i,e) = crystallite_subStep(g,i,e) * crystallite_dt(g,i,e) crystallite_subdt(g,i,e) = crystallite_subStep(g,i,e) * crystallite_dt(g,i,e)
if (debugger) then if (debugger) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
@ -383,36 +406,54 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
enddo enddo
!$OMPEND PARALLEL DO !$OMPEND PARALLEL DO
crystallite_nonfinished = ( crystallite_requested &
.and. crystallite_onTrack &
.and. .not. crystallite_converged)
! --+>> preguess for state <<+-- ! --+>> preguess for state <<+--
! !
! incrementing by crystallite_subdt ! incrementing by crystallite_subdt
! based on constitutive_subState0 ! based on constitutive_subState0
! results in constitutive_state ! results in constitutive_state
! first loop for collection of state evolution based on old state
! second loop for updating to new state
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e)) myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains do g = 1,myNgrains
if ( crystallite_requested(g,i,e) & constitutive_dotState(g,i,e)%p = 0.0_pReal ! zero out dotState
.and. crystallite_onTrack(g,i,e) & enddo; enddo; enddo
.and. .not. crystallite_converged(g,i,e)) then ! all undone crystallites !$OMPEND PARALLEL DO
crystallite_converged(g,i,e) = crystallite_updateState(g,i,e) ! use former evolution rate !$OMP PARALLEL DO
crystallite_converged(g,i,e) = crystallite_updateTemperature(g,i,e) ! use former evolution rate do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
crystallite_converged(g,i,e) = .false. ! force at least one iteration step even if state already converged myNgrains = homogenization_Ngrains(mesh_element(3,e))
endif do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
enddo do g = 1,myNgrains
enddo if (crystallite_nonfinished(g,i,e)) & ! all undone crystallites
enddo call constitutive_collectDotState(crystallite_Tstar_v(:,g,i,e), crystallite_Fp(:,:,g,i,e), &
crystallite_invFp(:,:,g,i,e), crystallite_Temperature(g,i,e), g, i, e)
enddo; enddo; enddo
!$OMPEND PARALLEL DO
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains
if (crystallite_nonfinished(g,i,e)) then ! all undone crystallites
crystallite_stateConverged(g,i,e) = crystallite_updateState(g,i,e) ! update state
crystallite_temperatureConverged(g,i,e) = crystallite_updateTemperature(g,i,e) ! update temperature
crystallite_converged(g,i,e) = .false. ! force at least one iteration step even if state already converged
endif
enddo; enddo; enddo
!$OMPEND PARALLEL DO !$OMPEND PARALLEL DO
! --+>> state loop <<+-- ! --+>> state loop <<+--
NiterationState = 0_pInt NiterationState = 0_pInt
do while ( any( crystallite_requested(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) & do while ( any(crystallite_nonfinished(:,:,FEsolving_execELem(1):FEsolving_execElem(2))) &
.and. crystallite_onTrack(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) &
.and. .not. crystallite_converged(:,:,FEsolving_execELem(1):FEsolving_execElem(2)) ) &
.and. NiterationState < nState) ! convergence loop for crystallite .and. NiterationState < nState) ! convergence loop for crystallite
NiterationState = NiterationState + 1_pInt NiterationState = NiterationState + 1_pInt
@ -430,41 +471,57 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains do g = 1,myNgrains
debugger = (e == 1 .and. i == 1 .and. g == 1) debugger = (e == 1 .and. i == 1 .and. g == 1)
if ( crystallite_requested(g,i,e) & if (crystallite_nonfinished(g,i,e)) & ! all undone crystallites
.and. crystallite_onTrack(g,i,e) &
.and. .not. crystallite_converged(g,i,e) ) & ! all undone crystallites
crystallite_onTrack(g,i,e) = crystallite_integrateStress(g,i,e) crystallite_onTrack(g,i,e) = crystallite_integrateStress(g,i,e)
enddo enddo
enddo enddo
enddo enddo
!$OMPEND PARALLEL DO !$OMPEND PARALLEL DO
crystallite_nonfinished = crystallite_nonfinished .and. crystallite_onTrack
! --+>> state integration <<+-- ! --+>> state integration <<+--
! !
! incrementing by crystallite_subdt ! incrementing by crystallite_subdt
! based on constitutive_subState0 ! based on constitutive_subState0
! results in constitutive_state ! results in constitutive_state
! first loop for collection of state evolution based on old state
! second loop for updating to new state
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains
constitutive_dotState(g,i,e)%p = 0.0_pReal ! zero out dotState
enddo; enddo; enddo
!$OMPEND PARALLEL DO
!$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains
if (crystallite_nonfinished(g,i,e)) & ! all undone crystallites
call constitutive_collectDotState(crystallite_Tstar_v(:,g,i,e), crystallite_Fp(:,:,g,i,e), &
crystallite_invFp(:,:,g,i,e), crystallite_Temperature(g,i,e), g, i, e)
enddo; enddo; enddo
!$OMPEND PARALLEL DO
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
myNgrains = homogenization_Ngrains(mesh_element(3,e)) myNgrains = homogenization_Ngrains(mesh_element(3,e))
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
do g = 1,myNgrains do g = 1,myNgrains
debugger = (e == 1 .and. i == 1 .and. g == 1) debugger = (e == 1 .and. i == 1 .and. g == 1)
if ( crystallite_requested(g,i,e) & if (crystallite_nonfinished(g,i,e)) then ! all undone crystallites
.and. crystallite_onTrack(g,i,e) & crystallite_stateConverged(g,i,e) = crystallite_updateState(g,i,e) ! update state
.and. .not. crystallite_converged(g,i,e)) then ! all undone crystallites crystallite_temperatureConverged(g,i,e) = crystallite_updateTemperature(g,i,e) ! update temperature
crystallite_converged(g,i,e) = crystallite_updateState(g,i,e) .and. & crystallite_converged(g,i,e) = crystallite_stateConverged(g,i,e) .and. crystallite_temperatureConverged(g,i,e)
crystallite_updateTemperature(g,i,e)
if (debugger) write (6,*) g,i,e,'converged after updState',crystallite_converged(g,i,e) if (debugger) write (6,*) g,i,e,'converged after updState',crystallite_converged(g,i,e)
if (crystallite_converged(g,i,e)) then if (crystallite_converged(g,i,e)) then
!$OMP CRITICAL (distributionState) !$OMP CRITICAL (distributionState)
debug_StateLoopDistribution(NiterationState) = debug_StateLoopDistribution(NiterationState) + 1 debug_CrystalliteStateLoopDistribution(NiterationState) = &
debug_CrystalliteStateLoopDistribution(NiterationState) + 1
!$OMPEND CRITICAL (distributionState) !$OMPEND CRITICAL (distributionState)
!$OMP CRITICAL (distributionCrystallite)
debug_CrystalliteLoopDistribution(NiterationCrystallite) = &
debug_CrystalliteLoopDistribution(NiterationCrystallite) + 1
!$OMPEND CRITICAL (distributionCrystallite)
endif endif
endif endif
enddo enddo
@ -472,8 +529,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
enddo enddo
!$OMPEND PARALLEL DO !$OMPEND PARALLEL DO
crystallite_nonfinished = crystallite_nonfinished .and. .not. crystallite_converged
enddo ! crystallite convergence loop enddo ! crystallite convergence loop
NiterationCrystallite = NiterationCrystallite + 1
enddo ! cutback loop enddo ! cutback loop
@ -511,10 +572,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
! debugger = (g == 1 .and. i == 1 .and. e == 1) ! debugger = (g == 1 .and. i == 1 .and. e == 1)
if (crystallite_converged(g,i,e)) then ! grain converged in above iteration if (crystallite_converged(g,i,e)) then ! grain converged in above iteration
mySizeState = constitutive_sizeState(g,i,e) ! number of state variables for this grain mySizeState = constitutive_sizeState(g,i,e) ! number of state variables for this grain
myState(1:mySizeState) = constitutive_state(g,i,e)%p ! remember unperturbed, converged state... mySizeDotState = constitutive_sizeDotState(g,i,e) ! number of dotStates for this grain
myState(1:mySizeState) = constitutive_state(g,i,e)%p ! remember unperturbed, converged state, ...
myDotState(1:mySizeDotState) = constitutive_dotState(g,i,e)%p ! ... dotStates, ...
myTemperature = crystallite_Temperature(g,i,e) ! ... Temperature, ...
myF = crystallite_subF(:,:,g,i,e) ! ... and kinematics myF = crystallite_subF(:,:,g,i,e) ! ... and kinematics
myFp = crystallite_Fp(:,:,g,i,e) myFp = crystallite_Fp(:,:,g,i,e)
myTemperature = crystallite_Temperature(g,i,e)
myFe = crystallite_Fe(:,:,g,i,e) myFe = crystallite_Fe(:,:,g,i,e)
myLp = crystallite_Lp(:,:,g,i,e) myLp = crystallite_Lp(:,:,g,i,e)
myTstar_v = crystallite_Tstar_v(:,g,i,e) myTstar_v = crystallite_Tstar_v(:,g,i,e)
@ -545,11 +608,14 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
onTrack = .true. onTrack = .true.
converged = .false. converged = .false.
NiterationState = 0_pInt NiterationState = 0_pInt
do while(.not. converged .and. onTrack .and. NiterationState < nState) ! keep cycling until done (potentially non-converged) do while(.not. converged .and. onTrack .and. NiterationState < nState) ! keep cycling until done (potentially non-converged)
NiterationState = NiterationState + 1_pInt NiterationState = NiterationState + 1_pInt
onTrack = crystallite_integrateStress(g,i,e) ! stress of perturbed situation (overwrites _P,_Tstar_v,_Fp,_Lp,_Fe) onTrack = crystallite_integrateStress(g,i,e) ! stress of perturbed situation (overwrites _P,_Tstar_v,_Fp,_Lp,_Fe)
if (onTrack) converged = crystallite_updateState(g,i,e).AND.& ! update state if (onTrack) then
crystallite_updateTemperature(g,i,e) ! update temperature stateConverged = crystallite_updateState(g,i,e) ! update state
temperatureConverged = crystallite_updateTemperature(g,i,e) ! update temperature
converged = stateConverged .and. temperatureConverged
endif
if (debugger) then if (debugger) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write (6,*) '-------------' write (6,*) '-------------'
@ -563,16 +629,18 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
enddo enddo
if (converged) & ! converged state warrants stiffness update if (converged) & ! converged state warrants stiffness update
crystallite_dPdF(:,:,k,l,g,i,e) = (crystallite_P(:,:,g,i,e) - myP)/pert_Fg ! tangent dP_ij/dFg_kl crystallite_dPdF(:,:,k,l,g,i,e) = (crystallite_P(:,:,g,i,e) - myP)/pert_Fg ! tangent dP_ij/dFg_kl
constitutive_state(g,i,e)%p = myState ! restore unperturbed, converged state... constitutive_state(g,i,e)%p = myState ! restore unperturbed, converged state, ...
crystallite_Temperature(g,i,e)= myTemperature ! ... temperature constitutive_dotState(g,i,e)%p = myDotState ! ... dotState, ...
crystallite_Fp(:,:,g,i,e) = myFp ! ... and kinematics crystallite_Temperature(g,i,e) = myTemperature ! ... temperature, ...
crystallite_Fe(:,:,g,i,e) = myFe crystallite_Fp(:,:,g,i,e) = myFp ! ... and kinematics
crystallite_Lp(:,:,g,i,e) = myLp crystallite_Fe(:,:,g,i,e) = myFe
crystallite_Tstar_v(:,g,i,e) = myTstar_v crystallite_Lp(:,:,g,i,e) = myLp
crystallite_P(:,:,g,i,e) = myP crystallite_Tstar_v(:,g,i,e) = myTstar_v
crystallite_P(:,:,g,i,e) = myP
!$OMP CRITICAL (out) !$OMP CRITICAL (out)
debug_StiffnessStateLoopDistribution(NiterationState) = & debug_StiffnessStateLoopDistribution(NiterationState) = &
debug_StiffnessstateLoopDistribution(NiterationState) + 1 debug_StiffnessstateLoopDistribution(NiterationState) + 1
if (nState < NiterationState) write(6,*) 'ohh shit!! stiffenss state loop debugging exceeded',NiterationState
!$OMPEND CRITICAL (out) !$OMPEND CRITICAL (out)
enddo enddo
enddo enddo
@ -633,9 +701,11 @@ endsubroutine
mySize = constitutive_sizeDotState(g,i,e) mySize = constitutive_sizeDotState(g,i,e)
! calculate the residuum ! calculate the residuum
if (any(abs(constitutive_dotState(g,i,e)%p) > 1e10_pReal)) &
write(6,*) 'dotState: crap found at',g,i,e,constitutive_dotState(g,i,e)%p
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
residuum = constitutive_state(g,i,e)%p(1:mySize) - constitutive_subState0(g,i,e)%p(1:mySize) - & residuum = constitutive_state(g,i,e)%p(1:mySize) - constitutive_subState0(g,i,e)%p(1:mySize) - &
crystallite_subdt(g,i,e) * constitutive_dotState(crystallite_Tstar_v(:,g,i,e),crystallite_Temperature(g,i,e),g,i,e) crystallite_subdt(g,i,e) * constitutive_dotState(g,i,e)%p(1:mySize)
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
debug_cumDotStateCalls = debug_cumDotStateCalls + 1_pInt debug_cumDotStateCalls = debug_cumDotStateCalls + 1_pInt
debug_cumDotStateTicks = debug_cumDotStateTicks + tock-tick debug_cumDotStateTicks = debug_cumDotStateTicks + tock-tick
@ -702,7 +772,8 @@ endsubroutine
! calculate the residuum ! calculate the residuum
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
residuum = crystallite_Temperature(g,i,e) - crystallite_subTemperature0(g,i,e) - & residuum = crystallite_Temperature(g,i,e) - crystallite_subTemperature0(g,i,e) - &
crystallite_subdt(g,i,e) * constitutive_dotTemperature(crystallite_Tstar_v(:,g,i,e),crystallite_Temperature(g,i,e),g,i,e) crystallite_subdt(g,i,e) * &
constitutive_dotTemperature(crystallite_Tstar_v(:,g,i,e),crystallite_Temperature(g,i,e),g,i,e)
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
debug_cumDotTemperatureCalls = debug_cumDotTemperatureCalls + 1_pInt debug_cumDotTemperatureCalls = debug_cumDotTemperatureCalls + 1_pInt
debug_cumDotTemperatureTicks = debug_cumDotTemperatureTicks + tock-tick debug_cumDotTemperatureTicks = debug_cumDotTemperatureTicks + tock-tick
@ -844,7 +915,7 @@ endsubroutine
A = math_mul33x33(transpose(invFp_current), math_mul33x33(transpose(Fg_new),math_mul33x33(Fg_new,invFp_current))) A = math_mul33x33(transpose(invFp_current), math_mul33x33(transpose(Fg_new),math_mul33x33(Fg_new,invFp_current)))
! update microstructure ! update microstructure
call constitutive_microstructure(crystallite_Temperature(g,i,e),g,i,e) call constitutive_microstructure(crystallite_subTemperature0(g,i,e), crystallite_subFp0, g, i, e)
! get elasticity tensor ! get elasticity tensor
C_66 = constitutive_homogenizedC(g,i,e) C_66 = constitutive_homogenizedC(g,i,e)
@ -877,7 +948,7 @@ LpLoop: do
! calculate plastic velocity gradient and its tangent according to constitutive law ! calculate plastic velocity gradient and its tangent according to constitutive law
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
call constitutive_LpAndItsTangent(Lp_constitutive,dLp_constitutive,Tstar_v,crystallite_Temperature(g,i,e),g,i,e) call constitutive_LpAndItsTangent(Lp_constitutive, dLp_constitutive, Tstar_v, crystallite_Temperature(g,i,e), g, i, e)
call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) call system_clock(count=tock,count_rate=tickrate,count_max=maxticks)
debug_cumLpCalls = debug_cumLpCalls + 1_pInt debug_cumLpCalls = debug_cumLpCalls + 1_pInt
debug_cumLpTicks = debug_cumLpTicks + tock-tick debug_cumLpTicks = debug_cumLpTicks + tock-tick
@ -934,6 +1005,10 @@ LpLoop: do
if (debugger) then if (debugger) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*) '::: integrateStress failed on dR/dLp inversion at iteration', NiterationStress write(6,*) '::: integrateStress failed on dR/dLp inversion at iteration', NiterationStress
write(6,'(a9,3(i3,x),/,9(9(e12.2,x)/))') 'dTdLp at ',g,i,e,dTdLp
write(6,'(a20,3(i3,x),/,9(9(e12.2,x)/))') 'dLp_constitutive at ',g,i,e,dLp_constitutive
write(6,'(a9,3(i3,x),/,9(9(f12.7,x)/))') 'dRdLp at ',g,i,e,dRdLp
write(6,'(a11,3(i3,x),/,3(3(f12.7,x)/))') 'Lpguess at ',g,i,e,Lpguess
!$OMPEND CRITICAL (write2out) !$OMPEND CRITICAL (write2out)
endif endif
return return
@ -979,6 +1054,7 @@ LpLoop: do
crystallite_Tstar_v(:,g,i,e) = Tstar_v crystallite_Tstar_v(:,g,i,e) = Tstar_v
crystallite_Fp(:,:,g,i,e) = Fp_new crystallite_Fp(:,:,g,i,e) = Fp_new
crystallite_Fe(:,:,g,i,e) = Fe_new crystallite_Fe(:,:,g,i,e) = Fe_new
crystallite_invFp(:,:,g,i,e) = invFp_new
! set return flag to true ! set return flag to true
crystallite_integrateStress = .true. crystallite_integrateStress = .true.
@ -993,6 +1069,7 @@ LpLoop: do
!$OMP CRITICAL (distributionStress) !$OMP CRITICAL (distributionStress)
debug_StressLoopDistribution(NiterationStress) = debug_StressLoopDistribution(NiterationStress) + 1 debug_StressLoopDistribution(NiterationStress) = debug_StressLoopDistribution(NiterationStress) + 1
if (nStress < NiterationStress) write(6,*) 'ohh shit!! debug loop of stress exceeded',NiterationStress
!$OMPEND CRITICAL (distributionStress) !$OMPEND CRITICAL (distributionStress)
return return

94
code/debug.f90
View File

@ -6,10 +6,11 @@
implicit none implicit none
integer(pInt), dimension(:), allocatable :: debug_StressLoopDistribution integer(pInt), dimension(:), allocatable :: debug_StressLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_StateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_CrystalliteStateLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_StiffnessStateLoopDistribution integer(pInt), dimension(:), allocatable :: debug_StiffnessStateLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution integer(pInt), dimension(:), allocatable :: debug_CrystalliteLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution ! added <<<updated 31.07.2009>>> integer(pInt), dimension(:), allocatable :: debug_MaterialpointStateLoopDistribution
integer(pInt), dimension(:), allocatable :: debug_MaterialpointLoopDistribution
integer(pLongInt) :: debug_cumLpTicks = 0_pInt integer(pLongInt) :: debug_cumLpTicks = 0_pInt
integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt integer(pLongInt) :: debug_cumDotStateTicks = 0_pInt
integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pInt integer(pLongInt) :: debug_cumDotTemperatureTicks = 0_pInt
@ -27,18 +28,20 @@ subroutine debug_init()
use numerics, only: nStress, & use numerics, only: nStress, &
nState, & nState, &
nCryst, & nCryst, &
nHomog ! added <<<updated 31.07.2009>>> nMPstate, &
nHomog
implicit none implicit none
write(6,*) write(6,*)
write(6,*) '<<<+- debug init -+>>>' write(6,*) '<<<+- debug init -+>>>'
write(6,*) write(6,*)
allocate(debug_StressLoopDistribution(nStress)) ; debug_StressLoopDistribution = 0_pInt allocate(debug_StressLoopDistribution(nStress)) ; debug_StressLoopDistribution = 0_pInt
allocate(debug_StateLoopDistribution(nState)) ; debug_StateLoopDistribution = 0_pInt allocate(debug_CrystalliteStateLoopDistribution(nState)); debug_CrystalliteStateLoopDistribution = 0_pInt
allocate(debug_StiffnessStateLoopDistribution(nState)) ; debug_StiffnessStateLoopDistribution = 0_pInt allocate(debug_StiffnessStateLoopDistribution(nState)) ; debug_StiffnessStateLoopDistribution = 0_pInt
allocate(debug_CrystalliteLoopDistribution(nCryst)) ; debug_CrystalliteLoopDistribution = 0_pInt allocate(debug_CrystalliteLoopDistribution(nCryst+1)) ; debug_CrystalliteLoopDistribution = 0_pInt
allocate(debug_MaterialpointLoopDistribution(nhomog)) ; debug_MaterialpointLoopDistribution = 0_pInt ! added <<<updated 31.07.2009>>> allocate(debug_MaterialpointStateLoopDistribution(nMPstate)) ; debug_MaterialpointStateLoopDistribution = 0_pInt
allocate(debug_MaterialpointLoopDistribution(nHomog+1)) ; debug_MaterialpointLoopDistribution = 0_pInt
endsubroutine endsubroutine
!******************************************************************** !********************************************************************
@ -49,11 +52,12 @@ subroutine debug_reset()
use prec use prec
implicit none implicit none
debug_StressLoopDistribution = 0_pInt ! initialize debugging data debug_StressLoopDistribution = 0_pInt ! initialize debugging data
debug_StateLoopDistribution = 0_pInt debug_CrystalliteStateLoopDistribution = 0_pInt
debug_StiffnessStateLoopDistribution = 0_pInt debug_StiffnessStateLoopDistribution = 0_pInt
debug_CrystalliteLoopDistribution = 0_pInt debug_CrystalliteLoopDistribution = 0_pInt
debug_MaterialpointLoopDistribution = 0_pInt ! added <<<updated 31.07.2009>>> debug_MaterialpointStateLoopDistribution = 0_pInt
debug_MaterialpointLoopDistribution = 0_pInt
debug_cumLpTicks = 0_pInt debug_cumLpTicks = 0_pInt
debug_cumDotStateTicks = 0_pInt debug_cumDotStateTicks = 0_pInt
debug_cumDotTemperatureTicks = 0_pInt debug_cumDotTemperatureTicks = 0_pInt
@ -70,9 +74,10 @@ endsubroutine
use prec use prec
use numerics, only: nStress, & use numerics, only: nStress, &
nState, & nState, &
nCryst, & nCryst, &
nHomog ! added <<<updated 31.07.2009>>> nMPstate, &
nHomog
implicit none implicit none
integer(pInt) i,integral integer(pInt) i,integral
@ -111,21 +116,21 @@ endsubroutine
do i=1,nStress do i=1,nStress
if (debug_StressLoopDistribution(i) /= 0) then if (debug_StressLoopDistribution(i) /= 0) then
integral = integral + i*debug_StressLoopDistribution(i) integral = integral + i*debug_StressLoopDistribution(i)
write(6,'(i25,i10)') i,debug_StressLoopDistribution(i) write(6,'(i25,x,i10)') i,debug_StressLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,i10)') ' total',integral,sum(debug_StressLoopDistribution) write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_StressLoopDistribution)
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,*)
write(6,*) 'distribution_StateLoop :' write(6,*) 'distribution_CrystalliteStateLoop :'
do i=1,nState do i=1,nState
if (debug_StateLoopDistribution(i) /= 0) then if (debug_CrystalliteStateLoopDistribution(i) /= 0) then
integral = integral + i*debug_StateLoopDistribution(i) integral = integral + i*debug_CrystalliteStateLoopDistribution(i)
write(6,'(i25,i10)') i,debug_StateLoopDistribution(i) write(6,'(i25,x,i10)') i,debug_CrystalliteStateLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,i10)') ' total',integral,sum(debug_StateLoopDistribution) write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_CrystalliteStateLoopDistribution)
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,*)
@ -133,36 +138,57 @@ endsubroutine
do i=1,nState do i=1,nState
if (debug_StiffnessStateLoopDistribution(i) /= 0) then if (debug_StiffnessStateLoopDistribution(i) /= 0) then
integral = integral + i*debug_StiffnessStateLoopDistribution(i) integral = integral + i*debug_StiffnessStateLoopDistribution(i)
write(6,'(i25,i10)') i,debug_StiffnessStateLoopDistribution(i) write(6,'(i25,x,i10)') i,debug_StiffnessStateLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,i10)') ' total',integral,sum(debug_StiffnessStateLoopDistribution) write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_StiffnessStateLoopDistribution)
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,*)
write(6,*) 'distribution_CrystalliteLoop :' write(6,*) 'distribution_CrystalliteLoop :'
do i=1,nCryst do i=1,nCryst+1
if (debug_CrystalliteLoopDistribution(i) /= 0) then if (debug_CrystalliteLoopDistribution(i) /= 0) then
integral = integral + i*debug_CrystalliteLoopDistribution(i) integral = integral + i*debug_CrystalliteLoopDistribution(i)
write(6,'(i25,i10)') i,debug_CrystalliteLoopDistribution(i) if (i <= nCryst) then
write(6,'(i25,x,i10)') i,debug_CrystalliteLoopDistribution(i)
else
write(6,'(i25,a1,i10)') i-1,'+',debug_CrystalliteLoopDistribution(i)
endif
endif endif
enddo enddo
write(6,'(a15,i10,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution) write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_CrystalliteLoopDistribution)
write(6,*) write(6,*)
!* Material point loop counter <<<updated 31.07.2009>>> !* Material point loop counter <<<updated 31.07.2009>>>
integral = 0_pInt integral = 0_pInt
write(6,*) write(6,*)
write(6,*) 'distribution_MaterialpointLoop :' write(6,*) 'distribution_MaterialpointStateLoop :'
do i=1,nCryst do i=1,nMPstate
if (debug_MaterialpointLoopDistribution(i) /= 0) then if (debug_MaterialpointStateLoopDistribution(i) /= 0) then
integral = integral + i*debug_MaterialpointLoopDistribution(i) integral = integral + i*debug_MaterialpointStateLoopDistribution(i)
write(6,'(i25,i10)') i,debug_MaterialpointLoopDistribution(i) write(6,'(i25,x,i10)') i,debug_MaterialpointStateLoopDistribution(i)
endif endif
enddo enddo
write(6,'(a15,i10,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution) write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointStateLoopDistribution)
write(6,*) write(6,*)
integral = 0_pInt
write(6,*)
write(6,*) 'distribution_MaterialpointLoop :'
do i=1,nHomog+1
if (debug_MaterialpointLoopDistribution(i) /= 0) then
integral = integral + i*debug_MaterialpointLoopDistribution(i)
if (i <= nHomog) then
write(6,'(i25,x,i10)') i,debug_MaterialpointLoopDistribution(i)
else
write(6,'(i25,a1,i10)') i-1,'+',debug_MaterialpointLoopDistribution(i)
endif
endif
enddo
write(6,'(a15,i10,x,i10)') ' total',integral,sum(debug_MaterialpointLoopDistribution)
write(6,*)
endsubroutine endsubroutine
END MODULE debug END MODULE debug

61
code/homogenization.f90
View File

@ -185,9 +185,11 @@ subroutine materialpoint_stressAndItsTangent(&
use prec, only: pInt, & use prec, only: pInt, &
pReal pReal
use numerics, only: subStepMin, & use numerics, only: subStepMin, &
nHomog nHomog, &
nMPstate
use FEsolving, only: FEsolving_execElem, & use FEsolving, only: FEsolving_execElem, &
FEsolving_execIP FEsolving_execIP, &
terminallyIll
use mesh, only: mesh_element use mesh, only: mesh_element
use material, only: homogenization_Ngrains use material, only: homogenization_Ngrains
use constitutive, only: constitutive_state0, & use constitutive, only: constitutive_state0, &
@ -209,14 +211,16 @@ subroutine materialpoint_stressAndItsTangent(&
crystallite_partionedTstar0_v, & crystallite_partionedTstar0_v, &
crystallite_dt, & crystallite_dt, &
crystallite_requested, & crystallite_requested, &
crystallite_converged, &
crystallite_stressAndItsTangent crystallite_stressAndItsTangent
use debug, only: debug_MaterialpointLoopdistribution ! added <<<updated 31.07.2009>>> use debug, only: debug_MaterialpointLoopDistribution, &
debug_MaterialpointStateLoopDistribution
implicit none implicit none
real(pReal), intent(in) :: dt real(pReal), intent(in) :: dt
logical, intent(in) :: updateJaco logical, intent(in) :: updateJaco
integer(pInt) homogenization_Niteration integer(pInt) NiterationHomog,NiterationMPstate
integer(pInt) g,i,e,myNgrains integer(pInt) g,i,e,myNgrains
! ------ initialize to starting condition ------ ! ------ initialize to starting condition ------
@ -255,6 +259,7 @@ subroutine materialpoint_stressAndItsTangent(&
enddo enddo
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
NiterationHomog = 0_pInt
! ------ cutback loop ------ ! ------ cutback loop ------
@ -285,7 +290,11 @@ subroutine materialpoint_stressAndItsTangent(&
if (homogenization_sizeState(i,e) > 0_pInt) & if (homogenization_sizeState(i,e) > 0_pInt) &
homogenization_subState0(i,e)%p = homogenization_state(i,e)%p ! ...internal state of homog scheme homogenization_subState0(i,e)%p = homogenization_state(i,e)%p ! ...internal state of homog scheme
materialpoint_subF0(:,:,i,e) = materialpoint_subF(:,:,i,e) ! ...def grad materialpoint_subF0(:,:,i,e) = materialpoint_subF(:,:,i,e) ! ...def grad
else ! already at final time
!$OMP CRITICAL (distributionHomog)
debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) = &
debug_MaterialpointLoopDistribution(min(nHomog+1,NiterationHomog)) + 1
!$OMPEND CRITICAL (distributionHomog)
endif endif
! materialpoint didn't converge, so we need a cutback here ! materialpoint didn't converge, so we need a cutback here
@ -316,19 +325,19 @@ subroutine materialpoint_stressAndItsTangent(&
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
!* Checks for cutback/substepping loops: added <<<updated 31.07.2009>>> !* Checks for cutback/substepping loops: added <<<updated 31.07.2009>>>
write (6,'(a,/,8(L,x))') 'MP exceeds substep min',materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMin ! write (6,'(a,/,8(L,x))') 'MP exceeds substep min',materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) > subStepMin
write (6,'(a,/,8(L,x))') 'MP requested',materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) ! write (6,'(a,/,8(L,x))') 'MP requested',materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2))
write (6,'(a,/,8(f6.4,x))') 'MP subFrac',materialpoint_subFrac(:,FEsolving_execELem(1):FEsolving_execElem(2)) ! write (6,'(a,/,8(f6.4,x))') 'MP subFrac',materialpoint_subFrac(:,FEsolving_execELem(1):FEsolving_execElem(2))
write (6,'(a,/,8(f6.4,x))') 'MP subStep',materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2)) ! write (6,'(a,/,8(f6.4,x))') 'MP subStep',materialpoint_subStep(:,FEsolving_execELem(1):FEsolving_execElem(2))
! ------ convergence loop material point homogenization ------ ! ------ convergence loop material point homogenization ------
homogenization_Niteration = 0_pInt NiterationMPstate = 0_pInt
do while (any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) & do while (any( materialpoint_requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) &
.and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) & .and. .not. materialpoint_doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) &
) .and. homogenization_Niteration < nHomog) ! convergence loop for materialpoint ) .and. NiterationMPstate < nMPstate) ! convergence loop for materialpoint
homogenization_Niteration = homogenization_Niteration + 1 NiterationMPstate = NiterationMPstate + 1
! --+>> deformation partitioning <<+-- ! --+>> deformation partitioning <<+--
! !
@ -367,11 +376,15 @@ subroutine materialpoint_stressAndItsTangent(&
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
if ( materialpoint_requested(i,e) .and. & if ( materialpoint_requested(i,e) .and. &
.not. materialpoint_doneAndHappy(1,i,e)) then .not. materialpoint_doneAndHappy(1,i,e)) then
materialpoint_doneAndHappy(:,i,e) = homogenization_updateState(i,e) if (.not. all(crystallite_converged(:,i,e))) then
materialpoint_doneAndHappy(:,i,e) = (/.true.,.false./)
else
materialpoint_doneAndHappy(:,i,e) = homogenization_updateState(i,e)
endif
materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(:,i,e)) ! converged if done and happy materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(:,i,e)) ! converged if done and happy
if (materialpoint_converged(i,e)) & ! added <<<updated 31.07.2009>>> if (materialpoint_converged(i,e)) & ! added <<<updated 31.07.2009>>>
debug_MaterialpointLoopdistribution(homogenization_Niteration) = & debug_MaterialpointStateLoopdistribution(NiterationMPstate) = &
debug_MaterialpointLoopdistribution(homogenization_Niteration) + 1 debug_MaterialpointStateLoopdistribution(NiterationMPstate) + 1
endif endif
enddo enddo
enddo enddo
@ -379,18 +392,26 @@ subroutine materialpoint_stressAndItsTangent(&
enddo ! homogenization convergence loop enddo ! homogenization convergence loop
NiterationHomog = NiterationHomog +1_pInt
enddo ! cutback loop enddo ! cutback loop
! check for non-performer: any(.not. converged) ! check for non-performer: any(.not. converged)
! replace with elastic response ? ! replace everybody with odd response ?
!$OMP PARALLEL DO !$OMP PARALLEL DO
do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed elementLoop: do e = FEsolving_execElem(1),FEsolving_execElem(2) ! iterate over elements to be processed
do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed
call homogenization_averageStressAndItsTangent(i,e) if (materialpoint_converged(i,e)) then
call homogenization_averageTemperature(i,e) call homogenization_averageStressAndItsTangent(i,e)
call homogenization_averageTemperature(i,e)
else
terminallyIll = .true.
exit elementLoop
endif
enddo enddo
enddo enddo elementLoop
!$OMP END PARALLEL DO !$OMP END PARALLEL DO
write (6,*) 'Material Point finished' write (6,*) 'Material Point finished'

3
code/homogenization_RGC.f90
View File

@ -64,8 +64,7 @@ subroutine homogenization_RGC_init(&
allocate(homogenization_RGC_Ngrains(3,maxNinstance)); homogenization_RGC_Ngrains = 0_pInt allocate(homogenization_RGC_Ngrains(3,maxNinstance)); homogenization_RGC_Ngrains = 0_pInt
allocate(homogenization_RGC_ciAlpha(3,maxNinstance)); homogenization_RGC_ciAlpha = 0.0_pReal allocate(homogenization_RGC_ciAlpha(3,maxNinstance)); homogenization_RGC_ciAlpha = 0.0_pReal
allocate(homogenization_RGC_xiAlpha(3,maxNinstance)); homogenization_RGC_xiAlpha = 0.0_pReal allocate(homogenization_RGC_xiAlpha(3,maxNinstance)); homogenization_RGC_xiAlpha = 0.0_pReal
allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)); & allocate(homogenization_RGC_output(maxval(homogenization_Noutput),maxNinstance)); homogenization_RGC_output = ''
homogenization_RGC_output = ''
rewind(file) rewind(file)
line = '' line = ''

97
code/material.config
View File

@ -6,56 +6,23 @@
type isostrain type isostrain
Ngrains 1 Ngrains 1
[RGC]
type RGC
Ngrains 8
[Taylor2] [Taylor2]
type isostrain type isostrain
Ngrains 2 Ngrains 2
[Taylor4]
type isostrain
Ngrains 4
[Taylor10]
type isostrain
Ngrains 10
[Taylor100]
type isostrain
Ngrains 100
##################### #####################
<microstructure> <microstructure>
##################### #####################
[TWIPSteel_Poly] [Aluminum_Poly]
(constituent) phase 5 texture 1 fraction 1.0 (constituent) phase 3 texture 1 fraction 1.0
[TWIPsteel_001] [Aluminum_001]
(constituent) phase 5 texture 2 fraction 1.0 (constituent) phase 3 texture 2 fraction 1.0
[TWIPsteel_011] [Aluminum_j2]
(constituent) phase 5 texture 3 fraction 1.0
[TWIPsteel_111]
(constituent) phase 5 texture 4 fraction 1.0
[TWIPsteel_123]
(constituent) phase 5 texture 5 fraction 1.0
[Alu_Polycrystal]
(constituent) phase 1 texture 1 fraction 1.0 (constituent) phase 1 texture 1 fraction 1.0
[Alu_001]
(constituent) phase 1 texture 2 fraction 1.0
[Alu_011]
(constituent) phase 1 texture 3 fraction 1.0
[Alu_111]
(constituent) phase 1 texture 4 fraction 1.0
##################### #####################
<phase> <phase>
@ -101,11 +68,11 @@ c44 28.34e9
gdot0_slip 0.001 gdot0_slip 0.001
n_slip 20 n_slip 20
s0_slip 31e6 0 0 0 # per family tau0_slip 31e6 # per family
ssat_slip 63e6 0 0 0 # per family tausat_slip 63e6 # per family
gdot0_twin 0.001 gdot0_twin 0.001
n_twin 20 n_twin 20
s0_twin 31e6 0 0 0 # per family tau0_twin 31e6 # per family
s_pr 0 # push-up factor for slip saturation due to twinning s_pr 0 # push-up factor for slip saturation due to twinning
twin_b 0 twin_b 0
twin_c 0 twin_c 0
@ -120,43 +87,27 @@ interaction_sliptwin 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
interaction_twinslip 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 interaction_twinslip 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
interaction_twintwin 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 interaction_twintwin 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[Aluminum_nonlocal]
[TWIP steel FeMnC] constitution nonlocal
/nonlocal/
constitution dislobased (output) dislocation_density
(output) state_slip lattice_structure fcc
(output) rateofshear_slip Nslip 12 0 0 0 # per family
(output) mfp_slip
(output) thresholdstress_slip
(output) state_twin
(output) rateofshear_twin
(output) mfp_twin
(output) thresholdstress_twin
C11 175.0e9 # elastic constants in Pa c11 106.75e9
C12 115.0e9 c12 60.41e9
C44 135.0e9 c44 28.34e9
lattice_structure fcc
Nslip 12
Ntwin 12
### dislocation density-based constitutive parameters ### burgers 2.56e-10 0 0 0 # Burgers vector in m
burgers 2.56e-10 # Burgers vector [m] rhoEdgePos0 2.5e12 0 0 0 # Initial positive edge dislocation density in m/m**3
Qedge 5.5e-19 # Activation energy for dislocation glide [J/K] (0.5*G*b^3) rhoEdgeNeg0 2.5e12 0 0 0 # Initial negative edge dislocation density in m/m**3
grainsize 2.0e-5 # Average grain size [m] rhoScrewPos0 2.5e12 0 0 0 # Initial positive screw dislocation density in m/m**3
stacksize 5.0e-8 # Twin stack mean thickness [m] rhoScrewNeg0 2.5e12 0 0 0 # Initial negative screw dislocation density in m/m**3
fmax 1.0 # Maximum admissible twin volume fraction v0 100 0 0 0 # initial dislocation velocity
Ndot0 0.0 # Number of potential twin source per volume per time [1/m³.s] interaction_SlipSlip 1.0 2.2 3.0 1.6 3.8 4.5 # Dislocation interaction coefficients
interaction_coefficients 1.0 2.2 3.0 1.6 3.8 4.5 # Dislocation interaction coefficients
rho0 6.0e12 # Initial dislocation density [m/m³]
Cmfpslip 2.0 # Adjustable parameter controlling dislocation mean free path
Cmfptwin 1.0 # Adjustable parameter controlling twin mean free path
Cthresholdslip 0.1 # Adjustable parameter controlling threshold stress for dislocation motion
Cthresholdtwin 1.0 # Adjustable parameter controlling threshold stress for deformation twinning
Cactivolume 1.0 # Adjustable parameter controlling activation volume
Cstorage 0.02 # Adjustable parameter controlling dislocation storage
Carecovery 0.0 # Adjustable parameter controlling athermal recovery
##################### #####################
<texture> <texture>

100
code/math.f90
View File

@ -556,7 +556,6 @@ endsubroutine
!************************************************************************** !**************************************************************************
! matrix multiplication 3x3 = 1 ! matrix multiplication 3x3 = 1
!************************************************************************** !**************************************************************************
PURE FUNCTION math_mul3x3(A,B) PURE FUNCTION math_mul3x3(A,B)
use prec, only: pReal, pInt use prec, only: pReal, pInt
@ -578,7 +577,6 @@ endsubroutine
!************************************************************************** !**************************************************************************
! matrix multiplication 6x6 = 1 ! matrix multiplication 6x6 = 1
!************************************************************************** !**************************************************************************
PURE FUNCTION math_mul6x6(A,B) PURE FUNCTION math_mul6x6(A,B)
use prec, only: pReal, pInt use prec, only: pReal, pInt
@ -596,10 +594,10 @@ endsubroutine
ENDFUNCTION ENDFUNCTION
!************************************************************************** !**************************************************************************
! matrix multiplication 33x33 = 3x3 ! matrix multiplication 33x33 = 3x3
!************************************************************************** !**************************************************************************´
PURE FUNCTION math_mul33x33(A,B) PURE FUNCTION math_mul33x33(A,B)
use prec, only: pReal, pInt use prec, only: pReal, pInt
@ -636,27 +634,6 @@ endsubroutine
ENDFUNCTION ENDFUNCTION
!**************************************************************************
! matrix multiplication 66x6 = 6
!**************************************************************************
PURE FUNCTION math_mul66x6(A,B)
use prec, only: pReal, pInt
implicit none
integer(pInt) i
real(pReal), dimension(6,6), intent(in) :: A
real(pReal), dimension(6), intent(in) :: B
real(pReal), dimension(6) :: math_mul66x6
forall (i=1:6) math_mul66x6(i) = &
A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) + &
A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
return
ENDFUNCTION
!************************************************************************** !**************************************************************************
! matrix multiplication 99x99 = 9x9 ! matrix multiplication 99x99 = 9x9
!************************************************************************** !**************************************************************************
@ -680,6 +657,62 @@ endsubroutine
ENDFUNCTION ENDFUNCTION
!**************************************************************************
! matrix multiplication 33x3 = 3
!**************************************************************************
PURE FUNCTION math_mul33x3(A,B)
use prec, only: pReal, pInt
implicit none
integer(pInt) i
real(pReal), dimension(3,3), intent(in) :: A
real(pReal), dimension(3), intent(in) :: B
real(pReal), dimension(3) :: math_mul33x3
forall (i=1:3) math_mul33x3(i) = A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3)
return
ENDFUNCTION
!**************************************************************************
! matrix multiplication 66x6 = 6
!**************************************************************************
PURE FUNCTION math_mul66x6(A,B)
use prec, only: pReal, pInt
implicit none
integer(pInt) i
real(pReal), dimension(6,6), intent(in) :: A
real(pReal), dimension(6), intent(in) :: B
real(pReal), dimension(6) :: math_mul66x6
forall (i=1:6) math_mul66x6(i) = &
A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) + &
A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
return
ENDFUNCTION
!**************************************************************************
! transposition of a 3x3 matrix
!**************************************************************************
function math_transpose3x3(A)
use prec, only: pReal,pInt
implicit none
real(pReal),dimension(3,3),intent(in) :: A
real(pReal),dimension(3,3) :: math_transpose3x3
math_transpose3x3 = reshape( (/A(1,1), A(1,2), A(1,3), A(2,1), A(2,2), A(2,3), A(3,1), A(3,2), A(3,3) /),(/3,3/) )
return
endfunction
!************************************************************************** !**************************************************************************
! Cramer inversion of 3x3 matrix (function) ! Cramer inversion of 3x3 matrix (function)
@ -1025,6 +1058,23 @@ endsubroutine
ENDFUNCTION ENDFUNCTION
!********************************************************************
! euclidic norm of a 3x1 vector
!********************************************************************
pure function math_norm3(v3)
use prec, only: pReal,pInt
implicit none
real(pReal), dimension(3), intent(in) :: v3
real(pReal) math_norm3
math_norm3 = sqrt(v3(1)*v3(1)+v3(2)*v3(2)+v3(3)*v3(3))
return
endfunction
!******************************************************************** !********************************************************************
! convert 3x3 matrix into vector 9x1 ! convert 3x3 matrix into vector 9x1
!******************************************************************** !********************************************************************

24
code/mesh.f90
View File

@ -46,14 +46,15 @@
integer(pInt), dimension(2) :: mesh_maxValStateVar = 0_pInt integer(pInt), dimension(2) :: mesh_maxValStateVar = 0_pInt
character(len=64), dimension(:), allocatable :: mesh_nameElemSet character(len=64), dimension(:), allocatable :: mesh_nameElemSet
integer(pInt), dimension(:,:), allocatable :: mesh_mapElemSet integer(pInt), dimension(:,:), allocatable :: mesh_mapElemSet
integer(pInt), dimension(:,:), allocatable, target :: mesh_mapFEtoCPelem,mesh_mapFEtoCPnode integer(pInt), dimension(:,:), allocatable, target :: mesh_mapFEtoCPelem, mesh_mapFEtoCPnode
integer(pInt), dimension(:,:), allocatable :: mesh_element, mesh_sharedElem integer(pInt), dimension(:,:), allocatable :: mesh_element, mesh_sharedElem
integer(pInt), dimension(:,:,:,:), allocatable :: mesh_ipNeighborhood integer(pInt), dimension(:,:,:,:), allocatable :: mesh_ipNeighborhood
real(pReal), dimension(:,:,:), allocatable :: mesh_subNodeCoord ! coordinates of subnodes per element real(pReal), dimension(:,:,:), allocatable :: mesh_subNodeCoord ! coordinates of subnodes per element
real(pReal), dimension(:,:), allocatable :: mesh_ipVolume ! volume associated with IP real(pReal), dimension(:,:), allocatable :: mesh_ipVolume ! volume associated with IP
real(pReal), dimension(:,:,:), allocatable :: mesh_ipArea ! area of interface to neighboring IP real(pReal), dimension(:,:,:), allocatable :: mesh_ipArea, & ! area of interface to neighboring IP
real(pReal), dimension(:,:,:,:), allocatable :: mesh_ipAreaNormal ! area normal of interface to neighboring IP mesh_ipCenterOfGravity ! center of gravity of IP
real(pReal), dimension(:,:,:,:), allocatable :: mesh_ipAreaNormal ! area normal of interface to neighboring IP
real(pReal), allocatable :: mesh_node (:,:) real(pReal), allocatable :: mesh_node (:,:)
integer(pInt), dimension(:,:,:,:), allocatable :: FE_nodesAtIP integer(pInt), dimension(:,:,:,:), allocatable :: FE_nodesAtIP
@ -1577,7 +1578,9 @@ subroutine mesh_get_nodeElemDimensions (unit)
real(pReal), dimension(Ntriangles,FE_NipFaceNodes) :: volume ! volumes of possible tetrahedra real(pReal), dimension(Ntriangles,FE_NipFaceNodes) :: volume ! volumes of possible tetrahedra
real(pReal), dimension(3) :: centerOfGravity real(pReal), dimension(3) :: centerOfGravity
allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) ; mesh_ipVolume = 0.0_pReal allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) ; mesh_ipVolume = 0.0_pReal
allocate(mesh_ipCenterOfGravity(3,mesh_maxNips,mesh_NcpElems)) ; mesh_ipCenterOfGravity = 0.0_pReal
do e = 1,mesh_NcpElems ! loop over cpElems do e = 1,mesh_NcpElems ! loop over cpElems
t = mesh_element(2,e) ! get elemType t = mesh_element(2,e) ! get elemType
do i = 1,FE_Nips(t) ! loop over IPs of elem do i = 1,FE_Nips(t) ! loop over IPs of elem
@ -1613,6 +1616,7 @@ subroutine mesh_get_nodeElemDimensions (unit)
mesh_ipVolume(i,e) = mesh_ipVolume(i,e) + sum(volume) ! add contribution from this interface mesh_ipVolume(i,e) = mesh_ipVolume(i,e) + sum(volume) ! add contribution from this interface
enddo enddo
mesh_ipVolume(i,e) = mesh_ipVolume(i,e) / FE_NipFaceNodes ! renormalize with interfaceNodeNum due to loop over them mesh_ipVolume(i,e) = mesh_ipVolume(i,e) / FE_NipFaceNodes ! renormalize with interfaceNodeNum due to loop over them
mesh_ipCenterOfGravity(:,i,e) = centerOfGravity
enddo enddo
enddo enddo
return return
@ -1645,17 +1649,17 @@ subroutine mesh_get_nodeElemDimensions (unit)
t = mesh_element(2,e) ! get elemType t = mesh_element(2,e) ! get elemType
do i = 1,FE_Nips(t) ! loop over IPs of elem do i = 1,FE_Nips(t) ! loop over IPs of elem
do f = 1,FE_NipNeighbors(t) ! loop over interfaces of IP do f = 1,FE_NipNeighbors(t) ! loop over interfaces of IP
forall (n = 1:FE_NipFaceNodes) nPos(:,n) = mesh_subNodeCoord(:,FE_subNodeOnIPFace(n,f,i,t),e) forall (n = 1:FE_NipFaceNodes) nPos(:,n) = mesh_subNodeCoord(:,FE_subNodeOnIPFace(n,f,i,t),e)
forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles) ! start at each interface node and build valid triangles to cover interface forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles) ! start at each interface node and build valid triangles to cover interface
normal(:,j,n) = math_vectorproduct(nPos(:,1+mod(n+j-1,FE_NipFaceNodes)) - nPos(:,n), & ! calc their normal vectors normal(:,j,n) = math_vectorproduct(nPos(:,1+mod(n+j-1,FE_NipFaceNodes)) - nPos(:,n), & ! calc their normal vectors
nPos(:,1+mod(n+j-0,FE_NipFaceNodes)) - nPos(:,n)) nPos(:,1+mod(n+j-0,FE_NipFaceNodes)) - nPos(:,n))
area(j,n) = dsqrt(sum(normal(:,j,n)*normal(:,j,n))) ! and area area(j,n) = dsqrt(sum(normal(:,j,n)*normal(:,j,n))) ! and area
end forall end forall
forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles, area(j,n) > 0.0_pReal) & forall (n = 1:FE_NipFaceNodes, j = 1:Ntriangles, area(j,n) > 0.0_pReal) &
normal(:,j,n) = normal(:,j,n) / area(j,n) ! make unit normal normal(:,j,n) = normal(:,j,n) / area(j,n) ! make unit normal
mesh_ipArea(f,i,e) = sum(area) / (FE_NipFaceNodes*2.0_pReal) ! area of parallelograms instead of triangles mesh_ipArea(f,i,e) = sum(area) / (FE_NipFaceNodes*2.0_pReal) ! area of parallelograms instead of triangles
mesh_ipAreaNormal(:,f,i,e) = sum(sum(normal,3),2) / count(area > 0.0_pReal) ! average of all valid normals mesh_ipAreaNormal(:,f,i,e) = sum(sum(normal,3),2) / count(area > 0.0_pReal) ! average of all valid normals
enddo enddo
enddo enddo
enddo enddo

16
code/mpie_cpfem_marc.f90
View File

@ -43,13 +43,14 @@
include "mesh.f90" ! uses prec, math, IO, FEsolving include "mesh.f90" ! uses prec, math, IO, FEsolving
include "material.f90" ! uses prec, math, IO, mesh include "material.f90" ! uses prec, math, IO, mesh
include "lattice.f90" ! uses prec, math, IO, material include "lattice.f90" ! uses prec, math, IO, material
include "constitutive_phenopowerlaw.f90" ! uses prec, math, IO, lattice, material, debug include "constitutive_phenopowerlaw.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_j2.f90" ! uses prec, math, IO, lattice, material, debug include "constitutive_j2.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_dislobased.f90" ! uses prec, math, IO, lattice, material, debug include "constitutive_dislobased.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_nonlocal.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive.f90" ! uses prec, IO, math, lattice, mesh, debug include "constitutive.f90" ! uses prec, IO, math, lattice, mesh, debug
include "crystallite.f90" ! uses prec, math, IO, numerics include "crystallite.f90" ! uses prec, math, IO, numerics
include "homogenization_isostrain.f90" ! uses prec, math, IO, include "homogenization_isostrain.f90" ! uses prec, math, IO,
include "homogenization_RGC.f90" ! uses prec, math, IO, numerics, mesh: added <<<updated 31.07.2009>>> include "homogenization_RGC.f90" ! uses prec, math, IO, numerics, mesh: added <<<updated 31.07.2009>>>
include "homogenization.f90" ! uses prec, math, IO, numerics include "homogenization.f90" ! uses prec, math, IO, numerics
include "CPFEM.f90" ! uses prec, math, IO, numerics, debug, FEsolving, mesh, lattice, constitutive, crystallite include "CPFEM.f90" ! uses prec, math, IO, numerics, debug, FEsolving, mesh, lattice, constitutive, crystallite
@ -166,7 +167,10 @@ subroutine hypela2(&
if (inc == 0) then if (inc == 0) then
cycleCounter = 4 cycleCounter = 4
else else
if (theCycle > ncycle .or. theInc /= inc) cycleCounter = 0 ! reset counter for each cutback or new inc if (theCycle > ncycle .or. theInc /= inc) then
cycleCounter = 0 ! reset counter for each cutback or new inc
terminallyIll = .false.
endif
if (theCycle /= ncycle .or. theLovl /= lovl) then if (theCycle /= ncycle .or. theLovl /= lovl) then
cycleCounter = cycleCounter+1 ! ping pong cycleCounter = cycleCounter+1 ! ping pong
outdatedFFN1 = .false. outdatedFFN1 = .false.

3
code/numerics.config
View File

@ -5,7 +5,8 @@ relevantStrain 1.0e-7 # strain increment considered signific
iJacoStiffness 1 # frequency of stiffness update iJacoStiffness 1 # frequency of stiffness update
iJacoLpresiduum 1 # frequency of Jacobian update of residuum in Lp iJacoLpresiduum 1 # frequency of Jacobian update of residuum in Lp
pert_Fg 1.0e-6 # strain perturbation for FEM Jacobi pert_Fg 1.0e-6 # strain perturbation for FEM Jacobi
nHomog 10 # homogenization loop limit nHomog 20 # homogenization loop limit
nMPstate 10 # material point state loop limit
nCryst 20 # crystallite loop limit (only for debugging info, real loop limit is "subStepMin") nCryst 20 # crystallite loop limit (only for debugging info, real loop limit is "subStepMin")
nState 10 # state loop limit nState 10 # state loop limit
nStress 40 # stress loop limit nStress 40 # stress loop limit

12
code/numerics.f90
View File

@ -9,6 +9,7 @@ character(len=64), parameter :: numerics_configFile = 'numerics.config' ! name o
integer(pInt) iJacoStiffness, & ! frequency of stiffness update integer(pInt) iJacoStiffness, & ! frequency of stiffness update
iJacoLpresiduum, & ! frequency of Jacobian update of residuum in Lp iJacoLpresiduum, & ! frequency of Jacobian update of residuum in Lp
nHomog, & ! homogenization loop limit nHomog, & ! homogenization loop limit
nMPstate, & ! materialpoint state loop limit
nCryst, & ! crystallite loop limit (only for debugging info, real loop limit is "subStepMin") nCryst, & ! crystallite loop limit (only for debugging info, real loop limit is "subStepMin")
nState, & ! state loop limit nState, & ! state loop limit
nStress ! stress loop limit nStress ! stress loop limit
@ -69,7 +70,8 @@ subroutine numerics_init()
iJacoStiffness = 1_pInt iJacoStiffness = 1_pInt
iJacoLpresiduum = 1_pInt iJacoLpresiduum = 1_pInt
pert_Fg = 1.0e-6_pReal pert_Fg = 1.0e-6_pReal
nHomog = 10_pInt nHomog = 20_pInt
nMPstate = 10_pInt
nCryst = 20_pInt nCryst = 20_pInt
nState = 10_pInt nState = 10_pInt
nStress = 40_pInt nStress = 40_pInt
@ -111,6 +113,8 @@ subroutine numerics_init()
pert_Fg = IO_floatValue(line,positions,2) pert_Fg = IO_floatValue(line,positions,2)
case ('nhomog') case ('nhomog')
nHomog = IO_intValue(line,positions,2) nHomog = IO_intValue(line,positions,2)
case ('nmpstate')
nMPstate = IO_intValue(line,positions,2)
case ('ncryst') case ('ncryst')
nCryst = IO_intValue(line,positions,2) nCryst = IO_intValue(line,positions,2)
case ('nstate') case ('nstate')
@ -160,6 +164,7 @@ subroutine numerics_init()
write(6,'(a24,x,i8)') 'iJacoLpresiduum: ',iJacoLpresiduum write(6,'(a24,x,i8)') 'iJacoLpresiduum: ',iJacoLpresiduum
write(6,'(a24,x,e8.1)') 'pert_Fg: ',pert_Fg write(6,'(a24,x,e8.1)') 'pert_Fg: ',pert_Fg
write(6,'(a24,x,i8)') 'nHomog: ',nHomog write(6,'(a24,x,i8)') 'nHomog: ',nHomog
write(6,'(a24,x,i8)') 'nMPstate: ',nMPstate
write(6,'(a24,x,i8)') 'nCryst: ',nCryst write(6,'(a24,x,i8)') 'nCryst: ',nCryst
write(6,'(a24,x,i8)') 'nState: ',nState write(6,'(a24,x,i8)') 'nState: ',nState
write(6,'(a24,x,i8)') 'nStress: ',nStress write(6,'(a24,x,i8)') 'nStress: ',nStress
@ -184,12 +189,13 @@ subroutine numerics_init()
if (iJacoLpresiduum < 1_pInt) call IO_error(262) if (iJacoLpresiduum < 1_pInt) call IO_error(262)
if (pert_Fg <= 0.0_pReal) call IO_error(263) if (pert_Fg <= 0.0_pReal) call IO_error(263)
if (nHomog < 1_pInt) call IO_error(264) if (nHomog < 1_pInt) call IO_error(264)
if (nMPstate < 1_pInt) call IO_error(279) !! missing in IO !!
if (nCryst < 1_pInt) call IO_error(265) if (nCryst < 1_pInt) call IO_error(265)
if (nState < 1_pInt) call IO_error(266) if (nState < 1_pInt) call IO_error(266)
if (nStress < 1_pInt) call IO_error(267) if (nStress < 1_pInt) call IO_error(267)
if (subStepMin <= 0.0_pReal) call IO_error(268) if (subStepMin <= 0.0_pReal) call IO_error(268)
if (rTol_crystalliteState <= 0.0_pReal) call IO_error(269) if (rTol_crystalliteState <= 0.0_pReal) call IO_error(269)
if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(276) if (rTol_crystalliteTemperature <= 0.0_pReal) call IO_error(276) !! oops !!
if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(270) if (rTol_crystalliteStress <= 0.0_pReal) call IO_error(270)
if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(271) if (aTol_crystalliteStress <= 0.0_pReal) call IO_error(271)
@ -198,7 +204,7 @@ subroutine numerics_init()
if (relTol_RGC <= 0.0_pReal) call IO_error(273) if (relTol_RGC <= 0.0_pReal) call IO_error(273)
if (absMax_RGC <= 0.0_pReal) call IO_error(274) if (absMax_RGC <= 0.0_pReal) call IO_error(274)
if (relMax_RGC <= 0.0_pReal) call IO_error(275) if (relMax_RGC <= 0.0_pReal) call IO_error(275)
if (pPert_RGC <= 0.0_pReal) call IO_error(276) if (pPert_RGC <= 0.0_pReal) call IO_error(276) !! oops !!
if (xSmoo_RGC <= 0.0_pReal) call IO_error(277) if (xSmoo_RGC <= 0.0_pReal) call IO_error(277)
endsubroutine endsubroutine