Annotation of rpl/lapack/blas/ztrsv.f, revision 1.16

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

CVSweb interface <joel.bertrand@systella.fr>