Added tests and confirmed build

Author: ghbrown

src/tests/linalg/test_linalg.f90

@@ -59,18 +59,16 @@ program test_linalg
   !
   ! outer product
   !
-  !commented until outer_product compiles
-  !call test_outer_product_rsp
-  !call test_outer_product_rsp_k
-  !call test_outer_product_rdp
-  !call test_outer_product_rqp
-
-  !call test_outer_product_csp
-  !call test_outer_product_cdp
-  !call test_outer_product_cqp
-
-  !call test_outer_product_int8
-  !call test_outer_product_int16
+  call test_outer_product_rsp
+  call test_outer_product_rdp
+  call test_outer_product_rqp
+
+  call test_outer_product_csp
+  call test_outer_product_cdp
+  call test_outer_product_cqp
+
+  call test_outer_product_int8
+  call test_outer_product_int16
   !call test_outer_product_int32
   !call test_outer_product_int64
 
@@ -93,7 +91,7 @@ subroutine test_eye
     cye = eye(7)
     call check(abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol, &
           msg="abs(trace(cye) - cmplx(7.0_sp,0.0_sp,kind=sp)) < sptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_eye
 
   subroutine test_diag_rsp
     integer, parameter :: n = 3
@@ -108,7 +106,7 @@ subroutine test_diag_rsp
 
     call check(all(diag(3*a) == 3*v), &
             msg="all(diag(3*a) == 3*v) failed.",warn=warn)
-  end subroutine
+  end subroutine test_diag_rsp
 
   subroutine test_diag_rsp_k
     integer, parameter :: n = 4
@@ -136,7 +134,7 @@ subroutine test_diag_rsp_k
     end do
     call check(size(diag(a,n+1)) == 0, &
         msg="size(diag(a,n+1)) == 0 failed.",warn=warn)
-  end subroutine
+  end subroutine test_diag_rsp_k
 
   subroutine test_diag_rdp
     integer, parameter :: n = 3
@@ -151,7 +149,7 @@ subroutine test_diag_rdp
 
     call check(all(diag(3*a) == 3*v), &
             msg="all(diag(3*a) == 3*v) failed.",warn=warn)
-  end subroutine
+  end subroutine test_diag_rdp
 
   subroutine test_diag_rqp
     integer, parameter :: n = 3
@@ -166,7 +164,7 @@ subroutine test_diag_rqp
 
     call check(all(diag(3*a) == 3*v), &
             msg="all(diag(3*a) == 3*v) failed.", warn=warn)
-  end subroutine
+  end subroutine test_diag_rqp
 
   subroutine test_diag_csp
     integer, parameter :: n = 3
@@ -183,7 +181,7 @@ subroutine test_diag_csp
           msg="all(abs(real(diag(a)) - [(i,i=1,n)]) < sptol)", warn=warn)
     call check(all(abs(aimag(diag(a)) - [(1,i=1,n)]) < sptol), &
           msg="all(abs(aimag(diag(a)) - [(1,i=1,n)]) < sptol)", warn=warn)
-  end subroutine
+  end subroutine test_diag_csp
 
   subroutine test_diag_cdp
     integer, parameter :: n = 3
@@ -193,7 +191,7 @@ subroutine test_diag_cdp
     a = diag([i_],-2) + diag([i_],2)
     call check(a(3,1) == i_ .and. a(1,3) == i_, &
           msg="a(3,1) == i_ .and. a(1,3) == i_ failed.",warn=warn)
-  end subroutine
+  end subroutine test_diag_cdp
 
   subroutine test_diag_cqp
     integer, parameter :: n = 3
@@ -203,7 +201,7 @@ subroutine test_diag_cqp
     a = diag([i_,i_],-1) + diag([i_,i_],1)
     call check(all(diag(a,-1) == i_) .and. all(diag(a,1) == i_), &
           msg="all(diag(a,-1) == i_) .and. all(diag(a,1) == i_) failed.",warn=warn)
-  end subroutine
+  end subroutine test_diag_cqp
 
   subroutine test_diag_int8
     integer, parameter :: n = 3
@@ -217,7 +215,7 @@ subroutine test_diag_int8
           msg="all(diag(a) == pack(a,mask)) failed.", warn=warn)
     call check(all(diag(diag(a)) == merge(a,0_int8,mask)), &
           msg="all(diag(diag(a)) == merge(a,0_int8,mask)) failed.", warn=warn)
-  end subroutine
+  end subroutine test_diag_int8
   subroutine test_diag_int16
     integer, parameter :: n = 4
     integer(int16), allocatable :: a(:,:)
