From 2ca780743850a5911786711a272bad4670bae341 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 15 Oct 2018 22:29:23 +0200 Subject: [PATCH 01/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] [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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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/61] 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 a458dc831be5b7148e05e426f61f8abc942e3bc5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 06:56:43 +0100 Subject: [PATCH 23/61] prepare for consistent use of full tensor representation --- src/constitutive.f90 | 20 +++++++++----------- src/crystallite.f90 | 4 +++- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ccaf01c33..ba6a554a3 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -854,7 +854,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position - s, & !< counter in source loop + s, & !< counter in source loop instance, of ho = material_homogenizationAt(el) @@ -920,7 +920,7 @@ end subroutine constitutive_collectDotState !> @brief for constitutive models having an instantaneous change of state !> will return false if delta state is not needed/supported by the constitutive model !-------------------------------------------------------------------------------------------------- -subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) +subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el) use prec, only: & pReal, & pLongInt @@ -929,8 +929,7 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) debug_constitutive, & debug_levelBasic use math, only: & - math_Mandel6to33, & - math_Mandel33to6, & + math_sym33to6, & math_mul33x33 use material, only: & phasememberAt, & @@ -954,18 +953,17 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) ipc, & !< component-ID of integration point ip, & !< integration point el !< element - real(pReal), intent(in), dimension(6) :: & - S6 !< 2nd Piola Kirchhoff stress (vector notation) real(pReal), intent(in), dimension(3,3) :: & + S, & !< 2nd Piola Kirchhoff stress Fe, & !< elastic deformation gradient Fi !< intermediate deformation gradient real(pReal), dimension(3,3) :: & Mp integer(pInt) :: & - s, & !< counter in source loop + i, & instance, of - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -975,13 +973,13 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el) call plastic_kinehardening_deltaState(Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_deltaState(math_Mandel33to6(Mp),ip,el) + call plastic_nonlocal_deltaState(math_sym33to6(Mp),ip,el) end select plasticityType - sourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) + sourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el)) - sourceType: select case (phase_source(s,material_phase(ipc,ip,el))) + sourceType: select case (phase_source(i,material_phase(ipc,ip,el))) case (SOURCE_damage_isoBrittle_ID) sourceType call source_damage_isoBrittle_deltaState (constitutive_homogenizedC(ipc,ip,el), Fe, & diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 1fcd92705..01c20a893 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2958,6 +2958,8 @@ logical function stateJump(ipc,ip,el) phaseAt, phasememberAt use constitutive, only: & constitutive_collectDeltaState + use math, only: & + math_6toSym33 implicit none integer(pInt), intent(in):: & @@ -2977,7 +2979,7 @@ logical function stateJump(ipc,ip,el) c = phasememberAt(ipc,ip,el) p = phaseAt(ipc,ip,el) - call constitutive_collectDeltaState(crystallite_Tstar_v(1:6,ipc,ip,el), & + call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,ipc,ip,el)), & crystallite_Fe(1:3,1:3,ipc,ip,el), & crystallite_Fi(1:3,1:3,ipc,ip,el), & ipc,ip,el) From a8a5c8eec03500b1276bd91a418e5aef7e7c07cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 07:12:20 +0100 Subject: [PATCH 24/61] preparing function for deltaState essential a "stateJump" over all points --- src/crystallite.f90 | 76 +++++++++++++++++++++++++++++++-------------- 1 file changed, 52 insertions(+), 24 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 01c20a893..d1565c9aa 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2932,6 +2932,40 @@ subroutine update_dotState(timeFraction) end subroutine update_DotState +subroutine update_deltaState + + implicit none + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g, & !< grain index in grain loop + p, & + c, & + s + + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP FLUSH(crystallite_todo) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then ! converged and still alive... + crystallite_todo(g,i,e) = stateJump(g,i,e) + !$OMP FLUSH(crystallite_todo) + if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken + crystallite_converged(g,i,e) = .false. + if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... + !$OMP CRITICAL (checkTodo) + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped + !$OMP END CRITICAL (checkTodo) + endif + endif + endif + enddo; enddo; enddo + !$OMP END PARALLEL DO + +end subroutine update_deltaState + + !-------------------------------------------------------------------------------------------------- !> @brief calculates a jump in the state according to the current state and the current stress !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state @@ -2971,10 +3005,8 @@ logical function stateJump(ipc,ip,el) c, & p, & mySource, & - myOffsetPlasticDeltaState, & - myOffsetSourceDeltaState, & - mySizePlasticDeltaState, & - mySizeSourceDeltaState + myOffset, & + mySize c = phasememberAt(ipc,ip,el) p = phaseAt(ipc,ip,el) @@ -2984,44 +3016,40 @@ logical function stateJump(ipc,ip,el) crystallite_Fi(1:3,1:3,ipc,ip,el), & ipc,ip,el) - myOffsetPlasticDeltaState = plasticState(p)%offsetDeltaState - mySizePlasticDeltaState = plasticState(p)%sizeDeltaState + myOffset = plasticState(p)%offsetDeltaState + mySize = plasticState(p)%sizeDeltaState - if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c)))) then ! NaN occured in deltaState + if( any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c)))) then ! NaN occured in deltaState stateJump = .false. return endif - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) = & - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) + & - plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & + plasticState(p)%deltaState(1:mySize,c) do mySource = 1_pInt, phase_Nsources(p) - myOffsetSourceDeltaState = sourceState(p)%p(mySource)%offsetDeltaState - mySizeSourceDeltaState = sourceState(p)%p(mySource)%sizeDeltaState - if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c)))) then ! NaN occured in deltaState + myOffset = sourceState(p)%p(mySource)%offsetDeltaState + mySize = sourceState(p)%p(mySource)%sizeDeltaState + if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c)))) then ! NaN occured in deltaState stateJump = .false. return endif - sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & - myOffsetSourceDeltaState + mySizeSourceDeltaState,c) = & - sourceState(p)%p(mySource)%state(myOffsetSourceDeltaState + 1_pInt : & - myOffsetSourceDeltaState + mySizeSourceDeltaState,c) + & - sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c) + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(mySource)%deltaState(1:mySize,c) enddo #ifdef DEBUG - if (any(dNeq0(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c))) & + if (any(dNeq0(plasticState(p)%deltaState(1:mySize,c))) & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then write(6,'(a,i8,1x,i2,1x,i3, /)') '<< CRYST >> update state at el ip ipc ',el,ip,ipc - write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> deltaState', plasticState(p)%deltaState(1:mySizePlasticDeltaState,c) + write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> deltaState', plasticState(p)%deltaState(1:mySize,c) write(6,'(a,/,(12x,12(e12.5,1x)),/)') '<< CRYST >> new state', & - plasticState(p)%state(myOffsetPlasticDeltaState + 1_pInt : & - myOffsetPlasticDeltaState + mySizePlasticDeltaState,c) + plasticState(p)%state(myOffset + 1_pInt : & + myOffset + mySize,c) endif #endif From c3b48c348440a189b532954715652430ce38a63f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 07:34:30 +0100 Subject: [PATCH 25/61] WIP: update_deltaState --- src/crystallite.f90 | 46 +++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d1565c9aa..bfb5bf833 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2933,22 +2933,64 @@ end subroutine update_DotState subroutine update_deltaState - + use, intrinsic :: & + IEEE_arithmetic + use prec, only: & + dNeq0 +#ifdef DEBUG + use debug, only: & + debug_e, & + debug_i, & + debug_g, & + debug_level, & + debug_crystallite, & + debug_levelExtensive, & + debug_levelSelective +#endif + use material, only: & + plasticState, & + sourceState, & + phase_Nsources, & + phaseAt, phasememberAt + use constitutive, only: & + constitutive_collectDeltaState + use math, only: & + math_6toSym33 implicit none integer(pInt) :: & e, & !< element index in element loop i, & !< integration point index in ip loop g, & !< grain index in grain loop p, & + mySize, & + myOffset, & c, & s + logical :: NaN - !$OMP PARALLEL DO + !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) !$OMP FLUSH(crystallite_todo) if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then ! converged and still alive... + call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & + crystallite_Fe(1:3,1:3,g,i,e), & + crystallite_Fi(1:3,1:3,g,i,e), & + g,i,e) + p = phaseAt(g,i,e); c = phasememberAt(g,i,e) + myOffset = plasticState(p)%offsetDeltaState + mySize = plasticState(p)%sizeDeltaState + NaN = any(IEEE_is_NaN(plasticState(p)%deltaState(1:mySize,c))) + + if (.not. NaN) then + + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & + plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & + plasticState(p)%deltaState(1:mySize,c) + + endif + crystallite_todo(g,i,e) = stateJump(g,i,e) !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken From 30dc8b4831735ee5ba5ab1a6585e8129d8eaa1ff Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 11:33:04 +0100 Subject: [PATCH 26/61] delta state update for all points replaced stateJump, which works only on one point --- src/crystallite.f90 | 132 ++++++++------------------------------------ 1 file changed, 22 insertions(+), 110 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index bfb5bf833..d05cbe764 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1921,32 +1921,8 @@ eIter = FEsolving_execElem(1:2) call update_dotState(1.0_pReal) call update_State(1.0_pReal) - - !$OMP PARALLEL - - - - - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL - - call update_dependentState + call update_deltaState + call update_dependentState !$OMP PARALLEL @@ -2109,26 +2085,8 @@ subroutine integrateStateAdaptiveEuler() endif enddo; enddo; enddo !$OMP ENDDO - - - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO !$OMP END PARALLEL - + call update_deltaState call update_dependentState @@ -2365,25 +2323,7 @@ subroutine integrateStateRK4() !$OMP END PARALLEL call update_state(TIMESTEPFRACTION(n)) - - !$OMP PARALLEL - ! --- state jump --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + call update_deltaState call update_dependentState !$OMP PARALLEL @@ -2584,31 +2524,8 @@ subroutine integrateStateRKCK45() !$OMP END PARALLEL call update_state(1.0_pReal) !MD: 1.0 correct? - - !$OMP PARALLEL - - - ! --- state jump --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - - - - call update_dependentState + call update_deltaState + call update_dependentState !$OMP PARALLEL ! --- stress integration --- @@ -2736,25 +2653,9 @@ subroutine integrateStateRKCK45() enddo; enddo; enddo !$OMP ENDDO +!$OMP END PARALLEL - ! --- STATE JUMP --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = stateJump(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - + call update_deltaState call update_dependentState !$OMP PARALLEL @@ -2964,11 +2865,12 @@ subroutine update_deltaState p, & mySize, & myOffset, & + mySource, & c, & s logical :: NaN - !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize) + !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,mySource,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) @@ -2988,10 +2890,20 @@ subroutine update_deltaState plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & plasticState(p)%deltaState(1:mySize,c) - + do mySource = 1_pInt, phase_Nsources(p) + myOffset = sourceState(p)%p(mySource)%offsetDeltaState + mySize = sourceState(p)%p(mySource)%sizeDeltaState + NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c))) + + if (.not. NaN) then + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(mySource)%deltaState(1:mySize,c) + endif + enddo endif - crystallite_todo(g,i,e) = stateJump(g,i,e) + crystallite_todo(g,i,e) = .not. NaN !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken crystallite_converged(g,i,e) = .false. From fcdab215653b0418e23b3e29cd54d085a347c12e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 14:15:26 +0100 Subject: [PATCH 27/61] avoid flush of full array more clear logic --- src/crystallite.f90 | 43 +++++++++++++++++++++---------------------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d05cbe764..0595aa197 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -2798,15 +2798,17 @@ subroutine update_dotState(timeFraction) c, & s logical :: & - NaN + NaN, & + nonlocalStop + + nonlocalStop = .false. - !$OMP PARALLEL - !$OMP DO PRIVATE (p,c,NaN) + !$OMP PARALLEL DO PRIVATE (p,c,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + !$OMP FLUSH(nonlocalStop) + if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then call constitutive_collectDotState(crystallite_Tstar_v(1:6,g,i,e), & crystallite_Fe, & crystallite_Fi(1:3,1:3,g,i,e), & @@ -2819,16 +2821,13 @@ subroutine update_dotState(timeFraction) enddo if (NaN) then crystallite_todo(g,i,e) = .false. ! this one done (and broken) - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken is a local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals done (and broken) - !$OMP END CRITICAL (checkTodo) - endif + if (.not. crystallite_localPlasticity(g,i,e)) nonlocalStop = .True. endif endif enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL + !$OMP END PARALLEL DO + + if (nonlocalStop) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity end subroutine update_DotState @@ -2868,14 +2867,18 @@ subroutine update_deltaState mySource, & c, & s - logical :: NaN + logical :: & + NaN, & + nonlocalStop + + nonlocalStop = .false. !$OMP PARALLEL DO PRIVATE(p,c,myOffset,mySize,mySource,NaN) do e = FEsolving_execElem(1),FEsolving_execElem(2) do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) do g = 1,homogenization_Ngrains(mesh_element(3,e)) - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then ! converged and still alive... + !$OMP FLUSH(nonlocalStop) + if (nonlocalStop .or. (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e))) then call constitutive_collectDeltaState(math_6toSym33(crystallite_Tstar_v(1:6,g,i,e)), & crystallite_Fe(1:3,1:3,g,i,e), & crystallite_Fi(1:3,1:3,g,i,e), & @@ -2904,19 +2907,15 @@ subroutine update_deltaState endif crystallite_todo(g,i,e) = .not. NaN - !$OMP FLUSH(crystallite_todo) if (.not. crystallite_todo(g,i,e)) then ! if state jump fails, then convergence is broken crystallite_converged(g,i,e) = .false. - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif + if (.not. crystallite_localPlasticity(g,i,e)) nonlocalStop = .true. endif endif enddo; enddo; enddo !$OMP END PARALLEL DO - + if (nonlocalStop) crystallite_todo = crystallite_todo .and. crystallite_localPlasticity + end subroutine update_deltaState From 934a15d73cc5d42847b722c4fa0114fc63853e8e Mon Sep 17 00:00:00 2001 From: Test User Date: Thu, 24 Jan 2019 15:57:55 +0100 Subject: [PATCH 28/61] [skip ci] updated version information after successful test of v2.0.2-1459-gff5de988 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 8da7b3148..f97473c67 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1453-g8e56f0d0 +v2.0.2-1459-gff5de988 From f4fef6448dc5d4e3dafb259b4753c97c33967e81 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 17:59:38 +0100 Subject: [PATCH 29/61] stress integration for all points in one function --- src/crystallite.f90 | 180 ++++++++++++-------------------------------- 1 file changed, 50 insertions(+), 130 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 0595aa197..53ddca1c7 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1654,29 +1654,7 @@ subroutine integrateStateFPI() !$OMP END PARALLEL DO call update_dependentState - !$OMP PARALLEL - - ! --- STRESS INTEGRATION --- - -#ifdef DEBUG - if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & - write(6,'(a,i8,a)') '<< CRYST >> ', count(crystallite_todo(:,:,:)),' grains todo before stress integration' -#endif - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ... then all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + call update_stress(1.0_pReal) call update_dotState(1.0_pReal) !$OMP PARALLEL ! --- UPDATE STATE --- @@ -1923,36 +1901,14 @@ eIter = FEsolving_execElem(1:2) call update_State(1.0_pReal) call update_deltaState call update_dependentState + call update_stress(1.0_pReal) - !$OMP PARALLEL - ! --- STRESS INTEGRATION --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - - ! --- SET CONVERGENCE FLAG --- - - !$OMP DO + !$OMP PARALLEL DO do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definitionem enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL + !$OMP END PARALLEL DO ! --- CHECK NON-LOCAL CONVERGENCE --- @@ -2088,27 +2044,8 @@ subroutine integrateStateAdaptiveEuler() !$OMP END PARALLEL call update_deltaState call update_dependentState - - - ! --- STRESS INTEGRATION (EULER INTEGRATION) --- - - !$OMP PARALLEL DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP END PARALLEL DO - - - call update_dotState(1.0_pReal) + call update_stress(1.0_pReal) + call update_dotState(1.0_pReal) !$OMP PARALLEL !$OMP DO PRIVATE(p,c,NaN) @@ -2325,26 +2262,7 @@ subroutine integrateStateRK4() call update_state(TIMESTEPFRACTION(n)) call update_deltaState call update_dependentState - !$OMP PARALLEL - - - ! --- stress integration --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e,timeStepFraction(n)) ! fraction of original times step - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO -!$OMP END PARALLEL + call update_stress(TIMESTEPFRACTION(n)) ! --- dot state and RK dot state--- @@ -2526,26 +2444,8 @@ subroutine integrateStateRKCK45() call update_state(1.0_pReal) !MD: 1.0 correct? call update_deltaState call update_dependentState - !$OMP PARALLEL - - ! --- stress integration --- - - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e,C(stage)) ! fraction of original time step - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - !$OMP END PARALLEL - call update_dotState(C(stage)) + call update_stress(C(stage)) + call update_dotState(C(stage)) enddo @@ -2652,31 +2552,13 @@ subroutine integrateStateRKCK45() endif enddo; enddo; enddo !$OMP ENDDO - !$OMP END PARALLEL call update_deltaState call update_dependentState - - !$OMP PARALLEL -!-------------------------------------------------------------------------------------------------- -! --- FINAL STRESS INTEGRATION STEP IF RESIDUUM BELOW TOLERANCE --- - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - crystallite_todo(g,i,e) = integrateStress(g,i,e) - !$OMP FLUSH(crystallite_todo) - if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - + call update_stress(1.0_pReal) + + !$OMP PARALLEL !-------------------------------------------------------------------------------------------------- ! --- SET CONVERGENCE FLAG --- !$OMP DO @@ -2699,6 +2581,43 @@ subroutine integrateStateRKCK45() end subroutine integrateStateRKCK45 +!-------------------------------------------------------------------------------------------------- +!> @brief Standard forwarding of state as state = state0 + dotState * (delta t) +!-------------------------------------------------------------------------------------------------- +subroutine update_stress(timeFraction) + use material, only: & + plasticState, & + sourceState, & + phase_Nsources, & + phaseAt, phasememberAt + + implicit none + real(pReal), intent(in) :: & + timeFraction + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g + + !$OMP PARALLEL DO + do e = FEsolving_execElem(1),FEsolving_execElem(2) + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) + do g = 1,homogenization_Ngrains(mesh_element(3,e)) + !$OMP FLUSH(crystallite_todo) + if (crystallite_todo(g,i,e) .and. .not. crystallite_converged(g,i,e)) then + crystallite_todo(g,i,e) = integrateStress(g,i,e,timeFraction) + !$OMP FLUSH(crystallite_todo) + if (.not. crystallite_todo(g,i,e) .and. .not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... + !$OMP CRITICAL (checkTodo) + crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped + !$OMP END CRITICAL (checkTodo) + endif + endif + enddo; enddo; enddo + !$OMP END PARALLEL DO + +end subroutine update_stress + !-------------------------------------------------------------------------------------------------- !> @brief tbd !-------------------------------------------------------------------------------------------------- @@ -2725,6 +2644,7 @@ subroutine update_dependentState() end subroutine update_dependentState + !-------------------------------------------------------------------------------------------------- !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- From 05e255b70b343305373e018a5190bba155121f2c Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 00:41:13 +0100 Subject: [PATCH 30/61] [skip ci] updated version information after successful test of v2.0.2-1464-g8fabacec --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index f97473c67..a25b1aedf 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1459-gff5de988 +v2.0.2-1464-g8fabacec From 1c4dc2e05f6819c8bf0b4877c61990dc85bd445c Mon Sep 17 00:00:00 2001 From: Satya Gupta Date: Thu, 24 Jan 2019 18:45:25 -0500 Subject: [PATCH 31/61] material_allocatePlasticState now takes care of setting offsetDeltaState --- src/material.f90 | 10 ++++++---- src/plastic_kinematichardening.f90 | 1 - 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/material.f90 b/src/material.f90 index 8356f43c7..d12321235 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -918,7 +918,8 @@ end subroutine material_parseTexture !-------------------------------------------------------------------------------------------------- !> @brief allocates the plastic state of a phase !-------------------------------------------------------------------------------------------------- -subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState,& +subroutine material_allocatePlasticState(phase,NofMyPhase,& + sizeState,sizeDotState,sizeDeltaState,& Nslip,Ntwin,Ntrans) use numerics, only: & numerics_integrator2 => numerics_integrator ! compatibility hack @@ -936,9 +937,10 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState integer(pInt) :: numerics_integrator ! compatibility hack numerics_integrator = numerics_integrator2(1) ! compatibility hack - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%sizeState = sizeState + plasticState(phase)%sizeDotState = sizeDotState + plasticState(phase)%sizeDeltaState = sizeDeltaState + plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState ! deltaState occupies latter part of state by definition plasticState(phase)%Nslip = Nslip plasticState(phase)%Ntwin = Ntwin plasticState(phase)%Ntrans= Ntrans diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index 690349c96..d70fe68f7 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -302,7 +302,6 @@ subroutine plastic_kinehardening_init call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,sizeDeltaState, & prm%totalNslip,0_pInt,0_pInt) plasticState(p)%sizePostResults = sum(plastic_kinehardening_sizePostResult(:,phase_plasticityInstance(p))) - plasticState(p)%offsetDeltaState = sizeDotState !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState From f2882f195a02d8af3072e4ea28fa00e12c049844 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 07:20:05 +0100 Subject: [PATCH 32/61] fuction for convergence check avoid code repetition --- src/crystallite.f90 | 112 +++++++++++++------------------------------- 1 file changed, 32 insertions(+), 80 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 53ddca1c7..af69b1727 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1852,17 +1852,6 @@ end subroutine integrateStateFPI subroutine integrateStateEuler() use, intrinsic :: & IEEE_arithmetic -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelBasic, & - debug_levelExtensive, & - debug_levelSelective -#endif use mesh, only: & mesh_element, & mesh_NcpElems @@ -1874,7 +1863,6 @@ subroutine integrateStateEuler() constitutive_microstructure implicit none - integer(pInt) :: & e, & ! element index in element loop i, & ! integration point index in ip loop @@ -1902,14 +1890,7 @@ eIter = FEsolving_execElem(1:2) call update_deltaState call update_dependentState call update_stress(1.0_pReal) - - - !$OMP PARALLEL DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definitionem - enddo; enddo; enddo - !$OMP END PARALLEL DO - + call setConvergenceFlag ! --- CHECK NON-LOCAL CONVERGENCE --- @@ -2048,30 +2029,6 @@ subroutine integrateStateAdaptiveEuler() call update_dotState(1.0_pReal) !$OMP PARALLEL - !$OMP DO PRIVATE(p,c,NaN) - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - !$OMP FLUSH(crystallite_todo) - if (crystallite_todo(g,i,e)) then - p = phaseAt(g,i,e) - c = phasememberAt(g,i,e) - NaN = any(IEEE_is_NaN(plasticState(p)%dotState(:,c))) - do mySource = 1_pInt, phase_Nsources(p) - NaN = NaN .or. any(IEEE_is_NaN(sourceState(p)%p(mySource)%dotState(:,c))) - enddo - if (NaN) then ! NaN occured in any dotState - if (.not. crystallite_localPlasticity(g,i,e)) then ! if broken non-local... - !$OMP CRITICAL (checkTodo) - crystallite_todo = crystallite_todo .and. crystallite_localPlasticity ! ...all non-locals skipped - !$OMP END CRITICAL (checkTodo) - else ! if broken local... - crystallite_todo(g,i,e) = .false. ! ... skip this one next time - endif - endif - endif - enddo; enddo; enddo - !$OMP ENDDO - - ! --- ERROR ESTIMATE FOR STATE (HEUN METHOD) --- !$OMP SINGLE @@ -2272,14 +2229,7 @@ subroutine integrateStateRK4() enddo - - - ! --- SET CONVERGENCE FLAG --- - - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definitionem - enddo; enddo; enddo - + call setConvergenceFlag ! --- CHECK NONLOCAL CONVERGENCE --- @@ -2557,17 +2507,7 @@ subroutine integrateStateRKCK45() call update_deltaState call update_dependentState call update_stress(1.0_pReal) - - !$OMP PARALLEL -!-------------------------------------------------------------------------------------------------- -! --- SET CONVERGENCE FLAG --- - !$OMP DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition - enddo; enddo; enddo - !$OMP ENDDO - - !$OMP END PARALLEL + call setConvergenceFlag ! --- nonlocal convergence check --- @@ -2581,6 +2521,30 @@ subroutine integrateStateRKCK45() end subroutine integrateStateRKCK45 +!-------------------------------------------------------------------------------------------------- +!> @brief Sets convergence flag based on "todo": every point that survived the integration (todo is +! still .true. is considered as converged +!> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria +!-------------------------------------------------------------------------------------------------- +subroutine setConvergenceFlag() + + implicit none + integer(pInt) :: & + e, & !< element index in element loop + i, & !< integration point index in ip loop + g !< grain index in grain loop + + !OMP DO PARALLEL PRIVATE(i,g) + do e = FEsolving_execElem(1),FEsolving_execElem(2) + forall (i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), & + g = 1:homogenization_Ngrains(mesh_element(3,e))) + crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! if still "to do" then converged per definition + end forall; enddo + !OMP END DO PARALLEL + +end subroutine setConvergenceFlag + + !-------------------------------------------------------------------------------------------------- !> @brief Standard forwarding of state as state = state0 + dotState * (delta t) !-------------------------------------------------------------------------------------------------- @@ -2707,7 +2671,6 @@ subroutine update_dotState(timeFraction) constitutive_collectDotState implicit none - real(pReal), intent(in) :: & timeFraction integer(pInt) :: & @@ -2757,16 +2720,6 @@ subroutine update_deltaState IEEE_arithmetic use prec, only: & dNeq0 -#ifdef DEBUG - use debug, only: & - debug_e, & - debug_i, & - debug_g, & - debug_level, & - debug_crystallite, & - debug_levelExtensive, & - debug_levelSelective -#endif use material, only: & plasticState, & sourceState, & @@ -2897,19 +2850,18 @@ logical function stateJump(ipc,ip,el) return endif - plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) = & - plasticState(p)%state(myOffset + 1_pInt: myOffset + mySize,c) + & - plasticState(p)%deltaState(1:mySize,c) + plasticState(p)%state(myOffset + 1_pInt:myOffset + mySize,c) = & + plasticState(p)%state(myOffset + 1_pInt:myOffset + mySize,c) + plasticState(p)%deltaState(1:mySize,c) do mySource = 1_pInt, phase_Nsources(p) myOffset = sourceState(p)%p(mySource)%offsetDeltaState - mySize = sourceState(p)%p(mySource)%sizeDeltaState + mySize = sourceState(p)%p(mySource)%sizeDeltaState if (any(IEEE_is_NaN(sourceState(p)%p(mySource)%deltaState(1:mySize,c)))) then ! NaN occured in deltaState stateJump = .false. return endif - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) = & - sourceState(p)%p(mySource)%state(myOffset + 1_pInt:myOffset +mySize,c) + & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt: myOffset + mySize,c) = & + sourceState(p)%p(mySource)%state(myOffset + 1_pInt: myOffset + mySize,c) + & sourceState(p)%p(mySource)%deltaState(1:mySize,c) enddo From c92e8c034d8f7b4c24cd7f095fa428444a346125 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 07:33:47 +0100 Subject: [PATCH 33/61] [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 From 99ef3534469e33afc12a587057c0836dc6edde56 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 13:42:38 +0100 Subject: [PATCH 34/61] more sanity checks structure string can be now of arbitrary length (technically) only fcc,hex,bcc,bct,ort are accepted labels --- src/lattice.f90 | 157 +++++++++++++++++++++++++++++++----------------- 1 file changed, 102 insertions(+), 55 deletions(-) diff --git a/src/lattice.f90 b/src/lattice.f90 index 69412895c..9be30a5d3 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -869,8 +869,8 @@ subroutine lattice_initializeStructure(myPhase,CoverA) math_mul33x3, & math_trace33, & math_symmetric33, & - math_Mandel33to6, & - math_Mandel3333to66, & + math_sym33to6, & + math_sym3333to66, & math_Voigt66to3333, & math_axisAngleToR, & INRAD, & @@ -908,7 +908,7 @@ subroutine lattice_initializeStructure(myPhase,CoverA) + 6.0_pReal*lattice_C66(1,2,myPhase) & + 2.0_pReal*lattice_C66(4,4,myPhase))! C12iso/(C11iso+C12iso) with C11iso=(3*C11+2*C12+4*C44)/5 and C12iso=(C11+4*C12-2*C44)/5 lattice_C3333(1:3,1:3,1:3,1:3,myPhase) = math_Voigt66to3333(lattice_C66(1:6,1:6,myPhase)) ! Literature data is Voigt - lattice_C66(1:6,1:6,myPhase) = math_Mandel3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel + lattice_C66(1:6,1:6,myPhase) = math_sym3333to66(lattice_C3333(1:3,1:3,1:3,1:3,myPhase)) ! DAMASK uses Mandel-weighting do i = 1_pInt, 6_pInt if (abs(lattice_C66(i,i,myPhase)) @brief Rotated elasticity matrices for twinning in Mandel notation +!> @brief Rotated elasticity matrices for twinning in 66-vector notation !-------------------------------------------------------------------------------------------------- function lattice_C66_twin(Ntwin,C66,structure,CoverA) use IO, only: & @@ -1405,8 +1408,8 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) use math, only: & INRAD, & math_axisAngleToR, & - math_Mandel3333to66, & - math_Mandel66to3333, & + math_sym3333to66, & + math_66toSym3333, & math_rotate_forward3333 implicit none @@ -1420,15 +1423,18 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) real(pReal), dimension(3,3) :: R integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_C66_twin: '//trim(structure)) - select case(trim(structure)) + select case(structure(1:3)) case('fcc') 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,& trim(structure),0.0_pReal) - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') coordinateSystem = buildCoordinateSystem(Ntwin,LATTICE_HEX_NSLIPSYSTEM,LATTICE_HEX_SYSTEMTWIN,& 'hex',cOverA) case default @@ -1437,18 +1443,17 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA) 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)) + lattice_C66_twin(1:6,1:6,i) = math_sym3333to66(math_rotate_forward3333(math_66toSym3333(C66),R)) enddo end function lattice_C66_twin !-------------------------------------------------------------------------------------------------- -!> @brief Rotated elasticity matrices for transformation in Mandel notation +!> @brief Rotated elasticity matrices for transformation in 66-vector notation !> ToDo: Completely untested and incomplete and undocumented !-------------------------------------------------------------------------------------------------- -function lattice_C66_trans(Ntrans,C_parent66, & - structure_target, & - CoverA_trans,a_bcc,a_fcc) +function lattice_C66_trans(Ntrans,C_parent66,structure_target, & + CoverA_trans,a_bcc,a_fcc) use prec, only: & tol_math_check use IO, only: & @@ -1465,21 +1470,25 @@ function lattice_C66_trans(Ntrans,C_parent66, & math_crossproduct implicit none - integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family - character(len=*), intent(in) :: & + integer(pInt), dimension(:), intent(in) :: Ntrans !< number of active twin systems per family + character(len=*), intent(in) :: & 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 + 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 integer(pInt) :: i + if (len_trim(structure_target) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) + !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + !-------------------------------------------------------------------------------------------------- ! elasticity matrix of the target phase in cube orientation - if (trim(structure_target) == 'hex') then + if (structure_target(1:3) == 'hex') then C_bar66(1,1) = (C_parent66(1,1) + C_parent66(1,2) + 2.0_pReal*C_parent66(4,4))/2.0_pReal C_bar66(1,2) = (C_parent66(1,1) + 5.0_pReal*C_parent66(1,2) - 2.0_pReal*C_parent66(4,4))/6.0_pReal C_bar66(3,3) = (C_parent66(1,1) + 2.0_pReal*C_parent66(1,2) + 4.0_pReal*C_parent66(4,4))/3.0_pReal @@ -1494,10 +1503,10 @@ function lattice_C66_trans(Ntrans,C_parent66, & C_target_unrotated66(3,3) = C_bar66(3,3) C_target_unrotated66(4,4) = C_bar66(4,4) - C_bar66(1,4)**2.0_pReal/(0.5_pReal*(C_bar66(1,1) - C_bar66(1,2))) C_target_unrotated66 = lattice_symmetrizeC66(LATTICE_HEX_ID,C_target_unrotated66) - elseif (trim(structure_target) == 'bcc') then + elseif (structure_target(1:3) == 'bcc') then C_target_unrotated66 = C_parent66 else - write(6,*) "Mist" + call IO_error(137_pInt,ext_msg='lattice_C66_trans (target): '//trim(structure_target)) endif @@ -1511,7 +1520,7 @@ function lattice_C66_trans(Ntrans,C_parent66, & 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))) enddo -end function +end function lattice_C66_trans !-------------------------------------------------------------------------------------------------- @@ -1584,14 +1593,17 @@ function lattice_interaction_SlipSlip(Nslip,interactionValues,structure) result( integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt), dimension(:,:), allocatable :: interactionTypes - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipSlip: '//trim(structure)) + + select case(structure(1:3)) case('fcc') interactionTypes = LATTICE_FCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_FCC_NSLIPSYSTEM case('bcc') interactionTypes = LATTICE_BCC_INTERACTIONSLIPSLIP NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + case('hex') interactionTypes = LATTICE_HEX_INTERACTIONSLIPSLIP NslipMax = LATTICE_HEX_NSLIPSYSTEM case('bct') @@ -1688,14 +1700,17 @@ 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,17,17,16 & ],pInt),shape(HEX_INTERACTIONTWINTWIN),order=[2,1]) !< Twin-twin interaction types for hex - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinTwin: '//trim(structure)) + + select case(structure(1:3)) case('fcc') interactionTypes = FCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_FCC_NTWINSYSTEM case('bcc') interactionTypes = BCC_INTERACTIONTWINTWIN NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + case('hex') interactionTypes = HEX_INTERACTIONTWINTWIN NtwinMax = LATTICE_HEX_NTWINSYSTEM case default @@ -1740,7 +1755,10 @@ function lattice_interaction_TransTrans(Ntrans,interactionValues,structure) resu 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 + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TransTrans: '//trim(structure)) + + if(structure(1:3) == 'fcc') then interactionTypes = FCC_INTERACTIONTRANSTRANS NtransMax = LATTICE_FCC_NTRANSSYSTEM else @@ -1870,8 +1888,10 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r ! ],pInt),shape(HEX_INTERACTIONSLIPTWIN),order=[2,1]) !< Slip-twin interaction types for hex - - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTwin: '//trim(structure)) + + select case(structure(1:3)) case('fcc') interactionTypes = FCC_INTERACTIONSLIPTWIN NslipMax = LATTICE_FCC_NSLIPSYSTEM @@ -1880,7 +1900,7 @@ function lattice_interaction_SlipTwin(Nslip,Ntwin,interactionValues,structure) r interactionTypes = BCC_INTERACTIONSLIPTWIN NslipMax = LATTICE_BCC_NSLIPSYSTEM NtwinMax = LATTICE_BCC_NTWINSYSTEM - case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + case('hex') interactionTypes = HEX_INTERACTIONSLIPTWIN NslipMax = LATTICE_HEX_NSLIPSYSTEM NtwinMax = LATTICE_HEX_NTWINSYSTEM @@ -1936,7 +1956,10 @@ function lattice_interaction_SlipTrans(Nslip,Ntrans,interactionValues,structure) 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) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_SlipTrans: '//trim(structure)) + + select case(structure(1:3)) case('fcc') interactionTypes = FCC_INTERACTIONSLIPTRANS NslipMax = LATTICE_FCC_NSLIPSYSTEM @@ -2005,8 +2028,11 @@ 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 & ],pInt),shape(HEX_INTERACTIONTWINSLIP),order=[2,1]) !< Twin-twin interaction types for hex + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_interaction_TwinSlip: '//trim(structure)) - select case(structure) + select case(structure(1:3)) case('fcc') interactionTypes = FCC_INTERACTIONTWINSLIP NtwinMax = LATTICE_FCC_NTWINSYSTEM @@ -2015,7 +2041,7 @@ function lattice_interaction_TwinSlip(Ntwin,Nslip,interactionValues,structure) r interactionTypes = BCC_INTERACTIONTWINSLIP NtwinMax = LATTICE_BCC_NTWINSYSTEM NslipMax = LATTICE_BCC_NSLIPSYSTEM - case('hex','hexagonal') ! ToDo: "No alias policy": long or short? + case('hex') interactionTypes = HEX_INTERACTIONTWINSLIP NtwinMax = LATTICE_HEX_NTWINSYSTEM NslipMax = LATTICE_HEX_NSLIPSYSTEM @@ -2051,15 +2077,18 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix) real(pReal), dimension(:,:), allocatable :: slipSystems integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure)) - select case(structure) + select case(structure(1:3)) 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? + case('hex') NslipMax = LATTICE_HEX_NSLIPSYSTEM slipSystems = LATTICE_HEX_SYSTEMSLIP case('bct') @@ -2109,14 +2138,17 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix) integer(pInt), dimension(:), allocatable :: NtwinMax integer(pInt) :: i - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure)) + + select case(structure(1:3)) case('fcc') NtwinMax = LATTICE_FCC_NTWINSYSTEM twinSystems = LATTICE_FCC_SYSTEMTWIN case('bcc') NtwinMax = LATTICE_BCC_NTWINSYSTEM twinSystems = LATTICE_BCC_SYSTEMTWIN - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') NtwinMax = LATTICE_HEX_NTWINSYSTEM twinSystems = LATTICE_HEX_SYSTEMTWIN case default @@ -2162,11 +2194,17 @@ function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) real(pReal), dimension(3,3,sum(Ntrans)) :: devNull real(pReal) :: a_bcc, a_fcc -! ToDo: Error checking!!!!!!!!!!!!!!!!!!! + + if (len_trim(structure_target) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + if (structure_target(1:3) /= 'bcc' .and. structure_target(1:3) /= 'hex') & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_trans (target): '//trim(structure_target)) + + !ToDo: add checks for CoverA_trans,a_fcc,a_bcc + call buildTransformationSystem(devNull,SchmidMatrix,Ntrans,cOverA,a_fcc,a_bcc) - -end function lattice_SchmidMatrix_trans + end function lattice_SchmidMatrix_trans !-------------------------------------------------------------------------------------------------- @@ -2189,8 +2227,11 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid real(pReal), dimension(:,:), allocatable :: cleavageSystems integer(pInt), dimension(:), allocatable :: NcleavageMax integer(pInt) :: i + + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure)) - select case(structure) + select case(structure(1:3)) case('iso') NcleavageMax = LATTICE_ISO_NCLEAVAGESYSTEM cleavageSystems = LATTICE_ISO_SYSTEMCLEAVAGE @@ -2203,7 +2244,7 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid case('bcc') NcleavageMax = LATTICE_BCC_NCLEAVAGESYSTEM cleavageSystems = LATTICE_BCC_SYSTEMCLEAVAGE - case('hex','hexagonal') !ToDo: "No alias policy": long or short? + case('hex') NcleavageMax = LATTICE_HEX_NCLEAVAGESYSTEM cleavageSystems = LATTICE_HEX_SYSTEMCLEAVAGE case default @@ -2246,14 +2287,17 @@ function lattice_forestProjection(Nslip,structure,cOverA) result(projection) integer(pInt), dimension(:), allocatable :: NslipMax integer(pInt) :: i, j - select case(structure) + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='lattice_forestProjection: '//trim(structure)) + + select case(structure(1:3)) 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? + case('hex') NslipMax = LATTICE_HEX_NSLIPSYSTEM slipSystems = LATTICE_HEX_SYSTEMSLIP case('bct') @@ -2346,9 +2390,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) & + if (len_trim(structure) /= 3_pInt) & + call IO_error(137_pInt,ext_msg='buildCoordinateSystem: '//trim(structure)) + if (trim(structure(1:3)) == '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)) & + if (trim(structure(1:3)) == 'hex' .and. (cOverA < 1.0_pReal .or. cOverA > 2.0_pReal)) & call IO_error(131_pInt,ext_msg='buildCoordinateSystem:'//trim(structure)) a = 0_pInt @@ -2357,7 +2403,7 @@ function buildCoordinateSystem(active,complete,system,structure,cOverA) a = a + 1_pInt c = sum(complete(1:f-1))+s - select case(trim(structure)) + select case(trim(structure(1:3))) case ('fcc','bcc','iso','ort','bct') direction = system(1:3,c) @@ -2391,7 +2437,7 @@ end function buildCoordinateSystem !> @brief Helper function to define transformation systems ! 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 +! set a_bcc = 0.0 for fcc -> hex transformation !-------------------------------------------------------------------------------------------------- subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) use prec, only: & @@ -2493,7 +2539,6 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) if (size(Ntrans) < 1_pInt .or. size(Ntrans) > 1_pInt) print*, 'mist' ! ToDo if (a_bcc > 0.0_pReal .and. dEq0(cOverA)) then ! fcc -> bcc transformation - if (a_bcc <= 0.0_pReal) print*, 'mist' ! ToDo do i = 1_pInt,sum(Ntrans) R = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & lattice_fccTobcc_systemTrans(4,i)*INRAD) @@ -2525,6 +2570,8 @@ subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc) 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 ! ToDo: This is of interest for the Schmid matrix only enddo + else + call IO_error(0_pInt) !ToDo: define error endif end subroutine buildTransformationSystem From e9087f83fe1edc850da711d51d4ab53092b4ee1d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 14:01:17 +0100 Subject: [PATCH 35/61] small improvements checking size of arguments (not shape) length of lattice structure not limited to 3 any more --- src/plastic_disloUCLA.f90 | 52 ++++++++++++++---------------- src/plastic_kinematichardening.f90 | 38 +++++++++++----------- src/plastic_phenopowerlaw.f90 | 48 +++++++++++++-------------- 3 files changed, 66 insertions(+), 72 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 94e07fc84..e386a9808 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -93,7 +93,7 @@ module plastic_disloUCLA !-------------------------------------------------------------------------------------------------- ! containers for parameters and state type(tParameters), allocatable, dimension(:), private :: param - type(tDisloUCLAState ), allocatable, dimension(:), private :: & + type(tDisloUCLAState), allocatable, dimension(:), private :: & dotState, & state type(tDisloUCLAdependentState), allocatable, dimension(:), private :: dependentState @@ -164,7 +164,6 @@ subroutine plastic_disloUCLA_init() outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -197,8 +196,6 @@ subroutine plastic_disloUCLA_init() dst => dependentState(phase_plasticityInstance(p)), & config => config_phase(p)) - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%mu = lattice_mu(p) @@ -213,36 +210,37 @@ subroutine plastic_disloUCLA_init() prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + if(trim(config%getString('lattice_structure')) == 'bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& defaultVal = emptyRealArray) - prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) - prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid - prm%nonSchmid_neg = prm%Schmid + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) - prm%rho0 = config%getFloats('rhoedge0', requiredShape=shape(prm%Nslip)) - prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredShape=shape(prm%Nslip)) - prm%v0 = config%getFloats('v0', requiredShape=shape(prm%Nslip)) - prm%burgers = config%getFloats('slipburgers', requiredShape=shape(prm%Nslip)) - prm%H0kp = config%getFloats('qedge', requiredShape=shape(prm%Nslip)) + config%getString('lattice_structure')) + prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) + prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredSize=size(prm%Nslip)) + prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) + prm%burgers = config%getFloats('slipburgers', requiredSize=size(prm%Nslip)) + prm%H0kp = config%getFloats('qedge', requiredSize=size(prm%Nslip)) - prm%clambda = config%getFloats('clambdaslip', requiredShape=shape(prm%Nslip)) - prm%tau_Peierls = config%getFloats('tau_peierls', requiredShape=shape(prm%Nslip)) ! ToDo: Deprecated - prm%p = config%getFloats('p_slip', requiredShape=shape(prm%Nslip), & + prm%clambda = config%getFloats('clambdaslip', requiredSize=size(prm%Nslip)) + prm%tau_Peierls = config%getFloats('tau_peierls', requiredSize=size(prm%Nslip)) ! ToDo: Deprecated + prm%p = config%getFloats('p_slip', requiredSize=size(prm%Nslip), & defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%q = config%getFloats('q_slip', requiredShape=shape(prm%Nslip), & + prm%q = config%getFloats('q_slip', requiredSize=size(prm%Nslip), & defaultVal=[(1.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%kink_height = config%getFloats('kink_height', requiredShape=shape(prm%Nslip)) - prm%w = config%getFloats('kink_width', requiredShape=shape(prm%Nslip)) - prm%omega = config%getFloats('omega', requiredShape=shape(prm%Nslip)) - prm%B = config%getFloats('friction_coeff', requiredShape=shape(prm%Nslip)) + prm%kink_height = config%getFloats('kink_height', requiredSize=size(prm%Nslip)) + prm%w = config%getFloats('kink_width', requiredSize=size(prm%Nslip)) + prm%omega = config%getFloats('omega', requiredSize=size(prm%Nslip)) + prm%B = config%getFloats('friction_coeff', requiredSize=size(prm%Nslip)) prm%SolidSolutionStrength = config%getFloat('solidsolutionstrength') ! ToDo: Deprecated prm%grainSize = config%getFloat('grainsize') @@ -250,7 +248,7 @@ subroutine plastic_disloUCLA_init() prm%Qsd = config%getFloat('qsd') prm%atomicVolume = config%getFloat('catomicvolume') * prm%burgers**3.0_pReal prm%minDipDistance = config%getFloat('cedgedipmindistance') * prm%burgers - prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-key + prm%dipoleformation = config%getFloat('dipoleformationfactor') > 0.0_pReal !should be on by default, ToDo: change to /key/-type key ! expand: family => system prm%rho0 = math_expand(prm%rho0, prm%Nslip) diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index d70fe68f7..be4261b03 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -151,7 +151,6 @@ subroutine plastic_kinehardening_init outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -187,8 +186,6 @@ subroutine plastic_kinehardening_init endif #endif - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal) @@ -203,28 +200,29 @@ subroutine plastic_kinehardening_init prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& - defaultVal = emptyRealArray) - prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) - prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + prm%Schmid = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + if(trim(config%getString('lattice_structure')) == 'bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid - prm%nonSchmid_neg = prm%Schmid + prm%nonSchmid_pos = prm%Schmid + prm%nonSchmid_neg = prm%Schmid endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getString('lattice_structure')) - prm%crss0 = config%getFloats('crss0', requiredShape=shape(prm%Nslip)) - prm%tau1 = config%getFloats('tau1', requiredShape=shape(prm%Nslip)) - prm%tau1_b = config%getFloats('tau1_b', requiredShape=shape(prm%Nslip)) - prm%theta0 = config%getFloats('theta0', requiredShape=shape(prm%Nslip)) - prm%theta1 = config%getFloats('theta1', requiredShape=shape(prm%Nslip)) - prm%theta0_b = config%getFloats('theta0_b', requiredShape=shape(prm%Nslip)) - prm%theta1_b = config%getFloats('theta1_b', requiredShape=shape(prm%Nslip)) + prm%crss0 = config%getFloats('crss0', requiredSize=size(prm%Nslip)) + prm%tau1 = config%getFloats('tau1', requiredSize=size(prm%Nslip)) + prm%tau1_b = config%getFloats('tau1_b', requiredSize=size(prm%Nslip)) + prm%theta0 = config%getFloats('theta0', requiredSize=size(prm%Nslip)) + prm%theta1 = config%getFloats('theta1', requiredSize=size(prm%Nslip)) + prm%theta0_b = config%getFloats('theta0_b', requiredSize=size(prm%Nslip)) + prm%theta1_b = config%getFloats('theta1_b', requiredSize=size(prm%Nslip)) prm%gdot0 = config%getFloat('gdot0') prm%n = config%getFloat('n_slip') diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 0fe0f51e8..fd40f12da 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -153,7 +153,6 @@ subroutine plastic_phenopowerlaw_init outputID character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -181,8 +180,6 @@ subroutine plastic_phenopowerlaw_init stt => state(phase_plasticityInstance(p)), & config => config_phase(p)) - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! optional parameters that need to be defined prm%twinB = config%getFloat('twin_b',defaultVal=1.0_pReal) @@ -204,30 +201,31 @@ subroutine plastic_phenopowerlaw_init prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - if(structure=='bcc') then - prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + + if(trim(config%getString('lattice_structure')) == 'bcc') then + prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',& defaultVal = emptyRealArray) - prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) - prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) + prm%nonSchmid_pos = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt) + prm%nonSchmid_neg = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt) else - prm%nonSchmid_pos = prm%Schmid_slip - prm%nonSchmid_neg = prm%Schmid_slip + prm%nonSchmid_pos = prm%Schmid_slip + prm%nonSchmid_neg = prm%Schmid_slip endif prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getString('lattice_structure')) - prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) - prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) - prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), & - defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%xi_slip_0 = config%getFloats('tau0_slip', requiredSize=size(prm%Nslip)) + prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip)) + prm%H_int = config%getFloats('h_int', requiredSize=size(prm%Nslip), & + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) - prm%gdot0_slip = config%getFloat('gdot0_slip') - prm%n_slip = config%getFloat('n_slip') - prm%a_slip = config%getFloat('a_slip') - prm%h0_SlipSlip = config%getFloat('h0_slipslip') + prm%gdot0_slip = config%getFloat('gdot0_slip') + prm%n_slip = config%getFloat('n_slip') + prm%a_slip = config%getFloat('a_slip') + prm%h0_SlipSlip = config%getFloat('h0_slipslip') ! expand: family => system prm%xi_slip_0 = math_expand(prm%xi_slip_0, prm%Nslip) @@ -250,12 +248,12 @@ subroutine plastic_phenopowerlaw_init prm%Ntwin = config%getInts('ntwin', defaultVal=emptyIntArray) prm%totalNtwin = sum(prm%Ntwin) twinActive: if (prm%totalNtwin > 0_pInt) then - prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),& + prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& config%getFloats('interaction_twintwin'), & - structure(1:3)) - prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,structure(1:3),& + config%getString('lattice_structure')) + prm%gamma_twin_char = lattice_characteristicShear_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a')) prm%xi_twin_0 = config%getFloats('tau0_twin',requiredSize=size(prm%Ntwin)) @@ -282,10 +280,10 @@ subroutine plastic_phenopowerlaw_init slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& config%getFloats('interaction_sliptwin'), & - structure(1:3)) + config%getString('lattice_structure')) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& config%getFloats('interaction_twinslip'), & - structure(1:3)) + config%getString('lattice_structure')) else slipAndTwinActive allocate(prm%interaction_SlipTwin(prm%totalNslip,prm%TotalNtwin)) ! at least one dimension is 0 allocate(prm%interaction_TwinSlip(prm%totalNtwin,prm%TotalNslip)) ! at least one dimension is 0 From e2c31bdc7c0987b61e3e736673e4fc6c0d9d6b2a Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 14:23:52 +0100 Subject: [PATCH 36/61] [skip ci] updated version information after successful test of v2.0.2-1496-g1c4dc2e0 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index a25b1aedf..2c7fbd47e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1464-g8fabacec +v2.0.2-1496-g1c4dc2e0 From 79603be179529bcf6a0bf63aba8b2dd6cd2ad235 Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 17:42:17 +0100 Subject: [PATCH 37/61] [skip ci] updated version information after successful test of v2.0.2-1500-g7f640896 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index a25b1aedf..f2aea9e3e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1464-g8fabacec +v2.0.2-1500-g7f640896 From bf6b365ae7b7ca34fcbb06f748fe8eda1e6ecaee Mon Sep 17 00:00:00 2001 From: Test User Date: Fri, 25 Jan 2019 20:18:03 +0100 Subject: [PATCH 38/61] [skip ci] updated version information after successful test of v2.0.2-1501-gf2882f19 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index a25b1aedf..78ecb88d7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1464-g8fabacec +v2.0.2-1501-gf2882f19 From e9c1299a305663fcf1c581f92cadfdc9624dac91 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 26 Jan 2019 09:02:44 +0100 Subject: [PATCH 39/61] requiredShape makes no sense the return value is always a 1D array, only its size might change --- src/config.f90 | 11 ++++------- src/plastic_dislotwin.f90 | 26 +++++++++++++------------- 2 files changed, 17 insertions(+), 20 deletions(-) diff --git a/src/config.f90 b/src/config.f90 index b79442e62..b184f2a6b 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -550,7 +550,7 @@ end function getString !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getFloats(this,key,defaultVal,requiredShape,requiredSize) +function getFloats(this,key,defaultVal,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -561,7 +561,6 @@ function getFloats(this,key,defaultVal,requiredShape,requiredSize) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal - integer(pInt), dimension(:), intent(in), optional :: requiredShape ! not useful (is always 1D array) integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i @@ -601,7 +600,7 @@ end function getFloats !> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all !! values from the last occurrence. If key is not found exits with error unless default is given. !-------------------------------------------------------------------------------------------------- -function getInts(this,key,defaultVal,requiredShape,requiredSize) +function getInts(this,key,defaultVal,requiredSize) use IO, only: & IO_error, & IO_stringValue, & @@ -611,8 +610,7 @@ function getInts(this,key,defaultVal,requiredShape,requiredSize) integer(pInt), dimension(:), allocatable :: getInts class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key - integer(pInt), dimension(:), intent(in), optional :: defaultVal, & - requiredShape ! not useful (is always 1D array) + integer(pInt), dimension(:), intent(in), optional :: defaultVal integer(pInt), intent(in), optional :: requiredSize type(tPartitionedStringList), pointer :: item integer(pInt) :: i @@ -653,7 +651,7 @@ end function getInts !! values from the last occurrence. If key is not found exits with error unless default is given. !! If raw is true, the the complete string is returned, otherwise the individual chunks are returned !-------------------------------------------------------------------------------------------------- -function getStrings(this,key,defaultVal,requiredShape,raw) +function getStrings(this,key,defaultVal,raw) use IO, only: & IO_error, & IO_StringValue @@ -663,7 +661,6 @@ function getStrings(this,key,defaultVal,requiredShape,raw) class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal - integer(pInt), dimension(:), intent(in), optional :: requiredShape logical, intent(in), optional :: raw type(tPartitionedStringList), pointer :: item character(len=65536) :: str diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 0c56e6ba5..141837d86 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -312,17 +312,17 @@ subroutine plastic_dislotwin_init config%getFloats('interaction_slipslip'), & structure(1:3)) - 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), & + prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) !ToDo: rename to rho_0 + prm%rhoDip0 = config%getFloats('rhoedgedip0',requiredSize=size(prm%Nslip)) !ToDo: rename to rho_dip_0 + prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) + prm%burgers_slip = config%getFloats('slipburgers',requiredSize=size(prm%Nslip)) + prm%Qedge = config%getFloats('qedge', requiredSize=size(prm%Nslip)) !ToDo: rename (ask Karo) + prm%CLambdaSlip = config%getFloats('clambdaslip',requiredSize=size(prm%Nslip)) + prm%p = config%getFloats('p_slip', requiredSize=size(prm%Nslip)) + prm%q = config%getFloats('q_slip', requiredSize=size(prm%Nslip)) + prm%B = config%getFloats('b', requiredSize=size(prm%Nslip), & defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) - prm%tau_peierls = config%getFloats('tau_peierls',requiredShape=shape(prm%Nslip), & + prm%tau_peierls = config%getFloats('tau_peierls',requiredSize=size(prm%Nslip), & defaultVal=[(0.0_pReal, i=1,size(prm%Nslip))]) ! Deprecated prm%CEdgeDipMinDistance = config%getFloat('cedgedipmindistance') @@ -366,9 +366,9 @@ subroutine plastic_dislotwin_init config%getFloats('interaction_twintwin'), & structure(1:3)) - prm%burgers_twin = config%getFloats('twinburgers') - prm%twinsize = config%getFloats('twinsize') - prm%r = config%getFloats('r_twin') + prm%burgers_twin = config%getFloats('twinburgers', requiredSize=size(prm%Ntwin)) + prm%twinsize = config%getFloats('twinsize', requiredSize=size(prm%Ntwin)) + prm%r = config%getFloats('r_twin', requiredSize=size(prm%Ntwin)) prm%xc_twin = config%getFloat('xc_twin') prm%L0_twin = config%getFloat('l0_twin') From 012aa4c697e6f4a072b0744a6f26f599f698122c Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 26 Jan 2019 11:22:23 +0100 Subject: [PATCH 40/61] [skip ci] updated version information after successful test of v2.0.2-1516-gffd29bdc --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 2c7fbd47e..6dee49c94 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1496-g1c4dc2e0 +v2.0.2-1516-gffd29bdc From 3b5a6b2877695a2bdd2aa0c3b1ac2121f768d5fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 08:17:08 +0100 Subject: [PATCH 41/61] have internal functions at the end of the module --- src/plastic_dislotwin.f90 | 419 +++++++++++++++++++------------------- 1 file changed, 210 insertions(+), 209 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 141837d86..f61d04187 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -231,7 +231,7 @@ subroutine plastic_dislotwin_init implicit none integer(pInt) :: Ninstance,& f,j,i,k,o,p, & - offset_slip, index_myFamily, index_otherFamily, & + offset_slip, & startIndex, endIndex, outputSize integer(pInt) :: sizeState, sizeDotState integer(pInt) :: NipcMyPhase @@ -303,9 +303,9 @@ subroutine plastic_dislotwin_init if(prm%fccTwinTransNucleation) & prm%fcc_twinNucleationSlipPair = lattice_fcc_twinNucleationSlipPair - prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),& + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%forestProjection = lattice_forestProjection (prm%Nslip,structure(1:3),& + prm%forestProjection = lattice_forestProjection (prm%Nslip,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & @@ -360,11 +360,11 @@ subroutine plastic_dislotwin_init 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),& + prm%Schmid_twin = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,& config%getFloats('interaction_twintwin'), & - structure(1:3)) + config%getString('lattice_structure')) prm%burgers_twin = config%getFloats('twinburgers', requiredSize=size(prm%Ntwin)) prm%twinsize = config%getFloats('twinsize', requiredSize=size(prm%Ntwin)) @@ -376,10 +376,10 @@ subroutine plastic_dislotwin_init 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),& + prm%shear_twin = lattice_characteristicShear_Twin(prm%Ntwin,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%C66_twin = lattice_C66_twin(prm%Ntwin,prm%C66,structure(1:3),& + prm%C66_twin = lattice_C66_twin(prm%Ntwin,prm%C66,config%getString('lattice_structure'),& config%getFloat('c/a',defaultVal=0.0_pReal)) if (.not. prm%fccTwinTransNucleation) then @@ -415,7 +415,7 @@ subroutine plastic_dislotwin_init prm%interaction_TransTrans = lattice_interaction_TransTrans(prm%Ntrans,& config%getFloats('interaction_transtrans'), & - structure(1:3)) + config%getString('lattice_structure')) prm%C66_trans = lattice_C66_trans(prm%Ntrans,prm%C66, & config%getString('trans_lattice_structure'), & @@ -1165,6 +1165,208 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) end subroutine plastic_dislotwin_dotState +!-------------------------------------------------------------------------------------------------- +!> @brief return array of constitutive results +!-------------------------------------------------------------------------------------------------- +function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postResults) + use prec, only: & + tol_math_check, & + dEq0 + use math, only: & + PI, & + math_mul33xx33, & + math_Mandel6to33 + + implicit none + real(pReal), dimension(3,3),intent(in) :: & + Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation + real(pReal), intent(in) :: & + temperature !< temperature at integration point + integer(pInt), intent(in) :: & + instance, & + of + + real(pReal), dimension(sum(plastic_dislotwin_sizePostResult(:,instance))) :: & + postResults + + integer(pInt) :: & + o,c,j,& + s1,s2 + real(pReal) :: sumf_twin,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0_twin,dgdot_dtauslip, & + stressRatio + real(pReal), dimension(param(instance)%totalNslip) :: & + gdot_slip + + type(tParameters) :: prm + type(tDislotwinState) :: stt + type(tDislotwinMicrostructure) :: mse + + + associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) + + sumf_twin = sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) + + c = 0_pInt + postResults = 0.0_pReal + do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) + + case (edge_density_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (dipole_density_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (shear_rate_slip_ID) + call kinetics_slip(prm,stt,mse,of,Mp,temperature,postResults(c+1:c+prm%totalNslip)) + c = c + prm%totalNslip + case (accumulated_shear_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (mfp_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (resolved_stress_slip_ID) + do j = 1_pInt, prm%totalNslip + postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) + enddo + c = c + prm%totalNslip + case (threshold_stress_slip_ID) + postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress_slip(1_pInt:prm%totalNslip,of) + c = c + prm%totalNslip + case (edge_dipole_distance_ID) + do j = 1_pInt, prm%totalNslip + postResults(c+j) = (3.0_pReal*prm%mu*prm%burgers_slip(j)) & + / (16.0_pReal*PI*abs(math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)))) + postResults(c+j)=min(postResults(c+j),mse%mfp_slip(j,of)) + ! postResults(c+j)=max(postResults(c+j),& + ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) + enddo + c = c + prm%totalNslip + ! case (resolved_stress_shearband_ID) + ! do j = 1_pInt,6_pInt ! loop over all shearband families + ! postResults(c+j) = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) + ! enddo + ! c = c + 6_pInt + ! case (shear_rate_shearband_ID) + ! do j = 1_pInt,6_pInt ! loop over all shearbands + ! tau = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) + ! if (abs(tau) < tol_math_check) then + ! StressRatio_p = 0.0_pReal + ! StressRatio_pminus1 = 0.0_pReal + ! else + ! StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand + ! StressRatio_pminus1 = (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) + ! endif + ! BoltzmannRatio = prm%sbQedge/(kB*Temperature) + ! DotGamma0 = prm%sbVelocity + ! postResults(c+j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand)*& + ! sign(1.0_pReal,tau) + ! enddo + ! c = c + 6_pInt + case (twin_fraction_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (shear_rate_twin_ID) + do j = 1_pInt, prm%totalNslip + tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) + if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then + StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& + (prm%SolidSolutionStrength+& + prm%tau_peierls(j)))& + **prm%p(j) + StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& + (prm%SolidSolutionStrength+& + prm%tau_peierls(j)))& + **(prm%p(j)-1.0_pReal) + BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) + DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) + + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + prm%q(j))*sign(1.0_pReal,tau) + else + gdot_slip(j) = 0.0_pReal + endif + enddo + + do j = 1_pInt, prm%totalNtwin + tau = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) + + if ( tau > 0.0_pReal ) 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 + Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& + (prm%L0_twin* prm%burgers_slip(j))*& + (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)* (mse%tau_r_twin(j,of)-tau))) + else + Ndot0_twin=0.0_pReal + end if + else isFCCtwin + Ndot0_twin=prm%Ndot0_twin(j) + endif isFCCtwin + StressRatio_r = (mse%threshold_stress_twin(j,of)/tau) **prm%r(j) + postResults(c+j) = (prm%MaxTwinFraction-sumf_twin)*prm%shear_twin(j) & + * mse%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) + endif + enddo + c = c + prm%totalNtwin + case (accumulated_shear_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (mfp_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = mse%mfp_twin(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (resolved_stress_twin_ID) + do j = 1_pInt, prm%totalNtwin + postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) + enddo + c = c + prm%totalNtwin + case (threshold_stress_twin_ID) + postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (stress_exponent_ID) + do j = 1_pInt, prm%totalNslip + tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) + if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then + StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& + (prm%SolidSolutionStrength+& + prm%tau_peierls(j)))& + **prm%p(j) + StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& + (prm%SolidSolutionStrength+& + prm%tau_peierls(j)))& + **(prm%p(j)-1.0_pReal) + BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) + DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) + + gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& + prm%q(j))*sign(1.0_pReal,tau) + + dgdot_dtauslip = abs(gdot_slip(j))*BoltzmannRatio*prm%p(j) *prm%q(j)/& + (prm%SolidSolutionStrength+ prm%tau_peierls(j))*& + StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) + else + gdot_slip(j) = 0.0_pReal + dgdot_dtauslip = 0.0_pReal + endif + postResults(c+j) = merge(0.0_pReal,(tau/gdot_slip(j))*dgdot_dtauslip,dEq0(gdot_slip(j))) + enddo + c = c + prm%totalNslip + case (stress_trans_fraction_ID) + postResults(c+1_pInt:c+prm%totalNtrans) = stt%stressTransFraction(1_pInt:prm%totalNtrans,of) + c = c + prm%totalNtrans + case (strain_trans_fraction_ID) + postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) + c = c + prm%totalNtrans + end select + enddo + end associate +end function plastic_dislotwin_postResults + + !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on slip systems !-------------------------------------------------------------------------------------------------- @@ -1395,205 +1597,4 @@ pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_tran ! end subroutine kinetics_trans -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postResults) - use prec, only: & - tol_math_check, & - dEq0 - use math, only: & - PI, & - math_mul33xx33, & - math_Mandel6to33 - - implicit none - real(pReal), dimension(3,3),intent(in) :: & - Mp !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - instance, & - of - - real(pReal), dimension(sum(plastic_dislotwin_sizePostResult(:,instance))) :: & - postResults - - integer(pInt) :: & - o,c,j,& - s1,s2 - real(pReal) :: sumf_twin,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0_twin,dgdot_dtauslip, & - stressRatio - real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip - - type(tParameters) :: prm - type(tDislotwinState) :: stt - type(tDislotwinMicrostructure) :: mse - - - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) - - sumf_twin = sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) - - c = 0_pInt - postResults = 0.0_pReal - do o = 1_pInt,size(prm%outputID) - select case(prm%outputID(o)) - - case (edge_density_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdge(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (dipole_density_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (shear_rate_slip_ID) - call kinetics_slip(prm,stt,mse,of,Mp,temperature,postResults(c+1:c+prm%totalNslip)) - c = c + prm%totalNslip - case (accumulated_shear_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (mfp_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (resolved_stress_slip_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - enddo - c = c + prm%totalNslip - case (threshold_stress_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress_slip(1_pInt:prm%totalNslip,of) - c = c + prm%totalNslip - case (edge_dipole_distance_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = (3.0_pReal*prm%mu*prm%burgers_slip(j)) & - / (16.0_pReal*PI*abs(math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)))) - postResults(c+j)=min(postResults(c+j),mse%mfp_slip(j,of)) - ! postResults(c+j)=max(postResults(c+j),& - ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) - enddo - c = c + prm%totalNslip - ! case (resolved_stress_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearband families - ! postResults(c+j) = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! enddo - ! c = c + 6_pInt - ! case (shear_rate_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearbands - ! tau = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! if (abs(tau) < tol_math_check) then - ! StressRatio_p = 0.0_pReal - ! StressRatio_pminus1 = 0.0_pReal - ! else - ! StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand - ! StressRatio_pminus1 = (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) - ! endif - ! BoltzmannRatio = prm%sbQedge/(kB*Temperature) - ! DotGamma0 = prm%sbVelocity - ! postResults(c+j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand)*& - ! sign(1.0_pReal,tau) - ! enddo - ! c = c + 6_pInt - case (twin_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (shear_rate_twin_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - else - gdot_slip(j) = 0.0_pReal - endif - enddo - - do j = 1_pInt, prm%totalNtwin - tau = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) - - if ( tau > 0.0_pReal ) 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 - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_twin* prm%burgers_slip(j))*& - (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)* (mse%tau_r_twin(j,of)-tau))) - else - Ndot0_twin=0.0_pReal - end if - else isFCCtwin - Ndot0_twin=prm%Ndot0_twin(j) - endif isFCCtwin - StressRatio_r = (mse%threshold_stress_twin(j,of)/tau) **prm%r(j) - postResults(c+j) = (prm%MaxTwinFraction-sumf_twin)*prm%shear_twin(j) & - * mse%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) - endif - enddo - c = c + prm%totalNtwin - case (accumulated_shear_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (mfp_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%mfp_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (resolved_stress_twin_ID) - do j = 1_pInt, prm%totalNtwin - postResults(c+j) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) - enddo - c = c + prm%totalNtwin - case (threshold_stress_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (stress_exponent_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - - dgdot_dtauslip = abs(gdot_slip(j))*BoltzmannRatio*prm%p(j) *prm%q(j)/& - (prm%SolidSolutionStrength+ prm%tau_peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) - else - gdot_slip(j) = 0.0_pReal - dgdot_dtauslip = 0.0_pReal - endif - postResults(c+j) = merge(0.0_pReal,(tau/gdot_slip(j))*dgdot_dtauslip,dEq0(gdot_slip(j))) - enddo - c = c + prm%totalNslip - case (stress_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = stt%stressTransFraction(1_pInt:prm%totalNtrans,of) - c = c + prm%totalNtrans - case (strain_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) - c = c + prm%totalNtrans - end select - enddo - end associate -end function plastic_dislotwin_postResults - end module plastic_dislotwin From 4b2da52e87a95bd1fde56923c3f7e3f9f85b4d7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 08:35:07 +0100 Subject: [PATCH 42/61] following example of disloUCLA --- src/constitutive.f90 | 6 +- src/plastic_dislotwin.f90 | 274 ++++++++++++++++++-------------------- 2 files changed, 134 insertions(+), 146 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 299ed1c04..374f5ddee 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -365,7 +365,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) use plastic_nonlocal, only: & plastic_nonlocal_microstructure use plastic_dislotwin, only: & - plastic_dislotwin_microstructure + plastic_dislotwin_dependentState use plastic_disloUCLA, only: & plastic_disloUCLA_dependentState @@ -389,7 +389,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType - call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el) + of = phasememberAt(ipc,ip,el) + instance = phase_plasticityInstance(material_phase(ipc,ip,el)) + call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of) case (PLASTICITY_DISLOUCLA_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index f61d04187..29679233d 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -177,7 +177,7 @@ module plastic_dislotwin public :: & plastic_dislotwin_init, & plastic_dislotwin_homogenizedC, & - plastic_dislotwin_microstructure, & + plastic_dislotwin_dependentState, & plastic_dislotwin_LpAndItsTangent, & plastic_dislotwin_dotState, & plastic_dislotwin_postResults @@ -230,7 +230,7 @@ subroutine plastic_dislotwin_init implicit none integer(pInt) :: Ninstance,& - f,j,i,k,o,p, & + i,p, & offset_slip, & startIndex, endIndex, outputSize integer(pInt) :: sizeState, sizeDotState @@ -245,7 +245,6 @@ subroutine plastic_dislotwin_init outputID !< ID of each post result output character(len=pStringLen) :: & - structure = '',& extmsg = '' character(len=65536), dimension(:), allocatable :: & outputs @@ -289,8 +288,6 @@ subroutine plastic_dislotwin_init prm%nu = lattice_nu(p) prm%C66 = lattice_C66(1:6,1:6,p) - structure = config%getString('lattice_structure') - !-------------------------------------------------------------------------------------------------- ! slip related parameters @@ -310,7 +307,7 @@ subroutine plastic_dislotwin_init prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & - structure(1:3)) + config%getString('lattice_structure')) prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) !ToDo: rename to rho_0 prm%rhoDip0 = config%getFloats('rhoedgedip0',requiredSize=size(prm%Nslip)) !ToDo: rename to rho_dip_0 @@ -451,17 +448,17 @@ subroutine plastic_dislotwin_init if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,& config%getFloats('interaction_sliptwin'), & - structure(1:3)) + config%getString('lattice_structure')) prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,& config%getFloats('interaction_twinslip'), & - structure(1:3)) + config%getString('lattice_structure')) 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%getFloats('interaction_sliptrans'), & - structure(1:3)) + config%getString('lattice_structure')) 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 @@ -735,133 +732,6 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) end function plastic_dislotwin_homogenizedC -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine plastic_dislotwin_microstructure(temperature,ipc,ip,el) - use math, only: & - PI - use material, only: & - material_phase, & - phase_plasticityInstance, & - phasememberAt - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in) :: & - temperature !< temperature at IP - - integer(pInt) :: & - i, & - of - real(pReal) :: & - sumf_twin,SFE,sumf_trans - real(pReal), dimension(:), allocatable :: & - x0, & - fOverStacksize, & - ftransOverLamellarSize - - of = phasememberAt(ipc,ip,el) - - associate(prm => param(phase_plasticityInstance(material_phase(ipc,ip,el))),& - stt => state(phase_plasticityInstance(material_phase(ipc,ip,el))),& - mse => microstructure(phase_plasticityInstance(material_phase(ipc,ip,el)))) - - sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) - sumf_trans = sum(stt%stressTransFraction(1:prm%totalNtrans,of)) & - + sum(stt%strainTransFraction(1:prm%totalNtrans,of)) - - sfe = prm%SFE_0K + prm%dSFE_dT * Temperature - - !* rescaled volume fraction for topology - fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system - ftransOverLamellarSize = sumf_trans/prm%lamellarsizePerTransSystem !ToDo: But this not ... - !Todo: Physically ok, but naming could be adjusted - - - !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation - 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%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) - if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & - mse%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & - matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) - - !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin - - !ToDo: needed? if (prm%totalNtwin > 0_pInt) & - mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = & - matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) - - - !* 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) = & ! 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) - !ToDo: needed? if (prm%totalNtrans > 0_pInt) & - - mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = & - matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) - !$OMP END CRITICAL (evilmatmul) - - !* mean free path between 2 obstacles seen by a moving dislocation - do i = 1_pInt,prm%totalNslip - if ((prm%totalNtwin > 0_pInt) .or. (prm%totalNtrans > 0_pInt)) then ! ToDo: This is too simplified - mse%mfp_slip(i,of) = & - prm%GrainSize/(1.0_pReal+prm%GrainSize*& - (mse%invLambdaSlip(i,of) + mse%invLambdaSlipTwin(i,of) + mse%invLambdaSlipTrans(i,of))) - else - mse%mfp_slip(i,of) = & - prm%GrainSize/& - (1.0_pReal+prm%GrainSize*(mse%invLambdaSlip(i,of))) !!!!!! correct? - endif - enddo - - !* mean free path between 2 obstacles seen by a growing twin/martensite - mse%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*mse%invLambdaTwin(:,of)) - mse%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*mse%invLambdaTrans(:,of)) - - !* threshold stress for dislocation motion - forall (i = 1_pInt:prm%totalNslip) mse%threshold_stress_slip(i,of) = & - prm%mu*prm%burgers_slip(i)*& - sqrt(dot_product(stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of),& - prm%interaction_SlipSlip(i,1:prm%totalNslip))) - - !* threshold stress for growing twin/martensite - if(prm%totalNtwin == prm%totalNslip) & - mse%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & - (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & - (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? - if(prm%totalNtrans == prm%totalNslip) & - mse%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & - (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& - (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) - - ! final volume after growth - mse%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*mse%mfp_twin(:,of)**2.0_pReal - mse%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*mse%mfp_trans(:,of)**2.0_pReal - - !* equilibrium separation of partial dislocations (twin) - x0 = prm%mu*prm%burgers_twin**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) - - !* equilibrium separation of partial dislocations (trans) - x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) - -end associate -end subroutine plastic_dislotwin_microstructure - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- @@ -885,7 +755,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, integer(pInt) :: i,k,l,m,n,s1,s2 real(pReal) :: f_unrotated,StressRatio_p,& - StressRatio_r,BoltzmannRatio,Ndot0_twin,stressRatio, & + BoltzmannRatio, & Ndot0_trans,StressRatio_s, & dgdot_dtau, & tau @@ -1039,9 +909,9 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) of integer(pInt) :: i,s1,s2 - real(pReal) :: f_unrotated,StressRatio_p,BoltzmannRatio,& - EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,StressRatio_r,Ndot0_twin,stressRatio,& - Ndot0_trans,StressRatio_s,EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & + real(pReal) :: f_unrotated,& + EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,Ndot0_twin,& + Ndot0_trans,StressRatio_r,StressRatio_s,EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation, & tau real(pReal), dimension(plasticState(instance)%Nslip) :: & @@ -1165,6 +1035,126 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) end subroutine plastic_dislotwin_dotState +!-------------------------------------------------------------------------------------------------- +!> @brief calculates derived quantities from state +!-------------------------------------------------------------------------------------------------- +subroutine plastic_dislotwin_dependentState(temperature,instance,of) + use math, only: & + PI + + implicit none + integer(pInt), intent(in) :: & + instance, & !< component-ID of integration point + of + real(pReal), intent(in) :: & + temperature !< temperature at IP + + integer(pInt) :: & + i + real(pReal) :: & + sumf_twin,SFE,sumf_trans + real(pReal), dimension(:), allocatable :: & + x0, & + fOverStacksize, & + ftransOverLamellarSize + + + associate(prm => param(instance),& + stt => state(instance),& + mse => microstructure(instance)) + + sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) + sumf_trans = sum(stt%stressTransFraction(1:prm%totalNtrans,of)) & + + sum(stt%strainTransFraction(1:prm%totalNtrans,of)) + + sfe = prm%SFE_0K + prm%dSFE_dT * Temperature + + !* rescaled volume fraction for topology + fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system + ftransOverLamellarSize = sumf_trans/prm%lamellarsizePerTransSystem !ToDo: But this not ... + !Todo: Physically ok, but naming could be adjusted + + + !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation + 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%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) + if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & + mse%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & + matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + + !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin + + !ToDo: needed? if (prm%totalNtwin > 0_pInt) & + mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = & + matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + + + !* 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) = & ! 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) + !ToDo: needed? if (prm%totalNtrans > 0_pInt) & + + mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = & + matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) + !$OMP END CRITICAL (evilmatmul) + + !* mean free path between 2 obstacles seen by a moving dislocation + do i = 1_pInt,prm%totalNslip + if ((prm%totalNtwin > 0_pInt) .or. (prm%totalNtrans > 0_pInt)) then ! ToDo: This is too simplified + mse%mfp_slip(i,of) = & + prm%GrainSize/(1.0_pReal+prm%GrainSize*& + (mse%invLambdaSlip(i,of) + mse%invLambdaSlipTwin(i,of) + mse%invLambdaSlipTrans(i,of))) + else + mse%mfp_slip(i,of) = & + prm%GrainSize/& + (1.0_pReal+prm%GrainSize*(mse%invLambdaSlip(i,of))) !!!!!! correct? + endif + enddo + + !* mean free path between 2 obstacles seen by a growing twin/martensite + mse%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*mse%invLambdaTwin(:,of)) + mse%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*mse%invLambdaTrans(:,of)) + + !* threshold stress for dislocation motion + forall (i = 1_pInt:prm%totalNslip) mse%threshold_stress_slip(i,of) = & + prm%mu*prm%burgers_slip(i)*& + sqrt(dot_product(stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of),& + prm%interaction_SlipSlip(i,1:prm%totalNslip))) + + !* threshold stress for growing twin/martensite + if(prm%totalNtwin == prm%totalNslip) & + mse%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & + (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & + (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? + if(prm%totalNtrans == prm%totalNslip) & + mse%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & + (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& + (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) + + ! final volume after growth + mse%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*mse%mfp_twin(:,of)**2.0_pReal + mse%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*mse%mfp_trans(:,of)**2.0_pReal + + !* equilibrium separation of partial dislocations (twin) + x0 = prm%mu*prm%burgers_twin**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + mse%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) + + !* equilibrium separation of partial dislocations (trans) + x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + mse%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) + +end associate +end subroutine plastic_dislotwin_dependentState + + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- @@ -1197,10 +1187,6 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip - type(tParameters) :: prm - type(tDislotwinState) :: stt - type(tDislotwinMicrostructure) :: mse - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) From fc9e80b3c29dfb77dcfcc8cf5151c93ef260e468 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 10:48:27 +0100 Subject: [PATCH 43/61] using real name, not compatibility aliases --- src/constitutive.f90 | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 374f5ddee..a0d7147a6 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -411,9 +411,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e pReal use math, only: & math_mul33x33, & - math_Mandel6to33, & - math_Mandel33to6, & - math_Plain99to3333 + math_6toSym33, & + math_sym33to6, & + math_99to3333 use material, only: & phasememberAt, & phase_plasticity, & @@ -472,7 +472,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - S = math_Mandel6to33(S6) + S = math_6toSym33(S6) Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -497,9 +497,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e call plastic_kinehardening_LpAndItsTangent (Lp,dLp_dMp, Mp,instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_Mandel33to6(Mp), & + call plastic_nonlocal_LpAndItsTangent (Lp,dLp_dMp99, math_sym33to6(Mp), & temperature(ho)%p(tme),ip,el) - dLp_dMp = math_Plain99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget + dLp_dMp = math_99to3333(dLp_dMp99) ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget case (PLASTICITY_DISLOTWIN_ID) plasticityType of = phasememberAt(ipc,ip,el) @@ -542,7 +542,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e math_inv33, & math_det33, & math_mul33x33, & - math_Mandel6to33 + math_6toSym33 use material, only: & phasememberAt, & phase_plasticity, & @@ -599,7 +599,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e case (PLASTICITY_isotropic_ID) plasticityType of = phasememberAt(ipc,ip,el) instance = phase_plasticityInstance(material_phase(ipc,ip,el)) - call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_Mandel6to33(S6),instance,of) + call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6),instance,of) case default plasticityType my_Li = 0.0_pReal my_dLi_dS = 0.0_pReal @@ -718,7 +718,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip use math, only : & math_mul33x33, & math_mul3333xx33, & - math_Mandel66to3333, & + math_66toSym3333, & math_I3 use material, only: & material_phase, & @@ -751,7 +751,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip i, j ho = material_homogenizationAt(el) - C = math_Mandel66to3333(constitutive_homogenizedC(ipc,ip,el)) + C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el)) DegradationLoop: do d = 1_pInt, phase_NstiffnessDegradations(material_phase(ipc,ip,el)) degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el))) @@ -786,8 +786,8 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac debug_levelBasic use math, only: & math_mul33x33, & - math_Mandel6to33, & - math_Mandel33to6, & + math_6toSym33, & + math_sym33to6, & math_mul33x33 use mesh, only: & mesh_NcpElems, & @@ -862,7 +862,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) @@ -892,7 +892,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac call plastic_disloucla_dotState (Mp,temperature(ho)%p(tme),instance,of) case (PLASTICITY_NONLOCAL_ID) plasticityType - call plastic_nonlocal_dotState (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & + call plastic_nonlocal_dotState (math_sym33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) end select plasticityType @@ -1001,7 +1001,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) use prec, only: & pReal use math, only: & - math_Mandel6to33, & + math_6toSym33, & math_mul33x33 use mesh, only: & mesh_NcpElems, & @@ -1076,7 +1076,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) constitutive_postResults = 0.0_pReal - Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6)) + Mp = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6)) ho = material_homogenizationAt(el) tme = thermalMapping(ho)%p(ip,el) From 8c18b294201b405de83a0955e9ff9525b6567516 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 11:37:50 +0100 Subject: [PATCH 44/61] mutual unification --- src/plastic_disloUCLA.f90 | 29 ++---- src/plastic_dislotwin.f90 | 185 ++++++++++++++++++-------------------- 2 files changed, 95 insertions(+), 119 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index e386a9808..eea064158 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -73,7 +73,7 @@ module plastic_disloUCLA integer(kind(undefined_ID)), allocatable, dimension(:) :: & outputID !< ID of each post result output logical :: & - dipoleformation + dipoleFormation !< flag indicating consideration of dipole formation end type !< container type for internal constitutive parameters type, private :: tDisloUCLAState @@ -127,7 +127,6 @@ subroutine plastic_disloUCLA_init() debug_constitutive,& debug_levelBasic use math, only: & - math_mul3x3, & math_expand use IO, only: & IO_error, & @@ -148,8 +147,6 @@ subroutine plastic_disloUCLA_init() implicit none integer(pInt) :: & - index_myFamily, index_otherFamily, & - f,j,k,o, & Ninstance, & p, i, & NipcMyPhase, & @@ -222,9 +219,13 @@ subroutine plastic_disloUCLA_init() prm%nonSchmid_pos = prm%Schmid prm%nonSchmid_neg = prm%Schmid endif + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & config%getFloats('interaction_slipslip'), & config%getString('lattice_structure')) + prm%forestProjectionEdge = lattice_forestProjection(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) prm%rhoDip0 = config%getFloats('rhoedgedip0', requiredSize=size(prm%Nslip)) prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) @@ -334,24 +335,6 @@ subroutine plastic_disloUCLA_init() prm%totalNslip,0_pInt,0_pInt) plasticState(p)%sizePostResults = sum(plastic_disloUCLA_sizePostResult(:,phase_plasticityInstance(p))) - 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 - !-------------------------------------------------------------------------------------------------- ! locally defined state aliases and initialization of state0 and aTolState startIndex = 1_pInt @@ -372,7 +355,7 @@ subroutine plastic_disloUCLA_init() endIndex = endIndex + prm%totalNslip stt%accshear=>plasticState(p)%state(startIndex:endIndex,:) dot%accshear=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1e6_pReal !ToDo: better make optional parameter + plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal !ToDo: better make optional parameter ! global alias plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 29679233d..8637ed1cb 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -11,19 +11,19 @@ module plastic_dislotwin use prec, only: & pReal, & pInt - + implicit none private integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_dislotwin_sizePostResult !< size of each post result output + plastic_dislotwin_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_dislotwin_output !< name of each post result output - - real(pReal), parameter, private :: & - kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + plastic_dislotwin_output !< name of each post result output - enum, bind(c) - enumerator :: & + real(pReal), parameter, private :: & + kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin + + enum, bind(c) + enumerator :: & undefined_ID, & edge_density_ID, & dipole_density_ID, & @@ -45,7 +45,7 @@ module plastic_dislotwin stress_trans_fraction_ID, & strain_trans_fraction_ID end enum - + type, private :: tParameters real(pReal) :: & mu, & @@ -99,12 +99,12 @@ module plastic_dislotwin shear_twin, & !< characteristic shear for twins B !< drag coefficient real(pReal), dimension(:,:), allocatable :: & - interaction_SlipSlip, & !< coefficients for slip-slip interaction for each interaction type - interaction_SlipTwin, & !< coefficients for slip-twin interaction for each interaction type - 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_TransTrans !< coefficients for trans-trans interaction for each interaction type + interaction_SlipSlip, & !< + interaction_SlipTwin, & !< + interaction_TwinSlip, & !< + interaction_TwinTwin, & !< + interaction_SlipTrans, & !< + interaction_TransTrans !< integer(pInt), dimension(:,:), allocatable :: & fcc_twinNucleationSlipPair ! ToDo: Better name? Is also use for trans real(pReal), dimension(:,:), allocatable :: & @@ -116,27 +116,21 @@ module plastic_dislotwin Schmid_twin, & C66_twin, & C66_trans - logical :: & - dipoleFormation !< flag indicating consideration of dipole formation - - integer(kind(undefined_ID)), dimension(:), allocatable :: & - outputID !< ID of each post result output - - logical :: & - 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 - totalNtrans !< number of active transformation systems for each family and instance + totalNslip, & !< total number of active slip system + totalNtwin, & !< total number of active twin system + totalNtrans !< total number of active transformation system integer(pInt), dimension(:), allocatable :: & - Nslip, & !< number of active slip systems for each family and instance - Ntwin, & !< number of active twin systems for each family and instance - Ntrans !< number of active transformation systems for each family and instance - end type - - type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) - - + Nslip, & !< number of active slip systems for each family + Ntwin, & !< number of active twin systems for each family + Ntrans !< number of active transformation systems for each family + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output + logical :: & + fccTwinTransNucleation, & !< twinning and transformation models are for fcc + dipoleFormation !< flag indicating consideration of dipole formation + end type !< container type for internal constitutive parameters + type, private :: tDislotwinState real(pReal), pointer, dimension(:,:) :: & rhoEdge, & @@ -150,7 +144,7 @@ module plastic_dislotwin end type tDislotwinState type, private :: tDislotwinMicrostructure - real(pReal), allocatable, dimension(:,:) :: & + real(pReal), allocatable, dimension(:,:) :: & invLambdaSlip, & invLambdaSlipTwin, & invLambdaTwin, & @@ -168,11 +162,13 @@ module plastic_dislotwin tau_r_trans !< stress to bring partial close together for each trans system and instance end type tDislotwinMicrostructure +!-------------------------------------------------------------------------------------------------- +! containers for parameters and state + type(tParameters), allocatable, dimension(:), private :: param type(tDislotwinState), allocatable, dimension(:), private :: & - state, & - dotState - type(tDislotwinMicrostructure), allocatable, dimension(:), private :: & - microstructure + dotState, & + state + type(tDislotwinMicrostructure), allocatable, dimension(:), private :: microstructure public :: & plastic_dislotwin_init, & @@ -181,6 +177,10 @@ module plastic_dislotwin plastic_dislotwin_LpAndItsTangent, & plastic_dislotwin_dotState, & plastic_dislotwin_postResults + private :: & + kinetics_slip, & + kinetics_twin, & + kinetics_trans contains @@ -205,9 +205,6 @@ subroutine plastic_dislotwin_init debug_constitutive,& debug_levelBasic use math, only: & - math_rotate_forward3333, & - math_Mandel3333to66, & - math_mul3x3, & math_expand,& PI use IO, only: & @@ -229,25 +226,25 @@ subroutine plastic_dislotwin_init use lattice implicit none - integer(pInt) :: Ninstance,& - i,p, & - offset_slip, & - startIndex, endIndex, outputSize - integer(pInt) :: sizeState, sizeDotState - integer(pInt) :: NipcMyPhase - + integer(pInt) :: & + Ninstance, & + p, i, & + NipcMyPhase, outputSize, & + sizeState, sizeDotState, & + startIndex, endIndex + 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)::] integer(kind(undefined_ID)) :: & - outputID !< ID of each post result output + outputID character(len=pStringLen) :: & extmsg = '' character(len=65536), dimension(:), allocatable :: & - outputs + outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_DISLOTWIN_label//' init -+>>>' write(6,'(/,a)') ' A. Ma and F. Roters, Acta Materialia, 52(12):3603–3612, 2004' @@ -258,10 +255,9 @@ subroutine plastic_dislotwin_init write(6,'(a,/)') ' https://doi.org/10.1016/j.actamat.2016.07.032' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - + Ninstance = int(count(phase_plasticity == PLASTICITY_DISLOTWIN_ID),pInt) - if (Ninstance == 0_pInt) return - + if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance @@ -275,7 +271,7 @@ subroutine plastic_dislotwin_init allocate(dotState(Ninstance)) allocate(microstructure(Ninstance)) - do p = 1_pInt, size(phase_plasticityInstance) + do p = 1_pInt, size(phase_plasticity) if (phase_plasticity(p) /= PLASTICITY_DISLOTWIN_ID) cycle associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & @@ -291,24 +287,22 @@ subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- ! slip related parameters - prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) + prm%Nslip = config%getInts('nslip',defaultVal=emptyIntArray) prm%totalNslip = sum(prm%Nslip) slipActive: if (prm%totalNslip > 0_pInt) then + prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) + prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & + config%getFloats('interaction_slipslip'), & + config%getString('lattice_structure')) + prm%forestProjection = lattice_forestProjection (prm%Nslip,config%getString('lattice_structure'),& + config%getFloat('c/a',defaultVal=0.0_pReal)) 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,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - prm%forestProjection = lattice_forestProjection (prm%Nslip,config%getString('lattice_structure'),& - config%getFloat('c/a',defaultVal=0.0_pReal)) - - prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, & - config%getFloats('interaction_slipslip'), & - config%getString('lattice_structure')) - prm%rho0 = config%getFloats('rhoedge0', requiredSize=size(prm%Nslip)) !ToDo: rename to rho_0 prm%rhoDip0 = config%getFloats('rhoedgedip0',requiredSize=size(prm%Nslip)) !ToDo: rename to rho_dip_0 prm%v0 = config%getFloats('v0', requiredSize=size(prm%Nslip)) @@ -595,75 +589,72 @@ subroutine plastic_dislotwin_init plastic_dislotwin_sizePostResult(i,phase_plasticityInstance(p)) = outputSize prm%outputID = [prm%outputID, outputID] endif + enddo - !-------------------------------------------------------------------------------------------------- ! 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 - sizeState = sizeDotState + 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 + sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & prm%totalNslip,prm%totalNtwin,prm%totalNtrans) plasticState(p)%sizePostResults = sum(plastic_dislotwin_sizePostResult(:,phase_plasticityInstance(p))) - ! ToDo: do later on - offset_slip = 2_pInt*plasticState(p)%nslip - plasticState(p)%slipRate => & - 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) - - startIndex=1_pInt - endIndex=prm%totalNslip +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState + startIndex = 1_pInt + endIndex = prm%totalNslip stt%rhoEdge=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdge= spread(prm%rho0,2,NipcMyPhase) dot%rhoEdge=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNslip + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip stt%rhoEdgeDip=>plasticState(p)%state(startIndex:endIndex,:) stt%rhoEdgeDip= spread(prm%rhoDip0,2,NipcMyPhase) dot%rhoEdgeDip=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolRho - - startIndex=endIndex+1 - endIndex=endIndex+prm%totalNslip + + startIndex = endIndex + 1_pInt + endIndex = endIndex + prm%totalNslip stt%accshear_slip=>plasticState(p)%state(startIndex:endIndex,:) dot%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal + plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal !ToDo: better make optional parameter + ! global alias + plasticState(p)%slipRate => plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip => plasticState(p)%state(startIndex:endIndex,:) - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtwin stt%twinFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%twinFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtwin stt%accshear_twin=>plasticState(p)%state(startIndex:endIndex,:) dot%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtrans stt%stressTransFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%stressTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - startIndex=endIndex+1 + startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtrans stt%strainTransFraction=>plasticState(p)%state(startIndex:endIndex,:) dot%strainTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - plasticState(p)%state0 = plasticState(p)%state - dot%whole => plasticState(p)%dotState + dot%whole => plasticState(p)%dotState !ToDo: needed? allocate(mse%invLambdaSlip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) allocate(mse%invLambdaSlipTwin (prm%totalNslip, NipcMyPhase),source=0.0_pReal) @@ -683,11 +674,15 @@ subroutine plastic_dislotwin_init allocate(mse%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(mse%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally + end associate + enddo - + end subroutine plastic_dislotwin_init + !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- @@ -894,7 +889,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) dEq0 use math, only: & math_mul33xx33, & - math_Mandel6to33, & pi use material, only: & plasticState @@ -1164,8 +1158,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe dEq0 use math, only: & PI, & - math_mul33xx33, & - math_Mandel6to33 + math_mul33xx33 implicit none real(pReal), dimension(3,3),intent(in) :: & From aecb5f20bf9ef6450b0a8013e882007222e8b985 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 12:15:11 +0100 Subject: [PATCH 45/61] shortened --- src/plastic_dislotwin.f90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 8637ed1cb..aa3d2a1fa 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -686,7 +686,7 @@ end subroutine plastic_dislotwin_init !-------------------------------------------------------------------------------------------------- !> @brief returns the homogenized elasticity matrix !-------------------------------------------------------------------------------------------------- -function plastic_dislotwin_homogenizedC(ipc,ip,el) +function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) use material, only: & material_phase, & phase_plasticityInstance, & @@ -694,7 +694,7 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) implicit none real(pReal), dimension(6,6) :: & - plastic_dislotwin_homogenizedC + homogenizedC integer(pInt), intent(in) :: & ipc, & !< component-ID of integration point ip, & !< integration point @@ -713,18 +713,19 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) - plastic_dislotwin_homogenizedC = f_unrotated * prm%C66 + homogenizedC = f_unrotated * prm%C66 do i=1_pInt,prm%totalNtwin - plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & - + stt%twinFraction(i,of)*prm%C66_twin(1:6,1:6,i) + homogenizedC = homogenizedC & + + stt%twinFraction(i,of)*prm%C66_twin(1:6,1:6,i) enddo do i=1_pInt,prm%totalNtrans - plastic_dislotwin_homogenizedC = plastic_dislotwin_homogenizedC & - +(stt%stressTransFraction(i,of)+stt%strainTransFraction(i,of))*& - prm%C66_trans(1:6,1:6,i) + homogenizedC = homogenizedC & + +(stt%stressTransFraction(i,of)+stt%strainTransFraction(i,of))*prm%C66_trans(1:6,1:6,i) enddo + end associate - end function plastic_dislotwin_homogenizedC + +end function plastic_dislotwin_homogenizedC !-------------------------------------------------------------------------------------------------- From 85c5c4ba12b2d54618d731e97896131cfb750e50 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 14:19:18 +0100 Subject: [PATCH 46/61] includes references to DAMASK paper --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 683bf0074..2d7a5067f 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 683bf0074f3fa079989b51f5a67aa593b7577f0b +Subproject commit 2d7a5067f49dea6fac4ecc83f8b784fcfb380aca From 3843bf599cb18d879a4e48ee8cad0a56bb508595 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 15:14:50 +0100 Subject: [PATCH 47/61] removed - accumulatedshear_twin: linearly depends on twin volume fraction - output of further derived quantities --- src/plastic_dislotwin.f90 | 103 +------------------------------------- 1 file changed, 2 insertions(+), 101 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index aa3d2a1fa..7b3f3fa31 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -33,10 +33,7 @@ module plastic_dislotwin resolved_stress_slip_ID, & threshold_stress_slip_ID, & edge_dipole_distance_ID, & - stress_exponent_ID, & twin_fraction_ID, & - shear_rate_twin_ID, & - accumulated_shear_twin_ID, & mfp_twin_ID, & resolved_stress_twin_ID, & threshold_stress_twin_ID, & @@ -137,7 +134,6 @@ module plastic_dislotwin rhoEdgeDip, & accshear_slip, & twinFraction, & - accshear_twin, & stressTransFraction, & strainTransFraction, & whole @@ -545,19 +541,10 @@ subroutine plastic_dislotwin_init case ('edge_dipole_distance') outputID = merge(edge_dipole_distance_ID,undefined_ID,prm%totalNslip > 0_pInt) outputSize = prm%totalNslip - case ('stress_exponent') - outputID = merge(stress_exponent_ID,undefined_ID,prm%totalNslip > 0_pInt) - outputSize = prm%totalNslip case ('twin_fraction') outputID = merge(twin_fraction_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin - case ('shear_rate_twin','shearrate_twin') - outputID = merge(shear_rate_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) - outputSize = prm%totalNtwin - case ('accumulated_shear_twin') - outputID = merge(accumulated_shear_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) - outputSize = prm%totalNtwin case ('mfp_twin') outputID = merge(mfp_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin @@ -596,7 +583,7 @@ subroutine plastic_dislotwin_init ! 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(['twinFraction']),pInt) * prm%totalNtwin & + int(size(['stressTransFraction','strainTransFraction']),pInt) * prm%totalNtrans sizeState = sizeDotState @@ -636,12 +623,6 @@ subroutine plastic_dislotwin_init dot%twinFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex = endIndex + 1_pInt - endIndex=endIndex+prm%totalNtwin - stt%accshear_twin=>plasticState(p)%state(startIndex:endIndex,:) - dot%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = 1.0e6_pReal - startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtrans stt%stressTransFraction=>plasticState(p)%state(startIndex:endIndex,:) @@ -992,7 +973,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) Ndot0_twin=prm%Ndot0_twin(i) endif isFCCtwin dot%twinFraction(i,of) = f_unrotated * mse%twinVolume(i,of)*Ndot0_twin*exp(-StressRatio_r) - dot%accshear_twin(i,of) = dot%twinFraction(i,of) * prm%shear_twin(i) endif significantTwinStress enddo twinState @@ -1019,9 +999,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) endif isFCCtrans dot%strainTransFraction(i,of) = f_unrotated * & mse%martensiteVolume(i,of)*Ndot0_trans*exp(-StressRatio_s) - !* Dotstate for accumulated shear due to transformation - !dot%accshear_trans(i,of) = dot%strainTransFraction(i,of) * & - ! lattice_sheartrans(index_myfamily+i,ph) endif significantTransStress enddo transState @@ -1246,56 +1223,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe ! c = c + 6_pInt case (twin_fraction_ID) postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin - case (shear_rate_twin_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - else - gdot_slip(j) = 0.0_pReal - endif - enddo - - do j = 1_pInt, prm%totalNtwin - tau = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,j)) - - if ( tau > 0.0_pReal ) 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 - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_twin* prm%burgers_slip(j))*& - (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)* (mse%tau_r_twin(j,of)-tau))) - else - Ndot0_twin=0.0_pReal - end if - else isFCCtwin - Ndot0_twin=prm%Ndot0_twin(j) - endif isFCCtwin - StressRatio_r = (mse%threshold_stress_twin(j,of)/tau) **prm%r(j) - postResults(c+j) = (prm%MaxTwinFraction-sumf_twin)*prm%shear_twin(j) & - * mse%twinVolume(j,of)*Ndot0_twin*exp(-StressRatio_r) - endif - enddo - c = c + prm%totalNtwin - case (accumulated_shear_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = stt%accshear_twin(1_pInt:prm%totalNtwin,of) - c = c + prm%totalNtwin + c = c + prm%totalNtwin case (mfp_twin_ID) postResults(c+1_pInt:c+prm%totalNtwin) = mse%mfp_twin(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin @@ -1307,34 +1235,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe case (threshold_stress_twin_ID) postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin - case (stress_exponent_ID) - do j = 1_pInt, prm%totalNslip - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)) - if((abs(tau)-mse%threshold_stress_slip(j,of)) > tol_math_check) then - StressRatio_p = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **prm%p(j) - StressRatio_pminus1 = ((abs(tau)-mse%threshold_stress_slip(j,of))/& - (prm%SolidSolutionStrength+& - prm%tau_peierls(j)))& - **(prm%p(j)-1.0_pReal) - BoltzmannRatio = prm%Qedge(j)/(kB*Temperature) - DotGamma0 = stt%rhoEdge(j,of)*prm%burgers_slip(j)* prm%v0(j) - gdot_slip(j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**& - prm%q(j))*sign(1.0_pReal,tau) - - dgdot_dtauslip = abs(gdot_slip(j))*BoltzmannRatio*prm%p(j) *prm%q(j)/& - (prm%SolidSolutionStrength+ prm%tau_peierls(j))*& - StressRatio_pminus1*(1-StressRatio_p)**(prm%q(j)-1.0_pReal) - else - gdot_slip(j) = 0.0_pReal - dgdot_dtauslip = 0.0_pReal - endif - postResults(c+j) = merge(0.0_pReal,(tau/gdot_slip(j))*dgdot_dtauslip,dEq0(gdot_slip(j))) - enddo - c = c + prm%totalNslip case (stress_trans_fraction_ID) postResults(c+1_pInt:c+prm%totalNtrans) = stt%stressTransFraction(1_pInt:prm%totalNtrans,of) c = c + prm%totalNtrans From 453323d18a5cc5f2b0da578638ede3660f256021 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 15:17:26 +0100 Subject: [PATCH 48/61] use dislotwin test with sensible output --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 2d7a5067f..e03ef29af 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 2d7a5067f49dea6fac4ecc83f8b784fcfb380aca +Subproject commit e03ef29af51bf5b666a0765a137f773ca8af493d From 3fcb7d72c84bfbe98c6b2c4079907773f6c14b7f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 16:39:36 +0100 Subject: [PATCH 49/61] shortened --- src/plastic_dislotwin.f90 | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 7b3f3fa31..6ad0b73d9 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -53,7 +53,6 @@ module plastic_dislotwin GrainSize, & ! tol_math_check) then StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand gdot_sb = sign(prm%sbVelocity*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand), tau) - dgdot_dtau = ((abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand)/ prm%sbResistance) & + dgdot_dtau = (abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand)/ prm%sbResistance & * (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) & * (1.0_pReal-StressRatio_p)**(prm%qShearBand-1.0_pReal) @@ -814,13 +813,11 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, endif shearBandingContribution call kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin,dgdot_dtau_twin) - gdot_twin = f_unrotated * gdot_twin - dgdot_dtau_twin = f_unrotated * dgdot_dtau_twin twinContibution: do i = 1_pInt, prm%totalNtwin - Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) + Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) * f_unrotated forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + dgdot_dtau_twin(i)* prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) + + dgdot_dtau_twin(i)* prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) * f_unrotated enddo twinContibution transConstribution: do i = 1_pInt, prm%totalNtrans From 5903e19e18a620205bbe8eaacdc7bbc3e5bc6bef Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 16:59:44 +0100 Subject: [PATCH 50/61] signature as in disloUCLA --- src/plastic_dislotwin.f90 | 59 ++++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 26 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 6ad0b73d9..111930cab 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -772,7 +772,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, Lp = 0.0_pReal dLp_dMp = 0.0_pReal - call kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau_slip) + call kinetics_slip(Mp,temperature,instance,of,gdot_slip,dgdot_dtau_slip) slipContribution: do i = 1_pInt, prm%totalNslip Lp = Lp + gdot_slip(i)*prm%Schmid_slip(1:3,1:3,i) forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & @@ -900,7 +900,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) - call kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip) + call kinetics_slip(Mp,temperature,instance,of,gdot_slip) slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) @@ -1172,7 +1172,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNslip) = stt%rhoEdgeDip(1_pInt:prm%totalNslip,of) c = c + prm%totalNslip case (shear_rate_slip_ID) - call kinetics_slip(prm,stt,mse,of,Mp,temperature,postResults(c+1:c+prm%totalNslip)) + call kinetics_slip(Mp,temperature,instance,of,postResults(c+1:c+prm%totalNslip)) c = c + prm%totalNslip case (accumulated_shear_slip_ID) postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) @@ -1246,9 +1246,14 @@ end function plastic_dislotwin_postResults !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on slip systems +!> @brief Shear rates on slip systems, their derivatives with respect to resolved stress and the +! resolved stresss +!> @details Derivatives and resolved stress are calculated only optionally. +! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to +! have the optional arguments at the end !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau_slip) +pure subroutine kinetics_slip(Mp,Temperature,instance,of, & + gdot_slip,dgdot_dtau_slip,tau_slip) use prec, only: & tol_math_check, & dNeq0 @@ -1256,43 +1261,42 @@ pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNslip), intent(out) :: & gdot_slip - real(pReal), dimension(prm%totalNslip), optional, intent(out) :: & - dgdot_dtau_slip - real(pReal), dimension(prm%totalNslip) :: & + real(pReal), dimension(param(instance)%totalNslip), optional, intent(out) :: & + dgdot_dtau_slip, & + tau_slip + real(pReal), dimension(param(instance)%totalNslip) :: & dgdot_dtau - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNslip) :: & + real, dimension(param(instance)%totalNslip) :: & tau, & stressRatio, & StressRatio_p, & BoltzmannRatio, & - v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned) - v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned) + v_wait_inverse, & !< inverse of the effective velocity of a dislocation waiting at obstacles (unsigned) + v_run_inverse, & !< inverse of the velocity of a free moving dislocation (unsigned) dV_wait_inverse_dTau, & dV_run_inverse_dTau, & dV_dTau, & - tau_eff !< effective resolved stress + tau_eff !< effective resolved stress integer(pInt) :: i + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNslip tau(i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) enddo - tau_eff = abs(tau)-mse%threshold_stress_slip(:,of) + tau_eff = abs(tau)-dst%threshold_stress_slip(:,of) significantStress: where(tau_eff > tol_math_check) stressRatio = tau_eff/(prm%SolidSolutionStrength+prm%tau_peierls) @@ -1317,6 +1321,9 @@ pure subroutine kinetics_slip(prm,stt,mse,of,Mp,temperature,gdot_slip,dgdot_dtau end where significantStress if(present(dgdot_dtau_slip)) dgdot_dtau_slip = dgdot_dtau + if(present(tau_slip)) tau_slip = tau + + end associate end subroutine kinetics_slip @@ -1340,7 +1347,7 @@ pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin, of type(tDislotwinMicrostructure), intent(in) :: & mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + real(pReal), dimension(prm%totalNslip), intent(in) :: & gdot_slip real(pReal), dimension(prm%totalNtwin), intent(out) :: & gdot_twin From c9e050c031ba4ee0f669e055840e2ef71b92bd7a Mon Sep 17 00:00:00 2001 From: Test User Date: Sun, 27 Jan 2019 17:50:07 +0100 Subject: [PATCH 51/61] [skip ci] updated version information after successful test of v2.0.2-1519-g453323d1 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6dee49c94..a51af2ff4 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1516-gffd29bdc +v2.0.2-1519-g453323d1 From 4b3efac4e5a898a813ee98c0180b580c930a9d6d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 19:44:53 +0100 Subject: [PATCH 52/61] simplified --- src/plastic_dislotwin.f90 | 319 ++++++++++++++------------------------ 1 file changed, 115 insertions(+), 204 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 111930cab..d85855577 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -228,7 +228,6 @@ subroutine plastic_dislotwin_init sizeState, sizeDotState, & startIndex, endIndex - 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)::] @@ -256,7 +255,6 @@ subroutine plastic_dislotwin_init if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',Ninstance - allocate(plastic_dislotwin_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt) allocate(plastic_dislotwin_output(maxval(phase_Noutput),Ninstance)) plastic_dislotwin_output = '' @@ -728,19 +726,20 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, integer(pInt), intent(in) :: instance,of real(pReal), intent(in) :: Temperature - integer(pInt) :: i,k,l,m,n,s1,s2 + integer(pInt) :: i,k,l,m,n real(pReal) :: f_unrotated,StressRatio_p,& BoltzmannRatio, & - Ndot0_trans,StressRatio_s, & dgdot_dtau, & tau real(pReal), dimension(param(instance)%totalNslip) :: & gdot_slip,dgdot_dtau_slip real(pReal), dimension(param(instance)%totalNtwin) :: & gdot_twin,dgdot_dtau_twin - real(pReal):: gdot_sb,gdot_trans + real(pReal), dimension(param(instance)%totalNtrans) :: & + gdot_trans,dgdot_dtau_trans + real(pReal):: gdot_sb real(pReal), dimension(3,3) :: eigVectors, Schmid_shearBand - real(pReal), dimension(3) :: eigValues, sb_s, sb_m + real(pReal), dimension(3) :: eigValues logical :: error real(pReal), dimension(3,6), parameter :: & sb_sComposition = & @@ -790,16 +789,14 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, call math_eigenValuesVectorsSym(Mp,eigValues,eigVectors,error) do i = 1_pInt,6_pInt - sb_s = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_sComposition(1:3,i)) - sb_m = 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_mComposition(1:3,i)) - Schmid_shearBand = math_tensorproduct33(0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_sComposition(1:3,i)),& - 0.5_pReal*sqrt(2.0_pReal)*math_mul33x3(eigVectors,sb_mComposition(1:3,i))) + Schmid_shearBand = 0.5_pReal * math_tensorproduct33(math_mul33x3(eigVectors,sb_sComposition(1:3,i)),& + math_mul33x3(eigVectors,sb_mComposition(1:3,i))) tau = math_mul33xx33(Mp,Schmid_shearBand) significantShearBandStress: if (abs(tau) > tol_math_check) then - StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand + StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand gdot_sb = sign(prm%sbVelocity*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand), tau) - dgdot_dtau = (abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand)/ prm%sbResistance & + dgdot_dtau = abs(gdot_sb)*BoltzmannRatio* prm%pShearBand*prm%qShearBand/ prm%sbResistance & * (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) & * (1.0_pReal-StressRatio_p)**(prm%qShearBand-1.0_pReal) @@ -812,47 +809,22 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, endif shearBandingContribution - call kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin,dgdot_dtau_twin) + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_twin,dgdot_dtau_twin) twinContibution: do i = 1_pInt, prm%totalNtwin Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i) * f_unrotated forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + dgdot_dtau_twin(i)* prm%Schmid_twin(k,l,i)*prm%Schmid_twin(m,n,i) * f_unrotated enddo twinContibution + + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_trans,dgdot_dtau_trans) + transContibution: do i = 1_pInt, prm%totalNtrans + Lp = Lp + gdot_trans(i)*prm%Schmid_trans(1:3,1:3,i) * f_unrotated + forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & + dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & + + dgdot_dtau_trans(i)* prm%Schmid_trans(k,l,i)*prm%Schmid_trans(m,n,i) * f_unrotated + enddo transContibution - transConstribution: do i = 1_pInt, prm%totalNtrans - - tau = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - - significantTransStress: if (tau > tol_math_check) then - StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - - 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 - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& !!!!! correct? - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*& - (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*(mse%tau_r_trans(i,of)-tau))) - else - Ndot0_trans=0.0_pReal - end if - else isFCCtrans - Ndot0_trans=prm%Ndot0_trans(i) - endif isFCCtrans - - gdot_trans = mse%martensiteVolume(i,of) * Ndot0_trans*exp(-StressRatio_s) - gdot_trans = f_unrotated * gdot_trans - dgdot_dtau = ((gdot_trans*prm%s(i))/tau)*StressRatio_s - Lp = Lp + gdot_trans*prm%Schmid_trans(1:3,1:3,i) - - forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & - dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) & - + dgdot_dtau * prm%Schmid_trans(k,l,i)* prm%Schmid_trans(m,n,i) - endif significantTransStress - - enddo transConstribution end associate @@ -881,14 +853,18 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) instance, & of - integer(pInt) :: i,s1,s2 + integer(pInt) :: i real(pReal) :: f_unrotated,& - EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,Ndot0_twin,& - Ndot0_trans,StressRatio_r,StressRatio_s,EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & + EdgeDipMinDistance,AtomicVolume,VacancyDiffusion,& + EdgeDipDistance, ClimbVelocity,DotRhoEdgeDipClimb,DotRhoEdgeDipAnnihilation, & DotRhoDipFormation,DotRhoMultiplication,DotRhoEdgeEdgeAnnihilation, & tau real(pReal), dimension(plasticState(instance)%Nslip) :: & - gdot_slip + gdot_slip + real(pReal), dimension(plasticState(instance)%Ntwin) :: & + gdot_twin + real(pReal), dimension(plasticState(instance)%Ntrans) :: & + gdot_trans associate(prm => param(instance), stt => state(instance), & dot => dotstate(instance), mse => microstructure(instance)) @@ -901,6 +877,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) call kinetics_slip(Mp,temperature,instance,of,gdot_slip) + slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) @@ -922,10 +899,10 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) endif significantSlipStress2 !* Spontaneous annihilation of 2 single edge dislocations - DotRhoEdgeEdgeAnnihilation = ((2.0_pReal*EdgeDipMinDistance)/prm%burgers_slip(i))*& - stt%rhoEdge(i,of)*abs(gdot_slip(i)) + DotRhoEdgeEdgeAnnihilation = 2.0_pReal*EdgeDipMinDistance/prm%burgers_slip(i) & + * stt%rhoEdge(i,of)*abs(gdot_slip(i)) !* Spontaneous annihilation of a single edge dislocation with a dipole constituent - DotRhoEdgeDipAnnihilation = ((2.0_pReal*EdgeDipMinDistance)/prm%burgers_slip(i)) & + DotRhoEdgeDipAnnihilation = 2.0_pReal*EdgeDipMinDistance/prm%burgers_slip(i) & * stt%rhoEdgeDip(i,of)*abs(gdot_slip(i)) !* Dislocation dipole climb @@ -949,58 +926,14 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) dot%accshear_slip(i,of) = abs(gdot_slip(i)) enddo slipState - twinState: do i = 1_pInt, prm%totalNtwin - - tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - - significantTwinStress: if (tau > tol_math_check) then - StressRatio_r = (mse%threshold_stress_twin(i,of)/tau)**prm%r(i) - 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 - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_twin*prm%burgers_slip(i))*(1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_twin(i,of)-tau))) - else - Ndot0_twin=0.0_pReal - end if - else isFCCtwin - Ndot0_twin=prm%Ndot0_twin(i) - endif isFCCtwin - dot%twinFraction(i,of) = f_unrotated * mse%twinVolume(i,of)*Ndot0_twin*exp(-StressRatio_r) - endif significantTwinStress - - enddo twinState + call kinetics_twin(Mp,temperature,gdot_slip,instance,of,gdot_twin) + dot%twinFraction(:,of) = f_unrotated*gdot_twin/prm%shear_twin - transState: do i = 1_pInt, prm%totalNtrans - - tau = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) - - significantTransStress: if (tau > tol_math_check) then - StressRatio_s = (mse%threshold_stress_trans(i,of)/tau)**prm%s(i) - 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 - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*(1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_trans(i,of)-tau))) - else - Ndot0_trans=0.0_pReal - end if - else isFCCtrans - Ndot0_trans=prm%Ndot0_trans(i) - endif isFCCtrans - dot%strainTransFraction(i,of) = f_unrotated * & - mse%martensiteVolume(i,of)*Ndot0_trans*exp(-StressRatio_s) - endif significantTransStress - - enddo transState + call kinetics_trans(Mp,temperature,gdot_slip,instance,of,gdot_trans) + dot%twinFraction(:,of) = f_unrotated*gdot_trans end associate + end subroutine plastic_dislotwin_dotState @@ -1051,7 +984,6 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) 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) if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & mse%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) @@ -1059,8 +991,7 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin !ToDo: needed? if (prm%totalNtwin > 0_pInt) & - mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = & - matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation @@ -1070,10 +1001,7 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans) !ToDo: needed? if (prm%totalNtrans > 0_pInt) & - - mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = & - matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) - !$OMP END CRITICAL (evilmatmul) + mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) !* mean free path between 2 obstacles seen by a moving dislocation do i = 1_pInt,prm%totalNslip @@ -1082,9 +1010,8 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) prm%GrainSize/(1.0_pReal+prm%GrainSize*& (mse%invLambdaSlip(i,of) + mse%invLambdaSlipTwin(i,of) + mse%invLambdaSlipTrans(i,of))) else - mse%mfp_slip(i,of) = & - prm%GrainSize/& - (1.0_pReal+prm%GrainSize*(mse%invLambdaSlip(i,of))) !!!!!! correct? + mse%mfp_slip(i,of) = prm%GrainSize & + / (1.0_pReal+prm%GrainSize*mse%invLambdaSlip(i,of)) !!!!!! correct? endif enddo @@ -1120,7 +1047,8 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) mse%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) -end associate + end associate + end subroutine plastic_dislotwin_dependentState @@ -1148,20 +1076,12 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe postResults integer(pInt) :: & - o,c,j,& - s1,s2 - real(pReal) :: sumf_twin,tau,StressRatio_p,StressRatio_pminus1,BoltzmannRatio,DotGamma0,StressRatio_r,Ndot0_twin,dgdot_dtauslip, & - stressRatio - real(pReal), dimension(param(instance)%totalNslip) :: & - gdot_slip - + o,c,j associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) - - sumf_twin = sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) c = 0_pInt - postResults = 0.0_pReal + do o = 1_pInt,size(prm%outputID) select case(prm%outputID(o)) @@ -1234,14 +1154,16 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe c = c + prm%totalNtwin case (stress_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = stt%stressTransFraction(1_pInt:prm%totalNtrans,of) + postResults(c+1_pInt:c+prm%totalNtrans) = 0.0_pReal c = c + prm%totalNtrans case (strain_trans_fraction_ID) postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) c = c + prm%totalNtrans end select enddo + end associate + end function plastic_dislotwin_postResults @@ -1320,18 +1242,19 @@ pure subroutine kinetics_slip(Mp,Temperature,instance,of, & dgdot_dtau = 0.0_pReal end where significantStress + end associate + if(present(dgdot_dtau_slip)) dgdot_dtau_slip = dgdot_dtau if(present(tau_slip)) tau_slip = tau - end associate - end subroutine kinetics_slip !-------------------------------------------------------------------------------------------------- !> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin,dgdot_dtau_twin) +pure subroutine kinetics_twin(Mp,temperature,gdot_slip,instance,of,& + gdot_twin,dgdot_dtau_twin) use prec, only: & tol_math_check, & dNeq0 @@ -1339,71 +1262,71 @@ pure subroutine kinetics_twin(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_twin, math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(in) :: & + real(pReal), dimension(param(instance)%totalNslip), intent(in) :: & gdot_slip - real(pReal), dimension(prm%totalNtwin), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: & gdot_twin - real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: & + real(pReal), dimension(param(instance)%totalNtwin), optional, intent(out) :: & dgdot_dtau_twin - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNtwin) :: & + real, dimension(param(instance)%totalNtwin) :: & tau, & - Ndot0_twin, & + Ndot0, & stressRatio_r, & dgdot_dtau integer(pInt) :: i,s1,s2 + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNtwin tau(i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i)) 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 - Ndot0_twin=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& + if (tau(i) < dst%tau_r_twin(i,of)) then + Ndot0=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state (prm%L0_twin*prm%burgers_slip(i))*& (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_twin(i,of)-tau))) + (dst%tau_r_twin(i,of)-tau))) else - Ndot0_twin=0.0_pReal + Ndot0=0.0_pReal end if else isFCC - Ndot0_twin=prm%Ndot0_twin(i) + Ndot0=prm%Ndot0_twin(i) endif isFCC enddo - significantStress: where(tau > tol_math_check) - StressRatio_r = (mse%threshold_stress_twin(:,of)/tau)**prm%r - gdot_twin = prm%shear_twin * mse%twinVolume(:,of) * Ndot0_twin*exp(-StressRatio_r) - dgdot_dtau = ((gdot_twin*prm%r)/tau)*StressRatio_r + StressRatio_r = (dst%threshold_stress_twin(:,of)/tau)**prm%r + gdot_twin = prm%shear_twin * dst%twinVolume(:,of) * Ndot0*exp(-StressRatio_r) + dgdot_dtau = (gdot_twin*prm%r/tau)*StressRatio_r else where significantStress gdot_twin = 0.0_pReal dgdot_dtau = 0.0_pReal end where significantStress + + end associate if(present(dgdot_dtau_twin)) dgdot_dtau_twin = dgdot_dtau end subroutine kinetics_twin - + !-------------------------------------------------------------------------------------------------- -!> @brief calculates shear rates on transformation systems +!> @brief calculates shear rates on twin systems !-------------------------------------------------------------------------------------------------- -pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_trans,dgdot_dtau_trans) +pure subroutine kinetics_trans(Mp,temperature,gdot_slip,instance,of,& + gdot_trans,dgdot_dtau_trans) use prec, only: & tol_math_check, & dNeq0 @@ -1411,75 +1334,63 @@ pure subroutine kinetics_trans(prm,stt,mse,of,Mp,temperature,gdot_slip,gdot_tran math_mul33xx33 implicit none - type(tParameters), intent(in) :: & - prm - type(tDislotwinState), intent(in) :: & - stt - integer(pInt), intent(in) :: & + real(pReal), dimension(3,3), intent(in) :: & + Mp !< Mandel stress + real(pReal), intent(in) :: & + temperature !< temperature + integer(pInt), intent(in) :: & + instance, & of - type(tDislotwinMicrostructure), intent(in) :: & - mse - real(pReal), dimension(prm%totalNslip), intent(out) :: & + real(pReal), dimension(param(instance)%totalNslip), intent(in) :: & gdot_slip - real(pReal), dimension(prm%totalNtrans), intent(out) :: & + + real(pReal), dimension(param(instance)%totalNtrans), intent(out) :: & gdot_trans - real(pReal), dimension(prm%totalNtrans), optional, intent(out) :: & + real(pReal), dimension(param(instance)%totalNtrans), optional, intent(out) :: & dgdot_dtau_trans - real(pReal), dimension(3,3), intent(in) :: & - Mp - real(pReal), intent(in) :: & - temperature - real, dimension(prm%totalNtrans) :: & + real, dimension(param(instance)%totalNtrans) :: & tau, & - Ndot0_trans, & - stressRatio_r, & + Ndot0, & + stressRatio_s, & dgdot_dtau integer(pInt) :: i,s1,s2 + + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) do i = 1_pInt, prm%totalNtrans tau(i) = math_mul33xx33(Mp,prm%Schmid_trans(1:3,1:3,i)) 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 - Ndot0_trans=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& - abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& - (prm%L0_trans*prm%burgers_slip(i))*& ! burgers_slip correct? + if (tau(i) < dst%tau_r_trans(i,of)) then + Ndot0=(abs(gdot_slip(s1))*(stt%rhoEdge(s2,of)+stt%rhoEdgeDip(s2,of))+& + abs(gdot_slip(s2))*(stt%rhoEdge(s1,of)+stt%rhoEdgeDip(s1,of)))/& ! ToDo: MD: it would be more consistent to use shearrates from state + (prm%L0_trans*prm%burgers_slip(i))*& (1.0_pReal-exp(-prm%VcrossSlip/(kB*Temperature)*& - (mse%tau_r_trans(i,of)-tau))) + (dst%tau_r_trans(i,of)-tau))) else - Ndot0_trans=0.0_pReal + Ndot0=0.0_pReal end if else isFCC - Ndot0_trans=prm%Ndot0_trans(i) + Ndot0=prm%Ndot0_trans(i) endif isFCC enddo -! -! -! endif isFCCtrans -! dot%strainTransFraction(i,of) = f_unrotated * & -! mse%martensiteVolume(i,of)*Ndot0_trans*exp(-StressRatio_s) -! !* Dotstate for accumulated shear due to transformation -! !dot%accshear_trans(i,of) = dot%strainTransFraction(i,of) * & -! ! lattice_sheartrans(index_myfamily+i,ph) -! endif significantTransStress -! -! enddo transState -! -! -! significantStress: where(tau > tol_math_check) -! StressRatio_r = (mse%threshold_stress_twin(:,of)/tau)**prm%r -! gdot_twin = prm%shear_twin * mse%twinVolume(:,of) * Ndot0_twin*exp(-StressRatio_r) -! dgdot_dtau = ((gdot_twin*prm%r)/tau)*StressRatio_r -! else where significantStress -! gdot_twin = 0.0_pReal -! dgdot_dtau = 0.0_pReal -! end where significantStress -! -! if(present(dgdot_dtau_twin)) dgdot_dtau_twin = dgdot_dtau -! + + significantStress: where(tau > tol_math_check) + StressRatio_s = (dst%threshold_stress_trans(:,of)/tau)**prm%s + gdot_trans = dst%martensiteVolume(:,of) * Ndot0*exp(-StressRatio_s) + dgdot_dtau = (gdot_trans*prm%r/tau)*StressRatio_s + else where significantStress + gdot_trans = 0.0_pReal + dgdot_dtau = 0.0_pReal + end where significantStress + + end associate + + if(present(dgdot_dtau_trans)) dgdot_dtau_trans = dgdot_dtau + end subroutine kinetics_trans end module plastic_dislotwin From 7ce47930d1052d53c45486c3397e6c8fcd493737 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 22:00:18 +0100 Subject: [PATCH 53/61] test compatible with updated disloXX models --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index e03ef29af..0c34bbee9 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit e03ef29af51bf5b666a0765a137f773ca8af493d +Subproject commit 0c34bbee91b3d293382063126afe0abd22b44986 From 5630b389628508892216e988c85b44432fd2f6c8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 22:06:08 +0100 Subject: [PATCH 54/61] stress induced transformation was never really implemented --- src/plastic_dislotwin.f90 | 24 +++--------------------- 1 file changed, 3 insertions(+), 21 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index d85855577..e50dfea6f 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -39,7 +39,6 @@ module plastic_dislotwin threshold_stress_twin_ID, & resolved_stress_shearband_ID, & shear_rate_shearband_ID, & - stress_trans_fraction_ID, & strain_trans_fraction_ID end enum @@ -133,7 +132,6 @@ module plastic_dislotwin rhoEdgeDip, & accshear_slip, & twinFraction, & - stressTransFraction, & strainTransFraction, & whole end type tDislotwinState @@ -558,9 +556,6 @@ subroutine plastic_dislotwin_init outputID = shear_rate_shearband_ID outputSize = 6_pInt - case ('stress_trans_fraction') - outputID = stress_trans_fraction_ID - outputSize = prm%totalNtrans case ('strain_trans_fraction') outputID = strain_trans_fraction_ID outputSize = prm%totalNtrans @@ -580,7 +575,7 @@ subroutine plastic_dislotwin_init NipcMyPhase = count(material_phase == p) sizeDotState = int(size(['rho ','rhoDip ','accshearslip']),pInt) * prm%totalNslip & + int(size(['twinFraction']),pInt) * prm%totalNtwin & - + int(size(['stressTransFraction','strainTransFraction']),pInt) * prm%totalNtrans + + int(size(['strainTransFraction']),pInt) * prm%totalNtrans sizeState = sizeDotState call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, & @@ -619,12 +614,6 @@ subroutine plastic_dislotwin_init dot%twinFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac - startIndex = endIndex + 1_pInt - endIndex=endIndex+prm%totalNtrans - stt%stressTransFraction=>plasticState(p)%state(startIndex:endIndex,:) - dot%stressTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) - plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - startIndex = endIndex + 1_pInt endIndex=endIndex+prm%totalNtrans stt%strainTransFraction=>plasticState(p)%state(startIndex:endIndex,:) @@ -687,7 +676,6 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) homogenizedC = f_unrotated * prm%C66 @@ -697,7 +685,7 @@ function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC) enddo do i=1_pInt,prm%totalNtrans homogenizedC = homogenizedC & - +(stt%stressTransFraction(i,of)+stt%strainTransFraction(i,of))*prm%C66_trans(1:6,1:6,i) + + stt%strainTransFraction(i,of)*prm%C66_trans(1:6,1:6,i) enddo end associate @@ -765,7 +753,6 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) Lp = 0.0_pReal @@ -873,7 +860,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - - sum(stt%stressTransFraction(1_pInt:prm%totalNtrans,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) call kinetics_slip(Mp,temperature,instance,of,gdot_slip) @@ -966,8 +952,7 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) mse => microstructure(instance)) sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) - sumf_trans = sum(stt%stressTransFraction(1:prm%totalNtrans,of)) & - + sum(stt%strainTransFraction(1:prm%totalNtrans,of)) + sumf_trans = sum(stt%strainTransFraction(1:prm%totalNtrans,of)) sfe = prm%SFE_0K + prm%dSFE_dT * Temperature @@ -1153,9 +1138,6 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin - case (stress_trans_fraction_ID) - postResults(c+1_pInt:c+prm%totalNtrans) = 0.0_pReal - c = c + prm%totalNtrans case (strain_trans_fraction_ID) postResults(c+1_pInt:c+prm%totalNtrans) = stt%strainTransFraction(1_pInt:prm%totalNtrans,of) c = c + prm%totalNtrans From 6983718685a0250f23fda4518da81c8aac8081cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 22:08:36 +0100 Subject: [PATCH 55/61] dst for "dependentState" --- src/plastic_dislotwin.f90 | 90 +++++++++++++++++++-------------------- 1 file changed, 45 insertions(+), 45 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index e50dfea6f..d334fd501 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -267,7 +267,7 @@ subroutine plastic_dislotwin_init associate(prm => param(phase_plasticityInstance(p)), & dot => dotState(phase_plasticityInstance(p)), & stt => state(phase_plasticityInstance(p)), & - mse => microstructure(phase_plasticityInstance(p)), & + dst => microstructure(phase_plasticityInstance(p)), & config => config_phase(p)) ! This data is read in already in lattice @@ -622,23 +622,23 @@ subroutine plastic_dislotwin_init dot%whole => plasticState(p)%dotState !ToDo: needed? - 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(dst%invLambdaSlip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaSlipTwin (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaSlipTrans (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_slip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_slip (prm%totalNslip, 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(dst%invLambdaTwin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%twinVolume (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_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(mse%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%mfp_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally @@ -749,7 +749,7 @@ subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,Temperature,instance, 0, 1, 1 & ],pReal),[ 3,6]) - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & @@ -854,7 +854,7 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) gdot_trans associate(prm => param(instance), stt => state(instance), & - dot => dotstate(instance), mse => microstructure(instance)) + dot => dotstate(instance), dst => microstructure(instance)) dot%whole(:,of) = 0.0_pReal @@ -867,14 +867,14 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) slipState: do i = 1_pInt, prm%totalNslip tau = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i)) - DotRhoMultiplication = abs(gdot_slip(i))/(prm%burgers_slip(i)*mse%mfp_slip(i,of)) + DotRhoMultiplication = abs(gdot_slip(i))/(prm%burgers_slip(i)*dst%mfp_slip(i,of)) EdgeDipMinDistance = prm%CEdgeDipMinDistance*prm%burgers_slip(i) significantSlipStress2: if (dEq0(tau)) then DotRhoDipFormation = 0.0_pReal else significantSlipStress2 EdgeDipDistance = (3.0_pReal*prm%mu*prm%burgers_slip(i))/(16.0_pReal*PI*abs(tau)) - if (EdgeDipDistance>mse%mfp_slip(i,of)) EdgeDipDistance = mse%mfp_slip(i,of) + if (EdgeDipDistance>dst%mfp_slip(i,of)) EdgeDipDistance = dst%mfp_slip(i,of) if (EdgeDipDistance param(instance),& stt => state(instance),& - mse => microstructure(instance)) + dst => microstructure(instance)) sumf_twin = sum(stt%twinFraction(1:prm%totalNtwin,of)) sumf_trans = sum(stt%strainTransFraction(1:prm%totalNtrans,of)) @@ -964,73 +964,73 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation forall (i = 1_pInt:prm%totalNslip) & - mse%invLambdaSlip(i,of) = & + dst%invLambdaSlip(i,of) = & sqrt(dot_product((stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of)),& 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 if (prm%totalNtwin > 0_pInt .and. prm%totalNslip > 0_pInt) & - mse%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & + dst%invLambdaSlipTwin(1_pInt:prm%totalNslip,of) = & matmul(prm%interaction_SlipTwin,fOverStacksize)/(1.0_pReal-sumf_twin) !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin !ToDo: needed? if (prm%totalNtwin > 0_pInt) & - mse%invLambdaTwin(1_pInt:prm%totalNtwin,of) = matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) + dst%invLambdaTwin(1_pInt:prm%totalNtwin,of) = matmul(prm%interaction_TwinTwin,fOverStacksize)/(1.0_pReal-sumf_twin) !* 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) = & ! ToDo: does not work if Ntrans is not 12 + dst%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) !ToDo: needed? if (prm%totalNtrans > 0_pInt) & - mse%invLambdaTrans(1_pInt:prm%totalNtrans,of) = matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) + dst%invLambdaTrans(1_pInt:prm%totalNtrans,of) = matmul(prm%interaction_TransTrans,ftransOverLamellarSize)/(1.0_pReal-sumf_trans) !* mean free path between 2 obstacles seen by a moving dislocation do i = 1_pInt,prm%totalNslip if ((prm%totalNtwin > 0_pInt) .or. (prm%totalNtrans > 0_pInt)) then ! ToDo: This is too simplified - mse%mfp_slip(i,of) = & + dst%mfp_slip(i,of) = & prm%GrainSize/(1.0_pReal+prm%GrainSize*& - (mse%invLambdaSlip(i,of) + mse%invLambdaSlipTwin(i,of) + mse%invLambdaSlipTrans(i,of))) + (dst%invLambdaSlip(i,of) + dst%invLambdaSlipTwin(i,of) + dst%invLambdaSlipTrans(i,of))) else - mse%mfp_slip(i,of) = prm%GrainSize & - / (1.0_pReal+prm%GrainSize*mse%invLambdaSlip(i,of)) !!!!!! correct? + dst%mfp_slip(i,of) = prm%GrainSize & + / (1.0_pReal+prm%GrainSize*dst%invLambdaSlip(i,of)) !!!!!! correct? endif enddo !* mean free path between 2 obstacles seen by a growing twin/martensite - mse%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*mse%invLambdaTwin(:,of)) - mse%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*mse%invLambdaTrans(:,of)) + dst%mfp_twin(:,of) = prm%Cmfptwin*prm%GrainSize/ (1.0_pReal+prm%GrainSize*dst%invLambdaTwin(:,of)) + dst%mfp_trans(:,of) = prm%Cmfptrans*prm%GrainSize/(1.0_pReal+prm%GrainSize*dst%invLambdaTrans(:,of)) !* threshold stress for dislocation motion - forall (i = 1_pInt:prm%totalNslip) mse%threshold_stress_slip(i,of) = & + forall (i = 1_pInt:prm%totalNslip) dst%threshold_stress_slip(i,of) = & prm%mu*prm%burgers_slip(i)*& sqrt(dot_product(stt%rhoEdge(1_pInt:prm%totalNslip,of)+stt%rhoEdgeDip(1_pInt:prm%totalNslip,of),& prm%interaction_SlipSlip(i,1:prm%totalNslip))) !* threshold stress for growing twin/martensite if(prm%totalNtwin == prm%totalNslip) & - mse%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & + dst%threshold_stress_twin(:,of) = prm%Cthresholdtwin* & (sfe/(3.0_pReal*prm%burgers_twin)+ 3.0_pReal*prm%burgers_twin*prm%mu/ & (prm%L0_twin*prm%burgers_slip)) ! slip burgers here correct? if(prm%totalNtrans == prm%totalNslip) & - mse%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & + dst%threshold_stress_trans(:,of) = prm%Cthresholdtrans* & (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) ! final volume after growth - mse%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*mse%mfp_twin(:,of)**2.0_pReal - mse%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*mse%mfp_trans(:,of)**2.0_pReal + dst%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*dst%mfp_twin(:,of)**2.0_pReal + dst%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*dst%mfp_trans(:,of)**2.0_pReal !* equilibrium separation of partial dislocations (twin) x0 = prm%mu*prm%burgers_twin**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) + dst%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) !* equilibrium separation of partial dislocations (trans) x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) - mse%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) + dst%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) end associate @@ -1063,7 +1063,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe integer(pInt) :: & o,c,j - associate(prm => param(instance), stt => state(instance), mse => microstructure(instance)) + associate(prm => param(instance), stt => state(instance), dst => microstructure(instance)) c = 0_pInt @@ -1083,7 +1083,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1_pInt:prm%totalNslip,of) c = c + prm%totalNslip case (mfp_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%mfp_slip(1_pInt:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp_slip(1_pInt:prm%totalNslip,of) c = c + prm%totalNslip case (resolved_stress_slip_ID) do j = 1_pInt, prm%totalNslip @@ -1091,13 +1091,13 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe enddo c = c + prm%totalNslip case (threshold_stress_slip_ID) - postResults(c+1_pInt:c+prm%totalNslip) = mse%threshold_stress_slip(1_pInt:prm%totalNslip,of) + postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress_slip(1_pInt:prm%totalNslip,of) c = c + prm%totalNslip case (edge_dipole_distance_ID) do j = 1_pInt, prm%totalNslip postResults(c+j) = (3.0_pReal*prm%mu*prm%burgers_slip(j)) & / (16.0_pReal*PI*abs(math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)))) - postResults(c+j)=min(postResults(c+j),mse%mfp_slip(j,of)) + postResults(c+j)=min(postResults(c+j),dst%mfp_slip(j,of)) ! postResults(c+j)=max(postResults(c+j),& ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) enddo @@ -1127,7 +1127,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin case (mfp_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%mfp_twin(1_pInt:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = dst%mfp_twin(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin case (resolved_stress_twin_ID) do j = 1_pInt, prm%totalNtwin @@ -1135,7 +1135,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe enddo c = c + prm%totalNtwin case (threshold_stress_twin_ID) - postResults(c+1_pInt:c+prm%totalNtwin) = mse%threshold_stress_twin(1_pInt:prm%totalNtwin,of) + postResults(c+1_pInt:c+prm%totalNtwin) = dst%threshold_stress_twin(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin case (strain_trans_fraction_ID) From 35972fbb8e19fb0f33864aa8192291f0b82344ba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 22:12:27 +0100 Subject: [PATCH 56/61] output would need to be store on demand --- src/plastic_dislotwin.f90 | 41 +-------------------------------------- 1 file changed, 1 insertion(+), 40 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index d334fd501..5e1235a94 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -532,9 +532,6 @@ subroutine plastic_dislotwin_init case ('threshold_stress_slip') outputID= merge(threshold_stress_slip_ID,undefined_ID,prm%totalNslip > 0_pInt) outputSize = prm%totalNslip - case ('edge_dipole_distance') - outputID = merge(edge_dipole_distance_ID,undefined_ID,prm%totalNslip > 0_pInt) - outputSize = prm%totalNslip case ('twin_fraction') outputID = merge(twin_fraction_ID,undefined_ID,prm%totalNtwin >0_pInt) @@ -549,13 +546,6 @@ subroutine plastic_dislotwin_init outputID = merge(threshold_stress_twin_ID,undefined_ID,prm%totalNtwin >0_pInt) outputSize = prm%totalNtwin - case ('resolved_stress_shearband') - outputID = resolved_stress_shearband_ID - outputSize = 6_pInt - case ('shear_rate_shearband','shearrate_shearband') - outputID = shear_rate_shearband_ID - outputSize = 6_pInt - case ('strain_trans_fraction') outputID = strain_trans_fraction_ID outputSize = prm%totalNtrans @@ -1093,36 +1083,7 @@ function plastic_dislotwin_postResults(Mp,Temperature,instance,of) result(postRe case (threshold_stress_slip_ID) postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress_slip(1_pInt:prm%totalNslip,of) c = c + prm%totalNslip - case (edge_dipole_distance_ID) - do j = 1_pInt, prm%totalNslip - postResults(c+j) = (3.0_pReal*prm%mu*prm%burgers_slip(j)) & - / (16.0_pReal*PI*abs(math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,j)))) - postResults(c+j)=min(postResults(c+j),dst%mfp_slip(j,of)) - ! postResults(c+j)=max(postResults(c+j),& - ! plasticState(ph)%state(4*ns+2*nt+2*nr+j, of)) - enddo - c = c + prm%totalNslip - ! case (resolved_stress_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearband families - ! postResults(c+j) = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! enddo - ! c = c + 6_pInt - ! case (shear_rate_shearband_ID) - ! do j = 1_pInt,6_pInt ! loop over all shearbands - ! tau = dot_product(Tstar_v,sbSv(1:6,j,ipc,ip,el)) - ! if (abs(tau) < tol_math_check) then - ! StressRatio_p = 0.0_pReal - ! StressRatio_pminus1 = 0.0_pReal - ! else - ! StressRatio_p = (abs(tau)/prm%sbResistance)**prm%pShearBand - ! StressRatio_pminus1 = (abs(tau)/prm%sbResistance)**(prm%pShearBand-1.0_pReal) - ! endif - ! BoltzmannRatio = prm%sbQedge/(kB*Temperature) - ! DotGamma0 = prm%sbVelocity - ! postResults(c+j) = DotGamma0*exp(-BoltzmannRatio*(1_pInt-StressRatio_p)**prm%qShearBand)*& - ! sign(1.0_pReal,tau) - ! enddo - ! c = c + 6_pInt + case (twin_fraction_ID) postResults(c+1_pInt:c+prm%totalNtwin) = stt%twinFraction(1_pInt:prm%totalNtwin,of) c = c + prm%totalNtwin From 3fb99b06cab566e2b0eedc28369999df5d683d7f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 22:13:45 +0100 Subject: [PATCH 57/61] avoid calculation in output routine --- src/plastic_disloUCLA.f90 | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index eea064158..f987ee75b 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -28,8 +28,7 @@ module plastic_disloUCLA shearrate_ID, & accumulatedshear_ID, & mfp_ID, & - thresholdstress_ID, & - dipoledistance_ID + thresholdstress_ID end enum type, private :: tParameters @@ -312,8 +311,6 @@ subroutine plastic_disloUCLA_init() outputID = merge(mfp_ID,undefined_ID,prm%totalNslip>0_pInt) case ('threshold_stress','threshold_stress_slip') outputID = merge(thresholdstress_ID,undefined_ID,prm%totalNslip>0_pInt) - case ('edge_dipole_distance') - outputID = merge(dipoleDistance_ID,undefined_ID,prm%totalNslip>0_pInt) end select @@ -560,16 +557,6 @@ function plastic_disloUCLA_postResults(Mp,Temperature,instance,of) result(postRe postResults(c+1_pInt:c+prm%totalNslip) = dst%mfp(1_pInt:prm%totalNslip, of) case (thresholdstress_ID) postResults(c+1_pInt:c+prm%totalNslip) = dst%threshold_stress(1_pInt:prm%totalNslip,of) - case (dipoleDistance_ID) ! ToDo: Discuss required changes with Franz - do i = 1_pInt, prm%totalNslip - if (dNeq0(abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i))))) then - postResults(c+i) = (3.0_pReal*prm%mu*prm%burgers(i)) & - / (16.0_pReal*pi*abs(math_mul33xx33(Mp,prm%nonSchmid_pos(1:3,1:3,i)))) - else - postResults(c+i) = huge(1.0_pReal) - endif - postResults(c+i)=min(postResults(c+i),dst%mfp(i,of)) - enddo end select From ef06e7c4fd519d518d9f2b049fbe642108334178 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 27 Jan 2019 23:36:34 +0100 Subject: [PATCH 58/61] cleaning --- src/plastic_dislotwin.f90 | 41 +++++++++++++++++---------------------- 1 file changed, 18 insertions(+), 23 deletions(-) diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 5e1235a94..d9312ae18 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -86,7 +86,7 @@ module plastic_dislotwin Ndot0_trans, & !< trans nucleation rate [1/m³s] for each trans system twinsize, & !< twin thickness [m] for each twin system CLambdaSlip, & !< Adj. parameter for distance between 2 forest dislocations for each slip system - lamellarsizePerTransSystem, & !< martensite lamellar thickness [m] for each trans system and instance + lamellarsize, & !< martensite lamellar thickness [m] for each trans system and instance p, & !< p-exponent in glide velocity q, & !< q-exponent in glide velocity r, & !< r-exponent in twin nucleation rate @@ -132,16 +132,15 @@ module plastic_dislotwin rhoEdgeDip, & accshear_slip, & twinFraction, & - strainTransFraction, & - whole + strainTransFraction end type tDislotwinState type, private :: tDislotwinMicrostructure real(pReal), allocatable, dimension(:,:) :: & invLambdaSlip, & invLambdaSlipTwin, & - invLambdaTwin, & invLambdaSlipTrans, & + invLambdaTwin, & invLambdaTrans, & mfp_slip, & mfp_twin, & @@ -151,8 +150,8 @@ module plastic_dislotwin threshold_stress_trans, & twinVolume, & martensiteVolume, & - tau_r_twin, & !< stress to bring partial close together for each twin system and instance - tau_r_trans !< stress to bring partial close together for each trans system and instance + tau_r_twin, & !< stress to bring partial close together for each twin system and instance + tau_r_trans !< stress to bring partial close together for each trans system and instance end type tDislotwinMicrostructure !-------------------------------------------------------------------------------------------------- @@ -414,12 +413,12 @@ subroutine plastic_dislotwin_init prm%Ndot0_trans = config%getFloats('ndot0_trans') prm%Ndot0_trans = math_expand(prm%Ndot0_trans,prm%Ntrans) endif - prm%lamellarsizePerTransSystem = config%getFloats('lamellarsize') - prm%lamellarsizePerTransSystem = math_expand(prm%lamellarsizePerTransSystem,prm%Ntrans) + prm%lamellarsize = config%getFloats('lamellarsize') + prm%lamellarsize = math_expand(prm%lamellarsize,prm%Ntrans) prm%s = config%getFloats('s_trans',defaultVal=[0.0_pReal]) prm%s = math_expand(prm%s,prm%Ntrans) else - allocate(prm%lamellarsizePerTransSystem(0)) + allocate(prm%lamellarsize(0)) allocate(prm%burgers_trans(0)) endif @@ -610,8 +609,6 @@ subroutine plastic_dislotwin_init dot%strainTransFraction=>plasticState(p)%dotState(startIndex:endIndex,:) plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTransFrac - dot%whole => plasticState(p)%dotState !ToDo: needed? - allocate(dst%invLambdaSlip (prm%totalNslip, NipcMyPhase),source=0.0_pReal) allocate(dst%invLambdaSlipTwin (prm%totalNslip, NipcMyPhase),source=0.0_pReal) allocate(dst%invLambdaSlipTrans (prm%totalNslip, NipcMyPhase),source=0.0_pReal) @@ -621,15 +618,16 @@ subroutine plastic_dislotwin_init allocate(dst%invLambdaTwin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%mfp_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%threshold_stress_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_twin (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (twin) allocate(dst%twinVolume (prm%totalNtwin, NipcMyPhase),source=0.0_pReal) allocate(dst%invLambdaTrans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(dst%mfp_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) allocate(dst%threshold_stress_trans(prm%totalNtrans,NipcMyPhase),source=0.0_pReal) - allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + allocate(dst%tau_r_trans (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) !* equilibrium separation of partial dislocations (trans) allocate(dst%martensiteVolume (prm%totalNtrans,NipcMyPhase),source=0.0_pReal) + plasticState(p)%state0 = plasticState(p)%state ! ToDo: this could be done centrally end associate @@ -846,8 +844,6 @@ subroutine plastic_dislotwin_dotState(Mp,Temperature,instance,of) associate(prm => param(instance), stt => state(instance), & dot => dotstate(instance), dst => microstructure(instance)) - dot%whole(:,of) = 0.0_pReal - f_unrotated = 1.0_pReal & - sum(stt%twinFraction(1_pInt:prm%totalNtwin,of)) & - sum(stt%strainTransFraction(1_pInt:prm%totalNtrans,of)) @@ -948,7 +944,7 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) !* rescaled volume fraction for topology fOverStacksize = stt%twinFraction(1_pInt:prm%totalNtwin,of)/prm%twinsize !ToDo: this is per system - ftransOverLamellarSize = sumf_trans/prm%lamellarsizePerTransSystem !ToDo: But this not ... + ftransOverLamellarSize = sumf_trans/prm%lamellarsize !ToDo: But this not ... !Todo: Physically ok, but naming could be adjusted @@ -1010,16 +1006,15 @@ subroutine plastic_dislotwin_dependentState(temperature,instance,of) (sfe/(3.0_pReal*prm%burgers_trans) + 3.0_pReal*prm%burgers_trans*prm%mu/& (prm%L0_trans*prm%burgers_slip) + prm%transStackHeight*prm%deltaG/ (3.0_pReal*prm%burgers_trans) ) - ! final volume after growth - dst%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*dst%mfp_twin(:,of)**2.0_pReal - dst%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsizePerTransSystem*dst%mfp_trans(:,of)**2.0_pReal - !* equilibrium separation of partial dislocations (twin) - x0 = prm%mu*prm%burgers_twin**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + dst%twinVolume(:,of) = (PI/4.0_pReal)*prm%twinsize*dst%mfp_twin(:,of)**2.0_pReal + dst%martensiteVolume(:,of) = (PI/4.0_pReal)*prm%lamellarsize*dst%mfp_trans(:,of)**2.0_pReal + + + x0 = prm%mu*prm%burgers_twin**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) dst%tau_r_twin(:,of) = prm%mu*prm%burgers_twin/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_twin)+cos(pi/3.0_pReal)/x0) - !* equilibrium separation of partial dislocations (trans) - x0 = prm%mu*prm%burgers_trans**2.0_pReal/(sfe*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) + x0 = prm%mu*prm%burgers_trans**2.0_pReal/(SFE*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu) dst%tau_r_trans(:,of) = prm%mu*prm%burgers_trans/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%xc_trans)+cos(pi/3.0_pReal)/x0) end associate From 2c2d04d0fa54052a1566b062c5efb9dcb1e509ff Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 28 Jan 2019 00:33:51 +0100 Subject: [PATCH 59/61] [skip ci] updated version information after successful test of v2.0.2-1521-g7ce47930 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index a51af2ff4..4296d10f3 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1519-g453323d1 +v2.0.2-1521-g7ce47930 From 26fbf5084d7df8c6fba1d22682d387cecd81b655 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 07:52:01 +0100 Subject: [PATCH 60/61] [skip ci] avoid space in file names --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 0c34bbee9..beb9682ff 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 0c34bbee91b3d293382063126afe0abd22b44986 +Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b From 19958b35c1845f1706a0dd44009a965099231eba Mon Sep 17 00:00:00 2001 From: Test User Date: Mon, 28 Jan 2019 10:22:39 +0100 Subject: [PATCH 61/61] [skip ci] updated version information after successful test of v2.0.2-1540-ge2582a8d --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 4296d10f3..3801ac74e 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1521-g7ce47930 +v2.0.2-1540-ge2582a8d