add generic-rank tests

Author: perazz

include/common.fypp

@@ -338,6 +338,34 @@ ${prefix + joinstr.join([line.strip() for line in txt.split("\n")]) + suffix}$
     #:endcall
 #:enddef
 
+#!
+#! Generates a list of loop variables from an array
+#!
+#! Args:
+#!   varname(str): Name of the array variable to be used as prefix
+#!   n      (int): Number of loop variables to be created
+#!   offset (int): Optional index offset
+#!
+#! Returns:
+#!   Variable definition string 
+#!
+#! E.g.,
+#!  loop_array_variables('j', 5)
+#!   -> "j(1), j(2), j(3), j(4), j(5)
+#!
+#!  loop_array_variables('j', 5, 2)
+#!   -> "j(3), j(4), j(5), j(6), j(7)
+#!
+#:def loop_array_variables(varname, n, offset=0)
+  #:assert n > 0
+    #:call join_lines(joinstr=", ")
+      #:for i in range(1, n + 1)
+        ${varname}$(${i+offset}$)
+      #:endfor
+    #:endcall
+#:enddef
+
+
 #! Generates an array shape specifier from an N-D array size
 #!
 #! Args:

test/linalg/test_linalg_mnorm.fypp

@@ -65,14 +65,15 @@ module test_linalg_mnorm
     subroutine test_mnorm_${ri}$_${rank}$d(error)
         type(error_type), allocatable, intent(out) :: error
 
-        integer(ilp) :: j,dim1,dim2,dim(2),order
+        integer(ilp) :: i,j,k,l,dim1,dim2,dim(2),dim_sizes(2),order,ptr(${rank}$)
         integer(ilp), parameter :: orders(*) = [1_ilp,2_ilp,huge(0_ilp)]
         integer(ilp), parameter :: ndim = ${rank}$
-        integer(ilp), parameter :: n   = 2_ilp**ndim
+        integer(ilp), parameter :: n    = 2_ilp**ndim
         integer(ilp), parameter :: dims(*) = [(dim1, dim1=1,ndim)]
         real(${rk}$), parameter :: tol = 10*sqrt(epsilon(0.0_${rk}$))
+        real(${rk}$) :: one_nrm
         real(${rk}$), allocatable :: bnrm${ranksuffix(rank-2)}$
-        ${rt}$, allocatable :: a(:), b${ranksuffix(rank)}$
+        ${rt}$, allocatable :: a(:), b${ranksuffix(rank)}$, one_mat(:,:)
 
         character(64) :: msg
 
@@ -84,20 +85,44 @@ module test_linalg_mnorm
         b = reshape(a, shape(b))
 
         ! Test norm as collapsed around dimensions
-        do j = 1, size(orders)
-            order = orders(j)
+        do k = 1, size(orders)
+            order = orders(k)
             do dim1 = 1, ndim
                 do dim2 = dim1+1, ndim
 
-                    dim = [dim1,dim2]
+                    dim       = [dim1,dim2]
+                    dim_sizes = [size(b,dim1,kind=ilp),size(b,dim2,kind=ilp)]
 
                     ! Get norms collapsed on these dims
                     bnrm = mnorm(b,order,dim)
 
                     ! Assert size
                     write(msg,"('dim=[',i0,',',i0,'] order=',i0,' ${rk}$ norm returned wrong shape')") dim, order
                     call check(error,all(shape(bnrm)==pack(shape(b),dims/=dim1 .and. dims/=dim2) ), trim(msg))
-                    if (allocated(error)) return                                     
+                    if (allocated(error)) return    
+                    
+                    ! Assert some matrix results: check that those on same index i.e. (l,l,l,:,l,l,:) etc.
+                    ! are equal to the corresponding 2d-array result
+                    do l = 1, minval(shape(b))
+                    
+                       ptr = l
+                    
+                       allocate(one_mat(dim_sizes(1),dim_sizes(2)))
+                       do j = 1, dim_sizes(2)
+                           ptr(dim(2)) = j
+                           do i = 1, dim_sizes(1)
+                               ptr(dim(1)) = i
+                               one_mat(i,j) = b(${loop_array_variables('ptr',rank)}$) 
+                           end do
+                       end do
+                       one_nrm = mnorm(one_mat,order)
+                    
+                       write(msg,"('dim=[',i0,',',i0,'] order=',i0,' ${rk}$ ',i0,'-th norm is wrong')") dim, order, l
+                       call check(error, abs(one_nrm-bnrm(${fixedranksuffix(rank-2,'l')}$))<tol*one_nrm, trim(msg))
+                       if (allocated(error)) return    
+                       deallocate(one_mat) 
+                    
+                    end do
 
                 end do
             end do