C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE MB01MD( UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y,
     $                   INCY )
C
C     PURPOSE
C
C     To perform the matrix-vector operation
C
C        y := alpha*A*x + beta*y,
C
C     where alpha and beta are scalars, x and y are vectors of length
C     n and A is an n-by-n skew-symmetric matrix.
C
C     This is a modified version of the vanilla implemented BLAS
C     routine DSYMV written by Jack Dongarra, Jeremy Du Croz,
C     Sven Hammarling, and Richard Hanson.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     UPLO    CHARACTER*1
C             Specifies whether the upper or lower triangular part of
C             the array A is to be referenced as follows:
C             = 'U':  only the strictly upper triangular part of A is to
C                     be referenced;
C             = 'L':  only the strictly lower triangular part of A is to
C                     be referenced.
C
C     Input/Output Parameters
C
C     N       (input) INTEGER
C             The order of the matrix A.  N >= 0.
C
C     ALPHA   (input) DOUBLE PRECISION
C             The scalar alpha. If alpha is zero the array A is not
C             referenced.
C
C     A       (input) DOUBLE PRECISION array, dimension (LDA,N)
C             On entry with UPLO = 'U', the leading N-by-N part of this
C             array must contain the strictly upper triangular part of
C             the matrix A. The lower triangular part of this array is
C             not referenced.
C             On entry with UPLO = 'L', the leading N-by-N part of this
C             array must contain the strictly lower triangular part of
C             the matrix A. The upper triangular part of this array is
C             not referenced.
C
C     LDA     INTEGER
C             The leading dimension of the array A.  LDA >= MAX(1,N)
C
C     X       (input) DOUBLE PRECISION array, dimension
C             ( 1 + ( N - 1 )*abs( INCX ) ).
C             On entry, elements 1, INCX+1, .., ( N - 1 )*INCX + 1 of
C             this array must contain the elements of the vector X.
C
C     INCX    (input) INTEGER
C             The increment for the elements of X. IF INCX < 0 then the
C             elements of X are accessed in reversed order.  INCX <> 0.
C
C     BETA    (input) DOUBLE PRECISION
C             The scalar beta. If beta is zero then Y need not be set on
C             input.
C
C     Y       (input/output) DOUBLE PRECISION array, dimension
C             ( 1 + ( N - 1 )*abs( INCY ) ).
C             On entry, elements 1, INCY+1, .., ( N - 1 )*INCY + 1 of
C             this array must contain the elements of the vector Y.
C             On exit, elements 1, INCY+1, .., ( N - 1 )*INCY + 1 of
C             this array contain the updated elements of the vector Y.
C
C     INCY    (input) INTEGER
C             The increment for the elements of Y. IF INCY < 0 then the
C             elements of Y are accessed in reversed order.  INCY <> 0.
C
C     NUMERICAL ASPECTS
C
C     Though being almost identical with the vanilla implementation
C     of the BLAS routine DSYMV the performance of this routine could
C     be significantly lower in the case of vendor supplied, highly
C     optimized BLAS.
C
C     CONTRIBUTORS
C
C     D. Kressner, Technical Univ. Berlin, Germany, and
C     P. Benner, Technical Univ. Chemnitz, Germany, December 2003.
C
C     REVISIONS
C
C     V. Sima, May 2008 (SLICOT version of the HAPACK routine DSKMV).
C
C     KEYWORDS
C
C     Elementary matrix operations.
C
C     ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION   ONE, ZERO
      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
C     .. Scalar Arguments ..
      DOUBLE PRECISION   ALPHA, BETA
      INTEGER            INCX, INCY, LDA, N
      CHARACTER          UPLO
C     .. Array Arguments ..
      DOUBLE PRECISION   A(LDA,*), X(*), Y(*)
C     .. Local Scalars ..
      DOUBLE PRECISION   TEMP1, TEMP2
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
C     .. External Functions ..
      LOGICAL            LSAME
      EXTERNAL           LSAME
C     .. External Subroutines ..
      EXTERNAL           XERBLA
C     .. Intrinsic Functions ..
      INTRINSIC          MAX