@@ -230,7 +228,7 @@ subroutine test_diag_int16
           msg="all(diag(a) == pack(a,mask))", warn=warn)
     call check(all(diag(diag(a)) == merge(a,0_int16,mask)), &
           msg="all(diag(diag(a)) == merge(a,0_int16,mask)) failed.", warn=warn)
-  end subroutine
+  end subroutine test_diag_int16
   subroutine test_diag_int32
     integer, parameter :: n = 3
     integer(int32) :: a(n,n)
@@ -244,7 +242,7 @@ subroutine test_diag_int32
           msg="all(diag([1,1],-1) == a) failed.", warn=warn)
     call check(all(diag([1,1],1) == transpose(a)), &
           msg="all(diag([1,1],1) == transpose(a)) failed.", warn=warn)
-  end subroutine
+  end subroutine test_diag_int32
   subroutine test_diag_int64
     integer, parameter :: n = 4
     integer(int64) :: a(n,n), c(0:2*n-1)
@@ -275,7 +273,7 @@ subroutine test_diag_int64
     end do
     call check(all(diag(a,-2) == diag(a,2)), &
           msg="all(diag(a,-2) == diag(a,2))", warn=warn)
-  end subroutine
+  end subroutine test_diag_int64
 
 
 
@@ -288,7 +286,7 @@ subroutine test_trace_rsp
     a = reshape([(i,i=1,n**2)],[n,n])
     call check(abs(trace(a) - sum(diag(a))) < sptol, &
           msg="abs(trace(a) - sum(diag(a))) < sptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_rsp
 
   subroutine test_trace_rsp_nonsquare
     integer, parameter :: n = 4
@@ -305,7 +303,7 @@ subroutine test_trace_rsp_nonsquare
 
     call check(abs(trace(a) - ans) < sptol, &
           msg="abs(trace(a) - ans) < sptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_rsp_nonsquare
 
   subroutine test_trace_rdp
     integer, parameter :: n = 4
@@ -315,7 +313,7 @@ subroutine test_trace_rdp
     a = reshape([(i,i=1,n**2)],[n,n])
     call check(abs(trace(a) - sum(diag(a))) < dptol, &
           msg="abs(trace(a) - sum(diag(a))) < dptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_rdp
 
   subroutine test_trace_rdp_nonsquare
     integer, parameter :: n = 4
@@ -332,7 +330,7 @@ subroutine test_trace_rdp_nonsquare
 
     call check(abs(trace(a) - ans) < dptol, &
           msg="abs(trace(a) - ans) < dptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_rdp_nonsquare
 
   subroutine test_trace_rqp
     integer, parameter :: n = 3
@@ -342,7 +340,7 @@ subroutine test_trace_rqp
     a = reshape([(i,i=1,n**2)],[n,n])
     call check(abs(trace(a) - sum(diag(a))) < qptol, &
           msg="abs(trace(a) - sum(diag(a))) < qptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_rqp
 
 
   subroutine test_trace_csp
@@ -363,7 +361,7 @@ subroutine test_trace_csp
     ! tr(A + B) = tr(A) + tr(B)
     call check(abs(trace(a+b) - (trace(a) + trace(b))) < sptol, &
           msg="abs(trace(a+b) - (trace(a) + trace(b))) < sptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_csp
 
   subroutine test_trace_cdp
     integer, parameter :: n = 3
@@ -377,7 +375,7 @@ subroutine test_trace_cdp
 
     call check(abs(trace(a) - ans) < dptol, &
           msg="abs(trace(a) - ans) < dptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_cdp
 
   subroutine test_trace_cqp
     integer, parameter :: n = 3
@@ -387,7 +385,7 @@ subroutine test_trace_cqp
     a = 3*eye(n) + 4*eye(n)*i_ ! pythagorean triple
     call check(abs(trace(a)) - 3*5.0_qp < qptol, &
           msg="abs(trace(a)) - 3*5.0_qp < qptol failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_cqp
 
 
   subroutine test_trace_int8
@@ -398,7 +396,7 @@ subroutine test_trace_int8
     a = reshape([(i**2,i=1,n**2)],[n,n])
     call check(trace(a) == (1 + 25 + 81), &
           msg="trace(a) == (1 + 25 + 81) failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_int8
 
   subroutine test_trace_int16
     integer, parameter :: n = 3
@@ -408,7 +406,7 @@ subroutine test_trace_int16
     a = reshape([(i**3,i=1,n**2)],[n,n])
     call check(trace(a) == (1 + 125 + 729), &
           msg="trace(a) == (1 + 125 + 729) failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_int16
 
   subroutine test_trace_int32
     integer, parameter :: n = 3
@@ -418,7 +416,7 @@ subroutine test_trace_int32
     a = reshape([(i**4,i=1,n**2)],[n,n])
     call check(trace(a) == (1 + 625 + 6561), &
           msg="trace(a) == (1 + 625 + 6561) failed.",warn=warn)
-  end subroutine
+  end subroutine test_trace_int32
 
   subroutine test_trace_int64
     integer, parameter :: n = 5
@@ -442,7 +440,129 @@ subroutine test_trace_int64
     call check(trace(h) == sum(c(0:nd:2)), &
           msg="trace(h) == sum(c(0:nd:2)) failed.",warn=warn)
 
-  end subroutine
+  end subroutine test_trace_int64
+
+
+  subroutine test_outer_product_rsp
+    integer, parameter :: n = 2
+    real(sp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_rsp" 
+    u = [1.,2.]
+    v = [1.,3.]
+    expected = reshape([1.,2.,3.,6.],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < sptol), &
+         msg="all(abs(diff) < sptol) failed.",warn=warn)
+  end subroutine test_outer_product_rsp
+
+  subroutine test_outer_product_rdp
+    integer, parameter :: n = 2
+    real(dp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_rdp" 
+    u = [1.,2.]
+    v = [1.,3.]
+    expected = reshape([1.,2.,3.,6.],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < dptol), &
+         msg="all(abs(diff) < dptol) failed.",warn=warn)
+  end subroutine test_outer_product_rdp
+
+  subroutine test_outer_product_rqp
+    integer, parameter :: n = 2
+    real(qp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_rqp" 
+    u = [1.,2.]
+    v = [1.,3.]
+    expected = reshape([1.,2.,3.,6.],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < qptol), &
+         msg="all(abs(diff) < qptol) failed.",warn=warn)
+  end subroutine test_outer_product_rqp
+
+  subroutine test_outer_product_csp
+    integer, parameter :: n = 2
+    complex(sp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_csp" 
+    u = [cmplx(1.,1.),cmplx(2.,0.)]
+    v = [cmplx(1.,0.),cmplx(3.,1.)]
+    expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < sptol), &
+         msg="all(abs(diff) < sptol) failed.",warn=warn)
+  end subroutine test_outer_product_csp
+
+  subroutine test_outer_product_cdp
+    integer, parameter :: n = 2
+    complex(dp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_cdp" 
+    u = [cmplx(1.,1.),cmplx(2.,0.)]
+    v = [cmplx(1.,0.),cmplx(3.,1.)]
+    expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < dptol), &
+         msg="all(abs(diff) < dptol) failed.",warn=warn)
+  end subroutine test_outer_product_cdp
+
+  subroutine test_outer_product_cqp
+    integer, parameter :: n = 2
+    complex(qp) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_cqp" 
+    u = [cmplx(1.,1.),cmplx(2.,0.)]
+    v = [cmplx(1.,0.),cmplx(3.,1.)]
+    expected = reshape([cmplx(1.,1.),cmplx(2.,0.),cmplx(2.,4.),cmplx(6.,2.)],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) < qptol), &
+         msg="all(abs(diff) < qptol) failed.",warn=warn)
+  end subroutine test_outer_product_cqp
+    
+  subroutine test_outer_product_int8
+    integer, parameter :: n = 2
+    integer(int8) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_int8" 
+    u = [1,2]
+    v = [1,3]
+    expected = reshape([1,2,3,6],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) == 0), &
+         msg="all(abs(diff) == 0) failed.",warn=warn)
+  end subroutine test_outer_product_int8
+
+  subroutine test_outer_product_int16
+    integer, parameter :: n = 2
+    integer(int16) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_int16" 
+    u = [1,2]
+    v = [1,3]
+    expected = reshape([1,2,3,6],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) == 0), &
+         msg="all(abs(diff) == 0) failed.",warn=warn)
+  end subroutine test_outer_product_int16
+
+  subroutine test_outer_product_int32
+    integer, parameter :: n = 2
+    integer(int32) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_int32" 
+    u = [1,2]
+    v = [1,3]
+    expected = reshape([1,2,3,6],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) == 0), &
+         msg="all(abs(diff) == 0) failed.",warn=warn)
+  end subroutine test_outer_product_int32
+
+  subroutine test_outer_product_int64
+    integer, parameter :: n = 2
+    integer(int64) :: u(n), v(n), expected(n,n), diff(n,n)
+    write(*,*) "test_outer_product_int64" 
+    u = [1,2]
+    v = [1,3]
+    expected = reshape([1,2,3,6],[n,n])
+    diff = expected - outer_product(u,v)
+    call check(all(abs(diff) == 0), &
+         msg="all(abs(diff) == 0) failed.",warn=warn)
+  end subroutine test_outer_product_int64
+
 
   pure recursive function catalan_number(n) result(value)
     integer, intent(in) :: n