From eaf65e56658a15c7ebcd5b707c6d722117a885e1 Mon Sep 17 00:00:00 2001
From: Martin Diehl <mail@martin-diehl.net>
Date: Wed, 22 Nov 2023 20:31:35 +0100
Subject: [PATCH] loop not needed

---
 src/crystal.f90 | 30 ++++++++++++++----------------
 1 file changed, 14 insertions(+), 16 deletions(-)

diff --git a/src/crystal.f90 b/src/crystal.f90
index 8f0b0bfb7..6690955bf 100644
--- a/src/crystal.f90
+++ b/src/crystal.f90
@@ -431,9 +431,8 @@ function crystal_characteristicShear_Twin(Ntwin,lattice,CoverA) result(character
   real(pREAL), dimension(sum(Ntwin))               :: characteristicShear
 
   integer :: &
-    a, &                                                                                            !< index of active system
     f, &                                                                                            !< index of my family
-    s                                                                                               !< index of my system in current family
+    s, e
 
   integer, dimension(size(HP_NTWINSYSTEM)), parameter :: &
     HP_SHEARTWIN = [&
@@ -450,21 +449,20 @@ 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')
-      a = 0
+
       myFamilies: do f = 1,size(Ntwin,1)
-        mySystems: do s = 1,Ntwin(f)
-          a = a + 1
-          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}
-              characteristicShear(a) = 1.0_pREAL/cOverA
-            case (3)                                                                                ! <10.-2>{10.1}
-              characteristicShear(a) = (4.0_pREAL*cOverA**2-9.0_pREAL)/sqrt(48.0_pREAL)/cOverA
-            case (4)                                                                                ! <11.-3>{11.2}
-              characteristicShear(a) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
-          end select
-        end do mySystems
+        s = sum(Ntwin(:f-1)) + 1
+        e = sum(Ntwin(:f))
+        select case(HP_SHEARTWIN(f))                                                              ! from Christian & Mahajan 1995 p.29
+          case (1)                                                                                ! <-10.1>{10.2}
+            characteristicShear(s:e) = (3.0_pREAL-cOverA**2)/sqrt(3.0_pREAL)/CoverA
+          case (2)                                                                                ! <11.6>{-1-1.1}
+            characteristicShear(s:e) = 1.0_pREAL/cOverA
+          case (3)                                                                                ! <10.-2>{10.1}
+            characteristicShear(s:e) = (4.0_pREAL*cOverA**2-9.0_pREAL)/sqrt(48.0_pREAL)/cOverA
+          case (4)                                                                                ! <11.-3>{11.2}
+            characteristicShear(s:e) = 2.0_pREAL*(cOverA**2-2.0_pREAL)/3.0_pREAL/cOverA
+        end select
       end do myFamilies
     case default
       call IO_error(137,ext_msg='crystal_characteristicShear_Twin: '//trim(lattice))