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

1.8       bertrand    1: *> \brief \b ZTRMV
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 ZTRMV(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: *> 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
1.1       bertrand   34: *
1.8       bertrand   35: *  Arguments:
1.1       bertrand   36: *  ==========
                     37: *
1.8       bertrand   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
1.14      bertrand   83: *>          A is COMPLEX*16 array, dimension ( LDA, N ).
1.8       bertrand   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: *>
1.14      bertrand  104: *> \param[in,out] X
1.8       bertrand  105: *> \verbatim
1.14      bertrand  106: *>          X is COMPLEX*16 array, dimension at least
1.8       bertrand  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
1.13      bertrand  110: *>           transformed vector x.
1.8       bertrand  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: *
1.13      bertrand  123: *> \author Univ. of Tennessee
                    124: *> \author Univ. of California Berkeley
                    125: *> \author Univ. of Colorado Denver
                    126: *> \author NAG Ltd.
1.8       bertrand  127: *
                    128: *> \ingroup complex16_blas_level2
                    129: *
                    130: *> \par Further Details:
                    131: *  =====================
                    132: *>
                    133: *> \verbatim
                    134: *>
                    135: *>  Level 2 Blas routine.
                    136: *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
                    137: *>
                    138: *>  -- Written on 22-October-1986.
                    139: *>     Jack Dongarra, Argonne National Lab.
                    140: *>     Jeremy Du Croz, Nag Central Office.
                    141: *>     Sven Hammarling, Nag Central Office.
                    142: *>     Richard Hanson, Sandia National Labs.
                    143: *> \endverbatim
                    144: *>
                    145: *  =====================================================================
                    146:       SUBROUTINE ZTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
1.1       bertrand  147: *
1.16    ! bertrand  148: *  -- Reference BLAS level2 routine --
1.8       bertrand  149: *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
                    150: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.1       bertrand  151: *
1.8       bertrand  152: *     .. Scalar Arguments ..
                    153:       INTEGER INCX,LDA,N
                    154:       CHARACTER DIAG,TRANS,UPLO
                    155: *     ..
                    156: *     .. Array Arguments ..
                    157:       COMPLEX*16 A(LDA,*),X(*)
                    158: *     ..
1.1       bertrand  159: *
                    160: *  =====================================================================
                    161: *
                    162: *     .. Parameters ..
1.8       bertrand  163:       COMPLEX*16 ZERO
1.1       bertrand  164:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
                    165: *     ..
                    166: *     .. Local Scalars ..
1.8       bertrand  167:       COMPLEX*16 TEMP
1.1       bertrand  168:       INTEGER I,INFO,IX,J,JX,KX
                    169:       LOGICAL NOCONJ,NOUNIT
                    170: *     ..
                    171: *     .. External Functions ..
                    172:       LOGICAL LSAME
                    173:       EXTERNAL LSAME
                    174: *     ..
                    175: *     .. External Subroutines ..
                    176:       EXTERNAL XERBLA
                    177: *     ..
                    178: *     .. Intrinsic Functions ..
                    179:       INTRINSIC DCONJG,MAX
                    180: *     ..
                    181: *
                    182: *     Test the input parameters.
                    183: *
                    184:       INFO = 0
                    185:       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
                    186:           INFO = 1
                    187:       ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
                    188:      +         .NOT.LSAME(TRANS,'C')) THEN
                    189:           INFO = 2
                    190:       ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
                    191:           INFO = 3
                    192:       ELSE IF (N.LT.0) THEN
                    193:           INFO = 4
                    194:       ELSE IF (LDA.LT.MAX(1,N)) THEN
                    195:           INFO = 6
                    196:       ELSE IF (INCX.EQ.0) THEN
                    197:           INFO = 8
                    198:       END IF
                    199:       IF (INFO.NE.0) THEN
                    200:           CALL XERBLA('ZTRMV ',INFO)
                    201:           RETURN
                    202:       END IF
                    203: *
                    204: *     Quick return if possible.
                    205: *
                    206:       IF (N.EQ.0) RETURN
                    207: *
                    208:       NOCONJ = LSAME(TRANS,'T')
                    209:       NOUNIT = LSAME(DIAG,'N')
                    210: *
                    211: *     Set up the start point in X if the increment is not unity. This
                    212: *     will be  ( N - 1 )*INCX  too small for descending loops.
                    213: *
                    214:       IF (INCX.LE.0) THEN
                    215:           KX = 1 - (N-1)*INCX
                    216:       ELSE IF (INCX.NE.1) THEN
                    217:           KX = 1
                    218:       END IF
                    219: *
                    220: *     Start the operations. In this version the elements of A are
                    221: *     accessed sequentially with one pass through A.
                    222: *
                    223:       IF (LSAME(TRANS,'N')) THEN
                    224: *
                    225: *        Form  x := A*x.
                    226: *
                    227:           IF (LSAME(UPLO,'U')) THEN
                    228:               IF (INCX.EQ.1) THEN
                    229:                   DO 20 J = 1,N
                    230:                       IF (X(J).NE.ZERO) THEN
                    231:                           TEMP = X(J)
                    232:                           DO 10 I = 1,J - 1
                    233:                               X(I) = X(I) + TEMP*A(I,J)
                    234:    10                     CONTINUE
                    235:                           IF (NOUNIT) X(J) = X(J)*A(J,J)
                    236:                       END IF
                    237:    20             CONTINUE
                    238:               ELSE
                    239:                   JX = KX
                    240:                   DO 40 J = 1,N
                    241:                       IF (X(JX).NE.ZERO) THEN
                    242:                           TEMP = X(JX)
                    243:                           IX = KX
                    244:                           DO 30 I = 1,J - 1
                    245:                               X(IX) = X(IX) + TEMP*A(I,J)
                    246:                               IX = IX + INCX
                    247:    30                     CONTINUE
                    248:                           IF (NOUNIT) X(JX) = X(JX)*A(J,J)
                    249:                       END IF
                    250:                       JX = JX + INCX
                    251:    40             CONTINUE
                    252:               END IF
                    253:           ELSE
                    254:               IF (INCX.EQ.1) THEN
                    255:                   DO 60 J = N,1,-1
                    256:                       IF (X(J).NE.ZERO) THEN
                    257:                           TEMP = X(J)
                    258:                           DO 50 I = N,J + 1,-1
                    259:                               X(I) = X(I) + TEMP*A(I,J)
                    260:    50                     CONTINUE
                    261:                           IF (NOUNIT) X(J) = X(J)*A(J,J)
                    262:                       END IF
                    263:    60             CONTINUE
                    264:               ELSE
                    265:                   KX = KX + (N-1)*INCX
                    266:                   JX = KX
                    267:                   DO 80 J = N,1,-1
                    268:                       IF (X(JX).NE.ZERO) THEN
                    269:                           TEMP = X(JX)
                    270:                           IX = KX
                    271:                           DO 70 I = N,J + 1,-1
                    272:                               X(IX) = X(IX) + TEMP*A(I,J)
                    273:                               IX = IX - INCX
                    274:    70                     CONTINUE
                    275:                           IF (NOUNIT) X(JX) = X(JX)*A(J,J)
                    276:                       END IF
                    277:                       JX = JX - INCX
                    278:    80             CONTINUE
                    279:               END IF
                    280:           END IF
                    281:       ELSE
                    282: *
