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

fixing inconsistencies in variable assignments

This commit is contained in:
Martin Diehl 2012-02-10 11:56:05 +00:00
parent cff66b5cc3
commit 37ac7bf1b4
7 changed files with 401 additions and 407 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
code/constitutive_dislotwin.f90
View File

@ -186,8 +186,8 @@ constitutive_dislotwin_Nslip = 0_pInt
constitutive_dislotwin_Ntwin = 0_pInt constitutive_dislotwin_Ntwin = 0_pInt
constitutive_dislotwin_slipFamily = 0_pInt constitutive_dislotwin_slipFamily = 0_pInt
constitutive_dislotwin_twinFamily = 0_pInt constitutive_dislotwin_twinFamily = 0_pInt
constitutive_dislotwin_slipSystemLattice = 0.0_pReal constitutive_dislotwin_slipSystemLattice = 0_pInt
constitutive_dislotwin_twinSystemLattice = 0.0_pReal constitutive_dislotwin_twinSystemLattice = 0_pInt
constitutive_dislotwin_totalNslip = 0_pInt constitutive_dislotwin_totalNslip = 0_pInt
constitutive_dislotwin_totalNtwin = 0_pInt constitutive_dislotwin_totalNtwin = 0_pInt
allocate(constitutive_dislotwin_CoverA(maxNinstance)) allocate(constitutive_dislotwin_CoverA(maxNinstance))
@ -959,23 +959,23 @@ real(pReal), dimension(3,3) :: eigVectors, sb_Smatrix
real(pReal), dimension(3) :: eigValues, sb_s, sb_m real(pReal), dimension(3) :: eigValues, sb_s, sb_m
real(pReal), dimension(3,6), parameter :: & real(pReal), dimension(3,6), parameter :: &
sb_sComposition = & sb_sComposition = &
reshape((/& reshape(real([&
1, 0, 1, & 1, 0, 1, &
1, 0,-1, & 1, 0,-1, &
1, 1, 0, & 1, 1, 0, &
1,-1, 0, & 1,-1, 0, &
0, 1, 1, & 0, 1, 1, &
0, 1,-1 & 0, 1,-1 &
/),(/3,6/)), & ],pReal),[ 3,6]), &
sb_mComposition = & sb_mComposition = &
reshape((/& reshape(real([&
1, 0,-1, & 1, 0,-1, &
1, 0,+1, & 1, 0,+1, &
1,-1, 0, & 1,-1, 0, &
1, 1, 0, & 1, 1, 0, &
0, 1,-1, & 0, 1,-1, &
0, 1, 1 & 0, 1, 1 &
/),(/3,6/)) ],pReal),[ 3,6])
logical error logical error
!* Shortened notation !* Shortened notation

6
code/constitutive_titanmod.f90
View File

