From b77a4145d0b96560e88e11e4e1df216f16b4abf9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 20 Nov 2023 19:31:56 +0100 Subject: [PATCH] no need to expand, is a property of the family --- src/crystal.f90 | 33 ++++++--------------------------- 1 file changed, 6 insertions(+), 27 deletions(-) diff --git a/src/crystal.f90 b/src/crystal.f90 index 62679e309..8e820b515 100644 --- a/src/crystal.f90 +++ b/src/crystal.f90 @@ -432,37 +432,17 @@ function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character integer :: & a, & !< index of active system - p, & !< index in potential system list f, & !< index of my family s !< index of my system in current family - integer, dimension(HP_NTWIN), parameter :: & - HP_SHEARTWIN = reshape( [& + integer, dimension(size(HP_NTWINSYSTEM)), parameter :: & + HP_SHEARTWIN = [& 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 & - ],[HP_NTWIN]) !< indicator to formulas below + 4 & ! <11.-3>{11.2} + ] !< indicator to formulas below + a = 0 myFamilies: do f = 1,size(Ntwin,1) @@ -474,8 +454,7 @@ function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character case('hP') if (cOverA < 1.0_pREAL .or. cOverA > 2.0_pREAL) & call IO_error(131,ext_msg='crystal_characteristicShear_Twin') - p = sum(HP_NTWINSYSTEM(1:f-1))+s - select case(HP_SHEARTWIN(p)) ! from Christian & Mahajan 1995 p.29 + select case(HP_SHEARTWIN(f)) ! from Christian & Mahajan 1995 p.29 case (1) ! <-10.1>{10.2} characteristicShear(a) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA case (2) ! <11.6>{-1-1.1}