2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @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
2018-12-12 04:59:19 +05:30
!> @brief contains lattice structure definitions including Schmid matrices for slip, twin, trans,
! and cleavage as well as interaction among the various systems
2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
module lattice
2019-05-17 02:26:48 +05:30
use prec
use IO
use config
use math
2019-09-20 19:38:21 +05:30
use rotations
2019-04-13 04:16:27 +05:30
implicit none
private
2020-02-25 22:02:49 +05:30
2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
2020-11-29 03:07:03 +05:30
! face centered cubic (cF)
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
FCC_NSLIPSYSTEM = [ 12 , 6 ] !< # of slip systems per family for fcc
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
FCC_NTWINSYSTEM = [ 12 ] !< # of twin systems per family for fcc
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
FCC_NTRANSSYSTEM = [ 12 ] !< # of transformation systems per family for fcc
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
FCC_NCLEAVAGESYSTEM = [ 3 ] !< # of cleavage systems per family for fcc
2020-02-25 22:02:49 +05:30
2019-05-17 02:26:48 +05:30
integer , parameter :: &
2020-01-04 05:34:20 +05:30
#ifndef __PGI
2020-03-10 18:15:00 +05:30
FCC_NSLIP = sum ( FCC_NSLIPSYSTEM ) , & !< total # of slip systems for fcc
FCC_NTWIN = sum ( FCC_NTWINSYSTEM ) , & !< total # of twin systems for fcc
FCC_NTRANS = sum ( FCC_NTRANSSYSTEM ) , & !< total # of transformation systems for fcc
FCC_NCLEAVAGE = sum ( FCC_NCLEAVAGESYSTEM ) !< total # of cleavage systems for fcc
2020-01-04 05:34:20 +05:30
#else
2020-03-10 18:15:00 +05:30
FCC_NSLIP = 18 , &
FCC_NTWIN = 12 , &
FCC_NTRANS = 12 , &
FCC_NCLEAVAGE = 3
2020-01-04 05:34:20 +05:30
#endif
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , FCC_NSLIP ) , parameter :: &
FCC_SYSTEMSLIP = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Slip direction Plane normal ! SCHMID-BOAS notation
0 , 1 , - 1 , 1 , 1 , 1 , & ! B2
- 1 , 0 , 1 , 1 , 1 , 1 , & ! B4
1 , - 1 , 0 , 1 , 1 , 1 , & ! B5
0 , - 1 , - 1 , - 1 , - 1 , 1 , & ! C1
1 , 0 , 1 , - 1 , - 1 , 1 , & ! C3
- 1 , 1 , 0 , - 1 , - 1 , 1 , & ! C5
0 , - 1 , 1 , 1 , - 1 , - 1 , & ! A2
- 1 , 0 , - 1 , 1 , - 1 , - 1 , & ! A3
1 , 1 , 0 , 1 , - 1 , - 1 , & ! A6
0 , 1 , 1 , - 1 , 1 , - 1 , & ! D1
1 , 0 , - 1 , - 1 , 1 , - 1 , & ! D4
- 1 , - 1 , 0 , - 1 , 1 , - 1 , & ! D6
! Slip system <110>{110}
1 , 1 , 0 , 1 , - 1 , 0 , &
1 , - 1 , 0 , 1 , 1 , 0 , &
1 , 0 , 1 , 1 , 0 , - 1 , &
1 , 0 , - 1 , 1 , 0 , 1 , &
0 , 1 , 1 , 0 , 1 , - 1 , &
0 , 1 , - 1 , 0 , 1 , 1 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( FCC_SYSTEMSLIP ) ) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , FCC_NTWIN ) , parameter :: &
FCC_SYSTEMTWIN = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
- 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 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( FCC_SYSTEMTWIN ) ) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( 2 , FCC_NTWIN ) , parameter , public :: &
lattice_FCC_TWINNUCLEATIONSLIPPAIR = reshape ( [ &
2019-04-13 04:16:27 +05:30
2 , 3 , &
1 , 3 , &
1 , 2 , &
5 , 6 , &
4 , 6 , &
4 , 5 , &
8 , 9 , &
7 , 9 , &
7 , 8 , &
11 , 12 , &
10 , 12 , &
10 , 11 &
2020-03-10 18:15:00 +05:30
] , shape ( lattice_FCC_TWINNUCLEATIONSLIPPAIR ) )
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , FCC_NCLEAVAGE ) , parameter :: &
FCC_SYSTEMCLEAVAGE = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Cleavage direction Plane normal
0 , 1 , 0 , 1 , 0 , 0 , &
0 , 0 , 1 , 0 , 1 , 0 , &
2020-02-26 23:41:33 +05:30
1 , 0 , 0 , 0 , 0 , 1 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( FCC_SYSTEMCLEAVAGE ) )
2020-02-25 22:02:49 +05:30
2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
2020-11-29 03:07:03 +05:30
! body centered cubic (cI)
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
BCC_NSLIPSYSTEM = [ 12 , 12 ] !< # of slip systems per family for bcc
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
BCC_NTWINSYSTEM = [ 12 ] !< # of twin systems per family for bcc
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
BCC_NCLEAVAGESYSTEM = [ 3 ] !< # of cleavage systems per family for bcc
2020-02-25 22:02:49 +05:30
2019-05-17 02:26:48 +05:30
integer , parameter :: &
2020-01-04 05:34:20 +05:30
#ifndef __PGI
2020-03-10 18:15:00 +05:30
BCC_NSLIP = sum ( BCC_NSLIPSYSTEM ) , & !< total # of slip systems for bcc
BCC_NTWIN = sum ( BCC_NTWINSYSTEM ) , & !< total # of twin systems for bcc
BCC_NCLEAVAGE = sum ( BCC_NCLEAVAGESYSTEM ) !< total # of cleavage systems for bcc
2020-01-04 05:34:20 +05:30
#else
2020-03-10 18:15:00 +05:30
BCC_NSLIP = 24 , &
BCC_NTWIN = 12 , &
BCC_NCLEAVAGE = 3
2020-01-04 05:34:20 +05:30
#endif
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , BCC_NSLIP ) , parameter :: &
BCC_SYSTEMSLIP = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Slip direction Plane normal
! Slip system <111>{110}
1 , - 1 , 1 , 0 , 1 , 1 , &
- 1 , - 1 , 1 , 0 , 1 , 1 , &
1 , 1 , 1 , 0 , - 1 , 1 , &
- 1 , 1 , 1 , 0 , - 1 , 1 , &
- 1 , 1 , 1 , 1 , 0 , 1 , &
- 1 , - 1 , 1 , 1 , 0 , 1 , &
1 , 1 , 1 , - 1 , 0 , 1 , &
1 , - 1 , 1 , - 1 , 0 , 1 , &
- 1 , 1 , 1 , 1 , 1 , 0 , &
- 1 , 1 , - 1 , 1 , 1 , 0 , &
1 , 1 , 1 , - 1 , 1 , 0 , &
1 , 1 , - 1 , - 1 , 1 , 0 , &
! Slip system <111>{112}
- 1 , 1 , 1 , 2 , 1 , 1 , &
1 , 1 , 1 , - 2 , 1 , 1 , &
1 , 1 , - 1 , 2 , - 1 , 1 , &
1 , - 1 , 1 , 2 , 1 , - 1 , &
1 , - 1 , 1 , 1 , 2 , 1 , &
1 , 1 , - 1 , - 1 , 2 , 1 , &
1 , 1 , 1 , 1 , - 2 , 1 , &
- 1 , 1 , 1 , 1 , 2 , - 1 , &
1 , 1 , - 1 , 1 , 1 , 2 , &
1 , - 1 , 1 , - 1 , 1 , 2 , &
- 1 , 1 , 1 , 1 , - 1 , 2 , &
1 , 1 , 1 , 1 , 1 , - 2 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( BCC_SYSTEMSLIP ) )
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , BCC_NTWIN ) , parameter :: &
BCC_SYSTEMTWIN = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Twin system <111>{112}
- 1 , 1 , 1 , 2 , 1 , 1 , &
1 , 1 , 1 , - 2 , 1 , 1 , &
1 , 1 , - 1 , 2 , - 1 , 1 , &
1 , - 1 , 1 , 2 , 1 , - 1 , &
1 , - 1 , 1 , 1 , 2 , 1 , &
1 , 1 , - 1 , - 1 , 2 , 1 , &
1 , 1 , 1 , 1 , - 2 , 1 , &
- 1 , 1 , 1 , 1 , 2 , - 1 , &
1 , 1 , - 1 , 1 , 1 , 2 , &
1 , - 1 , 1 , - 1 , 1 , 2 , &
- 1 , 1 , 1 , 1 , - 1 , 2 , &
1 , 1 , 1 , 1 , 1 , - 2 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( BCC_SYSTEMTWIN ) )
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , BCC_NCLEAVAGE ) , parameter :: &
BCC_SYSTEMCLEAVAGE = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Cleavage direction Plane normal
0 , 1 , 0 , 1 , 0 , 0 , &
0 , 0 , 1 , 0 , 1 , 0 , &
2020-02-26 23:41:33 +05:30
1 , 0 , 0 , 0 , 0 , 1 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( BCC_SYSTEMCLEAVAGE ) )
2020-02-25 22:02:49 +05:30
2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
2020-11-29 03:07:03 +05:30
! hexagonal (hP)
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
HEX_NSLIPSYSTEM = [ 3 , 3 , 3 , 6 , 12 , 6 ] !< # of slip systems per family for hex
2020-02-25 22:02:49 +05:30
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
HEX_NTWINSYSTEM = [ 6 , 6 , 6 , 6 ] !< # of slip systems per family for hex
2020-02-25 22:02:49 +05:30
2019-05-17 02:26:48 +05:30
integer , parameter :: &
2020-01-04 05:34:20 +05:30
#ifndef __PGI
2020-03-10 18:15:00 +05:30
HEX_NSLIP = sum ( HEX_NSLIPSYSTEM ) , & !< total # of slip systems for hex
HEX_NTWIN = sum ( HEX_NTWINSYSTEM ) !< total # of twin systems for hex
2020-01-04 05:34:20 +05:30
#else
2020-03-10 18:15:00 +05:30
HEX_NSLIP = 33 , &
HEX_NTWIN = 24
2020-01-04 05:34:20 +05:30
#endif
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 4 + 4 , HEX_NSLIP ) , parameter :: &
HEX_SYSTEMSLIP = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Slip direction Plane normal
2019-10-07 21:34:29 +05:30
! Basal systems <-1-1.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base))
2019-04-13 04:16:27 +05:30
2 , - 1 , - 1 , 0 , 0 , 0 , 0 , 1 , &
- 1 , 2 , - 1 , 0 , 0 , 0 , 0 , 1 , &
- 1 , - 1 , 2 , 0 , 0 , 0 , 0 , 1 , &
2019-10-07 21:34:29 +05:30
! 1st type prismatic systems <-1-1.0>{1-1.0} (independent of c/a-ratio)
2019-04-13 04:16:27 +05:30
2 , - 1 , - 1 , 0 , 0 , 1 , - 1 , 0 , &
- 1 , 2 , - 1 , 0 , - 1 , 0 , 1 , 0 , &
- 1 , - 1 , 2 , 0 , 1 , - 1 , 0 , 0 , &
2019-10-07 21:34:29 +05:30
! 2nd type prismatic systems <-11.0>{11.0} -- a slip; plane normals independent of c/a-ratio
- 1 , 1 , 0 , 0 , 1 , 1 , - 2 , 0 , &
0 , - 1 , 1 , 0 , - 2 , 1 , 1 , 0 , &
1 , 0 , - 1 , 0 , 1 , - 2 , 1 , 0 , &
! 1st type 1st order pyramidal systems <-1-1.0>{-11.1} -- plane normals depend on the c/a-ratio
- 1 , 2 , - 1 , 0 , 1 , 0 , - 1 , 1 , &
- 2 , 1 , 1 , 0 , 0 , 1 , - 1 , 1 , &
- 1 , - 1 , 2 , 0 , - 1 , 1 , 0 , 1 , &
1 , - 2 , 1 , 0 , - 1 , 0 , 1 , 1 , &
2 , - 1 , - 1 , 0 , 0 , - 1 , 1 , 1 , &
1 , 1 , - 2 , 0 , 1 , - 1 , 0 , 1 , &
2019-04-13 04:16:27 +05:30
! pyramidal system: c+a slip <11.3>{-10.1} -- plane normals depend on the c/a-ratio
- 2 , 1 , 1 , 3 , 1 , 0 , - 1 , 1 , &
2019-10-07 21:34:29 +05:30
- 1 , - 1 , 2 , 3 , 1 , 0 , - 1 , 1 , &
- 1 , - 1 , 2 , 3 , 0 , 1 , - 1 , 1 , &
1 , - 2 , 1 , 3 , 0 , 1 , - 1 , 1 , &
1 , - 2 , 1 , 3 , - 1 , 1 , 0 , 1 , &
2 , - 1 , - 1 , 3 , - 1 , 1 , 0 , 1 , &
2 , - 1 , - 1 , 3 , - 1 , 0 , 1 , 1 , &
1 , 1 , - 2 , 3 , - 1 , 0 , 1 , 1 , &
2019-04-13 04:16:27 +05:30
1 , 1 , - 2 , 3 , 0 , - 1 , 1 , 1 , &
2019-10-07 21:34:29 +05:30
- 1 , 2 , - 1 , 3 , 0 , - 1 , 1 , 1 , &
2019-04-13 04:16:27 +05:30
- 1 , 2 , - 1 , 3 , 1 , - 1 , 0 , 1 , &
2019-10-07 21:34:29 +05:30
- 2 , 1 , 1 , 3 , 1 , - 1 , 0 , 1 , &
2019-04-13 04:16:27 +05:30
! pyramidal system: c+a slip <11.3>{-1-1.2} -- as for hexagonal ice (Castelnau et al. 1996, similar to twin system found below)
2020-02-25 22:02:49 +05:30
- 1 , - 1 , 2 , 3 , 1 , 1 , - 2 , 2 , & ! <11.3>{-1-1.2} shear = 2((c/a)^2-2)/(3 c/a)
2019-04-13 04:16:27 +05:30
1 , - 2 , 1 , 3 , - 1 , 2 , - 1 , 2 , &
2019-10-07 21:34:29 +05:30
2 , - 1 , - 1 , 3 , - 2 , 1 , 1 , 2 , &
1 , 1 , - 2 , 3 , - 1 , - 1 , 2 , 2 , &
- 1 , 2 , - 1 , 3 , 1 , - 2 , 1 , 2 , &
- 2 , 1 , 1 , 3 , 2 , - 1 , - 1 , 2 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( HEX_SYSTEMSLIP ) ) !< slip systems for hex, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 4 + 4 , HEX_NTWIN ) , parameter :: &
HEX_SYSTEMTWIN = reshape ( real ( [ &
2019-10-07 21:34:29 +05:30
! Compression or Tension = f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981)
- 1 , 0 , 1 , 1 , 1 , 0 , - 1 , 2 , & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a)
0 , - 1 , 1 , 1 , 0 , 1 , - 1 , 2 , &
1 , - 1 , 0 , 1 , - 1 , 1 , 0 , 2 , &
1 , 0 , - 1 , 1 , - 1 , 0 , 1 , 2 , &
2019-04-13 04:16:27 +05:30
0 , 1 , - 1 , 1 , 0 , - 1 , 1 , 2 , &
- 1 , 1 , 0 , 1 , 1 , - 1 , 0 , 2 , &
2014-08-14 17:51:51 +05:30
!
2019-10-07 21:34:29 +05:30
- 1 , - 1 , 2 , 6 , 1 , 1 , - 2 , 1 , & ! <11.6>{-1-1.1} shear = 1/(c/a)
2019-04-13 04:16:27 +05:30
1 , - 2 , 1 , 6 , - 1 , 2 , - 1 , 1 , &
2019-10-07 21:34:29 +05:30
2 , - 1 , - 1 , 6 , - 2 , 1 , 1 , 1 , &
2019-04-13 04:16:27 +05:30
1 , 1 , - 2 , 6 , - 1 , - 1 , 2 , 1 , &
2019-10-07 21:34:29 +05:30
- 1 , 2 , - 1 , 6 , 1 , - 2 , 1 , 1 , &
- 2 , 1 , 1 , 6 , 2 , - 1 , - 1 , 1 , &
2014-08-14 17:51:51 +05:30
!
2019-10-07 21:34:29 +05:30
1 , 0 , - 1 , - 2 , 1 , 0 , - 1 , 1 , & ! <10.-2>{10.1} shear = (4(c/a)^2-9)/(4 sqrt(3) c/a)
0 , 1 , - 1 , - 2 , 0 , 1 , - 1 , 1 , &
- 1 , 1 , 0 , - 2 , - 1 , 1 , 0 , 1 , &
- 1 , 0 , 1 , - 2 , - 1 , 0 , 1 , 1 , &
2019-04-13 04:16:27 +05:30
0 , - 1 , 1 , - 2 , 0 , - 1 , 1 , 1 , &
1 , - 1 , 0 , - 2 , 1 , - 1 , 0 , 1 , &
2014-08-14 17:51:51 +05:30
!
2019-10-07 21:34:29 +05:30
1 , 1 , - 2 , - 3 , 1 , 1 , - 2 , 2 , & ! <11.-3>{11.2} shear = 2((c/a)^2-2)/(3 c/a)
2019-04-13 04:16:27 +05:30
- 1 , 2 , - 1 , - 3 , - 1 , 2 , - 1 , 2 , &
- 2 , 1 , 1 , - 3 , - 2 , 1 , 1 , 2 , &
2019-10-07 21:34:29 +05:30
- 1 , - 1 , 2 , - 3 , - 1 , - 1 , 2 , 2 , &
2019-04-13 04:16:27 +05:30
1 , - 2 , 1 , - 3 , 1 , - 2 , 1 , 2 , &
2019-10-07 21:34:29 +05:30
2 , - 1 , - 1 , - 3 , 2 , - 1 , - 1 , 2 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( HEX_SYSTEMTWIN ) ) !< twin systems for hex, sorted by P. Eisenlohr CCW around <c> starting next to a_1 axis
2020-02-25 22:02:49 +05:30
2015-06-27 20:25:30 +05:30
!--------------------------------------------------------------------------------------------------
2020-11-29 03:07:03 +05:30
! body centered tetragonal (tI)
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
BCT_NSLIPSYSTEM = [ 2 , 2 , 2 , 4 , 2 , 4 , 2 , 2 , 4 , 8 , 4 , 8 , 8 ] !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009
2020-02-25 22:02:49 +05:30
2019-05-17 02:26:48 +05:30
integer , parameter :: &
2020-01-04 05:34:20 +05:30
#ifndef __PGI
2020-03-10 18:15:00 +05:30
BCT_NSLIP = sum ( BCT_NSLIPSYSTEM ) !< total # of slip systems for bct
2020-01-04 05:34:20 +05:30
#else
2020-03-10 18:15:00 +05:30
BCT_NSLIP = 52
2020-01-04 05:34:20 +05:30
#endif
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , BCT_NSLIP ) , parameter :: &
BCT_SYSTEMSLIP = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Slip direction Plane normal
! Slip family 1 {100)<001] (Bravais notation {hkl)<uvw] for bct c/a = 0.5456)
0 , 0 , 1 , 1 , 0 , 0 , &
0 , 0 , 1 , 0 , 1 , 0 , &
! Slip family 2 {110)<001]
0 , 0 , 1 , 1 , 1 , 0 , &
0 , 0 , 1 , - 1 , 1 , 0 , &
! slip family 3 {100)<010]
0 , 1 , 0 , 1 , 0 , 0 , &
1 , 0 , 0 , 0 , 1 , 0 , &
! Slip family 4 {110)<1-11]/2
1 , - 1 , 1 , 1 , 1 , 0 , &
1 , - 1 , - 1 , 1 , 1 , 0 , &
- 1 , - 1 , - 1 , - 1 , 1 , 0 , &
- 1 , - 1 , 1 , - 1 , 1 , 0 , &
! Slip family 5 {110)<1-10]
1 , - 1 , 0 , 1 , 1 , 0 , &
1 , 1 , 0 , 1 , - 1 , 0 , &
! Slip family 6 {100)<011]
0 , 1 , 1 , 1 , 0 , 0 , &
0 , - 1 , 1 , 1 , 0 , 0 , &
- 1 , 0 , 1 , 0 , 1 , 0 , &
1 , 0 , 1 , 0 , 1 , 0 , &
! Slip family 7 {001)<010]
0 , 1 , 0 , 0 , 0 , 1 , &
1 , 0 , 0 , 0 , 0 , 1 , &
! Slip family 8 {001)<110]
1 , 1 , 0 , 0 , 0 , 1 , &
- 1 , 1 , 0 , 0 , 0 , 1 , &
! Slip family 9 {011)<01-1]
0 , 1 , - 1 , 0 , 1 , 1 , &
0 , - 1 , - 1 , 0 , - 1 , 1 , &
- 1 , 0 , - 1 , - 1 , 0 , 1 , &
1 , 0 , - 1 , 1 , 0 , 1 , &
! Slip family 10 {011)<1-11]/2
1 , - 1 , 1 , 0 , 1 , 1 , &
1 , 1 , - 1 , 0 , 1 , 1 , &
1 , 1 , 1 , 0 , 1 , - 1 , &
- 1 , 1 , 1 , 0 , 1 , - 1 , &
1 , - 1 , - 1 , 1 , 0 , 1 , &
- 1 , - 1 , 1 , 1 , 0 , 1 , &
1 , 1 , 1 , 1 , 0 , - 1 , &
1 , - 1 , 1 , 1 , 0 , - 1 , &
! Slip family 11 {011)<100]
1 , 0 , 0 , 0 , 1 , 1 , &
1 , 0 , 0 , 0 , 1 , - 1 , &
0 , 1 , 0 , 1 , 0 , 1 , &
0 , 1 , 0 , 1 , 0 , - 1 , &
! Slip family 12 {211)<01-1]
0 , 1 , - 1 , 2 , 1 , 1 , &
0 , - 1 , - 1 , 2 , - 1 , 1 , &
1 , 0 , - 1 , 1 , 2 , 1 , &
- 1 , 0 , - 1 , - 1 , 2 , 1 , &
0 , 1 , - 1 , - 2 , 1 , 1 , &
0 , - 1 , - 1 , - 2 , - 1 , 1 , &
- 1 , 0 , - 1 , - 1 , - 2 , 1 , &
1 , 0 , - 1 , 1 , - 2 , 1 , &
! Slip family 13 {211)<-111]/2
- 1 , 1 , 1 , 2 , 1 , 1 , &
- 1 , - 1 , 1 , 2 , - 1 , 1 , &
1 , - 1 , 1 , 1 , 2 , 1 , &
- 1 , - 1 , 1 , - 1 , 2 , 1 , &
1 , 1 , 1 , - 2 , 1 , 1 , &
1 , - 1 , 1 , - 2 , - 1 , 1 , &
- 1 , 1 , 1 , - 1 , - 2 , 1 , &
1 , 1 , 1 , 1 , - 2 , 1 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( BCT_SYSTEMSLIP ) ) !< slip systems for bct sorted by Bieler
2020-02-25 22:02:49 +05:30
2014-10-28 23:35:51 +05:30
!--------------------------------------------------------------------------------------------------
2020-11-29 03:07:03 +05:30
! orthorhombic primitive (oP)
2020-03-29 22:47:24 +05:30
integer , dimension ( * ) , parameter :: &
2020-03-10 18:15:00 +05:30
ORT_NCLEAVAGESYSTEM = [ 1 , 1 , 1 ] !< # of cleavage systems per family for ortho
2020-02-25 22:02:49 +05:30
2019-05-17 02:26:48 +05:30
integer , parameter :: &
2020-01-04 05:34:20 +05:30
#ifndef __PGI
2020-03-10 18:15:00 +05:30
ORT_NCLEAVAGE = sum ( ORT_NCLEAVAGESYSTEM ) !< total # of cleavage systems for ortho
2020-01-04 05:34:20 +05:30
#else
2020-03-10 18:15:00 +05:30
ORT_NCLEAVAGE = 3
2020-01-04 05:34:20 +05:30
#endif
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , ORT_NCLEAVAGE ) , parameter :: &
ORT_SYSTEMCLEAVAGE = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
! Cleavage direction Plane normal
0 , 1 , 0 , 1 , 0 , 0 , &
0 , 0 , 1 , 0 , 1 , 0 , &
1 , 0 , 0 , 0 , 0 , 1 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( ORT_SYSTEMCLEAVAGE ) )
2020-02-25 22:02:49 +05:30
2020-03-17 12:47:14 +05:30
enum , bind ( c ) ; enumerator :: &
lattice_UNDEFINED_ID , &
lattice_ISO_ID , &
lattice_FCC_ID , &
lattice_BCC_ID , &
lattice_BCT_ID , &
lattice_HEX_ID , &
lattice_ORT_ID
2019-04-13 04:16:27 +05:30
end enum
2020-02-25 22:02:49 +05:30
2018-12-11 05:09:50 +05:30
! SHOULD NOT BE PART OF LATTICE BEGIN
2020-02-29 17:47:33 +05:30
real ( pReal ) , dimension ( : ) , allocatable , public , protected :: &
lattice_mu , lattice_nu , &
2020-09-23 05:20:13 +05:30
lattice_M , &
lattice_rho , &
lattice_c_p
2020-02-29 17:47:33 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , public , protected :: &
lattice_C66 , &
2020-09-23 05:20:13 +05:30
lattice_K , &
lattice_D
2020-03-10 18:15:00 +05:30
integer ( kind ( lattice_UNDEFINED_ID ) ) , dimension ( : ) , allocatable , public , protected :: &
2019-06-04 15:36:16 +05:30
lattice_structure
2020-02-29 17:47:33 +05:30
! SHOULD NOT BE PART OF LATTICE END
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interface lattice_forestProjection_edge
module procedure slipProjection_transverse
end interface lattice_forestProjection_edge
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interface lattice_forestProjection_screw
module procedure slipProjection_direction
end interface lattice_forestProjection_screw
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
public :: &
2019-09-20 02:21:37 +05:30
lattice_init , &
2020-03-10 18:15:00 +05:30
lattice_ISO_ID , &
lattice_FCC_ID , &
lattice_BCC_ID , &
lattice_BCT_ID , &
lattice_HEX_ID , &
lattice_ORT_ID , &
2020-12-28 15:33:29 +05:30
lattice_equivalent_nu , &
lattice_equivalent_mu , &
2020-03-10 10:43:54 +05:30
lattice_applyLatticeSymmetry33 , &
2019-09-20 02:21:37 +05:30
lattice_SchmidMatrix_slip , &
lattice_SchmidMatrix_twin , &
lattice_SchmidMatrix_trans , &
lattice_SchmidMatrix_cleavage , &
lattice_nonSchmidMatrix , &
lattice_interaction_SlipBySlip , &
lattice_interaction_TwinByTwin , &
lattice_interaction_TransByTrans , &
lattice_interaction_SlipByTwin , &
lattice_interaction_SlipByTrans , &
lattice_interaction_TwinBySlip , &
lattice_characteristicShear_Twin , &
lattice_C66_twin , &
lattice_C66_trans , &
lattice_forestProjection_edge , &
lattice_forestProjection_screw , &
lattice_slip_normal , &
lattice_slip_direction , &
2019-10-10 16:41:02 +05:30
lattice_slip_transverse , &
2020-01-03 17:10:25 +05:30
lattice_labels_slip , &
lattice_labels_twin
2020-02-25 22:02:49 +05:30
2019-09-20 02:21:37 +05:30
contains
2020-01-03 17:10:25 +05:30
2014-08-14 17:51:51 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Module initialization
!--------------------------------------------------------------------------------------------------
subroutine lattice_init
2020-02-25 22:02:49 +05:30
2020-12-31 13:40:59 +05:30
integer :: Nphases , ph , i
2020-08-15 19:32:10 +05:30
class ( tNode ) , pointer :: &
phases , &
phase , &
2020-11-03 03:16:46 +05:30
mech , &
2020-12-31 13:40:59 +05:30
elasticity , &
2021-02-13 18:47:08 +05:30
thermal , &
damage
2020-11-29 03:07:03 +05:30
2020-09-22 16:39:12 +05:30
print '(/,a)' , ' <<<+- lattice init -+>>>' ; flush ( IO_STDOUT )
2020-02-25 22:02:49 +05:30
2020-09-13 14:09:17 +05:30
phases = > config_material % get ( 'phase' )
2020-08-15 19:32:10 +05:30
Nphases = phases % length
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
allocate ( lattice_structure ( Nphases ) , source = lattice_UNDEFINED_ID )
2019-04-13 04:16:27 +05:30
allocate ( lattice_C66 ( 6 , 6 , Nphases ) , source = 0.0_pReal )
2020-02-25 22:02:49 +05:30
2020-09-23 05:20:13 +05:30
allocate ( lattice_K ( 3 , 3 , Nphases ) , source = 0.0_pReal )
allocate ( lattice_D ( 3 , 3 , Nphases ) , source = 0.0_pReal )
2020-02-25 22:02:49 +05:30
2020-09-23 05:20:13 +05:30
allocate ( lattice_M , &
lattice_rho , lattice_c_p , &
2020-02-29 17:47:33 +05:30
lattice_mu , lattice_nu , &
source = [ ( 0.0_pReal , i = 1 , Nphases ) ] )
2020-02-26 11:53:29 +05:30
2020-12-31 13:40:59 +05:30
do ph = 1 , phases % length
phase = > phases % get ( ph )
2020-11-18 01:54:40 +05:30
mech = > phase % get ( 'mechanics' )
2020-11-03 03:16:46 +05:30
elasticity = > mech % get ( 'elasticity' )
2020-12-31 13:40:59 +05:30
lattice_C66 ( 1 , 1 , ph ) = elasticity % get_asFloat ( 'C_11' )
lattice_C66 ( 1 , 2 , ph ) = elasticity % get_asFloat ( 'C_12' )
2020-08-15 19:32:10 +05:30
2020-12-31 13:40:59 +05:30
lattice_C66 ( 1 , 3 , ph ) = elasticity % get_asFloat ( 'C_13' , defaultVal = 0.0_pReal )
lattice_C66 ( 2 , 2 , ph ) = elasticity % get_asFloat ( 'C_22' , defaultVal = 0.0_pReal )
lattice_C66 ( 2 , 3 , ph ) = elasticity % get_asFloat ( 'C_23' , defaultVal = 0.0_pReal )
lattice_C66 ( 3 , 3 , ph ) = elasticity % get_asFloat ( 'C_33' , defaultVal = 0.0_pReal )
lattice_C66 ( 4 , 4 , ph ) = elasticity % get_asFloat ( 'C_44' , defaultVal = 0.0_pReal )
lattice_C66 ( 5 , 5 , ph ) = elasticity % get_asFloat ( 'C_55' , defaultVal = 0.0_pReal )
lattice_C66 ( 6 , 6 , ph ) = elasticity % get_asFloat ( 'C_66' , defaultVal = 0.0_pReal )
2020-08-15 19:32:10 +05:30
select case ( phase % get_asString ( 'lattice' ) )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_FCC_ID
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_BCC_ID
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_HEX_ID
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_BCT_ID
2020-11-29 03:07:03 +05:30
case ( 'oP' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_ORT_ID
2020-11-29 03:07:03 +05:30
case ( 'aP' )
2020-12-31 13:40:59 +05:30
lattice_structure ( ph ) = lattice_ISO_ID
2020-02-25 22:02:49 +05:30
case default
2020-08-15 19:32:10 +05:30
call IO_error ( 130 , ext_msg = 'lattice_init: ' / / phase % get_asString ( 'lattice' ) )
2019-04-13 04:16:27 +05:30
end select
2020-02-25 22:02:49 +05:30
2020-12-31 13:40:59 +05:30
lattice_C66 ( 1 : 6 , 1 : 6 , ph ) = applyLatticeSymmetryC66 ( lattice_C66 ( 1 : 6 , 1 : 6 , ph ) , phase % get_asString ( 'lattice' ) )
2020-02-25 22:02:49 +05:30
2020-12-31 13:40:59 +05:30
lattice_nu ( ph ) = lattice_equivalent_nu ( lattice_C66 ( 1 : 6 , 1 : 6 , ph ) , 'voigt' )
lattice_mu ( ph ) = lattice_equivalent_mu ( lattice_C66 ( 1 : 6 , 1 : 6 , ph ) , 'voigt' )
2020-02-25 22:02:49 +05:30
2020-12-31 13:40:59 +05:30
lattice_C66 ( 1 : 6 , 1 : 6 , ph ) = math_sym3333to66 ( math_Voigt66to3333 ( lattice_C66 ( 1 : 6 , 1 : 6 , ph ) ) ) ! Literature data is in Voigt notation
2020-02-26 11:53:29 +05:30
do i = 1 , 6
2020-12-31 13:40:59 +05:30
if ( abs ( lattice_C66 ( i , i , ph ) ) < tol_math_check ) &
call IO_error ( 135 , el = i , ip = ph , ext_msg = 'matrix diagonal "el"ement of phase "ip"' )
2020-02-26 11:53:29 +05:30
enddo
2020-02-25 22:02:49 +05:30
2020-12-31 13:40:59 +05:30
lattice_rho ( ph ) = phase % get_asFloat ( 'rho' , defaultVal = 0.0_pReal )
2020-02-26 11:53:29 +05:30
2020-02-29 21:33:01 +05:30
! SHOULD NOT BE PART OF LATTICE BEGIN
2020-09-23 05:20:13 +05:30
2020-12-31 13:40:59 +05:30
if ( phase % contains ( 'thermal' ) ) then
thermal = > phase % get ( 'thermal' )
lattice_K ( 1 , 1 , ph ) = thermal % get_asFloat ( 'K_11' , defaultVal = 0.0_pReal )
lattice_K ( 2 , 2 , ph ) = thermal % get_asFloat ( 'K_22' , defaultVal = 0.0_pReal )
lattice_K ( 3 , 3 , ph ) = thermal % get_asFloat ( 'K_33' , defaultVal = 0.0_pReal )
lattice_K ( 1 : 3 , 1 : 3 , ph ) = lattice_applyLatticeSymmetry33 ( lattice_K ( 1 : 3 , 1 : 3 , ph ) , &
phase % get_asString ( 'lattice' ) )
lattice_c_p ( ph ) = thermal % get_asFloat ( 'c_p' , defaultVal = 0.0_pReal )
endif
2021-02-13 18:47:08 +05:30
if ( phase % contains ( 'damage' ) ) then
damage = > phase % get ( 'damage' )
damage = > damage % get ( 1 )
lattice_D ( 1 , 1 , ph ) = damage % get_asFloat ( 'D_11' , defaultVal = 0.0_pReal )
lattice_D ( 2 , 2 , ph ) = damage % get_asFloat ( 'D_22' , defaultVal = 0.0_pReal )
lattice_D ( 3 , 3 , ph ) = damage % get_asFloat ( 'D_33' , defaultVal = 0.0_pReal )
lattice_D ( 1 : 3 , 1 : 3 , ph ) = lattice_applyLatticeSymmetry33 ( lattice_D ( 1 : 3 , 1 : 3 , ph ) , &
2020-09-23 05:20:13 +05:30
phase % get_asString ( 'lattice' ) )
2021-02-13 18:47:08 +05:30
lattice_M ( ph ) = damage % get_asFloat ( 'M' , defaultVal = 0.0_pReal )
endif
2020-02-29 21:33:01 +05:30
! SHOULD NOT BE PART OF LATTICE END
2020-02-25 22:02:49 +05:30
2020-05-16 20:35:03 +05:30
call selfTest
2020-03-14 21:59:08 +05:30
2019-05-17 02:26:48 +05:30
enddo
2020-02-25 22:02:49 +05:30
2020-02-26 22:32:47 +05:30
end subroutine lattice_init
2020-02-25 22:02:49 +05:30
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Characteristic shear for twinning
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2018-10-05 08:24:47 +05:30
function lattice_characteristicShear_Twin ( Ntwin , structure , CoverA ) result ( characteristicShear )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 ( sum ( Ntwin ) ) :: characteristicShear
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer :: &
a , & !< index of active system
2019-10-10 15:56:45 +05:30
p , & !< index in potential system list
f , & !< index of my family
s !< index of my system in current family
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( HEX_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
HEX_SHEARTWIN = reshape ( [ &
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 &
2020-03-10 18:15:00 +05:30
] , [ HEX_NTWIN ] ) ! indicator to formulas below
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
a = 0
2019-10-10 15:56:45 +05:30
myFamilies : do f = 1 , size ( Ntwin , 1 )
mySystems : do s = 1 , Ntwin ( f )
2019-04-13 04:16:27 +05:30
a = a + 1
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' , 'cI' )
2019-04-13 04:16:27 +05:30
characteristicShear ( a ) = 0.5_pReal * sqrt ( 2.0_pReal )
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-04-13 04:16:27 +05:30
if ( cOverA < 1.0_pReal . or . cOverA > 2.0_pReal ) &
call IO_error ( 131 , ext_msg = 'lattice_characteristicShear_Twin' )
2020-03-10 18:15:00 +05:30
p = sum ( HEX_NTWINSYSTEM ( 1 : f - 1 ) ) + s
2019-10-10 15:56:45 +05:30
select case ( HEX_SHEARTWIN ( p ) ) ! from Christian & Mahajan 1995 p.29
2019-04-13 04:16:27 +05:30
case ( 1 ) ! <-10.1>{10.2}
characteristicShear ( a ) = ( 3.0_pReal - cOverA ** 2.0_pReal ) / sqrt ( 3.0_pReal ) / CoverA
case ( 2 ) ! <11.6>{-1-1.1}
characteristicShear ( a ) = 1.0_pReal / cOverA
case ( 3 ) ! <10.-2>{10.1}
characteristicShear ( a ) = ( 4.0_pReal * cOverA ** 2.0_pReal - 9.0_pReal ) / sqrt ( 4 8.0_pReal ) / cOverA
case ( 4 ) ! <11.-3>{11.2}
characteristicShear ( a ) = 2.0_pReal * ( cOverA ** 2.0_pReal - 2.0_pReal ) / 3.0_pReal / cOverA
end select
case default
call IO_error ( 137 , ext_msg = 'lattice_characteristicShear_Twin: ' / / trim ( structure ) )
end select
enddo mySystems
enddo myFamilies
2020-02-25 22:02:49 +05:30
2018-10-05 08:24:47 +05:30
end function lattice_characteristicShear_Twin
2020-02-25 22:02:49 +05:30
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-25 18:12:38 +05:30
!> @brief Rotated elasticity matrices for twinning in 66-vector notation
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2018-09-12 19:27:54 +05:30
function lattice_C66_twin ( Ntwin , C66 , structure , CoverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 !< unrotated parent stiffness matrix
real ( pReal ) , intent ( in ) :: cOverA !< c/a ratio
real ( pReal ) , dimension ( 6 , 6 , sum ( Ntwin ) ) :: lattice_C66_twin
2020-02-25 22:02:49 +05:30
2019-09-20 19:38:21 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntwin ) ) :: coordinateSystem
type ( rotation ) :: R
2019-04-13 04:16:27 +05:30
integer :: i
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
coordinateSystem = buildCoordinateSystem ( Ntwin , FCC_NSLIPSYSTEM , FCC_SYSTEMTWIN , &
2020-11-29 03:07:03 +05:30
structure , 0.0_pReal )
case ( 'cI' )
2020-03-10 18:15:00 +05:30
coordinateSystem = buildCoordinateSystem ( Ntwin , BCC_NSLIPSYSTEM , BCC_SYSTEMTWIN , &
2020-11-29 03:07:03 +05:30
structure , 0.0_pReal )
case ( 'hP' )
2020-03-10 18:15:00 +05:30
coordinateSystem = buildCoordinateSystem ( Ntwin , HEX_NSLIPSYSTEM , HEX_SYSTEMTWIN , &
2020-11-29 03:07:03 +05:30
structure , cOverA )
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_C66_twin: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ntwin )
2019-09-21 05:48:09 +05:30
call R % fromAxisAngle ( [ coordinateSystem ( 1 : 3 , 2 , i ) , PI ] , P = 1 ) ! ToDo: Why always 180 deg?
2019-09-21 06:12:55 +05:30
lattice_C66_twin ( 1 : 6 , 1 : 6 , i ) = R % rotTensor4sym ( C66 )
2019-04-13 04:16:27 +05:30
enddo
2019-09-20 19:38:21 +05:30
2018-12-10 02:50:18 +05:30
end function lattice_C66_twin
2020-02-25 22:02:49 +05:30
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-25 18:12:38 +05:30
!> @brief Rotated elasticity matrices for transformation in 66-vector notation
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-25 18:12:38 +05:30
function lattice_C66_trans ( Ntrans , C_parent66 , structure_target , &
2019-09-21 06:46:08 +05:30
cOverA_trans , a_bcc , a_fcc )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 , sum ( Ntrans ) ) :: lattice_C66_trans
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 6 , 6 ) :: C_bar66 , C_target_unrotated66
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntrans ) ) :: Q , S
2019-09-21 05:22:55 +05:30
type ( rotation ) :: R
2019-09-21 06:46:08 +05:30
real ( pReal ) :: a_bcc , a_fcc , cOverA_trans
2019-04-13 04:16:27 +05:30
integer :: i
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
!--------------------------------------------------------------------------------------------------
! elasticity matrix of the target phase in cube orientation
2020-11-29 03:07:03 +05:30
if ( structure_target == 'hP' ) then
2019-09-21 06:46:08 +05:30
if ( cOverA_trans < 1.0_pReal . or . cOverA_trans > 2.0_pReal ) &
2019-09-21 06:19:55 +05:30
call IO_error ( 131 , ext_msg = 'lattice_C66_trans: ' / / trim ( structure_target ) )
2019-04-13 04:16:27 +05:30
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
C_bar66 ( 1 , 3 ) = ( C_parent66 ( 1 , 1 ) + 2.0_pReal * C_parent66 ( 1 , 2 ) - 2.0_pReal * C_parent66 ( 4 , 4 ) ) / 3.0_pReal
C_bar66 ( 4 , 4 ) = ( C_parent66 ( 1 , 1 ) - C_parent66 ( 1 , 2 ) + C_parent66 ( 4 , 4 ) ) / 3.0_pReal
C_bar66 ( 1 , 4 ) = ( C_parent66 ( 1 , 1 ) - C_parent66 ( 1 , 2 ) - 2.0_pReal * C_parent66 ( 4 , 4 ) ) / ( 3.0_pReal * sqrt ( 2.0_pReal ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
C_target_unrotated66 = 0.0_pReal
C_target_unrotated66 ( 1 , 1 ) = C_bar66 ( 1 , 1 ) - C_bar66 ( 1 , 4 ) ** 2.0_pReal / C_bar66 ( 4 , 4 )
C_target_unrotated66 ( 1 , 2 ) = C_bar66 ( 1 , 2 ) + C_bar66 ( 1 , 4 ) ** 2.0_pReal / C_bar66 ( 4 , 4 )
C_target_unrotated66 ( 1 , 3 ) = C_bar66 ( 1 , 3 )
C_target_unrotated66 ( 3 , 3 ) = C_bar66 ( 3 , 3 )
2019-09-21 06:46:08 +05:30
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 ) ) )
2020-11-29 03:07:03 +05:30
C_target_unrotated66 = applyLatticeSymmetryC66 ( C_target_unrotated66 , 'hP' )
elseif ( structure_target == 'cI' ) then
2019-09-21 06:46:08 +05:30
if ( a_bcc < = 0.0_pReal . or . a_fcc < = 0.0_pReal ) &
call IO_error ( 134 , ext_msg = 'lattice_C66_trans: ' / / trim ( structure_target ) )
2019-04-13 04:16:27 +05:30
C_target_unrotated66 = C_parent66
else
2019-09-21 06:46:08 +05:30
call IO_error ( 137 , ext_msg = 'lattice_C66_trans : ' / / trim ( structure_target ) )
2019-04-13 04:16:27 +05:30
endif
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , 6
if ( abs ( C_target_unrotated66 ( i , i ) ) < tol_math_check ) &
call IO_error ( 135 , el = i , ext_msg = 'matrix diagonal "el"ement in transformation' )
enddo
2020-02-25 22:02:49 +05:30
2019-09-21 06:46:08 +05:30
call buildTransformationSystem ( Q , S , Ntrans , cOverA_trans , a_fcc , a_bcc )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ntrans )
2019-09-21 05:48:09 +05:30
call R % fromMatrix ( Q ( 1 : 3 , 1 : 3 , i ) )
2019-09-21 06:12:55 +05:30
lattice_C66_trans ( 1 : 6 , 1 : 6 , i ) = R % rotTensor4sym ( C_target_unrotated66 )
2019-04-13 04:16:27 +05:30
enddo
2019-09-20 19:38:21 +05:30
2019-04-13 04:16:27 +05:30
end function lattice_C66_trans
2020-02-25 22:02:49 +05:30
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @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
2018-10-06 14:12:25 +05:30
!--------------------------------------------------------------------------------------------------
2018-10-03 12:19:23 +05:30
function lattice_nonSchmidMatrix ( Nslip , nonSchmidCoefficients , sense ) result ( nonSchmidMatrix )
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: Nslip !< number of active slip systems per family
real ( pReal ) , dimension ( : ) , intent ( in ) :: nonSchmidCoefficients !< non-Schmid coefficients for projections
integer , intent ( in ) :: sense !< sense (-1,+1)
real ( pReal ) , dimension ( 1 : 3 , 1 : 3 , sum ( Nslip ) ) :: nonSchmidMatrix
2020-02-25 22:02:49 +05:30
2019-09-20 19:38:21 +05:30
real ( pReal ) , dimension ( 1 : 3 , 1 : 3 , sum ( Nslip ) ) :: coordinateSystem !< coordinate system of slip system
real ( pReal ) , dimension ( 3 ) :: direction , normal , np
type ( rotation ) :: R
integer :: i
2020-02-25 22:02:49 +05:30
2020-09-13 15:50:44 +05:30
if ( abs ( sense ) / = 1 ) error stop 'Sense in lattice_nonSchmidMatrix'
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
coordinateSystem = buildCoordinateSystem ( Nslip , BCC_NSLIPSYSTEM , BCC_SYSTEMSLIP , &
2020-11-29 03:07:03 +05:30
'cI' , 0.0_pReal )
2020-03-14 21:59:08 +05:30
coordinateSystem ( 1 : 3 , 1 , 1 : sum ( Nslip ) ) = coordinateSystem ( 1 : 3 , 1 , 1 : sum ( Nslip ) ) * real ( sense , pReal ) ! convert unidirectional coordinate system
2020-11-29 03:07:03 +05:30
nonSchmidMatrix = lattice_SchmidMatrix_slip ( Nslip , 'cI' , 0.0_pReal ) ! Schmid contribution
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Nslip )
direction = coordinateSystem ( 1 : 3 , 1 , i )
normal = coordinateSystem ( 1 : 3 , 2 , i )
2019-09-21 05:48:09 +05:30
call R % fromAxisAngle ( [ direction , 6 0.0_pReal ] , degrees = . true . , P = 1 )
np = R % rotate ( normal )
2019-09-20 19:38:21 +05:30
2019-04-13 04:16:27 +05:30
if ( size ( nonSchmidCoefficients ) > 0 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 1 ) * math_outer ( direction , np )
if ( size ( nonSchmidCoefficients ) > 1 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 2 ) * math_outer ( math_cross ( normal , direction ) , normal )
if ( size ( nonSchmidCoefficients ) > 2 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 3 ) * math_outer ( math_cross ( np , direction ) , np )
if ( size ( nonSchmidCoefficients ) > 3 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 4 ) * math_outer ( normal , normal )
if ( size ( nonSchmidCoefficients ) > 4 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 5 ) * math_outer ( math_cross ( normal , direction ) , &
math_cross ( normal , direction ) )
if ( size ( nonSchmidCoefficients ) > 5 ) nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) = nonSchmidMatrix ( 1 : 3 , 1 : 3 , i ) &
+ nonSchmidCoefficients ( 6 ) * math_outer ( direction , direction )
enddo
2019-09-20 19:38:21 +05:30
2018-10-03 12:19:23 +05:30
end function lattice_nonSchmidMatrix
2020-02-25 22:02:49 +05:30
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Slip-slip interaction matrix
!> details only active slip systems are considered
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_SlipBySlip ( Nslip , interactionValues , structure ) result ( interactionMatrix )
2019-05-17 02:26:48 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: Nslip !< number of active slip systems per family
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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NslipMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NSLIP , FCC_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONSLIPSLIP = reshape ( [ &
1 , 2 , 2 , 4 , 6 , 5 , 3 , 5 , 5 , 4 , 5 , 6 , 9 , 10 , 9 , 10 , 11 , 12 , & ! -----> acting
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 , & ! |
4 , 6 , 5 , 1 , 2 , 2 , 4 , 5 , 6 , 3 , 5 , 5 , 9 , 10 , 10 , 9 , 12 , 11 , & ! v
6 , 4 , 5 , 2 , 1 , 2 , 5 , 3 , 5 , 5 , 4 , 6 , 9 , 10 , 12 , 11 , 10 , 9 , & ! reacting
5 , 5 , 3 , 2 , 2 , 1 , 6 , 5 , 4 , 5 , 6 , 4 , 11 , 12 , 10 , 9 , 10 , 9 , &
3 , 5 , 5 , 4 , 5 , 6 , 1 , 2 , 2 , 4 , 6 , 5 , 10 , 9 , 10 , 9 , 11 , 12 , &
5 , 4 , 6 , 5 , 3 , 5 , 2 , 1 , 2 , 6 , 4 , 5 , 10 , 9 , 12 , 11 , 9 , 10 , &
5 , 6 , 4 , 6 , 5 , 4 , 2 , 2 , 1 , 5 , 5 , 3 , 12 , 11 , 10 , 9 , 9 , 10 , &
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 , &
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
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 &
] , shape ( FCC_INTERACTIONSLIPSLIP ) ) !< Slip--slip interaction types for fcc
2019-02-17 22:26:48 +05:30
!< 1: self interaction
!< 2: coplanar interaction
!< 3: collinear interaction
!< 4: Hirth locks
!< 5: glissile junctions
!< 6: Lomer locks
!< 7: crossing (similar to Hirth locks in <110>{111} for two {110} planes)
!< 8: similar to Lomer locks in <110>{111} for two {110} planes
!< 9: similar to Lomer locks in <110>{111} btw one {110} and one {111} plane
!<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
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( BCC_NSLIP , BCC_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
BCC_INTERACTIONSLIPSLIP = reshape ( [ &
1 , 2 , 6 , 6 , 5 , 4 , 4 , 3 , 4 , 3 , 5 , 4 , 6 , 6 , 4 , 3 , 3 , 4 , 6 , 6 , 4 , 3 , 6 , 6 , & ! -----> acting
2 , 1 , 6 , 6 , 4 , 3 , 5 , 4 , 5 , 4 , 4 , 3 , 6 , 6 , 3 , 4 , 4 , 3 , 6 , 6 , 3 , 4 , 6 , 6 , & ! |
6 , 6 , 1 , 2 , 4 , 5 , 3 , 4 , 4 , 5 , 3 , 4 , 4 , 3 , 6 , 6 , 6 , 6 , 3 , 4 , 6 , 6 , 4 , 3 , & ! |
6 , 6 , 2 , 1 , 3 , 4 , 4 , 5 , 3 , 4 , 4 , 5 , 3 , 4 , 6 , 6 , 6 , 6 , 4 , 3 , 6 , 6 , 3 , 4 , & ! v
5 , 4 , 4 , 3 , 1 , 2 , 6 , 6 , 3 , 4 , 5 , 4 , 3 , 6 , 4 , 6 , 6 , 4 , 6 , 3 , 4 , 6 , 3 , 6 , & ! reacting
4 , 3 , 5 , 4 , 2 , 1 , 6 , 6 , 4 , 5 , 4 , 3 , 4 , 6 , 3 , 6 , 6 , 3 , 6 , 4 , 3 , 6 , 4 , 6 , &
4 , 5 , 3 , 4 , 6 , 6 , 1 , 2 , 5 , 4 , 3 , 4 , 6 , 3 , 6 , 4 , 4 , 6 , 3 , 6 , 6 , 4 , 6 , 3 , &
3 , 4 , 4 , 5 , 6 , 6 , 2 , 1 , 4 , 3 , 4 , 5 , 6 , 4 , 6 , 3 , 3 , 6 , 4 , 6 , 6 , 3 , 6 , 4 , &
4 , 5 , 4 , 3 , 3 , 4 , 5 , 4 , 1 , 2 , 6 , 6 , 3 , 6 , 6 , 4 , 4 , 6 , 6 , 3 , 6 , 4 , 3 , 6 , &
3 , 4 , 5 , 4 , 4 , 5 , 4 , 3 , 2 , 1 , 6 , 6 , 4 , 6 , 6 , 3 , 3 , 6 , 6 , 4 , 6 , 3 , 4 , 6 , &
5 , 4 , 3 , 4 , 5 , 4 , 3 , 4 , 6 , 6 , 1 , 2 , 6 , 3 , 4 , 6 , 6 , 4 , 3 , 6 , 4 , 6 , 6 , 3 , &
4 , 3 , 4 , 5 , 4 , 3 , 4 , 5 , 6 , 6 , 2 , 1 , 6 , 4 , 3 , 6 , 6 , 3 , 4 , 6 , 3 , 6 , 6 , 4 , &
!
6 , 6 , 4 , 3 , 3 , 4 , 6 , 6 , 3 , 4 , 6 , 6 , 1 , 5 , 6 , 6 , 5 , 6 , 6 , 3 , 5 , 6 , 3 , 6 , &
6 , 6 , 3 , 4 , 6 , 6 , 3 , 4 , 6 , 6 , 3 , 4 , 5 , 1 , 6 , 6 , 6 , 5 , 3 , 6 , 6 , 5 , 6 , 3 , &
4 , 3 , 6 , 6 , 4 , 3 , 6 , 6 , 6 , 6 , 4 , 3 , 6 , 6 , 1 , 5 , 6 , 3 , 5 , 6 , 3 , 6 , 5 , 6 , &
3 , 4 , 6 , 6 , 6 , 6 , 4 , 3 , 4 , 3 , 6 , 6 , 6 , 6 , 5 , 1 , 3 , 6 , 6 , 5 , 6 , 3 , 6 , 5 , &
3 , 4 , 6 , 6 , 6 , 6 , 4 , 3 , 4 , 3 , 6 , 6 , 5 , 6 , 6 , 3 , 1 , 6 , 5 , 6 , 5 , 3 , 6 , 6 , &
4 , 3 , 6 , 6 , 4 , 3 , 6 , 6 , 6 , 6 , 4 , 3 , 6 , 5 , 3 , 6 , 6 , 1 , 6 , 5 , 3 , 5 , 6 , 6 , &
6 , 6 , 3 , 4 , 6 , 6 , 3 , 4 , 6 , 6 , 3 , 4 , 6 , 3 , 5 , 6 , 5 , 6 , 1 , 6 , 6 , 6 , 5 , 3 , &
6 , 6 , 4 , 3 , 3 , 4 , 6 , 6 , 3 , 4 , 6 , 6 , 3 , 6 , 6 , 5 , 6 , 5 , 6 , 1 , 6 , 6 , 3 , 5 , &
4 , 3 , 6 , 6 , 4 , 3 , 6 , 6 , 6 , 6 , 4 , 3 , 5 , 6 , 3 , 6 , 5 , 3 , 6 , 6 , 1 , 6 , 6 , 5 , &
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 &
] , shape ( BCC_INTERACTIONSLIPSLIP ) ) !< Slip--slip interaction types for bcc from Queyreau et al. Int J Plast 25 (2009) 361– 377
2019-02-17 22:26:48 +05:30
!< 1: self interaction
!< 2: coplanar interaction
!< 3: collinear interaction
!< 4: mixed-asymmetrical junction
!< 5: mixed-symmetrical junction
!< 6: edge junction
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( HEX_NSLIP , HEX_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
HEX_INTERACTIONSLIPSLIP = reshape ( [ &
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 , & ! -----> acting
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 , & ! |
2 , 2 , 1 , 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 , & ! |
! ! v
6 , 6 , 6 , 4 , 5 , 5 , 8 , 8 , 8 , 14 , 14 , 14 , 14 , 14 , 14 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 32 , 32 , 32 , 32 , 32 , 32 , & ! reacting
6 , 6 , 6 , 5 , 4 , 5 , 8 , 8 , 8 , 14 , 14 , 14 , 14 , 14 , 14 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 32 , 32 , 32 , 32 , 32 , 32 , &
6 , 6 , 6 , 5 , 5 , 4 , 8 , 8 , 8 , 14 , 14 , 14 , 14 , 14 , 14 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 22 , 32 , 32 , 32 , 32 , 32 , 32 , &
!
12 , 12 , 12 , 11 , 11 , 11 , 9 , 10 , 10 , 15 , 15 , 15 , 15 , 15 , 15 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 33 , 33 , 33 , 33 , 33 , 33 , &
12 , 12 , 12 , 11 , 11 , 11 , 10 , 9 , 10 , 15 , 15 , 15 , 15 , 15 , 15 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 33 , 33 , 33 , 33 , 33 , 33 , &
12 , 12 , 12 , 11 , 11 , 11 , 10 , 10 , 9 , 15 , 15 , 15 , 15 , 15 , 15 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 23 , 33 , 33 , 33 , 33 , 33 , 33 , &
!
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 16 , 17 , 17 , 17 , 17 , 17 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 17 , 16 , 17 , 17 , 17 , 17 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 17 , 17 , 16 , 17 , 17 , 17 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 17 , 17 , 17 , 16 , 17 , 17 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 17 , 17 , 17 , 17 , 16 , 17 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
20 , 20 , 20 , 19 , 19 , 19 , 18 , 18 , 18 , 17 , 17 , 17 , 17 , 17 , 16 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 24 , 34 , 34 , 34 , 34 , 34 , 34 , &
!
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 26 , 35 , 35 , 35 , 35 , 35 , 35 , &
30 , 30 , 30 , 29 , 29 , 29 , 28 , 28 , 28 , 27 , 27 , 27 , 27 , 27 , 27 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 26 , 25 , 35 , 35 , 35 , 35 , 35 , 35 , &
!
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 , 36 , 37 , 37 , 37 , 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 , 36 , 37 , 37 , 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 , 36 , 37 , 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 , 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 &
] , shape ( HEX_INTERACTIONSLIPSLIP ) ) !< Slip--slip interaction types for hex (onion peel naming scheme)
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( BCT_NSLIP , BCT_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
BCT_INTERACTIONSLIPSLIP = reshape ( [ &
1 , 2 , 3 , 3 , 7 , 7 , 13 , 13 , 13 , 13 , 21 , 21 , 31 , 31 , 31 , 31 , 43 , 43 , 57 , 57 , 73 , 73 , 73 , 73 , 91 , 91 , 91 , 91 , 91 , 91 , 91 , 91 , 111 , 111 , 111 , 111 , 133 , 133 , 133 , 133 , 133 , 133 , 133 , 133 , 157 , 157 , 157 , 157 , 157 , 157 , 157 , 157 , & ! -----> acting
2 , 1 , 3 , 3 , 7 , 7 , 13 , 13 , 13 , 13 , 21 , 21 , 31 , 31 , 31 , 31 , 43 , 43 , 57 , 57 , 73 , 73 , 73 , 73 , 91 , 91 , 91 , 91 , 91 , 91 , 91 , 91 , 111 , 111 , 111 , 111 , 133 , 133 , 133 , 133 , 133 , 133 , 133 , 133 , 157 , 157 , 157 , 157 , 157 , 157 , 157 , 157 , & ! |
! |
6 , 6 , 4 , 5 , 8 , 8 , 14 , 14 , 14 , 14 , 22 , 22 , 32 , 32 , 32 , 32 , 44 , 44 , 58 , 58 , 74 , 74 , 74 , 74 , 92 , 92 , 92 , 92 , 92 , 92 , 92 , 92 , 112 , 112 , 112 , 112 , 134 , 134 , 134 , 134 , 134 , 134 , 134 , 134 , 158 , 158 , 158 , 158 , 158 , 158 , 158 , 158 , & ! v
6 , 6 , 5 , 4 , 8 , 8 , 14 , 14 , 14 , 14 , 22 , 22 , 32 , 32 , 32 , 32 , 44 , 44 , 58 , 58 , 74 , 74 , 74 , 74 , 92 , 92 , 92 , 92 , 92 , 92 , 92 , 92 , 112 , 112 , 112 , 112 , 134 , 134 , 134 , 134 , 134 , 134 , 134 , 134 , 158 , 158 , 158 , 158 , 158 , 158 , 158 , 158 , & ! reacting
!
12 , 12 , 11 , 11 , 9 , 10 , 15 , 15 , 15 , 15 , 23 , 23 , 33 , 33 , 33 , 33 , 45 , 45 , 59 , 59 , 75 , 75 , 75 , 75 , 93 , 93 , 93 , 93 , 93 , 93 , 93 , 93 , 113 , 113 , 113 , 113 , 135 , 135 , 135 , 135 , 135 , 135 , 135 , 135 , 159 , 159 , 159 , 159 , 159 , 159 , 159 , 159 , &
12 , 12 , 11 , 11 , 10 , 9 , 15 , 15 , 15 , 15 , 23 , 23 , 33 , 33 , 33 , 33 , 45 , 45 , 59 , 59 , 75 , 75 , 75 , 75 , 93 , 93 , 93 , 93 , 93 , 93 , 93 , 93 , 113 , 113 , 113 , 113 , 135 , 135 , 135 , 135 , 135 , 135 , 135 , 135 , 159 , 159 , 159 , 159 , 159 , 159 , 159 , 159 , &
!
20 , 20 , 19 , 19 , 18 , 18 , 16 , 17 , 17 , 17 , 24 , 24 , 34 , 34 , 34 , 34 , 46 , 46 , 60 , 60 , 76 , 76 , 76 , 76 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 114 , 114 , 114 , 114 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , &
20 , 20 , 19 , 19 , 18 , 18 , 17 , 16 , 17 , 17 , 24 , 24 , 34 , 34 , 34 , 34 , 46 , 46 , 60 , 60 , 76 , 76 , 76 , 76 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 114 , 114 , 114 , 114 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , &
20 , 20 , 19 , 19 , 18 , 18 , 17 , 17 , 16 , 17 , 24 , 24 , 34 , 34 , 34 , 34 , 46 , 46 , 60 , 60 , 76 , 76 , 76 , 76 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 114 , 114 , 114 , 114 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , &
20 , 20 , 19 , 19 , 18 , 18 , 17 , 17 , 17 , 16 , 24 , 24 , 34 , 34 , 34 , 34 , 46 , 46 , 60 , 60 , 76 , 76 , 76 , 76 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 94 , 114 , 114 , 114 , 114 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 136 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , 160 , &
!
30 , 30 , 29 , 29 , 28 , 28 , 27 , 27 , 27 , 27 , 25 , 26 , 35 , 35 , 35 , 35 , 47 , 47 , 61 , 61 , 77 , 77 , 77 , 77 , 95 , 95 , 95 , 95 , 95 , 95 , 95 , 95 , 115 , 115 , 115 , 115 , 137 , 137 , 137 , 137 , 137 , 137 , 137 , 137 , 161 , 161 , 161 , 161 , 161 , 161 , 161 , 161 , &
30 , 30 , 29 , 29 , 28 , 28 , 27 , 27 , 27 , 27 , 26 , 25 , 35 , 35 , 35 , 35 , 47 , 47 , 61 , 61 , 77 , 77 , 77 , 77 , 95 , 95 , 95 , 95 , 95 , 95 , 95 , 95 , 115 , 115 , 115 , 115 , 137 , 137 , 137 , 137 , 137 , 137 , 137 , 137 , 161 , 161 , 161 , 161 , 161 , 161 , 161 , 161 , &
!
42 , 42 , 41 , 41 , 40 , 40 , 39 , 39 , 39 , 39 , 38 , 38 , 36 , 37 , 37 , 37 , 48 , 48 , 62 , 62 , 78 , 78 , 78 , 78 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 116 , 116 , 116 , 116 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , &
42 , 42 , 41 , 41 , 40 , 40 , 39 , 39 , 39 , 39 , 38 , 38 , 37 , 36 , 37 , 37 , 48 , 48 , 62 , 62 , 78 , 78 , 78 , 78 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 116 , 116 , 116 , 116 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , &
42 , 42 , 41 , 41 , 40 , 40 , 39 , 39 , 39 , 39 , 38 , 38 , 37 , 37 , 36 , 37 , 48 , 48 , 62 , 62 , 78 , 78 , 78 , 78 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 116 , 116 , 116 , 116 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , &
42 , 42 , 41 , 41 , 40 , 40 , 39 , 39 , 39 , 39 , 38 , 38 , 37 , 37 , 37 , 36 , 48 , 48 , 62 , 62 , 78 , 78 , 78 , 78 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 96 , 116 , 116 , 116 , 116 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 138 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , 162 , &
!
56 , 56 , 55 , 55 , 54 , 54 , 53 , 53 , 53 , 53 , 52 , 52 , 51 , 51 , 51 , 51 , 49 , 50 , 63 , 63 , 79 , 79 , 79 , 79 , 97 , 97 , 97 , 97 , 97 , 97 , 97 , 97 , 117 , 117 , 117 , 117 , 139 , 139 , 139 , 139 , 139 , 139 , 139 , 139 , 163 , 163 , 163 , 163 , 163 , 163 , 163 , 163 , &
56 , 56 , 55 , 55 , 54 , 54 , 53 , 53 , 53 , 53 , 52 , 52 , 51 , 51 , 51 , 51 , 50 , 49 , 63 , 63 , 79 , 79 , 79 , 79 , 97 , 97 , 97 , 97 , 97 , 97 , 97 , 97 , 117 , 117 , 117 , 117 , 139 , 139 , 139 , 139 , 139 , 139 , 139 , 139 , 163 , 163 , 163 , 163 , 163 , 163 , 163 , 163 , &
!
72 , 72 , 71 , 71 , 70 , 70 , 69 , 69 , 69 , 69 , 68 , 68 , 67 , 67 , 67 , 67 , 66 , 66 , 64 , 65 , 80 , 80 , 80 , 80 , 98 , 98 , 98 , 98 , 98 , 98 , 98 , 98 , 118 , 118 , 118 , 118 , 140 , 140 , 140 , 140 , 140 , 140 , 140 , 140 , 164 , 164 , 164 , 164 , 164 , 164 , 164 , 164 , &
72 , 72 , 71 , 71 , 70 , 70 , 69 , 69 , 69 , 69 , 68 , 68 , 67 , 67 , 67 , 67 , 66 , 66 , 65 , 64 , 80 , 80 , 80 , 80 , 98 , 98 , 98 , 98 , 98 , 98 , 98 , 98 , 118 , 118 , 118 , 118 , 140 , 140 , 140 , 140 , 140 , 140 , 140 , 140 , 164 , 164 , 164 , 164 , 164 , 164 , 164 , 164 , &
!
90 , 90 , 89 , 89 , 88 , 88 , 87 , 87 , 87 , 87 , 86 , 86 , 85 , 85 , 85 , 85 , 84 , 84 , 83 , 83 , 81 , 82 , 82 , 82 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 119 , 119 , 119 , 119 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , &
90 , 90 , 89 , 89 , 88 , 88 , 87 , 87 , 87 , 87 , 86 , 86 , 85 , 85 , 85 , 85 , 84 , 84 , 83 , 83 , 82 , 81 , 82 , 82 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 119 , 119 , 119 , 119 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , &
90 , 90 , 89 , 89 , 88 , 88 , 87 , 87 , 87 , 87 , 86 , 86 , 85 , 85 , 85 , 85 , 84 , 84 , 83 , 83 , 82 , 82 , 81 , 82 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 119 , 119 , 119 , 119 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , &
90 , 90 , 89 , 89 , 88 , 88 , 87 , 87 , 87 , 87 , 86 , 86 , 85 , 85 , 85 , 85 , 84 , 84 , 83 , 83 , 82 , 82 , 82 , 81 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 99 , 119 , 119 , 119 , 119 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 141 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , 165 , &
!
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 100 , 101 , 101 , 101 , 101 , 101 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 100 , 101 , 101 , 101 , 101 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 100 , 101 , 101 , 101 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 101 , 100 , 101 , 101 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 101 , 101 , 100 , 101 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 101 , 101 , 101 , 100 , 101 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 101 , 101 , 101 , 101 , 100 , 101 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
110 , 110 , 109 , 109 , 108 , 108 , 107 , 107 , 107 , 107 , 106 , 106 , 105 , 105 , 105 , 105 , 104 , 104 , 103 , 103 , 102 , 102 , 102 , 102 , 101 , 101 , 101 , 101 , 101 , 101 , 101 , 100 , 120 , 120 , 120 , 120 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 142 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , 166 , &
!
132 , 132 , 131 , 131 , 130 , 130 , 129 , 129 , 129 , 129 , 128 , 128 , 127 , 127 , 127 , 127 , 126 , 126 , 125 , 125 , 124 , 124 , 124 , 124 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 121 , 122 , 122 , 122 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , &
132 , 132 , 131 , 131 , 130 , 130 , 129 , 129 , 129 , 129 , 128 , 128 , 127 , 127 , 127 , 127 , 126 , 126 , 125 , 125 , 124 , 124 , 124 , 124 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 121 , 121 , 122 , 122 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , &
132 , 132 , 131 , 131 , 130 , 130 , 129 , 129 , 129 , 129 , 128 , 128 , 127 , 127 , 127 , 127 , 126 , 126 , 125 , 125 , 124 , 124 , 124 , 124 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 121 , 122 , 121 , 122 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , &
132 , 132 , 131 , 131 , 130 , 130 , 129 , 129 , 129 , 129 , 128 , 128 , 127 , 127 , 127 , 127 , 126 , 126 , 125 , 125 , 124 , 124 , 124 , 124 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 123 , 121 , 122 , 122 , 121 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 143 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , 167 , &
!
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 144 , 145 , 145 , 145 , 145 , 145 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 144 , 145 , 145 , 145 , 145 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 144 , 145 , 145 , 145 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 145 , 144 , 145 , 145 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 145 , 145 , 144 , 145 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 145 , 145 , 145 , 144 , 145 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 145 , 145 , 145 , 145 , 144 , 145 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
156 , 156 , 155 , 155 , 154 , 154 , 153 , 153 , 153 , 153 , 152 , 152 , 151 , 151 , 151 , 151 , 150 , 150 , 149 , 149 , 148 , 148 , 148 , 148 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 147 , 146 , 146 , 146 , 146 , 145 , 145 , 145 , 145 , 145 , 145 , 145 , 144 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , 168 , &
!
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 , 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 , 170 , 169 , 170 , 170 , 170 , 170 , 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 , 170 , 170 , 169 , 170 , 170 , 170 , 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 , 170 , 170 , 170 , 169 , 170 , 170 , 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 , 170 , 170 , 170 , 170 , 169 , 170 , 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 , 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 &
] , shape ( BCT_INTERACTIONSLIPSLIP ) )
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONSLIPSLIP
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2019-04-13 04:16:27 +05:30
interactionTypes = BCC_INTERACTIONSLIPSLIP
2020-03-10 18:15:00 +05:30
NslipMax = BCC_NSLIPSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-04-13 04:16:27 +05:30
interactionTypes = HEX_INTERACTIONSLIPSLIP
2020-03-10 18:15:00 +05:30
NslipMax = HEX_NSLIPSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2019-04-13 04:16:27 +05:30
interactionTypes = BCT_INTERACTIONSLIPSLIP
2020-03-10 18:15:00 +05:30
NslipMax = BCT_NSLIPSYSTEM
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_interaction_SlipBySlip: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Nslip , Nslip , NslipMax , NslipMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_interaction_SlipBySlip
2020-02-25 22:02:49 +05:30
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Twin-twin interaction matrix
!> details only active twin systems are considered
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_TwinByTwin ( Ntwin , interactionValues , structure ) result ( interactionMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: Ntwin !< number of active twin systems per family
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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NtwinMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NTWIN , FCC_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONTWINTWIN = reshape ( [ &
1 , 1 , 1 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , & ! -----> acting
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
2 , 2 , 2 , 1 , 1 , 1 , 2 , 2 , 2 , 2 , 2 , 2 , & ! reacting
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 &
] , shape ( FCC_INTERACTIONTWINTWIN ) ) !< Twin-twin interaction types for fcc
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( BCC_NTWIN , BCC_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
BCC_INTERACTIONTWINTWIN = reshape ( [ &
1 , 3 , 3 , 3 , 3 , 3 , 3 , 2 , 3 , 3 , 2 , 3 , & ! -----> acting
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
3 , 3 , 3 , 2 , 1 , 3 , 3 , 3 , 3 , 2 , 3 , 3 , & ! reacting
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 &
] , shape ( BCC_INTERACTIONTWINTWIN ) ) !< Twin-twin interaction types for bcc
2018-12-10 13:03:20 +05:30
!< 1: self interaction
!< 2: collinear interaction
!< 3: other interaction
2020-03-10 18:15:00 +05:30
integer , dimension ( HEX_NTWIN , HEX_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
HEX_INTERACTIONTWINTWIN = reshape ( [ &
1 , 2 , 2 , 2 , 2 , 2 , 3 , 3 , 3 , 3 , 3 , 3 , 7 , 7 , 7 , 7 , 7 , 7 , 13 , 13 , 13 , 13 , 13 , 13 , & ! -----> acting
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
2 , 2 , 2 , 2 , 1 , 2 , 3 , 3 , 3 , 3 , 3 , 3 , 7 , 7 , 7 , 7 , 7 , 7 , 13 , 13 , 13 , 13 , 13 , 13 , & ! reacting
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 &
] , shape ( HEX_INTERACTIONTWINTWIN ) ) !< Twin-twin interaction types for hex
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONTWINTWIN
2020-03-10 18:15:00 +05:30
NtwinMax = FCC_NTWINSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2019-04-13 04:16:27 +05:30
interactionTypes = BCC_INTERACTIONTWINTWIN
2020-03-10 18:15:00 +05:30
NtwinMax = BCC_NTWINSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-04-13 04:16:27 +05:30
interactionTypes = HEX_INTERACTIONTWINTWIN
2020-03-10 18:15:00 +05:30
NtwinMax = HEX_NTWINSYSTEM
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_interaction_TwinByTwin: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Ntwin , Ntwin , NtwinMax , NtwinMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_interaction_TwinByTwin
2020-02-25 22:02:49 +05:30
2018-12-11 05:09:50 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Trans-trans interaction matrix
!> details only active trans systems are considered
2018-12-11 05:09:50 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_TransByTrans ( Ntrans , interactionValues , structure ) result ( interactionMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NtransMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NTRANS , FCC_NTRANS ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONTRANSTRANS = reshape ( [ &
1 , 1 , 1 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , & ! -----> acting
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
2 , 2 , 2 , 1 , 1 , 1 , 2 , 2 , 2 , 2 , 2 , 2 , & ! reacting
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 &
] , shape ( FCC_INTERACTIONTRANSTRANS ) ) !< Trans-trans interaction types for fcc
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
if ( structure == 'cF' ) then
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONTRANSTRANS
2020-03-10 18:15:00 +05:30
NtransMax = FCC_NTRANSSYSTEM
2019-04-13 04:16:27 +05:30
else
call IO_error ( 137 , ext_msg = 'lattice_interaction_TransByTrans: ' / / trim ( structure ) )
end if
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Ntrans , Ntrans , NtransMax , NtransMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_interaction_TransByTrans
2020-02-25 22:02:49 +05:30
2018-10-03 11:21:11 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Slip-twin interaction matrix
!> details only active slip and twin systems are considered
2018-10-03 11:21:11 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_SlipByTwin ( Nslip , Ntwin , interactionValues , structure ) result ( interactionMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 !< values for slip-twin interaction
character ( len = * ) , intent ( in ) :: structure !< lattice structure
real ( pReal ) , dimension ( sum ( Nslip ) , sum ( Ntwin ) ) :: interactionMatrix
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NslipMax , &
NtwinMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NTWIN , FCC_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONSLIPTWIN = reshape ( [ &
1 , 1 , 1 , 3 , 3 , 3 , 2 , 2 , 2 , 3 , 3 , 3 , & ! -----> twin (acting)
1 , 1 , 1 , 3 , 3 , 3 , 3 , 3 , 3 , 2 , 2 , 2 , & ! |
1 , 1 , 1 , 2 , 2 , 2 , 3 , 3 , 3 , 3 , 3 , 3 , & ! |
2020-02-25 22:02:49 +05:30
3 , 3 , 3 , 1 , 1 , 1 , 3 , 3 , 3 , 2 , 2 , 2 , & ! v
2019-04-13 04:16:27 +05:30
3 , 3 , 3 , 1 , 1 , 1 , 2 , 2 , 2 , 3 , 3 , 3 , & ! slip (reacting)
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 , &
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 &
] , shape ( FCC_INTERACTIONSLIPTWIN ) ) !< Slip-twin interaction types for fcc
2018-12-10 13:03:20 +05:30
!< 1: coplanar interaction
!< 2: screw trace between slip system and twin habit plane (easy cross slip)
!< 3: other interaction
2020-03-10 18:15:00 +05:30
integer , dimension ( BCC_NTWIN , BCC_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
BCC_INTERACTIONSLIPTWIN = reshape ( [ &
3 , 3 , 3 , 2 , 2 , 3 , 3 , 3 , 3 , 2 , 3 , 3 , & ! -----> twin (acting)
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
2 , 3 , 3 , 3 , 3 , 3 , 3 , 2 , 3 , 3 , 2 , 3 , & ! slip (reacting)
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 &
] , shape ( BCC_INTERACTIONSLIPTWIN ) ) !< Slip-twin interaction types for bcc
2018-12-10 13:03:20 +05:30
!< 1: coplanar interaction
!< 2: screw trace between slip system and twin habit plane (easy cross slip)
!< 3: other interaction
2020-03-10 18:15:00 +05:30
integer , dimension ( HEX_NTWIN , HEX_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
HEX_INTERACTIONSLIPTWIN = reshape ( [ &
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 (acting)
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 (reacting)
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 &
!
] , shape ( HEX_INTERACTIONSLIPTWIN ) ) !< Slip-twin interaction types for hex
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONSLIPTWIN
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
NtwinMax = FCC_NTWINSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2019-04-13 04:16:27 +05:30
interactionTypes = BCC_INTERACTIONSLIPTWIN
2020-03-10 18:15:00 +05:30
NslipMax = BCC_NSLIPSYSTEM
NtwinMax = BCC_NTWINSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-04-13 04:16:27 +05:30
interactionTypes = HEX_INTERACTIONSLIPTWIN
2020-03-10 18:15:00 +05:30
NslipMax = HEX_NSLIPSYSTEM
NtwinMax = HEX_NTWINSYSTEM
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_interaction_SlipByTwin: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Nslip , Ntwin , NslipMax , NtwinMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_interaction_SlipByTwin
2020-02-25 22:02:49 +05:30
2018-12-11 05:09:50 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Slip-trans interaction matrix
!> details only active slip and trans systems are considered
2018-12-11 05:09:50 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_SlipByTrans ( Nslip , Ntrans , interactionValues , structure ) result ( interactionMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 !< values for slip-trans interaction
character ( len = * ) , intent ( in ) :: structure !< lattice structure (parent crystal)
real ( pReal ) , dimension ( sum ( Nslip ) , sum ( Ntrans ) ) :: interactionMatrix
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NslipMax , &
NtransMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NTRANS , FCC_NSLIP ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONSLIPTRANS = reshape ( [ &
1 , 1 , 1 , 3 , 3 , 3 , 2 , 2 , 2 , 3 , 3 , 3 , & ! -----> trans (acting)
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
3 , 3 , 3 , 1 , 1 , 1 , 2 , 2 , 2 , 3 , 3 , 3 , & ! slip (reacting)
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 , &
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 &
] , shape ( FCC_INTERACTIONSLIPTRANS ) ) !< Slip-trans interaction types for fcc
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONSLIPTRANS
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
NtransMax = FCC_NTRANSSYSTEM
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_interaction_SlipByTrans: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Nslip , Ntrans , NslipMax , NtransMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
end function lattice_interaction_SlipByTrans
2020-02-25 22:02:49 +05:30
2018-10-03 11:21:11 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Twin-slip interaction matrix
!> details only active twin and slip systems are considered
2018-10-03 11:21:11 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_interaction_TwinBySlip ( Ntwin , Nslip , interactionValues , structure ) result ( interactionMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 !< values for twin-twin interaction
character ( len = * ) , intent ( in ) :: structure !< lattice structure
real ( pReal ) , dimension ( sum ( Ntwin ) , sum ( Nslip ) ) :: interactionMatrix
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , allocatable :: NtwinMax , &
NslipMax
integer , dimension ( : , : ) , allocatable :: interactionTypes
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( FCC_NSLIP , FCC_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
FCC_INTERACTIONTWINSLIP = 1 !< Twin-slip interaction types for fcc
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( BCC_NSLIP , BCC_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
BCC_INTERACTIONTWINSLIP = 1 !< Twin-slip interaction types for bcc
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( HEX_NSLIP , HEX_NTWIN ) , parameter :: &
2019-04-13 04:16:27 +05:30
HEX_INTERACTIONTWINSLIP = reshape ( [ &
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 (acting)
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 (reacting)
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 &
] , shape ( HEX_INTERACTIONTWINSLIP ) ) !< Twin-slip interaction types for hex
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2019-04-13 04:16:27 +05:30
interactionTypes = FCC_INTERACTIONTWINSLIP
2020-03-10 18:15:00 +05:30
NtwinMax = FCC_NTWINSYSTEM
NslipMax = FCC_NSLIPSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2019-04-13 04:16:27 +05:30
interactionTypes = BCC_INTERACTIONTWINSLIP
2020-03-10 18:15:00 +05:30
NtwinMax = BCC_NTWINSYSTEM
NslipMax = BCC_NSLIPSYSTEM
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-04-13 04:16:27 +05:30
interactionTypes = HEX_INTERACTIONTWINSLIP
2020-03-10 18:15:00 +05:30
NtwinMax = HEX_NTWINSYSTEM
NslipMax = HEX_NSLIPSYSTEM
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_interaction_TwinBySlip: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
interactionMatrix = buildInteraction ( Ntwin , Nslip , NtwinMax , NslipMax , interactionValues , interactionTypes )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_interaction_TwinBySlip
2020-02-25 22:02:49 +05:30
2018-08-25 22:02:55 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Schmid matrix for slip
!> details only active slip systems are considered
2018-08-25 22:02:55 +05:30
!--------------------------------------------------------------------------------------------------
2018-09-12 17:59:22 +05:30
function lattice_SchmidMatrix_slip ( Nslip , structure , cOverA ) result ( SchmidMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Nslip ) ) :: coordinateSystem
real ( pReal ) , dimension ( : , : ) , allocatable :: slipSystems
integer , dimension ( : ) , allocatable :: NslipMax
integer :: i
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
slipSystems = FCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCC_NSLIPSYSTEM
slipSystems = BCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-03-10 18:15:00 +05:30
NslipMax = HEX_NSLIPSYSTEM
slipSystems = HEX_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCT_NSLIPSYSTEM
slipSystems = BCT_SYSTEMSLIP
2019-04-13 04:16:27 +05:30
case default
2020-05-16 02:03:38 +05:30
allocate ( NslipMax ( 0 ) )
2019-04-13 04:16:27 +05:30
call IO_error ( 137 , ext_msg = 'lattice_SchmidMatrix_slip: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
if ( any ( NslipMax ( 1 : size ( Nslip ) ) - Nslip < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Nslip ' / / trim ( structure ) )
if ( any ( Nslip < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Nslip ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = buildCoordinateSystem ( Nslip , NslipMax , slipSystems , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Nslip )
SchmidMatrix ( 1 : 3 , 1 : 3 , i ) = math_outer ( coordinateSystem ( 1 : 3 , 1 , i ) , coordinateSystem ( 1 : 3 , 2 , i ) )
if ( abs ( math_trace33 ( SchmidMatrix ( 1 : 3 , 1 : 3 , i ) ) ) > tol_math_check ) &
call IO_error ( 0 , i , ext_msg = 'dilatational Schmid matrix for slip' )
enddo
2020-02-25 22:02:49 +05:30
2018-09-12 17:33:45 +05:30
end function lattice_SchmidMatrix_slip
2020-02-25 22:02:49 +05:30
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Schmid matrix for twinning
!> details only active twin systems are considered
2018-08-25 16:38:32 +05:30
!--------------------------------------------------------------------------------------------------
2018-10-07 23:33:45 +05:30
function lattice_SchmidMatrix_twin ( Ntwin , structure , cOverA ) result ( SchmidMatrix )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntwin ) ) :: coordinateSystem
real ( pReal ) , dimension ( : , : ) , allocatable :: twinSystems
integer , dimension ( : ) , allocatable :: NtwinMax
integer :: i
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NtwinMax = FCC_NTWINSYSTEM
twinSystems = FCC_SYSTEMTWIN
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NtwinMax = BCC_NTWINSYSTEM
twinSystems = BCC_SYSTEMTWIN
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-03-10 18:15:00 +05:30
NtwinMax = HEX_NTWINSYSTEM
twinSystems = HEX_SYSTEMTWIN
2019-04-13 04:16:27 +05:30
case default
2020-05-16 02:03:38 +05:30
allocate ( NtwinMax ( 0 ) )
2019-04-13 04:16:27 +05:30
call IO_error ( 137 , ext_msg = 'lattice_SchmidMatrix_twin: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
if ( any ( NtwinMax ( 1 : size ( Ntwin ) ) - Ntwin < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Ntwin ' / / trim ( structure ) )
if ( any ( Ntwin < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Ntwin ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = buildCoordinateSystem ( Ntwin , NtwinMax , twinSystems , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ntwin )
SchmidMatrix ( 1 : 3 , 1 : 3 , i ) = math_outer ( coordinateSystem ( 1 : 3 , 1 , i ) , coordinateSystem ( 1 : 3 , 2 , i ) )
if ( abs ( math_trace33 ( SchmidMatrix ( 1 : 3 , 1 : 3 , i ) ) ) > tol_math_check ) &
call IO_error ( 0 , i , ext_msg = 'dilatational Schmid matrix for twin' )
enddo
2020-02-25 22:02:49 +05:30
2019-09-21 06:46:08 +05:30
end function lattice_SchmidMatrix_twin
2020-02-25 22:02:49 +05:30
2018-12-22 12:19:52 +05:30
!--------------------------------------------------------------------------------------------------
!> @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 )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: Ntrans !< number of active twin systems per family
character ( len = * ) , intent ( in ) :: structure_target !< lattice structure
2019-09-21 06:46:08 +05:30
real ( pReal ) , intent ( in ) :: cOverA !< c/a ratio
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntrans ) ) :: SchmidMatrix
2020-02-25 22:02:49 +05:30
2019-10-10 15:40:13 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntrans ) ) :: devNull
real ( pReal ) :: a_bcc , a_fcc
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
if ( structure_target / = 'cI' . and . structure_target / = 'hP' ) &
2019-09-21 06:46:08 +05:30
call IO_error ( 137 , ext_msg = 'lattice_SchmidMatrix_trans: ' / / trim ( structure_target ) )
2020-11-29 03:07:03 +05:30
if ( structure_target == 'hP' . and . ( cOverA < 1.0_pReal . or . cOverA > 2.0_pReal ) ) &
2019-09-21 06:46:08 +05:30
call IO_error ( 131 , ext_msg = 'lattice_SchmidMatrix_trans: ' / / trim ( structure_target ) )
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
if ( structure_target == 'cI' . and . ( a_bcc < = 0.0_pReal . or . a_fcc < = 0.0_pReal ) ) &
2019-09-21 06:46:08 +05:30
call IO_error ( 134 , ext_msg = 'lattice_SchmidMatrix_trans: ' / / trim ( structure_target ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
call buildTransformationSystem ( devNull , SchmidMatrix , Ntrans , cOverA , a_fcc , a_bcc )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
end function lattice_SchmidMatrix_trans
2020-02-25 22:02:49 +05:30
2018-10-16 01:59:23 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Schmid matrix for cleavage
!> details only active cleavage systems are considered
2018-10-16 01:59:23 +05:30
!--------------------------------------------------------------------------------------------------
function lattice_SchmidMatrix_cleavage ( Ncleavage , structure , cOverA ) result ( SchmidMatrix )
2019-05-17 02:26:48 +05:30
2019-04-13 04:16:27 +05:30
integer , 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
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Ncleavage ) ) :: coordinateSystem
real ( pReal ) , dimension ( : , : ) , allocatable :: cleavageSystems
integer , dimension ( : ) , allocatable :: NcleavageMax
integer :: i
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'oP' )
2020-03-10 18:15:00 +05:30
NcleavageMax = ORT_NCLEAVAGESYSTEM
cleavageSystems = ORT_SYSTEMCLEAVAGE
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NcleavageMax = FCC_NCLEAVAGESYSTEM
cleavageSystems = FCC_SYSTEMCLEAVAGE
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NcleavageMax = BCC_NCLEAVAGESYSTEM
cleavageSystems = BCC_SYSTEMCLEAVAGE
2019-04-13 04:16:27 +05:30
case default
2020-05-16 02:03:38 +05:30
allocate ( NcleavageMax ( 0 ) )
2019-04-13 04:16:27 +05:30
call IO_error ( 137 , ext_msg = 'lattice_SchmidMatrix_cleavage: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
if ( any ( NcleavageMax ( 1 : size ( Ncleavage ) ) - Ncleavage < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Ncleavage ' / / trim ( structure ) )
if ( any ( Ncleavage < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Ncleavage ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = buildCoordinateSystem ( Ncleavage , NcleavageMax , cleavageSystems , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ncleavage )
SchmidMatrix ( 1 : 3 , 1 : 3 , 1 , i ) = math_outer ( coordinateSystem ( 1 : 3 , 1 , i ) , coordinateSystem ( 1 : 3 , 2 , i ) )
SchmidMatrix ( 1 : 3 , 1 : 3 , 2 , i ) = math_outer ( coordinateSystem ( 1 : 3 , 3 , i ) , coordinateSystem ( 1 : 3 , 2 , i ) )
SchmidMatrix ( 1 : 3 , 1 : 3 , 3 , i ) = math_outer ( coordinateSystem ( 1 : 3 , 2 , i ) , coordinateSystem ( 1 : 3 , 2 , i ) )
enddo
2020-02-25 22:02:49 +05:30
2018-10-16 01:59:23 +05:30
end function lattice_SchmidMatrix_cleavage
2020-02-25 22:02:49 +05:30
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
!> @brief Slip direction of slip systems (|| b)
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_slip_direction ( Nslip , structure , cOverA ) result ( d )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 ( 3 , sum ( Nslip ) ) :: d
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Nslip ) ) :: coordinateSystem
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = coordinateSystem_slip ( Nslip , structure , cOverA )
d = coordinateSystem ( 1 : 3 , 1 , 1 : sum ( Nslip ) )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_slip_direction
2020-02-25 22:02:49 +05:30
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
!> @brief Normal direction of slip systems (|| n)
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
function lattice_slip_normal ( Nslip , structure , cOverA ) result ( n )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 ( 3 , sum ( Nslip ) ) :: n
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Nslip ) ) :: coordinateSystem
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = coordinateSystem_slip ( Nslip , structure , cOverA )
n = coordinateSystem ( 1 : 3 , 2 , 1 : sum ( Nslip ) )
2020-02-25 22:02:49 +05:30
2019-03-12 03:11:59 +05:30
end function lattice_slip_normal
2019-02-20 12:23:34 +05:30
2019-04-13 04:16:27 +05:30
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
2019-03-12 03:11:59 +05:30
!> @brief Transverse direction of slip systems ( || t = b x n)
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
function lattice_slip_transverse ( Nslip , structure , cOverA ) result ( t )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 ( 3 , sum ( Nslip ) ) :: t
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 , 3 , sum ( Nslip ) ) :: coordinateSystem
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = coordinateSystem_slip ( Nslip , structure , cOverA )
t = coordinateSystem ( 1 : 3 , 3 , 1 : sum ( Nslip ) )
2020-02-25 22:02:49 +05:30
2019-02-20 12:23:34 +05:30
end function lattice_slip_transverse
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Labels for slip systems
!> details only active slip systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_labels_slip ( Nslip , structure ) result ( labels )
integer , dimension ( : ) , intent ( in ) :: Nslip !< number of active slip systems per family
character ( len = * ) , intent ( in ) :: structure !< lattice structure
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
character ( len = : ) , dimension ( : ) , allocatable :: labels
real ( pReal ) , dimension ( : , : ) , allocatable :: slipSystems
integer , dimension ( : ) , allocatable :: NslipMax
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
slipSystems = FCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCC_NSLIPSYSTEM
slipSystems = BCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-03-10 18:15:00 +05:30
NslipMax = HEX_NSLIPSYSTEM
slipSystems = HEX_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCT_NSLIPSYSTEM
slipSystems = BCT_SYSTEMSLIP
2019-10-10 16:41:02 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_labels_slip: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
if ( any ( NslipMax ( 1 : size ( Nslip ) ) - Nslip < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Nslip ' / / trim ( structure ) )
if ( any ( Nslip < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Nslip ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2020-01-03 18:03:32 +05:30
labels = getLabels ( Nslip , NslipMax , slipSystems )
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
end function lattice_labels_slip
2020-02-26 22:32:47 +05:30
!--------------------------------------------------------------------------------------------------
2020-03-10 10:43:54 +05:30
!> @brief Return 3x3 tensor with symmetry according to given crystal structure
2020-02-26 22:32:47 +05:30
!--------------------------------------------------------------------------------------------------
2020-03-10 10:43:54 +05:30
function lattice_applyLatticeSymmetry33 ( T , structure ) result ( T_sym )
2020-02-29 16:50:40 +05:30
real ( pReal ) , dimension ( 3 , 3 ) :: T_sym
real ( pReal ) , dimension ( 3 , 3 ) , intent ( in ) :: T
character ( len = * ) , intent ( in ) :: structure
2020-02-26 22:32:47 +05:30
integer :: k
2020-02-29 16:50:40 +05:30
T_sym = 0.0_pReal
2020-02-26 22:32:47 +05:30
2020-02-29 16:50:40 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'aP' , 'cF' , 'cI' )
2020-02-26 22:32:47 +05:30
do k = 1 , 3
2020-02-29 16:50:40 +05:30
T_sym ( k , k ) = T ( 1 , 1 )
2020-02-26 22:32:47 +05:30
enddo
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-02-29 16:50:40 +05:30
T_sym ( 1 , 1 ) = T ( 1 , 1 )
T_sym ( 2 , 2 ) = T ( 1 , 1 )
T_sym ( 3 , 3 ) = T ( 3 , 3 )
2020-11-29 03:07:03 +05:30
case ( 'oP' , 'tI' )
2020-02-29 16:50:40 +05:30
T_sym ( 1 , 1 ) = T ( 1 , 1 )
T_sym ( 2 , 2 ) = T ( 2 , 2 )
T_sym ( 3 , 3 ) = T ( 3 , 3 )
2020-02-26 22:32:47 +05:30
case default
2020-03-10 10:43:54 +05:30
call IO_error ( 137 , ext_msg = 'lattice_applyLatticeSymmetry33: ' / / trim ( structure ) )
2020-02-26 22:32:47 +05:30
end select
2020-03-10 10:43:54 +05:30
end function lattice_applyLatticeSymmetry33
2020-02-26 22:32:47 +05:30
!--------------------------------------------------------------------------------------------------
2020-03-10 10:43:54 +05:30
!> @brief Return stiffness matrix in 6x6 notation with symmetry according to given crystal structure
2020-02-26 22:32:47 +05:30
!> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962
!--------------------------------------------------------------------------------------------------
2020-03-10 10:43:54 +05:30
function applyLatticeSymmetryC66 ( C66 , structure ) result ( C66_sym )
2020-02-29 19:04:19 +05:30
real ( pReal ) , dimension ( 6 , 6 ) :: C66_sym
2020-02-26 22:32:47 +05:30
real ( pReal ) , dimension ( 6 , 6 ) , intent ( in ) :: C66
2020-02-29 19:04:19 +05:30
character ( len = * ) , intent ( in ) :: structure
2020-02-26 22:32:47 +05:30
integer :: j , k
2020-02-29 19:04:19 +05:30
C66_sym = 0.0_pReal
2020-02-26 22:32:47 +05:30
2020-02-29 19:04:19 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'aP' )
2020-02-26 22:32:47 +05:30
do k = 1 , 3
do j = 1 , 3
2020-02-29 19:04:19 +05:30
C66_sym ( k , j ) = C66 ( 1 , 2 )
2020-02-26 22:32:47 +05:30
enddo
2020-02-29 19:04:19 +05:30
C66_sym ( k , k ) = C66 ( 1 , 1 )
C66_sym ( k + 3 , k + 3 ) = 0.5_pReal * ( C66 ( 1 , 1 ) - C66 ( 1 , 2 ) )
2020-02-26 22:32:47 +05:30
enddo
2020-11-29 03:07:03 +05:30
case ( 'cF' , 'cI' )
2020-02-26 22:32:47 +05:30
do k = 1 , 3
do j = 1 , 3
2020-02-29 19:04:19 +05:30
C66_sym ( k , j ) = C66 ( 1 , 2 )
2020-02-26 22:32:47 +05:30
enddo
2020-02-29 19:04:19 +05:30
C66_sym ( k , k ) = C66 ( 1 , 1 )
C66_sym ( k + 3 , k + 3 ) = C66 ( 4 , 4 )
2020-02-26 22:32:47 +05:30
enddo
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-02-29 19:04:19 +05:30
C66_sym ( 1 , 1 ) = C66 ( 1 , 1 )
C66_sym ( 2 , 2 ) = C66 ( 1 , 1 )
C66_sym ( 3 , 3 ) = C66 ( 3 , 3 )
C66_sym ( 1 , 2 ) = C66 ( 1 , 2 )
C66_sym ( 2 , 1 ) = C66 ( 1 , 2 )
C66_sym ( 1 , 3 ) = C66 ( 1 , 3 )
C66_sym ( 3 , 1 ) = C66 ( 1 , 3 )
C66_sym ( 2 , 3 ) = C66 ( 1 , 3 )
C66_sym ( 3 , 2 ) = C66 ( 1 , 3 )
C66_sym ( 4 , 4 ) = C66 ( 4 , 4 )
C66_sym ( 5 , 5 ) = C66 ( 4 , 4 )
C66_sym ( 6 , 6 ) = 0.5_pReal * ( C66 ( 1 , 1 ) - C66 ( 1 , 2 ) )
2020-11-29 03:07:03 +05:30
case ( 'oP' )
2020-02-29 19:04:19 +05:30
C66_sym ( 1 , 1 ) = C66 ( 1 , 1 )
C66_sym ( 2 , 2 ) = C66 ( 2 , 2 )
C66_sym ( 3 , 3 ) = C66 ( 3 , 3 )
C66_sym ( 1 , 2 ) = C66 ( 1 , 2 )
C66_sym ( 2 , 1 ) = C66 ( 1 , 2 )
C66_sym ( 1 , 3 ) = C66 ( 1 , 3 )
C66_sym ( 3 , 1 ) = C66 ( 1 , 3 )
C66_sym ( 2 , 3 ) = C66 ( 2 , 3 )
C66_sym ( 3 , 2 ) = C66 ( 2 , 3 )
C66_sym ( 4 , 4 ) = C66 ( 4 , 4 )
C66_sym ( 5 , 5 ) = C66 ( 5 , 5 )
C66_sym ( 6 , 6 ) = C66 ( 6 , 6 )
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2020-02-29 19:04:19 +05:30
C66_sym ( 1 , 1 ) = C66 ( 1 , 1 )
C66_sym ( 2 , 2 ) = C66 ( 1 , 1 )
C66_sym ( 3 , 3 ) = C66 ( 3 , 3 )
C66_sym ( 1 , 2 ) = C66 ( 1 , 2 )
C66_sym ( 2 , 1 ) = C66 ( 1 , 2 )
C66_sym ( 1 , 3 ) = C66 ( 1 , 3 )
C66_sym ( 3 , 1 ) = C66 ( 1 , 3 )
C66_sym ( 2 , 3 ) = C66 ( 1 , 3 )
C66_sym ( 3 , 2 ) = C66 ( 1 , 3 )
C66_sym ( 4 , 4 ) = C66 ( 4 , 4 )
C66_sym ( 5 , 5 ) = C66 ( 4 , 4 )
C66_sym ( 6 , 6 ) = C66 ( 6 , 6 )
2020-02-26 22:32:47 +05:30
case default
2020-03-10 10:43:54 +05:30
call IO_error ( 137 , ext_msg = 'applyLatticeSymmetryC66: ' / / trim ( structure ) )
2020-02-26 22:32:47 +05:30
end select
2020-03-10 10:43:54 +05:30
end function applyLatticeSymmetryC66
2020-02-26 22:32:47 +05:30
2019-10-10 16:41:02 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Labels for twin systems
!> details only active twin systems are considered
!--------------------------------------------------------------------------------------------------
function lattice_labels_twin ( Ntwin , structure ) result ( labels )
integer , dimension ( : ) , intent ( in ) :: Ntwin !< number of active slip systems per family
character ( len = * ) , intent ( in ) :: structure !< lattice structure
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
character ( len = : ) , dimension ( : ) , allocatable :: labels
real ( pReal ) , dimension ( : , : ) , allocatable :: twinSystems
integer , dimension ( : ) , allocatable :: NtwinMax
2020-02-25 22:02:49 +05:30
2020-02-29 21:34:29 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NtwinMax = FCC_NTWINSYSTEM
twinSystems = FCC_SYSTEMTWIN
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NtwinMax = BCC_NTWINSYSTEM
twinSystems = BCC_SYSTEMTWIN
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-03-10 18:15:00 +05:30
NtwinMax = HEX_NTWINSYSTEM
twinSystems = HEX_SYSTEMTWIN
2019-10-10 16:41:02 +05:30
case default
call IO_error ( 137 , ext_msg = 'lattice_labels_twin: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
if ( any ( NtwinMax ( 1 : size ( Ntwin ) ) - Ntwin < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Ntwin ' / / trim ( structure ) )
if ( any ( Ntwin < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Ntwin ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2020-01-03 18:03:32 +05:30
labels = getLabels ( Ntwin , NtwinMax , twinSystems )
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
end function lattice_labels_twin
2020-02-29 21:34:29 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Projection of the transverse direction onto the slip plane
!> @details: This projection is used to calculate forest hardening for edge dislocations
!--------------------------------------------------------------------------------------------------
function slipProjection_transverse ( Nslip , structure , cOverA ) result ( projection )
integer , 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 , sum ( Nslip ) ) :: n , t
integer :: i , j
n = lattice_slip_normal ( Nslip , structure , cOverA )
t = lattice_slip_transverse ( Nslip , structure , cOverA )
do i = 1 , sum ( Nslip ) ; do j = 1 , sum ( Nslip )
projection ( i , j ) = abs ( math_inner ( n ( : , i ) , t ( : , j ) ) )
enddo ; enddo
end function slipProjection_transverse
2019-02-20 04:25:59 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Projection of the slip direction onto the slip plane
2019-03-09 17:18:01 +05:30
!> @details: This projection is used to calculate forest hardening for screw dislocations
2019-02-20 04:25:59 +05:30
!--------------------------------------------------------------------------------------------------
function slipProjection_direction ( Nslip , structure , cOverA ) result ( projection )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , 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
2020-02-25 22:02:49 +05:30
2019-09-21 21:46:58 +05:30
real ( pReal ) , dimension ( 3 , sum ( Nslip ) ) :: n , d
integer :: i , j
2020-02-25 22:02:49 +05:30
2019-09-21 21:46:58 +05:30
n = lattice_slip_normal ( Nslip , structure , cOverA )
d = lattice_slip_direction ( Nslip , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Nslip ) ; do j = 1 , sum ( Nslip )
2019-09-21 21:46:58 +05:30
projection ( i , j ) = abs ( math_inner ( n ( : , i ) , d ( : , j ) ) )
2019-04-13 04:16:27 +05:30
enddo ; enddo
2020-02-25 22:02:49 +05:30
2019-02-20 04:25:59 +05:30
end function slipProjection_direction
2020-02-25 22:02:49 +05:30
2019-02-20 12:23:34 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief build a local coordinate system on slip systems
!> @details Order: Direction, plane (normal), and common perpendicular
!--------------------------------------------------------------------------------------------------
function coordinateSystem_slip ( Nslip , structure , cOverA ) result ( coordinateSystem )
2019-05-17 02:26:48 +05:30
2019-04-13 04:16:27 +05:30
integer , 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 ( 3 , 3 , sum ( Nslip ) ) :: coordinateSystem
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable :: slipSystems
integer , dimension ( : ) , allocatable :: NslipMax
2020-02-25 22:02:49 +05:30
2020-02-29 21:33:01 +05:30
select case ( structure )
2020-11-29 03:07:03 +05:30
case ( 'cF' )
2020-03-10 18:15:00 +05:30
NslipMax = FCC_NSLIPSYSTEM
slipSystems = FCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'cI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCC_NSLIPSYSTEM
slipSystems = BCC_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2020-03-10 18:15:00 +05:30
NslipMax = HEX_NSLIPSYSTEM
slipSystems = HEX_SYSTEMSLIP
2020-11-29 03:07:03 +05:30
case ( 'tI' )
2020-03-10 18:15:00 +05:30
NslipMax = BCT_NSLIPSYSTEM
slipSystems = BCT_SYSTEMSLIP
2019-04-13 04:16:27 +05:30
case default
2020-05-16 02:03:38 +05:30
allocate ( NslipMax ( 0 ) )
2019-04-13 04:16:27 +05:30
call IO_error ( 137 , ext_msg = 'coordinateSystem_slip: ' / / trim ( structure ) )
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
if ( any ( NslipMax ( 1 : size ( Nslip ) ) - Nslip < 0 ) ) &
call IO_error ( 145 , ext_msg = 'Nslip ' / / trim ( structure ) )
if ( any ( Nslip < 0 ) ) &
call IO_error ( 144 , ext_msg = 'Nslip ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
coordinateSystem = buildCoordinateSystem ( Nslip , NslipMax , slipSystems , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-02-20 12:23:34 +05:30
end function coordinateSystem_slip
2020-02-25 22:02:49 +05:30
2018-09-08 23:02:26 +05:30
!--------------------------------------------------------------------------------------------------
2020-03-16 15:44:27 +05:30
!> @brief Populate reduced interaction matrix
2018-09-08 23:02:26 +05:30
!--------------------------------------------------------------------------------------------------
2019-04-13 04:16:27 +05:30
function buildInteraction ( reacting_used , acting_used , reacting_max , acting_max , values , matrix )
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
integer , dimension ( : ) , intent ( in ) :: &
reacting_used , & !< # of reacting systems per family as specified in material.config
acting_used , & !< # of acting systems per family as specified in material.config
reacting_max , & !< max # of reacting systems per family for given lattice
acting_max !< max # of acting systems per family for given lattice
real ( pReal ) , dimension ( : ) , intent ( in ) :: values !< interaction values
integer , dimension ( : , : ) , intent ( in ) :: matrix !< interaction types
real ( pReal ) , dimension ( sum ( reacting_used ) , sum ( acting_used ) ) :: buildInteraction
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
integer :: &
acting_family_index , acting_family , acting_system , &
reacting_family_index , reacting_family , reacting_system , &
i , j , k , l
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
do acting_family = 1 , size ( acting_used , 1 )
acting_family_index = sum ( acting_used ( 1 : acting_family - 1 ) )
do acting_system = 1 , acting_used ( acting_family )
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
do reacting_family = 1 , size ( reacting_used , 1 )
reacting_family_index = sum ( reacting_used ( 1 : reacting_family - 1 ) )
do reacting_system = 1 , reacting_used ( reacting_family )
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
i = sum ( acting_max ( 1 : acting_family - 1 ) ) + acting_system
j = sum ( reacting_max ( 1 : reacting_family - 1 ) ) + reacting_system
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
k = acting_family_index + acting_system
l = reacting_family_index + reacting_system
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
if ( matrix ( i , j ) > size ( values ) ) call IO_error ( 138 , ext_msg = 'buildInteraction' )
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
buildInteraction ( l , k ) = values ( matrix ( i , j ) )
2020-02-25 22:02:49 +05:30
2020-02-26 22:25:19 +05:30
enddo ; enddo
enddo ; enddo
2020-02-25 22:02:49 +05:30
2018-08-25 16:38:32 +05:30
end function buildInteraction
2020-02-25 22:02:49 +05:30
2018-08-25 22:02:55 +05:30
!--------------------------------------------------------------------------------------------------
2020-03-16 15:44:27 +05:30
!> @brief Build a local coordinate system on slip, twin, trans, cleavage systems
2018-12-12 04:59:19 +05:30
!> @details Order: Direction, plane (normal), and common perpendicular
2018-08-25 22:02:55 +05:30
!--------------------------------------------------------------------------------------------------
2019-10-10 15:56:45 +05:30
function buildCoordinateSystem ( active , potential , system , structure , cOverA )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: &
2020-01-03 16:30:19 +05:30
active , & !< # of active systems per family
potential !< # of potential systems per family
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( : , : ) , intent ( in ) :: &
system
character ( len = * ) , intent ( in ) :: &
structure !< lattice structure
real ( pReal ) , intent ( in ) :: &
cOverA
real ( pReal ) , dimension ( 3 , 3 , sum ( active ) ) :: &
2020-03-17 04:01:43 +05:30
buildCoordinateSystem
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
real ( pReal ) , dimension ( 3 ) :: &
direction , normal
integer :: &
a , & !< index of active system
2019-10-10 15:56:45 +05:30
p , & !< index in potential system matrix
2019-04-13 04:16:27 +05:30
f , & !< index of my family
s !< index of my system in current family
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
if ( structure == 'tI' . and . cOverA > 2.0_pReal ) &
2019-04-13 04:16:27 +05:30
call IO_error ( 131 , ext_msg = 'buildCoordinateSystem:' / / trim ( structure ) )
2020-11-29 03:07:03 +05:30
if ( structure == 'hP' . and . ( cOverA < 1.0_pReal . or . cOverA > 2.0_pReal ) ) &
2019-04-13 04:16:27 +05:30
call IO_error ( 131 , ext_msg = 'buildCoordinateSystem:' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
a = 0
activeFamilies : do f = 1 , size ( active , 1 )
activeSystems : do s = 1 , active ( f )
a = a + 1
2019-10-10 15:56:45 +05:30
p = sum ( potential ( 1 : f - 1 ) ) + s
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
select case ( structure )
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
case ( 'cF' , 'cI' , 'aP' , 'oP' , 'tI' )
2019-10-10 15:56:45 +05:30
direction = system ( 1 : 3 , p )
normal = system ( 4 : 6 , p )
2020-02-25 22:02:49 +05:30
2020-11-29 03:07:03 +05:30
case ( 'hP' )
2019-10-10 15:56:45 +05:30
direction = [ system ( 1 , p ) * 1.5_pReal , &
( system ( 1 , p ) + 2.0_pReal * system ( 2 , p ) ) * sqrt ( 0.75_pReal ) , &
system ( 4 , p ) * cOverA ] ! direction [uvtw]->[3u/2 (u+2v)*sqrt(3)/2 w*(p/a)])
normal = [ system ( 5 , p ) , &
( system ( 5 , p ) + 2.0_pReal * system ( 6 , p ) ) / sqrt ( 3.0_pReal ) , &
system ( 8 , p ) / cOverA ] ! plane (hkil)->(h (h+2k)/sqrt(3) l/(p/a))
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
case default
call IO_error ( 137 , ext_msg = 'buildCoordinateSystem: ' / / trim ( structure ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
end select
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
buildCoordinateSystem ( 1 : 3 , 1 , a ) = direction / norm2 ( direction )
2019-10-10 15:40:13 +05:30
buildCoordinateSystem ( 1 : 3 , 2 , a ) = normal / norm2 ( normal )
buildCoordinateSystem ( 1 : 3 , 3 , a ) = math_cross ( direction / norm2 ( direction ) , &
normal / norm2 ( normal ) )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
enddo activeSystems
enddo activeFamilies
2020-02-25 22:02:49 +05:30
2018-08-25 22:02:55 +05:30
end function buildCoordinateSystem
2020-02-25 22:02:49 +05:30
2018-12-12 03:30:56 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-12 04:59:19 +05:30
!> @brief Helper function to define transformation systems
2018-12-22 12:19:52 +05:30
! Needed to calculate Schmid matrix and rotated stiffness matrices.
! @details: set c/a = 0.0 for fcc -> bcc transformation
2019-09-21 06:46:08 +05:30
! set a_Xcc = 0.0 for fcc -> hex transformation
2018-12-12 03:30:56 +05:30
!--------------------------------------------------------------------------------------------------
2018-12-22 12:19:52 +05:30
subroutine buildTransformationSystem ( Q , S , Ntrans , cOverA , a_fcc , a_bcc )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
integer , dimension ( : ) , intent ( in ) :: &
Ntrans
real ( pReal ) , dimension ( 3 , 3 , sum ( Ntrans ) ) , intent ( out ) :: &
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
2020-02-25 22:02:49 +05:30
2019-09-20 19:38:21 +05:30
type ( rotation ) :: &
2019-04-13 04:16:27 +05:30
R , & !< Pitsch rotation
2020-02-25 22:02:49 +05:30
B !< Rotation of fcc to Bain coordinate system
2019-09-20 19:38:21 +05:30
real ( pReal ) , dimension ( 3 , 3 ) :: &
2019-04-13 04:16:27 +05:30
U , & !< Bain deformation
ss , sd
real ( pReal ) , dimension ( 3 ) :: &
x , y , z
integer :: &
i
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 3 + 3 , FCC_NTRANS ) , parameter :: &
FCCTOHEX_SYSTEMTRANS = reshape ( real ( [ &
2019-04-13 04:16:27 +05:30
- 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 &
2020-03-10 18:15:00 +05:30
] , pReal ) , shape ( FCCTOHEX_SYSTEMTRANS ) )
real ( pReal ) , dimension ( 4 , fcc_Ntrans ) , parameter :: &
FCCTOBCC_SYSTEMTRANS = reshape ( [ &
2019-04-13 04:16:27 +05:30
0.0 , 1.0 , 0.0 , 1 0.26 , & ! Pitsch OR (Ma & Hartmaier 2014, Table 3)
2019-09-20 19:38:21 +05:30
0.0 , - 1.0 , 0.0 , 1 0.26 , &
2019-04-13 04:16:27 +05:30
0.0 , 0.0 , 1.0 , 1 0.26 , &
2019-09-20 19:38:21 +05:30
0.0 , 0.0 , - 1.0 , 1 0.26 , &
2019-04-13 04:16:27 +05:30
1.0 , 0.0 , 0.0 , 1 0.26 , &
2019-09-20 19:38:21 +05:30
- 1.0 , 0.0 , 0.0 , 1 0.26 , &
2019-04-13 04:16:27 +05:30
0.0 , 0.0 , 1.0 , 1 0.26 , &
2019-09-20 19:38:21 +05:30
0.0 , 0.0 , - 1.0 , 1 0.26 , &
2019-04-13 04:16:27 +05:30
1.0 , 0.0 , 0.0 , 1 0.26 , &
2019-09-20 19:38:21 +05:30
- 1.0 , 0.0 , 0.0 , 1 0.26 , &
2019-04-13 04:16:27 +05:30
0.0 , 1.0 , 0.0 , 1 0.26 , &
2019-09-20 19:38:21 +05:30
0.0 , - 1.0 , 0.0 , 1 0.26 &
2020-03-10 18:15:00 +05:30
] , shape ( FCCTOBCC_SYSTEMTRANS ) )
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
integer , dimension ( 9 , fcc_Ntrans ) , parameter :: &
FCCTOBCC_BAINVARIANT = reshape ( [ &
2019-04-13 04:16:27 +05:30
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 &
2020-03-10 18:15:00 +05:30
] , shape ( FCCTOBCC_BAINVARIANT ) )
2020-02-25 22:02:49 +05:30
2020-03-10 18:15:00 +05:30
real ( pReal ) , dimension ( 4 , fcc_Ntrans ) , parameter :: &
FCCTOBCC_BAINROT = reshape ( [ &
2019-04-13 04:16:27 +05:30
1.0 , 0.0 , 0.0 , 4 5.0 , & ! Rotate fcc austensite to bain variant
1.0 , 0.0 , 0.0 , 4 5.0 , &
1.0 , 0.0 , 0.0 , 4 5.0 , &
1.0 , 0.0 , 0.0 , 4 5.0 , &
0.0 , 1.0 , 0.0 , 4 5.0 , &
0.0 , 1.0 , 0.0 , 4 5.0 , &
0.0 , 1.0 , 0.0 , 4 5.0 , &
0.0 , 1.0 , 0.0 , 4 5.0 , &
0.0 , 0.0 , 1.0 , 4 5.0 , &
0.0 , 0.0 , 1.0 , 4 5.0 , &
0.0 , 0.0 , 1.0 , 4 5.0 , &
0.0 , 0.0 , 1.0 , 4 5.0 &
2020-03-10 18:15:00 +05:30
] , shape ( FCCTOBCC_BAINROT ) )
2020-02-25 22:02:49 +05:30
2019-09-21 06:46:08 +05:30
if ( a_bcc > 0.0_pReal . and . a_fcc > 0.0_pReal . and . dEq0 ( cOverA ) ) then ! fcc -> bcc transformation
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ntrans )
2020-03-10 18:15:00 +05:30
call R % fromAxisAngle ( FCCTOBCC_SYSTEMTRANS ( : , i ) , degrees = . true . , P = 1 )
call B % fromAxisAngle ( FCCTOBCC_BAINROT ( : , i ) , degrees = . true . , P = 1 )
x = real ( FCCTOBCC_BAINVARIANT ( 1 : 3 , i ) , pReal )
y = real ( FCCTOBCC_BAINVARIANT ( 4 : 6 , i ) , pReal )
z = real ( FCCTOBCC_BAINVARIANT ( 7 : 9 , i ) , pReal )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
U = ( a_bcc / a_fcc ) * math_outer ( x , x ) &
+ ( a_bcc / a_fcc ) * math_outer ( y , y ) * sqrt ( 2.0_pReal ) &
+ ( a_bcc / a_fcc ) * math_outer ( z , z ) * sqrt ( 2.0_pReal )
2019-09-21 05:48:09 +05:30
Q ( 1 : 3 , 1 : 3 , i ) = matmul ( R % asMatrix ( ) , B % asMatrix ( ) )
S ( 1 : 3 , 1 : 3 , i ) = matmul ( R % asMatrix ( ) , U ) - MATH_I3
2019-04-13 04:16:27 +05:30
enddo
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
2019-09-21 06:46:08 +05:30
sd ( 3 , 3 ) = cOverA / sqrt ( 8.0_pReal / 3.0_pReal )
2020-02-25 22:02:49 +05:30
2019-04-13 04:16:27 +05:30
do i = 1 , sum ( Ntrans )
2020-03-10 18:15:00 +05:30
x = FCCTOHEX_SYSTEMTRANS ( 1 : 3 , i ) / norm2 ( FCCTOHEX_SYSTEMTRANS ( 1 : 3 , i ) )
z = FCCTOHEX_SYSTEMTRANS ( 4 : 6 , i ) / norm2 ( FCCTOHEX_SYSTEMTRANS ( 4 : 6 , i ) )
2019-04-13 04:16:27 +05:30
y = - math_cross ( 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 ) = matmul ( Q ( 1 : 3 , 1 : 3 , i ) , matmul ( matmul ( sd , ss ) , transpose ( Q ( 1 : 3 , 1 : 3 , i ) ) ) ) - MATH_I3 ! ToDo: This is of interest for the Schmid matrix only
enddo
else
2019-09-21 06:46:08 +05:30
call IO_error ( 132 , ext_msg = 'buildTransformationSystem' )
2019-04-13 04:16:27 +05:30
endif
2019-09-20 19:38:21 +05:30
2018-12-22 12:19:52 +05:30
end subroutine buildTransformationSystem
2019-10-10 16:41:02 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief select active systems as strings
!--------------------------------------------------------------------------------------------------
2020-01-03 17:10:25 +05:30
function getlabels ( active , potential , system ) result ( labels )
2020-02-25 22:02:49 +05:30
2020-01-03 16:30:19 +05:30
integer , dimension ( : ) , intent ( in ) :: &
active , & !< # of active systems per family
potential !< # of potential systems per family
real ( pReal ) , dimension ( : , : ) , intent ( in ) :: &
2019-10-10 16:41:02 +05:30
system
character ( len = : ) , dimension ( : ) , allocatable :: labels
character ( len = : ) , allocatable :: label
2020-02-25 22:02:49 +05:30
integer :: i , j
2019-10-10 16:41:02 +05:30
integer :: &
a , & !< index of active system
2019-10-18 20:43:19 +05:30
p , & !< index in potential system matrix
2019-10-10 16:41:02 +05:30
f , & !< index of my family
s !< index of my system in current family
i = 2 * size ( system , 1 ) + ( size ( system , 1 ) - 2 ) + 4 ! 2 letters per index + spaces + brackets
allocate ( character ( len = i ) :: labels ( sum ( active ) ) , label )
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
a = 0
activeFamilies : do f = 1 , size ( active , 1 )
activeSystems : do s = 1 , active ( f )
a = a + 1
p = sum ( potential ( 1 : f - 1 ) ) + s
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
i = 1
2020-01-03 16:30:19 +05:30
label ( i : i ) = '['
2019-10-10 16:41:02 +05:30
direction : do j = 1 , size ( system , 1 ) / 2
2020-03-13 12:31:25 +05:30
write ( label ( i + 1 : i + 2 ) , '(I2.1)' ) int ( system ( j , p ) )
2019-10-10 16:41:02 +05:30
label ( i + 3 : i + 3 ) = ' '
i = i + 3
enddo direction
label ( i : i ) = ']'
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
i = i + 1
2020-01-03 16:30:19 +05:30
label ( i : i ) = '('
2019-10-10 16:41:02 +05:30
normal : do j = size ( system , 1 ) / 2 + 1 , size ( system , 1 )
2020-03-13 12:31:25 +05:30
write ( label ( i + 1 : i + 2 ) , '(I2.1)' ) int ( system ( j , p ) )
2019-10-10 16:41:02 +05:30
label ( i + 3 : i + 3 ) = ' '
i = i + 3
enddo normal
label ( i : i ) = ')'
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
labels ( s ) = label
enddo activeSystems
enddo activeFamilies
2020-02-25 22:02:49 +05:30
2019-10-10 16:41:02 +05:30
end function getlabels
2020-03-13 12:31:25 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Equivalent Poisson's ratio (ν )
!> @details https://doi.org/10.1143/JPSJ.20.635
!--------------------------------------------------------------------------------------------------
2020-12-28 15:33:29 +05:30
function lattice_equivalent_nu ( C , assumption ) result ( nu )
2020-03-13 12:31:25 +05:30
2020-03-14 18:23:21 +05:30
real ( pReal ) , dimension ( 6 , 6 ) , intent ( in ) :: C !< Stiffness tensor (Voigt notation)
character ( len = * ) , intent ( in ) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
real ( pReal ) :: K , mu , nu
2020-12-28 15:33:29 +05:30
2020-03-14 18:23:21 +05:30
logical :: error
real ( pReal ) , dimension ( 6 , 6 ) :: S
2020-03-13 12:31:25 +05:30
2020-12-28 15:33:29 +05:30
2020-03-13 12:31:25 +05:30
if ( IO_lc ( assumption ) == 'voigt' ) then
K = ( C ( 1 , 1 ) + C ( 2 , 2 ) + C ( 3 , 3 ) + 2.0_pReal * ( C ( 1 , 2 ) + C ( 2 , 3 ) + C ( 1 , 3 ) ) ) &
/ 9.0_pReal
elseif ( IO_lc ( assumption ) == 'reuss' ) then
call math_invert ( S , error , C )
2020-11-11 20:27:05 +05:30
if ( error ) error stop 'matrix inversion failed'
2020-03-13 12:31:25 +05:30
K = 1.0_pReal &
/ ( S ( 1 , 1 ) + S ( 2 , 2 ) + S ( 3 , 3 ) + 2.0_pReal * ( S ( 1 , 2 ) + S ( 2 , 3 ) + S ( 1 , 3 ) ) )
else
2020-11-11 20:27:05 +05:30
error stop 'invalid assumption'
2020-03-13 12:31:25 +05:30
K = 0.0_pReal
endif
2020-12-28 15:33:29 +05:30
mu = lattice_equivalent_mu ( C , assumption )
2020-03-13 12:31:25 +05:30
nu = ( 1.5_pReal * K - mu ) / ( 3.0_pReal * K + mu )
2020-12-28 15:33:29 +05:30
end function lattice_equivalent_nu
2020-03-13 12:31:25 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Equivalent shear modulus (μ)
!> @details https://doi.org/10.1143/JPSJ.20.635
!--------------------------------------------------------------------------------------------------
2020-12-28 15:33:29 +05:30
function lattice_equivalent_mu ( C , assumption ) result ( mu )
2020-03-13 12:31:25 +05:30
2020-03-14 18:23:21 +05:30
real ( pReal ) , dimension ( 6 , 6 ) , intent ( in ) :: C !< Stiffness tensor (Voigt notation)
character ( len = * ) , intent ( in ) :: assumption !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
real ( pReal ) :: mu
2020-12-28 15:33:29 +05:30
2020-03-14 18:23:21 +05:30
logical :: error
real ( pReal ) , dimension ( 6 , 6 ) :: S
2020-03-13 12:31:25 +05:30
2020-12-28 15:33:29 +05:30
2020-03-13 12:31:25 +05:30
if ( IO_lc ( assumption ) == 'voigt' ) then
mu = ( 1.0_pReal * ( C ( 1 , 1 ) + C ( 2 , 2 ) + C ( 3 , 3 ) ) - 1.0_pReal * ( C ( 1 , 2 ) + C ( 2 , 3 ) + C ( 1 , 3 ) ) + 3.0_pReal * ( C ( 4 , 4 ) + C ( 5 , 5 ) + C ( 6 , 6 ) ) ) &
/ 1 5.0_pReal
elseif ( IO_lc ( assumption ) == 'reuss' ) then
call math_invert ( S , error , C )
2020-11-11 20:27:05 +05:30
if ( error ) error stop 'matrix inversion failed'
2020-03-13 12:31:25 +05:30
mu = 1 5.0_pReal &
/ ( 4.0_pReal * ( S ( 1 , 1 ) + S ( 2 , 2 ) + S ( 3 , 3 ) ) - 4.0_pReal * ( S ( 1 , 2 ) + S ( 2 , 3 ) + S ( 1 , 3 ) ) + 3.0_pReal * ( S ( 4 , 4 ) + S ( 5 , 5 ) + S ( 6 , 6 ) ) )
else
2020-11-11 20:27:05 +05:30
error stop 'invalid assumption'
2020-03-13 12:31:25 +05:30
mu = 0.0_pReal
endif
2020-12-28 15:33:29 +05:30
end function lattice_equivalent_mu
2020-03-13 12:31:25 +05:30
2020-03-14 21:59:08 +05:30
!--------------------------------------------------------------------------------------------------
2020-09-13 15:39:32 +05:30
!> @brief Check correctness of some lattice functions.
2020-03-14 21:59:08 +05:30
!--------------------------------------------------------------------------------------------------
2020-05-16 20:35:03 +05:30
subroutine selfTest
2020-03-14 21:59:08 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable :: CoSy
real ( pReal ) , dimension ( : , : ) , allocatable :: system
real ( pReal ) , dimension ( 6 , 6 ) :: C
real ( pReal ) , dimension ( 2 ) :: r
real ( pReal ) :: lambda
call random_number ( r )
system = reshape ( [ 1.0_pReal + r ( 1 ) , 0.0_pReal , 0.0_pReal , 0.0_pReal , 1.0_pReal + r ( 2 ) , 0.0_pReal ] , [ 6 , 1 ] )
2020-11-29 03:07:03 +05:30
CoSy = buildCoordinateSystem ( [ 1 ] , [ 1 ] , system , 'cF' , 0.0_pReal )
2020-09-13 15:39:32 +05:30
if ( any ( dNeq ( CoSy ( 1 : 3 , 1 : 3 , 1 ) , math_I3 ) ) ) error stop 'buildCoordinateSystem'
2020-03-14 21:59:08 +05:30
call random_number ( C )
C ( 1 , 1 ) = C ( 1 , 1 ) + 1.0_pReal
2020-11-29 03:07:03 +05:30
C = applyLatticeSymmetryC66 ( C , 'aP' )
2020-12-28 15:33:29 +05:30
if ( dNeq ( C ( 6 , 6 ) , lattice_equivalent_mu ( C , 'voigt' ) , 1.0e-12_pReal ) ) error stop 'equivalent_mu/voigt'
if ( dNeq ( C ( 6 , 6 ) , lattice_equivalent_mu ( C , 'voigt' ) , 1.0e-12_pReal ) ) error stop 'equivalent_mu/reuss'
2020-11-29 03:07:03 +05:30
2020-03-14 21:59:08 +05:30
lambda = C ( 1 , 2 )
2020-12-28 15:33:29 +05:30
if ( dNeq ( lambda * 0.5_pReal / ( lambda + lattice_equivalent_mu ( C , 'voigt' ) ) , &
lattice_equivalent_nu ( C , 'voigt' ) , 1.0e-12_pReal ) ) error stop 'equivalent_nu/voigt'
if ( dNeq ( lambda * 0.5_pReal / ( lambda + lattice_equivalent_mu ( C , 'reuss' ) ) , &
lattice_equivalent_nu ( C , 'reuss' ) , 1.0e-12_pReal ) ) error stop 'equivalent_nu/reuss'
2020-03-14 21:59:08 +05:30
2020-05-16 20:35:03 +05:30
end subroutine selfTest
2020-03-14 21:59:08 +05:30
2014-08-14 17:51:51 +05:30
end module lattice