SSYMM performs one of the matrix-matrix operations C := alphaAB + betaC, or C := alphaBA + betaC, where alpha and beta are scalars, A is a symmetric matrix and B and C are m by n matrices.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=1), | intent(in) | :: | side | |||
character(len=1), | intent(in) | :: | uplo | |||
integer(kind=ilp), | intent(in) | :: | m | |||
integer(kind=ilp), | intent(in) | :: | n | |||
real(kind=sp), | intent(in) | :: | alpha | |||
real(kind=sp), | intent(in) | :: | a(lda,*) | |||
integer(kind=ilp), | intent(in) | :: | lda | |||
real(kind=sp), | intent(in) | :: | b(ldb,*) | |||
integer(kind=ilp), | intent(in) | :: | ldb | |||
real(kind=sp), | intent(in) | :: | beta | |||
real(kind=sp), | intent(inout) | :: | c(ldc,*) | |||
integer(kind=ilp), | intent(in) | :: | ldc |
pure subroutine stdlib_ssymm(side,uplo,m,n,alpha,a,lda,b,ldb,beta,c,ldc) !! SSYMM performs one of the matrix-matrix operations !! C := alpha*A*B + beta*C, !! or !! C := alpha*B*A + beta*C, !! where alpha and beta are scalars, A is a symmetric matrix and B and !! C are m by n matrices. ! -- reference blas level3 routine -- ! -- reference blas is a software package provided by univ. of tennessee, -- ! -- univ. of california berkeley, univ. of colorado denver and nag ltd..-- ! Scalar Arguments real(sp), intent(in) :: alpha, beta integer(ilp), intent(in) :: lda, ldb, ldc, m, n character, intent(in) :: side, uplo ! Array Arguments real(sp), intent(in) :: a(lda,*), b(ldb,*) real(sp), intent(inout) :: c(ldc,*) ! ===================================================================== ! Intrinsic Functions intrinsic :: max ! Local Scalars real(sp) :: temp1, temp2 integer(ilp) :: i, info, j, k, nrowa logical(lk) :: upper ! set nrowa as the number of rows of a. if (stdlib_lsame(side,'L')) then nrowa = m else nrowa = n end if upper = stdlib_lsame(uplo,'U') ! test the input parameters. info = 0 if ((.not.stdlib_lsame(side,'L')) .and. (.not.stdlib_lsame(side,'R'))) then info = 1 else if ((.not.upper) .and. (.not.stdlib_lsame(uplo,'L'))) then info = 2 else if (m<0) then info = 3 else if (n<0) then info = 4 else if (lda<max(1,nrowa)) then info = 7 else if (ldb<max(1,m)) then info = 9 else if (ldc<max(1,m)) then info = 12 end if if (info/=0) then call stdlib_xerbla('SSYMM ',info) return end if ! quick return if possible. if ((m==0) .or. (n==0) .or.((alpha==zero).and. (beta==one))) return ! and when alpha.eq.zero. if (alpha==zero) then if (beta==zero) then do j = 1,n do i = 1,m c(i,j) = zero end do end do else do j = 1,n do i = 1,m c(i,j) = beta*c(i,j) end do end do end if return end if ! start the operations. if (stdlib_lsame(side,'L')) then ! form c := alpha*a*b + beta*c. if (upper) then do j = 1,n do i = 1,m temp1 = alpha*b(i,j) temp2 = zero do k = 1,i - 1 c(k,j) = c(k,j) + temp1*a(k,i) temp2 = temp2 + b(k,j)*a(k,i) end do if (beta==zero) then c(i,j) = temp1*a(i,i) + alpha*temp2 else c(i,j) = beta*c(i,j) + temp1*a(i,i) +alpha*temp2 end if end do end do else do j = 1,n do i = m,1,-1 temp1 = alpha*b(i,j) temp2 = zero do k = i + 1,m c(k,j) = c(k,j) + temp1*a(k,i) temp2 = temp2 + b(k,j)*a(k,i) end do if (beta==zero) then c(i,j) = temp1*a(i,i) + alpha*temp2 else c(i,j) = beta*c(i,j) + temp1*a(i,i) +alpha*temp2 end if end do end do end if else ! form c := alpha*b*a + beta*c. loop_170: do j = 1,n temp1 = alpha*a(j,j) if (beta==zero) then do i = 1,m c(i,j) = temp1*b(i,j) end do else do i = 1,m c(i,j) = beta*c(i,j) + temp1*b(i,j) end do end if do k = 1,j - 1 if (upper) then temp1 = alpha*a(k,j) else temp1 = alpha*a(j,k) end if do i = 1,m c(i,j) = c(i,j) + temp1*b(i,k) end do end do do k = j + 1,n if (upper) then temp1 = alpha*a(j,k) else temp1 = alpha*a(k,j) end if do i = 1,m c(i,j) = c(i,j) + temp1*b(i,k) end do end do end do loop_170 end if return end subroutine stdlib_ssymm