@ -58,7 +58,7 @@ character(len=18), dimension(3), parameter:: constitutive_titanmod_listBasicSlip
character(len=18), dimension(1), parameter:: constitutive_titanmod_listBasicTwinStates = (/'gdot_twin'/) character(len=18), dimension(1), parameter:: constitutive_titanmod_listBasicTwinStates = (/'gdot_twin'/)
character(len=18), dimension(11), parameter:: constitutive_titanmod_listDependentSlipStates =(/'segment_edge ', & character(len=19), dimension(11), parameter:: constitutive_titanmod_listDependentSlipStates =(/'segment_edge ', &
'segment_screw ', & 'segment_screw ', &
'resistance_edge ', & 'resistance_edge ', &
'resistance_screw ', & 'resistance_screw ', &
@ -254,8 +254,8 @@ constitutive_titanmod_Nslip = 0_pInt
constitutive_titanmod_Ntwin = 0_pInt constitutive_titanmod_Ntwin = 0_pInt
constitutive_titanmod_slipFamily = 0_pInt constitutive_titanmod_slipFamily = 0_pInt
constitutive_titanmod_twinFamily = 0_pInt constitutive_titanmod_twinFamily = 0_pInt
constitutive_titanmod_slipSystemLattice = 0.0_pReal constitutive_titanmod_slipSystemLattice = 0_pInt
constitutive_titanmod_twinSystemLattice = 0.0_pReal constitutive_titanmod_twinSystemLattice = 0_pInt
constitutive_titanmod_totalNslip = 0_pInt constitutive_titanmod_totalNslip = 0_pInt
constitutive_titanmod_totalNtwin = 0_pInt constitutive_titanmod_totalNtwin = 0_pInt
allocate(constitutive_titanmod_CoverA(maxNinstance)) allocate(constitutive_titanmod_CoverA(maxNinstance))

4
code/homogenization_RGC.f90
View File

@ -941,8 +941,8 @@ subroutine homogenization_RGC_stressPenalty(&
integer(pInt) homID,iGrain,iGNghb,iFace,i,j,k,l integer(pInt) homID,iGrain,iGNghb,iFace,i,j,k,l
real(pReal) muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb real(pReal) muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb
! !
integer(pInt), parameter :: nFace = 6 integer(pInt), parameter :: nFace = 6_pInt
real(pReal), parameter :: nDefToler = 1.0e-10 real(pReal), parameter :: nDefToler = 1.0e-10_pReal
nGDim = homogenization_RGC_Ngrains(:,homID) nGDim = homogenization_RGC_Ngrains(:,homID)

4
code/homogenization_isostrain.f90
View File

@ -61,7 +61,7 @@ CONTAINS
subroutine homogenization_isostrain_init(& subroutine homogenization_isostrain_init(&
file & ! file pointer to material configuration file & ! file pointer to material configuration
) )
use, intrinsic :: iso_fortran_env
use prec, only: pInt, pReal use prec, only: pInt, pReal
use math, only: math_Mandel3333to66, math_Voigt66to3333 use math, only: math_Mandel3333to66, math_Voigt66to3333
use IO use IO
@ -328,7 +328,7 @@ pure function homogenization_isostrain_postResults(&
do o = 1,homogenization_Noutput(mesh_element(3,el)) do o = 1,homogenization_Noutput(mesh_element(3,el))
select case(homogenization_isostrain_output(o,homID)) select case(homogenization_isostrain_output(o,homID))
case ('ngrains') case ('ngrains')
homogenization_isostrain_postResults(c+1) = homogenization_isostrain_Ngrains(homID) homogenization_isostrain_postResults(c+1) = real(homogenization_isostrain_Ngrains(homID),pReal)
c = c + 1 c = c + 1
end select end select
enddo enddo

163
code/lattice.f90
View File

@ -88,7 +88,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
integer(pInt) :: lattice_fcc_Nstructure = 0_pInt integer(pInt) :: lattice_fcc_Nstructure = 0_pInt
real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter :: lattice_fcc_systemSlip = & real(pReal), dimension(3+3,lattice_fcc_Nslip), parameter :: lattice_fcc_systemSlip = &
reshape((/& reshape(real([&
! Slip system <110>{111} Sorted according to Eisenlohr & Hantcherli ! Slip system <110>{111} Sorted according to Eisenlohr & Hantcherli
0, 1,-1, 1, 1, 1, & 0, 1,-1, 1, 1, 1, &
-1, 0, 1, 1, 1, 1, & -1, 0, 1, 1, 1, 1, &
@ -102,10 +102,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
0, 1, 1, -1, 1,-1, & 0, 1, 1, -1, 1,-1, &
1, 0,-1, -1, 1,-1, & 1, 0,-1, -1, 1,-1, &
-1,-1, 0, -1, 1,-1 & -1,-1, 0, -1, 1,-1 &
/),(/3+3,lattice_fcc_Nslip/)) ],pReal),[ 3_pInt + 3_pInt,lattice_fcc_Nslip])
real(pReal), dimension(3+3,lattice_fcc_Ntwin), parameter :: lattice_fcc_systemTwin = & real(pReal), dimension(3+3,lattice_fcc_Ntwin), parameter :: lattice_fcc_systemTwin = &
reshape((/& reshape(real( [&
! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli
-2, 1, 1, 1, 1, 1, & -2, 1, 1, 1, 1, 1, &
1,-2, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, &
@ -119,27 +119,27 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
2, 1,-1, -1, 1,-1, & 2, 1,-1, -1, 1,-1, &
-1,-2,-1, -1, 1,-1, & -1,-2,-1, -1, 1,-1, &
-1, 1, 2, -1, 1,-1 & -1, 1, 2, -1, 1,-1 &
/),(/3+3,lattice_fcc_Ntwin/)) ],pReal),[ 3_pInt + 3_pInt ,lattice_fcc_Ntwin])
real(pReal), dimension(lattice_fcc_Ntwin), parameter :: lattice_fcc_shearTwin = & real(pReal), dimension(lattice_fcc_Ntwin), parameter :: lattice_fcc_shearTwin = &
reshape((/& reshape([&
! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812, & 0.7071067812_pReal, &
0.7071067812 & 0.7071067812_pReal &
/),(/lattice_fcc_Ntwin/)) ],[lattice_fcc_Ntwin])
integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipSlip = & integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipSlip = &
reshape((/& reshape(int( [&
! Interaction types ! Interaction types
! 1 --- self interaction ! 1 --- self interaction
! 2 --- coplanar interaction ! 2 --- coplanar interaction
@ -159,10 +159,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
4,5,6,3,5,5,4,6,5,1,2,2, & 4,5,6,3,5,5,4,6,5,1,2,2, &
5,3,5,5,4,6,6,4,5,2,1,2, & 5,3,5,5,4,6,6,4,5,2,1,2, &
6,5,4,5,6,4,5,5,3,2,2,1 & 6,5,4,5,6,4,5,5,3,2,2,1 &
/),(/lattice_fcc_Nslip,lattice_fcc_Nslip/)) ],pInt),[lattice_fcc_Nslip,lattice_fcc_Nslip])
integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipTwin = & integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Nslip) :: lattice_fcc_interactionSlipTwin = &
reshape((/& reshape(int( [&
1,1,1,2,2,1,1,2,2,2,1,2, & 1,1,1,2,2,1,1,2,2,2,1,2, &
1,1,1,2,2,1,1,2,2,2,1,2, & 1,1,1,2,2,1,1,2,2,2,1,2, &
1,1,1,2,2,1,1,2,2,2,1,2, & 1,1,1,2,2,1,1,2,2,2,1,2, &
@ -175,12 +175,12 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
2,1,2,1,2,2,2,2,1,1,1,1, & 2,1,2,1,2,2,2,2,1,1,1,1, &
2,1,2,1,2,2,2,2,1,1,1,1, & 2,1,2,1,2,2,2,2,1,1,1,1, &
2,1,2,1,2,2,2,2,1,1,1,1 & 2,1,2,1,2,2,2,2,1,1,1,1 &
/),(/lattice_fcc_Ntwin,lattice_fcc_Nslip/)) ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Nslip])
integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinSlip = 0 integer(pInt), target, dimension(lattice_fcc_Nslip,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinSlip = 0_pInt
integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinTwin = & integer(pInt), target, dimension(lattice_fcc_Ntwin,lattice_fcc_Ntwin) :: lattice_fcc_interactionTwinTwin = &
reshape((/& reshape(int( [&
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, & 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, &
@ -193,19 +193,19 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
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,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 &
/),(/lattice_fcc_Ntwin,lattice_fcc_Ntwin/)) ],pInt),[lattice_fcc_Ntwin,lattice_fcc_Ntwin])
!============================== bcc (2) ================================= !============================== bcc (2) =================================
integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_bcc_NslipSystem = (/12,12,24, 0, 0/) integer(pInt), parameter, dimension(lattice_maxNslipFamily) :: lattice_bcc_NslipSystem = int([ 12,12,24, 0, 0], pInt)
integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_bcc_NtwinSystem = (/12, 0, 0, 0/) integer(pInt), parameter, dimension(lattice_maxNtwinFamily) :: lattice_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt)
integer(pInt), parameter :: lattice_bcc_Nslip = 48 ! sum(lattice_bcc_NslipSystem) integer(pInt), parameter :: lattice_bcc_Nslip = 48_pInt ! sum(lattice_bcc_NslipSystem)
integer(pInt), parameter :: lattice_bcc_Ntwin = 12 ! sum(lattice_bcc_NtwinSystem) integer(pInt), parameter :: lattice_bcc_Ntwin = 12_pInt ! sum(lattice_bcc_NtwinSystem)
integer(pInt) :: lattice_bcc_Nstructure = 0_pInt integer(pInt) :: lattice_bcc_Nstructure = 0_pInt
real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter :: lattice_bcc_systemSlip = & real(pReal), dimension(3+3,lattice_bcc_Nslip), parameter :: lattice_bcc_systemSlip = &
reshape((/& reshape(real([&
! Slip system <111>{110} meaningful sorting? ! Slip system <111>{110} meaningful sorting?
1,-1, 1, 0, 1, 1, & 1,-1, 1, 0, 1, 1, &
-1,-1, 1, 0, 1, 1, & -1,-1, 1, 0, 1, 1, &
@ -257,12 +257,12 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
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, 1, 3, 2,-1 & 1,-1, 1, 3, 2,-1 &
/),(/3+3,lattice_bcc_Nslip/)) ],pReal),[ 3_pInt + 3_pInt ,lattice_bcc_Nslip])
! twin system <111>{112} ! twin system <111>{112}
! MISSING: not implemented yet -- now dummy copy from fcc !! ! MISSING: not implemented yet -- now dummy copy from fcc !!
real(pReal), dimension(3+3,lattice_bcc_Ntwin), parameter :: lattice_bcc_systemTwin = & real(pReal), dimension(3+3,lattice_bcc_Ntwin), parameter :: lattice_bcc_systemTwin = &
reshape((/& reshape(real([&
! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli ! Twin system <112>{111} Sorted according to Eisenlohr & Hantcherli
-2, 1, 1, 1, 1, 1, & -2, 1, 1, 1, 1, 1, &
1,-2, 1, 1, 1, 1, & 1,-2, 1, 1, 1, 1, &
@ -276,28 +276,28 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
2, 1,-1, -1, 1,-1, & 2, 1,-1, -1, 1,-1, &
-1,-2,-1, -1, 1,-1, & -1,-2,-1, -1, 1,-1, &
-1, 1, 2, -1, 1,-1 & -1, 1, 2, -1, 1,-1 &
/),(/3+3,lattice_bcc_Ntwin/)) ],pReal),[ 3_pInt + 3_pInt,lattice_bcc_Ntwin])
real(pReal), dimension(lattice_bcc_Ntwin), parameter :: lattice_bcc_shearTwin = & real(pReal), dimension(lattice_bcc_Ntwin), parameter :: lattice_bcc_shearTwin = &
reshape((/& reshape([&
! Twin system {111}<112> just a dummy ! Twin system {111}<112> just a dummy
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123, & 0.123_pReal, &
0.123 & 0.123_pReal &
/),(/lattice_bcc_Ntwin/)) ],[lattice_bcc_Ntwin])
!*** slip--slip interactions for BCC structures (2) *** !*** slip--slip interactions for BCC structures (2) ***
integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipSlip = & integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipSlip = &
reshape((/& reshape(int( [&
1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & 1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & 2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, & 2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, &
@ -346,12 +346,12 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, & 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, & 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2, &
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 & 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1 &
/),(/lattice_bcc_Nslip,lattice_bcc_Nslip/)) ],pInt),[lattice_bcc_Nslip,lattice_bcc_Nslip])
!*** slip--twin interactions for BCC structures (2) *** !*** slip--twin interactions for BCC structures (2) ***
! MISSING: not implemented yet ! MISSING: not implemented yet
integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipTwin = & integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Nslip) :: lattice_bcc_interactionSlipTwin = &
reshape((/& reshape(int( [&
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
@ -400,13 +400,13 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0 & 0,0,0,0,0,0,0,0,0,0,0,0 &
/),(/lattice_bcc_Ntwin,lattice_bcc_Nslip/)) ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Nslip])
!*** twin--slip interactions for BCC structures (2) *** !*** twin--slip interactions for BCC structures (2) ***
! MISSING: not implemented yet ! MISSING: not implemented yet
integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinSlip = & integer(pInt), target, dimension(lattice_bcc_Nslip,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinSlip = &
reshape((/& reshape(int( [&
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
@ -419,12 +419,12 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 &
/),(/lattice_bcc_Nslip,lattice_bcc_Ntwin/)) ],pInt),[lattice_bcc_Nslip,lattice_bcc_Ntwin])
!*** twin-twin interactions for BCC structures (2) *** !*** twin-twin interactions for BCC structures (2) ***
! MISSING: not implemented yet ! MISSING: not implemented yet
integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinTwin = & integer(pInt), target, dimension(lattice_bcc_Ntwin,lattice_bcc_Ntwin) :: lattice_bcc_interactionTwinTwin = &
reshape((/& reshape(int( [&
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
@ -437,7 +437,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0, & 0,0,0,0,0,0,0,0,0,0,0,0, &
0,0,0,0,0,0,0,0,0,0,0,0 & 0,0,0,0,0,0,0,0,0,0,0,0 &
/),(/lattice_bcc_Ntwin,lattice_bcc_Ntwin/)) ],pInt),[lattice_bcc_Ntwin,lattice_bcc_Ntwin])
!============================== hex (3+) ================================= !============================== hex (3+) =================================
@ -450,7 +450,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
!* sorted by A. Alankar & P. Eisenlohr !* sorted by A. Alankar & P. Eisenlohr
real(pReal), dimension(4+4,lattice_hex_Nslip), parameter :: lattice_hex_systemSlip = & real(pReal), dimension(4+4,lattice_hex_Nslip), parameter :: lattice_hex_systemSlip = &
reshape((/& reshape(real([&
! Basal systems <1120>{0001} (independent of c/a-ratio, Bravais notation (4 coordinate base)) ! Basal systems <1120>{0001} (independent of c/a-ratio, Bravais notation (4 coordinate base))
2, -1, -1, 0, 0, 0, 0, 1, & 2, -1, -1, 0, 0, 0, 0, 1, &
-1, 2, -1, 0, 0, 0, 0, 1, & -1, 2, -1, 0, 0, 0, 0, 1, &
@ -486,10 +486,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
-2, 1, 1, -3, -2, 1, 1, 2, & -2, 1, 1, -3, -2, 1, 1, 2, &
-1, -1, 2, -3, -1, -1, 2, 2, & -1, -1, 2, -3, -1, -1, 2, 2, &
1, -2, 1, -3, 1, -2, 1, 2 & 1, -2, 1, -3, 1, -2, 1, 2 &
/),(/4+4,lattice_hex_Nslip/)) ],pReal),[ 4_pInt + 4_pInt,lattice_hex_Nslip])
real(pReal), dimension(4+4,lattice_hex_Ntwin), parameter :: lattice_hex_systemTwin = & real(pReal), dimension(4+4,lattice_hex_Ntwin), parameter :: lattice_hex_systemTwin = &
reshape((/& reshape(real([&
0, 1, -1, 1, 0, -1, 1, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a) 0, 1, -1, 1, 0, -1, 1, 2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a)
-1, 1, 0, 1, 1, -1, 0, 2, & -1, 1, 0, 1, 1, -1, 0, 2, &
-1, 0, 1, 1, 1, 0, -1, 2, & !! -1, 0, 1, 1, 1, 0, -1, 2, & !!
@ -514,10 +514,10 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
0, -1, 1, -2, 0, -1, 1, 1, & 0, -1, 1, -2, 0, -1, 1, 1, &
1, -1, 0, -2, 1, -1, 0, 1, & 1, -1, 0, -2, 1, -1, 0, 1, &
-1, 1, 0, -2, -1, 1, 0, 1 & -1, 1, 0, -2, -1, 1, 0, 1 &
/),(/4+4,lattice_hex_Ntwin/)) !* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 & ],pReal),[ 4_pInt + 4_pInt ,lattice_hex_Ntwin]) !* Sort? Numbering of twin system follows Prof. Tom Bieler's scheme (to be consistent with his work); but numbering in data was restarted from 1 &
integer(pInt), dimension(lattice_hex_Ntwin), parameter :: lattice_hex_shearTwin = & ! indicator to formula further below integer(pInt), dimension(lattice_hex_Ntwin), parameter :: lattice_hex_shearTwin = & ! indicator to formula further below
reshape((/& reshape(int( [&
1, & ! {10.2}<-10.1> 1, & ! {10.2}<-10.1>
1, & 1, &
1, & 1, &
@ -542,7 +542,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
4, & 4, &
4, & 4, &
4 & 4 &
/),(/lattice_hex_Ntwin/)) ],pInt),[lattice_hex_Ntwin])
!* four different interaction type matrix !* four different interaction type matrix
!* 1. slip-slip interaction - 30 types !* 1. slip-slip interaction - 30 types
@ -551,7 +551,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
!* 4. twin-slip interaction - 16 types !* 4. twin-slip interaction - 16 types
integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Nslip) :: lattice_hex_interactionSlipSlip = & integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Nslip) :: lattice_hex_interactionSlipSlip = &
reshape((/& reshape(int( [&
1, 6, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & 1, 6, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, &
6, 1, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & 6, 1, 6, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, &
6, 6, 1, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, & 6, 6, 1, 11,11,11, 15,15,15,15,15,15, 18,18,18,18,18,18,18,18,18,18,18,18, 20,20,20,20,20,20, &
@ -586,11 +586,11 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10, 5,10,10, & 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10, 5,10,10, &
30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10, 5,10, & 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10, 5,10, &
30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10,10, 5 & 30,30,30, 29,29,29, 27,27,27,27,27,27, 24,24,24,24,24,24,24,24,24,24,24,24, 10,10,10,10,10, 5 &
/),(/lattice_hex_Nslip,lattice_hex_Nslip/)) ],pInt),[lattice_hex_Nslip,lattice_hex_Nslip])
!* isotropic interaction at the moment !* isotropic interaction at the moment
integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Nslip) :: lattice_hex_interactionSlipTwin = & integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Nslip) :: lattice_hex_interactionSlipTwin = &
reshape((/& 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, & ! --> 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, & ! |
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, & ! |
@ -625,11 +625,11 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
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 &
/),(/lattice_hex_Ntwin,lattice_hex_Nslip/)) ],pInt),[lattice_hex_Ntwin,lattice_hex_Nslip])
!* isotropic interaction at the moment !* isotropic interaction at the moment
integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Ntwin) :: lattice_hex_interactionTwinSlip = & integer(pInt), target, dimension(lattice_hex_Nslip,lattice_hex_Ntwin) :: lattice_hex_interactionTwinSlip = &
reshape((/& reshape(int( [&
1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! --> slip 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! --> slip
1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! |
1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! | 1, 1, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 13,13,13,13,13,13,13,13,13,13,13,13, 17,17,17,17,17,17, & ! |
@ -657,11 +657,11 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, &
4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, & 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20, &
4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20 & 4, 4, 4, 8, 8, 8, 12,12,12,12,12,12, 16,16,16,16,16,16,16,16,16,16,16,16, 20,20,20,20,20,20 &
/),(/lattice_hex_Nslip,lattice_hex_Ntwin/)) ],pInt),[lattice_hex_Nslip,lattice_hex_Ntwin])
integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Ntwin) :: lattice_hex_interactionTwinTwin = & integer(pInt), target, dimension(lattice_hex_Ntwin,lattice_hex_Ntwin) :: lattice_hex_interactionTwinTwin = &
reshape((/& reshape(int( [&
1, 5, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & 1, 5, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, &
5, 1, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & 5, 1, 5, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, &
5, 5, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, & 5, 5, 1, 5, 5, 5, 9, 9, 9, 9, 9, 9, 12,12,12,12,12,12, 14,14,14,14,14,14, &
@ -689,7 +689,7 @@ integer(pInt), allocatable, dimension(:,:,:) :: lattice_interactionSlipSlip, &
20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 4, 8, 8, & 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 4, 8, 8, &
20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 4, 8, & 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 4, 8, &
20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 8, 4 & 20,20,20,20,20,20, 19,19,19,19,19,19, 17,17,17,17,17,17, 8, 8, 8, 8, 8, 4 &
/),(/lattice_hex_Ntwin,lattice_hex_Ntwin/)) ],pInt),[lattice_hex_Ntwin,lattice_hex_Ntwin])
CONTAINS CONTAINS
@ -710,9 +710,9 @@ pure function lattice_symmetryType(structID)
integer(pInt) lattice_symmetryType integer(pInt) lattice_symmetryType
select case(structID) select case(structID)
case (1,2) case (1_pInt,2_pInt)
lattice_symmetryType = 1_pInt lattice_symmetryType = 1_pInt
case (3:) case (3_pInt:)
lattice_symmetryType = 2_pInt lattice_symmetryType = 2_pInt
case default case default
lattice_symmetryType = 0_pInt lattice_symmetryType = 0_pInt
@ -727,6 +727,7 @@ subroutine lattice_init()
!************************************** !**************************************
!* Module initialization * !* Module initialization *
!************************************** !**************************************
use, intrinsic :: iso_fortran_env
use IO, only: IO_open_file,IO_open_jobFile,IO_countSections,IO_countTagInPart,IO_error use IO, only: IO_open_file,IO_open_jobFile,IO_countSections,IO_countTagInPart,IO_error
use material, only: material_configfile,material_localFileExt,material_partPhase use material, only: material_configfile,material_localFileExt,material_partPhase
use debug, only: debug_verbosity use debug, only: debug_verbosity
@ -742,15 +743,15 @@ subroutine lattice_init()
#include "compilation_info.f90" #include "compilation_info.f90"
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present... if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present...
if (.not. IO_open_file(fileunit,material_configFile)) call IO_error(100) ! ...and cannot open material.config file if (.not. IO_open_file(fileunit,material_configFile)) call IO_error(100_pInt) ! ...and cannot open material.config file
endif endif
Nsections = IO_countSections(fileunit,material_partPhase) Nsections = IO_countSections(fileunit,material_partPhase)
lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(fileunit,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex lattice_Nstructure = 2_pInt + sum(IO_countTagInPart(fileunit,material_partPhase,'covera_ratio',Nsections)) ! fcc + bcc + all hex
! lattice_Nstructure = Nsections + 2_pInt ! most conservative assumption ! lattice_Nstructure = Nsections + 2_pInt ! most conservative assumption
close(fileunit) close(fileunit)
if (debug_verbosity > 0) then if (debug_verbosity > 0_pInt) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,'(a16,1x,i5)') '# phases:',Nsections write(6,'(a16,1x,i5)') '# phases:',Nsections
write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure write(6,'(a16,1x,i5)') '# structures:',lattice_Nstructure
@ -773,8 +774,8 @@ subroutine lattice_init()
allocate(lattice_shearTwin(lattice_maxNtwin,lattice_Nstructure)); lattice_shearTwin = 0.0_pReal allocate(lattice_shearTwin(lattice_maxNtwin,lattice_Nstructure)); lattice_shearTwin = 0.0_pReal
allocate(lattice_NslipSystem(lattice_maxNslipFamily,lattice_Nstructure)); lattice_NslipSystem = 0.0_pReal allocate(lattice_NslipSystem(lattice_maxNslipFamily,lattice_Nstructure)); lattice_NslipSystem = 0_pInt
allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,lattice_Nstructure)); lattice_NtwinSystem = 0.0_pReal allocate(lattice_NtwinSystem(lattice_maxNtwinFamily,lattice_Nstructure)); lattice_NtwinSystem = 0_pInt
allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipSlip = 0_pInt ! other:me allocate(lattice_interactionSlipSlip(lattice_maxNslip,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipSlip = 0_pInt ! other:me
allocate(lattice_interactionSlipTwin(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipTwin = 0_pInt ! other:me allocate(lattice_interactionSlipTwin(lattice_maxNtwin,lattice_maxNslip,lattice_Nstructure)); lattice_interactionSlipTwin = 0_pInt ! other:me
@ -901,13 +902,13 @@ function lattice_initializeStructure(struct,CoverA)
tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i)) tt(1:3,i) = math_vectorproduct(td(1:3,i),tn(1:3,i))
select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29 select case(lattice_hex_shearTwin(i)) ! from Christian & Mahajan 1995 p.29
case (1) ! {10.2}<-10.1> case (1_pInt) ! {10.2}<-10.1>
ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA ts(i) = (3.0_pReal-CoverA*CoverA)/sqrt(3.0_pReal)/CoverA
case (2) ! {11.2}<11.-3> case (2_pInt) ! {11.2}<11.-3>
ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA ts(i) = 2.0_pReal*(CoverA*CoverA-2.0_pReal)/3.0_pReal/CoverA
case (3) ! {11.1}<-1-1.6> case (3_pInt) ! {11.1}<-1-1.6>
ts(i) = 1.0_pReal/CoverA ts(i) = 1.0_pReal/CoverA
case (4) ! {10.1}<10.-2> case (4_pInt) ! {10.1}<10.-2>
ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA ts(i) = (4.0_pReal*CoverA*CoverA-9.0_pReal)/4.0_pReal/sqrt(3.0_pReal)/CoverA
end select end select
@ -921,7 +922,7 @@ function lattice_initializeStructure(struct,CoverA)
if (processMe) then if (processMe) then
if (myStructure > lattice_Nstructure) & if (myStructure > lattice_Nstructure) &
call IO_error(666,0,0,0,'structure index too large') ! check for memory leakage call IO_error(666_pint,0_pInt,0_pInt,0_pInt,'structure index too large') ! check for memory leakage
do i = 1,myNslip ! store slip system vectors and Schmid matrix for my structure do i = 1,myNslip ! store slip system vectors and Schmid matrix for my structure
lattice_sd(1:3,i,myStructure) = sd(1:3,i) lattice_sd(1:3,i,myStructure) = sd(1:3,i)
lattice_st(1:3,i,myStructure) = st(1:3,i) lattice_st(1:3,i,myStructure) = st(1:3,i)

118
code/material.f90
View File

@ -31,13 +31,13 @@ MODULE material
use prec, only: pReal,pInt use prec, only: pReal,pInt
implicit none implicit none
character(len=64), parameter :: material_configFile = 'material.config' character(len=64), parameter, public :: material_configFile = 'material.config'
character(len=64), parameter :: material_localFileExt = 'materialConfig' character(len=64), parameter, public :: material_localFileExt = 'materialConfig'
character(len=32), parameter :: material_partHomogenization = 'homogenization' character(len=32), parameter, public :: material_partHomogenization = 'homogenization'
character(len=32), parameter :: material_partMicrostructure = 'microstructure' character(len=32), parameter, private :: material_partMicrostructure = 'microstructure'
character(len=32), parameter :: material_partCrystallite = 'crystallite' character(len=32), parameter, public :: material_partCrystallite = 'crystallite'
character(len=32), parameter :: material_partPhase = 'phase' character(len=32), parameter, public :: material_partPhase = 'phase'
character(len=32), parameter :: material_partTexture = 'texture' character(len=32), parameter, private :: material_partTexture = 'texture'
!************************************* !*************************************
@ -106,6 +106,8 @@ subroutine material_init()
!********************************************************************* !*********************************************************************
!* Module initialization * !* Module initialization *
!************************************** !**************************************
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use prec, only: pReal,pInt use prec, only: pReal,pInt
use IO, only: IO_error, IO_open_file, IO_open_jobFile use IO, only: IO_error, IO_open_file, IO_open_jobFile
use debug, only: debug_verbosity use debug, only: debug_verbosity
@ -123,7 +125,7 @@ subroutine material_init()
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present... if (.not. IO_open_jobFile(fileunit,material_localFileExt)) then ! no local material configuration present...
if (.not. IO_open_file(fileunit,material_configFile)) call IO_error(100) ! ...and cannot open material.config file if (.not. IO_open_file(fileunit,material_configFile)) call IO_error(100_pInt) ! ...and cannot open material.config file
endif endif
call material_parseHomogenization(fileunit,material_partHomogenization) call material_parseHomogenization(fileunit,material_partHomogenization)
if (debug_verbosity > 0) then if (debug_verbosity > 0) then
@ -159,18 +161,18 @@ subroutine material_init()
do i = 1,material_Nmicrostructure do i = 1,material_Nmicrostructure
if (microstructure_crystallite(i) < 1 .or. & if (microstructure_crystallite(i) < 1 .or. &
microstructure_crystallite(i) > material_Ncrystallite) call IO_error(150,i) microstructure_crystallite(i) > material_Ncrystallite) call IO_error(150_pInt,i)
if (minval(microstructure_phase(1:microstructure_Nconstituents(i),i)) < 1 .or. & if (minval(microstructure_phase(1:microstructure_Nconstituents(i),i)) < 1 .or. &
maxval(microstructure_phase(1:microstructure_Nconstituents(i),i)) > material_Nphase) call IO_error(155,i) maxval(microstructure_phase(1:microstructure_Nconstituents(i),i)) > material_Nphase) call IO_error(155_pInt,i)
if (minval(microstructure_texture(1:microstructure_Nconstituents(i),i)) < 1 .or. & if (minval(microstructure_texture(1:microstructure_Nconstituents(i),i)) < 1 .or. &
maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(160,i) maxval(microstructure_texture(1:microstructure_Nconstituents(i),i)) > material_Ntexture) call IO_error(160_pInt,i)
if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then if (abs(sum(microstructure_fraction(:,i)) - 1.0_pReal) >= 1.0e-10_pReal) then
if (debug_verbosity > 0) then if (debug_verbosity > 0) then
!$OMP CRITICAL (write2out) !$OMP CRITICAL (write2out)
write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i)) write(6,*)'sum of microstructure fraction = ',sum(microstructure_fraction(:,i))
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif endif
call IO_error(170,i) call IO_error(170_pInt,i)
endif endif
enddo enddo
if (debug_verbosity > 0) then if (debug_verbosity > 0) then
@ -217,7 +219,7 @@ subroutine material_parseHomogenization(file,myPart)
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
integer(pInt), intent(in) :: file integer(pInt), intent(in) :: file
integer(pInt), parameter :: maxNchunks = 2 integer(pInt), parameter :: maxNchunks = 2_pInt
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1+2*maxNchunks) :: positions
integer(pInt) Nsections, section, s integer(pInt) Nsections, section, s
character(len=64) tag character(len=64) tag
@ -225,7 +227,7 @@ subroutine material_parseHomogenization(file,myPart)
Nsections = IO_countSections(file,myPart) Nsections = IO_countSections(file,myPart)
material_Nhomogenization = Nsections material_Nhomogenization = Nsections
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(125_pInt,ext_msg=myPart)
allocate(homogenization_name(Nsections)); homogenization_name = '' allocate(homogenization_name(Nsections)); homogenization_name = ''
allocate(homogenization_type(Nsections)); homogenization_type = '' allocate(homogenization_type(Nsections)); homogenization_type = ''
@ -253,18 +255,18 @@ subroutine material_parseHomogenization(file,myPart)
section = section + 1 section = section + 1
homogenization_name(section) = IO_getTag(line,'[',']') homogenization_name(section) = IO_getTag(line,'[',']')
endif endif
if (section > 0) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('type') case ('type')
homogenization_type(section) = IO_lc(IO_stringValue(line,positions,2)) ! adding: IO_lc function <<<updated 31.07.2009>>> homogenization_type(section) = IO_lc(IO_stringValue(line,positions,2_pInt)) ! adding: IO_lc function <<<updated 31.07.2009>>>
do s = 1,section do s = 1_pInt,section
if (homogenization_type(s) == homogenization_type(section)) & if (homogenization_type(s) == homogenization_type(section)) &
homogenization_typeInstance(section) = homogenization_typeInstance(section) + 1 ! count instances homogenization_typeInstance(section) = homogenization_typeInstance(section) + 1_pInt ! count instances
enddo enddo
case ('ngrains') case ('ngrains')
homogenization_Ngrains(section) = IO_intValue(line,positions,2) homogenization_Ngrains(section) = IO_intValue(line,positions,2_pInt)
end select end select
endif endif
enddo enddo
@ -285,15 +287,15 @@ subroutine material_parseMicrostructure(file,myPart)
character(len=*), intent(in) :: myPart character(len=*), intent(in) :: myPart
integer(pInt), intent(in) :: file integer(pInt), intent(in) :: file
integer(pInt), parameter :: maxNchunks = 7 integer(pInt), parameter :: maxNchunks = 7_pInt
integer(pInt), dimension(1+2*maxNchunks) :: positions integer(pInt), dimension(1_pInt+2_pInt*maxNchunks) :: positions
integer(pInt) Nsections, section, constituent, e, i integer(pInt) Nsections, section, constituent, e, i
character(len=64) tag character(len=64) tag
character(len=1024) line character(len=1024) line
Nsections = IO_countSections(file,myPart) Nsections = IO_countSections(file,myPart)
material_Nmicrostructure = Nsections material_Nmicrostructure = Nsections
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(125_pInt,ext_msg=myPart)
allocate(microstructure_name(Nsections)); microstructure_name = '' allocate(microstructure_name(Nsections)); microstructure_name = ''
allocate(microstructure_crystallite(Nsections)); microstructure_crystallite = 0_pInt allocate(microstructure_crystallite(Nsections)); microstructure_crystallite = 0_pInt
@ -330,21 +332,21 @@ subroutine material_parseMicrostructure(file,myPart)
endif endif
if (section > 0) then if (section > 0) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('crystallite') case ('crystallite')
microstructure_crystallite(section) = IO_intValue(line,positions,2) microstructure_crystallite(section) = IO_intValue(line,positions,2_pInt)
case ('(constituent)') case ('(constituent)')
constituent = constituent + 1 constituent = constituent + 1
do i=2,6,2 do i=2,6,2
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,i))
select case (tag) select case (tag)
case('phase') case('phase')
microstructure_phase(constituent,section) = IO_intValue(line,positions,i+1) microstructure_phase(constituent,section) = IO_intValue(line,positions,i+1_pInt)
case('texture') case('texture')
microstructure_texture(constituent,section) = IO_intValue(line,positions,i+1) microstructure_texture(constituent,section) = IO_intValue(line,positions,i+1_pInt)
case('fraction') case('fraction')
microstructure_fraction(constituent,section) = IO_floatValue(line,positions,i+1) microstructure_fraction(constituent,section) = IO_floatValue(line,positions,i+1_pInt)
end select end select
enddo enddo
end select end select
@ -370,7 +372,7 @@ subroutine material_parseCrystallite(file,myPart)
Nsections = IO_countSections(file,myPart) Nsections = IO_countSections(file,myPart)
material_Ncrystallite = Nsections material_Ncrystallite = Nsections
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(125_pInt,ext_msg=myPart)
allocate(crystallite_name(Nsections)); crystallite_name = '' allocate(crystallite_name(Nsections)); crystallite_name = ''
allocate(crystallite_Noutput(Nsections)); crystallite_Noutput = 0_pInt allocate(crystallite_Noutput(Nsections)); crystallite_Noutput = 0_pInt
@ -416,7 +418,7 @@ subroutine material_parsePhase(file,myPart)
Nsections = IO_countSections(file,myPart) Nsections = IO_countSections(file,myPart)
material_Nphase = Nsections material_Nphase = Nsections
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(125_pInt,ext_msg=myPart)
allocate(phase_name(Nsections)); phase_name = '' allocate(phase_name(Nsections)); phase_name = ''
allocate(phase_constitution(Nsections)); phase_constitution = '' allocate(phase_constitution(Nsections)); phase_constitution = ''
@ -443,12 +445,12 @@ subroutine material_parsePhase(file,myPart)
section = section + 1 section = section + 1
phase_name(section) = IO_getTag(line,'[',']') phase_name(section) = IO_getTag(line,'[',']')
endif endif
if (section > 0) then if (section > 0_pInt) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('constitution') case ('constitution')
phase_constitution(section) = IO_lc(IO_stringValue(line,positions,2)) phase_constitution(section) = IO_lc(IO_stringValue(line,positions,2_pInt))
do s = 1,section do s = 1,section
if (phase_constitution(s) == phase_constitution(section)) & if (phase_constitution(s) == phase_constitution(section)) &
phase_constitutionInstance(section) = phase_constitutionInstance(section) + 1 ! count instances phase_constitutionInstance(section) = phase_constitutionInstance(section) + 1 ! count instances
@ -480,7 +482,7 @@ subroutine material_parseTexture(file,myPart)
Nsections = IO_countSections(file,myPart) Nsections = IO_countSections(file,myPart)
material_Ntexture = Nsections material_Ntexture = Nsections
if (Nsections < 1_pInt) call IO_error(125,ext_msg=myPart) if (Nsections < 1_pInt) call IO_error(125_pInt,ext_msg=myPart)
allocate(texture_name(Nsections)); texture_name = '' allocate(texture_name(Nsections)); texture_name = ''
allocate(texture_ODFfile(Nsections)); texture_ODFfile = '' allocate(texture_ODFfile(Nsections)); texture_ODFfile = ''
@ -516,14 +518,14 @@ subroutine material_parseTexture(file,myPart)
endif endif
if (section > 0) then if (section > 0) then
positions = IO_stringPos(line,maxNchunks) positions = IO_stringPos(line,maxNchunks)
tag = IO_lc(IO_stringValue(line,positions,1)) ! extract key tag = IO_lc(IO_stringValue(line,positions,1_pInt)) ! extract key
select case(tag) select case(tag)
case ('hybridia') case ('hybridia')
texture_ODFfile(section) = IO_stringValue(line,positions,2) texture_ODFfile(section) = IO_stringValue(line,positions,2_pInt)
case ('symmetry') case ('symmetry')
tag = IO_lc(IO_stringValue(line,positions,2)) tag = IO_lc(IO_stringValue(line,positions,2_pInt))
select case (tag) select case (tag)
case('orthotropic') case('orthotropic')
texture_symmetry(section) = 4 texture_symmetry(section) = 4
@ -540,9 +542,9 @@ subroutine material_parseTexture(file,myPart)
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,i))
select case (tag) select case (tag)
case('scatter') case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1)*inRad texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1) texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1_pInt)
end select end select
enddo enddo
@ -552,15 +554,15 @@ subroutine material_parseTexture(file,myPart)
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,i))
select case (tag) select case (tag)
case('phi1') case('phi1')
texture_Gauss(1,gauss,section) = IO_floatValue(line,positions,i+1)*inRad texture_Gauss(1,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('phi') case('phi')
texture_Gauss(2,gauss,section) = IO_floatValue(line,positions,i+1)*inRad texture_Gauss(2,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('phi2') case('phi2')
texture_Gauss(3,gauss,section) = IO_floatValue(line,positions,i+1)*inRad texture_Gauss(3,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('scatter') case('scatter')
texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1)*inRad texture_Gauss(4,gauss,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('fraction') case('fraction')
texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1) texture_Gauss(5,gauss,section) = IO_floatValue(line,positions,i+1_pInt)
end select end select
enddo enddo
@ -570,17 +572,17 @@ subroutine material_parseTexture(file,myPart)
tag = IO_lc(IO_stringValue(line,positions,i)) tag = IO_lc(IO_stringValue(line,positions,i))
select case (tag) select case (tag)
case('alpha1') case('alpha1')
texture_Fiber(1,fiber,section) = IO_floatValue(line,positions,i+1)*inRad texture_Fiber(1,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('alpha2') case('alpha2')
texture_Fiber(2,fiber,section) = IO_floatValue(line,positions,i+1)*inRad texture_Fiber(2,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('beta1') case('beta1')
texture_Fiber(3,fiber,section) = IO_floatValue(line,positions,i+1)*inRad texture_Fiber(3,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('beta2') case('beta2')
texture_Fiber(4,fiber,section) = IO_floatValue(line,positions,i+1)*inRad texture_Fiber(4,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('scatter') case('scatter')
texture_Fiber(5,fiber,section) = IO_floatValue(line,positions,i+1)*inRad texture_Fiber(5,fiber,section) = IO_floatValue(line,positions,i+1_pInt)*inRad
case('fraction') case('fraction')
texture_Fiber(6,fiber,section) = IO_floatValue(line,positions,i+1) texture_Fiber(6,fiber,section) = IO_floatValue(line,positions,i+1_pInt)
end select end select
enddo enddo
@ -643,9 +645,9 @@ subroutine material_populateGrains()
homog = mesh_element(3,e) homog = mesh_element(3,e)
micro = mesh_element(4,e) micro = mesh_element(4,e)
if (homog < 1 .or. homog > material_Nhomogenization) & ! out of bounds if (homog < 1 .or. homog > material_Nhomogenization) & ! out of bounds
call IO_error(130,e,0,0) call IO_error(130_pInt,e,0_pInt,0_pInt)
if (micro < 1 .or. micro > material_Nmicrostructure) & ! out of bounds if (micro < 1 .or. micro > material_Nmicrostructure) & ! out of bounds
call IO_error(140,e,0,0) call IO_error(140_pInt,e,0_pInt,0_pInt)
if (microstructure_elemhomo(micro)) then if (microstructure_elemhomo(micro)) then
dGrains = homogenization_Ngrains(homog) dGrains = homogenization_Ngrains(homog)
else else
@ -688,7 +690,8 @@ subroutine material_populateGrains()
do hme = 1_pInt, Nelems(homog,micro) do hme = 1_pInt, Nelems(homog,micro)
e = elemsOfHomogMicro(hme,homog,micro) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex e = elemsOfHomogMicro(hme,homog,micro) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex
if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs
volumeOfGrain(grain+1:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(mesh_element(2,e)),e))/dGrains volumeOfGrain(grain+1:grain+dGrains) = sum(mesh_ipVolume(1:FE_Nips(mesh_element(2,e)),e))/&
real(dGrains,pReal)
grain = grain + dGrains ! wind forward by NgrainsPerIP grain = grain + dGrains ! wind forward by NgrainsPerIP
else else
forall (i = 1:FE_Nips(mesh_element(2,e))) & ! loop over IPs forall (i = 1:FE_Nips(mesh_element(2,e))) & ! loop over IPs
@ -707,8 +710,8 @@ subroutine material_populateGrains()
extreme = 0.0_pReal extreme = 0.0_pReal
t = 0_pInt t = 0_pInt
do i = 1,microstructure_Nconstituents(micro) ! find largest deviator do i = 1,microstructure_Nconstituents(micro) ! find largest deviator
if (sgn*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then if (real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) > extreme) then
extreme = sgn*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro)) extreme = real(sgn,pReal)*log(NgrainsOfConstituent(i)/myNgrains/microstructure_fraction(i,micro))
t = i t = i
endif endif
enddo enddo
@ -726,7 +729,8 @@ subroutine material_populateGrains()
phaseOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase phaseOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = phaseID ! assign resp. phase
textureOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture textureOfGrain(grain+1:grain+NgrainsOfConstituent(i)) = textureID ! assign resp. texture
myNorientations = ceiling(float(NgrainsOfConstituent(i))/texture_symmetry(textureID)) ! max number of unique orientations (excl. symmetry) myNorientations = ceiling(real(NgrainsOfConstituent(i),pReal)/&
real(texture_symmetry(textureID),pReal)) ! max number of unique orientations (excl. symmetry)
constituentGrain = 0_pInt ! constituent grain index constituentGrain = 0_pInt ! constituent grain index
! --------- ! ---------
@ -758,7 +762,7 @@ subroutine material_populateGrains()
else ! hybrid IA else ! hybrid IA
! --------- ! ---------
orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID)) orientationOfGrain(:,grain+1:grain+myNorientations) = IO_hybridIA(myNorientations,texture_ODFfile(textureID))
if (all(orientationOfGrain(:,grain+1) == -1.0_pReal)) call IO_error(105) if (all(orientationOfGrain(:,grain+1) == -1.0_pReal)) call IO_error(105_pInt)
constituentGrain = constituentGrain + myNorientations constituentGrain = constituentGrain + myNorientations
endif endif

499
code/mesh.f90
View File

File diff suppressed because it is too large Load Diff