diff --git a/trunk/CPFEM.f90 b/trunk/CPFEM.f90 index 512ef5673..ed7765b01 100644 --- a/trunk/CPFEM.f90 +++ b/trunk/CPFEM.f90 @@ -485,17 +485,24 @@ use prec, only: pReal,pInt,reltol_Outer use constitutive, only: constitutive_dotState,constitutive_sizeDotState,& constitutive_state_old,constitutive_state_new + use debug logical integrateState + integer(pInt) tick,tock,tickrate,maxticks integer(pInt) g,i,e,mySize real(pReal), dimension(6) :: Tstar_v real(pReal) dt real(pReal), dimension(constitutive_sizeDotState(g,i,e)) :: residuum mySize = constitutive_sizeDotState(g,i,e) + call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) residuum = constitutive_state_new(g,i,e)%p(1:mySize) - constitutive_state_old(g,i,e)%p(1:mySize) - & dt*constitutive_dotState(Tstar_v,CPFEM_Temperature(i,e),g,i,e) ! residuum from evolution of microstructure + call system_clock(count=tock,count_rate=tickrate,count_max=maxticks) + debug_cumDotStateCalls = debug_cumDotStateCalls + 1_pInt + debug_cumDotStateTicks = debug_cumDotStateTicks + tock-tick + if (tock < tick) debug_cumDotStateTicks = debug_cumDotStateTicks + maxticks constitutive_state_new(g,i,e)%p(1:mySize) = constitutive_state_new(g,i,e)%p(1:mySize) - residuum ! update of microstructure integrateState = maxval(abs(residuum/constitutive_state_new(g,i,e)%p(1:mySize)),& constitutive_state_new(g,i,e)%p(1:mySize) /= 0.0_pReal) < reltol_Outer @@ -652,7 +659,7 @@ logical failed integer(pInt) cp_en, ip, grain integer(pInt) iInner,dummy, i,j,k,l,m,n - integer(8) tick,tock,tickrate,maxticks + integer(pInt) tick,tock,tickrate,maxticks real(pReal) dt, Temperature, det, p_hydro, leapfrog,maxleap real(pReal), dimension(6) :: Tstar_v real(pReal), dimension(9,9) :: dLp,dTdLp,dRdLp,invdRdLp,eye2 @@ -722,7 +729,7 @@ Inner: do ! inner iteration: Lp ! check for acceleration/deceleration in Newton--Raphson correction ! if (any(Rinner/=Rinner) .and. & ! NaN occured at regular speed - leapfrog == 1.0) then + leapfrog == 1.0) then Lpguess = Lpguess_old ! restore known good guess msg = 'NaN present' ! croak for cutback return diff --git a/trunk/IO.f90 b/trunk/IO.f90 index 438b00103..c84f5a984 100644 --- a/trunk/IO.f90 +++ b/trunk/IO.f90 @@ -40,7 +40,6 @@ character(256) path inquire(6, name=path) ! determine outputfile - write(6,*)'trying to open mattex at',path(1:scan(path,pathSep,back=.true.))//relPath open(unit,status='old',err=100,file=path(1:scan(path,pathSep,back=.true.))//relPath) IO_open_file = .true. return diff --git a/trunk/constitutive_dislobased.f90 b/trunk/constitutive_dislobased.f90 index a24e540c0..e9d2f9517 100644 --- a/trunk/constitutive_dislobased.f90 +++ b/trunk/constitutive_dislobased.f90 @@ -45,6 +45,7 @@ MODULE constitutive_dislobased constitutive_dislobased_sizeState, & constitutive_dislobased_sizePostResults character(len=64), dimension(:,:), allocatable :: constitutive_dislobased_output + character(len=32), dimension(:), allocatable :: constitutive_dislobased_structureName integer(pInt), dimension(:), allocatable :: constitutive_dislobased_structure integer(pInt), dimension(:), allocatable :: constitutive_dislobased_Nslip real(pReal), dimension(:), allocatable :: constitutive_dislobased_C11 @@ -68,6 +69,7 @@ MODULE constitutive_dislobased real(pReal), dimension(:), allocatable :: constitutive_dislobased_c6 real(pReal), dimension(:), allocatable :: constitutive_dislobased_c7 real(pReal), dimension(:), allocatable :: constitutive_dislobased_c8 + real(pReal), dimension(:), allocatable :: constitutive_dislobased_CoverA real(pReal), dimension(:,:), allocatable :: constitutive_dislobased_SlipIntCoeff real(pReal), dimension(:,:,:), allocatable :: constitutive_dislobased_Iparallel real(pReal), dimension(:,:,:), allocatable :: constitutive_dislobased_Iforest @@ -102,7 +104,7 @@ subroutine constitutive_dislobased_init(file) use math, only: math_Mandel3333to66, math_Voigt66to3333, math_mul3x3 use IO use material - use lattice, only: lattice_sn, lattice_st, lattice_SlipIntType + use lattice, only: lattice_sn, lattice_st, lattice_interactionSlipSlip, lattice_initializeStructure integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 7 integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -120,6 +122,7 @@ subroutine constitutive_dislobased_init(file) allocate(constitutive_dislobased_sizePostResults(maxNinstance)); constitutive_dislobased_sizePostResults = 0_pInt allocate(constitutive_dislobased_output(maxval(phase_Noutput), & maxNinstance)) ; constitutive_dislobased_output = '' + allocate(constitutive_dislobased_structureName(maxNinstance)) ; constitutive_dislobased_structureName = '' allocate(constitutive_dislobased_structure(maxNinstance)) ; constitutive_dislobased_structure = 0_pInt allocate(constitutive_dislobased_Nslip(maxNinstance)) ; constitutive_dislobased_Nslip = 0_pInt allocate(constitutive_dislobased_C11(maxNinstance)) ; constitutive_dislobased_C11 = 0.0_pReal @@ -142,6 +145,7 @@ subroutine constitutive_dislobased_init(file) allocate(constitutive_dislobased_c6(maxNinstance)) ; constitutive_dislobased_c6 = 0.0_pReal allocate(constitutive_dislobased_c7(maxNinstance)) ; constitutive_dislobased_c7 = 0.0_pReal allocate(constitutive_dislobased_c8(maxNinstance)) ; constitutive_dislobased_c8 = 0.0_pReal + allocate(constitutive_dislobased_CoverA(maxNinstance)) ; constitutive_dislobased_CoverA = 0.0_pReal allocate(constitutive_dislobased_SlipIntCoeff(6,maxNinstance)) ; constitutive_dislobased_SlipIntCoeff = 0.0_pReal rewind(file) @@ -169,7 +173,9 @@ subroutine constitutive_dislobased_init(file) output = output + 1 constitutive_dislobased_output(output,i) = IO_lc(IO_stringValue(line,positions,2)) case ('lattice_structure') - constitutive_dislobased_structure(i) = IO_intValue(line,positions,2) + constitutive_dislobased_structureName(i) = IO_lc(IO_stringValue(line,positions,2)) + case ('covera_ratio') + constitutive_dislobased_CoverA(i) = IO_floatValue(line,positions,2) case ('nslip') constitutive_dislobased_Nslip(i) = IO_intValue(line,positions,2) case ('c11') @@ -208,17 +214,19 @@ subroutine constitutive_dislobased_init(file) constitutive_dislobased_c7(i) = IO_floatValue(line,positions,2) case ('c8') constitutive_dislobased_c8(i) = IO_floatValue(line,positions,2) - case ('interaction_coefficients') - forall (j=2:min(7,positions(1))) & - constitutive_dislobased_SlipIntCoeff(j-1,i) = IO_floatValue(line,positions,j) + case ('interaction_coefficients') + forall (j=2:min(7,positions(1))) & + constitutive_dislobased_SlipIntCoeff(j-1,i) = IO_floatValue(line,positions,j) end select endif enddo -100 do i = 1,maxNinstance ! sanity checks - if (constitutive_dislobased_structure(i) < 1 .or. & - constitutive_dislobased_structure(i) > 3) call IO_error(201) +100 do i = 1,maxNinstance + constitutive_dislobased_structure(i) = lattice_initializeStructure(constitutive_dislobased_structureName(i), & + constitutive_dislobased_CoverA(i)) +! sanity checks + if (constitutive_dislobased_structure(i) < 1) call IO_error(201) if (constitutive_dislobased_Nslip(i) < 1) call IO_error(202) if (constitutive_dislobased_rho0(i) < 0.0_pReal) call IO_error(220) if (constitutive_dislobased_bg(i) <= 0.0_pReal) call IO_error(221) @@ -259,7 +267,7 @@ subroutine constitutive_dislobased_init(file) constitutive_dislobased_Cslip_66(k,k,i) = constitutive_dislobased_C11(i) constitutive_dislobased_Cslip_66(k+3,k+3,i) = constitutive_dislobased_C44(i) end forall - case(3) ! hcp + case(3:) ! all hex constitutive_dislobased_Cslip_66(1,1,i) = constitutive_dislobased_C11(i) constitutive_dislobased_Cslip_66(2,2,i) = constitutive_dislobased_C11(i) constitutive_dislobased_Cslip_66(3,3,i) = constitutive_dislobased_C33(i) @@ -286,14 +294,11 @@ subroutine constitutive_dislobased_init(file) x = math_mul3x3(lattice_sn(:,j,i),lattice_st(:,k,i)) y = 1.0_pReal-x**(2.0_pReal) !* Interaction matrix * - constitutive_dislobased_Iforest(j,k,i)=abs(x)*& - constitutive_dislobased_SlipIntCoeff(lattice_SlipIntType(j,k,constitutive_dislobased_structure(i)),i) - if (y>0.0_pReal) then - constitutive_dislobased_Iparallel(j,k,i)=sqrt(y)*& - constitutive_dislobased_SlipIntCoeff(lattice_SlipIntType(j,k,constitutive_dislobased_structure(i)),i) - else - constitutive_dislobased_Iparallel(j,k,i)=0.0_pReal - endif + constitutive_dislobased_Iforest(j,k,i) = abs(x)*& + constitutive_dislobased_SlipIntCoeff(lattice_interactionSlipSlip(j,k,constitutive_dislobased_structure(i)),i) + if (y>0.0_pReal) & + constitutive_dislobased_Iparallel(j,k,i) = sqrt(y)*& + constitutive_dislobased_SlipIntCoeff(lattice_interactionSlipSlip(j,k,constitutive_dislobased_structure(i)),i) enddo enddo @@ -303,7 +308,7 @@ subroutine constitutive_dislobased_init(file) end subroutine - + function constitutive_dislobased_stateInit(ipc,ip,el) !********************************************************************* !* initial microstructural state * @@ -407,7 +412,7 @@ subroutine constitutive_dislobased_microstructure(Temperature,state,ipc,ip,el) state(ipc,ip,el)%p(7*n+i) = & state(ipc,ip,el)%p(6*n+i)*constitutive_dislobased_bg(matID)*attack_frequency*state(ipc,ip,el)%p(4*n+i)*& exp(-constitutive_dislobased_Qedge(matID)/(kB*Temperature)) - + enddo end subroutine @@ -450,20 +455,24 @@ subroutine constitutive_dislobased_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Tempera !* Calculation of Lp Lp = 0.0_pReal + gdot_slip = 0.0_pReal do i = 1,constitutive_dislobased_Nslip(matID) tau_slip(i) = math_mul6x6(Tstar_v,lattice_Sslip_v(:,i,constitutive_dislobased_structure(matID))) - gdot_slip(i) = state(ipc,ip,el)%p(7*n+i)*sign(1.0_pReal,tau_slip(i))*& - sinh(((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + if ((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))>0) & + gdot_slip(i) = state(ipc,ip,el)%p(7*n+i)*sign(1.0_pReal,tau_slip(i))*& + sinh(((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + Lp = Lp + gdot_slip(i)*lattice_Sslip(:,:,i,constitutive_dislobased_structure(matID)) enddo - !* Calculation of the tangent of Lp dLp_dTstar3333 = 0.0_pReal dLp_dTstar = 0.0_pReal + dgdot_dtauslip = 0.0_pReal do i = 1,constitutive_dislobased_Nslip(matID) - dgdot_dtauslip(i) = (state(ipc,ip,el)%p(7*n+i)*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)*& - cosh(((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + if ((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))>0) & + dgdot_dtauslip(i) = (state(ipc,ip,el)%p(7*n+i)*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)*& + cosh(((abs(tau_slip(i))-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) forall (k=1:3,l=1:3,m=1:3,n=1:3) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip(i)*lattice_Sslip(k,l,i,constitutive_dislobased_structure(matID))* & @@ -511,13 +520,17 @@ function constitutive_dislobased_dotState(Tstar_v,Temperature,state,ipc,ip,el) if (abs(tau_slip) > state(ipc,ip,el)%p(3*n+i)) then gdot_slip = state(ipc,ip,el)%p(7*n+i)*sign(1.0_pReal,tau_slip)*& sinh(((abs(tau_slip)-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + locks = (sqrt(state(ipc,ip,el)%p(n+i))*abs(gdot_slip))/& - (constitutive_dislobased_c4(matID)*constitutive_dislobased_bg(matID)) + (constitutive_dislobased_c4(matID)*constitutive_dislobased_bg(matID)) + athermal_recovery = constitutive_dislobased_c7(matID)*state(ipc,ip,el)%p(i)*abs(gdot_slip) - thermal_recovery = constitutive_dislobased_c8(matID)*abs(tau_slip)*state(ipc,ip,el)%p(i)**(2.0_pReal)*& - ((constitutive_dislobased_D0(matID)*constitutive_dislobased_bg(matID)**(3.0_pReal))/& - (kB*Temperature))*exp(-constitutive_dislobased_Qsd(matID)/(kB*Temperature)) - constitutive_dislobased_dotState(i) = locks - athermal_recovery !-thermal_recovery + + !thermal_recovery = constitutive_dislobased_c8(matID)*abs(tau_slip)*state(ipc,ip,el)%p(i)**(2.0_pReal)*& + ! ((constitutive_dislobased_D0(matID)*constitutive_dislobased_bg(matID)**(3.0_pReal))/& + ! (kB*Temperature))*exp(-constitutive_dislobased_Qsd(matID)/(kB*Temperature)) + + constitutive_dislobased_dotState(i) = locks - athermal_recovery endif enddo @@ -564,8 +577,12 @@ pure function constitutive_dislobased_postResults(Tstar_v,Temperature,dt,state,i case ('rateofshear') do i = 1,n tau_slip = math_mul6x6(Tstar_v,lattice_Sslip_v(:,i,constitutive_dislobased_structure(matID))) - constitutive_dislobased_postResults(c+i) = state(ipc,ip,el)%p(7*n+i)*sign(1.0_pReal,tau_slip)*& - sinh(((abs(tau_slip)-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + if ((abs(tau_slip)-state(ipc,ip,el)%p(3*n+i))>0) then + constitutive_dislobased_postResults(c+i) = state(ipc,ip,el)%p(7*n+i)*sign(1.0_pReal,tau_slip)*& + sinh(((abs(tau_slip)-state(ipc,ip,el)%p(3*n+i))*state(ipc,ip,el)%p(5*n+i))/(kB*Temperature)) + else + constitutive_dislobased_postResults(c+i) = 0.0_pReal + endif enddo c = c + n end select diff --git a/trunk/constitutive_j2.f90 b/trunk/constitutive_j2.f90 index cd4ef02a5..88bfa83f3 100644 --- a/trunk/constitutive_j2.f90 +++ b/trunk/constitutive_j2.f90 @@ -298,18 +298,18 @@ subroutine constitutive_j2_LpAndItsTangent(Lp,dLp_dTstar,Tstar_v,Temperature,sta if (norm_Tstar > 0) then !* Calculation of Lp Lp = Tstar33/norm_Tstar*constitutive_j2_gdot0(matID)/constitutive_j2_fTaylor(matID)* & - (dsqrt(1.5_pReal)/constitutive_j2_fTaylor(matID)*norm_Tstar/state(ipc,ip,el)%p(1))**constitutive_j2_n(matID) + (dsqrt(1.5_pReal)/constitutive_j2_fTaylor(matID)*norm_Tstar/state(ipc,ip,el)%p(1))**constitutive_j2_n(matID) !* Calculation of the tangent of Lp factor = constitutive_j2_gdot0(matID)/constitutive_j2_fTaylor(matID)* & - (dsqrt(1.5_pReal)/ constitutive_j2_fTaylor(matID)/state(ipc,ip,el)%p(1))**constitutive_j2_n(matID) * & - norm_Tstar**(constitutive_j2_n(matID)-1.0_pReal) + (dsqrt(1.5_pReal)/ constitutive_j2_fTaylor(matID)/state(ipc,ip,el)%p(1))**constitutive_j2_n(matID) * & + norm_Tstar**(constitutive_j2_n(matID)-1.0_pReal) dLp_dTstar3333 = 0.0_pReal forall (k=1:3,l=1:3,m=1:3,n=1:3) & - dLp_dTstar3333(k,l,m,n) = Tstar33(k,l)*Tstar33(m,n) * (constitutive_j2_n(matID)-1.0_pReal)/squarenorm_Tstar + dLp_dTstar3333(k,l,m,n) = Tstar33(k,l)*Tstar33(m,n) * (constitutive_j2_n(matID)-1.0_pReal)/squarenorm_Tstar forall (k=1:3,l=1:3) & - dLp_dTstar3333(k,l,k,l) = dLp_dTstar3333(k,l,k,l) + 1.0_pReal - dLp_dTstar = math_Plain3333to99(factor * dLp_dTstar3333) + dLp_dTstar3333(k,l,k,l) = dLp_dTstar3333(k,l,k,l) + 1.0_pReal + dLp_dTstar = math_Plain3333to99(factor * dLp_dTstar3333) end if return diff --git a/trunk/constitutive_phenomenological.f90 b/trunk/constitutive_phenomenological.f90 index ec97f5f0e..808a98aba 100644 --- a/trunk/constitutive_phenomenological.f90 +++ b/trunk/constitutive_phenomenological.f90 @@ -37,9 +37,11 @@ MODULE constitutive_phenomenological integer(pInt), dimension(:), allocatable :: constitutive_phenomenological_sizeDotState, & constitutive_phenomenological_sizeState, & constitutive_phenomenological_sizePostResults - character(len=64), dimension(:,:), allocatable :: constitutive_phenomenological_output + character(len=64), dimension(:,:), allocatable :: constitutive_phenomenological_output + character(len=32), dimension(:), allocatable :: constitutive_phenomenological_structureName integer(pInt), dimension(:), allocatable :: constitutive_phenomenological_structure - integer(pInt), dimension(:), allocatable :: constitutive_phenomenological_Nslip + integer(pInt), dimension(:), allocatable :: constitutive_phenomenological_Nslip + real(pReal), dimension(:), allocatable :: constitutive_phenomenological_CoverA real(pReal), dimension(:), allocatable :: constitutive_phenomenological_C11 real(pReal), dimension(:), allocatable :: constitutive_phenomenological_C12 real(pReal), dimension(:), allocatable :: constitutive_phenomenological_C13 @@ -77,7 +79,8 @@ subroutine constitutive_phenomenological_init(file) use prec, only: pInt, pReal use math, only: math_Mandel3333to66, math_Voigt66to3333 use IO - use material + use material + use lattice, only: lattice_initializeStructure integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 7 integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -92,9 +95,11 @@ subroutine constitutive_phenomenological_init(file) allocate(constitutive_phenomenological_sizeState(maxNinstance)) ; constitutive_phenomenological_sizeState = 0_pInt allocate(constitutive_phenomenological_sizePostResults(maxNinstance)); constitutive_phenomenological_sizePostResults = 0_pInt allocate(constitutive_phenomenological_output(maxval(phase_Noutput), & - maxNinstance)) ; constitutive_phenomenological_output = '' + maxNinstance)) ; constitutive_phenomenological_output = '' + allocate(constitutive_phenomenological_structureName(maxNinstance)) ; constitutive_phenomenological_structureName = '' allocate(constitutive_phenomenological_structure(maxNinstance)) ; constitutive_phenomenological_structure = 0_pInt - allocate(constitutive_phenomenological_Nslip(maxNinstance)) ; constitutive_phenomenological_Nslip = 0_pInt + allocate(constitutive_phenomenological_Nslip(maxNinstance)) ; constitutive_phenomenological_Nslip = 0_pInt + allocate(constitutive_phenomenological_CoverA(maxNinstance)) ; constitutive_phenomenological_CoverA = 0.0_pReal allocate(constitutive_phenomenological_C11(maxNinstance)) ; constitutive_phenomenological_C11 = 0.0_pReal allocate(constitutive_phenomenological_C12(maxNinstance)) ; constitutive_phenomenological_C12 = 0.0_pReal allocate(constitutive_phenomenological_C13(maxNinstance)) ; constitutive_phenomenological_C13 = 0.0_pReal @@ -133,10 +138,12 @@ subroutine constitutive_phenomenological_init(file) case ('(output)') output = output + 1 constitutive_phenomenological_output(output,i) = IO_lc(IO_stringValue(line,positions,2)) - case ('lattice_structure') - constitutive_phenomenological_structure(i) = IO_intValue(line,positions,2) + case ('lattice_structure') + constitutive_phenomenological_structureName(i) = IO_lc(IO_stringValue(line,positions,2)) case ('nslip') - constitutive_phenomenological_Nslip(i) = IO_intValue(line,positions,2) + constitutive_phenomenological_Nslip(i) = IO_intValue(line,positions,2) + case ('covera_ratio') + constitutive_phenomenological_CoverA(i) = IO_floatValue(line,positions,2) case ('c11') constitutive_phenomenological_C11(i) = IO_floatValue(line,positions,2) case ('c12') @@ -165,7 +172,9 @@ subroutine constitutive_phenomenological_init(file) endif enddo -100 do i = 1,maxNinstance ! sanity checks +100 do i = 1,maxNinstance + constitutive_phenomenological_structure(i) = lattice_initializeStructure(constitutive_phenomenological_structureName(i), & + constitutive_phenomenological_CoverA(i)) ! sanity checks if (constitutive_phenomenological_structure(i) < 1 .or. & constitutive_phenomenological_structure(i) > 3) call IO_error(201) if (constitutive_phenomenological_Nslip(i) < 1) call IO_error(202) diff --git a/trunk/debug.f90 b/trunk/debug.f90 index 7f3db4db7..52db5d54e 100644 --- a/trunk/debug.f90 +++ b/trunk/debug.f90 @@ -9,8 +9,10 @@ integer(pInt), dimension(nCutback+1) :: debug_cutbackDistribution = 0_pInt integer(pInt), dimension(nInner) :: debug_InnerLoopDistribution = 0_pInt integer(pInt), dimension(nOuter) :: debug_OuterLoopDistribution = 0_pInt - integer(8) :: debug_cumLpTicks = 0_pInt + integer(pInt) :: debug_cumLpTicks = 0_pInt + integer(pInt) :: debug_cumDotStateTicks = 0_pInt integer(pInt) :: debug_cumLpCalls = 0_pInt + integer(pInt) :: debug_cumDotStateCalls = 0_pInt logical :: debugger = .false. logical :: distribution_init = .false. @@ -26,18 +28,26 @@ implicit none integer(pInt) i,integral - integer(8) tickrate + integer(pInt) tickrate write(6,*) write(6,*) 'DEBUG Info' write(6,*) - write(6,'(a33,x,i9)') 'total calls to LpAndItsTangent :',debug_cumLpCalls + write(6,'(a33,x,i12)') 'total calls to LpAndItsTangent :',debug_cumLpCalls if (debug_cumLpCalls > 0_pInt) then call system_clock(count_rate=tickrate) - write(6,'(a33,x,f10.6)') 'avg CPU time/microsecs per call :',dble(debug_cumLpTicks)/tickrate/1.0e-6_pReal/debug_cumLpCalls + write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',dble(debug_cumLpTicks)/tickrate/1.0e-6_pReal/debug_cumLpCalls write(6,'(a33,x,i12)') 'total CPU ticks :',debug_cumLpTicks endif write(6,*) + write(6,'(a33,x,i12)') 'total calls to dotState :',debug_cumDotStateCalls + if (debug_cumdotStateCalls > 0_pInt) then + call system_clock(count_rate=tickrate) + write(6,'(a33,x,f12.6)') 'avg CPU time/microsecs per call :',& + dble(debug_cumDotStateTicks)/tickrate/1.0e-6_pReal/debug_cumDotStateCalls + write(6,'(a33,x,i12)') 'total CPU ticks :',debug_cumDotStateTicks + endif + write(6,*) write(6,*) 'distribution_cutback :' do i=0,nCutback if (debug_cutbackDistribution(i+1) /= 0) write(6,*) i,debug_cutbackDistribution(i+1) diff --git a/trunk/lattice.f90 b/trunk/lattice.f90 index 399fa0728..554069bfa 100644 --- a/trunk/lattice.f90 +++ b/trunk/lattice.f90 @@ -17,463 +17,518 @@ implicit none !************************************ !* Lattice structures * !************************************ -!* Number of lattice structures (1-FCC,2-BCC,3-HCP) -integer(pInt), parameter :: lattice_MaxLatticeStructure = 3 -!* Total number of slip systems per lattice structure -!* (has to be changed according the definition of slip systems) -integer(pInt), dimension(lattice_MaxLatticeStructure), parameter :: lattice_MaxNslipOfStructure = & -reshape((/12,48,24/),(/lattice_MaxLatticeStructure/)) -!* Total number of twin systems per lattice structure -!* (has to be changed according the definition of twin systems) -integer(pInt), dimension(lattice_MaxLatticeStructure), parameter :: lattice_MaxNtwinOfStructure = & -reshape((/12,0,24/),(/lattice_MaxLatticeStructure/)) -!* Maximum number of slip systems over lattice structures -integer(pInt), parameter :: lattice_MaxMaxNslipOfStructure = 48 -!* Maximum number of twin systems over lattice structures, changed form 12 to 24 (yj.ro) -integer(pInt), parameter :: lattice_MaxMaxNtwinOfStructure = 24 -!* Slip direction, slip normales and Schmid matrices -real(pReal), dimension(3,3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: lattice_Sslip -real(pReal), dimension(6,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: lattice_Sslip_v -real(pReal), dimension(3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: lattice_sn -real(pReal), dimension(3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: lattice_sd -real(pReal), dimension(3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: lattice_st -!* HCP - slip direction, slip normal (4 indices): Prof. Tom Bieler, Leeyun, YJRO -real(pReal), dimension(4,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: Hlattice_sn -real(pReal), dimension(4,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: Hlattice_sd -real(pReal), dimension(3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: H_lattice_sn -real(pReal), dimension(3,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: H_lattice_sd +integer(pInt) lattice_Nhexagonal, & ! # of hexagonal lattice structure (from tag CoverA_ratio) + lattice_Nstructure ! # of lattice structures (1: fcc,2: bcc,3+: hexagonal) +integer(pInt), parameter :: lattice_maxNslip = 48 ! max # of slip systems over lattice structures +integer(pInt), parameter :: lattice_maxNtwin = 24 ! max # of twin systems over lattice structures -!* twin direction, twin normales, Schmid matrices and transformation matrices -real(pReal), dimension(3,3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_Stwin -real(pReal), dimension(6,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_Stwin_v -real(pReal), dimension(3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_tn -real(pReal), dimension(3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_td -real(pReal), dimension(3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_tt -real(pReal), dimension(3,3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: lattice_Qtwin +integer(pInt), pointer, dimension(:,:) :: interactionSlipSlip, & + interactionSlipTwin, & + interactionTwinTwin -!* HCP - twin direction, twin normales for 4 indices: Prof. Tom Bieler, Leeyun, YJR -real(pReal), dimension(4,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: Hlattice_tn -real(pReal), dimension(4,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: Hlattice_td -real(pReal), dimension(3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: H_lattice_tn -real(pReal), dimension(3,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: H_lattice_td +! Schmid matrices, normal, shear direction and nxd of slip systems +real(pReal), allocatable, dimension(:,:,:,:) :: lattice_Sslip +real(pReal), allocatable, dimension(:,:,:) :: lattice_Sslip_v +real(pReal), allocatable, dimension(:,:,:) :: lattice_sn +real(pReal), allocatable, dimension(:,:,:) :: lattice_sd +real(pReal), allocatable, dimension(:,:,:) :: lattice_st + +! Rotation and Schmid matrices, normal, shear direction and nxd of twin systems +real(pReal), allocatable, dimension(:,:,:,:) :: lattice_Qtwin +real(pReal), allocatable, dimension(:,:,:,:) :: lattice_Stwin +real(pReal), allocatable, dimension(:,:,:) :: lattice_Stwin_v +real(pReal), allocatable, dimension(:,:,:) :: lattice_tn +real(pReal), allocatable, dimension(:,:,:) :: lattice_td +real(pReal), allocatable, dimension(:,:,:) :: lattice_tt +real(pReal), allocatable, dimension(:,:) :: lattice_shearTwin + +integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip +integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipTwin +integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionTwinTwin -real(pReal), dimension(lattice_MaxLatticeStructure), parameter :: lattice_TwinShear = & -reshape((/0.7071067812,0.7071067812,0.7071067812/),(/lattice_MaxLatticeStructure/)) ! Depends surely on c/a ratio for HCP + +!============================== fcc (1) ================================= + + integer(pInt), parameter :: lattice_fcc_Nslip = 12_pInt + integer(pInt), parameter :: lattice_fcc_Ntwin = 12_pInt + integer(pInt) :: lattice_fcc_Nstructure = 0_pInt + + real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter :: lattice_fcc_systemSlip = & + reshape((/& +! Slip system <110>{111} Sorted according to Eisenlohr & Hantcherli + 0, 1,-1, 1, 1, 1, & + -1, 0, 1, 1, 1, 1, & + 1,-1, 0, 1, 1, 1, & + 0,-1,-1, -1,-1, 1, & + 1, 0, 1, -1,-1, 1, & + -1, 1, 0, -1,-1, 1, & + 0,-1, 1, 1,-1,-1, & + -1, 0,-1, 1,-1,-1, & + 1, 1, 0, 1,-1,-1, & + 0, 1, 1, -1, 1,-1, & + 1, 0,-1, -1, 1,-1, & + -1,-1, 0, -1, 1,-1 & + /),(/3+3,lattice_fcc_Nslip/)) + + real(pReal), dimension(3+3,lattice_fcc_Ntwin), parameter :: lattice_fcc_systemTwin = & + reshape((/& +! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + /),(/3+3,lattice_fcc_Ntwin/)) + + real(pReal), dimension(lattice_fcc_Ntwin), parameter :: lattice_fcc_shearTwin = & + reshape((/& +! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812, & + 0.7071067812 & + /),(/lattice_fcc_Ntwin/)) + + integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipSlip = & + reshape((/& + 1,2,2,4,6,5,3,5,5,4,5,6, & + 2,1,2,6,4,5,5,4,6,5,3,5, & + 2,2,1,5,5,3,5,6,4,6,5,4, & + 4,6,5,1,2,2,4,5,6,3,5,5, & + 6,4,5,2,1,2,5,3,5,5,4,6, & + 5,5,3,2,2,1,6,5,4,5,6,4, & + 3,5,5,4,5,6,1,2,2,4,6,5, & + 5,4,6,5,3,5,2,1,2,6,4,5, & + 5,6,4,6,5,4,2,2,1,5,5,3, & + 4,5,6,3,5,5,4,6,5,1,2,2, & + 5,3,5,5,4,6,6,4,5,2,1,2, & + 6,5,4,5,6,4,5,5,3,2,2,1 & + /),(/lattice_fcc_Nslip,lattice_fcc_Nslip/)) + + integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin) :: lattice_fcc_interactionSlipTwin = & + reshape((/& + 0,0,0,1,1,0,0,1,1,1,0,1, & + 0,0,0,1,1,0,0,1,1,1,0,1, & + 0,0,0,1,1,0,0,1,1,1,0,1, & + 1,1,0,0,0,0,1,0,1,0,1,1, & + 1,1,0,0,0,0,1,0,1,0,1,1, & + 1,1,0,0,0,0,1,0,1,0,1,1, & + 0,1,1,1,0,1,0,0,0,1,1,0, & + 0,1,1,1,0,1,0,0,0,1,1,0, & + 0,1,1,1,0,1,0,0,0,1,1,0, & + 1,0,1,0,1,1,1,1,0,0,0,0, & + 1,0,1,0,1,1,1,1,0,0,0,0, & + 1,0,1,0,1,1,1,1,0,0,0,0 & + /),(/lattice_fcc_Nslip,lattice_fcc_Ntwin/)) + + integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinTwin = & + reshape((/& + 0,0,0,1,1,1,1,1,1,1,1,1, & + 0,0,0,1,1,1,1,1,1,1,1,1, & + 0,0,0,1,1,1,1,1,1,1,1,1, & + 1,1,1,0,0,0,1,1,1,1,1,1, & + 1,1,1,0,0,0,1,1,1,1,1,1, & + 1,1,1,0,0,0,1,1,1,1,1,1, & + 1,1,1,1,1,1,0,0,0,1,1,1, & + 1,1,1,1,1,1,0,0,0,1,1,1, & + 1,1,1,1,1,1,0,0,0,1,1,1, & + 1,1,1,1,1,1,1,1,1,0,0,0, & + 1,1,1,1,1,1,1,1,1,0,0,0, & + 1,1,1,1,1,1,1,1,1,0,0,0 & + /),(/lattice_fcc_Ntwin,lattice_fcc_Ntwin/)) -!* Slip_slip interaction matrices -integer(pInt), dimension(lattice_MaxMaxNslipOfStructure,lattice_MaxMaxNslipOfStructure,lattice_MaxLatticeStructure) :: & -lattice_SlipIntType -!* Slip_twin interaction matrices -integer(pInt), dimension(lattice_MaxMaxNslipOfStructure,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: & -lattice_SlipTwinIntType -!* Twin-twin interaction matrices -integer(pInt), dimension(lattice_MaxMaxNtwinOfStructure,lattice_MaxMaxNtwinOfStructure,lattice_MaxLatticeStructure) :: & -lattice_TwinIntType +!============================== bcc (2) ================================= -!*** Slip systems for FCC structures (1) *** -!* System {111}<110> Sort according Eisenlohr&Hantcherli -data lattice_sd(:, 1,1)/ 0, 1,-1/ ; data lattice_sn(:, 1,1)/ 1, 1, 1/ -data lattice_sd(:, 2,1)/-1, 0, 1/ ; data lattice_sn(:, 2,1)/ 1, 1, 1/ -data lattice_sd(:, 3,1)/ 1,-1, 0/ ; data lattice_sn(:, 3,1)/ 1, 1, 1/ -data lattice_sd(:, 4,1)/ 0,-1,-1/ ; data lattice_sn(:, 4,1)/-1,-1, 1/ -data lattice_sd(:, 5,1)/ 1, 0, 1/ ; data lattice_sn(:, 5,1)/-1,-1, 1/ -data lattice_sd(:, 6,1)/-1, 1, 0/ ; data lattice_sn(:, 6,1)/-1,-1, 1/ -data lattice_sd(:, 7,1)/ 0,-1, 1/ ; data lattice_sn(:, 7,1)/ 1,-1,-1/ -data lattice_sd(:, 8,1)/-1, 0,-1/ ; data lattice_sn(:, 8,1)/ 1,-1,-1/ -data lattice_sd(:, 9,1)/ 1, 1, 0/ ; data lattice_sn(:, 9,1)/ 1,-1,-1/ -data lattice_sd(:,10,1)/ 0, 1, 1/ ; data lattice_sn(:,10,1)/-1, 1,-1/ -data lattice_sd(:,11,1)/ 1, 0,-1/ ; data lattice_sn(:,11,1)/-1, 1,-1/ -data lattice_sd(:,12,1)/-1,-1, 0/ ; data lattice_sn(:,12,1)/-1, 1,-1/ + integer(pInt), parameter :: lattice_bcc_Nslip = 48_pInt + integer(pInt), parameter :: lattice_bcc_Ntwin = 12_pInt + integer(pInt) :: lattice_bcc_Nstructure = 0_pInt -!*** Twin systems for FCC structures (1) *** -!* System {111}<112> Sort according Eisenlohr&Hantcherli -data lattice_td(:, 1,1)/-2, 1, 1/ ; data lattice_tn(:, 1,1)/ 1, 1, 1/ -data lattice_td(:, 2,1)/ 1,-2, 1/ ; data lattice_tn(:, 2,1)/ 1, 1, 1/ -data lattice_td(:, 3,1)/ 1, 1,-2/ ; data lattice_tn(:, 3,1)/ 1, 1, 1/ -data lattice_td(:, 4,1)/ 2,-1, 1/ ; data lattice_tn(:, 4,1)/-1,-1, 1/ -data lattice_td(:, 5,1)/-1, 2, 1/ ; data lattice_tn(:, 5,1)/-1,-1, 1/ -data lattice_td(:, 6,1)/-1,-1,-2/ ; data lattice_tn(:, 6,1)/-1,-1, 1/ -data lattice_td(:, 7,1)/-2,-1,-1/ ; data lattice_tn(:, 7,1)/ 1,-1,-1/ -data lattice_td(:, 8,1)/ 1, 2,-1/ ; data lattice_tn(:, 8,1)/ 1,-1,-1/ -data lattice_td(:, 9,1)/ 1,-1, 2/ ; data lattice_tn(:, 9,1)/ 1,-1,-1/ -data lattice_td(:,10,1)/ 2, 1,-1/ ; data lattice_tn(:,10,1)/-1, 1,-1/ -data lattice_td(:,11,1)/-1,-2,-1/ ; data lattice_tn(:,11,1)/-1, 1,-1/ -data lattice_td(:,12,1)/-1, 1, 2/ ; data lattice_tn(:,12,1)/-1, 1,-1/ + real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter :: lattice_bcc_systemSlip = & + reshape((/& +! Slip system <111>{110} meaningful sorting? + 1,-1, 1, 0, 1, 1, & + -1,-1, 1, 0, 1, 1, & + 1, 1, 1, 0,-1, 1, & + -1, 1, 1, 0,-1, 1, & + -1, 1, 1, 1, 0, 1, & + -1,-1, 1, 1, 0, 1, & + 1, 1, 1, -1, 0, 1, & + 1,-1, 1, -1, 0, 1, & + -1, 1, 1, 1, 1, 0, & + -1, 1,-1, 1, 1, 0, & + 1, 1, 1, -1, 1, 0, & + 1, 1,-1, -1, 1, 0, & +! Slip system <111>{112} meaningful sorting ? + -1, 1, 1, 2, 1, 1, & + 1, 1, 1, -2, 1, 1, & + 1, 1,-1, 2,-1, 1, & + 1,-1, 1, 2, 1,-1, & + 1,-1, 1, 1, 2, 1, & + 1, 1,-1, -1, 2, 1, & + 1, 1, 1, 1,-2, 1, & + -1, 1, 1, 1, 2,-1, & + 1, 1,-1, 1, 1, 2, & + 1,-1, 1, -1, 1, 2, & + -1, 1, 1, 1,-1, 2, & + 1, 1, 1, 1, 1,-2, & +! Slip system <111>{123} meaningful sorting ? + 1, 1,-1, 1, 2, 3, & + 1,-1, 1, -1, 2, 3, & + -1, 1, 1, 1,-2, 3, & + 1, 1, 1, 1, 2,-3, & + 1,-1, 1, 1, 3, 2, & + 1, 1,-1, -1, 3, 2, & + 1, 1, 1, 1,-3, 2, & + -1, 1, 1, 1, 3,-2, & + 1, 1,-1, 2, 1, 3, & + 1,-1, 1, -2, 1, 3, & + -1, 1, 1, 2,-1, 3, & + 1, 1, 1, 2, 1,-3, & + 1,-1, 1, 2, 3, 1, & + 1, 1,-1, -2, 3, 1, & + 1, 1, 1, 2,-3, 1, & + -1, 1, 1, 2, 3,-1, & + -1, 1, 1, 3, 1, 2, & + 1, 1, 1, -3, 1, 2, & + 1, 1,-1, 3,-1, 2, & + 1,-1, 1, 3, 1,-2, & + -1, 1, 1, 3, 2, 1, & + 1, 1, 1, -3, 2, 1, & + 1, 1,-1, 3,-2, 1, & + 1,-1, 1, 3, 2,-1 & + /),(/3+3,lattice_bcc_Nslip/)) -!*** Slip-Slip interactions for FCC structures (1) *** -data lattice_SlipIntType( 1,1:lattice_MaxNslipOfStructure(1),1)/1,2,2,4,6,5,3,5,5,4,5,6/ -data lattice_SlipIntType( 2,1:lattice_MaxNslipOfStructure(1),1)/2,1,2,6,4,5,5,4,6,5,3,5/ -data lattice_SlipIntType( 3,1:lattice_MaxNslipOfStructure(1),1)/2,2,1,5,5,3,5,6,4,6,5,4/ -data lattice_SlipIntType( 4,1:lattice_MaxNslipOfStructure(1),1)/4,6,5,1,2,2,4,5,6,3,5,5/ -data lattice_SlipIntType( 5,1:lattice_MaxNslipOfStructure(1),1)/6,4,5,2,1,2,5,3,5,5,4,6/ -data lattice_SlipIntType( 6,1:lattice_MaxNslipOfStructure(1),1)/5,5,3,2,2,1,6,5,4,5,6,4/ -data lattice_SlipIntType( 7,1:lattice_MaxNslipOfStructure(1),1)/3,5,5,4,5,6,1,2,2,4,6,5/ -data lattice_SlipIntType( 8,1:lattice_MaxNslipOfStructure(1),1)/5,4,6,5,3,5,2,1,2,6,4,5/ -data lattice_SlipIntType( 9,1:lattice_MaxNslipOfStructure(1),1)/5,6,4,6,5,4,2,2,1,5,5,3/ -data lattice_SlipIntType(10,1:lattice_MaxNslipOfStructure(1),1)/4,5,6,3,5,5,4,6,5,1,2,2/ -data lattice_SlipIntType(11,1:lattice_MaxNslipOfStructure(1),1)/5,3,5,5,4,6,6,4,5,2,1,2/ -data lattice_SlipIntType(12,1:lattice_MaxNslipOfStructure(1),1)/6,5,4,5,6,4,5,5,3,2,2,1/ +! twin system <111>{112} +! MISSING: not implemented yet -- now dummy copy from fcc !! + real(pReal), dimension(3+3,lattice_bcc_Ntwin), parameter :: lattice_bcc_systemTwin = & + reshape((/& +! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli + -2, 1, 1, 1, 1, 1, & + 1,-2, 1, 1, 1, 1, & + 1, 1,-2, 1, 1, 1, & + 2,-1, 1, -1,-1, 1, & + -1, 2, 1, -1,-1, 1, & + -1,-1,-2, -1,-1, 1, & + -2,-1,-1, 1,-1,-1, & + 1, 2,-1, 1,-1,-1, & + 1,-1, 2, 1,-1,-1, & + 2, 1,-1, -1, 1,-1, & + -1,-2,-1, -1, 1,-1, & + -1, 1, 2, -1, 1,-1 & + /),(/3+3,lattice_bcc_Ntwin/)) -!*** Slip-Twin interactions for FCC structures (1) *** -data lattice_SlipTwinIntType( 1,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,0,0,0,1,1,1/ -data lattice_SlipTwinIntType( 2,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,1,1,1,0,0,0/ -data lattice_SlipTwinIntType( 3,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,0,0,0,1,1,1,1,1,1/ -data lattice_SlipTwinIntType( 4,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,1,1,1,0,0,0/ -data lattice_SlipTwinIntType( 5,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,0,0,0,1,1,1/ -data lattice_SlipTwinIntType( 6,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,0,0,0,1,1,1,1,1,1/ -data lattice_SlipTwinIntType( 7,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,0,0,0,1,1,1/ -data lattice_SlipTwinIntType( 8,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,0,0,0,1,1,1/ -data lattice_SlipTwinIntType( 9,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,0,0,0,0,0,0/ -data lattice_SlipTwinIntType(10,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,1,1,1,0,0,0/ -data lattice_SlipTwinIntType(11,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,1,1,1,0,0,0/ -data lattice_SlipTwinIntType(12,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,0,0,0,0,0,0/ -!*** Twin-Twin interactions for FCC structures (1) *** -data lattice_TwinIntType( 1,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,1,1,1,1,1,1/ -data lattice_TwinIntType( 2,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,1,1,1,1,1,1/ -data lattice_TwinIntType( 3,1:lattice_MaxNtwinOfStructure(1),1)/0,0,0,1,1,1,1,1,1,1,1,1/ -data lattice_TwinIntType( 4,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,1,1,1,1,1,1/ -data lattice_TwinIntType( 5,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,1,1,1,1,1,1/ -data lattice_TwinIntType( 6,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,0,0,0,1,1,1,1,1,1/ -data lattice_TwinIntType( 7,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,0,0,0,1,1,1/ -data lattice_TwinIntType( 8,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,0,0,0,1,1,1/ -data lattice_TwinIntType( 9,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,0,0,0,1,1,1/ -data lattice_TwinIntType(10,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,1,1,1,0,0,0/ -data lattice_TwinIntType(11,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,1,1,1,0,0,0/ -data lattice_TwinIntType(12,1:lattice_MaxNtwinOfStructure(1),1)/1,1,1,1,1,1,1,1,1,0,0,0/ - -!*** Slip systems for BCC structures (2) *** -!* System {110}<111> -!* Sort? -data lattice_sd(:, 1,2)/ 1,-1, 1/ ; data lattice_sn(:, 1,2)/ 0, 1, 1/ -data lattice_sd(:, 2,2)/-1,-1, 1/ ; data lattice_sn(:, 2,2)/ 0, 1, 1/ -data lattice_sd(:, 3,2)/ 1, 1, 1/ ; data lattice_sn(:, 3,2)/ 0,-1, 1/ -data lattice_sd(:, 4,2)/-1, 1, 1/ ; data lattice_sn(:, 4,2)/ 0,-1, 1/ -data lattice_sd(:, 5,2)/-1, 1, 1/ ; data lattice_sn(:, 5,2)/ 1, 0, 1/ -data lattice_sd(:, 6,2)/-1,-1, 1/ ; data lattice_sn(:, 6,2)/ 1, 0, 1/ -data lattice_sd(:, 7,2)/ 1, 1, 1/ ; data lattice_sn(:, 7,2)/-1, 0, 1/ -data lattice_sd(:, 8,2)/ 1,-1, 1/ ; data lattice_sn(:, 8,2)/-1, 0, 1/ -data lattice_sd(:, 9,2)/-1, 1, 1/ ; data lattice_sn(:, 9,2)/ 1, 1, 0/ -data lattice_sd(:,10,2)/-1, 1,-1/ ; data lattice_sn(:,10,2)/ 1, 1, 0/ -data lattice_sd(:,11,2)/ 1, 1, 1/ ; data lattice_sn(:,11,2)/-1, 1, 0/ -data lattice_sd(:,12,2)/ 1, 1,-1/ ; data lattice_sn(:,12,2)/-1, 1, 0/ -!* System {112}<111> -!* Sort? -data lattice_sd(:,13,2)/-1, 1, 1/ ; data lattice_sn(:,13,2)/ 2, 1, 1/ -data lattice_sd(:,14,2)/ 1, 1, 1/ ; data lattice_sn(:,14,2)/-2, 1, 1/ -data lattice_sd(:,15,2)/ 1, 1,-1/ ; data lattice_sn(:,15,2)/ 2,-1, 1/ -data lattice_sd(:,16,2)/ 1,-1, 1/ ; data lattice_sn(:,16,2)/ 2, 1,-1/ -data lattice_sd(:,17,2)/ 1,-1, 1/ ; data lattice_sn(:,17,2)/ 1, 2, 1/ -data lattice_sd(:,18,2)/ 1, 1,-1/ ; data lattice_sn(:,18,2)/-1, 2, 1/ -data lattice_sd(:,19,2)/ 1, 1, 1/ ; data lattice_sn(:,19,2)/ 1,-2, 1/ -data lattice_sd(:,20,2)/-1, 1, 1/ ; data lattice_sn(:,20,2)/ 1, 2,-1/ -data lattice_sd(:,21,2)/ 1, 1,-1/ ; data lattice_sn(:,21,2)/ 1, 1, 2/ -data lattice_sd(:,22,2)/ 1,-1, 1/ ; data lattice_sn(:,22,2)/-1, 1, 2/ -data lattice_sd(:,23,2)/-1, 1, 1/ ; data lattice_sn(:,23,2)/ 1,-1, 2/ -data lattice_sd(:,24,2)/ 1, 1, 1/ ; data lattice_sn(:,24,2)/ 1, 1,-2/ -!* System {123}<111> -!* Sort? -data lattice_sd(:,25,2)/ 1, 1,-1/ ; data lattice_sn(:,25,2)/ 1, 2, 3/ -data lattice_sd(:,26,2)/ 1,-1, 1/ ; data lattice_sn(:,26,2)/-1, 2, 3/ -data lattice_sd(:,27,2)/-1, 1, 1/ ; data lattice_sn(:,27,2)/ 1,-2, 3/ -data lattice_sd(:,28,2)/ 1, 1, 1/ ; data lattice_sn(:,28,2)/ 1, 2,-3/ -data lattice_sd(:,29,2)/ 1,-1, 1/ ; data lattice_sn(:,29,2)/ 1, 3, 2/ -data lattice_sd(:,30,2)/ 1, 1,-1/ ; data lattice_sn(:,30,2)/-1, 3, 2/ -data lattice_sd(:,31,2)/ 1, 1, 1/ ; data lattice_sn(:,31,2)/ 1,-3, 2/ -data lattice_sd(:,32,2)/-1, 1, 1/ ; data lattice_sn(:,32,2)/ 1, 3,-2/ -data lattice_sd(:,33,2)/ 1, 1,-1/ ; data lattice_sn(:,33,2)/ 2, 1, 3/ -data lattice_sd(:,34,2)/ 1,-1, 1/ ; data lattice_sn(:,34,2)/-2, 1, 3/ -data lattice_sd(:,35,2)/-1, 1, 1/ ; data lattice_sn(:,35,2)/ 2,-1, 3/ -data lattice_sd(:,36,2)/ 1, 1, 1/ ; data lattice_sn(:,36,2)/ 2, 1,-3/ -data lattice_sd(:,37,2)/ 1,-1, 1/ ; data lattice_sn(:,37,2)/ 2, 3, 1/ -data lattice_sd(:,38,2)/ 1, 1,-1/ ; data lattice_sn(:,38,2)/-2, 3, 1/ -data lattice_sd(:,39,2)/ 1, 1, 1/ ; data lattice_sn(:,39,2)/ 2,-3, 1/ -data lattice_sd(:,40,2)/-1, 1, 1/ ; data lattice_sn(:,40,2)/ 2, 3,-1/ -data lattice_sd(:,41,2)/-1, 1, 1/ ; data lattice_sn(:,41,2)/ 3, 1, 2/ -data lattice_sd(:,42,2)/ 1, 1, 1/ ; data lattice_sn(:,42,2)/-3, 1, 2/ -data lattice_sd(:,43,2)/ 1, 1,-1/ ; data lattice_sn(:,43,2)/ 3,-1, 2/ -data lattice_sd(:,44,2)/ 1,-1, 1/ ; data lattice_sn(:,44,2)/ 3, 1,-2/ -data lattice_sd(:,45,2)/-1, 1, 1/ ; data lattice_sn(:,45,2)/ 3, 2, 1/ -data lattice_sd(:,46,2)/ 1, 1, 1/ ; data lattice_sn(:,46,2)/-3, 2, 1/ -data lattice_sd(:,47,2)/ 1, 1,-1/ ; data lattice_sn(:,47,2)/ 3,-2, 1/ -data lattice_sd(:,48,2)/ 1,-1, 1/ ; data lattice_sn(:,48,2)/ 3, 2,-1/ - -!*** Twin systems for BCC structures (2) *** -!* System {112}<111> -!* Sort? -!* MISSING: not implemented yet + real(pReal), dimension(lattice_bcc_Ntwin), parameter :: lattice_bcc_shearTwin = & + reshape((/& +! Twin system {111}<112> just a dummy + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123, & + 0.123 & + /),(/lattice_bcc_Ntwin/)) !*** Slip-Slip interactions for BCC structures (2) *** -data lattice_SlipIntType( 1,:,2)/1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 2,:,2)/2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 3,:,2)/2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 4,:,2)/2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 5,:,2)/2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 6,:,2)/2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 7,:,2)/2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 8,:,2)/2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 9,:,2)/2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(10,:,2)/2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(11,:,2)/2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(12,:,2)/2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(13,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(14,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(15,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(16,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(17,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(18,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(19,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(20,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(21,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(22,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(23,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(24,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(25,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(26,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(27,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(28,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(29,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(30,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(31,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(32,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(33,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(34,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(35,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(36,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(37,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(38,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(39,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(40,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(41,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2/ -data lattice_SlipIntType(42,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2/ -data lattice_SlipIntType(43,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2/ -data lattice_SlipIntType(44,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2/ -data lattice_SlipIntType(45,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2/ -data lattice_SlipIntType(46,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2/ -data lattice_SlipIntType(47,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2/ -data lattice_SlipIntType(48,:,2)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1/ + integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipSlip = & + reshape((/& + 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & + /),(/lattice_bcc_Nslip,lattice_bcc_Nslip/)) !*** Slip-twin interactions for BCC structures (2) *** ! MISSING: not implemented yet + integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin) :: lattice_bcc_interactionSlipTwin = & + reshape((/& + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 & + /),(/lattice_bcc_Nslip,lattice_bcc_Ntwin/)) !*** Twin-twin interactions for BCC structures (2) *** ! MISSING: not implemented yet - -!*** Slip systems for HCP structures (3) *** -!* Basal systems {0001}<1120> (independent of c/a-ratio) -!* 1- [2 -1 -1 0](0 0 0 1) -!* 2- [-1 2 -1 0](0 0 0 1) -!* 3- [-1 -1 2 0](0 0 0 1) -!* Automatical transformation from Bravais (4 axes coorinate system) to Miller (in ortho-hexagonal coordinate system) -!* not done for the moment -!* Sort? Changed order of slip system and sign of Burges vector (Tom Bieler, yj.ro) -data Hlattice_sd(:, 1,3)/ 2, -1, -1, 0/ ; data Hlattice_sn(:, 1,3)/ 0, 0, 0, 1/ -data Hlattice_sd(:, 2,3)/-1, 2, -1, 0/ ; data Hlattice_sn(:, 2,3)/ 0, 0, 0, 1/ -data Hlattice_sd(:, 3,3)/-1, -1, 2, 0/ ; data Hlattice_sn(:, 3,3)/ 0, 0, 0, 1/ -!* 1st type prismatic systems {1010}<1120> (independent of c/a-ratio) -!* 4- [ 2 -1 -1 0]( 0 1 -1 0) -!* 5- [-1 2 -1 0]( 1 0 -1 0) -!* 6- [-1 -1 2 0](-1 1 0 0) -!* Sort? Changed order of slip system and sign of Burges vector (yj.ro) -data Hlattice_sd(:, 4,3)/ 2, -1, -1, 0/ ; data Hlattice_sn(:, 4,3)/ 0, 1, -1, 0/ -data Hlattice_sd(:, 5,3)/-1, 2, -1, 0/ ; data Hlattice_sn(:, 5,3)/ 1, 0, -1, 0/ -data Hlattice_sd(:, 6,3)/-1, -1, 2, 0/ ; data Hlattice_sn(:, 6,3)/-1, 1, 0, 0/ -!* 1st type 1st order pyramidal systems {1011}<1120> -!* plane normales depend on the c/a-ratio -!* 7- [ 2 -1 -1 0]( 0 1 -1 1) -!* 8- [-1 2 -1 0]( 1 0 -1 1) -!* 9- [-1 -1 2 0](-1 1 0 1) -!* 10- [ 2 -1 -1 0]( 0 -1 1 1) -!* 11- [-1 2 -1 0](-1 0 1 1) -!* 12- [-1 -1 2 0]( 1 -1 0 1) -!* Sort? Changed order of slip system and sign of Burges vector (Tom Bieler, yj.ro) -data Hlattice_sd(:, 7,3)/ 2, -1, -1, 0/ ; data Hlattice_sn(:, 7,3)/ 0, 1, -1, 1/ -data Hlattice_sd(:, 8,3)/-1, 2, -1, 0/ ; data Hlattice_sn(:, 8,3)/ 1, 0, -1, 1/ -data Hlattice_sd(:, 9,3)/-1, -1, 2, 0/ ; data Hlattice_sn(:, 9,3)/-1, 1, 0, 1/ -data Hlattice_sd(:,10,3)/ 2, -1, -1, 0/ ; data Hlattice_sn(:,10,3)/ 0, -1, 1, 1/ -data Hlattice_sd(:,11,3)/-1, 2, -1, 0/ ; data Hlattice_sn(:,11,3)/-1, 0, 1, 1/ -data Hlattice_sd(:,12,3)/-1, -1, 2, 0/ ; data Hlattice_sn(:,12,3)/ 1, -1, 0, 1/ -!* pyramidal system: c+a slip {1011}<2113> -!* plane normales depend on the c/a-ratio -!* added by Tom Bieler, yj.ro -!* 13- [ 2 -1 -1 -3]( 1 0 -1 1) -!* 14- [ 1 1 -2 -3]( 1 0 -1 1) -!* 15- [ 1 1 -2 -3]( 0 1 -1 1) -!* 16- [-1 2 -1 -3]( 0 1 -1 1) -!* 17- [-1 2 -1 -3](-1 1 0 1) -!* 18- [-2 1 1 -3](-1 1 0 1) -!* 19- [-2 1 1 -3](-1 0 1 1) -!* 20- [-1 -1 2 -3](-1 0 1 1) -!* 21- [-1 -1 2 -3]( 0 -1 1 1) -!* 22- [ 1 -2 1 -3]( 0 -1 1 1) -!* 23- [ 1 -2 1 -3]( 1 -1 0 1) -!* 24- [ 2 -1 -1 -3]( 1 -1 0 1) -data Hlattice_sd(:,13,3)/ 2, -1, -1, -3/ ; data Hlattice_sn(:,13,3)/ 1, 0, -1, 1/ -data Hlattice_sd(:,14,3)/ 1, 1, -2, -3/ ; data Hlattice_sn(:,14,3)/ 1, 0, -1, 1/ -data Hlattice_sd(:,15,3)/ 1, 1, -2, -3/ ; data Hlattice_sn(:,15,3)/ 0, 1, -1, 1/ -data Hlattice_sd(:,16,3)/-1, 2, -1, -3/ ; data Hlattice_sn(:,16,3)/ 0, 1, -1, 1/ -data Hlattice_sd(:,17,3)/-1, 2, -1, -3/ ; data Hlattice_sn(:,17,3)/-1, 1, 0, 1/ -data Hlattice_sd(:,18,3)/-2, 1, 1, -3/ ; data Hlattice_sn(:,18,3)/-1, 1, 0, 1/ -data Hlattice_sd(:,19,3)/-2, 1, 1, -3/ ; data Hlattice_sn(:,19,3)/-1, 0, 1, 1/ -data Hlattice_sd(:,20,3)/-1, -1, 2, -3/ ; data Hlattice_sn(:,20,3)/-1, 0, 1, 1/ -data Hlattice_sd(:,21,3)/-1, -1, 2, -3/ ; data Hlattice_sn(:,21,3)/ 0, -1, 1, 1/ -data Hlattice_sd(:,22,3)/ 1, -2, 1, -3/ ; data Hlattice_sn(:,22,3)/ 0, -1, 1, 1/ -data Hlattice_sd(:,23,3)/ 1, -2, 1, -3/ ; data Hlattice_sn(:,23,3)/ 1, -1, 0, 1/ -data Hlattice_sd(:,24,3)/ 2, -1, -1, -3/ ; data Hlattice_sn(:,24,3)/ 1, -1, 0, 1/ - -!*** Twin systems for HCP structures (3) *** -!* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 & -!*(to be consistent with this code structure). -!* MISSING: not implemented yet -!* added by Tom Bieler, yj.ro - -!* (1012)<1011> Twin: shear 0.169 -1.26 compression -!* 25- [-1 0 1 1]( 1 0 -1 2) -!* 26- [ 0 -1 1 1]( 0 1 -1 2) -!* 27- [ 1 -1 0 1](-1 1 0 2) -!* 28- [ 1 0 -1 1](-1 0 1 2) -!* 29- [ 0 1 -1 1]( 0 -1 1 2) -!* 30- [-1 1 0 1]( 1 -1 0 2) -data Hlattice_td(:, 1,3)/-1, 0, 1, 1/ ; data Hlattice_tn(:, 1,3)/ 1, 0, -1, 2/ -data Hlattice_td(:, 2,3)/ 0, -1, 1, 1/ ; data Hlattice_tn(:, 2,3)/ 0, 1, -1, 2/ -data Hlattice_td(:, 3,3)/ 1, -1, 0, 1/ ; data Hlattice_tn(:, 3,3)/-1, 1, 0, 2/ -data Hlattice_td(:, 4,3)/ 1, 0, -1, 1/ ; data Hlattice_tn(:, 4,3)/-1, 0, 1, 2/ -data Hlattice_td(:, 5,3)/ 0, 1, -1, 1/ ; data Hlattice_tn(:, 5,3)/ 0, -1, 1, 2/ -data Hlattice_td(:, 6,3)/-1, 1, 0, 1/ ; data Hlattice_tn(:, 6,3)/ 1, -1, 0, 2/ + integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinTwin = & + reshape((/& + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0, & + 0,0,0,0,0,0,0,0,0,0,0,0 & + /),(/lattice_bcc_Ntwin,lattice_bcc_Ntwin/)) -!*(2112)<211-2> Twin: shear 0.224 1.19 tension -!* 31- [ 2 -1 -1 -3]( 2 -1 -1 2) -!* 32- [ 1 1 -2 -3]( 1 1 -2 2) -!* 33- [-1 2 -1 -3](-1 2 -1 2) -!* 34- [-2 1 1 -3](-2 1 1 2) -!* 35- [-1 -1 2 -3](-1 -1 2 2) -!* 36- [ 1 -2 1 -3]( 1 -2 1 2) -data Hlattice_td(:, 7,3)/ 2, -1, -1, -3/ ; data Hlattice_tn(:, 7,3)/ 2, -1, -1, 2/ -data Hlattice_td(:, 8,3)/ 1, 1, -2, -3/ ; data Hlattice_tn(:, 8,3)/ 1, 1, -2, 2/ -data Hlattice_td(:, 9,3)/-1, 2, -1, -3/ ; data Hlattice_tn(:, 9,3)/-1, 2, -1, 2/ -data Hlattice_td(:,10,3)/-2, 1, 1, -3/ ; data Hlattice_tn(:,10,3)/-2, 1, 1, 2/ -data Hlattice_td(:,11,3)/-1, -1, 2, -3/ ; data Hlattice_tn(:,11,3)/-1, -1, 2, 2/ -data Hlattice_td(:,12,3)/1, -2, 1, -3/ ; data Hlattice_tn(:,12,3)/ 1, -2, 1, 2/ + +!============================== hex (3+) ================================= + + integer(pInt), parameter :: lattice_hex_Nslip = 24_pInt + integer(pInt), parameter :: lattice_hex_Ntwin = 24_pInt + integer(pInt) :: lattice_hex_Nstructure = 0_pInt + + real(pReal), dimension(4+4,lattice_hex_Nslip), parameter :: lattice_hex_systemSlip = & + reshape((/& +! Basal systems <1120>{0001} (independent of c/a-ratio, Bravais notation (4 coordinate base)) + 2, -1, -1, 0, 0, 0, 0, 1, & + -1, 2, -1, 0, 0, 0, 0, 1, & + -1, -1, 2, 0, 0, 0, 0, 1, & +! 1st type prismatic systems <1120>{1010} (independent of c/a-ratio) + 2, -1, -1, 0, 0, 1, -1, 0, & + -1, 2, -1, 0, 1, 0, -1, 0, & + -1, -1, 2, 0, -1, 1, 0, 0, & +! 1st type 1st order pyramidal systems <1120>{1011} + 2, -1, -1, 0, 0, 1, -1, 1, & + -1, 2, -1, 0, 1, 0, -1, 1, & + -1, -1, 2, 0, -1, 1, 0, 1, & + 2, -1, -1, 0, 0, -1, 1, 1, & + -1, 2, -1, 0, -1, 0, 1, 1, & + -1, -1, 2, 0, 1, -1, 0, 1, & +! pyramidal system: c+a slip <2113>{1011} -- plane normals depend on the c/a-ratio + 2, -1, -1, -3, 1, 0, -1, 1, & + 1, 1, -2, -3, 1, 0, -1, 1, & + 1, 1, -2, -3, 0, 1, -1, 1, & + -1, 2, -1, -3, 0, 1, -1, 1, & + -1, 2, -1, -3, -1, 1, 0, 1, & + -2, 1, 1, -3, -1, 1, 0, 1, & + -2, 1, 1, -3, -1, 0, 1, 1, & + -1, -1, 2, -3, -1, 0, 1, 1, & + -1, -1, 2, -3, 0, -1, 1, 1, & + 1, -2, 1, -3, 0, -1, 1, 1, & + 1, -2, 1, -3, 1, -1, 0, 1, & + 2, -1, -1, -3, 1, -1, 0, 1 & + /),(/4+4,lattice_hex_Nslip/)) + + real(pReal), dimension(4+4,lattice_hex_Ntwin), parameter :: lattice_hex_systemTwin = & + reshape((/& + -1, 0, 1, 1, 1, 0, -1, 2, & ! <1011>{1012} Twin: shear 0.169 -1.26 compression + 0, -1, 1, 1, 0, 1, -1, 2, & + 1, -1, 0, 1, -1, 1, 0, 2, & + 1, 0, -1, 1, -1, 0, 1, 2, & + 0, 1, -1, 1, 0, -1, 1, 2, & + -1, 1, 0, 1, 1, -1, 0, 2, & + 2, -1, -1, -3, 2, -1, -1, 2, & ! <211-2>{2112} Twin: shear 0.224 1.19 tension + 1, 1, -2, -3, 1, 1, -2, 2, & + -1, 2, -1, -3, -1, 2, -1, 2, & + -2, 1, 1, -3, -2, 1, 1, 2, & + -1, -1, 2, -3, -1, -1, 2, 2, & + 1, -2, 1, -3, 1, -2, 1, 2, & + -2, 1, 1, 6, 2, -1, -1, 1, & ! <211-6>{2111} Twin: shear 0.628 -0.39 compression + -1, -1, 2, 6, 1, 1, -2, 1, & + 1, -2, 1, 6, -1, 2, -1, 1, & + 2, -1, -1, 6, -2, 1, 1, 1, & + 1, 1, -2, 6, -1, -1, 2, 1, & + -1, 2, -1, 6, 1, -2, 1, 1, & + 1, 0, -1, -2, 1, 0, -1, 1, & ! <101-2>{1011} Twin: shear 0.103 1.09 tension + -1, 0, 1, -2, -1, 0, 1, 1, & + 0, 1, -1, -2, 0, 1, -1, 1, & + 0, -1, 1, -2, 0, -1, 1, 1, & + 1, -1, 0, -2, 1, -1, 0, 1, & + -1, 1, 0, -2, -1, 1, 0, 1 & + /),(/4+4,lattice_hex_Ntwin/)) !* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 & + + real(pReal), dimension(lattice_hex_Ntwin), parameter :: lattice_hex_shearTwin = & + reshape((/& + 0.169, & ! <1011>{1012} Twin: shear 0.169 -1.26 compression + 0.169, & + 0.169, & + 0.169, & + 0.169, & + 0.169, & + 0.224, & ! <211-2>{2112} Twin: shear 0.224 1.19 tension + 0.224, & + 0.224, & + 0.224, & + 0.224, & + 0.224, & + 0.628, & ! <211-6>{2111} Twin: shear 0.628 -0.39 compression + 0.628, & + 0.628, & + 0.628, & + 0.628, & + 0.628, & + 0.103, & ! <101-2>{1011} Twin: shear 0.103 1.09 tension + 0.103, & + 0.103, & + 0.103, & + 0.103, & + 0.103 & + /),(/lattice_hex_Ntwin/)) + + integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Nslip) :: lattice_hex_interactionSlipSlip = & + reshape((/& + 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & + /),(/lattice_hex_Nslip,lattice_hex_Nslip/)) + + integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Ntwin) :: lattice_hex_interactionSlipTwin = & + reshape((/& + 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & + /),(/lattice_hex_Nslip,lattice_hex_Ntwin/)) -!* (2111)<211-6> Twin: shear 0.628 -0.39 compressio -!* 37- [-2 1 1 6]( 2 -1 -1 1) -!* 38- [-1 -1 2 6]( 1 1 -2 1) -!* 39- [ 1 -2 1 6](-1 2 -1 1) -!* 40- [ 2 -1 -1 6](-2 1 1 1) -!* 41- [ 1 1 -2 6](-1 -1 2 1) -!* 42- [-1 2 -1 6]( 1 -2 1 1) -data Hlattice_td(:,13,3)/-2, 1, 1, 6/ ; data Hlattice_tn(:,13,3)/ 2, -1, -1, 1/ -data Hlattice_td(:,14,3)/-1, -1, 2, 6/ ; data Hlattice_tn(:,14,3)/ 1, 1, -2, 1/ -data Hlattice_td(:,15,3)/ 1, -2, 1, 6/ ; data Hlattice_tn(:,15,3)/-1, 2, -1, 1/ -data Hlattice_td(:,16,3)/ 2, -1, -1, 6/ ; data Hlattice_tn(:,16,3)/-2, 1, 1, 1/ -data Hlattice_td(:,17,3)/ 1, 1, -2, 6/ ; data Hlattice_tn(:,17,3)/-1, -1, 2, 1/ -data Hlattice_td(:,18,3)/-1, 2, -1, 6/ ; data Hlattice_tn(:,18,3)/ 1, -2, 1, 1/ - - -!* (1011)<101-2> Twin: shear 0.103 1.09 tension -!* 43- [ 1 0 -1 -2]( 1 0 -1 1) -!* 44- [-1 0 1 -2](-1 0 1 1) -!* 45- [ 0 1 -1 -2]( 0 1 -1 1) -!* 46- [ 0 -1 2 -2]( 0 -1 1 1) -!* 47- [ 1 -1 0 -2]( 1 -1 0 1) -!* 48- [-1 1 0 -2](-1 1 0 1) -data Hlattice_td(:,19,3)/ 1, 0, -1, -2/ ; data Hlattice_tn(:,19,3)/ 1, 0, -1, 1/ -data Hlattice_td(:,20,3)/-1, 0, 1, -2/ ; data Hlattice_tn(:,20,3)/-1, 0, 1, 1/ -data Hlattice_td(:,21,3)/ 0, 1, -1, -2/ ; data Hlattice_tn(:,21,3)/ 0, 1, -1, 1/ -data Hlattice_td(:,22,3)/ 0, -1, 1, -2/ ; data Hlattice_tn(:,22,3)/ 0, -1, 1, 1/ -data Hlattice_td(:,23,3)/ 1, -1, 0, -2/ ; data Hlattice_tn(:,23,3)/ 1, -1, 0, 1/ -data Hlattice_td(:,24,3)/-1, 1, 0, -2/ ; data Hlattice_tn(:,24,3)/-1, 1, 0, 1/ - - -!*** Slip-Slip interactions for HCP structures (3) *** -data lattice_SlipIntType( 1,1:lattice_MaxNslipOfStructure(3),3)/1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 2,1:lattice_MaxNslipOfStructure(3),3)/1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 3,1:lattice_MaxNslipOfStructure(3),3)/1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 4,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 5,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 6,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 7,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 8,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType( 9,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(10,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(11,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(12,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(13,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(14,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(15,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(16,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2/ -data lattice_SlipIntType(17,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2/ -data lattice_SlipIntType(18,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2/ -data lattice_SlipIntType(19,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2/ -data lattice_SlipIntType(20,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2/ -data lattice_SlipIntType(21,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2/ -data lattice_SlipIntType(22,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2/ -data lattice_SlipIntType(23,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2/ -data lattice_SlipIntType(24,1:lattice_MaxNslipOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1/ - -!*** slip-twin interactions for HCP structures (3) *** -data lattice_SlipTwinIntType( 1,1:lattice_MaxNtwinOfStructure(3),3)/1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 2,1:lattice_MaxNtwinOfStructure(3),3)/2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 3,1:lattice_MaxNtwinOfStructure(3),3)/2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 4,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 5,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 6,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 7,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 8,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType( 9,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(10,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(11,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(12,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(13,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(14,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(15,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(16,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(17,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(18,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2/ -data lattice_SlipTwinIntType(19,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2/ -data lattice_SlipTwinIntType(20,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2/ -data lattice_SlipTwinIntType(21,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2/ -data lattice_SlipTwinIntType(22,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2/ -data lattice_SlipTwinIntType(23,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2/ -data lattice_SlipTwinIntType(24,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1/ - -!*** Twin-twin interactions for HCP structures (3) *** -data lattice_TwinIntType( 1,1:lattice_MaxNtwinOfStructure(3),3)/1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 2,1:lattice_MaxNtwinOfStructure(3),3)/2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 3,1:lattice_MaxNtwinOfStructure(3),3)/2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 4,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 5,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 6,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 7,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 8,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType( 9,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(10,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(11,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(12,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(13,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(14,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(15,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(16,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2/ -data lattice_TwinIntType(17,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2/ -data lattice_TwinIntType(18,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2/ -data lattice_TwinIntType(19,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2/ -data lattice_TwinIntType(20,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2/ -data lattice_TwinIntType(21,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2/ -data lattice_TwinIntType(22,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2/ -data lattice_TwinIntType(23,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2/ -data lattice_TwinIntType(24,1:lattice_MaxNtwinOfStructure(3),3)/2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1/ + integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Ntwin) :: lattice_hex_interactionTwinTwin = & + reshape((/& + 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & + /),(/lattice_hex_Ntwin,lattice_hex_Ntwin/)) CONTAINS !**************************************** -!* - lattice_Init -!* - lattice_SchmidMatrices +!* - lattice_init +!* - lattice_initializeStructure !**************************************** @@ -481,149 +536,178 @@ subroutine lattice_init() !************************************** !* Module initialization * !************************************** -call lattice_SchmidMatrices() + use IO, only: IO_open_file,IO_countSections,IO_countTagInPart,IO_error + use material, only: material_configfile,material_partPhase + implicit none + + integer(pInt), parameter :: fileunit = 200 + integer(pInt) i,Nsections + + if(.not. IO_open_file(fileunit,material_configFile)) call IO_error (100) ! corrupt config file + Nsections = IO_countSections(fileunit,material_partPhase) + lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(fileunit,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex + close(fileunit) + + allocate(lattice_Sslip(3,3,lattice_maxNslip,lattice_Nstructure)); lattice_Sslip = 0.0_pReal + allocate(lattice_Sslip_v(6,lattice_maxNslip,lattice_Nstructure)); lattice_Sslip_v = 0.0_pReal + allocate(lattice_sd(3,lattice_maxNslip,lattice_Nstructure)); lattice_sd = 0.0_pReal + allocate(lattice_st(3,lattice_maxNslip,lattice_Nstructure)); lattice_st = 0.0_pReal + allocate(lattice_sn(3,lattice_maxNslip,lattice_Nstructure)); lattice_sn = 0.0_pReal + + allocate(lattice_Qtwin(3,3,lattice_maxNtwin,lattice_Nstructure)); lattice_Qtwin = 0.0_pReal + allocate(lattice_Stwin(3,3,lattice_maxNtwin,lattice_Nstructure)); lattice_Stwin = 0.0_pReal + allocate(lattice_Stwin_v(6,lattice_maxNtwin,lattice_Nstructure)); lattice_Stwin_v = 0.0_pReal + allocate(lattice_td(3,lattice_maxNtwin,lattice_Nstructure)); lattice_td = 0.0_pReal + allocate(lattice_tt(3,lattice_maxNtwin,lattice_Nstructure)); lattice_tt = 0.0_pReal + allocate(lattice_tn(3,lattice_maxNtwin,lattice_Nstructure)); lattice_tn = 0.0_pReal + allocate(lattice_shearTwin(lattice_maxNtwin,lattice_Nstructure)); lattice_shearTwin = 0.0_pReal + + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipSlip = 0_pInt + allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,lattice_Nstructure)); lattice_interactionSlipTwin = 0_pInt + allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,lattice_Nstructure)); lattice_interactionTwinTwin = 0_pInt + + write(6,*) 'lattice Nstructure',lattice_Nstructure end subroutine -subroutine lattice_SchmidMatrices() +function lattice_initializeStructure(struct,CoverA) !************************************** -!* Calculation of Schmid matrices * +!* Calculation of Schmid * +!* matrices, etc. * !************************************** -use prec, only: pReal,pInt -use math, only: math_I3,nrmMandel,mapMandel -implicit none + use prec, only: pReal,pInt + use math + implicit none -!* Definition of variables -integer(pInt) i,j,k,l -real(pReal) norm_d,norm_t,norm_n -real(pReal) norm_sn, norm_sd, norm_tn, norm_td, ratio + character(len=*) struct + real(pReal) CoverA + real(pReal), dimension(3,lattice_maxNslip) :: sd = 0.0_pReal, & + sn = 0.0_pReal, & + st = 0.0_pReal + real(pReal), dimension(3,lattice_maxNtwin) :: td = 0.0_pReal, & + tn = 0.0_pReal, & + tt = 0.0_pReal + real(pReal), dimension(lattice_maxNtwin) :: ts = 0.0_pReal + real(pReal), dimension(3) :: hex_d = 0.0_pReal, & + hex_n = 0.0_pReal + integer(pInt) :: i,myNslip,myNtwin,myStructure = 0_pInt + logical :: processMe = .false. -!*** Only HCP crystal: converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexgonal system (a, b, c) -!* Plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)): this has been changed to unit vector afterward. -!* Direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]: this has been changed to unit vector afterward. -!* Equations provided by Prof. Tom Bieler -!* need to input "c/a rati"o in somewhere in mattax.mpie file(I am not sure where to insert this value for now????). + integer(pInt) lattice_initializeStructure -ratio = 1.56 + write(6,*) 'initialize structure', struct + select case(struct(1:3)) ! check first three chars of structure name + case ('fcc') + myStructure = 1_pInt + myNslip = lattice_fcc_Nslip + myNtwin = lattice_fcc_Ntwin + lattice_fcc_Nstructure = lattice_fcc_Nstructure + 1_pInt + if (lattice_fcc_Nstructure == 1_pInt) then + processMe = .true. + do i = 1,myNslip + sn(:,i) = lattice_fcc_systemSlip(1:3,i)/dsqrt(math_mul3x3(lattice_fcc_systemSlip(1:3,i),lattice_fcc_systemSlip(1:3,i))) + sd(:,i) = lattice_fcc_systemSlip(4:6,i)/dsqrt(math_mul3x3(lattice_fcc_systemSlip(4:6,i),lattice_fcc_systemSlip(4:6,i))) + st(:,i) = math_vectorproduct(sn(:,i),sd(:,i)) + enddo + do i = 1,myNtwin + tn(:,i) = lattice_fcc_systemTwin(1:3,i)/dsqrt(math_mul3x3(lattice_fcc_systemTwin(1:3,i),lattice_fcc_systemTwin(1:3,i))) + td(:,i) = lattice_fcc_systemTwin(4:6,i)/dsqrt(math_mul3x3(lattice_fcc_systemTwin(4:6,i),lattice_fcc_systemTwin(4:6,i))) + tt(:,i) = math_vectorproduct(tn(:,i),td(:,i)) + ts(i) = lattice_fcc_shearTwin(i) + enddo + interactionSlipSlip => lattice_fcc_interactionSlipSlip + interactionSlipTwin => lattice_fcc_interactionSlipTwin + interactionTwinTwin => lattice_fcc_interactionTwinTwin + endif + + case ('bcc') + myStructure = 2_pInt + myNslip = lattice_bcc_Nslip + myNtwin = lattice_bcc_Ntwin + lattice_bcc_Nstructure = lattice_bcc_Nstructure + 1_pInt + if (lattice_bcc_Nstructure == 1_pInt) then + processMe = .true. + do i = 1,myNslip + sn(:,i) = lattice_bcc_systemSlip(1:3,i)/dsqrt(math_mul3x3(lattice_bcc_systemSlip(1:3,i),lattice_bcc_systemSlip(1:3,i))) + sd(:,i) = lattice_bcc_systemSlip(4:6,i)/dsqrt(math_mul3x3(lattice_bcc_systemSlip(4:6,i),lattice_bcc_systemSlip(4:6,i))) + st(:,i) = math_vectorproduct(sn(:,i),sd(:,i)) + enddo + do i = 1,myNtwin + tn(:,i) = lattice_bcc_systemTwin(1:3,i)/dsqrt(math_mul3x3(lattice_bcc_systemTwin(1:3,i),lattice_bcc_systemTwin(1:3,i))) + td(:,i) = lattice_bcc_systemTwin(4:6,i)/dsqrt(math_mul3x3(lattice_bcc_systemTwin(4:6,i),lattice_bcc_systemTwin(4:6,i))) + tt(:,i) = math_vectorproduct(tn(:,i),td(:,i)) + ts(i) = lattice_bcc_shearTwin(i) + enddo + interactionSlipSlip => lattice_bcc_interactionSlipSlip + interactionSlipTwin => lattice_bcc_interactionSlipTwin + interactionTwinTwin => lattice_bcc_interactionTwinTwin + endif + + case ('hex') + if (CoverA > 0.0_pReal) then + lattice_hex_Nstructure = lattice_hex_Nstructure + 1_pInt + myStructure = 2_pInt + lattice_hex_Nstructure + myNslip = lattice_hex_Nslip + myNtwin = lattice_hex_Ntwin + processMe = .true. +! converting from 4 axes coordinate system (a1=a2=a3=c) to ortho-hexgonal system (a, b, c) + do i = 1,myNslip + hex_n(1) = lattice_hex_systemSlip(1,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) + hex_n(2) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))/dsqrt(3.0_pReal) + hex_n(3) = lattice_hex_systemSlip(4,i)/CoverA + hex_d(1) = lattice_hex_systemSlip(5,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] + hex_d(2) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))*(0.5_pReal*dsqrt(3.0_pReal)) + hex_d(3) = lattice_hex_systemSlip(8,i)*CoverA -do i = 1,lattice_MaxNslipOfStructure(3) + sn(:,i) = hex_n/dsqrt(math_mul3x3(hex_n,hex_n)) + sd(:,i) = hex_d/dsqrt(math_mul3x3(hex_d,hex_d)) + st(:,i) = math_vectorproduct(sn(:,i),sd(:,i)) + enddo + do i = 1,myNtwin + hex_n(1) = lattice_hex_systemTwin(1,i) + hex_n(2) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))/dsqrt(3.0_pReal) + hex_n(3) = lattice_hex_systemTwin(4,i)/CoverA + hex_d(1) = lattice_hex_systemTwin(5,i)*1.5_pReal + hex_d(2) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))*(0.5_pReal*dsqrt(3.0_pReal)) + hex_d(3) = lattice_hex_systemTwin(8,i)*CoverA -!* slip system conversion - H_lattice_sn(1,i,3) = Hlattice_sn(1,i,3) - H_lattice_sn(2,i,3) = (Hlattice_sn(1,i,3)+ 2.0*Hlattice_sn(2,i,3))/sqrt(3.0) - H_lattice_sn(3,i,3) = Hlattice_sn(4,i,3)/ratio - - norm_sn = dsqrt(H_lattice_sn(1,i,3)**2 + H_lattice_sn(2,i,3)**2 + H_lattice_sn(3,i,3)**2) - - lattice_sn(1,i,3) = H_lattice_sn(1,i,3)/norm_sn - lattice_sn(2,i,3) = H_lattice_sn(2,i,3)/norm_sn - lattice_sn(3,i,3) = H_lattice_sn(3,i,3)/norm_sn - - H_lattice_sd(1,i,3) = 1.5*Hlattice_sd(1,i,3) - H_lattice_sd(2,i,3) = (Hlattice_sd(1,i,3) + 2.0*Hlattice_sd(2,i,3))*(sqrt(3.0)/2.0) - H_lattice_sd(3,i,3) = Hlattice_sd(4,i,3)*ratio + tn(:,i) = hex_n/dsqrt(math_mul3x3(hex_n,hex_n)) + td(:,i) = hex_d/dsqrt(math_mul3x3(hex_d,hex_d)) + tt(:,i) = math_vectorproduct(tn(:,i),td(:,i)) + ts(i) = lattice_hex_shearTwin(i) + enddo + interactionSlipSlip => lattice_hex_interactionSlipSlip + interactionSlipTwin => lattice_hex_interactionSlipTwin + interactionTwinTwin => lattice_hex_interactionTwinTwin + endif + end select - norm_sd = dsqrt(H_lattice_sd(1,i,3)**2 + H_lattice_sd(2,i,3)**2 + H_lattice_sd(3,i,3)**2) - - lattice_sd(1,i,3) = H_lattice_sd(1,i,3)/norm_sd - lattice_sd(2,i,3) = H_lattice_sd(2,i,3)/norm_sd - lattice_sd(3,i,3) = H_lattice_sd(3,i,3)/norm_sd - -!* twin system conversion - H_lattice_tn(1,i,3) = Hlattice_tn(1,i,3) - H_lattice_tn(2,i,3) = (Hlattice_tn(1,i,3)+ 2.0*Hlattice_tn(2,i,3))/sqrt(3.0) - H_lattice_tn(3,i,3) = Hlattice_tn(4,i,3)/ratio - - norm_tn = dsqrt(H_lattice_tn(1,i,3)**2 + H_lattice_tn(2,i,3)**2 + H_lattice_tn(3,i,3)**2) - - lattice_tn(1,i,3) = H_lattice_tn(1,i,3)/norm_tn - lattice_tn(2,i,3) = H_lattice_tn(2,i,3)/norm_tn - lattice_tn(3,i,3) = H_lattice_tn(3,i,3)/norm_tn - - H_lattice_td(1,i,3) = 1.5*Hlattice_td(1,i,3) - H_lattice_td(2,i,3) = (Hlattice_td(1,i,3)+ 2.0*Hlattice_td(2,i,3))*(sqrt(3.0)/2.0) - H_lattice_td(3,i,3) = Hlattice_td(4,i,3)*ratio - - norm_td = dsqrt(H_lattice_td(1,i,3)**2 + H_lattice_td(2,i,3)**2 + H_lattice_td(3,i,3)**2) - - lattice_td(1,i,3) = H_lattice_td(1,i,3)/norm_td - lattice_td(2,i,3) = H_lattice_td(2,i,3)/norm_td - lattice_td(3,i,3) = H_lattice_td(3,i,3)/norm_td - -enddo - -!* Iteration over the lattice structures -do l=1,lattice_MaxLatticeStructure -!* Iteration over the slip systems - do k=1,lattice_MaxNslipOfStructure(l) -!* Definition of transverse direction st for the frame (sd,st,sn) - lattice_st(1,k,l)=lattice_sn(2,k,l)*lattice_sd(3,k,l)-lattice_sn(3,k,l)*lattice_sd(2,k,l) - lattice_st(2,k,l)=lattice_sn(3,k,l)*lattice_sd(1,k,l)-lattice_sn(1,k,l)*lattice_sd(3,k,l) - lattice_st(3,k,l)=lattice_sn(1,k,l)*lattice_sd(2,k,l)-lattice_sn(2,k,l)*lattice_sd(1,k,l) - norm_d=dsqrt(lattice_sd(1,k,l)**2+lattice_sd(2,k,l)**2+lattice_sd(3,k,l)**2) - norm_t=dsqrt(lattice_st(1,k,l)**2+lattice_st(2,k,l)**2+lattice_st(3,k,l)**2) - norm_n=dsqrt(lattice_sn(1,k,l)**2+lattice_sn(2,k,l)**2+lattice_sn(3,k,l)**2) - lattice_sd(:,k,l)=lattice_sd(:,k,l)/norm_d - lattice_st(:,k,l)=lattice_st(:,k,l)/norm_t - lattice_sn(:,k,l)=lattice_sn(:,k,l)/norm_n -!* Defintion of Schmid matrix - forall (i=1:3,j=1:3) lattice_Sslip(i,j,k,l)=lattice_sd(i,k,l)*lattice_sn(j,k,l) -!* Vectorization of normalized Schmid matrix - forall (i=1:6) lattice_Sslip_v(i,k,l) = nrmMandel(i)/2.0_pReal * & - (lattice_Sslip(mapMandel(1,i),mapMandel(2,i),k,l)+lattice_Sslip(mapMandel(2,i),mapMandel(1,i),k,l)) + if (processMe) then + do i = 1,myNslip + lattice_sd(:,i,myStructure) = sd(:,i) + lattice_st(:,i,myStructure) = st(:,i) + lattice_sn(:,i,myStructure) = sn(:,i) + lattice_Sslip(:,:,i,myStructure) = math_tensorproduct(sd(:,i),sn(:,i)) + lattice_Sslip_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Sslip(:,:,i,myStructure))) enddo - -!* Iteration over the twin systems - do k=1,lattice_MaxNtwinOfStructure(l) -!* Definition of transverse direction tt for the frame (td,tt,tn) - lattice_tt(1,k,l)=lattice_tn(2,k,l)*lattice_td(3,k,l)-lattice_tn(3,k,l)*lattice_td(2,k,l) - lattice_tt(2,k,l)=lattice_tn(3,k,l)*lattice_td(1,k,l)-lattice_tn(1,k,l)*lattice_td(3,k,l) - lattice_tt(3,k,l)=lattice_tn(1,k,l)*lattice_td(2,k,l)-lattice_tn(2,k,l)*lattice_td(1,k,l) - norm_d=dsqrt(lattice_td(1,k,l)**2+lattice_td(2,k,l)**2+lattice_td(3,k,l)**2) - norm_t=dsqrt(lattice_tt(1,k,l)**2+lattice_tt(2,k,l)**2+lattice_tt(3,k,l)**2) - norm_n=dsqrt(lattice_tn(1,k,l)**2+lattice_tn(2,k,l)**2+lattice_tn(3,k,l)**2) - lattice_td(:,k,l)=lattice_td(:,k,l)/norm_d - lattice_tt(:,k,l)=lattice_tt(:,k,l)/norm_t - lattice_tn(:,k,l)=lattice_tn(:,k,l)/norm_n -!* Defintion of Schmid matrix and transformation matrices - lattice_Qtwin(:,:,k,l)=-math_I3 - forall (i=1:3,j=1:3) - lattice_Stwin(i,j,k,l)=lattice_td(i,k,l)*lattice_tn(j,k,l) - lattice_Qtwin(i,j,k,l)=lattice_Qtwin(i,j,k,l)+2*lattice_tn(i,k,l)*lattice_tn(j,k,l) - endforall -!* Vectorization of normalized Schmid matrix - lattice_Stwin_v(1,k,l)=lattice_Stwin(1,1,k,l) - lattice_Stwin_v(2,k,l)=lattice_Stwin(2,2,k,l) - lattice_Stwin_v(3,k,l)=lattice_Stwin(3,3,k,l) - !* be compatible with Mandel notation of Tstar - lattice_Stwin_v(4,k,l)=(lattice_Stwin(1,2,k,l)+lattice_Stwin(2,1,k,l))/dsqrt(2.0_pReal) - lattice_Stwin_v(5,k,l)=(lattice_Stwin(2,3,k,l)+lattice_Stwin(3,2,k,l))/dsqrt(2.0_pReal) - lattice_Stwin_v(6,k,l)=(lattice_Stwin(1,3,k,l)+lattice_Stwin(3,1,k,l))/dsqrt(2.0_pReal) + do i = 1,myNtwin + lattice_td(:,i,myStructure) = td(:,i) + lattice_tt(:,i,myStructure) = tt(:,i) + lattice_tn(:,i,myStructure) = tn(:,i) + lattice_Stwin(:,:,i,myStructure) = math_tensorproduct(td(:,i),tn(:,i)) + lattice_Stwin_v(:,i,myStructure) = math_Mandel33to6(math_symmetric3x3(lattice_Stwin(:,:,i,myStructure))) + lattice_Qtwin(:,:,i,myStructure) = math_RodrigToR(tn(:,i),180.0_pReal*inRad) + lattice_shearTwin(i,myStructure) = ts(i) enddo -enddo + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myStructure) = interactionSlipSlip(1:myNslip,1:myNslip) + lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myStructure) = interactionSlipTwin(1:myNslip,1:myNtwin) + lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myStructure) = interactionTwinTwin(1:myNtwin,1:myNtwin) + endif -!*** printout schmid matrix (0nly Hexagonal structure)to check if the conversion is correctly done. + lattice_initializeStructure = myStructure + write(6,*) 'lattice_initializeStructure', myStructure -!* define the output location -!open(7, FILE='slip.prn') -!open(8, FILE='twin.prn') -! -!do k = 1,24 -! write(7,*) k -! write(7,*) lattice_Sslip(1,1,k,3),lattice_Sslip(1,2,k,3),lattice_Sslip(1,3,k,3) -! write(7,*) lattice_Sslip(2,1,k,3),lattice_Sslip(2,2,k,3),lattice_Sslip(2,3,k,3) -! write(7,*) lattice_Sslip(3,1,k,3),lattice_Sslip(3,2,k,3),lattice_Sslip(3,3,k,3) -! write(7,*) -! write(8,*) k -! write(8,*) lattice_Stwin(1,1,k,3),lattice_Stwin(2,2,k,3),lattice_Stwin(3,3,k,3) -! write(8,*) lattice_Stwin(2,1,k,3),lattice_Stwin(2,2,k,3),lattice_Stwin(2,3,k,3) -! write(8,*) lattice_Stwin(3,1,k,3),lattice_Stwin(3,2,k,3),lattice_Stwin(3,3,k,3) -! write(8,*) -!enddo +end function -end subroutine END MODULE - - - diff --git a/trunk/material.f90 b/trunk/material.f90 index ae4d1949a..8db56183f 100644 --- a/trunk/material.f90 +++ b/trunk/material.f90 @@ -13,6 +13,10 @@ use prec, only: pReal,pInt implicit none character(len=64), parameter :: material_configFile = 'material.config' +character(len=32), parameter :: material_partHomogenization = 'homogenization' +character(len=32), parameter :: material_partMicrostructure = 'microstructure' +character(len=32), parameter :: material_partPhase = 'phase' +character(len=32), parameter :: material_partTexture = 'texture' !************************************* @@ -68,13 +72,13 @@ subroutine material_init() if(.not. IO_open_file(fileunit,material_configFile)) call IO_error (100) ! corrupt config file write(6,*) 'parsing homogenization...' - call material_parseHomogenization(fileunit) + call material_parseHomogenization(fileunit,material_partHomogenization) write(6,*) 'parsing microstrcuture...' - call material_parseMicrostructure(fileunit) + call material_parseMicrostructure(fileunit,material_partMicrostructure) write(6,*) 'parsing texture...' - call material_parseTexture(fileunit) + call material_parseTexture(fileunit,material_partTexture) write(6,*) 'parsing phase...' - call material_parsePhase(fileunit) + call material_parsePhase(fileunit,material_partPhase) close(fileunit) do i = 1,material_Nmicrostructure @@ -105,14 +109,14 @@ end subroutine !********************************************************************* -subroutine material_parseHomogenization(file) +subroutine material_parseHomogenization(file,myPart) !********************************************************************* use prec, only: pInt use IO implicit none - character(len=32), parameter :: myPart = 'homogenization' + character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 2 integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -161,14 +165,14 @@ subroutine material_parseHomogenization(file) !********************************************************************* -subroutine material_parseMicrostructure(file) +subroutine material_parseMicrostructure(file,myPart) !********************************************************************* use prec, only: pInt use IO implicit none - character(len=32), parameter :: myPart = 'microstructure' + character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 7 integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -231,14 +235,14 @@ subroutine material_parseMicrostructure(file) !********************************************************************* -subroutine material_parsePhase(file) +subroutine material_parsePhase(file,myPart) !********************************************************************* use prec, only: pInt use IO implicit none - character(len=32), parameter :: myPart = 'phase' + character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 2 integer(pInt), dimension(1+2*maxNchunks) :: positions @@ -246,7 +250,7 @@ subroutine material_parsePhase(file) character(len=64) tag character(len=1024) line - Nsections= IO_countSections(file,myPart) + Nsections = IO_countSections(file,myPart) material_Nphase = Nsections allocate(phase_name(Nsections)); phase_name = '' allocate(phase_constitution(Nsections)); phase_constitution = '' @@ -291,7 +295,7 @@ subroutine material_parsePhase(file) !********************************************************************* -subroutine material_parseTexture(file) +subroutine material_parseTexture(file,myPart) !********************************************************************* use prec, only: pInt, pReal @@ -299,7 +303,7 @@ subroutine material_parseTexture(file) use math, only: inRad implicit none - character(len=32), parameter :: myPart = 'texture' + character(len=*), intent(in) :: myPart integer(pInt), intent(in) :: file integer(pInt), parameter :: maxNchunks = 13 integer(pInt), dimension(1+2*maxNchunks) :: positions diff --git a/trunk/math.f90 b/trunk/math.f90 index 349706b7d..ece8d2d48 100644 --- a/trunk/math.f90 +++ b/trunk/math.f90 @@ -1210,7 +1210,7 @@ end subroutine real(pReal), intent(in) :: omega real(pReal), dimension(3) :: axisNrm real(pReal), dimension(3,3) :: math_RodrigToR - real(pReal) s,c + real(pReal) s,c,c1 integer(pInt) i forall (i=1:3) axisNrm(i) = axis(i)/dsqrt(math_mul3x3(axis,axis)) diff --git a/trunk/mpie_cpfem_marc2007r1.f90 b/trunk/mpie_cpfem_marc2007r1.f90 index 299a8d6f5..0813140d8 100644 --- a/trunk/mpie_cpfem_marc2007r1.f90 +++ b/trunk/mpie_cpfem_marc2007r1.f90 @@ -33,8 +33,8 @@ include "IO.f90" ! uses prec, debug, math include "FEsolving.f90" ! uses prec, IO include "mesh.f90" ! uses prec, IO, math, FEsolving - include "lattice.f90" ! uses prec, math include "material.f90" ! uses prec, math, IO, mesh + include "lattice.f90" ! uses prec, math include "constitutive_phenomenological.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 @@ -168,7 +168,9 @@ debug_InnerLoopDistribution = 0_pInt debug_OuterLoopDistribution = 0_pInt debug_cumLpTicks = 0 + debug_cumDotStateTicks = 0 debug_cumLpCalls = 0_pInt + debug_cumDotStateCalls = 0_pInt endif endif if (cptim > theTime .or. theInc /= inc) then ! reached convergence diff --git a/trunk/mpie_cpfem_marc2008r1.f90 b/trunk/mpie_cpfem_marc2008r1.f90 index 64af6b2b6..cc10a5a64 100644 --- a/trunk/mpie_cpfem_marc2008r1.f90 +++ b/trunk/mpie_cpfem_marc2008r1.f90 @@ -168,7 +168,9 @@ debug_InnerLoopDistribution = 0_pInt debug_OuterLoopDistribution = 0_pInt debug_cumLpTicks = 0 + debug_cumDotStateTicks = 0 debug_cumLpCalls = 0_pInt + debug_cumDotStateCalls = 0_pInt endif endif if (cptim > theTime .or. theInc /= inc) then ! reached convergence