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

cleaning

This commit is contained in:
Martin Diehl 2018-09-12 15:27:47 +02:00
parent d7023096ad
commit b753a86d13
1 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/plastic_dislotwin.f90
View File

@ -201,6 +201,7 @@ subroutine plastic_dislotwin_init(fileUnit)
debug_constitutive,& debug_constitutive,&
debug_levelBasic debug_levelBasic
use math, only: & use math, only: &
math_rotate_forward3333, &
math_Mandel3333to66, & math_Mandel3333to66, &
math_Voigt66to3333, & math_Voigt66to3333, &
math_mul3x3, & math_mul3x3, &
@ -240,9 +241,8 @@ subroutine plastic_dislotwin_init(fileUnit)
integer(pInt) :: NofMyPhase integer(pInt) :: NofMyPhase
integer(kind(undefined_ID)) outputID integer(kind(undefined_ID)) outputID
real(pReal), dimension(:,:,:,:,:), allocatable :: & real(pReal), dimension(3,3,3,3) :: &
Ctwin3333, & !< twin elasticity matrix temp3333
Ctrans3333 !< trans elasticity matrix
real(pReal), allocatable, dimension(:) :: & real(pReal), allocatable, dimension(:) :: &
invLambdaSlip0,& invLambdaSlip0,&
@ -673,8 +673,6 @@ subroutine plastic_dislotwin_init(fileUnit)
allocate(temp1(prm%totalNtwin,prm%totalNslip), source =0.0_pReal) allocate(temp1(prm%totalNtwin,prm%totalNslip), source =0.0_pReal)
allocate(temp2(prm%totalNtwin,prm%totalNtwin), source =0.0_pReal) allocate(temp2(prm%totalNtwin,prm%totalNtwin), source =0.0_pReal)
allocate(prm%C66_twin(6,6,prm%totalNtwin), source=0.0_pReal) allocate(prm%C66_twin(6,6,prm%totalNtwin), source=0.0_pReal)
if (allocated(Ctwin3333)) deallocate(Ctwin3333)
allocate(Ctwin3333(3,3,3,3,prm%totalNtwin), source=0.0_pReal)
allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal) allocate(prm%Schmid_twin(3,3,prm%totalNtwin),source = 0.0_pReal)
if (lattice_structure(p) == LATTICE_fcc_ID) & if (lattice_structure(p) == LATTICE_fcc_ID) &
allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0_pInt) allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0_pInt)
@ -689,20 +687,21 @@ subroutine plastic_dislotwin_init(fileUnit)
if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = & if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = &
lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j) lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j)
!* Rotate twin elasticity matrices !* Rotate twin elasticity matrices
temp3333 = 0.0_pReal
index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list
do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt
do p1 = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt do p1 = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt
Ctwin3333(l,m,n,o,index_myFamily+j) = & temp3333(l,m,n,o) = &
Ctwin3333(l,m,n,o,index_myFamily+j) + & temp3333(l,m,n,o) + &
lattice_C3333(p1,q,r,s,p) * &
lattice_Qtwin(l,p1,index_otherFamily+j,p) * & lattice_Qtwin(l,p1,index_otherFamily+j,p) * &
lattice_Qtwin(m,q,index_otherFamily+j,p) * & lattice_Qtwin(m,q,index_otherFamily+j,p) * &
lattice_Qtwin(n,r,index_otherFamily+j,p) * & lattice_Qtwin(n,r,index_otherFamily+j,p) * &
lattice_Qtwin(o,s,index_otherFamily+j,p) lattice_Qtwin(o,s,index_otherFamily+j,p) * lattice_C3333(p1,q,r,s,p)
enddo; enddo; enddo; enddo enddo; enddo; enddo; enddo
enddo; enddo; enddo; enddo enddo; enddo; enddo; enddo
prm%C66_twin(1:6,1:6,index_myFamily+j) = & prm%C66_twin(1:6,1:6,index_myFamily+j) = math_Mandel3333to66(temp3333)
math_Mandel3333to66(Ctwin3333(1:3,1:3,1:3,1:3,index_myFamily+j)) if (any(dNeq0(temp3333-math_rotate_forward3333(lattice_trans_C3333(1:3,1:3,1:3,1:3,p),&
lattice_Qtwin(1:3,1:3,index_otherFamily+j,p))))) print*, 'mist'
!* Interaction matrices !* Interaction matrices
do o = 1_pInt,size(prm%Nslip,1) do o = 1_pInt,size(prm%Nslip,1)
@ -733,31 +732,29 @@ subroutine plastic_dislotwin_init(fileUnit)
allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal)
allocate(temp2(prm%totalNtrans,prm%totalNtrans), source =0.0_pReal) allocate(temp2(prm%totalNtrans,prm%totalNtrans), source =0.0_pReal)
allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal)
if (allocated(Ctrans3333)) deallocate(Ctrans3333)
allocate(Ctrans3333(3,3,3,3,prm%totalNtrans), source=0.0_pReal)
allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal)
i = 0_pInt i = 0_pInt
transFamiliesLoop: do f = 1_pInt,size(prm%Ntrans,1) transFamiliesLoop: do f = 1_pInt,size(prm%Ntrans,1)
index_myFamily = sum(prm%Ntrans(1:f-1_pInt)) ! index in truncated trans system list index_myFamily = sum(prm%Ntrans(1:f-1_pInt)) ! index in truncated trans system list
transSystemsLoop: do j = 1_pInt,prm%Ntrans(f) transSystemsLoop: do j = 1_pInt,prm%Ntrans(f)
i = i + 1_pInt i = i + 1_pInt
prm%Schmid_trans(1:3,1:3,i) = lattice_Strans(1:3,1:3,sum(lattice_Ntranssystem(1:f-1,p))+j,p) prm%Schmid_trans(1:3,1:3,i) = lattice_Strans(1:3,1:3,sum(lattice_Ntranssystem(1:f-1,p))+j,p)
index_otherFamily = sum(lattice_NtransSystem(1:f-1_pInt,p)) ! index in full lattice trans list index_otherFamily = sum(lattice_NtransSystem(1:f-1_pInt,p)) ! index in full lattice trans list
temp3333 = 0.0_pReal
do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt do l = 1_pInt,3_pInt; do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt
do p1 = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt do p1 = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt
Ctrans3333(l,m,n,o,index_myFamily+j) = & temp3333(l,m,n,o) = &
Ctrans3333(l,m,n,o,index_myFamily+j) + & temp3333(l,m,n,o) + &
lattice_trans_C3333(p1,q,r,s,p) * &
lattice_Qtrans(l,p1,index_otherFamily+j,p) * & lattice_Qtrans(l,p1,index_otherFamily+j,p) * &
lattice_Qtrans(m,q,index_otherFamily+j,p) * & lattice_Qtrans(m,q,index_otherFamily+j,p) * &
lattice_Qtrans(n,r,index_otherFamily+j,p) * & lattice_Qtrans(n,r,index_otherFamily+j,p) * &
lattice_Qtrans(o,s,index_otherFamily+j,p) lattice_Qtrans(o,s,index_otherFamily+j,p)* lattice_trans_C3333(p1,q,r,s,p)
enddo; enddo; enddo; enddo enddo; enddo; enddo; enddo
enddo; enddo; enddo; enddo enddo; enddo; enddo; enddo
prm%C66_trans(1:6,1:6,index_myFamily+j) = & prm%C66_trans(1:6,1:6,index_myFamily+j) = math_Mandel3333to66(temp3333)
math_Mandel3333to66(Ctrans3333(1:3,1:3,1:3,1:3,index_myFamily+j)) if (any(dNeq0(temp3333-math_rotate_forward3333(lattice_trans_C3333(1:3,1:3,1:3,1:3,p),&
lattice_Qtrans(1:3,1:3,index_otherFamily+j,p))))) print*, 'mist'
!* Interaction matrices !* Interaction matrices
do o = 1_pInt,size(prm%Nslip,1) do o = 1_pInt,size(prm%Nslip,1)
index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) index_otherFamily = sum(prm%Nslip(1:o-1_pInt))