From 2ca780743850a5911786711a272bad4670bae341 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 15 Oct 2018 22:29:23 +0200 Subject: [PATCH 01/23] cleavage systems avaialable as function --- src/lattice.f90 | 63 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 60 insertions(+), 3 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 996852a79..5d93ab003 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2126,9 +2126,7 @@ function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(charact case (2_pInt) ! <11.6>{-1-1.1} characteristicShear(ir) = 1.0_pReal/cOverA case (3_pInt) ! <10.-2>{10.1} - characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/4.0_pReal & - / sqrt(3.0_pReal)/cOverA - !characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/sqrt(48.0_pReal)/cOverA + characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/sqrt(48.0_pReal)/cOverA case (4_pInt) ! <11.-3>{11.2} characteristicShear(ir) = 2.0_pReal*(cOverA*cOverA-2.0_pReal)/3.0_pReal/cOverA end select @@ -2662,6 +2660,65 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) end function lattice_SchmidMatrix_twin +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates Schmid matrix for active cleavage systems +!-------------------------------------------------------------------------------------------------- +function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + math_trace33, & + math_tensorproduct33 + + implicit none + integer(pInt), dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix + real(pReal), intent(in) :: cOverA + + real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: cleavageSystems + integer(pInt), dimension(:), allocatable :: NcleavageMax + integer(pInt) :: i + + select case(structure) + case('iso') + NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE + case('ort') + NcleavageMax = LATTICE_ORTHO_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ORTHO_SYSTEMCLEAVAGE + case('fcc') + NcleavageMax = LATTICE_FCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_FCC_SYSTEMCLEAVAGE + case('bcc') + NcleavageMax = LATTICE_BCC_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_BCC_SYSTEMCLEAVAGE + case('hex','hexagonal') !ToDo: "No alias policy": long or short? + NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE + case default + call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_cleavage)') + end select + + if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Ncleavage '//trim(structure)) + if (any(Ncleavage < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Ncleavage '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) + + do i = 1, sum(Ncleavage) + SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + enddo + +end function lattice_SchmidMatrix_cleavage + + !-------------------------------------------------------------------------------------------------- !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- From f88b78195afafd6c428975b5352c9117a0f34502 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 26 Oct 2018 10:20:45 +0200 Subject: [PATCH 02/23] not need to repeat shape definition --- src/lattice.f90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 5d93ab003..094ca3409 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -433,7 +433,7 @@ module lattice ! 1, 1, 1, -3, 2, 1, & ! 1, 1,-1, 3,-2, 1, & ! 1,-1, 1, 3, 2,-1 & - ],pReal),[ 3_pInt + 3_pInt ,LATTICE_bcc_Nslip]) + ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & ['<1 -1 1>{0 1 1}', & @@ -454,7 +454,7 @@ module lattice 1,-1, 1, -1, 1, 2, & -1, 1, 1, 1,-1, 2, & 1, 1, 1, 1, 1,-2 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ntwin]) + ],pReal),shape(LATTICE_BCC_SYSTEMTWIN)) character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] @@ -489,7 +489,7 @@ module lattice 3,4,6,6,6,6,4,3,4,3,6,6, 6,5,6,3,3,5,6,6,6,1,5,6, & 6,6,4,3,3,4,6,6,3,4,6,6, 3,6,5,6,6,6,5,3,6,5,1,6, & 6,6,3,4,6,6,3,4,6,6,3,4, 6,3,6,5,6,6,3,5,5,6,6,1 & - ],pInt),[lattice_bcc_Nslip,lattice_bcc_Nslip],order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 + ],pInt),shape(LATTICE_BCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361–377 !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction @@ -523,7 +523,7 @@ module lattice 3,3,3,2,2,3,3,3,3,1,3,3, & 2,3,3,3,3,3,3,2,3,3,1,3, & 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),[LATTICE_bcc_Nslip,LATTICE_bcc_Ntwin],order=[2,1]) !< Slip--twin interaction types for bcc + ],pInt),shape(LATTICE_BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for bcc !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction @@ -544,7 +544,7 @@ module lattice 3,3,3,2,2,3,3,3,3,1,3,3, & 2,3,3,3,3,3,3,2,3,3,1,3, & 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),[LATTICE_bcc_Ntwin,LATTICE_bcc_Ntwin],order=[2,1]) !< Twin--twin interaction types for bcc + ],pInt),shape(LATTICE_BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for bcc !< 1: self interaction !< 2: collinear interaction !< 3: other interaction @@ -560,7 +560,7 @@ module lattice 1, 1, 1, -1, 0, 1, & -1, 1, 1, 1, 1, 0, & 1, 1, 1, -1, 1, 0 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ncleavage]) + ],pReal),shape(LATTICE_BCC_SYSTEMCLEAVAGE)) !-------------------------------------------------------------------------------------------------- ! hexagonal @@ -625,7 +625,7 @@ module lattice -2, 1, 1, 3, 2, -1, -1, 2, & 1, -2, 1, 3, -1, 2, -1, 2, & 1, 1, -2, 3, -1, -1, 2, 2 & - ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Nslip]) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + ],pReal),shape(LATTICE_HEX_SYSTEMSLIP)) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = & ['<1 1 . 1>{0 0 . 1} ', & @@ -665,7 +665,7 @@ module lattice -2, 1, 1, -3, -2, 1, 1, 2, & 1, -2, 1, -3, 1, -2, 1, 2, & 1, 1, -2, -3, 1, 1, -2, 2 & - ],pReal),[ 4_pInt + 4_pInt ,LATTICE_hex_Ntwin]) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 + ],pReal),shape(LATTICE_HEX_SYSTEMTWIN)) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = & ['<-1 0 . 1>{1 0 . 2} ', & @@ -742,7 +742,7 @@ module lattice 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & ! - ],pInt),[LATTICE_hex_Nslip,LATTICE_hex_Nslip],order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) + ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Ntwin), parameter, public :: & LATTICE_hex_interactionSlipTwin = reshape(int( [& @@ -785,7 +785,7 @@ module lattice 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & ! - ],pInt),[LATTICE_hex_Nslip,LATTICE_hex_Ntwin],order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) + ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Nslip), parameter, public :: & LATTICE_hex_interactionTwinSlip = reshape(int( [& @@ -816,7 +816,7 @@ module lattice 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & - ],pInt),[LATTICE_hex_Ntwin,LATTICE_hex_Nslip],order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) + ],pInt),shape(LATTICE_HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Ntwin), parameter, public :: & LATTICE_hex_interactionTwinTwin = reshape(int( [& @@ -847,7 +847,7 @@ module lattice 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & - ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin],order=[2,1]) !< Twin--slip interaction types for hex (isotropic, 16 in total) + ],pInt),shape(LATTICE_HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--slip interaction types for hex (isotropic, 16 in total) real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & LATTICE_hex_systemCleavage = reshape(real([& @@ -855,7 +855,7 @@ module lattice 2,-1,-1, 0, 0, 0, 0, 1, & 0, 0, 0, 1, 2,-1,-1, 0, & 0, 0, 0, 1, 0, 1,-1, 0 & - ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Ncleavage]) + ],pReal),shape(LATTICE_HEX_SYSTEMCLEAVAGE)) !-------------------------------------------------------------------------------------------------- From 8424ba76ac814bdea8f0405ad9e6f83d2f224006 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 20:54:49 +0100 Subject: [PATCH 03/23] never used --- src/lattice.f90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index bdb52bc8d..01df2a00a 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -52,8 +52,7 @@ module lattice lattice_st, & !< sd x sn lattice_sd, & !< slip direction of slip system lattice_Stwin_v, & - lattice_Strans_v, & !< Eigendeformation tensor in vector form - lattice_projectionTrans !< Matrix for projection of slip to fault-band (twin) systems for strain-induced martensite nucleation + lattice_Strans_v !< Eigendeformation tensor in vector form real(pReal), allocatable, dimension(:,:), protected, public :: & lattice_shearTwin, & !< characteristic twin shear @@ -1353,7 +1352,6 @@ subroutine lattice_init allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_Strans_v(6,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_projectionTrans(lattice_maxNtrans,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,Nphases),source=0_pInt) @@ -1701,8 +1699,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fccTohex_interactionSlipTrans lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fccTohex_interactionTransSlip lattice_interactionTransTrans(1:myNtrans,1:myNtrans,myPhase) = lattice_fccTohex_interactionTransTrans - lattice_projectionTrans(1:myNtrans,1:myNtrans,myPhase) = LATTICE_fccTobcc_projectionTrans*& - LATTICE_fccTobcc_projectionTransFactor !-------------------------------------------------------------------------------------------------- ! bcc From 1b571d33a76e8a59a0c3ac91011c6fb1996ab378 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 21:10:14 +0100 Subject: [PATCH 04/23] using trans-trans interactions from lattice --- src/lattice.f90 | 8 ++++++-- src/plastic_dislotwin.f90 | 26 ++++---------------------- 2 files changed, 10 insertions(+), 24 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 01df2a00a..49601d548 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1268,6 +1268,7 @@ real(pReal), dimension(4,36), parameter, private :: & lattice_interaction_TwinTwin, & lattice_interaction_SlipTwin, & lattice_interaction_TwinSlip, & + lattice_interaction_TransTrans, & lattice_characteristicShear_Twin contains @@ -2570,6 +2571,9 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targe if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then interactionTypes = lattice_fccToHex_interactionTransTrans NtransMax = lattice_fcc_Ntrans + elseif (trim(structure) == 'fcc' .and. trim(targetStructure) == 'bcc') then + interactionTypes = lattice_fccToHex_interactionTransTrans !< ToDo: The definition for bcc does not exist yet + NtransMax = lattice_fcc_Ntrans else call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure)) end if @@ -2827,7 +2831,7 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) normal = system(4:6,j) case ('hex') - !ToDo: check c/a ratio + !ToDo: check if c/a ratio is sensible ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) direction = [ system(1,j)*1.5_pReal, & (system(1,j)+2.0_pReal*system(2,j))*sqrt(0.75_pReal), & @@ -2839,7 +2843,7 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) system(8,j)/CoverA ] case ('bct') - !ToDo: check c/a ratio + !ToDo: check if c/a ratio is sensible direction = [system(1:2,j),system(3,i)*CoverA] normal = [system(4:5,j),system(6,i)/CoverA] diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 00534d251..475721c57 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -245,14 +245,6 @@ subroutine plastic_dislotwin_init(fileUnit) real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] - type(tParameters) :: & - prm - type(tDislotwinState) :: & - stt, & - dot - type(tDislotwinMicrostructure) :: & - mse - integer(kind(undefined_ID)) :: & outputID !< ID of each post result output @@ -411,7 +403,10 @@ subroutine plastic_dislotwin_init(fileUnit) prm%xc_trans = config_phase(p)%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? prm%L0_trans = config_phase(p)%getFloat('l0_trans') - prm%interaction_TransTrans = spread(config_phase(p)%getFloats('interaction_transtrans'),2,1) + prm%interaction_TransTrans = lattice_interaction_TransTrans(prm%Ntrans,& + config_phase(p)%getFloats('interaction_transtrans'), & + structure(1:3),& + trim(config_phase(p)%getString('trans_lattice_structure'))) if (lattice_structure(p) /= LATTICE_fcc_ID) then prm%Ndot0_trans = config_phase(p)%getFloats('ndot0_trans') prm%Ndot0_trans = math_expand(prm%Ndot0_trans,prm%Ntrans) @@ -651,7 +646,6 @@ subroutine plastic_dislotwin_init(fileUnit) allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) - allocate(temp2(prm%totalNtrans,prm%totalNtrans), source =0.0_pReal) allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) i = 0_pInt @@ -675,21 +669,9 @@ subroutine plastic_dislotwin_init(fileUnit) sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & p) ,1 ) enddo; enddo - - do o = 1_pInt,size(prm%Ntrans,1) - index_otherFamily = sum(prm%Ntrans(1:o-1_pInt)) - do k = 1_pInt,prm%Ntrans(o) ! loop over (active) systems in other family (trans) - temp2(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TransTrans(lattice_interactionTransTrans( & - sum(lattice_NtransSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtransSystem(1:o-1_pInt,p))+k, & - p),1 ) - enddo; enddo - enddo transSystemsLoop enddo transFamiliesLoop prm%interaction_TransSlip = temp1; deallocate(temp1) - prm%interaction_TransTrans = temp2; deallocate(temp2) startIndex=1_pInt endIndex=prm%totalNslip From 95826d094c4ff60a8eff7f554a7da1faa574b604 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 22:00:04 +0100 Subject: [PATCH 05/23] not needed anymore --- src/lattice.f90 | 33 ++------------------------------- 1 file changed, 2 insertions(+), 31 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 49601d548..d55049808 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -28,12 +28,9 @@ module lattice integer(pInt), allocatable, dimension(:,:,:), protected, public :: & lattice_interactionSlipSlip, & !< Slip--slip interaction type - lattice_interactionSlipTwin, & !< Slip--twin interaction type - lattice_interactionTwinSlip, & !< Twin--slip interaction type - lattice_interactionTwinTwin, & !< Twin--twin interaction type lattice_interactionSlipTrans, & !< Slip--trans interaction type - lattice_interactionTransSlip, & !< Trans--slip interaction type - lattice_interactionTransTrans !< Trans--trans interaction type + lattice_interactionTransSlip !< Trans--slip interaction type + real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Sslip, & !< Schmid and non-Schmid matrices @@ -44,14 +41,12 @@ module lattice lattice_Scleavage_v, & !< Mandel notation of lattice_Scleavege lattice_Qtrans, & !< Total rotation: Q = R*B lattice_Strans, & !< Eigendeformation tensor for phase transformation - lattice_Stwin, & lattice_Qtwin real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system lattice_st, & !< sd x sn lattice_sd, & !< slip direction of slip system - lattice_Stwin_v, & lattice_Strans_v !< Eigendeformation tensor in vector form real(pReal), allocatable, dimension(:,:), protected, public :: & @@ -1344,8 +1339,6 @@ subroutine lattice_init allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Qtwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_Stwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_Stwin_v(6,lattice_maxNtwin,Nphases),source=0.0_pReal) allocate(lattice_shearTwin(lattice_maxNtwin,Nphases),source=0.0_pReal) allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) @@ -1360,12 +1353,8 @@ subroutine lattice_init allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionSlipTwin(lattice_maxNslip,lattice_maxNtwin,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTwinSlip(lattice_maxNtwin,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTwinTwin(lattice_maxNtwin,lattice_maxNtwin,Nphases),source=0_pInt) ! other:me allocate(lattice_interactionSlipTrans(lattice_maxNslip,lattice_maxNtrans,Nphases),source=0_pInt) ! other:me allocate(lattice_interactionTransSlip(lattice_maxNtrans,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTransTrans(lattice_maxNtrans,lattice_maxNtrans,Nphases),source=0_pInt) ! other:me allocate(CoverA(Nphases),source=0.0_pReal) allocate(CoverA_trans(Nphases),source=0.0_pReal) @@ -1694,12 +1683,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem lattice_NnonSchmid(myPhase) = lattice_fcc_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_fcc_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_fcc_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_fcc_interactionTwinTwin lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fccTohex_interactionSlipTrans lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fccTohex_interactionTransSlip - lattice_interactionTransTrans(1:myNtrans,1:myNtrans,myPhase) = lattice_fccTohex_interactionTransTrans !-------------------------------------------------------------------------------------------------- ! bcc @@ -1746,9 +1731,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_bcc_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_bcc_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_bcc_interactionTwinTwin !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) @@ -1803,9 +1785,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem lattice_NnonSchmid(myPhase) = lattice_hex_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip - lattice_interactionSlipTwin(1:myNslip,1:myNtwin,myPhase) = lattice_hex_interactionSlipTwin - lattice_interactionTwinSlip(1:myNtwin,1:myNslip,myPhase) = lattice_hex_interactionTwinSlip - lattice_interactionTwinTwin(1:myNtwin,1:myNtwin,myPhase) = lattice_hex_interactionTwinTwin !-------------------------------------------------------------------------------------------------- ! bct @@ -1882,17 +1861,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_td(1:3,i,myPhase) = td(1:3,i)/norm2(td(1:3,i)) ! make unit vector lattice_tn(1:3,i,myPhase) = tn(1:3,i)/norm2(tn(1:3,i)) ! make unit vector - lattice_tt(1:3,i,myPhase) = math_crossproduct(lattice_td(1:3,i,myPhase), & - lattice_tn(1:3,i,myPhase)) - lattice_Stwin(1:3,1:3,i,myPhase) = math_tensorproduct33(lattice_td(1:3,i,myPhase), & - lattice_tn(1:3,i,myPhase)) - lattice_Stwin_v(1:6,i,myPhase) = math_Mandel33to6(math_symmetric33(lattice_Stwin(1:3,1:3,i,myPhase))) lattice_Qtwin(1:3,1:3,i,myPhase) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) lattice_shearTwin(i,myPhase) = ts(i) - if (abs(math_trace33(lattice_Stwin(1:3,1:3,i,myPhase))) > tol_math_check) & - call IO_error(301_pInt,myPhase,ext_msg = 'dilatational twin Schmid matrix') enddo do i = 1_pInt,myNtrans lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) From 0f106e77d99313d60e3dd3029d10dafba0a02183 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 9 Dec 2018 22:20:18 +0100 Subject: [PATCH 06/23] cleaning --- src/lattice.f90 | 43 ++++++--------------------------------- src/plastic_dislotwin.f90 | 9 ++++---- 2 files changed, 11 insertions(+), 41 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index d55049808..69b0de5a6 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -50,16 +50,11 @@ module lattice lattice_Strans_v !< Eigendeformation tensor in vector form real(pReal), allocatable, dimension(:,:), protected, public :: & - lattice_shearTwin, & !< characteristic twin shear lattice_shearTrans !< characteristic transformation shear integer(pInt), allocatable, dimension(:), protected, public :: & lattice_NnonSchmid !< total # of non-Schmid contributions for each structure - real(pReal), allocatable, dimension(:,:,:), private :: & - lattice_tn, & - lattice_td, & - lattice_tt ! END DEPRECATED @@ -1340,7 +1335,6 @@ subroutine lattice_init allocate(lattice_Qtwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_shearTwin(lattice_maxNtwin,Nphases),source=0.0_pReal) allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) @@ -1361,9 +1355,6 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - allocate(lattice_td(3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_tt(3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_tn(3,lattice_maxNtwin,Nphases),source=0.0_pReal) allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_sn(3,lattice_maxNslip,Nphases),source=0.0_pReal) @@ -1518,8 +1509,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sns real(pReal), dimension(3,lattice_maxNtwin) :: & td, tn - real(pReal), dimension(lattice_maxNtwin) :: & - ts real(pReal), dimension(lattice_maxNtrans) :: & trs real(pReal), dimension(3,lattice_maxNtrans) :: & @@ -1622,9 +1611,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1:3,i) = lattice_fcc_systemTwin(1:3,i) tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) - ts(i) = lattice_fcc_shearTwin(i) enddo do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) @@ -1716,9 +1703,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sns(1:3,1:3,2,6,i) = math_tensorproduct33(-sdU, -sdU) enddo do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1:3,i) = lattice_bcc_systemTwin(1:3,i) tn(1:3,i) = lattice_bcc_systemTwin(4:6,i) - ts(i) = lattice_bcc_shearTwin(i) enddo do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_bcc_systemCleavage(1:3,i)/norm2(lattice_bcc_systemCleavage(1:3,i)) @@ -1749,23 +1734,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA enddo do i = 1_pInt,myNtwin ! assign twin system vectors and shears - td(1,i) = lattice_hex_systemTwin(1,i)*1.5_pReal - td(2,i) = (lattice_hex_systemTwin(1,i)+2.0_pReal*lattice_hex_systemTwin(2,i))*& - 0.5_pReal*sqrt(3.0_pReal) - td(3,i) = lattice_hex_systemTwin(4,i)*CoverA tn(1,i) = lattice_hex_systemTwin(5,i) tn(2,i) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) tn(3,i) = lattice_hex_systemTwin(8,i)/CoverA - select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 - case (1_pInt) ! <-10.1>{10.2} - ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA - case (2_pInt) ! <11.6>{-1-1.1} - ts(i) = 1.0_pReal/CoverA - case (3_pInt) ! <10.-2>{10.1} - ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA - case (4_pInt) ! <11.-3>{11.2} - ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA - end select enddo do i = 1_pInt, myNcleavage ! cleavage system vectors cd(1,i) = lattice_hex_systemCleavage(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] @@ -1861,9 +1832,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_tn(1:3,i,myPhase) = tn(1:3,i)/norm2(tn(1:3,i)) ! make unit vector lattice_Qtwin(1:3,1:3,i,myPhase) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) - lattice_shearTwin(i,myPhase) = ts(i) enddo do i = 1_pInt,myNtrans lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) @@ -2181,7 +2150,7 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) lattice_C66_twin(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) enddo -end function +end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- @@ -2716,11 +2685,11 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) - do i = 1, sum(Ncleavage) - SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) - enddo + do i = 1, sum(Ncleavage) + SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + enddo end function lattice_SchmidMatrix_cleavage diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 475721c57..0913feb44 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -239,7 +239,7 @@ subroutine plastic_dislotwin_init(fileUnit) integer(pInt) :: sizeState, sizeDotState integer(pInt) :: NipcMyPhase - real(pReal), allocatable, dimension(:,:) :: temp1,temp2 + real(pReal), allocatable, dimension(:,:) :: temp1 integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] @@ -371,6 +371,9 @@ subroutine plastic_dislotwin_init(fileUnit) prm%Cthresholdtwin = config_phase(p)%getFloat('cthresholdtwin', defaultVal=0.0_pReal) prm%Cmfptwin = config_phase(p)%getFloat('cmfptwin', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%shear_twin = lattice_characteristicShear_Twin(prm%Ntwin,structure(1:3),& + config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + if (.not. prm%isFCC) then prm%Ndot0_twin = config_phase(p)%getFloats('ndot0_twin') @@ -627,13 +630,11 @@ subroutine plastic_dislotwin_init(fileUnit) allocate(prm%C66_twin(6,6,prm%totalNtwin), source=0.0_pReal) if (lattice_structure(p) == LATTICE_fcc_ID) & allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0_pInt) - allocate(prm%shear_twin(prm%totalNtwin),source = 0.0_pReal) i = 0_pInt twinFamiliesLoop: do f = 1_pInt, size(prm%Ntwin,1) index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) ! index in truncated twin system list twinSystemsLoop: do j = 1_pInt,prm%Ntwin(f) i = i + 1_pInt - prm%shear_twin(i) = lattice_shearTwin(sum(lattice_Ntwinsystem(1:f-1,p))+j,p) if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = & lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j) !* Rotate twin elasticity matrices @@ -644,7 +645,7 @@ subroutine plastic_dislotwin_init(fileUnit) enddo twinSystemsLoop enddo twinFamiliesLoop - + allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) From efbd50c9318fda9ce26347d70d96baeff8998b62 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Dec 2018 05:52:36 +0100 Subject: [PATCH 07/23] parameters in bold allow easy distinction --- src/lattice.f90 | 82 ++++++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 42 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 69b0de5a6..062e67977 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -73,13 +73,13 @@ module lattice LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc + LATTICE_FCC_NSLIP = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc + LATTICE_FCC_NTWIN = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc - real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& ! Slip direction Plane normal ! SCHMID-BOAS notation 0, 1,-1, 1, 1, 1, & ! B2 @@ -107,7 +107,7 @@ module lattice ['<0 1 -1>{1 1 1}', & '<0 1 -1>{0 1 1}'] - real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: & LATTICE_fcc_systemTwin = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & @@ -142,11 +142,11 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) - real(pReal), dimension(LATTICE_fcc_Ntwin), parameter, private :: & + real(pReal), dimension(LATTICE_FCC_NTWIN), parameter, private :: & LATTICE_fcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) !< Twin system <112>{111} ??? Sorted according to Eisenlohr & Hantcherli - integer(pInt), dimension(2_pInt,LATTICE_fcc_Ntwin), parameter, public :: & - LATTICE_fcc_twinNucleationSlipPair = reshape(int( [& + integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & + LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& 2,3, & 1,3, & 1,2, & @@ -161,8 +161,8 @@ module lattice 10,11 & ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) - integer(pInt), dimension(LATTICE_fcc_Nslip,lattice_fcc_Nslip), parameter, public :: & - LATTICE_fcc_interactionSlipSlip = reshape(int( [& + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, public :: & + LATTICE_FCC_INTERACTIONSLIPSLIP = reshape(int( [& 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip 2, 1, 2, 6, 4, 5, 5, 4, 6, 5, 3, 5, 9,10,11,12, 9,10, & ! | 2, 2, 1, 5, 5, 3, 5, 6, 4, 6, 5, 4, 11,12, 9,10, 9,10, & ! | @@ -182,7 +182,7 @@ module lattice 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & - ],pInt),[LATTICE_fcc_Nslip,LATTICE_fcc_Nslip],order=[2,1]) !< Slip--slip interaction types for fcc + ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for fcc !< 1: self interaction !< 2: coplanar interaction !< 3: collinear interaction @@ -195,8 +195,8 @@ module lattice !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - integer(pInt), dimension(LATTICE_fcc_Nslip,LATTICE_fcc_Ntwin), parameter, public :: & - LATTICE_fcc_interactionSlipTwin = reshape(int( [& + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter, public :: & + LATTICE_FCC_INTERACTIONSLIPTWIN = reshape(int( [& 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin 1,1,1,3,3,3,3,3,3,2,2,2, & ! | 1,1,1,2,2,2,3,3,3,3,3,3, & ! | @@ -220,11 +220,11 @@ module lattice !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction - integer(pInt), dimension(LATTICE_fcc_Ntwin,LATTICE_fcc_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter, public :: & LATTICE_fcc_interactionTwinSlip = 1_pInt !< Twin--Slip interaction types for fcc - integer(pInt), dimension(LATTICE_fcc_Ntwin,LATTICE_fcc_Ntwin), parameter,public :: & - LATTICE_fcc_interactionTwinTwin = reshape(int( [& + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter,public :: & + LATTICE_FCC_INTERACTIONTWINTWIN = reshape(int( [& 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin 1,1,1,2,2,2,2,2,2,2,2,2, & ! | 1,1,1,2,2,2,2,2,2,2,2,2, & ! | @@ -239,8 +239,8 @@ module lattice 2,2,2,2,2,2,2,2,2,1,1,1 & ],pInt),shape(LATTICE_FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for fcc - integer(pInt), dimension(LATTICE_fcc_Nslip,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_fccTohex_interactionSlipTrans = reshape(int( [& + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter, public :: & + LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS = reshape(int( [& 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans 1,1,1,3,3,3,3,3,3,2,2,2, & ! | 1,1,1,2,2,2,3,3,3,3,3,3, & ! | @@ -262,7 +262,7 @@ module lattice 4,4,4,4,4,4,4,4,4,4,4,4 & ],pInt),shape(LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc - integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_FCC_NSLIP), parameter, public :: & LATTICE_fccTohex_interactionTransSlip = 1_pInt !< Trans--Slip interaction types for fcc integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter,public :: & @@ -285,7 +285,7 @@ module lattice LATTICE_fccTohex_shearTrans = sqrt(1.0_pReal/8.0_pReal) real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_systemTrans = reshape([& + LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) 0.0, 1.0, 0.0, -10.26, & 0.0, 0.0, 1.0, 10.26, & @@ -301,7 +301,7 @@ module lattice ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) integer(pInt), dimension(9,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_bainVariant = reshape(int( [& + LATTICE_FCCTOBCC_BAINVARIANT = reshape(int( [& 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) 1, 0, 0, 0, 1, 0, 0, 0, 1, & 1, 0, 0, 0, 1, 0, 0, 0, 1, & @@ -317,7 +317,7 @@ module lattice ],pInt),shape(LATTICE_FCCTOBCC_BAINVARIANT)) real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTobcc_bainRot = reshape([& + LATTICE_FCCTOBCC_BAINROT = reshape([& 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant 1.0, 0.0, 0.0, 45.0, & 1.0, 0.0, 0.0, 45.0, & @@ -333,7 +333,7 @@ module lattice ],shape(LATTICE_FCCTOBCC_BAINROT)) real(pReal), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter, private :: & ! Matrix for projection of shear from slip system to fault-band (twin) systems - LATTICE_fccTobcc_projectionTrans = reshape(real([& ! For ns = nt = nr + LATTICE_FCCTOBCC_PROJECTIONTRANS = reshape(real([& ! For ns = nt = nr 0, 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & @@ -355,7 +355,7 @@ module lattice LATTICE_fccTobcc_shearCritTrans = 0.0224 integer(pInt), dimension(2_pInt,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_fccTobcc_transNucleationTwinPair = reshape(int( [& + LATTICE_FCCTOBCC_TRANSNUCLEATIONTWINPAIR = reshape(int( [& 4, 7, & 1, 10, & 1, 4, & @@ -397,13 +397,13 @@ module lattice LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_bcc_Ntwin = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_BCC_NSLIP = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc + LATTICE_BCC_NTWIN = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc - real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & LATTICE_bcc_systemSlip = reshape(real([& ! Slip direction Plane normal ! Slip system <111>{110} @@ -463,7 +463,7 @@ module lattice ['<1 -1 1>{0 1 1}', & '<1 -1 1>{2 1 1}'] - real(pReal), dimension(3+3,LATTICE_bcc_Ntwin), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: & LATTICE_bcc_systemTwin = reshape(real([& ! Twin system <111>{112} -1, 1, 1, 2, 1, 1, & @@ -483,10 +483,10 @@ module lattice character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - real(pReal), dimension(LATTICE_bcc_Ntwin), parameter, private :: & + real(pReal), dimension(LATTICE_BCC_NTWIN), parameter, private :: & LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) - integer(pInt), dimension(LATTICE_bcc_Nslip,LATTICE_bcc_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, public :: & LATTICE_bcc_interactionSlipSlip = reshape(int( [& 1,2,6,6,5,4,4,3,4,3,5,4, 6,6,4,3,3,4,6,6,4,3,6,6, & ! ---> slip 2,1,6,6,4,3,5,4,5,4,4,3, 6,6,3,4,4,3,6,6,3,4,6,6, & ! | @@ -520,7 +520,7 @@ module lattice !< 4: mixed-asymmetrical junction !< 5: mixed-symmetrical junction !< 6: edge junction - integer(pInt), dimension(LATTICE_bcc_Nslip,LATTICE_bcc_Ntwin), parameter, public :: & + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter, public :: & LATTICE_bcc_interactionSlipTwin = reshape(int( [& 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin 3,3,2,3,3,2,3,3,2,3,3,3, & ! | @@ -551,10 +551,10 @@ module lattice !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction - integer(pInt), dimension(LATTICE_bcc_Ntwin,LATTICE_bcc_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter, public :: & LATTICE_bcc_interactionTwinSlip = 1_pInt !< Twin--slip interaction types for bcc @todo not implemented yet - integer(pInt), dimension(LATTICE_bcc_Ntwin,LATTICE_bcc_Ntwin), parameter, public :: & + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter, public :: & LATTICE_bcc_interactionTwinTwin = reshape(int( [& 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin 3,1,3,3,3,3,2,3,3,3,3,2, & ! | @@ -1117,9 +1117,9 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & - LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_hex_Nslip, & LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_maxNtwin = max(LATTICE_FCC_NTWIN,LATTICE_BCC_NTWIN,LATTICE_hex_Ntwin, & LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & @@ -1259,7 +1259,8 @@ real(pReal), dimension(4,36), parameter, private :: & lattice_interaction_SlipTwin, & lattice_interaction_TwinSlip, & lattice_interaction_TransTrans, & - lattice_characteristicShear_Twin + lattice_characteristicShear_Twin, & + lattice_C66_twin contains @@ -1602,8 +1603,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) !-------------------------------------------------------------------------------------------------- ! fcc case (LATTICE_fcc_ID) - myNslip = lattice_fcc_Nslip - myNtwin = lattice_fcc_Ntwin + myNslip = LATTICE_FCC_NSLIP + myNtwin = LATTICE_FCC_NTWIN myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage do i = 1_pInt,myNslip ! assign slip system vectors @@ -1676,8 +1677,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) !-------------------------------------------------------------------------------------------------- ! bcc case (LATTICE_bcc_ID) - myNslip = lattice_bcc_Nslip - myNtwin = lattice_bcc_Ntwin + myNslip = LATTICE_BCC_NSLIP + myNtwin = LATTICE_BCC_NTWIN myNtrans = lattice_bcc_Ntrans myNcleavage = lattice_bcc_Ncleavage do i = 1_pInt,myNslip ! assign slip system vectors @@ -2149,7 +2150,6 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? lattice_C66_twin(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) enddo - end function lattice_C66_twin @@ -2520,9 +2520,7 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targe !if (size(interactionValues) > maxval(interactionTypes)) & ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) - end function lattice_interaction_TransTrans From 51d8011afeb28748016df900746fb2d9aef39235 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Dec 2018 08:33:20 +0100 Subject: [PATCH 08/23] cleaned - only define variables that are needed - define variables where they are needed --- src/lattice.f90 | 703 ++++++++++++++++++++---------------------------- 1 file changed, 298 insertions(+), 405 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 062e67977..0b99bbc45 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,13 +16,11 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures - LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & lattice_NslipSystem, & !< total # of slip systems in each family - lattice_NtwinSystem, & !< total # of twin systems in each family lattice_NtransSystem, & !< total # of transformation systems in each family lattice_NcleavageSystem !< total # of transformation systems in each family @@ -31,7 +29,6 @@ module lattice lattice_interactionSlipTrans, & !< Slip--trans interaction type lattice_interactionTransSlip !< Trans--slip interaction type - real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Sslip, & !< Schmid and non-Schmid matrices lattice_Scleavage !< Schmid matrices for cleavage systems @@ -40,14 +37,12 @@ module lattice lattice_Sslip_v, & !< Mandel notation of lattice_Sslip lattice_Scleavage_v, & !< Mandel notation of lattice_Scleavege lattice_Qtrans, & !< Total rotation: Q = R*B - lattice_Strans, & !< Eigendeformation tensor for phase transformation - lattice_Qtwin + lattice_Strans !< Eigendeformation tensor for phase transformation real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system lattice_st, & !< sd x sn - lattice_sd, & !< slip direction of slip system - lattice_Strans_v !< Eigendeformation tensor in vector form + lattice_sd !< slip direction of slip system real(pReal), allocatable, dimension(:,:), protected, public :: & lattice_shearTrans !< characteristic transformation shear @@ -63,8 +58,8 @@ module lattice integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & LATTICE_fcc_NslipSystem = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc + integer(pInt), dimension(1), parameter, public :: & + LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc @@ -74,8 +69,7 @@ module lattice integer(pInt), parameter, private :: & LATTICE_FCC_NSLIP = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_FCC_NTWIN = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc - LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc + LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc @@ -195,49 +189,10 @@ module lattice !<10: similar to glissile junctions in <110>{111} btw one {110} and one {111} plane !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter, public :: & - LATTICE_FCC_INTERACTIONSLIPTWIN = reshape(int( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for fcc - !< 1: coplanar interaction - !< 2: screw trace between slip system and twin habit plane (easy cross slip) - !< 3: other interaction - integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter, public :: & - LATTICE_fcc_interactionTwinSlip = 1_pInt !< Twin--Slip interaction types for fcc - integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter,public :: & - LATTICE_FCC_INTERACTIONTWINTWIN = reshape(int( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 2,2,2,1,1,1,2,2,2,2,2,2, & ! v twin - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(LATTICE_FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for fcc + + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter, public :: & LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS = reshape(int( [& @@ -387,20 +342,16 @@ module lattice integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & LATTICE_bcc_NslipSystem = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc + integer(pInt), dimension(1), parameter, public :: & + LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & LATTICE_BCC_NSLIP = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_BCC_NTWIN = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) - LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: & @@ -520,58 +471,7 @@ module lattice !< 4: mixed-asymmetrical junction !< 5: mixed-symmetrical junction !< 6: edge junction - integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter, public :: & - LATTICE_bcc_interactionSlipTwin = reshape(int( [& - 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin - 3,3,2,3,3,2,3,3,2,3,3,3, & ! | - 3,2,3,3,3,3,2,3,3,3,3,2, & ! | - 2,3,3,3,3,3,3,2,3,3,2,3, & ! v slip - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,2,3,3,2,3,3,2,3,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 2,3,3,3,3,3,3,2,3,3,2,3, & - 3,3,3,2,2,3,3,3,3,2,3,3, & - 3,2,3,3,3,3,2,3,3,3,3,2, & - 3,3,2,3,3,2,3,3,2,3,3,3, & - ! - 1,3,3,3,3,3,3,2,3,3,2,3, & - 3,1,3,3,3,3,2,3,3,3,3,2, & - 3,3,1,3,3,2,3,3,2,3,3,3, & - 3,3,3,1,2,3,3,3,3,2,3,3, & - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),shape(LATTICE_BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for bcc - !< 1: coplanar interaction - !< 2: screw trace between slip system and twin habit plane (easy cross slip) - !< 3: other interaction - integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter, public :: & - LATTICE_bcc_interactionTwinSlip = 1_pInt !< Twin--slip interaction types for bcc @todo not implemented yet - integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter, public :: & - LATTICE_bcc_interactionTwinTwin = reshape(int( [& - 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin - 3,1,3,3,3,3,2,3,3,3,3,2, & ! | - 3,3,1,3,3,2,3,3,2,3,3,3, & ! | - 3,3,3,1,2,3,3,3,3,2,3,3, & ! v twin - 3,3,3,2,1,3,3,3,3,2,3,3, & - 3,3,2,3,3,1,3,3,2,3,3,3, & - 3,2,3,3,3,3,1,3,3,3,3,2, & - 2,3,3,3,3,3,3,1,3,3,2,3, & - 3,3,2,3,3,2,3,3,1,3,3,3, & - 3,3,3,2,2,3,3,3,3,1,3,3, & - 2,3,3,3,3,3,3,2,3,3,1,3, & - 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),shape(LATTICE_BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for bcc - !< 1: self interaction - !< 2: collinear interaction - !< 3: other interaction real(pReal), dimension(3+3,LATTICE_bcc_Ncleavage), parameter, private :: & LATTICE_bcc_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -591,20 +491,15 @@ module lattice integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex + integer(pInt), dimension(4), parameter, public :: & + LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex - LATTICE_hex_Ntwin = sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex - LATTICE_hex_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex - LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex + LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & @@ -768,110 +663,8 @@ module lattice ! ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) - integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Ntwin), parameter, public :: & - LATTICE_hex_interactionSlipTwin = reshape(int( [& - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | - ! v - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & - ! - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & - ! - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & - ! - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & - ! - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & - 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & - ! - ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) - integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Nslip), parameter, public :: & - LATTICE_hex_interactionTwinSlip = reshape(int( [& - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin - 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & - ! - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & - ! - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & - ! - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & - 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & - ],pInt),shape(LATTICE_HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) - integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Ntwin), parameter, public :: & - LATTICE_hex_interactionTwinTwin = reshape(int( [& - 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! ---> twin - 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | - 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | - 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! v twin - 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & - ! - 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & - ! - 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & - 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & - ! - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & - 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & - ],pInt),shape(LATTICE_HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--slip interaction types for hex (isotropic, 16 in total) real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & LATTICE_hex_systemCleavage = reshape(real([& @@ -887,21 +680,8 @@ module lattice integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & LATTICE_bct_NslipSystem = int([2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ],pInt) !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009 - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct - - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct - integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct - LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct - LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct - LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct - LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct + LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem) !< total # of slip systems for bct real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_systemSlip = reshape(real([& @@ -1059,23 +839,10 @@ module lattice !-------------------------------------------------------------------------------------------------- ! isotropic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_iso_NslipSystem = int([0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ],pInt) !< # of slip systems per family for iso - - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & - LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso - LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso - LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso - LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: & @@ -1088,23 +855,10 @@ module lattice !-------------------------------------------------------------------------------------------------- ! orthorhombic - integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_ortho_NslipSystem = int([0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ],pInt) !< # of slip systems per family for ortho - - integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & - LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho - - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho - integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho - LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho - LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho - LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & @@ -1118,43 +872,14 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_hex_Nslip, & - LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = max(LATTICE_FCC_NTWIN,LATTICE_BCC_NTWIN,LATTICE_hex_Ntwin, & - LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & - LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & - LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & - LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures + LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures + LATTICE_maxNnonSchmid = LATTICE_bcc_NnonSchmid, & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = LATTICE_fcc_Ntrans, & !< max # of transformation systems over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & - LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_hex_Ncleavage, & LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures -#if defined(__GFORTRAN__) - ! only supported in gcc 8 LATTICE_maxNinteraction = 182_pInt -#else - LATTICE_maxNinteraction = max(& - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & - ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & - !maxval(lattice_bct_interactionSlipTwin), & - ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & - !maxval(lattice_bct_interactionTwinSlip), & - ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin) & - !maxval(lattice_bct_interactionTwinTwin))) - ) !< max # of interaction types (in hardening matrix part) -#endif + !END DEPRECATED real(pReal), dimension(:,:,:), allocatable, private :: & temp66 @@ -1166,6 +891,8 @@ module lattice lattice_mu, lattice_nu real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & ! with higher-order parameters (e.g. temperature-dependent) lattice_thermalExpansion33 + +! SHOULD NOT BE PART OF LATTICE BEGIN real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_thermalConductivity33, & lattice_damageDiffusion33, & @@ -1188,6 +915,7 @@ module lattice lattice_referenceTemperature, & lattice_equilibriumVacancyConcentration, & lattice_equilibriumHydrogenConcentration +! SHOULD NOT BE PART OF LATTICE END enum, bind(c) enumerator :: LATTICE_undefined_ID, & LATTICE_iso_ID, & @@ -1200,49 +928,7 @@ module lattice integer(kind(LATTICE_undefined_ID)), dimension(:), allocatable, public, protected :: & lattice_structure, trans_lattice_structure - integer(pInt), dimension(2), parameter, private :: & - lattice_NsymOperations = [24_pInt,12_pInt] -real(pReal), dimension(4,36), parameter, private :: & - lattice_symOperations = reshape([& - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry - -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & - -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & -! - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry - 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & - 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & - 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry - -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & - 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & - 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & - ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 public :: & lattice_init, & @@ -1334,16 +1020,12 @@ subroutine lattice_init allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) - allocate(lattice_Qtwin(3,3,lattice_maxNtwin,Nphases),source=0.0_pReal) - allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Strans_v(6,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) - allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,Nphases),source=0_pInt) allocate(lattice_NtransSystem(lattice_maxNtransFamily,Nphases),source=0_pInt) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) @@ -1508,8 +1190,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sd, sn real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: & sns - real(pReal), dimension(3,lattice_maxNtwin) :: & - td, tn real(pReal), dimension(lattice_maxNtrans) :: & trs real(pReal), dimension(3,lattice_maxNtrans) :: & @@ -1520,7 +1200,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) cd, cn, ct integer(pInt) :: & i,j, & - myNslip = 0_pInt, myNtwin = 0_pInt, myNtrans = 0_pInt, myNcleavage = 0_pInt + myNslip = 0_pInt, myNtrans = 0_pInt, myNcleavage = 0_pInt real(pReal) :: c11bar, c12bar, c13bar, c14bar, c33bar, c44bar, A, B lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& @@ -1604,16 +1284,12 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! fcc case (LATTICE_fcc_ID) myNslip = LATTICE_FCC_NSLIP - myNtwin = LATTICE_FCC_NTWIN myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) - enddo do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) @@ -1666,10 +1342,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) end select lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_fcc_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_fcc_NtransSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_fcc_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fccTohex_interactionSlipTrans lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fccTohex_interactionTransSlip @@ -1678,8 +1351,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! bcc case (LATTICE_bcc_ID) myNslip = LATTICE_BCC_NSLIP - myNtwin = LATTICE_BCC_NTWIN - myNtrans = lattice_bcc_Ntrans + myNtrans = 0_pInt myNcleavage = lattice_bcc_Ncleavage do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) @@ -1703,17 +1375,12 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sns(1:3,1:3,1,6,i) = math_tensorproduct33(sdU, sdU) sns(1:3,1:3,2,6,i) = math_tensorproduct33(-sdU, -sdU) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - tn(1:3,i) = lattice_bcc_systemTwin(4:6,i) - enddo do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_bcc_systemCleavage(1:3,i)/norm2(lattice_bcc_systemCleavage(1:3,i)) cn(1:3,i) = lattice_bcc_systemCleavage(4:6,i)/norm2(lattice_bcc_systemCleavage(4:6,i)) ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) enddo lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_bcc_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_bcc_NtransSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip @@ -1722,8 +1389,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) myNslip = lattice_hex_Nslip - myNtwin = lattice_hex_Ntwin - myNtrans = lattice_hex_Ntrans + myNtrans = 0_pInt myNcleavage = lattice_hex_Ncleavage do i = 1_pInt,myNslip ! assign slip system vectors sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] @@ -1734,11 +1400,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears - tn(1,i) = lattice_hex_systemTwin(5,i) - tn(2,i) = (lattice_hex_systemTwin(5,i)+2.0_pReal*lattice_hex_systemTwin(6,i))/sqrt(3.0_pReal) - tn(3,i) = lattice_hex_systemTwin(8,i)/CoverA - enddo do i = 1_pInt, myNcleavage ! cleavage system vectors cd(1,i) = lattice_hex_systemCleavage(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] cd(2,i) = (lattice_hex_systemCleavage(1,i)+2.0_pReal*lattice_hex_systemCleavage(2,i))*& @@ -1752,18 +1413,15 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) enddo lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_hex_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_hex_NtransSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_hex_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! bct case (LATTICE_bct_ID) + myNtrans = 0_pInt myNslip = lattice_bct_Nslip - myNtwin = lattice_bct_Ntwin - myNcleavage = lattice_bct_Ncleavage + myNcleavage = 0_pInt do i = 1_pInt,myNslip ! assign slip system vectors sd(1:2,i) = lattice_bct_systemSlip(1:2,i) sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA @@ -1773,17 +1431,12 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) snU = sn(1:3,i) / norm2(sn(1:3,i)) enddo lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem - lattice_NtwinSystem(1:lattice_maxNtwinFamily,myPhase) = lattice_bct_NtwinSystem - lattice_NtransSystem(1:lattice_maxNtransFamily,myPhase) = lattice_bct_NtransSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bct_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_bct_NnonSchmid lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! orthorhombic (no crystal plasticity) case (LATTICE_ort_ID) myNslip = 0_pInt - myNtwin = 0_pInt myNtrans = 0_pInt myNcleavage = lattice_ortho_Ncleavage do i = 1_pInt, myNcleavage ! assign cleavage system vectors @@ -1797,7 +1450,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! isotropic (no crystal plasticity) case (LATTICE_iso_ID) myNslip = 0_pInt - myNtwin = 0_pInt myNtrans = 0_pInt myNcleavage = lattice_iso_Ncleavage do i = 1_pInt, myNcleavage ! assign cleavage system vectors @@ -1832,13 +1484,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) if (abs(math_trace33(lattice_Sslip(1:3,1:3,1,i,myPhase))) > tol_math_check) & call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo - do i = 1_pInt,myNtwin ! store twin system vectors and Schmid plus rotation matrix for my structure - lattice_Qtwin(1:3,1:3,i,myPhase) = math_axisAngleToR(tn(1:3,i),180.0_pReal*INRAD) - enddo do i = 1_pInt,myNtrans lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) lattice_Strans(1:3,1:3,i,myPhase) = Str(1:3,1:3,i) - lattice_Strans_v(1:6,i,myPhase) = math_Mandel33to6(math_symmetric33(lattice_Strans(1:3,1:3,i,myPhase))) lattice_shearTrans(i,myPhase) = trs(i) enddo do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure @@ -2014,6 +1662,50 @@ pure function lattice_qDisorientation(Q1, Q2, struct) integer(pInt) :: i,j,k,s,symmetry integer(kind(LATTICE_undefined_ID)) :: myStruct + integer(pInt), dimension(2), parameter :: & + NsymOperations = [24_pInt,12_pInt] + +real(pReal), dimension(4,36), parameter :: & + symOperations = reshape([& + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry + -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & + 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & + 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & + -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & +! + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry + 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & + 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & + 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & + 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry + -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & + 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & + 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & + ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 + !-------------------------------------------------------------------------------------------------- ! check if a structure with known symmetries is given if (present(struct)) then @@ -2040,13 +1732,13 @@ pure function lattice_qDisorientation(Q1, Q2, struct) select case(symmetry) case (1_pInt,2_pInt) - s = sum(lattice_NsymOperations(1:symmetry-1_pInt)) + s = sum(NsymOperations(1:symmetry-1_pInt)) do i = 1_pInt,2_pInt dQ = math_qConj(dQ) ! switch order of "from -- to" - do j = 1_pInt,lattice_NsymOperations(symmetry) ! run through first crystal's symmetries - dQsymA = math_qMul(lattice_symOperations(1:4,s+j),dQ) ! apply sym - do k = 1_pInt,lattice_NsymOperations(symmetry) ! run through 2nd crystal's symmetries - mis = math_qMul(dQsymA,lattice_symOperations(1:4,s+k)) ! apply sym + do j = 1_pInt,NsymOperations(symmetry) ! run through first crystal's symmetries + dQsymA = math_qMul(symOperations(1:4,s+j),dQ) ! apply sym + do k = 1_pInt,NsymOperations(symmetry) ! run through 2nd crystal's symmetries + mis = math_qMul(dQsymA,symOperations(1:4,s+k)) ! apply sym if (mis(1) < 0.0_pReal) & ! want positive angle mis = -mis if (mis(1)-lattice_qDisorientation(1) > -tol_math_check & @@ -2112,7 +1804,6 @@ end function lattice_characteristicShear_Twin !-------------------------------------------------------------------------------------------------- !> @brief Calculates rotated elasticity matrices for twinning -!> ToDo: Completely untested !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) use IO, only: & @@ -2344,7 +2035,7 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( case('bcc') interactionTypes = LATTICE_BCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? interactionTypes = LATTICE_HEX_INTERACTIONSLIPSLIP NslipMax = LATTICE_HEX_NSLIPSYSTEM case('bct') @@ -2379,15 +2070,80 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:,:), allocatable :: interactionTypes + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONTWINTWIN = reshape(int( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> twin + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v twin + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],pInt),shape(FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for fcc + + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONTWINTWIN = reshape(int( [& + 1,3,3,3,3,3,3,2,3,3,2,3, & ! ---> twin + 3,1,3,3,3,3,2,3,3,3,3,2, & ! | + 3,3,1,3,3,2,3,3,2,3,3,3, & ! | + 3,3,3,1,2,3,3,3,3,2,3,3, & ! v twin + 3,3,3,2,1,3,3,3,3,2,3,3, & + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],pInt),shape(BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for bcc + !< 1: self interaction + !< 2: collinear interaction + !< 3: other interaction + integer(pInt), dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONTWINTWIN = reshape(int( [& + 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! ---> twin + 2, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! | + 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & ! v twin + 2, 2, 2, 2, 1, 2, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & + 2, 2, 2, 2, 2, 1, 3, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 13,13,13,13,13,13, & + ! + 6, 6, 6, 6, 6, 6, 4, 5, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 4, 5, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 4, 5, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 4, 5, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 4, 5, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + 6, 6, 6, 6, 6, 6, 5, 5, 5, 5, 5, 4, 8, 8, 8, 8, 8, 8, 14,14,14,14,14,14, & + ! + 12,12,12,12,12,12, 11,11,11,11,11,11, 9,10,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10, 9,10,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10, 9,10,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10, 9,10,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10, 9,10, 15,15,15,15,15,15, & + 12,12,12,12,12,12, 11,11,11,11,11,11, 10,10,10,10,10, 9, 15,15,15,15,15,15, & + ! + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 16,17,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,16,17,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,16,17,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & + 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & + ],pInt),shape(HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 16 in total) + select case(structure) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONTWINTWIN + interactionTypes = FCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_FCC_NTWINSYSTEM case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONTWINTWIN + interactionTypes = BCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONTWINTWIN + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + interactionTypes = HEX_INTERACTIONTWINTWIN NtwinMax = LATTICE_HEX_NTWINSYSTEM case default call IO_error(132_pInt,ext_msg=trim(structure)//' (twin twin interaction)') @@ -2420,17 +2176,117 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:,:), allocatable :: interactionTypes + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter :: & + FCC_INTERACTIONSLIPTWIN = reshape(int( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> twin + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip + 3,3,3,1,1,1,2,2,2,3,3,3, & + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],pInt),shape(FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for fcc + !< 1: coplanar interaction + !< 2: screw trace between slip system and twin habit plane (easy cross slip) + !< 3: other interaction + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NTWIN), parameter :: & + BCC_INTERACTIONSLIPTWIN = reshape(int( [& + 3,3,3,2,2,3,3,3,3,2,3,3, & ! ---> twin + 3,3,2,3,3,2,3,3,2,3,3,3, & ! | + 3,2,3,3,3,3,2,3,3,3,3,2, & ! | + 2,3,3,3,3,3,3,2,3,3,2,3, & ! v slip + 2,3,3,3,3,3,3,2,3,3,2,3, & + 3,3,2,3,3,2,3,3,2,3,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 2,3,3,3,3,3,3,2,3,3,2,3, & + 3,3,3,2,2,3,3,3,3,2,3,3, & + 3,2,3,3,3,3,2,3,3,3,3,2, & + 3,3,2,3,3,2,3,3,2,3,3,3, & + ! + 1,3,3,3,3,3,3,2,3,3,2,3, & + 3,1,3,3,3,3,2,3,3,3,3,2, & + 3,3,1,3,3,2,3,3,2,3,3,3, & + 3,3,3,1,2,3,3,3,3,2,3,3, & + 3,3,3,2,1,3,3,3,3,2,3,3, & + 3,3,2,3,3,1,3,3,2,3,3,3, & + 3,2,3,3,3,3,1,3,3,3,3,2, & + 2,3,3,3,3,3,3,1,3,3,2,3, & + 3,3,2,3,3,2,3,3,1,3,3,3, & + 3,3,3,2,2,3,3,3,3,1,3,3, & + 2,3,3,3,3,3,3,2,3,3,1,3, & + 3,2,3,3,3,3,2,3,3,3,3,1 & + ],pInt),shape(BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for bcc + !< 1: coplanar interaction + !< 2: screw trace between slip system and twin habit plane (easy cross slip) + !< 3: other interaction + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NTWIN), parameter :: & + HEX_INTERACTIONSLIPTWIN = reshape(int( [& + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! --> twin + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, & ! | + ! v + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & ! slip + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, & + ! + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + 9, 9, 9, 9, 9, 9, 10,10,10,10,10,10, 11,11,11,11,11,11, 12,12,12,12,12,12, & + ! + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + 13,13,13,13,13,13, 14,14,14,14,14,14, 15,15,15,15,15,15, 16,16,16,16,16,16, & + ! + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + 17,17,17,17,17,17, 18,18,18,18,18,18, 19,19,19,19,19,19, 20,20,20,20,20,20, & + ! + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & + 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & + ! + ],pInt),shape(HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) + + select case(structure) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONSLIPTWIN + interactionTypes = FCC_INTERACTIONSLIPTWIN NslipMax = LATTICE_FCC_NSLIPSYSTEM NtwinMax = LATTICE_FCC_NTWINSYSTEM case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONSLIPTWIN + interactionTypes = BCC_INTERACTIONSLIPTWIN NslipMax = LATTICE_BCC_NSLIPSYSTEM NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONSLIPTWIN + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + interactionTypes = HEX_INTERACTIONSLIPTWIN NslipMax = LATTICE_HEX_NSLIPSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM case default @@ -2464,17 +2320,54 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt), dimension(:,:), allocatable :: interactionTypes + integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & + FCC_INTERACTIONTWINSLIP = 1_pInt !< Twin--Slip interaction types for fcc + + integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & + BCC_INTERACTIONTWINSLIP = 1_pInt !< Twin--slip interaction types for bcc + + integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Nslip), parameter :: & + HEX_INTERACTIONTWINSLIP = reshape(int( [& + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! v + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! twin + 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & + ! + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + 2, 2, 2, 6, 6, 6, 10,10,10, 14,14,14,14,14,14, 18,18,18,18,18,18,18,18,18,18,18,18, 22,22,22,22,22,22, & + ! + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + 3, 3, 3, 7, 7, 7, 11,11,11, 15,15,15,15,15,15, 19,19,19,19,19,19,19,19,19,19,19,19, 23,23,23,23,23,23, & + ! + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & + 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & + ],pInt),shape(HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) + select case(structure) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONTWINSLIP + interactionTypes = FCC_INTERACTIONTWINSLIP NtwinMax = LATTICE_FCC_NTWINSYSTEM NslipMax = LATTICE_FCC_NSLIPSYSTEM case('bcc') - interactionTypes = LATTICE_BCC_INTERACTIONTWINSLIP + interactionTypes = BCC_INTERACTIONTWINSLIP NtwinMax = LATTICE_BCC_NTWINSYSTEM NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') !ToDo: "No alias policy": long or short? - interactionTypes = LATTICE_HEX_INTERACTIONTWINSLIP + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + interactionTypes = HEX_INTERACTIONTWINSLIP NtwinMax = LATTICE_HEX_NTWINSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM case default @@ -2510,10 +2403,10 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targe if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then interactionTypes = lattice_fccToHex_interactionTransTrans - NtransMax = lattice_fcc_Ntrans + NtransMax = LATTICE_FCC_NTRANSSYSTEM elseif (trim(structure) == 'fcc' .and. trim(targetStructure) == 'bcc') then - interactionTypes = lattice_fccToHex_interactionTransTrans !< ToDo: The definition for bcc does not exist yet - NtransMax = lattice_fcc_Ntrans + interactionTypes = lattice_fccToHex_interactionTransTrans ! ToDo: The definition for bcc does not exist yet + NtransMax = LATTICE_FCC_NTRANSSYSTEM else call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure)) end if @@ -2554,7 +2447,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) case('bcc') NslipMax = LATTICE_BCC_NSLIPSYSTEM slipSystems = LATTICE_BCC_SYSTEMSLIP - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? NslipMax = LATTICE_HEX_NSLIPSYSTEM slipSystems = LATTICE_HEX_SYSTEMSLIP case('bct') @@ -2684,9 +2577,9 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid coordinateSystem = buildCoordinateSystem(Ncleavage,NcleavageMax,cleavageSystems,structure,cOverA) do i = 1, sum(Ncleavage) - SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) - SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,1,i) = math_tensorproduct33(coordinateSystem(1:3,1,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,2,i) = math_tensorproduct33(coordinateSystem(1:3,3,i),coordinateSystem(1:3,2,i)) + SchmidMatrix(1:3,1:3,3,i) = math_tensorproduct33(coordinateSystem(1:3,2,i),coordinateSystem(1:3,2,i)) enddo end function lattice_SchmidMatrix_cleavage From cee905443bd9cfbffe4180d5cde4443e2812c890 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 10 Dec 2018 08:34:24 +0100 Subject: [PATCH 09/23] cleaner and safer - use functions from lattice instead of repeating code - sanity check for twin nucleation --- src/plastic_dislotwin.f90 | 63 ++++++++++++++++++--------------------- 1 file changed, 29 insertions(+), 34 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 0913feb44..3c059856f 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -107,7 +107,7 @@ module plastic_dislotwin interaction_TransSlip, & !< coefficients for trans-slip interaction for each interaction type interaction_TransTrans !< coefficients for trans-trans interaction for each interaction type integer(pInt), dimension(:,:), allocatable :: & - fcc_twinNucleationSlipPair + fcc_twinNucleationSlipPair ! ToDo: Better name? Is also use for trans real(pReal), dimension(:,:), allocatable :: & forestProjectionEdge, & C66 @@ -124,7 +124,7 @@ module plastic_dislotwin outputID !< ID of each post result output logical :: & - isFCC !< twinning and transformation models are for fcc + fccTwinTransNucleation !< twinning and transformation models are for fcc integer(pInt) :: & totalNslip, & !< number of active slip systems for each family and instance totalNtwin, & !< number of active twin systems for each family and instance @@ -288,7 +288,6 @@ subroutine plastic_dislotwin_init(fileUnit) mse => microstructure(phase_plasticityInstance(p))) ! This data is read in already in lattice - prm%isFCC = merge(.true., .false., lattice_structure(p) == LATTICE_FCC_ID) prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) prm%C66 = lattice_C66(1:6,1:6,p) @@ -301,6 +300,13 @@ subroutine plastic_dislotwin_init(fileUnit) prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then + + prm%fccTwinTransNucleation = merge(.true., .false., lattice_structure(p) == LATTICE_FCC_ID) & + .and. (prm%Nslip(1) == 12_pInt) + if(prm%fccTwinTransNucleation) & + prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair + + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & @@ -374,8 +380,10 @@ subroutine plastic_dislotwin_init(fileUnit) prm%shear_twin = lattice_characteristicShear_Twin(prm%Ntwin,structure(1:3),& config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%C66_twin = lattice_C66_twin(prm%Ntwin,prm%C66,structure(1:3),& + config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) - if (.not. prm%isFCC) then + if (.not. prm%fccTwinTransNucleation) then prm%Ndot0_twin = config_phase(p)%getFloats('ndot0_twin') prm%Ndot0_twin = math_expand(prm%Ndot0_twin,prm%Ntwin) endif @@ -435,12 +443,15 @@ subroutine plastic_dislotwin_init(fileUnit) structure(1:3)) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& config_phase(p)%getFloats('interaction_twinslip'), & - structure(1:3)) + structure(1:3)) + if (prm%fccTwinTransNucleation .and. prm%totalNtwin > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntwin is [6,6] endif if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then prm%interaction_TransSlip = spread(config_phase(p)%getFloats('interaction_transslip'),2,1) prm%interaction_SlipTrans = spread(config_phase(p)%getFloats('interaction_sliptrans'),2,1) + + if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] endif @@ -583,8 +594,8 @@ subroutine plastic_dislotwin_init(fileUnit) ! allocate state arrays NipcMyPhase=count(material_phase==p) sizeDotState = int(size(['rho ','rhoDip ','accshearslip']),pInt) * prm%totalNslip & - + int(size(['twinFraction','accsheartwin']),pInt) * prm%totalNtwin & - + int(size(['stressTransFraction','strainTransFraction']),pInt) * prm%totalNtrans + + int(size(['twinFraction','accsheartwin']),pInt) * prm%totalNtwin & + + int(size(['stressTransFraction','strainTransFraction']),pInt) * prm%totalNtrans sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & @@ -597,7 +608,9 @@ subroutine plastic_dislotwin_init(fileUnit) plasticState(p)%dotState(offset_slip+1:offset_slip+plasticState(p)%nslip,1:NipcMyPhase) plasticState(p)%accumulatedSlip => & plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nslip,1:NipcMyPhase) - + + +! DEPRECATED BEGIN allocate(temp1(prm%totalNslip,prm%totalNtrans),source =0.0_pReal) allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) i = 0_pInt @@ -627,25 +640,6 @@ subroutine plastic_dislotwin_init(fileUnit) enddo mySlipFamilies prm%interaction_SlipTrans = temp1; deallocate(temp1) - allocate(prm%C66_twin(6,6,prm%totalNtwin), source=0.0_pReal) - if (lattice_structure(p) == LATTICE_fcc_ID) & - allocate(prm%fcc_twinNucleationSlipPair(2,prm%totalNtwin),source = 0_pInt) - i = 0_pInt - twinFamiliesLoop: do f = 1_pInt, size(prm%Ntwin,1) - index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) ! index in truncated twin system list - twinSystemsLoop: do j = 1_pInt,prm%Ntwin(f) - i = i + 1_pInt - if (lattice_structure(p) == LATTICE_fcc_ID) prm%fcc_twinNucleationSlipPair(1:2,i) = & - lattice_fcc_twinNucleationSlipPair(1:2,sum(lattice_Ntwinsystem(1:f-1,p))+j) - !* Rotate twin elasticity matrices - index_otherFamily = sum(lattice_NtwinSystem(1:f-1_pInt,p)) ! index in full lattice twin list - prm%C66_twin(1:6,1:6,index_myFamily+j) = & - math_Mandel3333to66(math_rotate_forward3333(lattice_C3333(1:3,1:3,1:3,1:3,p),& - lattice_Qtwin(1:3,1:3,index_otherFamily+j,p))) - enddo twinSystemsLoop - enddo twinFamiliesLoop - - allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) @@ -672,7 +666,8 @@ subroutine plastic_dislotwin_init(fileUnit) enddo; enddo enddo transSystemsLoop enddo transFamiliesLoop - prm%interaction_TransSlip = temp1; deallocate(temp1) + prm%interaction_TransSlip = temp1; deallocate(temp1) +! DEPRECATED END startIndex=1_pInt endIndex=prm%totalNslip @@ -1051,7 +1046,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, significantTransStress: if (tau > tol_math_check) then StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - isFCCtrans: if (prm%isFCC) then + isFCCtrans: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau < mse%tau_r_trans(i,of)) then @@ -1189,7 +1184,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) significantTwinStress: if (tau > tol_math_check) then StressRatio_r = (mse%threshold_stress_twin(i,of)/tau)**prm%r(i) - isFCCtwin: if (prm%isFCC) then + isFCCtwin: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau < mse%tau_r_twin(i,of)) then @@ -1215,7 +1210,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) significantTransStress: if (tau > tol_math_check) then StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - isFCCtrans: if (prm%isFCC) then + isFCCtrans: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau < mse%tau_r_trans(i,of)) then @@ -1358,7 +1353,7 @@ pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin, do i = 1_pInt, prm%totalNtwin tau(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) - isFCC: if (prm%isFCC) then + isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau(i) < mse%tau_r_twin(i,of)) then @@ -1430,7 +1425,7 @@ pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_tran do i = 1_pInt, prm%totalNtrans tau(i) = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - isFCC: if (prm%isFCC) then + isFCC: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,i) s2=prm%fcc_twinNucleationSlipPair(2,i) if (tau(i) < mse%tau_r_trans(i,of)) then @@ -1605,7 +1600,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe tau = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) if ( tau > 0.0_pReal ) then - isFCCtwin: if (prm%isFCC) then + isFCCtwin: if (prm%fccTwinTransNucleation) then s1=prm%fcc_twinNucleationSlipPair(1,j) s2=prm%fcc_twinNucleationSlipPair(2,j) if (tau < mse%tau_r_twin(j,of)) then From 2fac481a267f2b9cba82e3a493e3ab26f6138c0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 00:39:50 +0100 Subject: [PATCH 10/23] polishing/sorting --- src/lattice.f90 | 374 ++++++++++++++++++++++++-------------- src/plastic_dislotwin.f90 | 3 +- 2 files changed, 242 insertions(+), 135 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 0b99bbc45..8e282b718 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -136,8 +136,6 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) - real(pReal), dimension(LATTICE_FCC_NTWIN), parameter, private :: & - LATTICE_fcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) !< Twin system <112>{111} ??? Sorted according to Eisenlohr & Hantcherli integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& @@ -195,7 +193,7 @@ module lattice integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS = reshape(int( [& + LATTICE_FCC_INTERACTIONSLIPTRANS = reshape(int( [& 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans 1,1,1,3,3,3,3,3,3,2,2,2, & ! | 1,1,1,2,2,2,3,3,3,3,3,3, & ! | @@ -215,26 +213,10 @@ module lattice 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(LATTICE_FCCTOHEX_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc + ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_FCC_NSLIP), parameter, public :: & - LATTICE_fccTohex_interactionTransSlip = 1_pInt !< Trans--Slip interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter,public :: & - LATTICE_fccTohex_interactionTransTrans = reshape(int( [& - 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> trans - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 1,1,1,2,2,2,2,2,2,2,2,2, & ! | - 2,2,2,1,1,1,2,2,2,2,2,2, & ! v trans - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,1,1,1,2,2,2,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,1,1,1,2,2,2, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1, & - 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(LATTICE_FCCTOHEX_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans--trans interaction types for fcc + LATTICE_FCC_interactionTransSlip = 1_pInt !< Trans--Slip interaction types for fcc real(pReal), dimension(LATTICE_fcc_Ntrans), parameter, private :: & LATTICE_fccTohex_shearTrans = sqrt(1.0_pReal/8.0_pReal) @@ -434,8 +416,7 @@ module lattice character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & ['<1 1 1>{2 1 1}'] - real(pReal), dimension(LATTICE_BCC_NTWIN), parameter, private :: & - LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) + integer(pInt), dimension(LATTICE_BCC_NSLIP,LATTICE_BCC_NSLIP), parameter, public :: & LATTICE_bcc_interactionSlipSlip = reshape(int( [& @@ -592,33 +573,6 @@ module lattice '<1 0 . -2>{1 0 . 1} ', & '<1 1 . -3>{1 1 . 2} '] - integer(pInt), dimension(LATTICE_hex_Ntwin), parameter, private :: & - LATTICE_hex_shearTwin = reshape(int( [& ! indicator to formula further below - 1, & ! <-10.1>{10.2} - 1, & - 1, & - 1, & - 1, & - 1, & - 2, & ! <11.6>{-1-1.1} - 2, & - 2, & - 2, & - 2, & - 2, & - 3, & ! <10.-2>{10.1} - 3, & - 3, & - 3, & - 3, & - 3, & - 4, & ! <11.-3>{11.2} - 4, & - 4, & - 4, & - 4, & - 4 & - ],pInt),[LATTICE_hex_Ntwin]) integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Nslip), parameter, public :: & LATTICE_hex_interactionSlipSlip = reshape(int( [& @@ -889,10 +843,10 @@ module lattice lattice_C3333, lattice_trans_C3333 real(pReal), dimension(:), allocatable, public, protected :: & lattice_mu, lattice_nu + +! SHOULD NOT BE PART OF LATTICE BEGIN real(pReal), dimension(:,:,:,:), allocatable, public, protected :: & ! with higher-order parameters (e.g. temperature-dependent) lattice_thermalExpansion33 - -! SHOULD NOT BE PART OF LATTICE BEGIN real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_thermalConductivity33, & lattice_damageDiffusion33, & @@ -916,6 +870,7 @@ module lattice lattice_equilibriumVacancyConcentration, & lattice_equilibriumHydrogenConcentration ! SHOULD NOT BE PART OF LATTICE END + enum, bind(c) enumerator :: LATTICE_undefined_ID, & LATTICE_iso_ID, & @@ -929,7 +884,6 @@ module lattice lattice_structure, trans_lattice_structure - public :: & lattice_init, & lattice_qDisorientation, & @@ -942,9 +896,11 @@ module lattice lattice_nonSchmidMatrix, & lattice_interaction_SlipSlip, & lattice_interaction_TwinTwin, & - lattice_interaction_SlipTwin, & - lattice_interaction_TwinSlip, & lattice_interaction_TransTrans, & + lattice_interaction_SlipTwin, & + lattice_interaction_SlipTrans, & + lattice_interaction_TwinSlip, & + lattice_interaction_TransSlip, & lattice_characteristicShear_Twin, & lattice_C66_twin @@ -1149,6 +1105,84 @@ subroutine lattice_init end subroutine lattice_init +!-------------------------------------------------------------------------------------------------- +!> @brief xxx +!-------------------------------------------------------------------------------------------------- +subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) + use math, only: & + math_crossproduct, & + math_tensorproduct33, & + math_mul33x33, & + math_mul33x3, & + math_axisAngleToR, & + INRAD, & + MATH_I3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: & + Ntrans + real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & + S, Q + real(pReal), intent(in), optional :: & + cOverA, & + a_fcc, & + a_bcc + + real(pReal), dimension(3,3) :: & + R, & + U, & ! Bain deformation + B, & + ss, sd + real(pReal), dimension(3) :: & + x, y, z + integer(pInt) :: & + i + + + if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' + + + if (present(a_fcc) .and. present(a_bcc)) then ! fcc -> bcc transformation + if ( a_fcc <= 0.0_pReal .or. a_bcc <= 0.0_pReal) print*, 'mist' + do i = 1_pInt,sum(Ntrans) + R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + lattice_fccTobcc_systemTrans(4,i)*INRAD) + B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + lattice_fccTobcc_bainRot(4,i)*INRAD) + x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) + y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) + z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) + + U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & + + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & + + (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) + Q(1:3,1:3,i) = math_mul33x33(R,B) + S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 + enddo + elseif (present(cOverA)) then + ss = MATH_I3 + sd = MATH_I3 + ss(1,3) = sqrt(2.0_pReal)/4.0_pReal + if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & + sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) + + do i = 1_pInt,sum(Ntrans) + x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) + z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) + y = -math_crossproduct(x,z) + Q(1:3,1,i) = x + Q(1:3,2,i) = y + Q(1:3,3,i) = z + S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 + enddo + endif + + +end subroutine lattice_Trans + + !-------------------------------------------------------------------------------------------------- !> @brief Calculation of Schmid matrices, etc. !-------------------------------------------------------------------------------------------------- @@ -1160,7 +1194,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) math_tensorproduct33, & math_mul33x33, & math_mul33x3, & - math_transpose33, & math_trace33, & math_symmetric33, & math_Mandel33to6, & @@ -1332,7 +1365,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) Rtr(1:3,2,i) = ytr(1:3,i) Rtr(1:3,3,i) = ztr(1:3,i) Qtr(1:3,1:3,i) = Rtr(1:3,1:3,i) - Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), math_mul33x33(sttr, math_transpose33(Rtr(1:3,1:3,i)))) + Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), math_mul33x33(sttr, transpose(Rtr(1:3,1:3,i)))) Str(1:3,1:3,i) = Str(1:3,1:3,i) - MATH_I3 trs(i) = lattice_fccTohex_shearTrans(i) enddo @@ -1344,8 +1377,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip - lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fccTohex_interactionSlipTrans - lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fccTohex_interactionTransSlip + lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fcc_interactionSlipTrans + lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fcc_interactionTransSlip !-------------------------------------------------------------------------------------------------- ! bcc @@ -1770,22 +1803,55 @@ function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(charact mf, & !< index of my family ms !< index of my system in current family + real(pReal), dimension(LATTICE_FCC_NTWIN), parameter :: & + FCC_SHEARTWIN = 0.5_pReal*sqrt(2.0_pReal) + + real(pReal), dimension(LATTICE_BCC_NTWIN), parameter :: & + BCC_SHEARTWIN = 0.5_pReal*sqrt(2.0_pReal) + + integer(pInt), dimension(LATTICE_HEX_NTWIN), parameter :: & + HEX_SHEARTWIN = reshape(int( [& + 1, & ! <-10.1>{10.2} + 1, & + 1, & + 1, & + 1, & + 1, & + 2, & ! <11.6>{-1-1.1} + 2, & + 2, & + 2, & + 2, & + 2, & + 3, & ! <10.-2>{10.1} + 3, & + 3, & + 3, & + 3, & + 3, & + 4, & ! <11.-3>{11.2} + 4, & + 4, & + 4, & + 4, & + 4 & + ],pInt),[LATTICE_HEX_NTWIN]) ! indicator to formula further below + ir = 0_pInt myFamilies: do mf = 1_pInt,size(Ntwin,1) mySystems: do ms = 1_pInt,Ntwin(mf) ir = ir + 1_pInt - ig = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms select case(structure) case('fcc') ig = sum(LATTICE_FCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = LATTICE_FCC_SHEARTWIN(ig) + characteristicShear(ir) = FCC_SHEARTWIN(ig) case('bcc') ig = sum(LATTICE_BCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = LATTICE_BCC_SHEARTWIN(ig) + characteristicShear(ir) = BCC_SHEARTWIN(ig) case('hex') if (.not. present(CoverA)) call IO_error(0_pInt) ig = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms - select case(LATTICE_HEX_SHEARTWIN(ig)) ! from Christian & Mahajan 1995 p.29 + select case(HEX_SHEARTWIN(ig)) ! from Christian & Mahajan 1995 p.29 case (1_pInt) ! <-10.1>{10.2} characteristicShear(ir) = (3.0_pReal-cOverA*cOverA)/sqrt(3.0_pReal)/CoverA case (2_pInt) ! <11.6>{-1-1.1} @@ -1874,8 +1940,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans - real(pReal), dimension(3,3) :: R,B,U,Q,S,ss,sd,st - real(pReal), dimension(3) :: x,y,z + real(pReal), dimension(3,3) :: Q,S real(pReal) :: a_bcc, a_fcc, CoverA_trans integer(pInt) :: i @@ -1909,47 +1974,6 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & call IO_error(135_pInt,el=i,ext_msg='matrix diagonal "el"ement in transformation') enddo - if (trim(structure_parent) == 'fcc' .and. trim(structure_target) == 'hex') then - do i = 1_pInt,sum(Ntrans)!!!!!!!!!!!!!! ToDo: NEED TO BE FIXED - R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation - lattice_fccTobcc_systemTrans(4,i)*INRAD) - B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system - lattice_fccTobcc_bainRot(4,i)*INRAD) - x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) - y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - - BainDeformation: if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then - U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) + & - (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) + & - (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) - else BainDeformation - U = 0.0_pReal - endif BainDeformation - Q = math_mul33x33(R,B) - S = math_mul33x33(R,U) - MATH_I3 - enddo - elseif (trim(structure_target) == 'bcc') then - ss = MATH_I3 - ss(1,3) = sqrt(0.125_pReal) - sd = MATH_I3 - if (CoverA_trans > 1.0_pReal .and. CoverA_trans < 2.0_pReal) then - sd(3,3) = CoverA_trans/sqrt(8.0_pReal/3.0_pReal) - endif - st = math_mul33x33(sd,ss) - do i = 1_pInt,sum(Ntrans)!!!!!!!!!!!!!! NEED TO BE FIXED - R(1:3,1) = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - R(1:3,3) = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - R(1:3,2) = -math_crossproduct(R(1:3,1),R(1:3,3)) - Q = R - S = math_mul33x33(R, math_mul33x33(st, transpose(R))) - MATH_I3 - ! trs(i) = lattice_fccTohex_shearTrans(i) - enddo - else - write(6,*) "Mist" - endif - - do i = 1, sum(Ntrans) ! R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? ! lattice_C66_trans(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) @@ -2157,6 +2181,53 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( end function lattice_interaction_TwinTwin +!-------------------------------------------------------------------------------------------------- +!> @brief Populates trans-trans interaction matrix +!> details: only active transformation systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_interaction_TransTrans(Ntrans,interactionValues,structure) result(interactionMatrix) + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + character(len=*), intent(in) :: & + structure !< lattice structure of parent crystal + real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix + + integer(pInt), dimension(:), allocatable :: NtransMax + integer(pInt), dimension(:,:), allocatable :: interactionTypes + + integer(pInt), dimension(LATTICE_FCC_NTRANS,LATTICE_FCC_NTRANS), parameter :: & + FCC_INTERACTIONTRANSTRANS = reshape(int( [& + 1,1,1,2,2,2,2,2,2,2,2,2, & ! ---> trans + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 1,1,1,2,2,2,2,2,2,2,2,2, & ! | + 2,2,2,1,1,1,2,2,2,2,2,2, & ! v trans + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,1,1,1,2,2,2,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,1,1,1,2,2,2, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1, & + 2,2,2,2,2,2,2,2,2,1,1,1 & + ],pInt),shape(FCC_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans--trans interaction types for fcc + + if (trim(structure) == 'fcc') then + interactionTypes = FCC_INTERACTIONTRANSTRANS + NtransMax = LATTICE_FCC_NTRANSSYSTEM + else + call IO_error(132_pInt,ext_msg=trim(structure)//' (trans trans interaction)') + end if + + !if (size(interactionValues) > maxval(interactionTypes)) & + ! call IO_error(0_pInt) ! ToDo + interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) +end function lattice_interaction_TransTrans + + !-------------------------------------------------------------------------------------------------- !> @brief Populates slip-twin interaction matrix !> details: only active slip and twin systems are considered @@ -2166,14 +2237,14 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntwin !< number of active twin systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix - integer(pInt), dimension(:), allocatable :: NslipMax - integer(pInt), dimension(:), allocatable :: NtwinMax + integer(pInt), dimension(:), allocatable :: NslipMax, & + NtwinMax integer(pInt), dimension(:,:), allocatable :: interactionTypes integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NTWIN), parameter :: & @@ -2301,6 +2372,42 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r end function lattice_interaction_SlipTwin +!-------------------------------------------------------------------------------------------------- +!> @brief Populates trans-trans interaction matrix +!> details: only active transformation systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family + Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip--trans + character(len=*), intent(in) :: & + structure !< lattice structure of parent crystal + real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix + + integer(pInt), dimension(:), allocatable :: NslipMax, & + NtransMax + integer(pInt), dimension(:,:), allocatable :: interactionTypes + + select case(structure) + case('fcc') + interactionTypes = LATTICE_FCC_INTERACTIONSLIPTRANS + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtransMax = LATTICE_FCC_NTRANSSYSTEM + case default + call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') + end select + + !if (size(interactionValues) > maxval(interactionTypes)) & + ! call IO_error(0_pInt) ! ToDo + interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes) + +end function lattice_interaction_SlipTrans + + !-------------------------------------------------------------------------------------------------- !> @brief Populates twin-slip interaction matrix !> details: only active twin and slip systems are considered @@ -2310,14 +2417,14 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + integer(pInt), dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family + Nslip !< number of active slip systems per family real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix - integer(pInt), dimension(:), allocatable :: NslipMax - integer(pInt), dimension(:), allocatable :: NtwinMax + integer(pInt), dimension(:), allocatable :: NtwinMax, & + NslipMax integer(pInt), dimension(:,:), allocatable :: interactionTypes integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & @@ -2326,7 +2433,7 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & BCC_INTERACTIONTWINSLIP = 1_pInt !< Twin--slip interaction types for bcc - integer(pInt), dimension(LATTICE_hex_Ntwin,LATTICE_hex_Nslip), parameter :: & + integer(pInt), dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NSLIP), parameter :: & HEX_INTERACTIONTWINSLIP = reshape(int( [& 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! --> slip 1, 1, 1, 5, 5, 5, 9, 9, 9, 13,13,13,13,13,13, 17,17,17,17,17,17,17,17,17,17,17,17, 21,21,21,21,21,21, & ! | @@ -2386,35 +2493,36 @@ end function lattice_interaction_TwinSlip !> @brief Populates trans-trans interaction matrix !> details: only active transformation systems are considered !-------------------------------------------------------------------------------------------------- -function lattice_interaction_TransTrans(Ntrans,interactionValues,structure,targetStructure) result(interactionMatrix) +function lattice_interaction_TransSlip(Ntrans,Nslip,interactionValues,structure) result(interactionMatrix) use IO, only: & IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + integer(pInt), dimension(:), intent(in) :: Ntrans, & !< number of active trans systems per family + Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values trans-trans character(len=*), intent(in) :: & - structure, & !< lattice structure of parent crystal - targetStructure !< lattice structure of transformed crystal - real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix + structure !< lattice structure of parent crystal + real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix - integer(pInt), dimension(:), allocatable :: NtransMax + integer(pInt), dimension(:), allocatable :: NtransMax, & + NslipMax integer(pInt), dimension(:,:), allocatable :: interactionTypes - if (trim(structure) == 'fcc' .and. trim(targetStructure) == 'hex') then - interactionTypes = lattice_fccToHex_interactionTransTrans - NtransMax = LATTICE_FCC_NTRANSSYSTEM - elseif (trim(structure) == 'fcc' .and. trim(targetStructure) == 'bcc') then - interactionTypes = lattice_fccToHex_interactionTransTrans ! ToDo: The definition for bcc does not exist yet - NtransMax = LATTICE_FCC_NTRANSSYSTEM - else - call IO_error(132_pInt,ext_msg=trim(structure)//' => '//trim(targetStructure)) - end if + select case(structure) + case('fcc') + interactionTypes = LATTICE_FCC_INTERACTIONTRANSSLIP + NslipMax = LATTICE_FCC_NSLIPSYSTEM + NtransMax = LATTICE_FCC_NTRANSSYSTEM + case default + call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') + end select !if (size(interactionValues) > maxval(interactionTypes)) & ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) -end function lattice_interaction_TransTrans + interactionMatrix = buildInteraction(Ntrans,Nslip,NtransMax,NslipMax,interactionValues,interactionTypes) + +end function lattice_interaction_TransSlip !-------------------------------------------------------------------------------------------------- diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 3c059856f..421701893 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -416,8 +416,7 @@ subroutine plastic_dislotwin_init(fileUnit) prm%interaction_TransTrans = lattice_interaction_TransTrans(prm%Ntrans,& config_phase(p)%getFloats('interaction_transtrans'), & - structure(1:3),& - trim(config_phase(p)%getString('trans_lattice_structure'))) + structure(1:3)) if (lattice_structure(p) /= LATTICE_fcc_ID) then prm%Ndot0_trans = config_phase(p)%getFloats('ndot0_trans') prm%Ndot0_trans = math_expand(prm%Ndot0_trans,prm%Ntrans) From ee60ce0d98a658d4e6ede1892251fe0de5d94b84 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 01:35:36 +0100 Subject: [PATCH 11/23] further simplifications --- src/lattice.f90 | 6 ++-- src/plastic_dislotwin.f90 | 71 +++++++++------------------------------ 2 files changed, 18 insertions(+), 59 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 8e282b718..6a2bbba10 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2398,7 +2398,7 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) NslipMax = LATTICE_FCC_NSLIPSYSTEM NtransMax = LATTICE_FCC_NTRANSSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') + call IO_error(132_pInt,ext_msg=trim(structure)//' (slip trans interaction)') end select !if (size(interactionValues) > maxval(interactionTypes)) & @@ -2503,7 +2503,7 @@ function lattice_interaction_TransSlip(Ntrans,Nslip,interactionValues,structure) real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values trans-trans character(len=*), intent(in) :: & structure !< lattice structure of parent crystal - real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix + real(pReal), dimension(sum(Ntrans),sum(Nslip)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NtransMax, & NslipMax @@ -2515,7 +2515,7 @@ function lattice_interaction_TransSlip(Ntrans,Nslip,interactionValues,structure) NslipMax = LATTICE_FCC_NSLIPSYSTEM NtransMax = LATTICE_FCC_NTRANSSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') + call IO_error(132_pInt,ext_msg=trim(structure)//' (trans slip interaction)') end select !if (size(interactionValues) > maxval(interactionTypes)) & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 421701893..dd150f3cb 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -446,9 +446,13 @@ subroutine plastic_dislotwin_init(fileUnit) if (prm%fccTwinTransNucleation .and. prm%totalNtwin > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntwin is [6,6] endif - if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then - prm%interaction_TransSlip = spread(config_phase(p)%getFloats('interaction_transslip'),2,1) - prm%interaction_SlipTrans = spread(config_phase(p)%getFloats('interaction_sliptrans'),2,1) + if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then + prm%interaction_SlipTrans = lattice_interaction_SlipTrans(prm%Nslip,prm%Ntrans,& + config_phase(p)%getFloats('interaction_sliptrans'), & + structure(1:3)) + prm%interaction_TransSlip = lattice_interaction_TransSlip(prm%Ntrans,prm%Nslip,& + config_phase(p)%getFloats('interaction_transslip'), & + structure(1:3)) if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] endif @@ -615,7 +619,6 @@ subroutine plastic_dislotwin_init(fileUnit) i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - slipSystemsLoop: do j = 1_pInt,prm%Nslip(f) i = i + 1_pInt do o = 1_pInt, size(prm%Nslip,1) @@ -625,21 +628,9 @@ subroutine plastic_dislotwin_init(fileUnit) abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) enddo; enddo - do o = 1_pInt,size(prm%Ntrans,1) - index_otherFamily = sum(prm%Ntrans(1:o-1_pInt)) - do k = 1_pInt,prm%Ntrans(o) ! loop over (active) systems in other family (trans) - temp1(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_SlipTrans(lattice_interactionSlipTrans( & - sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & - sum(lattice_NtransSystem(1:o-1_pInt,p))+k, & - p),1 ) - enddo; enddo - enddo slipSystemsLoop - enddo mySlipFamilies - prm%interaction_SlipTrans = temp1; deallocate(temp1) + enddo mySlipFamilies - allocate(temp1(prm%totalNtrans,prm%totalNslip), source =0.0_pReal) allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) i = 0_pInt @@ -653,19 +644,8 @@ subroutine plastic_dislotwin_init(fileUnit) prm%C66_trans(1:6,1:6,index_myFamily+j) = & math_Mandel3333to66(math_rotate_forward3333(lattice_trans_C3333(1:3,1:3,1:3,1:3,p),& lattice_Qtrans(1:3,1:3,index_otherFamily+j,p))) - !* Interaction matrices - do o = 1_pInt,size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) - temp1(index_myFamily+j,index_otherFamily+k) = & - prm%interaction_TransSlip(lattice_interactionTransSlip( & - sum(lattice_NtransSystem(1:f-1_pInt,p))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & - p) ,1 ) - enddo; enddo enddo transSystemsLoop enddo transFamiliesLoop - prm%interaction_TransSlip = temp1; deallocate(temp1) ! DEPRECATED END startIndex=1_pInt @@ -715,11 +695,11 @@ subroutine plastic_dislotwin_init(fileUnit) plasticState(p)%state0 = plasticState(p)%state dot%whole => plasticState(p)%dotState - allocate(mse%invLambdaSlip(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTwin(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTwin(prm%totalNtwin,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTrans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTrans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlip (prm%totalNslip,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlipTwin (prm%totalNslip,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlipTrans(prm%totalNslip,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaTwin (prm%totalNtwin,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(mse%mfp_slip(prm%totalNslip,NipcMyPhase), source=0.0_pReal) allocate(mse%mfp_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) @@ -756,8 +736,6 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - type(tParameters) :: prm - type(tDislotwinState) :: stt integer(pInt) :: i, & of @@ -814,10 +792,6 @@ subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) x0, & fOverStacksize, & ftransOverLamellarSize - - type(tParameters) :: prm !< parameters of present instance - type(tDislotwinState) :: stt !< state of present instance - type(tDislotwinMicrostructure) :: mse of = phasememberAt(ipc,ip,el) @@ -858,7 +832,7 @@ subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation if (prm%totalNtrans > 0_pInt .and. prm%totalNslip > 0_pInt) & - mse%invLambdaSlipTrans(1_pInt:prm%totalNslip,of) = & + mse%invLambdaSlipTrans(1_pInt:prm%totalNslip,of) = & ! ToDo: does not work if Ntrans is not 12 matmul(prm%interaction_SlipTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) @@ -930,10 +904,6 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, math_symmetric33, & math_mul33xx33, & math_mul33x3 - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt implicit none real(pReal), dimension(3,3), intent(out) :: Lp @@ -975,9 +945,6 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, 0, 1,-1, & 0, 1, 1 & ],pReal),[ 3,6]) - - type(tParameters) :: prm !< parameters of present instance - type(tDislotwinState) :: ste !< state of present instance associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) @@ -1089,10 +1056,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) math_Mandel6to33, & pi use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phasememberAt + plasticState implicit none real(pReal), dimension(3,3), intent(in):: & @@ -1477,11 +1441,6 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe PI, & math_mul33xx33, & math_Mandel6to33 - use material, only: & - material_phase, & - plasticState, & - phase_plasticityInstance,& - phasememberAt implicit none real(pReal), dimension(3,3),intent(in) :: & From 1bcf41100dd839bd00d77dcaa4baafded77bb2bc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 01:47:13 +0100 Subject: [PATCH 12/23] [skip ci] WIP: cleaning contains a few bugs --- src/constitutive.f90 | 2 +- src/lattice.f90 | 120 ++++++++++---------------------------- src/plastic_dislotwin.f90 | 47 +++++---------- 3 files changed, 49 insertions(+), 120 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index eca8af08a..d7be5daac 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -163,7 +163,7 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) - if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(FILEUNIT) diff --git a/src/lattice.f90 b/src/lattice.f90 index 6a2bbba10..6598c1dc1 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,18 +16,14 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures - LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & lattice_NslipSystem, & !< total # of slip systems in each family - lattice_NtransSystem, & !< total # of transformation systems in each family lattice_NcleavageSystem !< total # of transformation systems in each family integer(pInt), allocatable, dimension(:,:,:), protected, public :: & - lattice_interactionSlipSlip, & !< Slip--slip interaction type - lattice_interactionSlipTrans, & !< Slip--trans interaction type - lattice_interactionTransSlip !< Trans--slip interaction type + lattice_interactionSlipSlip !< Slip--slip interaction type real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Sslip, & !< Schmid and non-Schmid matrices @@ -49,7 +45,6 @@ module lattice integer(pInt), allocatable, dimension(:), protected, public :: & lattice_NnonSchmid !< total # of non-Schmid contributions for each structure - ! END DEPRECATED @@ -61,7 +56,7 @@ module lattice integer(pInt), dimension(1), parameter, public :: & LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc - integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & + integer(pInt), dimension(1), parameter, public :: & LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & @@ -188,36 +183,6 @@ module lattice !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - - - - - integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_FCC_INTERACTIONSLIPTRANS = reshape(int( [& - 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans - 1,1,1,3,3,3,3,3,3,2,2,2, & ! | - 1,1,1,2,2,2,3,3,3,3,3,3, & ! | - 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip - 3,3,3,1,1,1,2,2,2,3,3,3, & - 2,2,2,1,1,1,3,3,3,3,3,3, & - 2,2,2,3,3,3,1,1,1,3,3,3, & - 3,3,3,2,2,2,1,1,1,3,3,3, & - 3,3,3,3,3,3,1,1,1,2,2,2, & - 3,3,3,2,2,2,3,3,3,1,1,1, & - 2,2,2,3,3,3,3,3,3,1,1,1, & - 3,3,3,3,3,3,2,2,2,1,1,1, & - - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4, & - 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc - - integer(pInt), dimension(LATTICE_fcc_Ntrans,LATTICE_FCC_NSLIP), parameter, public :: & - LATTICE_FCC_interactionTransSlip = 1_pInt !< Trans--Slip interaction types for fcc - real(pReal), dimension(LATTICE_fcc_Ntrans), parameter, private :: & LATTICE_fccTohex_shearTrans = sqrt(1.0_pReal/8.0_pReal) @@ -900,7 +865,6 @@ module lattice lattice_interaction_SlipTwin, & lattice_interaction_SlipTrans, & lattice_interaction_TwinSlip, & - lattice_interaction_TransSlip, & lattice_characteristicShear_Twin, & lattice_C66_twin @@ -973,21 +937,16 @@ subroutine lattice_init allocate(lattice_NnonSchmid(Nphases), source=0_pInt) allocate(lattice_Sslip(3,3,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Sslip_v(6,1+2*lattice_maxNnonSchmid,lattice_maxNslip,Nphases),source=0.0_pReal) + allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) + allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me + allocate(lattice_Scleavage(3,3,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) - - allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) - - allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - - allocate(lattice_NslipSystem(lattice_maxNslipFamily,Nphases),source=0_pInt) - allocate(lattice_NtransSystem(lattice_maxNtransFamily,Nphases),source=0_pInt) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) - allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionSlipTrans(lattice_maxNslip,lattice_maxNtrans,Nphases),source=0_pInt) ! other:me - allocate(lattice_interactionTransSlip(lattice_maxNtrans,lattice_maxNslip,Nphases),source=0_pInt) ! other:me + allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) + allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) + allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) allocate(CoverA(Nphases),source=0.0_pReal) allocate(CoverA_trans(Nphases),source=0.0_pReal) @@ -1377,8 +1336,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip - lattice_interactionSlipTrans(1:myNslip,1:myNtrans,myPhase) = lattice_fcc_interactionSlipTrans - lattice_interactionTransSlip(1:myNtrans,1:myNslip,myPhase) = lattice_fcc_interactionTransSlip !-------------------------------------------------------------------------------------------------- ! bcc @@ -2392,9 +2349,32 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) NtransMax integer(pInt), dimension(:,:), allocatable :: interactionTypes + integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_fcc_Ntrans), parameter :: & + FCC_INTERACTIONSLIPTRANS = reshape(int( [& + 1,1,1,3,3,3,2,2,2,3,3,3, & ! ---> trans + 1,1,1,3,3,3,3,3,3,2,2,2, & ! | + 1,1,1,2,2,2,3,3,3,3,3,3, & ! | + 3,3,3,1,1,1,3,3,3,2,2,2, & ! v slip + 3,3,3,1,1,1,2,2,2,3,3,3, & + 2,2,2,1,1,1,3,3,3,3,3,3, & + 2,2,2,3,3,3,1,1,1,3,3,3, & + 3,3,3,2,2,2,1,1,1,3,3,3, & + 3,3,3,3,3,3,1,1,1,2,2,2, & + 3,3,3,2,2,2,3,3,3,1,1,1, & + 2,2,2,3,3,3,3,3,3,1,1,1, & + 3,3,3,3,3,3,2,2,2,1,1,1, & + + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4, & + 4,4,4,4,4,4,4,4,4,4,4,4 & + ],pInt),shape(FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc + select case(structure) case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONSLIPTRANS + interactionTypes = FCC_INTERACTIONSLIPTRANS NslipMax = LATTICE_FCC_NSLIPSYSTEM NtransMax = LATTICE_FCC_NTRANSSYSTEM case default @@ -2489,42 +2469,6 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r end function lattice_interaction_TwinSlip -!-------------------------------------------------------------------------------------------------- -!> @brief Populates trans-trans interaction matrix -!> details: only active transformation systems are considered -!-------------------------------------------------------------------------------------------------- -function lattice_interaction_TransSlip(Ntrans,Nslip,interactionValues,structure) result(interactionMatrix) - use IO, only: & - IO_error - - implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans, & !< number of active trans systems per family - Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values trans-trans - character(len=*), intent(in) :: & - structure !< lattice structure of parent crystal - real(pReal), dimension(sum(Ntrans),sum(Nslip)) :: interactionMatrix - - integer(pInt), dimension(:), allocatable :: NtransMax, & - NslipMax - integer(pInt), dimension(:,:), allocatable :: interactionTypes - - select case(structure) - case('fcc') - interactionTypes = LATTICE_FCC_INTERACTIONTRANSSLIP - NslipMax = LATTICE_FCC_NSLIPSYSTEM - NtransMax = LATTICE_FCC_NTRANSSYSTEM - case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (trans slip interaction)') - end select - - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntrans,Nslip,NtransMax,NslipMax,interactionValues,interactionTypes) - -end function lattice_interaction_TransSlip - - !-------------------------------------------------------------------------------------------------- !> @brief Calculates Schmid matrix for active slip systems !-------------------------------------------------------------------------------------------------- diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index dd150f3cb..c7c03c1f4 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -104,7 +104,6 @@ module plastic_dislotwin interaction_TwinSlip, & !< coefficients for twin-slip interaction for each interaction type interaction_TwinTwin, & !< coefficients for twin-twin interaction for each interaction type interaction_SlipTrans, & !< coefficients for slip-trans interaction for each interaction type - interaction_TransSlip, & !< coefficients for trans-slip interaction for each interaction type interaction_TransTrans !< coefficients for trans-trans interaction for each interaction type integer(pInt), dimension(:,:), allocatable :: & fcc_twinNucleationSlipPair ! ToDo: Better name? Is also use for trans @@ -190,7 +189,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_dislotwin_init(fileUnit) +subroutine plastic_dislotwin_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -230,8 +229,6 @@ subroutine plastic_dislotwin_init(fileUnit) use lattice implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt) :: Ninstance,& f,j,i,k,o,p, & offset_slip, index_myFamily, index_otherFamily, & @@ -240,7 +237,7 @@ subroutine plastic_dislotwin_init(fileUnit) integer(pInt) :: NipcMyPhase real(pReal), allocatable, dimension(:,:) :: temp1 - + integer(pInt), dimension(1,200), parameter :: lattice_ntranssystem = 12 ! HACK!! integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] @@ -450,10 +447,6 @@ subroutine plastic_dislotwin_init(fileUnit) prm%interaction_SlipTrans = lattice_interaction_SlipTrans(prm%Nslip,prm%Ntrans,& config_phase(p)%getFloats('interaction_sliptrans'), & structure(1:3)) - prm%interaction_TransSlip = lattice_interaction_TransSlip(prm%Ntrans,prm%Nslip,& - config_phase(p)%getFloats('interaction_transslip'), & - structure(1:3)) - if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] endif @@ -695,25 +688,23 @@ subroutine plastic_dislotwin_init(fileUnit) plasticState(p)%state0 = plasticState(p)%state dot%whole => plasticState(p)%dotState - allocate(mse%invLambdaSlip (prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTwin (prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaSlipTrans(prm%totalNslip,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTwin (prm%totalNtwin,NipcMyPhase),source=0.0_pReal) - allocate(mse%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlipTwin (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaSlipTrans (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(mse%mfp_slip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(mse%threshold_stress_slip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) - allocate(mse%mfp_slip(prm%totalNslip,NipcMyPhase), source=0.0_pReal) - allocate(mse%mfp_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%mfp_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(mse%invLambdaTwin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(mse%mfp_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(mse%threshold_stress_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(mse%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(mse%twinVolume (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) - allocate(mse%threshold_stress_slip(prm%totalNslip,NipcMyPhase), source=0.0_pReal) - allocate(mse%threshold_stress_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) + allocate(mse%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(mse%mfp_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(mse%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - - allocate(mse%tau_r_twin(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%tau_r_trans(prm%totalNtrans,NipcMyPhase), source=0.0_pReal) - - allocate(mse%twinVolume(prm%totalNtwin,NipcMyPhase), source=0.0_pReal) - allocate(mse%martensiteVolume(prm%totalNtrans,NipcMyPhase), source=0.0_pReal) + allocate(mse%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(mse%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) end associate enddo @@ -1076,12 +1067,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) real(pReal), dimension(plasticState(instance)%Nslip) :: & gdot_slip - - type(tParameters) :: prm - type(tDislotwinState) :: stt, dot - type(tDislotwinMicrostructure) :: mse - - associate(prm => param(instance), stt => state(instance), & dot => dotstate(instance), mse => microstructure(instance)) From 754e5a960bc7f06bd4094d4f80fcdab342449852 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 07:22:48 +0100 Subject: [PATCH 13/23] polishing sometimes gives segmentation fault/division by zero. probably the usual problem of dislotwin when running without friction coefficient B --- src/plastic_dislotwin.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index c7c03c1f4..6dbcb2b06 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -236,7 +236,6 @@ subroutine plastic_dislotwin_init integer(pInt) :: sizeState, sizeDotState integer(pInt) :: NipcMyPhase - real(pReal), allocatable, dimension(:,:) :: temp1 integer(pInt), dimension(1,200), parameter :: lattice_ntranssystem = 12 ! HACK!! integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] @@ -607,7 +606,6 @@ subroutine plastic_dislotwin_init ! DEPRECATED BEGIN - allocate(temp1(prm%totalNslip,prm%totalNtrans),source =0.0_pReal) allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) i = 0_pInt mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) From ef23095332b11aeb65b9ffdfb956a78004509787 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 08:03:40 +0100 Subject: [PATCH 14/23] using function for cleavage system definition only internally since damage related constitutive laws will be re-written anyway --- src/lattice.f90 | 122 ++++++++++++++++++++---------------------------- 1 file changed, 51 insertions(+), 71 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 6598c1dc1..6d4251fc9 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -775,18 +775,18 @@ module lattice !-------------------------------------------------------------------------------------------------- ! orthorhombic integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ort_Ncleavage = sum(lattice_ort_NcleavageSystem) !< total # of cleavage systems for ortho - real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & - LATTICE_ortho_systemCleavage = reshape(real([& + real(pReal), dimension(3+3,LATTICE_ort_Ncleavage), parameter, private :: & + LATTICE_ort_systemCleavage = reshape(real([& ! Cleavage direction Plane normal 0, 1, 0, 1, 0, 0, & 0, 0, 1, 0, 1, 0, & 1, 0, 0, 0, 0, 1 & - ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) + ],pReal),[ 3_pInt + 3_pInt,LATTICE_ort_Ncleavage]) ! BEGIN DEPRECATED integer(pInt), parameter, public :: & @@ -796,7 +796,7 @@ module lattice LATTICE_maxNtrans = LATTICE_fcc_Ntrans, & !< max # of transformation systems over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures + LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures LATTICE_maxNinteraction = 182_pInt !END DEPRECATED @@ -1192,7 +1192,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) cd, cn, ct integer(pInt) :: & i,j, & - myNslip = 0_pInt, myNtrans = 0_pInt, myNcleavage = 0_pInt + myNslip, myNtrans, myNcleavage real(pReal) :: c11bar, c12bar, c13bar, c14bar, c33bar, c44bar, A, B lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& @@ -1270,23 +1270,28 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_hydrogenfluxDiffusion33(1:3,1:3,myPhase)) lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase)) + myNslip = 0_pInt + myNtrans = 0_pInt + myNcleavage = 0_pInt select case(lattice_structure(myPhase)) !-------------------------------------------------------------------------------------------------- ! fcc case (LATTICE_fcc_ID) - myNslip = LATTICE_FCC_NSLIP - myNtrans = lattice_fcc_Ntrans + myNslip = LATTICE_FCC_NSLIP + myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage - do i = 1_pInt,myNslip ! assign slip system vectors + lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavageSystem,'fcc',covera) + + do i = 1_pInt,myNslip sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo ! Phase transformation select case(trans_lattice_structure(myPhase)) @@ -1333,16 +1338,20 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) Str = 0.0_pReal end select - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_fcc_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! bcc case (LATTICE_bcc_ID) - myNslip = LATTICE_BCC_NSLIP - myNtrans = 0_pInt + myNslip = LATTICE_BCC_NSLIP myNcleavage = lattice_bcc_Ncleavage + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem + lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_bcc_ncleavagesystem,'bcc',covera) + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_bcc_systemSlip(1:3,i) sn(1:3,i) = lattice_bcc_systemSlip(4:6,i) @@ -1365,22 +1374,19 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sns(1:3,1:3,1,6,i) = math_tensorproduct33(sdU, sdU) sns(1:3,1:3,2,6,i) = math_tensorproduct33(-sdU, -sdU) enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_bcc_systemCleavage(1:3,i)/norm2(lattice_bcc_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_bcc_systemCleavage(4:6,i)/norm2(lattice_bcc_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bcc_NslipSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_bcc_NcleavageSystem - lattice_NnonSchmid(myPhase) = lattice_bcc_NnonSchmid - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bcc_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) - myNslip = lattice_hex_Nslip - myNtrans = 0_pInt + myNslip = lattice_hex_Nslip myNcleavage = lattice_hex_Ncleavage + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavagesystem,'hex',covera) + do i = 1_pInt,myNslip ! assign slip system vectors sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] sd(2,i) = (lattice_hex_systemSlip(1,i)+2.0_pReal*lattice_hex_systemSlip(2,i))*& @@ -1390,28 +1396,14 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(2,i) = (lattice_hex_systemSlip(5,i)+2.0_pReal*lattice_hex_systemSlip(6,i))/sqrt(3.0_pReal) sn(3,i) = lattice_hex_systemSlip(8,i)/CoverA enddo - do i = 1_pInt, myNcleavage ! cleavage system vectors - cd(1,i) = lattice_hex_systemCleavage(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] - cd(2,i) = (lattice_hex_systemCleavage(1,i)+2.0_pReal*lattice_hex_systemCleavage(2,i))*& - 0.5_pReal*sqrt(3.0_pReal) - cd(3,i) = lattice_hex_systemCleavage(4,i)*CoverA - cd(1:3,1) = cd(1:3,i)/norm2(cd(1:3,i)) - cn(1,i) = lattice_hex_systemCleavage(5,i) ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - cn(2,i) = (lattice_hex_systemCleavage(5,i)+2.0_pReal*lattice_hex_systemCleavage(6,i))/sqrt(3.0_pReal) - cn(3,i) = lattice_hex_systemCleavage(8,i)/CoverA - cn(1:3,1) = cn(1:3,i)/norm2(cn(1:3,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! bct case (LATTICE_bct_ID) - myNtrans = 0_pInt myNslip = lattice_bct_Nslip - myNcleavage = 0_pInt + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem + lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:2,i) = lattice_bct_systemSlip(1:2,i) sd(3,i) = lattice_bct_systemSlip(3,i)*CoverA @@ -1420,35 +1412,25 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sdU = sd(1:3,i) / norm2(sd(1:3,i)) snU = sn(1:3,i) / norm2(sn(1:3,i)) enddo - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_bct_NslipSystem - lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_bct_interactionSlipSlip !-------------------------------------------------------------------------------------------------- ! orthorhombic (no crystal plasticity) case (LATTICE_ort_ID) - myNslip = 0_pInt - myNtrans = 0_pInt - myNcleavage = lattice_ortho_Ncleavage - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_iso_systemCleavage(1:3,i)/norm2(LATTICE_ortho_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_iso_systemCleavage(4:6,i)/norm2(LATTICE_ortho_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo - lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_iso_NcleavageSystem + myNcleavage = lattice_ort_Ncleavage + lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_ort_NcleavageSystem + + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_ort_NcleavageSystem,'ort',covera) !-------------------------------------------------------------------------------------------------- ! isotropic (no crystal plasticity) case (LATTICE_iso_ID) - myNslip = 0_pInt - myNtrans = 0_pInt myNcleavage = lattice_iso_Ncleavage - do i = 1_pInt, myNcleavage ! assign cleavage system vectors - cd(1:3,i) = lattice_iso_systemCleavage(1:3,i)/norm2(lattice_iso_systemCleavage(1:3,i)) - cn(1:3,i) = lattice_iso_systemCleavage(4:6,i)/norm2(lattice_iso_systemCleavage(4:6,i)) - ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) - enddo lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_iso_NcleavageSystem + lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & + lattice_SchmidMatrix_cleavage(lattice_iso_NcleavageSystem,'iso',covera) + !-------------------------------------------------------------------------------------------------- ! something went wrong case default @@ -1479,10 +1461,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_Strans(1:3,1:3,i,myPhase) = Str(1:3,1:3,i) lattice_shearTrans(i,myPhase) = trs(i) enddo + do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure - lattice_Scleavage(1:3,1:3,1,i,myPhase) = math_tensorproduct33(cd(1:3,i),cn(1:3,i)) - lattice_Scleavage(1:3,1:3,2,i,myPhase) = math_tensorproduct33(ct(1:3,i),cn(1:3,i)) - lattice_Scleavage(1:3,1:3,3,i,myPhase) = math_tensorproduct33(cn(1:3,i),cn(1:3,i)) do j = 1_pInt,3_pInt lattice_Scleavage_v(1:6,j,i,myPhase) = & math_Mandel33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) @@ -2606,8 +2586,8 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE case('ort') - NcleavageMax = LATTICE_ORTHO_NCLEAVAGESYSTEM - cleavageSystems = LATTICE_ORTHO_SYSTEMCLEAVAGE + NcleavageMax = LATTICE_ORT_NCLEAVAGESYSTEM + cleavageSystems = LATTICE_ORT_SYSTEMCLEAVAGE case('fcc') NcleavageMax = LATTICE_FCC_NCLEAVAGESYSTEM cleavageSystems = LATTICE_FCC_SYSTEMCLEAVAGE From c29240c1c857e76cafe68bbe2bf145708d00e394 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 23:00:56 +0100 Subject: [PATCH 15/23] forestprojection can be calculated centrally --- src/lattice.f90 | 231 +++++++++++++++++++++++--------------- src/plastic_dislotwin.f90 | 20 +--- 2 files changed, 141 insertions(+), 110 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 6d4251fc9..25b96b65e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -865,6 +865,7 @@ module lattice lattice_interaction_SlipTwin, & lattice_interaction_SlipTrans, & lattice_interaction_TwinSlip, & + lattice_forestProjection, & lattice_characteristicShear_Twin, & lattice_C66_twin @@ -1065,85 +1066,7 @@ end subroutine lattice_init !-------------------------------------------------------------------------------------------------- -!> @brief xxx -!-------------------------------------------------------------------------------------------------- -subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) - use math, only: & - math_crossproduct, & - math_tensorproduct33, & - math_mul33x33, & - math_mul33x3, & - math_axisAngleToR, & - INRAD, & - MATH_I3 - use IO, only: & - IO_error - - implicit none - integer(pInt), dimension(:), intent(in) :: & - Ntrans - real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & - S, Q - real(pReal), intent(in), optional :: & - cOverA, & - a_fcc, & - a_bcc - - real(pReal), dimension(3,3) :: & - R, & - U, & ! Bain deformation - B, & - ss, sd - real(pReal), dimension(3) :: & - x, y, z - integer(pInt) :: & - i - - - if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' - - - if (present(a_fcc) .and. present(a_bcc)) then ! fcc -> bcc transformation - if ( a_fcc <= 0.0_pReal .or. a_bcc <= 0.0_pReal) print*, 'mist' - do i = 1_pInt,sum(Ntrans) - R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation - lattice_fccTobcc_systemTrans(4,i)*INRAD) - B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system - lattice_fccTobcc_bainRot(4,i)*INRAD) - x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) - y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - - U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & - + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & - + (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) - Q(1:3,1:3,i) = math_mul33x33(R,B) - S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 - enddo - elseif (present(cOverA)) then - ss = MATH_I3 - sd = MATH_I3 - ss(1,3) = sqrt(2.0_pReal)/4.0_pReal - if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & - sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) - - do i = 1_pInt,sum(Ntrans) - x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - y = -math_crossproduct(x,z) - Q(1:3,1,i) = x - Q(1:3,2,i) = y - Q(1:3,3,i) = z - S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 - enddo - endif - - -end subroutine lattice_Trans - - -!-------------------------------------------------------------------------------------------------- -!> @brief Calculation of Schmid matrices, etc. +!> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) use prec, only: & @@ -1385,7 +1308,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip lattice_Scleavage(1:3,1:3,1:3,1:myNcleavage,myPhase) = & - lattice_SchmidMatrix_cleavage(lattice_fcc_ncleavagesystem,'hex',covera) + lattice_SchmidMatrix_cleavage(lattice_hex_ncleavagesystem,'hex',covera) do i = 1_pInt,myNslip ! assign slip system vectors sd(1,i) = lattice_hex_systemSlip(1,i)*1.5_pReal ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)] @@ -1453,8 +1376,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_Sslip_v(1:6,j,i,myPhase) = & math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) enddo - if (abs(math_trace33(lattice_Sslip(1:3,1:3,1,i,myPhase))) > tol_math_check) & - call IO_error(0_pInt,myPhase,i,0_pInt,ext_msg = 'dilatational slip Schmid matrix') enddo do i = 1_pInt,myNtrans lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) @@ -1852,7 +1773,8 @@ end function lattice_C66_twin !> ToDo: Completely untested and incomplete !-------------------------------------------------------------------------------------------------- function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & - C_target66,structure_target) + C_target66,structure_target, & + CoverA_trans,a_bcc,a_fcc) use prec, only: & tol_math_check use IO, only: & @@ -1910,7 +1832,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & if (abs(C_target_unrotated66(i,i)) @brief Calculates Schmid matrix for active cleavage systems !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) - use prec, only: & - tol_math_check + use math, only: & + math_tensorproduct33 use IO, only: & IO_error - use math, only: & - math_trace33, & - math_tensorproduct33 implicit none integer(pInt), dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix real(pReal), intent(in) :: cOverA + real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem real(pReal), dimension(:,:), allocatable :: cleavageSystems @@ -2617,6 +2536,57 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid end function lattice_SchmidMatrix_cleavage +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates forest projection (for edge dislocations) +!-------------------------------------------------------------------------------------------------- +function lattice_forestProjection(Nslip,structure,cOverA) result(projection) + use math, only: & + math_mul3x3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA + real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection + + real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem + real(pReal), dimension(:,:), allocatable :: slipSystems + integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt) :: i, j + + select case(structure) + case('fcc') + NslipMax = LATTICE_FCC_NSLIPSYSTEM + slipSystems = LATTICE_FCC_SYSTEMSLIP + case('bcc') + NslipMax = LATTICE_BCC_NSLIPSYSTEM + slipSystems = LATTICE_BCC_SYSTEMSLIP + case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + NslipMax = LATTICE_HEX_NSLIPSYSTEM + slipSystems = LATTICE_HEX_SYSTEMSLIP + case('bct') + NslipMax = LATTICE_BCT_NSLIPSYSTEM + slipSystems = LATTICE_BCT_SYSTEMSLIP + case default + call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_forrestProjection)') + end select + + if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & + call IO_error(145_pInt,ext_msg='Nslip '//trim(structure)) + if (any(Nslip < 0_pInt)) & + call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) + + coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) + + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) + projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) + enddo; enddo + +end function lattice_forestProjection + + !-------------------------------------------------------------------------------------------------- !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- @@ -2714,11 +2684,86 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) buildCoordinateSystem(1:3,1,i) = direction/norm2(direction) buildCoordinateSystem(1:3,2,i) = normal/norm2(normal) - buildCoordinateSystem(1:3,3,i) = math_crossproduct(direction,normal) + buildCoordinateSystem(1:3,3,i) = math_crossproduct(buildCoordinateSystem(1:3,1,i),& + buildCoordinateSystem(1:3,2,i)) enddo activeSystems enddo activeFamilies end function buildCoordinateSystem +!-------------------------------------------------------------------------------------------------- +!> @brief xxx +!-------------------------------------------------------------------------------------------------- +subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) + use math, only: & + math_crossproduct, & + math_tensorproduct33, & + math_mul33x33, & + math_mul33x3, & + math_axisAngleToR, & + INRAD, & + MATH_I3 + use IO, only: & + IO_error + + implicit none + integer(pInt), dimension(:), intent(in) :: & + Ntrans + real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & + S, Q + real(pReal), intent(in), optional :: & + cOverA, & + a_fcc, & + a_bcc + + real(pReal), dimension(3,3) :: & + R, & + U, & ! Bain deformation + B, & + ss, sd + real(pReal), dimension(3) :: & + x, y, z + integer(pInt) :: & + i + + if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' + + if (present(a_fcc) .and. present(a_bcc)) then ! fcc -> bcc transformation + if ( a_fcc <= 0.0_pReal .or. a_bcc <= 0.0_pReal) print*, 'mist' + do i = 1_pInt,sum(Ntrans) + R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + lattice_fccTobcc_systemTrans(4,i)*INRAD) + B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + lattice_fccTobcc_bainRot(4,i)*INRAD) + x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) + y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) + z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) + + U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & + + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & + + (a_bcc/a_fcc)*math_tensorproduct33(z,z) * sqrt(2.0_pReal) + Q(1:3,1:3,i) = math_mul33x33(R,B) + S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 + enddo + elseif (present(cOverA)) then + ss = MATH_I3 + sd = MATH_I3 + ss(1,3) = sqrt(2.0_pReal)/4.0_pReal + if (cOverA > 1.0_pReal .and. cOverA < 2.0_pReal) & + sd(3,3) = cOverA/sqrt(8.0_pReal/3.0_pReal) + + do i = 1_pInt,sum(Ntrans) + x = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) + z = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) + y = -math_crossproduct(x,z) + Q(1:3,1,i) = x + Q(1:3,2,i) = y + Q(1:3,3,i) = z + S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 + enddo + endif + +end subroutine lattice_Trans + end module lattice diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 6dbcb2b06..b28f59e92 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -302,9 +302,11 @@ subroutine plastic_dislotwin_init if(prm%fccTwinTransNucleation) & prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%forestProjectionEdge= lattice_forestProjection (prm%Nslip,structure(1:3),& + config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config_phase(p)%getFloats('interaction_slipslip'), & structure(1:3)) @@ -606,22 +608,6 @@ subroutine plastic_dislotwin_init ! DEPRECATED BEGIN - allocate(prm%forestProjectionEdge(prm%totalNslip,prm%totalNslip),source = 0.0_pReal) - i = 0_pInt - mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) - index_myFamily = sum(prm%Nslip(1:f-1_pInt)) - slipSystemsLoop: do j = 1_pInt,prm%Nslip(f) - i = i + 1_pInt - do o = 1_pInt, size(prm%Nslip,1) - index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) - do k = 1_pInt,prm%Nslip(o) ! loop over (active) systems in other family (slip) - prm%forestProjectionEdge(index_myFamily+j,index_otherFamily+k) = & - abs(math_mul3x3(lattice_sn(:,sum(lattice_NslipSystem(1:f-1,p))+j,p), & - lattice_st(:,sum(lattice_NslipSystem(1:o-1,p))+k,p))) - enddo; enddo - enddo slipSystemsLoop - enddo mySlipFamilies - allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) i = 0_pInt From bf2b07478724e316bb28e2ae61fffd7a38fa6ea2 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 11 Dec 2018 23:11:59 +0100 Subject: [PATCH 16/23] make parameters obvious --- src/lattice.f90 | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 25b96b65e..1c1c5644e 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -13,6 +13,7 @@ module lattice implicit none private + ! BEGIN DEPRECATED integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures @@ -40,7 +41,7 @@ module lattice lattice_st, & !< sd x sn lattice_sd !< slip direction of slip system - real(pReal), allocatable, dimension(:,:), protected, public :: & + real(pReal), allocatable, dimension(:,:), protected, private :: & lattice_shearTrans !< characteristic transformation shear integer(pInt), allocatable, dimension(:), protected, public :: & @@ -51,22 +52,22 @@ module lattice !-------------------------------------------------------------------------------------------------- ! face centered cubic integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_fcc_NslipSystem = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc + LATTICE_FCC_NSLIPSYSTEM = int([12, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for fcc integer(pInt), dimension(1), parameter, public :: & LATTICE_FCC_NTWINSYSTEM = int([12],pInt) !< # of twin systems per family for fcc integer(pInt), dimension(1), parameter, public :: & - LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc + LATTICE_FCC_NTRANSSYSTEM = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc + LATTICE_FCC_NCLEAVAGESYSTEM = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_FCC_NSLIP = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc + LATTICE_FCC_NSLIP = sum(LATTICE_FCC_NSLIPSYSTEM), & !< total # of slip systems for fcc LATTICE_FCC_NTWIN = sum(LATTICE_FCC_NTWINSYSTEM), & !< total # of twin systems for fcc - LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc - LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc + LATTICE_FCC_NTRANS = sum(LATTICE_FCC_NTRANSSYSTEM), & !< total # of transformation systems for fcc + LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& @@ -115,7 +116,7 @@ module lattice character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] - real(pReal), dimension(3+3,LATTICE_fcc_Ntrans), parameter, private :: & + real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter, private :: & LATTICE_fccTohex_systemTrans = reshape(real( [& -2, 1, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, & @@ -148,6 +149,7 @@ module lattice 10,11 & ],pInt),shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR)) +! ToDo: should be in the interaction function integer(pInt), dimension(LATTICE_FCC_NSLIP,LATTICE_FCC_NSLIP), parameter, public :: & LATTICE_FCC_INTERACTIONSLIPSLIP = reshape(int( [& 1, 2, 2, 4, 6, 5, 3, 5, 5, 4, 5, 6, 9,10, 9,10,11,12, & ! ---> slip @@ -287,7 +289,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! body centered cubic integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - LATTICE_bcc_NslipSystem = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc + LATTICE_BCC_NSLIPSYSTEM = int([ 12, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], pInt) !< # of slip systems per family for bcc integer(pInt), dimension(1), parameter, public :: & LATTICE_BCC_NTWINSYSTEM = int([12], pInt) !< # of twin systems per family for bcc @@ -296,7 +298,7 @@ module lattice LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_BCC_NSLIP = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc + LATTICE_BCC_NSLIP = sum(LATTICE_BCC_NSLIPSYSTEM), & !< total # of slip systems for bcc LATTICE_BCC_NTWIN = sum(LATTICE_BCC_NTWINSYSTEM), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc @@ -435,7 +437,7 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + LATTICE_HEX_NSLIPSYSTEM = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex integer(pInt), dimension(4), parameter, public :: & LATTICE_HEX_NTWINSYSTEM = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex @@ -444,11 +446,11 @@ module lattice LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & - LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex + LATTICE_HEX_NSLIP = sum(LATTICE_HEX_NSLIPSystem), & !< total # of slip systems for hex LATTICE_HEX_NTWIN = sum(LATTICE_HEX_NTWINSYSTEM), & !< total # of twin systems for hex LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex - real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & + real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: & LATTICE_hex_systemSlip = reshape(real([& ! Slip direction Plane normal ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base)) @@ -539,7 +541,7 @@ module lattice '<1 1 . -3>{1 1 . 2} '] - integer(pInt), dimension(LATTICE_hex_Nslip,LATTICE_hex_Nslip), parameter, public :: & + integer(pInt), dimension(LATTICE_HEX_NSLIP,LATTICE_HEX_NSLIP), parameter, public :: & LATTICE_hex_interactionSlipSlip = reshape(int( [& 1, 2, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! ---> slip 2, 1, 2, 3, 3, 3, 7, 7, 7, 13,13,13,13,13,13, 21,21,21,21,21,21,21,21,21,21,21,21, 31,31,31,31,31,31, & ! | @@ -790,7 +792,7 @@ module lattice ! BEGIN DEPRECATED integer(pInt), parameter, public :: & - LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_hex_Nslip, & + LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, & LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures LATTICE_maxNnonSchmid = LATTICE_bcc_NnonSchmid, & !< max # of non-Schmid contributions over lattice structures LATTICE_maxNtrans = LATTICE_fcc_Ntrans, & !< max # of transformation systems over lattice structures @@ -1111,8 +1113,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) xtr, ytr, ztr real(pReal), dimension(3,3,lattice_maxNtrans) :: & Rtr, Utr, Btr, Qtr, Str - real(pReal), dimension(3,lattice_maxNcleavage) :: & - cd, cn, ct integer(pInt) :: & i,j, & myNslip, myNtrans, myNcleavage @@ -1301,9 +1301,9 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) !-------------------------------------------------------------------------------------------------- ! hex (including conversion from miller-bravais (a1=a2=a3=c) to miller (a, b, c) indices) case (LATTICE_hex_ID) - myNslip = lattice_hex_Nslip + myNslip = LATTICE_HEX_NSLIP myNcleavage = lattice_hex_Ncleavage - lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = lattice_hex_NslipSystem + lattice_NslipSystem(1:lattice_maxNslipFamily,myPhase) = LATTICE_HEX_NSLIPSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_hex_NcleavageSystem lattice_interactionSlipSlip(1:myNslip,1:myNslip,myPhase) = lattice_hex_interactionSlipSlip From 1446e9f4abd951ef68a489efb78dbd8069e47d9a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 12 Dec 2018 00:29:19 +0100 Subject: [PATCH 17/23] polished sanity checks + documentation --- src/IO.f90 | 4 + src/lattice.f90 | 396 ++++++++++++++++++++++++------------------------ 2 files changed, 199 insertions(+), 201 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index af59b11b9..9ab6c81b7 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1236,6 +1236,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'zero entry on stiffness diagonal' case (136_pInt) msg = 'zero entry on stiffness diagonal for transformed phase' + case (137_pInt) + msg = 'not defined for lattice structure' + case (138_pInt) + msg = 'not enough interaction parameters given' !-------------------------------------------------------------------------------------------------- ! errors related to the parsing of material.config diff --git a/src/lattice.f90 b/src/lattice.f90 index 1c1c5644e..34535c7f0 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -3,8 +3,8 @@ !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH -!> @brief defines lattice structure definitions, slip and twin system definitions, Schimd matrix -!> calculation and non-Schmid behavior +!> @brief contains lattice structure definitions including Schmid matrices for slip, twin, trans, +! and cleavage as well as interaction among the various systems !-------------------------------------------------------------------------------------------------- module lattice use prec, only: & @@ -24,7 +24,7 @@ module lattice lattice_NcleavageSystem !< total # of transformation systems in each family integer(pInt), allocatable, dimension(:,:,:), protected, public :: & - lattice_interactionSlipSlip !< Slip--slip interaction type + lattice_interactionSlipSlip !< Slip--slip interaction type real(pReal), allocatable, dimension(:,:,:,:,:), protected, public :: & lattice_Sslip, & !< Schmid and non-Schmid matrices @@ -111,7 +111,7 @@ module lattice 2, 1,-1, -1, 1,-1, & -1,-2,-1, -1, 1,-1, & -1, 1, 2, -1, 1,-1 & - ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli + ],pReal),shape(LATTICE_FCC_SYSTEMTWIN)) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] @@ -164,13 +164,13 @@ module lattice 4, 5, 6, 3, 5, 5, 4, 6, 5, 1, 2, 2, 10, 9, 9,10,12,11, & 5, 3, 5, 5, 4, 6, 6, 4, 5, 2, 1, 2, 10, 9,11,12,10, 9, & 6, 5, 4, 5, 6, 4, 5, 5, 3, 2, 2, 1, 12,11, 9,10,10, 9, & - - 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & - 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & - 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & - 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & - 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & - 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & + + 9, 9,11, 9, 9,11,10,10,12,10,10,12, 1, 7, 8, 8, 8, 8, & + 10,10,12,10,10,12, 9, 9,11, 9, 9,11, 7, 1, 8, 8, 8, 8, & + 9,11, 9,10,12,10,10,12,10, 9,11, 9, 8, 8, 1, 7, 8, 8, & + 10,12,10, 9,11, 9, 9,11, 9,10,12,10, 8, 8, 7, 1, 8, 8, & + 11, 9, 9,12,10,10,11, 9, 9,12,10,10, 8, 8, 8, 8, 1, 7, & + 12,10,10,11, 9, 9,12,10,10,11, 9, 9, 8, 8, 8, 8, 7, 1 & ],pInt),shape(LATTICE_FCC_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for fcc !< 1: self interaction !< 2: coplanar interaction @@ -222,7 +222,7 @@ module lattice real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & LATTICE_FCCTOBCC_BAINROT = reshape([& - 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant + 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant 1.0, 0.0, 0.0, 45.0, & 1.0, 0.0, 0.0, 45.0, & 1.0, 0.0, 0.0, 45.0, & @@ -1383,7 +1383,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_shearTrans(i,myPhase) = trs(i) enddo - do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure + do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure do j = 1_pInt,3_pInt lattice_Scleavage_v(1:6,j,i,myPhase) = & math_Mandel33to6(math_symmetric33(lattice_Scleavage(1:3,1:3,j,i,myPhase))) @@ -1395,6 +1395,7 @@ end subroutine lattice_initializeStructure !-------------------------------------------------------------------------------------------------- !> @brief Symmetrizes stiffness matrix according to lattice type +!> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962 !-------------------------------------------------------------------------------------------------- pure function lattice_symmetrizeC66(struct,C66) @@ -1457,7 +1458,7 @@ pure function lattice_symmetrizeC66(struct,C66) lattice_symmetrizeC66(3,2) = C66(1,3) lattice_symmetrizeC66(4,4) = C66(4,4) lattice_symmetrizeC66(5,5) = C66(4,4) - lattice_symmetrizeC66(6,6) = C66(6,6) !J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962 + lattice_symmetrizeC66(6,6) = C66(6,6) case default lattice_symmetrizeC66 = C66 end select @@ -1558,14 +1559,14 @@ pure function lattice_qDisorientation(Q1, Q2, struct) real(pReal), dimension(4,36), parameter :: & symOperations = reshape([& - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations - 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! cubic symmetry operations + 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), & ! 2-fold symmetry 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), & 0.0_pReal, -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & - 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry + 0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & ! 3-fold symmetry -0.5_pReal, 0.5_pReal, 0.5_pReal, 0.5_pReal, & 0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & -0.5_pReal, -0.5_pReal, 0.5_pReal, 0.5_pReal, & @@ -1573,7 +1574,7 @@ real(pReal), dimension(4,36), parameter :: & -0.5_pReal, 0.5_pReal, -0.5_pReal, 0.5_pReal, & 0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & -0.5_pReal, 0.5_pReal, 0.5_pReal, -0.5_pReal, & - 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry + 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & ! 4-fold symmetry 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & -1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, & 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, & @@ -1583,19 +1584,19 @@ real(pReal), dimension(4,36), parameter :: & 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal, & -1.0_pReal/sqrt(2.0_pReal), 0.0_pReal, 0.0_pReal, 1.0_pReal/sqrt(2.0_pReal), & ! - 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations - 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry + 1.0_pReal, 0.0_pReal, 0.0_pReal, 0.0_pReal, & ! hexagonal symmetry operations + 0.0_pReal, 1.0_pReal, 0.0_pReal, 0.0_pReal, & ! 2-fold symmetry 0.0_pReal, 0.0_pReal, 1.0_pReal, 0.0_pReal, & 0.0_pReal, 0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & 0.0_pReal, -0.5_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, & 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & 0.0_pReal, -2.0_pReal/sqrt(3.0_pReal), 0.5_pReal, 0.0_pReal, & - 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry + 2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & ! 6-fold symmetry -2.0_pReal/sqrt(3.0_pReal), 0.0_pReal, 0.0_pReal, 0.5_pReal, & 0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & -0.5_pReal, 0.0_pReal, 0.0_pReal, 2.0_pReal/sqrt(3.0_pReal), & 0.0_pReal, 0.0_pReal, 0.0_pReal, 1.0_pReal & - ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 + ],[4,36]) !< Symmetry operations as quaternions 24 for cubic, 12 for hexagonal = 36 !-------------------------------------------------------------------------------------------------- ! check if a structure with known symmetries is given @@ -1643,32 +1644,25 @@ end function lattice_qDisorientation !-------------------------------------------------------------------------------------------------- -!> @brief Provides characteristtic shear for twinning +!> @brief Characteristic shear for twinning !-------------------------------------------------------------------------------------------------- function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear) use IO, only: & IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=3), intent(in) :: structure - real(pReal), intent(in), optional :: & - cOverA - real(pReal), dimension(sum(Ntwin)) :: characteristicShear + integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=3), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(sum(Ntwin)) :: characteristicShear integer(pInt) :: & - ir, & !< index in reduced list - ig, & !< index in full list + a, & !< index of active system + c, & !< index in complete system list mf, & !< index of my family ms !< index of my system in current family - real(pReal), dimension(LATTICE_FCC_NTWIN), parameter :: & - FCC_SHEARTWIN = 0.5_pReal*sqrt(2.0_pReal) - - real(pReal), dimension(LATTICE_BCC_NTWIN), parameter :: & - BCC_SHEARTWIN = 0.5_pReal*sqrt(2.0_pReal) - integer(pInt), dimension(LATTICE_HEX_NTWIN), parameter :: & - HEX_SHEARTWIN = reshape(int( [& + HEX_SHEARTWIN = reshape(int( [& 1, & ! <-10.1>{10.2} 1, & 1, & @@ -1693,32 +1687,31 @@ function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(charact 4, & 4, & 4 & - ],pInt),[LATTICE_HEX_NTWIN]) ! indicator to formula further below + ],pInt),[LATTICE_HEX_NTWIN]) ! indicator to formulas below - ir = 0_pInt + a = 0_pInt myFamilies: do mf = 1_pInt,size(Ntwin,1) mySystems: do ms = 1_pInt,Ntwin(mf) - ir = ir + 1_pInt - select case(structure) - case('fcc') - ig = sum(LATTICE_FCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = FCC_SHEARTWIN(ig) - case('bcc') - ig = sum(LATTICE_BCC_NTWINSYSTEM(1:mf-1))+ms - characteristicShear(ir) = BCC_SHEARTWIN(ig) + a = a + 1_pInt + select case(trim(structure)) + case('fcc','bcc') + characteristicShear(a) = 0.5_pReal*sqrt(2.0_pReal) case('hex') - if (.not. present(CoverA)) call IO_error(0_pInt) - ig = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms - select case(HEX_SHEARTWIN(ig)) ! from Christian & Mahajan 1995 p.29 + if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='lattice_characteristicShear_Twin') + c = sum(LATTICE_HEX_NTWINSYSTEM(1:mf-1))+ms + select case(HEX_SHEARTWIN(c)) ! from Christian & Mahajan 1995 p.29 case (1_pInt) ! <-10.1>{10.2} - characteristicShear(ir) = (3.0_pReal-cOverA*cOverA)/sqrt(3.0_pReal)/CoverA + characteristicShear(a) = (3.0_pReal-cOverA**2.0_pReal)/sqrt(3.0_pReal)/CoverA case (2_pInt) ! <11.6>{-1-1.1} - characteristicShear(ir) = 1.0_pReal/cOverA + characteristicShear(a) = 1.0_pReal/cOverA case (3_pInt) ! <10.-2>{10.1} - characteristicShear(ir) = (4.0_pReal*cOverA*cOverA-9.0_pReal)/sqrt(48.0_pReal)/cOverA + characteristicShear(a) = (4.0_pReal*cOverA**2.0_pReal-9.0_pReal)/sqrt(48.0_pReal)/cOverA case (4_pInt) ! <11.-3>{11.2} - characteristicShear(ir) = 2.0_pReal*(cOverA*cOverA-2.0_pReal)/3.0_pReal/cOverA + characteristicShear(a) = 2.0_pReal*(cOverA**2.0_pReal-2.0_pReal)/3.0_pReal/cOverA end select + case default + call IO_error(137_pInt,ext_msg='lattice_characteristicShear_Twin: '//trim(structure)) end select enddo mySystems enddo myFamilies @@ -1727,7 +1720,7 @@ end function lattice_characteristicShear_Twin !-------------------------------------------------------------------------------------------------- -!> @brief Calculates rotated elasticity matrices for twinning +!> @brief Rotated elasticity matrices for twinning in Mandel notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) use IO, only: & @@ -1742,25 +1735,29 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family character(len=*), intent(in) :: structure !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C66 - real(pReal), intent(in) :: cOverA - real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin + real(pReal), dimension(6,6), intent(in) :: C66 !< unrotated parent stiffness matrix + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(6,6,sum(Ntwin)) :: lattice_C66_twin - real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem + real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem - real(pReal), dimension(3,3) :: R + real(pReal), dimension(3,3) :: R integer(pInt) :: i - select case(structure) + select case(trim(structure)) case('fcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,structure,cOverA) + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_FCC_NSLIPSYSTEM,LATTICE_FCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) case('bcc') - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,structure,cOverA) + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMTWIN,& + trim(structure),0.0_pReal) case('hex','hexagonal') !ToDo: "No alias policy": long or short? - coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,'hex',cOverA) + coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,& + 'hex',cOverA) case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_C66_twin)') + call IO_error(137_pInt,ext_msg='lattice_C66_twin: '//trim(structure)) end select + do i = 1, sum(Ntwin) R = math_axisAngleToR(coordinateSystem(1:3,2,i), 180.0_pReal * INRAD) ! ToDo: Why always 180 deg? lattice_C66_twin(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(math_Mandel66to3333(C66),R)) @@ -1769,8 +1766,8 @@ end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- -!> @brief Calculates rotated elasticity matrices for transformation -!> ToDo: Completely untested and incomplete +!> @brief Rotated elasticity matrices for transformation in Mandel notation +!> ToDo: Completely untested and incomplete and undocumented !-------------------------------------------------------------------------------------------------- function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & C_target66,structure_target, & @@ -1791,7 +1788,7 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & math_crossproduct implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family character(len=*), intent(in) :: & structure_target, & !< lattice structure structure_parent !< lattice structure @@ -1840,16 +1837,14 @@ lattice_C66_trans = 0.0_pReal end function - !-------------------------------------------------------------------------------------------------- -!> @brief Non-schmid tensor -!> ToDo: Clean description needed -! Schmid matrices with non-Schmid contributions according to Koester_etal2012, Acta Materialia 60 (2012) -! 3894–3901, eq. (17) ("n1" is replaced by either "np" or "nn" according to either positive or negative slip direction) -! "np" and "nn" according to Gröger_etal2008, Acta Materialia 56 (2008) 5412–5425, table 1 -! (corresponds to their "n1" for positive and negative slip direction respectively) +!> @brief Non-schmid projections for bcc with up to 6 coefficients +! Koester et al. 2012, Acta Materialia 60 (2012) 3894–3901, eq. (17) +! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1 !-------------------------------------------------------------------------------------------------- function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix) + use IO, only: & + IO_error use math, only: & INRAD, & math_tensorproduct33, & @@ -1857,21 +1852,22 @@ function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSc math_mul33x3, & math_axisAngleToR implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients - integer(pInt), intent(in) :: sense !< sense (-1,+1) + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + real(pReal), dimension(:), intent(in) :: nonSchmidCoefficients !< non-Schmid coefficients for projections + integer(pInt), intent(in) :: sense !< sense (-1,+1) + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: nonSchmidMatrix - - real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem - real(pReal), dimension(:), allocatable :: direction - real(pReal), dimension(:), allocatable :: normal,np + real(pReal), dimension(1:3,1:3,sum(Nslip)) :: coordinateSystem !< coordinate system of slip system + real(pReal), dimension(:), allocatable :: & + direction, normal, np integer(pInt) :: i - if (abs(sense) /= 1_pInt) write(6,*) 'mist' - coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,'bcc',0.0_pReal) - coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) - nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) + if (abs(sense) /= 1_pInt) call IO_error(0_pInt,ext_msg='lattice_nonSchmidMatrix') + + coordinateSystem = buildCoordinateSystem(Nslip,LATTICE_BCC_NSLIPSYSTEM,LATTICE_BCC_SYSTEMSLIP,& + 'bcc',0.0_pReal) + coordinateSystem(1:3,1,1:sum(Nslip)) = coordinateSystem(1:3,1,1:sum(Nslip)) *real(sense,pReal) ! convert unidirectional coordinate system + nonSchmidMatrix = lattice_SchmidMatrix_slip(Nslip,'bcc',0.0_pReal) ! Schmid contribution do i = 1_pInt,sum(Nslip) direction = coordinateSystem(1:3,1,i) @@ -1895,8 +1891,8 @@ end function lattice_nonSchmidMatrix !-------------------------------------------------------------------------------------------------- -!> @brief Populates slip-slip interaction matrix -!> details: only active slip systems are considered +!> @brief Slip-slip interaction matrix +!> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -1904,7 +1900,7 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( implicit none integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip-slip + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-slip interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Nslip),sum(Nslip)) :: interactionMatrix @@ -1925,20 +1921,17 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( interactionTypes = LATTICE_BCT_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCT_NSLIPSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (slip slip interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Nslip,Nslip,NslipMax,NslipMax,interactionValues,interactionTypes) end function lattice_interaction_SlipSlip !-------------------------------------------------------------------------------------------------- -!> @brief Populates twin-twin interaction matrix -!> details: only active twin systems are considered +!> @brief Twin-twin interaction matrix +!> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -1946,7 +1939,7 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( implicit none integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Ntwin),sum(Ntwin)) :: interactionMatrix @@ -1967,7 +1960,7 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( 2,2,2,2,2,2,2,2,2,1,1,1, & 2,2,2,2,2,2,2,2,2,1,1,1, & 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for fcc + ],pInt),shape(FCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for fcc integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NTWIN), parameter :: & BCC_INTERACTIONTWINTWIN = reshape(int( [& @@ -1983,7 +1976,7 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( 3,3,3,2,2,3,3,3,3,1,3,3, & 2,3,3,3,3,3,3,2,3,3,1,3, & 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),shape(BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for bcc + ],pInt),shape(BCC_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for bcc !< 1: self interaction !< 2: collinear interaction !< 3: other interaction @@ -2016,7 +2009,7 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,16,17,17, & 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,16,17, & 20,20,20,20,20,20, 19,19,19,19,19,19, 18,18,18,18,18,18, 17,17,17,17,17,16 & - ],pInt),shape(HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 16 in total) + ],pInt),shape(HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for hex select case(structure) case('fcc') @@ -2029,30 +2022,26 @@ function lattice_interaction_TwinTwin(Ntwin,interactionValues,structure) result( interactionTypes = HEX_INTERACTIONTWINTWIN NtwinMax = LATTICE_HEX_NTWINSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin twin interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinTwin: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntwin,Ntwin,NtwinMax,NtwinMax,interactionValues,interactionTypes) end function lattice_interaction_TwinTwin !-------------------------------------------------------------------------------------------------- -!> @brief Populates trans-trans interaction matrix -!> details: only active transformation systems are considered +!> @brief Trans-trans interaction matrix +!> details only active trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TransTrans(Ntrans,interactionValues,structure) result(interactionMatrix) use IO, only: & IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin - character(len=*), intent(in) :: & - structure !< lattice structure of parent crystal + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active trans systems per family + real(pReal), dimension(:), intent(in) :: interactionValues !< values for trans-trans interaction + character(len=*), intent(in) :: structure !< lattice structure (parent crystal) real(pReal), dimension(sum(Ntrans),sum(Ntrans)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NtransMax @@ -2072,24 +2061,23 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure) resu 2,2,2,2,2,2,2,2,2,1,1,1, & 2,2,2,2,2,2,2,2,2,1,1,1, & 2,2,2,2,2,2,2,2,2,1,1,1 & - ],pInt),shape(FCC_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans--trans interaction types for fcc + ],pInt),shape(FCC_INTERACTIONTRANSTRANS),order=[2,1]) !< Trans-trans interaction types for fcc if (trim(structure) == 'fcc') then interactionTypes = FCC_INTERACTIONTRANSTRANS NtransMax = LATTICE_FCC_NTRANSSYSTEM else - call IO_error(132_pInt,ext_msg=trim(structure)//' (trans trans interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_TransTrans: '//trim(structure)) end if - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo interactionMatrix = buildInteraction(Ntrans,Ntrans,NtransMax,NtransMax,interactionValues,interactionTypes) + end function lattice_interaction_TransTrans !-------------------------------------------------------------------------------------------------- -!> @brief Populates slip-twin interaction matrix -!> details: only active slip and twin systems are considered +!> @brief Slip-twin interaction matrix +!> details only active slip and twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -2098,7 +2086,7 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r implicit none integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntwin !< number of active twin systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-twin interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Nslip),sum(Ntwin)) :: interactionMatrix @@ -2127,7 +2115,7 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for fcc + ],pInt),shape(FCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for fcc !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction @@ -2158,7 +2146,7 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r 3,3,3,2,2,3,3,3,3,1,3,3, & 2,3,3,3,3,3,3,2,3,3,1,3, & 3,2,3,3,3,3,2,3,3,3,3,1 & - ],pInt),shape(BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for bcc + ],pInt),shape(BCC_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for bcc !< 1: coplanar interaction !< 2: screw trace between slip system and twin habit plane (easy cross slip) !< 3: other interaction @@ -2203,7 +2191,7 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24, & 21,21,21,21,21,21, 22,22,22,22,22,22, 23,23,23,23,23,23, 24,24,24,24,24,24 & ! - ],pInt),shape(HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip--twin interaction types for hex (isotropic, 24 in total) + ],pInt),shape(HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for hex select case(structure) @@ -2220,20 +2208,17 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r NslipMax = LATTICE_HEX_NSLIPSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (slip twin interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTwin: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Nslip,Ntwin,NslipMax,NtwinMax,interactionValues,interactionTypes) end function lattice_interaction_SlipTwin !-------------------------------------------------------------------------------------------------- -!> @brief Populates trans-trans interaction matrix -!> details: only active transformation systems are considered +!> @brief Slip-trans interaction matrix +!> details only active slip and trans systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -2242,9 +2227,9 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) implicit none integer(pInt), dimension(:), intent(in) :: Nslip, & !< number of active slip systems per family Ntrans !< number of active trans systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values slip--trans + real(pReal), dimension(:), intent(in) :: interactionValues !< values for slip-trans interaction character(len=*), intent(in) :: & - structure !< lattice structure of parent crystal + structure !< lattice structure (parent crystal) real(pReal), dimension(sum(Nslip),sum(Ntrans)) :: interactionMatrix integer(pInt), dimension(:), allocatable :: NslipMax, & @@ -2265,14 +2250,14 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) 3,3,3,2,2,2,3,3,3,1,1,1, & 2,2,2,3,3,3,3,3,3,1,1,1, & 3,3,3,3,3,3,2,2,2,1,1,1, & - + 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4, & 4,4,4,4,4,4,4,4,4,4,4,4 & - ],pInt),shape(FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip--trans interaction types for fcc + ],pInt),shape(FCC_INTERACTIONSLIPTRANS),order=[2,1]) !< Slip-trans interaction types for fcc select case(structure) case('fcc') @@ -2280,19 +2265,17 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) NslipMax = LATTICE_FCC_NSLIPSYSTEM NtransMax = LATTICE_FCC_NTRANSSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (slip trans interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTrans: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo interactionMatrix = buildInteraction(Nslip,Ntrans,NslipMax,NtransMax,interactionValues,interactionTypes) end function lattice_interaction_SlipTrans !-------------------------------------------------------------------------------------------------- -!> @brief Populates twin-slip interaction matrix -!> details: only active twin and slip systems are considered +!> @brief Twin-slip interaction matrix +!> details only active twin and slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix) use IO, only: & @@ -2301,7 +2284,7 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r implicit none integer(pInt), dimension(:), intent(in) :: Ntwin, & !< number of active twin systems per family Nslip !< number of active slip systems per family - real(pReal), dimension(:), intent(in) :: interactionValues !< interaction values twin-twin + real(pReal), dimension(:), intent(in) :: interactionValues !< values for twin-twin interaction character(len=*), intent(in) :: structure !< lattice structure real(pReal), dimension(sum(Ntwin),sum(Nslip)) :: interactionMatrix @@ -2310,10 +2293,10 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r integer(pInt), dimension(:,:), allocatable :: interactionTypes integer(pInt), dimension(LATTICE_FCC_NTWIN,LATTICE_FCC_NSLIP), parameter :: & - FCC_INTERACTIONTWINSLIP = 1_pInt !< Twin--Slip interaction types for fcc + FCC_INTERACTIONTWINSLIP = 1_pInt !< Twin-Slip interaction types for fcc integer(pInt), dimension(LATTICE_BCC_NTWIN,LATTICE_BCC_NSLIP), parameter :: & - BCC_INTERACTIONTWINSLIP = 1_pInt !< Twin--slip interaction types for bcc + BCC_INTERACTIONTWINSLIP = 1_pInt !< Twin-slip interaction types for bcc integer(pInt), dimension(LATTICE_HEX_NTWIN,LATTICE_HEX_NSLIP), parameter :: & HEX_INTERACTIONTWINSLIP = reshape(int( [& @@ -2344,7 +2327,7 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24, & 4, 4, 4, 8, 8, 8, 12,12,12, 16,16,16,16,16,16, 20,20,20,20,20,20,20,20,20,20,20,20, 24,24,24,24,24,24 & - ],pInt),shape(HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin--twin interaction types for hex (isotropic, 20 in total) + ],pInt),shape(HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin-twin interaction types for hex select case(structure) case('fcc') @@ -2360,19 +2343,17 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r NtwinMax = LATTICE_HEX_NTWINSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM case default - call IO_error(132_pInt,ext_msg=trim(structure)//' (twin slip interaction)') + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinSlip: '//trim(structure)) end select - !if (size(interactionValues) > maxval(interactionTypes)) & - ! call IO_error(0_pInt) ! ToDo - interactionMatrix = buildInteraction(Ntwin,Nslip,NtwinMax,NslipMax,interactionValues,interactionTypes) end function lattice_interaction_TwinSlip !-------------------------------------------------------------------------------------------------- -!> @brief Calculates Schmid matrix for active slip systems +!> @brief Schmid matrix for slip +!> details only active slip systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) use prec, only: & @@ -2384,14 +2365,14 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) math_tensorproduct33 implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure real(pReal), intent(in) :: cOverA real(pReal), dimension(3,3,sum(Nslip)) :: SchmidMatrix real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem real(pReal), dimension(:,:), allocatable :: slipSystems - integer(pInt), dimension(:), allocatable :: NslipMax + integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i select case(structure) @@ -2408,7 +2389,7 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) NslipMax = LATTICE_BCT_NSLIPSYSTEM slipSystems = LATTICE_BCT_SYSTEMSLIP case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_slip)') + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) end select if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & @@ -2428,7 +2409,8 @@ end function lattice_SchmidMatrix_slip !-------------------------------------------------------------------------------------------------- -!> @brief Calculates Schmid matrix for active twin systems +!> @brief Schmid matrix for twinning +!> details only active twin systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) use prec, only: & @@ -2440,14 +2422,14 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) math_tensorproduct33 implicit none - integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA + integer(pInt), dimension(:), intent(in) :: Ntwin !< number of active twin systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio real(pReal), dimension(3,3,sum(Ntwin)) :: SchmidMatrix real(pReal), dimension(3,3,sum(Ntwin)) :: coordinateSystem real(pReal), dimension(:,:), allocatable :: twinSystems - integer(pInt), dimension(:), allocatable :: NtwinMax + integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt) :: i select case(structure) @@ -2461,14 +2443,14 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) NtwinMax = LATTICE_HEX_NTWINSYSTEM twinSystems = LATTICE_HEX_SYSTEMTWIN case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_twin)') + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) end select if (any(NtwinMax(1:size(Ntwin)) - Ntwin < 0_pInt)) & call IO_error(145_pInt,ext_msg='Ntwin '//trim(structure)) if (any(Ntwin < 0_pInt)) & call IO_error(144_pInt,ext_msg='Ntwin '//trim(structure)) - + coordinateSystem = buildCoordinateSystem(Ntwin,NtwinMax,twinSystems,structure,cOverA) do i = 1, sum(Ntwin) @@ -2481,7 +2463,8 @@ end function lattice_SchmidMatrix_twin !-------------------------------------------------------------------------------------------------- -!> @brief Calculates Schmid matrix for active cleavage systems +!> @brief Schmid matrix for cleavage +!> details only active cleavage systems are considered !-------------------------------------------------------------------------------------------------- function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix) use math, only: & @@ -2490,9 +2473,9 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA + integer(pInt), dimension(:), intent(in) :: Ncleavage !< number of active cleavage systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio real(pReal), dimension(3,3,3,sum(Ncleavage)) :: SchmidMatrix real(pReal), dimension(3,3,sum(Ncleavage)) :: coordinateSystem @@ -2517,7 +2500,7 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_SchmidMatrix_cleavage)') + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) end select if (any(NcleavageMax(1:size(Ncleavage)) - Ncleavage < 0_pInt)) & @@ -2537,7 +2520,7 @@ end function lattice_SchmidMatrix_cleavage !-------------------------------------------------------------------------------------------------- -!> @brief Calculates forest projection (for edge dislocations) +!> @brief Forest projection (for edge dislocations) !-------------------------------------------------------------------------------------------------- function lattice_forestProjection(Nslip,structure,cOverA) result(projection) use math, only: & @@ -2546,9 +2529,9 @@ function lattice_forestProjection(Nslip,structure,cOverA) result(projection) IO_error implicit none - integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family - character(len=*), intent(in) :: structure !< lattice structure - real(pReal), intent(in) :: cOverA + integer(pInt), dimension(:), intent(in) :: Nslip !< number of active slip systems per family + character(len=*), intent(in) :: structure !< lattice structure + real(pReal), intent(in) :: cOverA !< c/a ratio real(pReal), dimension(sum(Nslip),sum(Nslip)) :: projection real(pReal), dimension(3,3,sum(Nslip)) :: coordinateSystem @@ -2570,7 +2553,7 @@ function lattice_forestProjection(Nslip,structure,cOverA) result(projection) NslipMax = LATTICE_BCT_NSLIPSYSTEM slipSystems = LATTICE_BCT_SYSTEMSLIP case default - call IO_error(130_pInt,ext_msg=trim(structure)//' (lattice_forrestProjection)') + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) end select if (any(NslipMax(1:size(Nslip)) - Nslip < 0_pInt)) & @@ -2579,7 +2562,7 @@ function lattice_forestProjection(Nslip,structure,cOverA) result(projection) call IO_error(144_pInt,ext_msg='Nslip '//trim(structure)) coordinateSystem = buildCoordinateSystem(Nslip,NslipMax,slipSystems,structure,cOverA) - + do i=1_pInt, sum(Nslip); do j=1_pInt, sum(Nslip) projection(i,j) = abs(math_mul3x3(coordinateSystem(1:3,2,i),coordinateSystem(1:3,3,j))) enddo; enddo @@ -2590,8 +2573,9 @@ end function lattice_forestProjection !-------------------------------------------------------------------------------------------------- !> @brief Populates reduced interaction matrix !-------------------------------------------------------------------------------------------------- -pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) - +function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) + use IO, only: & + IO_error implicit none integer(pInt), dimension(:), intent(in) :: & activeA, & !< number of active systems as specified in material.config @@ -2599,7 +2583,7 @@ pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) maxA, & !< number of maximum available systems maxB !< number of maximum available systems real(pReal), dimension(:), intent(in) :: values !< interaction values - integer(pInt), dimension(:,:), intent(in) :: matrix !< full interaction matrix + integer(pInt), dimension(:,:), intent(in) :: matrix !< complete interaction matrix real(pReal), dimension(sum(activeA),sum(activeB)) :: buildInteraction integer(pInt) :: & @@ -2613,6 +2597,8 @@ pure function buildInteraction(activeA,activeB,maxA,maxB,values,matrix) otherFamilies: do of = 1_pInt,size(activeB,1) index_otherFamily = sum(activeB(1:of-1_pInt)) otherSystems: do os = 1_pInt,activeB(of) + if(matrix(sum(maxA(1:mf-1))+ms, sum(maxB(1:of-1))+os) > size(values)) & + call IO_error(138,ext_msg='buildInteraction') buildInteraction(index_myFamily+ms,index_otherFamily+os) = & values(matrix(sum(maxA(1:mf-1))+ms, sum(maxB(1:of-1))+os)) enddo otherSystems; enddo otherFamilies; @@ -2624,16 +2610,18 @@ end function buildInteraction !-------------------------------------------------------------------------------------------------- !> @brief build a local coordinate system in a slip, twin, trans, cleavage system -!> @details: Order: Direction, plane (normal), and common perpendicular +!> @details Order: Direction, plane (normal), and common perpendicular !-------------------------------------------------------------------------------------------------- -function buildCoordinateSystem(active,maximum,system,structure,cOverA) +function buildCoordinateSystem(active,complete,system,structure,cOverA) + use IO, only: & + IO_error use math, only: & math_crossproduct implicit none integer(pInt), dimension(:), intent(in) :: & active, & - maximum + complete real(pReal), dimension(:,:), intent(in) :: & system character(len=*), intent(in) :: & @@ -2646,46 +2634,50 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) real(pReal), dimension(3) :: & direction, normal integer(pInt) :: & - i, & !< index in reduced matrix - j, & !< index in full matrix + a, & !< index of active system + c, & !< index in complete system matrix f, & !< index of my family s !< index of my system in current family - i = 0_pInt + a = 0_pInt activeFamilies: do f = 1_pInt,size(active,1) activeSystems: do s = 1_pInt,active(f) - i = i + 1_pInt - j = sum(maximum(1:f-1))+s + a = a + 1_pInt + c = sum(complete(1:f-1))+s select case(trim(structure)) case ('fcc','bcc') - direction = system(1:3,j) - normal = system(4:6,j) - - case ('hex') - !ToDo: check if c/a ratio is sensible - ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) - direction = [ system(1,j)*1.5_pReal, & - (system(1,j)+2.0_pReal*system(2,j))*sqrt(0.75_pReal), & - system(4,j)*CoverA ] + direction = system(1:3,c) + normal = system(4:6,c) - ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - normal = [ system(5,j), & - (system(5,j)+2.0_pReal*system(6,j))/ sqrt(3.0_pReal), & - system(8,j)/CoverA ] + case ('hex') + if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + + direction = [ system(1,c)*1.5_pReal, & + (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & + system(4,c)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) + + normal = [ system(5,c), & + (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & + system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) case ('bct') - !ToDo: check if c/a ratio is sensible - direction = [system(1:2,j),system(3,i)*CoverA] - normal = [system(4:5,j),system(6,i)/CoverA] + if (cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + direction = [system(1:2,c),system(3,c)*cOverA] + normal = [system(4:5,c),system(6,c)/cOverA] + + case default + call IO_error(137_pInt,ext_msg='buildCoordinateSystem: '//trim(structure)) end select - buildCoordinateSystem(1:3,1,i) = direction/norm2(direction) - buildCoordinateSystem(1:3,2,i) = normal/norm2(normal) - buildCoordinateSystem(1:3,3,i) = math_crossproduct(buildCoordinateSystem(1:3,1,i),& - buildCoordinateSystem(1:3,2,i)) + buildCoordinateSystem(1:3,1,a) = direction/norm2(direction) + buildCoordinateSystem(1:3,2,a) = normal/norm2(normal) + buildCoordinateSystem(1:3,3,a) = math_crossproduct(buildCoordinateSystem(1:3,1,a),& + buildCoordinateSystem(1:3,2,a)) enddo activeSystems enddo activeFamilies @@ -2693,7 +2685,9 @@ function buildCoordinateSystem(active,maximum,system,structure,cOverA) end function buildCoordinateSystem !-------------------------------------------------------------------------------------------------- -!> @brief xxx +!> @brief Helper function to define transformation systems +! Needed for Schmid_trans + C66_trans +! ToDo: completely untested and uncommented !-------------------------------------------------------------------------------------------------- subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) use math, only: & @@ -2728,7 +2722,7 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) i if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' - + if (present(a_fcc) .and. present(a_bcc)) then ! fcc -> bcc transformation if ( a_fcc <= 0.0_pReal .or. a_bcc <= 0.0_pReal) print*, 'mist' do i = 1_pInt,sum(Ntrans) @@ -2738,7 +2732,7 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) lattice_fccTobcc_bainRot(4,i)*INRAD) x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) + z = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) U = (a_bcc/a_fcc)*math_tensorproduct33(x,x) & + (a_bcc/a_fcc)*math_tensorproduct33(y,y) * sqrt(2.0_pReal) & @@ -2763,7 +2757,7 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 enddo endif - + end subroutine lattice_Trans end module lattice From 4edaab6da68181f2ad3b78f779b30a90e71948db Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 13 Dec 2018 11:11:45 +0100 Subject: [PATCH 18/23] definition of cleavage systems did not work bct definition was overly complicated --- src/lattice.f90 | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 34535c7f0..b54feb007 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2639,6 +2639,11 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) f, & !< index of my family s !< index of my system in current family + if (trim(structure) == 'bct' .and. cOverA > 2.0_pReal) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + if (trim(structure) == 'hex' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) & + call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) + a = 0_pInt activeFamilies: do f = 1_pInt,size(active,1) activeSystems: do s = 1_pInt,active(f) @@ -2647,13 +2652,12 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) select case(trim(structure)) - case ('fcc','bcc') + case ('fcc','bcc','iso','ort','bct') direction = system(1:3,c) normal = system(4:6,c) case ('hex') if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & - call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) direction = [ system(1,c)*1.5_pReal, & (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & @@ -2663,12 +2667,6 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) - case ('bct') - if (cOverA > 2.0_pReal) & - call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) - direction = [system(1:2,c),system(3,c)*cOverA] - normal = [system(4:5,c),system(6,c)/cOverA] - case default call IO_error(137_pInt,ext_msg='buildCoordinateSystem: '//trim(structure)) From 25bd6faf7cd2ddaec6529810bb8738e2f36d69fa Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 14 Dec 2018 06:39:49 +0100 Subject: [PATCH 19/23] left over "if" caused wrong coordinate systems for hex --- src/lattice.f90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index b54feb007..1da02e192 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -2657,12 +2657,9 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) normal = system(4:6,c) case ('hex') - if (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal) & - direction = [ system(1,c)*1.5_pReal, & (system(1,c)+2.0_pReal*system(2,c))*sqrt(0.75_pReal), & system(4,c)*cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(c/a)]) - normal = [ system(5,c), & (system(5,c)+2.0_pReal*system(6,c))/sqrt(3.0_pReal), & system(8,c)/cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(c/a)) From f4cf38fa2273948cbb26dc01992c788d4742fe20 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 21 Dec 2018 23:53:21 +0100 Subject: [PATCH 20/23] implementing C66 rotation for transformation --- src/lattice.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 1da02e192..21b575b64 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -1769,8 +1769,8 @@ end function lattice_C66_twin !> @brief Rotated elasticity matrices for transformation in Mandel notation !> ToDo: Completely untested and incomplete and undocumented !-------------------------------------------------------------------------------------------------- -function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & - C_target66,structure_target, & +function lattice_C66_trans(Ntrans,C_parent66, & + structure_target, & CoverA_trans,a_bcc,a_fcc) use prec, only: & tol_math_check @@ -1790,17 +1790,14 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & implicit none integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family character(len=*), intent(in) :: & - structure_target, & !< lattice structure - structure_parent !< lattice structure - real(pReal), dimension(6,6), intent(in) :: C_parent66, C_target66 + structure_target !< lattice structure + real(pReal), dimension(6,6), intent(in) :: C_parent66 real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans - - real(pReal), dimension(3,3) :: Q,S + real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S real(pReal) :: a_bcc, a_fcc, CoverA_trans integer(pInt) :: i - if (trim(structure_parent) /= 'hex') write(6,*) "Mist" !-------------------------------------------------------------------------------------------------- ! elasticity matrix of the target phase in cube orientation @@ -1829,7 +1826,10 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_parent, & if (abs(C_target_unrotated66(i,i)) Date: Sat, 22 Dec 2018 00:19:51 +0100 Subject: [PATCH 21/23] poviding stiffness for transformation as function --- src/lattice.f90 | 11 +-- src/plastic_dislotwin.f90 | 147 +++++++++++++++++++------------------- 2 files changed, 81 insertions(+), 77 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 21b575b64..e187dc2a2 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -869,7 +869,8 @@ module lattice lattice_interaction_TwinSlip, & lattice_forestProjection, & lattice_characteristicShear_Twin, & - lattice_C66_twin + lattice_C66_twin, & + lattice_C66_trans contains @@ -1793,6 +1794,7 @@ function lattice_C66_trans(Ntrans,C_parent66, & structure_target !< lattice structure real(pReal), dimension(6,6), intent(in) :: C_parent66 real(pReal), dimension(6,6) :: C_bar66, C_target_unrotated66 + real(pReal), dimension(3,3,3,3) :: C_target_unrotated real(pReal), dimension(6,6,sum(Ntrans)) :: lattice_C66_trans real(pReal), dimension(3,3,sum(Ntrans)) :: Q,S real(pReal) :: a_bcc, a_fcc, CoverA_trans @@ -1822,17 +1824,16 @@ function lattice_C66_trans(Ntrans,C_parent66, & write(6,*) "Mist" endif + do i = 1_pInt, 6_pInt if (abs(C_target_unrotated66(i,i)) param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - mse => microstructure(phase_plasticityInstance(p))) + mse => microstructure(phase_plasticityInstance(p)), & + config => config_phase(p)) ! This data is read in already in lattice prm%mu = lattice_mu(p) prm%nu = lattice_nu(p) prm%C66 = lattice_C66(1:6,1:6,p) - structure = config_phase(p)%getString('lattice_structure') + structure = config%getString('lattice_structure') !-------------------------------------------------------------------------------------------------- ! slip related parameters - prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then @@ -303,28 +304,28 @@ subroutine plastic_dislotwin_init prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%forestProjectionEdge= lattice_forestProjection (prm%Nslip,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config_phase(p)%getFloats('interaction_slipslip'), & + config%getFloats('interaction_slipslip'), & structure(1:3)) - prm%rho0 = config_phase(p)%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_0 - prm%rhoDip0 = config_phase(p)%getFloats('rhoedgedip0',requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_dip_0 - prm%v0 = config_phase(p)%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%burgers_slip = config_phase(p)%getFloats('slipburgers',requiredShape=shape(prm%Nslip)) - prm%Qedge = config_phase(p)%getFloats('qedge', requiredShape=shape(prm%Nslip)) !ToDo: rename (ask Karo) - prm%CLambdaSlip = config_phase(p)%getFloats('clambdaslip',requiredShape=shape(prm%Nslip)) - prm%p = config_phase(p)%getFloats('p_slip', requiredShape=shape(prm%Nslip)) - prm%q = config_phase(p)%getFloats('q_slip', requiredShape=shape(prm%Nslip)) - prm%B = config_phase(p)%getFloats('b', requiredShape=shape(prm%Nslip), & + prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_0 + prm%rhoDip0 = config%getFloats('rhoedgedip0',requiredShape=shape(prm%Nslip)) !ToDo: rename to rho_dip_0 + prm%v0 = config%getFloats('v0', requiredShape=shape(prm%Nslip)) + prm%burgers_slip = config%getFloats('slipburgers',requiredShape=shape(prm%Nslip)) + prm%Qedge = config%getFloats('qedge', requiredShape=shape(prm%Nslip)) !ToDo: rename (ask Karo) + prm%CLambdaSlip = config%getFloats('clambdaslip',requiredShape=shape(prm%Nslip)) + prm%p = config%getFloats('p_slip', requiredShape=shape(prm%Nslip)) + prm%q = config%getFloats('q_slip', requiredShape=shape(prm%Nslip)) + prm%B = config%getFloats('b', requiredShape=shape(prm%Nslip), & defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) - prm%tau_peierls = config_phase(p)%getFloats('tau_peierls',requiredShape=shape(prm%Nslip), & + prm%tau_peierls = config%getFloats('tau_peierls',requiredShape=shape(prm%Nslip), & defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) - prm%CEdgeDipMinDistance = config_phase(p)%getFloat('cedgedipmindistance') + prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) @@ -356,33 +357,33 @@ subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! twin related parameters - prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) if (prm%totalNtwin > 0_pInt) then prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& - config_phase(p)%getFloats('interaction_twintwin'), & + config%getFloats('interaction_twintwin'), & structure(1:3)) - prm%burgers_twin = config_phase(p)%getFloats('twinburgers') - prm%twinsize = config_phase(p)%getFloats('twinsize') - prm%r = config_phase(p)%getFloats('r_twin') + prm%burgers_twin = config%getFloats('twinburgers') + prm%twinsize = config%getFloats('twinsize') + prm%r = config%getFloats('r_twin') - prm%xc_twin = config_phase(p)%getFloat('xc_twin') - prm%L0_twin = config_phase(p)%getFloat('l0_twin') - prm%MaxTwinFraction = config_phase(p)%getFloat('maxtwinfraction') ! ToDo: only used in postResults - prm%Cthresholdtwin = config_phase(p)%getFloat('cthresholdtwin', defaultVal=0.0_pReal) - prm%Cmfptwin = config_phase(p)%getFloat('cmfptwin', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%xc_twin = config%getFloat('xc_twin') + prm%L0_twin = config%getFloat('l0_twin') + prm%MaxTwinFraction = config%getFloat('maxtwinfraction') ! ToDo: only used in postResults + prm%Cthresholdtwin = config%getFloat('cthresholdtwin', defaultVal=0.0_pReal) + prm%Cmfptwin = config%getFloat('cmfptwin', defaultVal=0.0_pReal) ! ToDo: How to handle that??? prm%shear_twin = lattice_characteristicShear_Twin(prm%Ntwin,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) prm%C66_twin = lattice_C66_twin(prm%Ntwin,prm%C66,structure(1:3),& - config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)) + config%getFloat('c/a',defaultVal=0.0_pReal)) if (.not. prm%fccTwinTransNucleation) then - prm%Ndot0_twin = config_phase(p)%getFloats('ndot0_twin') + prm%Ndot0_twin = config%getFloats('ndot0_twin') prm%Ndot0_twin = math_expand(prm%Ndot0_twin,prm%Ntwin) endif @@ -399,29 +400,36 @@ subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! transformation related parameters - prm%Ntrans = config_phase(p)%getInts('ntrans', defaultVal=emptyIntArray) + prm%Ntrans = config%getInts('ntrans', defaultVal=emptyIntArray) prm%totalNtrans = sum(prm%Ntrans) if (prm%totalNtrans > 0_pInt) then - prm%burgers_trans = config_phase(p)%getFloats('transburgers') + prm%burgers_trans = config%getFloats('transburgers') prm%burgers_trans = math_expand(prm%burgers_trans,prm%Ntrans) - prm%Cthresholdtrans = config_phase(p)%getFloat('cthresholdtrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%transStackHeight = config_phase(p)%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%Cmfptrans = config_phase(p)%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%deltaG = config_phase(p)%getFloat('deltag') - prm%xc_trans = config_phase(p)%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? - prm%L0_trans = config_phase(p)%getFloat('l0_trans') + prm%Cthresholdtrans = config%getFloat('cthresholdtrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%transStackHeight = config%getFloat('transstackheight', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%Cmfptrans = config%getFloat('cmfptrans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%deltaG = config%getFloat('deltag') + prm%xc_trans = config%getFloat('xc_trans', defaultVal=0.0_pReal) ! ToDo: How to handle that??? + prm%L0_trans = config%getFloat('l0_trans') prm%interaction_TransTrans = lattice_interaction_TransTrans(prm%Ntrans,& - config_phase(p)%getFloats('interaction_transtrans'), & + config%getFloats('interaction_transtrans'), & structure(1:3)) + + prm%C66_trans = lattice_C66_trans(prm%Ntrans,prm%C66, & + config%getString('trans_lattice_structure'), & + 0.0_pReal, & + config%getFloat('a_bcc', defaultVal=0.0_pReal), & + config%getFloat('a_fcc', defaultVal=0.0_pReal)) + if (lattice_structure(p) /= LATTICE_fcc_ID) then - prm%Ndot0_trans = config_phase(p)%getFloats('ndot0_trans') + prm%Ndot0_trans = config%getFloats('ndot0_trans') prm%Ndot0_trans = math_expand(prm%Ndot0_trans,prm%Ntrans) endif - prm%lamellarsizePerTransSystem = config_phase(p)%getFloats('lamellarsize') + prm%lamellarsizePerTransSystem = config%getFloats('lamellarsize') prm%lamellarsizePerTransSystem = math_expand(prm%lamellarsizePerTransSystem,prm%Ntrans) - prm%s = config_phase(p)%getFloats('s_trans',defaultVal=[0.0_pReal]) + prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,prm%Ntrans) else allocate(prm%lamellarsizePerTransSystem(0)) @@ -429,48 +437,48 @@ subroutine plastic_dislotwin_init endif if (sum(prm%Ntwin) > 0_pInt .or. prm%totalNtrans > 0_pInt) then - prm%SFE_0K = config_phase(p)%getFloat('sfe_0k') - prm%dSFE_dT = config_phase(p)%getFloat('dsfe_dt') - prm%VcrossSlip = config_phase(p)%getFloat('vcrossslip') + prm%SFE_0K = config%getFloat('sfe_0k') + prm%dSFE_dT = config%getFloat('dsfe_dt') + prm%VcrossSlip = config%getFloat('vcrossslip') endif if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& - config_phase(p)%getFloats('interaction_sliptwin'), & + config%getFloats('interaction_sliptwin'), & structure(1:3)) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& - config_phase(p)%getFloats('interaction_twinslip'), & + config%getFloats('interaction_twinslip'), & structure(1:3)) if (prm%fccTwinTransNucleation .and. prm%totalNtwin > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntwin is [6,6] endif if (prm%totalNslip > 0_pInt .and. prm%totalNtrans > 0_pInt) then prm%interaction_SlipTrans = lattice_interaction_SlipTrans(prm%Nslip,prm%Ntrans,& - config_phase(p)%getFloats('interaction_sliptrans'), & + config%getFloats('interaction_sliptrans'), & structure(1:3)) if (prm%fccTwinTransNucleation .and. prm%totalNtrans > 12_pInt) write(6,*) 'mist' ! ToDo: implement better test. The model will fail also if ntrans is [6,6] endif - prm%aTolRho = config_phase(p)%getFloat('atol_rho', defaultVal=0.0_pReal) - prm%aTolTwinFrac = config_phase(p)%getFloat('atol_twinfrac', defaultVal=0.0_pReal) - prm%aTolTransFrac = config_phase(p)%getFloat('atol_transfrac', defaultVal=0.0_pReal) + prm%aTolRho = config%getFloat('atol_rho', defaultVal=0.0_pReal) + prm%aTolTwinFrac = config%getFloat('atol_twinfrac', defaultVal=0.0_pReal) + prm%aTolTransFrac = config%getFloat('atol_transfrac', defaultVal=0.0_pReal) - prm%CAtomicVolume = config_phase(p)%getFloat('catomicvolume') - prm%GrainSize = config_phase(p)%getFloat('grainsize') + prm%CAtomicVolume = config%getFloat('catomicvolume') + prm%GrainSize = config%getFloat('grainsize') - prm%D0 = config_phase(p)%getFloat('d0') - prm%Qsd = config_phase(p)%getFloat('qsd') - prm%SolidSolutionStrength = config_phase(p)%getFloat('solidsolutionstrength') - if (config_phase(p)%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') - prm%dipoleformation = .not. config_phase(p)%keyExists('/nodipoleformation/') - prm%sbVelocity = config_phase(p)%getFloat('shearbandvelocity',defaultVal=0.0_pReal) + prm%D0 = config%getFloat('d0') + prm%Qsd = config%getFloat('qsd') + prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') + if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') + prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') + prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) if (prm%sbVelocity > 0.0_pReal) then - prm%sbResistance = config_phase(p)%getFloat('shearbandresistance') - prm%sbQedge = config_phase(p)%getFloat('qedgepersbsystem') - prm%pShearBand = config_phase(p)%getFloat('p_shearband') - prm%qShearBand = config_phase(p)%getFloat('q_shearband') + prm%sbResistance = config%getFloat('shearbandresistance') + prm%sbQedge = config%getFloat('qedgepersbsystem') + prm%pShearBand = config%getFloat('p_shearband') + prm%qShearBand = config%getFloat('q_shearband') endif !if (Ndot0PerTwinFamily(f,p) < 0.0_pReal) & @@ -511,7 +519,7 @@ subroutine plastic_dislotwin_init prm%qShearBand <= 0.0_pReal) & call IO_error(211_pInt,el=p,ext_msg='qShearBand ('//PLASTICITY_DISLOTWIN_label//')') - outputs = config_phase(p)%getStrings('(output)', defaultVal=emptyStringArray) + outputs = config%getStrings('(output)', defaultVal=emptyStringArray) allocate(prm%outputID(0)) do i= 1_pInt, size(outputs) outputID = undefined_ID @@ -608,7 +616,6 @@ subroutine plastic_dislotwin_init ! DEPRECATED BEGIN - allocate(prm%C66_trans(6,6,prm%totalNtrans) ,source=0.0_pReal) allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) i = 0_pInt transFamiliesLoop: do f = 1_pInt,size(prm%Ntrans,1) @@ -616,14 +623,10 @@ subroutine plastic_dislotwin_init transSystemsLoop: do j = 1_pInt,prm%Ntrans(f) i = i + 1_pInt prm%Schmid_trans(1:3,1:3,i) = lattice_Strans(1:3,1:3,sum(lattice_Ntranssystem(1:f-1,p))+j,p) - !* Rotate trans elasticity matrices - index_otherFamily = sum(lattice_NtransSystem(1:f-1_pInt,p)) ! index in full lattice trans list - prm%C66_trans(1:6,1:6,index_myFamily+j) = & - math_Mandel3333to66(math_rotate_forward3333(lattice_trans_C3333(1:3,1:3,1:3,1:3,p),& - lattice_Qtrans(1:3,1:3,index_otherFamily+j,p))) enddo transSystemsLoop enddo transFamiliesLoop -! DEPRECATED END +! DEPRECATED END + startIndex=1_pInt endIndex=prm%totalNslip From e083520c7361249add0584ace031756358344a6f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 22 Dec 2018 07:49:52 +0100 Subject: [PATCH 22/23] trans systems now handled centrally remove inactive (= untested) definitions. --- src/lattice.f90 | 438 ++++++++++++-------------------------- src/plastic_dislotwin.f90 | 31 ++- 2 files changed, 150 insertions(+), 319 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index e187dc2a2..b4d0fa8dd 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -32,18 +32,13 @@ module lattice real(pReal), allocatable, dimension(:,:,:,:), protected, public :: & lattice_Sslip_v, & !< Mandel notation of lattice_Sslip - lattice_Scleavage_v, & !< Mandel notation of lattice_Scleavege - lattice_Qtrans, & !< Total rotation: Q = R*B - lattice_Strans !< Eigendeformation tensor for phase transformation + lattice_Scleavage_v !< Mandel notation of lattice_Scleavege real(pReal), allocatable, dimension(:,:,:), protected, public :: & lattice_sn, & !< normal direction of slip system lattice_st, & !< sd x sn lattice_sd !< slip direction of slip system - real(pReal), allocatable, dimension(:,:), protected, private :: & - lattice_shearTrans !< characteristic transformation shear - integer(pInt), allocatable, dimension(:), protected, public :: & lattice_NnonSchmid !< total # of non-Schmid contributions for each structure ! END DEPRECATED @@ -70,7 +65,7 @@ module lattice LATTICE_FCC_NCLEAVAGE = sum(LATTICE_FCC_NCLEAVAGESYSTEM) !< total # of cleavage systems for fcc real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: & - LATTICE_fcc_systemSlip = reshape(real([& + LATTICE_FCC_SYSTEMSLIP = reshape(real([& ! Slip direction Plane normal ! SCHMID-BOAS notation 0, 1,-1, 1, 1, 1, & ! B2 -1, 0, 1, 1, 1, 1, & ! B4 @@ -116,22 +111,6 @@ module lattice character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & ['<-2 1 1>{1 1 1}'] - real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter, private :: & - LATTICE_fccTohex_systemTrans = reshape(real( [& - -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 & - ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) - integer(pInt), dimension(2_pInt,LATTICE_FCC_NTWIN), parameter, public :: & LATTICE_FCC_TWINNUCLEATIONSLIPPAIR = reshape(int( [& @@ -185,95 +164,6 @@ module lattice !<11: crossing btw one {110} and one {111} plane !<12: collinear btw one {110} and one {111} plane - real(pReal), dimension(LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_fccTohex_shearTrans = sqrt(1.0_pReal/8.0_pReal) - - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& - 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 0.0, 1.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 0.0, 1.0, 10.26, & - 0.0, 0.0, 1.0, -10.26, & - 1.0, 0.0, 0.0, 10.26, & - 1.0, 0.0, 0.0, -10.26, & - 0.0, 1.0, 0.0, 10.26, & - 0.0, 1.0, 0.0, -10.26 & - ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) - - integer(pInt), dimension(9,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_FCCTOBCC_BAINVARIANT = reshape(int( [& - 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 1, 0, 0, 0, 1, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 1, 0, 1, 0, 0, 0, 0, 1, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0, & - 0, 0, 1, 1, 0, 0, 0, 1, 0 & - ],pInt),shape(LATTICE_FCCTOBCC_BAINVARIANT)) - - real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter, private :: & - LATTICE_FCCTOBCC_BAINROT = reshape([& - 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 1.0, 0.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 1.0, 0.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0, & - 0.0, 0.0, 1.0, 45.0 & - ],shape(LATTICE_FCCTOBCC_BAINROT)) - - real(pReal), dimension(LATTICE_fcc_Ntrans,LATTICE_fcc_Ntrans), parameter, private :: & ! Matrix for projection of shear from slip system to fault-band (twin) systems - LATTICE_FCCTOBCC_PROJECTIONTRANS = reshape(real([& ! For ns = nt = nr - 0, 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - -1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 1,-1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 1,-1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, -1, 0, 1, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 1,-1, 0, 0, 0, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 1,-1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, -1, 0, 1, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 1,-1, 0, 0, 0, 0, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,-1, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, -1, 0, 1, & - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1,-1, 0 & - ],pReal),shape(LATTICE_FCCTOBCC_PROJECTIONTRANS),order=[2,1]) - - real(pReal), parameter, private :: & - LATTICE_fccTobcc_projectionTransFactor = sqrt(3.0_pReal/4.0_pReal) - - real(pReal), parameter, public :: & - LATTICE_fccTobcc_shearCritTrans = 0.0224 - - integer(pInt), dimension(2_pInt,LATTICE_fcc_Ntrans), parameter, public :: & - LATTICE_FCCTOBCC_TRANSNUCLEATIONTWINPAIR = reshape(int( [& - 4, 7, & - 1, 10, & - 1, 4, & - 7, 10, & - 2, 8, & - 5, 11, & - 8, 11, & - 2, 5, & - 6, 12, & - 3, 9, & - 3, 12, & - 6, 9 & - ],pInt),shape(LATTICE_FCCTOBCC_TRANSNUCLEATIONTWINPAIR)) - real(pReal), dimension(3+3,LATTICE_fcc_Ncleavage), parameter, private :: & LATTICE_fcc_systemCleavage = reshape(real([& ! Cleavage direction Plane normal @@ -332,31 +222,6 @@ module lattice 1,-1, 1, -1, 1, 2, & -1, 1, 1, 1,-1, 2, & 1, 1, 1, 1, 1,-2 & - ! Slip system <111>{123} - ! 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 & ],pReal),shape(LATTICE_BCC_SYSTEMSLIP)) character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & @@ -581,10 +446,7 @@ module lattice 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,36,37,37, & 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,36,37, & 42,42,42, 41,41,41, 40,40,40, 39,39,39,39,39,39, 38,38,38,38,38,38,38,38,38,38,38,38, 37,37,37,37,37,36 & - ! - ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) - - + ],pInt),shape(LATTICE_HEX_INTERACTIONSLIPSLIP),order=[2,1]) !< Slip--slip interaction types for hex (onion peel naming scheme) real(pReal), dimension(4+4,LATTICE_hex_Ncleavage), parameter, private :: & @@ -755,9 +617,9 @@ module lattice 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,169,170,170, & 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,169,170, & 182,182, 181,181, 180,180, 179,179,179,179, 178,178, 177,177,177,177, 176,176, 175,175, 174,174,174,174, 173,173,173,173,173,173,173,173, 172, 172, 172, 172, 171,171,171,171,171,171,171,171, 169,170,170,170,170,170,170,169 & - ],pInt),[lattice_bct_Nslip,lattice_bct_Nslip],order=[2,1]) + !-------------------------------------------------------------------------------------------------- ! isotropic integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & @@ -774,13 +636,14 @@ module lattice 1, 0, 0, 0, 0, 1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_iso_Ncleavage]) + !-------------------------------------------------------------------------------------------------- ! orthorhombic integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ort_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ort_Ncleavage = sum(lattice_ort_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ort_Ncleavage = sum(lattice_ort_NcleavageSystem) !< total # of cleavage systems for ortho real(pReal), dimension(3+3,LATTICE_ort_Ncleavage), parameter, private :: & LATTICE_ort_systemCleavage = reshape(real([& @@ -795,19 +658,16 @@ module lattice LATTICE_maxNslip = max(LATTICE_FCC_NSLIP,LATTICE_BCC_NSLIP,LATTICE_HEX_NSLIP, & LATTICE_bct_Nslip), & !< max # of slip systems over lattice structures LATTICE_maxNnonSchmid = LATTICE_bcc_NnonSchmid, & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = LATTICE_fcc_Ntrans, & !< max # of transformation systems over lattice structures LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & LATTICE_hex_Ncleavage, & - LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures + LATTICE_iso_Ncleavage,LATTICE_ort_Ncleavage), & !< max # of cleavage systems over lattice structures LATTICE_maxNinteraction = 182_pInt !END DEPRECATED - real(pReal), dimension(:,:,:), allocatable, private :: & - temp66 real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66 real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & - lattice_C3333, lattice_trans_C3333 + lattice_C3333 real(pReal), dimension(:), allocatable, public, protected :: & lattice_mu, lattice_nu @@ -860,6 +720,8 @@ module lattice LATTICE_hex_ID, & lattice_SchmidMatrix_slip, & lattice_SchmidMatrix_twin, & + lattice_SchmidMatrix_trans, & + lattice_SchmidMatrix_cleavage, & lattice_nonSchmidMatrix, & lattice_interaction_SlipSlip, & lattice_interaction_TwinTwin, & @@ -896,10 +758,8 @@ subroutine lattice_init integer(pInt) :: i,p real(pReal), dimension(:), allocatable :: & temp, & - CoverA, & !< c/a ratio for low symmetry type lattice - CoverA_trans, & !< c/a ratio for transformed hex type lattice - a_fcc, & !< lattice parameter a for fcc austenite - a_bcc !< lattice paramater a for bcc martensite + CoverA !< c/a ratio for low symmetry type lattice + write(6,'(/,a)') ' <<<+- lattice init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -910,9 +770,8 @@ subroutine lattice_init allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(lattice_C66(6,6,Nphases), source=0.0_pReal) - allocate(temp66(6,6,Nphases), source=0.0_pReal) allocate(lattice_C3333(3,3,3,3,Nphases), source=0.0_pReal) - allocate(lattice_trans_C3333(3,3,3,3,Nphases), source=0.0_pReal) + allocate(lattice_thermalExpansion33 (3,3,3,Nphases), source=0.0_pReal) ! constant, linear, quadratic coefficients allocate(lattice_thermalConductivity33 (3,3,Nphases), source=0.0_pReal) allocate(lattice_damageDiffusion33 (3,3,Nphases), source=0.0_pReal) @@ -948,14 +807,8 @@ subroutine lattice_init allocate(lattice_Scleavage_v(6,3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_NcleavageSystem(lattice_maxNcleavageFamily,Nphases),source=0_pInt) - allocate(lattice_shearTrans(lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Qtrans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(lattice_Strans(3,3,lattice_maxNtrans,Nphases),source=0.0_pReal) - allocate(CoverA(Nphases),source=0.0_pReal) - allocate(CoverA_trans(Nphases),source=0.0_pReal) - allocate(a_fcc(Nphases),source=0.0_pReal) - allocate(a_bcc(Nphases),source=0.0_pReal) + allocate(lattice_sd(3,lattice_maxNslip,Nphases),source=0.0_pReal) allocate(lattice_st(3,lattice_maxNslip,Nphases),source=0.0_pReal) @@ -998,20 +851,8 @@ subroutine lattice_init lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) - temp66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal) - temp66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal) - temp66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal) - temp66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal) - temp66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal) - temp66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal) - temp66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal) - temp66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal) - temp66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal) CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) - CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal) - a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) - a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) @@ -1062,7 +903,7 @@ subroutine lattice_init .and. lattice_structure(i) == LATTICE_hex_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a if ((CoverA(i) > 2.0_pReal) & .and. lattice_structure(i) == LATTICE_bct_ID) call IO_error(131_pInt,el=i) ! checking physical significance of c/a - call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i)) + call lattice_initializeStructure(i, CoverA(i)) enddo end subroutine lattice_init @@ -1071,7 +912,7 @@ end subroutine lattice_init !-------------------------------------------------------------------------------------------------- !> @brief !!!!!!!DEPRECTATED!!!!!! !-------------------------------------------------------------------------------------------------- -subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) +subroutine lattice_initializeStructure(myPhase,CoverA) use prec, only: & tol_math_check use math, only: & @@ -1094,30 +935,18 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) implicit none integer(pInt), intent(in) :: myPhase real(pReal), intent(in) :: & - CoverA, & - CoverA_trans, & - a_fcc, & - a_bcc + CoverA real(pReal), dimension(3) :: & sdU, snU, & np, nn - real(pReal), dimension(3,3) :: & - sstr, sdtr, sttr real(pReal), dimension(3,lattice_maxNslip) :: & sd, sn real(pReal), dimension(3,3,2,lattice_maxNnonSchmid,lattice_maxNslip) :: & sns - real(pReal), dimension(lattice_maxNtrans) :: & - trs - real(pReal), dimension(3,lattice_maxNtrans) :: & - xtr, ytr, ztr - real(pReal), dimension(3,3,lattice_maxNtrans) :: & - Rtr, Utr, Btr, Qtr, Str integer(pInt) :: & - i,j, & - myNslip, myNtrans, myNcleavage - real(pReal) :: c11bar, c12bar, c13bar, c14bar, c33bar, c44bar, A, B + j, i, & + myNslip, myNcleavage lattice_C66(1:6,1:6,myPhase) = lattice_symmetrizeC66(lattice_structure(myPhase),& lattice_C66(1:6,1:6,myPhase)) @@ -1138,44 +967,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) call IO_error(135_pInt,el=i,ip=myPhase,ext_msg='matrix diagonal "el"ement of phase "ip"') enddo -! Elasticity matrices for transformed phase - select case(lattice_structure(myPhase)) - case (LATTICE_fcc_ID) - select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) - lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase) = lattice_C3333(1:3,1:3,1:3,1:3,myPhase) - temp66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase)) - do i = 1_pInt, 6_pInt - if (abs(temp66(i,i,myPhase))bcc transformation') - enddo - case (LATTICE_hex_ID) - c11bar = (lattice_C66(1,1,myPhase) + lattice_C66(1,2,myPhase) + 2.0_pReal*lattice_C66(4,4,myPhase))/2.0_pReal - c12bar = (lattice_C66(1,1,myPhase) + 5.0_pReal*lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase))/6.0_pReal - c33bar = (lattice_C66(1,1,myPhase) + 2.0_pReal*lattice_C66(1,2,myPhase) + 4.0_pReal*lattice_C66(4,4,myPhase))/3.0_pReal - c13bar = (lattice_C66(1,1,myPhase) + 2.0_pReal*lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase))/3.0_pReal - c44bar = (lattice_C66(1,1,myPhase) - lattice_C66(1,2,myPhase) + lattice_C66(4,4,myPhase))/3.0_pReal - c14bar = (lattice_C66(1,1,myPhase) - lattice_C66(1,2,myPhase) - 2.0_pReal*lattice_C66(4,4,myPhase)) & - /(3.0_pReal*sqrt(2.0_pReal)) - A = c14bar**(2.0_pReal)/c44bar - B = c14bar**(2.0_pReal)/(0.5_pReal*(c11bar - c12bar)) - temp66(1,1,myPhase) = c11bar - A - temp66(1,2,myPhase) = c12bar + A - temp66(1,3,myPhase) = c13bar - temp66(3,3,myPhase) = c33bar - temp66(4,4,myPhase) = c44bar - B - - temp66(1:6,1:6,myPhase) = lattice_symmetrizeC66(trans_lattice_structure(myPhase),& - temp66(1:6,1:6,myPhase)) - lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(temp66(1:6,1:6,myPhase)) - temp66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_trans_C3333(1:3,1:3,1:3,1:3,myPhase)) - do i = 1_pInt, 6_pInt - if (abs(temp66(i,i,myPhase))hex transformation') - enddo - end select - end select - forall (i = 1_pInt:3_pInt) & lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_thermalExpansion33 (1:3,1:3,i,myPhase)) @@ -1195,7 +986,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),& lattice_hydrogenfluxMobility33 (1:3,1:3,myPhase)) myNslip = 0_pInt - myNtrans = 0_pInt myNcleavage = 0_pInt select case(lattice_structure(myPhase)) @@ -1203,7 +993,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! fcc case (LATTICE_fcc_ID) myNslip = LATTICE_FCC_NSLIP - myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage lattice_NslipSystem (1:lattice_maxNslipFamily,myPhase) = lattice_fcc_NslipSystem lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,myPhase) = lattice_fcc_NcleavageSystem @@ -1217,51 +1006,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - ! Phase transformation - select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) ! fcc to bcc transformation - do i = 1_pInt,myNtrans - Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation - lattice_fccTobcc_systemTrans(4,i)*INRAD) - Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system - lattice_fccTobcc_bainRot(4,i)*INRAD) - xtr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) - ytr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) - ztr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation - if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then - Utr(1:3,1:3,i) = (a_bcc/a_fcc)*math_tensorproduct33(xtr(1:3,i), xtr(1:3,i)) + & - sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ytr(1:3,i), ytr(1:3,i)) + & - sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ztr(1:3,i), ztr(1:3,i)) - endif - Qtr(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), Btr(1:3,1:3,i)) - Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), Utr(1:3,1:3,i)) - MATH_I3 - enddo - case (LATTICE_hex_ID) - sstr(1:3,1:3) = MATH_I3 - sstr(1,3) = sqrt(2.0_pReal)/4.0_pReal - sdtr(1:3,1:3) = MATH_I3 - if (CoverA_trans > 1.0_pReal .and. CoverA_trans < 2.0_pReal) then - sdtr(3,3) = CoverA_trans/sqrt(8.0_pReal/3.0_pReal) - endif - sttr = math_mul33x33(sdtr, sstr) - do i = 1_pInt,myNtrans - xtr(1:3,i) = lattice_fccTohex_systemTrans(1:3,i)/norm2(lattice_fccTohex_systemTrans(1:3,i)) - ztr(1:3,i) = lattice_fccTohex_systemTrans(4:6,i)/norm2(lattice_fccTohex_systemTrans(4:6,i)) - ytr(1:3,i) = -math_crossproduct(xtr(1:3,i), ztr(1:3,i)) - Rtr(1:3,1,i) = xtr(1:3,i) - Rtr(1:3,2,i) = ytr(1:3,i) - Rtr(1:3,3,i) = ztr(1:3,i) - Qtr(1:3,1:3,i) = Rtr(1:3,1:3,i) - Str(1:3,1:3,i) = math_mul33x33(Rtr(1:3,1:3,i), math_mul33x33(sttr, transpose(Rtr(1:3,1:3,i)))) - Str(1:3,1:3,i) = Str(1:3,1:3,i) - MATH_I3 - trs(i) = lattice_fccTohex_shearTrans(i) - enddo - case default - Qtr = 0.0_pReal - Str = 0.0_pReal - end select - !-------------------------------------------------------------------------------------------------- ! bcc @@ -1378,11 +1122,6 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) math_Mandel33to6(math_symmetric33(lattice_Sslip(1:3,1:3,j,i,myPhase))) enddo enddo - do i = 1_pInt,myNtrans - lattice_Qtrans(1:3,1:3,i,myPhase) = Qtr(1:3,1:3,i) - lattice_Strans(1:3,1:3,i,myPhase) = Str(1:3,1:3,i) - lattice_shearTrans(i,myPhase) = trs(i) - enddo do i = 1_pInt,myNcleavage ! store slip system vectors and Schmid matrix for my structure do j = 1_pInt,3_pInt @@ -1830,7 +1569,7 @@ function lattice_C66_trans(Ntrans,C_parent66, & call IO_error(135_pInt,el=i,ext_msg='matrix diagonal "el"ement in transformation') enddo C_target_unrotated = math_Mandel66to3333(C_target_unrotated66) - call lattice_Trans(Q,S,Ntrans,CoverA_trans,a_fcc,a_bcc) + call buildTransformationSystem(Q,S,Ntrans,CoverA_trans,a_fcc,a_bcc) do i = 1, sum(Ntrans) lattice_C66_trans(1:6,1:6,i) = math_Mandel3333to66(math_rotate_forward3333(C_target_unrotated,Q(1:3,1:3,i))) @@ -2463,6 +2202,38 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) end function lattice_SchmidMatrix_twin +!-------------------------------------------------------------------------------------------------- +!> @brief Schmid matrix for twinning +!> details only active twin systems are considered +!-------------------------------------------------------------------------------------------------- +function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix) + use prec, only: & + tol_math_check + use IO, only: & + IO_error + use math, only: & + math_trace33, & + math_tensorproduct33 + + implicit none + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + real(pReal), intent(in) :: cOverA !< c/a ratio + real(pReal), dimension(3,3,sum(Ntrans)) :: SchmidMatrix + + integer(pInt) :: i + + character(len=*), intent(in) :: & + structure_target !< lattice structure + + real(pReal), dimension(3,3,sum(Ntrans)) :: devNull + real(pReal) :: a_bcc, a_fcc +! ToDo: Error checking!!!!!!!!!!!!!!!!!!! + call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA,a_fcc,a_bcc) + + +end function lattice_SchmidMatrix_trans + + !-------------------------------------------------------------------------------------------------- !> @brief Schmid matrix for cleavage !> details only active cleavage systems are considered @@ -2680,12 +2451,16 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) end function buildCoordinateSystem + !-------------------------------------------------------------------------------------------------- !> @brief Helper function to define transformation systems -! Needed for Schmid_trans + C66_trans -! ToDo: completely untested and uncommented +! Needed to calculate Schmid matrix and rotated stiffness matrices. +! @details: set c/a = 0.0 for fcc -> bcc transformation +! set a_bcc = 0.0 for fcc -> bcc transformation !-------------------------------------------------------------------------------------------------- -subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) +subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) + use prec, only: & + dEq0 use math, only: & math_crossproduct, & math_tensorproduct33, & @@ -2701,30 +2476,93 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) integer(pInt), dimension(:), intent(in) :: & Ntrans real(pReal), dimension(3,3,sum(Ntrans)), intent(out) :: & - S, Q - real(pReal), intent(in), optional :: & - cOverA, & - a_fcc, & - a_bcc + Q, & !< Total rotation: Q = R*B + S !< Eigendeformation tensor for phase transformation + real(pReal), intent(in) :: & + cOverA, & !< c/a for target hex structure + a_bcc, & !< lattice parameter a for target bcc structure + a_fcc !< lattice parameter a for parent fcc structure real(pReal), dimension(3,3) :: & - R, & - U, & ! Bain deformation - B, & + R, & !< Pitsch rotation + U, & !< Bain deformation + B, & !< Rotation of fcc to Bain coordinate system ss, sd real(pReal), dimension(3) :: & x, y, z integer(pInt) :: & i + real(pReal), dimension(3+3,LATTICE_FCC_NTRANS), parameter :: & + LATTICE_FCCTOHEX_SYSTEMTRANS = reshape(real( [& + -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 & + ],pReal),shape(LATTICE_FCCTOHEX_SYSTEMTRANS)) + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_SYSTEMTRANS = reshape([& + 0.0, 1.0, 0.0, 10.26, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 0.0, 1.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 0.0, 1.0, 10.26, & + 0.0, 0.0, 1.0, -10.26, & + 1.0, 0.0, 0.0, 10.26, & + 1.0, 0.0, 0.0, -10.26, & + 0.0, 1.0, 0.0, 10.26, & + 0.0, 1.0, 0.0, -10.26 & + ],shape(LATTICE_FCCTOBCC_SYSTEMTRANS)) + + integer(pInt), dimension(9,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINVARIANT = reshape(int( [& + 1, 0, 0, 0, 1, 0, 0, 0, 1, & ! Pitsch OR (Ma & Hartmaier 2014, Table 3) + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 1, 0, 0, 0, 1, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 1, 0, 1, 0, 0, 0, 0, 1, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0, & + 0, 0, 1, 1, 0, 0, 0, 1, 0 & + ],pInt),shape(LATTICE_FCCTOBCC_BAINVARIANT)) + + real(pReal), dimension(4,LATTICE_fcc_Ntrans), parameter :: & + LATTICE_FCCTOBCC_BAINROT = reshape([& + 1.0, 0.0, 0.0, 45.0, & ! Rotate fcc austensite to bain variant + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 1.0, 0.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 1.0, 0.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0, & + 0.0, 0.0, 1.0, 45.0 & + ],shape(LATTICE_FCCTOBCC_BAINROT)) if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' - if (present(a_fcc) .and. present(a_bcc)) then ! fcc -> bcc transformation - if ( a_fcc <= 0.0_pReal .or. a_bcc <= 0.0_pReal) print*, 'mist' + if (a_bcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation + if (a_bcc <= 0.0_pReal) print*, 'mist' do i = 1_pInt,sum(Ntrans) - R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & lattice_fccTobcc_systemTrans(4,i)*INRAD) - B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + B = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & lattice_fccTobcc_bainRot(4,i)*INRAD) x = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) y = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) @@ -2736,7 +2574,7 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) Q(1:3,1:3,i) = math_mul33x33(R,B) S(1:3,1:3,i) = math_mul33x33(R,U) - MATH_I3 enddo - elseif (present(cOverA)) then + elseif (cOverA > 0.0_pReal .and. dEq0(a_bcc)) then ! fcc -> hex transformation ss = MATH_I3 sd = MATH_I3 ss(1,3) = sqrt(2.0_pReal)/4.0_pReal @@ -2750,10 +2588,10 @@ subroutine lattice_Trans(Q,S,Ntrans,cOverA,a_fcc,a_bcc) Q(1:3,1,i) = x Q(1:3,2,i) = y Q(1:3,3,i) = z - S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 + S(1:3,1:3,i) = math_mul33x33(Q(1:3,1:3,i), math_mul33x33(math_mul33x33(sd,ss), transpose(Q(1:3,1:3,i)))) - MATH_I3 ! ToDo: This is of interest for the Schmid matrix only enddo endif -end subroutine lattice_Trans +end subroutine buildTransformationSystem end module lattice diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index b6d9c65f4..0c56e6ba5 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -108,7 +108,7 @@ module plastic_dislotwin integer(pInt), dimension(:,:), allocatable :: & fcc_twinNucleationSlipPair ! ToDo: Better name? Is also use for trans real(pReal), dimension(:,:), allocatable :: & - forestProjectionEdge, & + forestProjection, & C66 real(pReal), dimension(:,:,:), allocatable :: & Schmid_trans, & @@ -305,7 +305,7 @@ subroutine plastic_dislotwin_init prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%forestProjectionEdge= lattice_forestProjection (prm%Nslip,structure(1:3),& + prm%forestProjection = lattice_forestProjection (prm%Nslip,structure(1:3),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & @@ -323,7 +323,7 @@ subroutine plastic_dislotwin_init prm%B = config%getFloats('b', requiredShape=shape(prm%Nslip), & defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) prm%tau_peierls = config%getFloats('tau_peierls',requiredShape=shape(prm%Nslip), & - defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) + defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) ! Deprecated prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') @@ -337,7 +337,7 @@ subroutine plastic_dislotwin_init prm%p = math_expand(prm%p, prm%Nslip) prm%q = math_expand(prm%q, prm%Nslip) prm%B = math_expand(prm%B, prm%Nslip) - prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) + prm%tau_peierls = math_expand(prm%tau_peierls, prm%Nslip) ! sanity checks if (any(prm%rho0 < 0.0_pReal)) extmsg = trim(extmsg)//'rho0 ' @@ -422,6 +422,12 @@ subroutine plastic_dislotwin_init 0.0_pReal, & config%getFloat('a_bcc', defaultVal=0.0_pReal), & config%getFloat('a_fcc', defaultVal=0.0_pReal)) + + prm%Schmid_trans = lattice_SchmidMatrix_trans(prm%Ntrans, & + config%getString('trans_lattice_structure'), & + 0.0_pReal, & + config%getFloat('a_bcc', defaultVal=0.0_pReal), & + config%getFloat('a_fcc', defaultVal=0.0_pReal)) if (lattice_structure(p) /= LATTICE_fcc_ID) then prm%Ndot0_trans = config%getFloats('ndot0_trans') @@ -470,7 +476,7 @@ subroutine plastic_dislotwin_init prm%D0 = config%getFloat('d0') prm%Qsd = config%getFloat('qsd') - prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') + prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! Deprecated if (config%keyExists('dipoleformationfactor')) call IO_error(1,ext_msg='use /nodipoleformation/') prm%dipoleformation = .not. config%keyExists('/nodipoleformation/') prm%sbVelocity = config%getFloat('shearbandvelocity',defaultVal=0.0_pReal) @@ -615,19 +621,6 @@ subroutine plastic_dislotwin_init plasticState(p)%state (offset_slip+1:offset_slip+plasticState(p)%nslip,1:NipcMyPhase) -! DEPRECATED BEGIN - allocate(prm%Schmid_trans(3,3,prm%totalNtrans),source = 0.0_pReal) - i = 0_pInt - transFamiliesLoop: do f = 1_pInt,size(prm%Ntrans,1) - index_myFamily = sum(prm%Ntrans(1:f-1_pInt)) ! index in truncated trans system list - transSystemsLoop: do j = 1_pInt,prm%Ntrans(f) - i = i + 1_pInt - prm%Schmid_trans(1:3,1:3,i) = lattice_Strans(1:3,1:3,sum(lattice_Ntranssystem(1:f-1,p))+j,p) - enddo transSystemsLoop - enddo transFamiliesLoop -! DEPRECATED END - - startIndex=1_pInt endIndex=prm%totalNslip stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) @@ -793,7 +786,7 @@ subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) forall (i = 1_pInt:prm%totalNslip) & mse%invLambdaSlip(i,of) = & sqrt(dot_product((stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of)),& - prm%forestProjectionEdge(1:prm%totalNslip,i)))/prm%CLambdaSlip(i) + prm%forestProjection(1:prm%totalNslip,i)))/prm%CLambdaSlip(i) !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation !$OMP CRITICAL (evilmatmul) From c92e8c034d8f7b4c24cd7f095fa428444a346125 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 07:33:47 +0100 Subject: [PATCH 23/23] [skip ci] updated version information after successful test of v2.0.2-1493-g13f66c9c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f97473c67..bd7a310ee 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1459-gff5de988 +v2.0.2-1493-g13f66c9c