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

not needed

This commit is contained in:
Martin Diehl 2020-11-11 13:59:37 +01:00
parent 5531f892c3
commit 8e89452791
1 changed files with 0 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/lattice.f90
View File

@ -588,9 +588,6 @@ function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(charact
4 &
],[HEX_NTWIN]) ! indicator to formulas below
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_characteristicShear_Twin: '//trim(structure))
a = 0
myFamilies: do f = 1,size(Ntwin,1)
mySystems: do s = 1,Ntwin(f)
@ -636,9 +633,6 @@ function lattice_C66_twin(Ntwin,C66,structure,CoverA)
type(rotation) :: R
integer :: i
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_C66_twin: '//trim(structure))
select case(structure)
case('fcc')
coordinateSystem = buildCoordinateSystem(Ntwin,FCC_NSLIPSYSTEM,FCC_SYSTEMTWIN,&
@ -966,9 +960,6 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) resul
],shape(BCT_INTERACTIONSLIPSLIP))
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_SlipBySlip: '//trim(structure))
select case(structure)
case('fcc')
interactionTypes = FCC_INTERACTIONSLIPSLIP
@ -1070,9 +1061,6 @@ function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) resul
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
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_TwinByTwin: '//trim(structure))
select case(structure)
case('fcc')
interactionTypes = FCC_INTERACTIONTWINTWIN
@ -1122,9 +1110,6 @@ function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) re
2,2,2,2,2,2,2,2,2,1,1,1 &
],shape(FCC_INTERACTIONTRANSTRANS)) !< Trans-trans interaction types for fcc
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_TransByTrans: '//trim(structure))
if(structure == 'fcc') then
interactionTypes = FCC_INTERACTIONTRANSTRANS
NtransMax = FCC_NTRANSSYSTEM
@ -1252,9 +1237,6 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure)
!
],shape(HEX_INTERACTIONSLIPTWIN)) !< Slip-twin interaction types for hex
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_SlipByTwin: '//trim(structure))
select case(structure)
case('fcc')
interactionTypes = FCC_INTERACTIONSLIPTWIN
@ -1316,9 +1298,6 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structur
4,4,4,4,4,4,4,4,4,4,4,4 &
],shape(FCC_INTERACTIONSLIPTRANS)) !< Slip-trans interaction types for fcc
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_SlipByTrans: '//trim(structure))
select case(structure)
case('fcc')
interactionTypes = FCC_INTERACTIONSLIPTRANS
@ -1386,9 +1365,6 @@ function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure)
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
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_interaction_TwinBySlip: '//trim(structure))
select case(structure)
case('fcc')
interactionTypes = FCC_INTERACTIONTWINSLIP
@ -1427,9 +1403,6 @@ function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
integer, dimension(:), allocatable :: NslipMax
integer :: i
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_SchmidMatrix_slip: '//trim(structure))
select case(structure)
case('fcc')
NslipMax = FCC_NSLIPSYSTEM
@ -1480,9 +1453,6 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
integer, dimension(:), allocatable :: NtwinMax
integer :: i
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_SchmidMatrix_twin: '//trim(structure))
select case(structure)
case('fcc')
NtwinMax = FCC_NTWINSYSTEM
@ -1560,9 +1530,6 @@ function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(Schmid
integer, dimension(:), allocatable :: NcleavageMax
integer :: i
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_SchmidMatrix_cleavage: '//trim(structure))
select case(structure)
case('ort')
NcleavageMax = ORT_NCLEAVAGESYSTEM
@ -1662,9 +1629,6 @@ function lattice_labels_slip(Nslip,structure) result(labels)
real(pReal), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_labels_slip: '//trim(structure))
select case(structure)
case('fcc')
NslipMax = FCC_NSLIPSYSTEM
@ -1706,9 +1670,6 @@ function lattice_applyLatticeSymmetry33(T,structure) result(T_sym)
T_sym = 0.0_pReal
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_applyLatticeSymmetry33: '//trim(structure))
select case(structure)
case('iso','fcc','bcc')
do k=1,3
@ -1744,9 +1705,6 @@ function applyLatticeSymmetryC66(C66,structure) result(C66_sym)
C66_sym = 0.0_pReal
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='applyLatticeSymmetryC66: '//trim(structure))
select case(structure)
case ('iso')
do k=1,3
@ -1824,9 +1782,6 @@ function lattice_labels_twin(Ntwin,structure) result(labels)
real(pReal), dimension(:,:), allocatable :: twinSystems
integer, dimension(:), allocatable :: NtwinMax
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='lattice_labels_twin: '//trim(structure))
select case(structure)
case('fcc')
NtwinMax = FCC_NTWINSYSTEM
@ -1913,9 +1868,6 @@ function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem)
real(pReal), dimension(:,:), allocatable :: slipSystems
integer, dimension(:), allocatable :: NslipMax
if (len_trim(structure) /= 3) &
call IO_error(137,ext_msg='coordinateSystem_slip: '//trim(structure))
select case(structure)
case('fcc')
NslipMax = FCC_NSLIPSYSTEM