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

more logical order

This commit is contained in:
Martin Diehl 2023-11-22 20:22:05 +01:00
parent f6c463d2a6
commit 34db73b068
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/crystal.f90
View File

@ -444,16 +444,16 @@ function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
] !< indicator to formulas below ] !< indicator to formulas below
a = 0 select case(lattice)
myFamilies: do f = 1,size(Ntwin,1) case('cF','cI')
mySystems: do s = 1,Ntwin(f) characteristicShear = 0.5_pREAL*sqrt(2.0_pREAL)
a = a + 1 case('hP')
select case(lattice) if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) &
case('cF','cI') call IO_error(131,ext_msg='crystal_characteristicShear_Twin')
characteristicShear(a) = 0.5_pREAL*sqrt(2.0_pREAL) a = 0
case('hP') myFamilies: do f = 1,size(Ntwin,1)
if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) & mySystems: do s = 1,Ntwin(f)
call IO_error(131,ext_msg='crystal_characteristicShear_Twin') a = a + 1
select case(HP_SHEARTWIN(f)) ! from Christian & Mahajan 1995 p.29 select case(HP_SHEARTWIN(f)) ! from Christian & Mahajan 1995 p.29
case (1) ! <-10.1>{10.2} case (1) ! <-10.1>{10.2}
characteristicShear(a) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA characteristicShear(a) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA
@ -464,11 +464,11 @@ function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
case (4) ! <11.-3>{11.2} case (4) ! <11.-3>{11.2}
characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
end select end select
case default end do mySystems
call IO_error(137,ext_msg='crystal_characteristicShear_Twin: '//trim(lattice)) end do myFamilies
end select case default
end do mySystems call IO_error(137,ext_msg='crystal_characteristicShear_Twin: '//trim(lattice))
end do myFamilies end select
end function crystal_characteristicShear_Twin end function crystal_characteristicShear_Twin