C
C SPDX-License-Identifier: BSD-3-Clause
C
      SUBROUTINE MB01RW( UPLO, TRANS, M, N, A, LDA, Z, LDZ, DWORK,
     $                   INFO )
C
C     PURPOSE
C
C     To compute the transformation of the symmetric matrix A by the
C     matrix Z in the form
C
C        A := op(Z)*A*op(Z)',
C
C     where op(Z) is either Z or its transpose, Z'.
C
C     ARGUMENTS
C
C     Mode Parameters
C
C     UPLO    CHARACTER*1
C             Specifies whether the upper or lower triangle of A
C             is stored:
C             = 'U':  Upper triangle of A is stored;
C             = 'L':  Lower triangle of A is stored.
C
C     TRANS   CHARACTER*1
C             Specifies whether op(Z) is Z or its transpose Z':
C             = 'N':  op(Z) = Z;
C             = 'T':  op(Z) = Z'.
C
C     Input/Output Parameters
C
C     M       (input) INTEGER
C             The order of the resulting symmetric matrix op(Z)*A*op(Z)'
C             and the number of rows of the matrix Z, if TRANS = 'N',
C             or the number of columns of the matrix Z, if TRANS = 'T'.
C             M >= 0.
C
C     N       (input) INTEGER
C             The order of the symmetric matrix A and the number of
C             columns of the matrix Z, if TRANS = 'N', or the number of
C             rows of the matrix Z, if TRANS = 'T'.  N >= 0.
C
C     A       (input/output) DOUBLE PRECISION array, dimension
C             (LDA,MAX(M,N))
C             On entry, the leading N-by-N upper or lower triangular
C             part of this array must contain the upper (UPLO = 'U')
C             or lower (UPLO = 'L') triangular part of the symmetric
C             matrix A.
C             On exit, the leading M-by-M upper or lower triangular
C             part of this array contains the upper (UPLO = 'U') or
C             lower (UPLO = 'L') triangular part of the symmetric
C             matrix op(Z)*A*op(Z)'.
C
C     LDA     INTEGER
C             The leading dimension of the array A.  LDA >= MAX(1,M,N).
C
C     Z       (input) DOUBLE PRECISION array, dimension (LDQ,K)
C             where K = N if TRANS = 'N' and K = M if TRANS = 'T'.
C             The leading M-by-N part, if TRANS = 'N', or N-by-M part,
C             if TRANS = 'T', of this array contains the matrix Z.
C
C     LDZ     INTEGER
C             The leading dimension of the array Z.
C             LDZ >= MAX(1,M) if TRANS = 'N' and
C             LDZ >= MAX(1,N) if TRANS = 'T'.
C
C     Workspace
C
C     DWORK   DOUBLE PRECISION array, dimension (N)
C
C     Error Indicator
C
C     INFO    INTEGER
C             = 0:  successful exit;
C             < 0:  if INFO = -i, the i-th argument had an illegal
C                   value.
C
C     FURTHER COMMENTS
C
C     This is a simpler, BLAS 2 version for MB01RD.
C
C     CONTRIBUTOR
C
C     A. Varga, DLR, Feb. 1995.
C
C     REVISIONS
C
C     April 1998 (T. Penzl).
C     Sep. 1998 (V. Sima).
C
C    ******************************************************************
C
C     .. Parameters ..
      DOUBLE PRECISION  ZERO, ONE
      PARAMETER         ( ZERO = 0.0D0, ONE = 1.0D0 )
C     .. Scalar Arguments ..
      CHARACTER         TRANS, UPLO
      INTEGER           INFO, LDA, LDZ, M, N
C     .. Array Arguments ..
      DOUBLE PRECISION  A(LDA,*), DWORK(*), Z(LDZ,*)
C     .. Local Scalars ..
      LOGICAL           NOTTRA, UPPER
      INTEGER           I, J
C     .. External Functions ..
      LOGICAL           LSAME
      EXTERNAL          LSAME
C     .. External Subroutines ..
      EXTERNAL          DCOPY, DGEMV, XERBLA
C     .. Intrinsic Functions ..
      INTRINSIC         MAX
C
C     .. Executable Statements
C
      NOTTRA = LSAME( TRANS, 'N' )
      UPPER  = LSAME( UPLO,  'U' )