C
C     .. Executable Statements ..
C
C     Test the input parameters.
C
      INFO = 0
      IF ( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
         INFO = 1
      ELSE IF ( N.LT.0 )THEN
         INFO = 2
      ELSE IF ( LDA.LT.MAX( 1, N ) )THEN
         INFO = 5
      ELSE IF ( INCX.EQ.0 )THEN
         INFO = 7
      ELSE IF ( INCY.EQ.0 )THEN
         INFO = 10
      END IF
      IF ( INFO.NE.0 )THEN
         CALL XERBLA( 'MB01MD', INFO )
         RETURN
      END IF
C
C     Quick return if possible.
C
      IF ( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
     $   RETURN
C
C     Set up the start points in  X  and  Y.
C
      IF ( INCX.GT.0 )THEN
         KX = 1
      ELSE
         KX = 1 - ( N - 1 )*INCX
      END IF
      IF ( INCY.GT.0 )THEN
         KY = 1
      ELSE
         KY = 1 - ( N - 1 )*INCY
      END IF
C
C     Start the operations. In this version the elements of A are
C     accessed sequentially with one pass through the triangular part
C     of A.
C
C     First form  y := beta*y.
C
      IF ( BETA.NE.ONE )THEN
         IF ( INCY.EQ.1 )THEN
            IF ( BETA.EQ.ZERO )THEN
               DO 10 I = 1, N
                  Y(I) = ZERO
   10          CONTINUE
            ELSE
               DO 20 I = 1, N
                  Y(I) = BETA*Y(I)
   20          CONTINUE
            END IF
         ELSE
            IY = KY
            IF ( BETA.EQ.ZERO )THEN
               DO 30 I = 1, N
                  Y(IY) = ZERO
                  IY = IY + INCY
   30          CONTINUE
            ELSE
               DO 40 I = 1, N
                  Y(IY) = BETA*Y(IY)
                  IY = IY + INCY
   40          CONTINUE
            END IF
         END IF
      END IF
C
C     Quick return if possible.
C
      IF ( ALPHA.EQ.ZERO )
     $   RETURN
      IF ( LSAME( UPLO, 'U' ) )THEN
C
C        Form y when A is stored in upper triangle.
C
         IF ( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
            DO 60 J = 2, N
               TEMP1 = ALPHA*X(J)
               TEMP2 = ZERO
               DO 50, I = 1, J - 1
                  Y(I)  = Y(I)  + TEMP1*A(I,J)
                  TEMP2 = TEMP2 + A(I,J)*X(I)
   50          CONTINUE
               Y(J) = Y(J) - ALPHA*TEMP2
   60       CONTINUE
         ELSE
            JX = KX + INCX
            JY = KY + INCY
            DO 80 J = 2, N
               TEMP1 = ALPHA*X(JX)
               TEMP2 = ZERO
               IX    = KX
               IY    = KY
               DO 70 I = 1, J - 1
                  Y(IY) = Y(IY) + TEMP1*A(I,J)
                  TEMP2 = TEMP2 + A(I,J)*X(IX)
                  IX    = IX + INCX
                  IY    = IY + INCY
   70          CONTINUE
               Y(JY) = Y(JY) - ALPHA*TEMP2
               JX = JX + INCX
               JY = JY + INCY
   80       CONTINUE
         END IF
      ELSE
C
C        Form y when A is stored in lower triangle.
C
         IF ( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) )THEN
            DO 100 J = 1, N - 1
               TEMP1 = ALPHA*X(J)
               TEMP2 = ZERO
               DO 90 I = J + 1, N
                  Y(I)  = Y(I)  + TEMP1*A(I,J)
                  TEMP2 = TEMP2 + A(I,J)*X(I)
   90          CONTINUE
               Y(J) = Y(J) - ALPHA*TEMP2
  100       CONTINUE
         ELSE
            JX = KX
            JY = KY
            DO 120 J = 1, N - 1
               TEMP1 = ALPHA*X(JX)
               TEMP2 = ZERO
               IX = JX
               IY = JY
               DO 110 I = J + 1, N
                  IX = IX + INCX
                  IY = IY + INCY
                  Y(IY ) = Y(IY) + TEMP1*A(I,J)
                  TEMP2  = TEMP2 + A(I,J)*X(IX)
  110          CONTINUE
               Y(JY) = Y(JY) - ALPHA*TEMP2
               JX = JX + INCX
               JY = JY + INCY
  120       CONTINUE
         END IF
      END IF
C *** Last line of MB01MD ***
      END
