Fix scalar multiplication for Hermitian matrices.

Author: loiseaujc

src/stdlib_specialmatrices.fypp

@@ -452,11 +452,21 @@ module stdlib_specialmatrices
         pure module function scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
             ${t1}$, intent(in) :: alpha
             type(hermtridiagonal_${s1}$_type), intent(in) :: A
-            type(hermtridiagonal_${s1}$_type) :: B
+            type(tridiagonal_${s1}$_type) :: B
         end function
         pure module function scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
             type(hermtridiagonal_${s1}$_type), intent(in) :: A
             ${t1}$, intent(in) :: alpha
+            type(tridiagonal_${s1}$_type) :: B
+        end function
+        pure module function real_scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
+            real(${k1}$), intent(in) :: alpha
+            type(hermtridiagonal_${s1}$_type), intent(in) :: A
+            type(hermtridiagonal_${s1}$_type) :: B
+        end function
+        pure module function real_scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
+            type(hermtridiagonal_${s1}$_type), intent(in) :: A
+            real(${k1}$), intent(in) :: alpha
             type(hermtridiagonal_${s1}$_type) :: B
         end function
         #:endif

src/stdlib_specialmatrices_tridiagonal.fypp

@@ -549,17 +549,33 @@ submodule (stdlib_specialmatrices) tridiagonal_matrices
      pure module function scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
         ${t1}$, intent(in) :: alpha
         type(hermtridiagonal_${s1}$_type), intent(in) :: A
-        type(hermtridiagonal_${s1}$_type) :: B
-        B = hermtridiagonal(A%dv, A%du)
-        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = conjg(B%dl)
+        type(tridiagonal_${s1}$_type) :: B
+        B = tridiagonal(A%dl, A%dv, A%du)
+        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
     end function
 
     pure module function scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
         type(hermtridiagonal_${s1}$_type), intent(in) :: A
         ${t1}$, intent(in) :: alpha
+        type(tridiagonal_${s1}$_type) :: B
+        B = tridiagonal(A%dl, A%dv, A%du)
+        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
+    end function
+    
+    pure module function real_scalar_multiplication_hermtridiagonal_${s1}$(alpha, A) result(B)
+        real(${k1}$), intent(in) :: alpha
+        type(hermtridiagonal_${s1}$_type), intent(in) :: A
+        type(hermtridiagonal_${s1}$_type) :: B
+        B = hermtridiagonal(A%dv, A%du)
+        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
+    end function
+
+    pure module function real_scalar_multiplication_bis_hermtridiagonal_${s1}$(A, alpha) result(B)
+        type(hermtridiagonal_${s1}$_type), intent(in) :: A
+        real(${k1}$), intent(in) :: alpha
         type(hermtridiagonal_${s1}$_type) :: B
         B = hermtridiagonal(A%dv, A%du)
-        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = conjg(B%dl)
+        B%dl = alpha*B%dl; B%dv = alpha*B%dv; B%du = alpha*B%du
     end function
     #:endif
     #:endfor

test/linalg/test_linalg_specialmatrices.fypp

@@ -400,9 +400,11 @@ contains
             integer, parameter :: wp = ${k1}$
             integer, parameter :: n = 5
             type(hermtridiagonal_${s1}$_type) :: A, B, C
-            ${t1}$, allocatable :: Amat(:, :), Bmat(:, :), Cmat(:, :)
+            type(tridiagonal_${s1}$_type) :: D
+            ${t1}$, allocatable :: Amat(:, :), Bmat(:, :), Cmat(:, :), Dmat(:, :)
             ${t1}$, allocatable :: dv(:), ev(:)
-            ${t1}$, parameter :: alpha = 2.0_dp
+            ${t1}$, parameter :: alpha = cmplx(2.0_wp, 2.0_wp, kind=wp)
+            real(${k1}$), parameter :: beta = 2.0_wp
             integer :: i, j
             real(wp), allocatable :: data(:, :)
 
@@ -428,12 +430,20 @@ contains
             if (allocated(error)) return
 
             ! Matrix scalar multiplication
-            C = alpha * A ; Cmat = dense(C)
-            call check(error, all_close(Cmat, alpha * Amat), .true.)
+            D = alpha * A ; Dmat = dense(D)
+            call check(error, all_close(Dmat, alpha * Amat), .true.)
             if (allocated(error)) return
 
-            C = A *alpha ; Cmat = dense(C)
-            call check(error, all_close(Cmat, alpha * Amat), .true.)
+            D = A * alpha ; Dmat = dense(D)
+            call check(error, all_close(Dmat, alpha * Amat), .true.)
+            if (allocated(error)) return
+
+            C = beta * A ; Cmat = dense(C)
+            call check(error, all_close(Cmat, beta * Amat), .true.)
+            if (allocated(error)) return
+
+            C = A * beta ; Cmat = dense(C)
+            call check(error, all_close(Cmat, beta * Amat), .true.)
             if (allocated(error)) return
         end block
         #:endfor