C
      INFO = 0
      IF( .NOT.( UPPER .OR. LSAME( UPLO, 'L') ) ) THEN
         INFO = -1
      ELSE IF( .NOT.( NOTTRA .OR. LSAME( TRANS, 'T') ) ) THEN
         INFO = -2
      ELSE IF( M.LT.0 ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( LDA.LT.MAX( 1, M, N ) ) THEN
         INFO = -6
      ELSE IF( (      NOTTRA .AND. LDZ.LT.MAX( 1, M ) )   .OR.
     $         ( .NOT.NOTTRA .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
         INFO = -8
      END IF
C
      IF ( INFO.NE.0 ) THEN
         CALL XERBLA( 'MB01RW', -INFO )
         RETURN
      END IF
C
C     Quick return if possible.
C
      IF( N.EQ.0 .OR. M.EQ.0 )
     $   RETURN
C
      IF ( NOTTRA ) THEN
C
C        Compute Z*A*Z'.
C
         IF ( UPPER ) THEN
C
C           Compute Z*A in A (M-by-N).
C
            DO 10 J = 1, N
               CALL DCOPY( J-1, A(1,J), 1, DWORK, 1 )
               CALL DCOPY( N-J+1, A(J,J), LDA, DWORK(J), 1 )
               CALL DGEMV( TRANS, M, N, ONE, Z, LDZ, DWORK, 1, ZERO,
     $                     A(1,J), 1 )
   10       CONTINUE
C
C           Compute A*Z' in the upper triangular part of A.
C
            DO 20 I = 1, M
               CALL DCOPY( N, A(I,1), LDA, DWORK, 1 )
               CALL DGEMV( TRANS, M-I+1, N, ONE, Z(I,1), LDZ, DWORK, 1,
     $                     ZERO, A(I,I), LDA )
   20       CONTINUE
C
         ELSE
C
C           Compute A*Z' in A (N-by-M).
C
            DO 30 I = 1, N
               CALL DCOPY( I-1, A(I,1), LDA, DWORK, 1 )
               CALL DCOPY( N-I+1, A(I,I), 1, DWORK(I), 1 )
               CALL DGEMV( TRANS, M, N, ONE, Z, LDZ, DWORK, 1, ZERO,
     $                     A(I,1), LDA )
   30       CONTINUE
C
C           Compute Z*A in the lower triangular part of A.
C
            DO 40 J = 1, M
               CALL DCOPY( N, A(1,J), 1, DWORK, 1 )
               CALL DGEMV( TRANS, M-J+1, N, ONE, Z(J,1), LDZ, DWORK, 1,
     $                     ZERO, A(J,J), 1 )
   40       CONTINUE
C
         END IF
      ELSE
C
C        Compute Z'*A*Z.
C
         IF ( UPPER ) THEN
C
C           Compute Z'*A in A (M-by-N).
C
            DO 50 J = 1, N
               CALL DCOPY( J-1, A(1,J), 1, DWORK, 1 )
               CALL DCOPY( N-J+1, A(J,J), LDA, DWORK(J), 1 )
               CALL DGEMV( TRANS, N, M, ONE, Z, LDZ, DWORK, 1, ZERO,
     $                     A(1,J), 1 )
   50       CONTINUE
C
C           Compute A*Z in the upper triangular part of A.
C
            DO 60 I = 1, M
               CALL DCOPY( N, A(I,1), LDA, DWORK, 1 )
               CALL DGEMV( TRANS, N, M-I+1, ONE, Z(1,I), LDZ, DWORK, 1,
     $                     ZERO, A(I,I), LDA )
   60       CONTINUE
C
         ELSE
C
C           Compute A*Z in A (N-by-M).
C
            DO 70 I = 1, N
               CALL DCOPY( I-1, A(I,1), LDA, DWORK, 1 )
               CALL DCOPY( N-I+1, A(I,I), 1, DWORK(I), 1 )
               CALL DGEMV( TRANS, N, M, ONE, Z, LDZ, DWORK, 1, ZERO,
     $                     A(I,1), LDA )
   70       CONTINUE
C
C           Compute Z'*A in the lower triangular part of A.
C
            DO 80 J = 1, M
               CALL DCOPY( N, A(1,J), 1, DWORK, 1 )
               CALL DGEMV( TRANS, N, M-J+1, ONE, Z(1,J), LDZ, DWORK, 1,
     $                     ZERO, A(J,J), 1 )
   80       CONTINUE
C
         END IF
      END IF
C
      RETURN
C *** Last line of MB01RW ***
      END
