stdlib_linalg.fypp

#:include "common.fypp"
#:set RCI_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES
module stdlib_linalg
  !!Provides a support for various linear algebra procedures
  !! ([Specification](../page/specs/stdlib_linalg.html))
  use stdlib_kinds, only: sp, dp, qp, &
    int8, int16, int32, int64
  use stdlib_optval, only: optval
  implicit none
  private

  public :: diag
  public :: eye
  public :: trace
  public :: outer_product

  interface diag
    !! version: experimental
    !!
    !! Creates a diagonal array or extract the diagonal elements of an array
    !! ([Specification](../page/specs/stdlib_linalg.html#description))
      !
      ! Vector to matrix
      !
    #:for k1, t1 in RCI_KINDS_TYPES
      module function diag_${t1[0]}$${k1}$(v) result(res)
        ${t1}$, intent(in) :: v(:)
        ${t1}$ :: res(size(v),size(v))
      end function diag_${t1[0]}$${k1}$
    #:endfor
    #:for k1, t1 in RCI_KINDS_TYPES
      module function diag_${t1[0]}$${k1}$_k(v,k) result(res)
        ${t1}$, intent(in) :: v(:)
        integer, intent(in) :: k
        ${t1}$ :: res(size(v)+abs(k),size(v)+abs(k))
      end function diag_${t1[0]}$${k1}$_k
    #:endfor

      !
      ! Matrix to vector
      !
    #:for k1, t1 in RCI_KINDS_TYPES
      module function diag_${t1[0]}$${k1}$_mat(A) result(res)
        ${t1}$, intent(in) :: A(:,:)
        ${t1}$ :: res(minval(shape(A)))
      end function diag_${t1[0]}$${k1}$_mat
    #:endfor
    #:for k1, t1 in RCI_KINDS_TYPES
      module function diag_${t1[0]}$${k1}$_mat_k(A,k) result(res)
        ${t1}$, intent(in) :: A(:,:)
        integer, intent(in) :: k
        ${t1}$ :: res(minval(shape(A))-abs(k))
      end function diag_${t1[0]}$${k1}$_mat_k
    #:endfor
  end interface


  ! Matrix trace
  interface trace
    !! version: experimental
    !!
    !! Computes the trace of a matrix
    !! ([Specification](../page/specs/stdlib_linalg.html#description_2))
    #:for k1, t1 in RCI_KINDS_TYPES
      module procedure trace_${t1[0]}$${k1}$
    #:endfor
  end interface


  ! Outer product (of two vectors)
  interface outer_product
    !! version: experimental
    !!
    !! Computes the outer product of two vectors, returning a rank-2 array
    !! ([Specification](../page/specs/stdlib_linalg.html#description_3))
    #:for k1, t1 in RCI_KINDS_TYPES
      pure module function outer_product_${t1[0]}$${k1}$(u, v) result(res)
        ${t1}$, intent(in) :: u(:), v(:)
        ${t1}$ :: res(size(u),size(v))
      end function outer_product_${t1[0]}$${k1}$
    #:endfor
  end interface outer_product

contains

    !> Version: experimental
    !>
    !> Constructs the identity matrix.
    !> ([Specification](../page/specs/stdlib_linalg.html#eye-construct-the-identity-matrix))
    pure function eye(dim1, dim2) result(result)

        integer, intent(in) :: dim1
        integer, intent(in), optional :: dim2
        integer(int8), allocatable :: result(:, :)

        integer :: dim2_
        integer :: i

        dim2_ = optval(dim2, dim1)
        allocate(result(dim1, dim2_))
        
        result = 0_int8
        do i = 1, min(dim1, dim2_)
            result(i, i) = 1_int8
        end do

    end function eye

    #:for k1, t1 in RCI_KINDS_TYPES
      function trace_${t1[0]}$${k1}$(A) result(res)
        ${t1}$, intent(in) :: A(:,:)
        ${t1}$ :: res
        integer :: i
        res = 0
        do i = 1, minval(shape(A))
          res = res + A(i,i)
        end do
      end function trace_${t1[0]}$${k1}$
    #:endfor

end module stdlib_linalg