Improve tests and faster SIMD.

app/runtime_error_detection/Randomized.F90

@@ -2,13 +2,16 @@ program Randomized
   use iso_fortran_env, only: error_unit
   use MAC, only: container
   use WannInt_kinds, only: wp => dp
+  use WannInt_definitions, only: cmplx_1
   use WannInt, only: crystal
 
   implicit none
 
-  integer, parameter :: minbnd = 20, maxbnd = 300, &
-                        minnr = 500, maxnr = 3000, &
-                        minder = 1, maxder = 10
+  integer, parameter :: minbnd = 20, maxbnd = 200, &
+                        minnr = 500, maxnr = 2000, &
+                        minder = 1, maxder = 6
+
+  real(wp), parameter :: tol = 1.0E2_wp
 
   real(wp) :: rnd, &
               rnbnd, rnr, rnder
@@ -108,6 +111,9 @@ subroutine random_exec_h_b1(nbnd, nr, nder)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -118,6 +124,8 @@ subroutine random_exec_h_b1(nbnd, nr, nder)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     alloc_container_res = dummy%hamiltonian(kpt=[0.0_wp, 0.0_wp, 0.0_wp], derivative=nder, all=.true.)
+    if (abs(abs(alloc_container_res(1)%cdp_storage(1))/real(dummy%nrpts()) - 1.0_wp) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_h_b1
 
@@ -139,6 +147,9 @@ subroutine random_exec_h_b2(nbnd, nr, nder)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -149,6 +160,8 @@ subroutine random_exec_h_b2(nbnd, nr, nder)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     contained_res = dummy%hamiltonian(kpt=[0.0_wp, 0.0_wp, 0.0_wp], derivative=nder)
+    if (abs(abs(contained_res%cdp_storage(1))/real(dummy%nrpts())) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_h_b2
 
@@ -170,6 +183,9 @@ subroutine random_exec_h_b3(nbnd, nr)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -180,6 +196,8 @@ subroutine random_exec_h_b3(nbnd, nr)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     resH = dummy%hamiltonian(kpt=[0.0_wp, 0.0_wp, 0.0_wp])
+    if(abs(abs(resH(1, 1))/real(dummy%nrpts()) - 1.0_wp) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_h_b3
 
@@ -201,6 +219,9 @@ subroutine random_exec_a_b1(nbnd, nr, nder)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -211,6 +232,8 @@ subroutine random_exec_a_b1(nbnd, nr, nder)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     alloc_container_res = dummy%berry_connection(kpt=[0.0_wp, 0.0_wp, 0.0_wp], derivative=nder, all=.true.)
+    if(abs(abs(alloc_container_res(1)%cdp_storage(1))/real(dummy%nrpts()) - 1.0_wp) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_a_b1
 
@@ -232,6 +255,9 @@ subroutine random_exec_a_b2(nbnd, nr, nder)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -242,6 +268,8 @@ subroutine random_exec_a_b2(nbnd, nr, nder)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     contained_res = dummy%berry_connection(kpt=[0.0_wp, 0.0_wp, 0.0_wp], derivative=nder)
+    if(abs(abs(contained_res%cdp_storage(1))/real(dummy%nrpts())) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_a_b2
 
@@ -263,6 +291,9 @@ subroutine random_exec_a_b3(nbnd, nr)
     dlb(2, :) = [0.0_wp, 1.0_wp, 0.0_wp]
     dlb(3, :) = [0.0_wp, 0.0_wp, 1.0_wp]
 
+    tunnellings = cmplx_1
+    dipoles = cmplx_1
+
     call dummy%construct(name="dummy", &
                          direct_lattice_basis=dlb, &
                          num_bands=nbnd, &
@@ -273,6 +304,8 @@ subroutine random_exec_a_b3(nbnd, nr)
 
     write (error_unit, fmt="(A)") "All variables allocated."
     resA = dummy%berry_connection(kpt=[0.0_wp, 0.0_wp, 0.0_wp])
+    if(abs(abs(resA(1, 1, 1))/real(dummy%nrpts()) - 1.0_wp) > tol*epsilon(1.0_wp)) &
+    error stop "Mismatch with reference."
 
   end subroutine random_exec_a_b3
 

src/WannInt.F90

@@ -143,14 +143,14 @@ subroutine construct_from_input(self, name, &
 
     self%num_R_points = size(R_points(:, 1))
 
-    allocate (self%R_points(self%num_R_points, 3), &
+    allocate (self%R_points(3, self%num_R_points), &
               self%deg_R_points(self%num_R_points), stat=istat)
     if (istat /= 0) then
       write (errormsg, "(i20)") istat
       errormsg = "WannInt: Error #5: failure allocating R_points and deg_R_points. stat = "//trim(adjustl(errormsg))//"."
       error stop trim(errormsg)
     endif
-    self%R_points = R_points
+    self%R_points = transpose(R_points)
     self%deg_R_points = 1
 
     allocate (self%real_space_hamiltonian_elements(self%num_R_points, self%bands, self%bands), &
@@ -237,7 +237,7 @@ subroutine construct_from_file(self, name, &
 
     read (unit=stdin, fmt=*) self%num_R_points
 
-    allocate (self%R_points(self%num_R_points, 3), &
+    allocate (self%R_points(3, self%num_R_points), &
               self%deg_R_points(self%num_R_points), stat=istat)
     if (istat /= 0) then
       write (errormsg, "(i20)") istat
@@ -279,7 +279,7 @@ subroutine construct_from_file(self, name, &
     endif
     self%real_space_hamiltonian_elements = cmplx_0
     do irpts = 1, self%num_R_points
-      read (unit=stdin, fmt=*) (self%R_points(irpts, i), i=1, 3)
+      read (unit=stdin, fmt=*) (self%R_points(i, irpts), i=1, 3)
       do i = 1, self%bands
         do j = 1, self%bands
           read (unit=stdin, fmt=*) dummy1, dummy2, dummyR(1), dummyR(2)
@@ -386,7 +386,7 @@ pure function rpts(self)
     integer :: rpts(self%num_R_points, 3)
     if (.not. (self%is_initialized)) error stop &
       "WannInt: Error #6: crystal is not initialized."
-    rpts = self%R_points
+    rpts = transpose(self%R_points)
   end function rpts
 
   pure function deg_rpts(self)
@@ -546,12 +546,12 @@ function hamiltonian_der_driver(self, k, der)
 
         !Compute factor appearing in the exponential.
         !(k is in coords relative to recip. lattice vectors).
-        kdotr = 2.0_wp*pi*dot_product(self%R_points(irpts, :), k)
+        kdotr = 2.0_wp*pi*dot_product(self%R_points(:, irpts), k)
 
         !Compute Bravais lattice vector for label irpts.
         vec = 0.0_wp
         do i = 1, 3
-          vec = vec + self%R_points(irpts, i)*self%direct_l_b(i, :)
+          vec = vec + self%R_points(i, irpts)*self%direct_l_b(i, :)
         enddo
 
         prod_r = 1.0_wp
@@ -694,12 +694,12 @@ function berry_der_driver(self, k, der)
 
         !Compute factor appearing in the exponential.
         !(k is in coords relative to recip. lattice vectors).
-        kdotr = 2.0_wp*pi*dot_product(self%R_points(irpts, :), k)
+        kdotr = 2.0_wp*pi*dot_product(self%R_points(:, irpts), k)
 
         !Compute Bravais lattice vector for label irpts.
         vec = 0.0_wp
         do i = 1, 3
-          vec = vec + self%R_points(irpts, i)*self%direct_l_b(i, :)
+          vec = vec + self%R_points(i, irpts)*self%direct_l_b(i, :)
         enddo
 
         prod_r = 1.0_wp