1.7       bertrand  283: *        Form  x := A**T*x  or  x := A**H*x.
1.1       bertrand  284: *
                    285:           IF (LSAME(UPLO,'U')) THEN
                    286:               IF (INCX.EQ.1) THEN
                    287:                   DO 110 J = N,1,-1
                    288:                       TEMP = X(J)
                    289:                       IF (NOCONJ) THEN
                    290:                           IF (NOUNIT) TEMP = TEMP*A(J,J)
                    291:                           DO 90 I = J - 1,1,-1
                    292:                               TEMP = TEMP + A(I,J)*X(I)
                    293:    90                     CONTINUE
                    294:                       ELSE
                    295:                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
                    296:                           DO 100 I = J - 1,1,-1
                    297:                               TEMP = TEMP + DCONJG(A(I,J))*X(I)
                    298:   100                     CONTINUE
                    299:                       END IF
                    300:                       X(J) = TEMP
                    301:   110             CONTINUE
                    302:               ELSE
                    303:                   JX = KX + (N-1)*INCX
                    304:                   DO 140 J = N,1,-1
                    305:                       TEMP = X(JX)
                    306:                       IX = JX
                    307:                       IF (NOCONJ) THEN
                    308:                           IF (NOUNIT) TEMP = TEMP*A(J,J)
                    309:                           DO 120 I = J - 1,1,-1
                    310:                               IX = IX - INCX
                    311:                               TEMP = TEMP + A(I,J)*X(IX)
                    312:   120                     CONTINUE
                    313:                       ELSE
                    314:                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
                    315:                           DO 130 I = J - 1,1,-1
                    316:                               IX = IX - INCX
                    317:                               TEMP = TEMP + DCONJG(A(I,J))*X(IX)
                    318:   130                     CONTINUE
                    319:                       END IF
                    320:                       X(JX) = TEMP
                    321:                       JX = JX - INCX
                    322:   140             CONTINUE
                    323:               END IF
                    324:           ELSE
                    325:               IF (INCX.EQ.1) THEN
                    326:                   DO 170 J = 1,N
                    327:                       TEMP = X(J)
                    328:                       IF (NOCONJ) THEN
                    329:                           IF (NOUNIT) TEMP = TEMP*A(J,J)
                    330:                           DO 150 I = J + 1,N
                    331:                               TEMP = TEMP + A(I,J)*X(I)
                    332:   150                     CONTINUE
                    333:                       ELSE
                    334:                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
                    335:                           DO 160 I = J + 1,N
                    336:                               TEMP = TEMP + DCONJG(A(I,J))*X(I)
                    337:   160                     CONTINUE
                    338:                       END IF
                    339:                       X(J) = TEMP
                    340:   170             CONTINUE
                    341:               ELSE
                    342:                   JX = KX
                    343:                   DO 200 J = 1,N
                    344:                       TEMP = X(JX)
                    345:                       IX = JX
                    346:                       IF (NOCONJ) THEN
                    347:                           IF (NOUNIT) TEMP = TEMP*A(J,J)
                    348:                           DO 180 I = J + 1,N
                    349:                               IX = IX + INCX
                    350:                               TEMP = TEMP + A(I,J)*X(IX)
                    351:   180                     CONTINUE
                    352:                       ELSE
                    353:                           IF (NOUNIT) TEMP = TEMP*DCONJG(A(J,J))
                    354:                           DO 190 I = J + 1,N
                    355:                               IX = IX + INCX
                    356:                               TEMP = TEMP + DCONJG(A(I,J))*X(IX)
                    357:   190                     CONTINUE
                    358:                       END IF
                    359:                       X(JX) = TEMP
                    360:                       JX = JX + INCX
                    361:   200             CONTINUE
                    362:               END IF
                    363:           END IF
                    364:       END IF
                    365: *
                    366:       RETURN
                    367: *
1.16    ! bertrand  368: *     End of ZTRMV
1.1       bertrand  369: *
                    370:       END

CVSweb interface <joel.bertrand@systella.fr>