BLAS/SRC/ztrmv.f

   1 *> \brief \b ZTRMV
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER INCX,LDA,N
  15 *       CHARACTER DIAG,TRANS,UPLO
  16 *       ..
  17 *       .. Array Arguments ..
  18 *       COMPLEX*16 A(LDA,*),X(*)
  19 *       ..
  20 *
  21 *
  22 *> \par Purpose:
  23 *  =============
  24 *>
  25 *> \verbatim
  26 *>
  27 *> ZTRMV  performs one of the matrix-vector operations
  28 *>
  29 *>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
  30 *>
  31 *> where x is an n element vector and  A is an n by n unit, or non-unit,
  32 *> upper or lower triangular matrix.
  33 *> \endverbatim
  34 *
  35 *  Arguments:
  36 *  ==========
  37 *
  38 *> \param[in] UPLO
  39 *> \verbatim
  40 *>          UPLO is CHARACTER*1
  41 *>           On entry, UPLO specifies whether the matrix is an upper or
  42 *>           lower triangular matrix as follows:
  43 *>
  44 *>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
  45 *>
  46 *>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
  47 *> \endverbatim
  48 *>
  49 *> \param[in] TRANS
  50 *> \verbatim
  51 *>          TRANS is CHARACTER*1
  52 *>           On entry, TRANS specifies the operation to be performed as
  53 *>           follows:
  54 *>
  55 *>              TRANS = 'N' or 'n'   x := A*x.
  56 *>
  57 *>              TRANS = 'T' or 't'   x := A**T*x.
  58 *>
  59 *>              TRANS = 'C' or 'c'   x := A**H*x.
  60 *> \endverbatim
  61 *>
  62 *> \param[in] DIAG
  63 *> \verbatim
  64 *>          DIAG is CHARACTER*1
  65 *>           On entry, DIAG specifies whether or not A is unit
  66 *>           triangular as follows:
  67 *>
  68 *>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
  69 *>
  70 *>              DIAG = 'N' or 'n'   A is not assumed to be unit
  71 *>                                  triangular.
  72 *> \endverbatim
  73 *>
  74 *> \param[in] N
  75 *> \verbatim
  76 *>          N is INTEGER
  77 *>           On entry, N specifies the order of the matrix A.
  78 *>           N must be at least zero.
  79 *> \endverbatim
  80 *>
  81 *> \param[in] A
  82 *> \verbatim
  83 *>          A is COMPLEX*16 array of DIMENSION ( LDA, n ).
  84 *>           Before entry with  UPLO = 'U' or 'u', the leading n by n
  85 *>           upper triangular part of the array A must contain the upper
  86 *>           triangular matrix and the strictly lower triangular part of
  87 *>           A is not referenced.
  88 *>           Before entry with UPLO = 'L' or 'l', the leading n by n
  89 *>           lower triangular part of the array A must contain the lower
  90 *>           triangular matrix and the strictly upper triangular part of
  91 *>           A is not referenced.
  92 *>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
  93 *>           A are not referenced either, but are assumed to be unity.
  94 *> \endverbatim
  95 *>
  96 *> \param[in] LDA
  97 *> \verbatim
  98 *>          LDA is INTEGER
  99 *>           On entry, LDA specifies the first dimension of A as declared
 100 *>           in the calling (sub) program. LDA must be at least
 101 *>           max( 1, n ).
 102 *> \endverbatim
 103 *>
 104 *> \param[in] X
 105 *> \verbatim
 106 *>          X is (input/output) COMPLEX*16 array of dimension at least
 107 *>           ( 1 + ( n - 1 )*abs( INCX ) ).
 108 *>           Before entry, the incremented array X must contain the n
 109 *>           element vector x. On exit, X is overwritten with the
 110 *>           transformed vector x.
 111 *> \endverbatim
 112 *>
 113 *> \param[in] INCX
 114 *> \verbatim
 115 *>          INCX is INTEGER
 116 *>           On entry, INCX specifies the increment for the elements of
 117 *>           X. INCX must not be zero.
 118 *> \endverbatim
 119 *
 120 *  Authors:
 121 *  ========
 122 *
 123 *> \author Univ. of Tennessee
 124 *> \author Univ. of California Berkeley
 125 *> \author Univ. of Colorado Denver
 126 *> \author NAG Ltd.
 127 *
 128 *> \date November 2011
 129 *
 130 *> \ingroup complex16_blas_level2
 131 *
 132 *> \par Further Details:
 133 *  =====================
 134 *>
 135 *> \verbatim
 136 *>
 137 *>  Level 2 Blas routine.
 138 *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
 139 *>
 140 *>  -- Written on 22-October-1986.
 141 *>     Jack Dongarra, Argonne National Lab.
 142 *>     Jeremy Du Croz, Nag Central Office.
 143 *>     Sven Hammarling, Nag Central Office.
 144 *>     Richard Hanson, Sandia National Labs.
 145 *> \endverbatim
 146 *>
 147 *  =====================================================================
 148       SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
 149 *
 150 *  -- Reference BLAS level2 routine (version 3.4.0) --
 151 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 153 *     November 2011
 154 *
 155 *     .. Scalar Arguments ..
 156       INTEGER INCX,LDA,N
 157       CHARACTER DIAG,TRANS,UPLO
 158 *     ..
 159 *     .. Array Arguments ..
 160       COMPLEX*16 A(LDA,*),X(*)
 161 *     ..
 162 *
 163 *  =====================================================================
 164 *
 165 *     .. Parameters ..
 166       COMPLEX*16 ZERO
 167       PARAMETER (ZERO= (0.0D+0,0.0D+0))
 168 *     ..
 169 *     .. Local Scalars ..
 170       COMPLEX*16 TEMP
 171       INTEGER I,INFO,IX,J,JX,KX
 172       LOGICAL NOCONJ,NOUNIT
 173 *     ..
 174 *     .. External Functions ..
 175       LOGICAL LSAME
 176       EXTERNAL LSAME
 177 *     ..
 178 *     .. External Subroutines ..
 179       EXTERNAL XERBLA
 180 *     ..
 181 *     .. Intrinsic Functions ..
 182       INTRINSIC DCONJG,MAX
 183 *     ..
 184 *
 185 *     Test the input parameters.
 186 *
 187       INFO = 0
 188       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
 189           INFO = 1
 190       ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
 191      +         .NOT.LSAME(TRANS,'C')) THEN
 192           INFO = 2
 193       ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
 194           INFO = 3
 195       ELSE IF (N.LT.0) THEN
 196           INFO = 4
 197       ELSE IF (LDA.LT.MAX(1,N)) THEN
 198           INFO = 6
 199       ELSE IF (INCX.EQ.0) THEN
 200           INFO = 8
 201       END IF
 202       IF (INFO.NE.0) THEN
 203           CALL XERBLA('ZTRMV ',INFO)
 204           RETURN
 205       END IF
 206 *
 207 *     Quick return if possible.
 208 *
 209       IF (N.EQ.0) RETURN
 210 *
 211       NOCONJ = LSAME(TRANS,'T')
 212       NOUNIT = LSAME(DIAG,'N')
 213 *
 214 *     Set up the start point in X if the increment is not unity. This
 215 *     will be  ( N - 1 )*INCX  too small for descending loops.
 216 *
 217       IF (INCX.LE.0) THEN
 218           KX = 1 - (N-1)*INCX
 219       ELSE IF (INCX.NE.1) THEN
 220           KX = 1
 221       END IF
 222 *
 223 *     Start the operations. In this version the elements of A are
 224 *     accessed sequentially with one pass through A.
 225 *
 226       IF (LSAME(TRANS,'N')) THEN
 227 *
 228 *        Form  x := A*x.
 229 *
 230           IF (LSAME(UPLO,'U')) THEN
 231               IF (INCX.EQ.1) THEN
 232                   DO 20 J = 1,N
 233                       IF (X(J).NE.ZERO) THEN
 234                           TEMP = X(J)
 235                           DO 10 I = 1,J - 1
 236                               X(I) = X(I) + TEMP*A(I,J)
 237    10                     CONTINUE
 238                           IF (NOUNIT) X(J) = X(J)*A(J,J)
 239                       END IF
 240    20             CONTINUE
 241               ELSE
 242                   JX = KX
 243                   DO 40 J = 1,N
 244                       IF (X(JX).NE.ZERO) THEN
 245                           TEMP = X(JX)
 246                           IX = KX
 247                           DO 30 I = 1,J - 1
 248                               X(IX) = X(IX) + TEMP*A(I,J)
 249                               IX = IX + INCX
 250    30                     CONTINUE
 251                           IF (NOUNIT) X(JX) = X(JX)*A(J,J)
 252                       END IF
 253                       JX = JX + INCX
 254    40             CONTINUE
 255               END IF
 256           ELSE
 257               IF (INCX.EQ.1) THEN
 258                   DO 60 J = N,1,-1
 259                       IF (X(J).NE.ZERO) THEN
 260                           TEMP = X(J)
 261                           DO 50 I = N,J + 1,-1
 262                               X(I) = X(I) + TEMP*A(I,J)
 263    50                     CONTINUE
 264                           IF (NOUNIT) X(J) = X(J)*A(J,J)
 265                       END IF
 266    60             CONTINUE
 267               ELSE
 268                   KX = KX + (N-1)*INCX
 269                   JX = KX
 270                   DO 80 J = N,1,-1
 271                       IF (X(JX).NE.ZERO) THEN
 272                           TEMP = X(JX)
 273                           IX = KX
 274                           DO 70 I = N,J + 1,-1
 275                               X(IX) = X(IX) + TEMP*A(I,J)
 276                               IX = IX - INCX
 277    70                     CONTINUE
 278                           IF (NOUNIT) X(JX) = X(JX)*A(J,J)
 279                       END IF
 280                       JX = JX - INCX
 281    80             CONTINUE
 282               END IF
 283           END IF
 284       ELSE
 285 *
 286 *        Form  x := A**T*x  or  x := A**H*x.
 287 *
 288           IF (LSAME(UPLO,'U')) THEN
 289               IF (INCX.EQ.1) THEN
 290                   DO 110 J = N,1,-1
 291                       TEMP = X(J)
 292                       IF (NOCONJ) THEN
 293                           IF (NOUNIT) TEMP = TEMP*A(J,J)
 294                           DO 90 I = J - 1,1,-1
 295                               TEMP = TEMP + A(I,J)*X(I)
 296    90                     CONTINUE
 297                       ELSE
 298                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
 299                           DO 100 I = J - 1,1,-1
 300                               TEMP = TEMP + DCONJG(A(I,J))*X(I)
 301   100                     CONTINUE
 302                       END IF
 303                       X(J) = TEMP
 304   110             CONTINUE
 305               ELSE
 306                   JX = KX + (N-1)*INCX
 307                   DO 140 J = N,1,-1
 308                       TEMP = X(JX)
 309                       IX = JX
 310                       IF (NOCONJ) THEN
 311                           IF (NOUNIT) TEMP = TEMP*A(J,J)
 312                           DO 120 I = J - 1,1,-1
 313                               IX = IX - INCX
 314                               TEMP = TEMP + A(I,J)*X(IX)
 315   120                     CONTINUE
 316                       ELSE
 317                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
 318                           DO 130 I = J - 1,1,-1
 319                               IX = IX - INCX
 320                               TEMP = TEMP + DCONJG(A(I,J))*X(IX)
 321   130                     CONTINUE
 322                       END IF
 323                       X(JX) = TEMP
 324                       JX = JX - INCX
 325   140             CONTINUE
 326               END IF
 327           ELSE
 328               IF (INCX.EQ.1) THEN
 329                   DO 170 J = 1,N
 330                       TEMP = X(J)
 331                       IF (NOCONJ) THEN
 332                           IF (NOUNIT) TEMP = TEMP*A(J,J)
 333                           DO 150 I = J + 1,N
 334                               TEMP = TEMP + A(I,J)*X(I)
 335   150                     CONTINUE
 336                       ELSE
 337                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
 338                           DO 160 I = J + 1,N
 339                               TEMP = TEMP + DCONJG(A(I,J))*X(I)
 340   160                     CONTINUE
 341                       END IF
 342                       X(J) = TEMP
 343   170             CONTINUE
 344               ELSE
 345                   JX = KX
 346                   DO 200 J = 1,N
 347                       TEMP = X(JX)
 348                       IX = JX
 349                       IF (NOCONJ) THEN
 350                           IF (NOUNIT) TEMP = TEMP*A(J,J)
 351                           DO 180 I = J + 1,N
 352                               IX = IX + INCX
 353                               TEMP = TEMP + A(I,J)*X(IX)
 354   180                     CONTINUE
 355                       ELSE
 356                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
 357                           DO 190 I = J + 1,N
 358                               IX = IX + INCX
 359                               TEMP = TEMP + DCONJG(A(I,J))*X(IX)
 360   190                     CONTINUE
 361                       END IF
 362                       X(JX) = TEMP
 363                       JX = JX + INCX
 364   200             CONTINUE
 365               END IF
 366           END IF
 367       END IF
 368 *
 369       RETURN
 370 *
 371 *     End of ZTRMV .
 372 *
 373       END