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

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: *
1.13      bertrand  128: *> \date December 2016
1.8       bertrand  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)
1.1       bertrand  149: *
1.13      bertrand  150: *  -- Reference BLAS level2 routine (version 3.7.0) --
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.13      bertrand  153: *     December 2016
1.1       bertrand  154: *
1.8       bertrand  155: *     .. Scalar Arguments ..
                    156:       INTEGER INCX,LDA,N
                    157:       CHARACTER DIAG,TRANS,UPLO
                    158: *     ..
                    159: *     .. Array Arguments ..
                    160:       COMPLEX*16 A(LDA,*),X(*)
                    161: *     ..
1.1       bertrand  162: *
                    163: *  =====================================================================
                    164: *
                    165: *     .. Parameters ..
1.8       bertrand  166:       COMPLEX*16 ZERO
1.1       bertrand  167:       PARAMETER (ZERO= (0.0D+0,0.0D+0))
                    168: *     ..
                    169: *     .. Local Scalars ..
1.8       bertrand  170:       COMPLEX*16 TEMP
1.1       bertrand  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: *
1.7       bertrand  286: *        Form  x := A**T*x  or  x := A**H*x.
1.1       bertrand  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

CVSweb interface <joel.bertrand@systella.fr>