share/lapack/blas/fortran/ztrmv.f

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