share/lapack/blas/fortran/ztrsv.f

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