Annotation of rpl/lapack/lapack/zspmv.f, revision 1.18

1.11      bertrand    1: *> \brief \b ZSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix
1.8       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.15      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.8       bertrand    7: *
                      8: *> \htmlonly
1.15      bertrand    9: *> Download ZSPMV + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zspmv.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zspmv.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zspmv.f">
1.8       bertrand   15: *> [TXT]</a>
1.15      bertrand   16: *> \endhtmlonly
1.8       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
1.15      bertrand   22: *
1.8       bertrand   23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          UPLO
                     25: *       INTEGER            INCX, INCY, N
                     26: *       COMPLEX*16         ALPHA, BETA
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       COMPLEX*16         AP( * ), X( * ), Y( * )
                     30: *       ..
1.15      bertrand   31: *
1.8       bertrand   32: *
                     33: *> \par Purpose:
                     34: *  =============
                     35: *>
                     36: *> \verbatim
                     37: *>
                     38: *> ZSPMV  performs the matrix-vector operation
                     39: *>
                     40: *>    y := alpha*A*x + beta*y,
                     41: *>
                     42: *> where alpha and beta are scalars, x and y are n element vectors and
                     43: *> A is an n by n symmetric matrix, supplied in packed form.
                     44: *> \endverbatim
                     45: *
                     46: *  Arguments:
                     47: *  ==========
                     48: *
                     49: *> \param[in] UPLO
                     50: *> \verbatim
                     51: *>          UPLO is CHARACTER*1
                     52: *>           On entry, UPLO specifies whether the upper or lower
                     53: *>           triangular part of the matrix A is supplied in the packed
                     54: *>           array AP as follows:
                     55: *>
                     56: *>              UPLO = 'U' or 'u'   The upper triangular part of A is
                     57: *>                                  supplied in AP.
                     58: *>
                     59: *>              UPLO = 'L' or 'l'   The lower triangular part of A is
                     60: *>                                  supplied in AP.
                     61: *>
                     62: *>           Unchanged on exit.
                     63: *> \endverbatim
                     64: *>
                     65: *> \param[in] N
                     66: *> \verbatim
                     67: *>          N is INTEGER
                     68: *>           On entry, N specifies the order of the matrix A.
                     69: *>           N must be at least zero.
                     70: *>           Unchanged on exit.
                     71: *> \endverbatim
                     72: *>
                     73: *> \param[in] ALPHA
                     74: *> \verbatim
                     75: *>          ALPHA is COMPLEX*16
                     76: *>           On entry, ALPHA specifies the scalar alpha.
                     77: *>           Unchanged on exit.
                     78: *> \endverbatim
                     79: *>
                     80: *> \param[in] AP
                     81: *> \verbatim
                     82: *>          AP is COMPLEX*16 array, dimension at least
                     83: *>           ( ( N*( N + 1 ) )/2 ).
                     84: *>           Before entry, with UPLO = 'U' or 'u', the array AP must
                     85: *>           contain the upper triangular part of the symmetric matrix
                     86: *>           packed sequentially, column by column, so that AP( 1 )
                     87: *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
                     88: *>           and a( 2, 2 ) respectively, and so on.
                     89: *>           Before entry, with UPLO = 'L' or 'l', the array AP must
                     90: *>           contain the lower triangular part of the symmetric matrix
                     91: *>           packed sequentially, column by column, so that AP( 1 )
                     92: *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
                     93: *>           and a( 3, 1 ) respectively, and so on.
                     94: *>           Unchanged on exit.
                     95: *> \endverbatim
                     96: *>
                     97: *> \param[in] X
                     98: *> \verbatim
                     99: *>          X is COMPLEX*16 array, dimension at least
                    100: *>           ( 1 + ( N - 1 )*abs( INCX ) ).
                    101: *>           Before entry, the incremented array X must contain the N-
                    102: *>           element vector x.
                    103: *>           Unchanged on exit.
                    104: *> \endverbatim
                    105: *>
                    106: *> \param[in] INCX
                    107: *> \verbatim
                    108: *>          INCX is INTEGER
                    109: *>           On entry, INCX specifies the increment for the elements of
                    110: *>           X. INCX must not be zero.
                    111: *>           Unchanged on exit.
                    112: *> \endverbatim
                    113: *>
                    114: *> \param[in] BETA
                    115: *> \verbatim
                    116: *>          BETA is COMPLEX*16
                    117: *>           On entry, BETA specifies the scalar beta. When BETA is
                    118: *>           supplied as zero then Y need not be set on input.
                    119: *>           Unchanged on exit.
                    120: *> \endverbatim
                    121: *>
                    122: *> \param[in,out] Y
                    123: *> \verbatim
                    124: *>          Y is COMPLEX*16 array, dimension at least
                    125: *>           ( 1 + ( N - 1 )*abs( INCY ) ).
                    126: *>           Before entry, the incremented array Y must contain the n
                    127: *>           element vector y. On exit, Y is overwritten by the updated
                    128: *>           vector y.
                    129: *> \endverbatim
                    130: *>
                    131: *> \param[in] INCY
                    132: *> \verbatim
                    133: *>          INCY is INTEGER
                    134: *>           On entry, INCY specifies the increment for the elements of
                    135: *>           Y. INCY must not be zero.
                    136: *>           Unchanged on exit.
                    137: *> \endverbatim
                    138: *
                    139: *  Authors:
                    140: *  ========
                    141: *
1.15      bertrand  142: *> \author Univ. of Tennessee
                    143: *> \author Univ. of California Berkeley
                    144: *> \author Univ. of Colorado Denver
                    145: *> \author NAG Ltd.
1.8       bertrand  146: *
                    147: *> \ingroup complex16OTHERauxiliary
                    148: *
                    149: *  =====================================================================
1.1       bertrand  150:       SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
                    151: *
1.18    ! bertrand  152: *  -- LAPACK auxiliary routine --
1.1       bertrand  153: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    154: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    155: *
                    156: *     .. Scalar Arguments ..
                    157:       CHARACTER          UPLO
                    158:       INTEGER            INCX, INCY, N
                    159:       COMPLEX*16         ALPHA, BETA
                    160: *     ..
                    161: *     .. Array Arguments ..
                    162:       COMPLEX*16         AP( * ), X( * ), Y( * )
                    163: *     ..
                    164: *
                    165: * =====================================================================
                    166: *
                    167: *     .. Parameters ..
                    168:       COMPLEX*16         ONE
                    169:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
                    170:       COMPLEX*16         ZERO
                    171:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
                    172: *     ..
                    173: *     .. Local Scalars ..
                    174:       INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
                    175:       COMPLEX*16         TEMP1, TEMP2
                    176: *     ..
                    177: *     .. External Functions ..
                    178:       LOGICAL            LSAME
                    179:       EXTERNAL           LSAME
                    180: *     ..
                    181: *     .. External Subroutines ..
                    182:       EXTERNAL           XERBLA
                    183: *     ..
                    184: *     .. Executable Statements ..
                    185: *
                    186: *     Test the input parameters.
                    187: *
                    188:       INFO = 0
                    189:       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    190:          INFO = 1
                    191:       ELSE IF( N.LT.0 ) THEN
                    192:          INFO = 2
                    193:       ELSE IF( INCX.EQ.0 ) THEN
                    194:          INFO = 6
                    195:       ELSE IF( INCY.EQ.0 ) THEN
                    196:          INFO = 9
                    197:       END IF
                    198:       IF( INFO.NE.0 ) THEN
                    199:          CALL XERBLA( 'ZSPMV ', INFO )
                    200:          RETURN
                    201:       END IF
                    202: *
                    203: *     Quick return if possible.
                    204: *
                    205:       IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
                    206:      $   RETURN
                    207: *
                    208: *     Set up the start points in  X  and  Y.
                    209: *
                    210:       IF( INCX.GT.0 ) THEN
                    211:          KX = 1
                    212:       ELSE
                    213:          KX = 1 - ( N-1 )*INCX
                    214:       END IF
                    215:       IF( INCY.GT.0 ) THEN
                    216:          KY = 1
                    217:       ELSE
                    218:          KY = 1 - ( N-1 )*INCY
                    219:       END IF
                    220: *
                    221: *     Start the operations. In this version the elements of the array AP
                    222: *     are accessed sequentially with one pass through AP.
                    223: *
                    224: *     First form  y := beta*y.
                    225: *
                    226:       IF( BETA.NE.ONE ) THEN
                    227:          IF( INCY.EQ.1 ) THEN
                    228:             IF( BETA.EQ.ZERO ) THEN
                    229:                DO 10 I = 1, N
                    230:                   Y( I ) = ZERO
                    231:    10          CONTINUE
                    232:             ELSE
                    233:                DO 20 I = 1, N
                    234:                   Y( I ) = BETA*Y( I )
                    235:    20          CONTINUE
                    236:             END IF
                    237:          ELSE
                    238:             IY = KY
                    239:             IF( BETA.EQ.ZERO ) THEN
                    240:                DO 30 I = 1, N
                    241:                   Y( IY ) = ZERO
                    242:                   IY = IY + INCY
                    243:    30          CONTINUE
                    244:             ELSE
                    245:                DO 40 I = 1, N
                    246:                   Y( IY ) = BETA*Y( IY )
                    247:                   IY = IY + INCY
                    248:    40          CONTINUE
                    249:             END IF
                    250:          END IF
                    251:       END IF
                    252:       IF( ALPHA.EQ.ZERO )
                    253:      $   RETURN
                    254:       KK = 1
                    255:       IF( LSAME( UPLO, 'U' ) ) THEN
                    256: *
                    257: *        Form  y  when AP contains the upper triangle.
                    258: *
                    259:          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
                    260:             DO 60 J = 1, N
                    261:                TEMP1 = ALPHA*X( J )
                    262:                TEMP2 = ZERO
                    263:                K = KK
                    264:                DO 50 I = 1, J - 1
                    265:                   Y( I ) = Y( I ) + TEMP1*AP( K )
                    266:                   TEMP2 = TEMP2 + AP( K )*X( I )
                    267:                   K = K + 1
                    268:    50          CONTINUE
                    269:                Y( J ) = Y( J ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
                    270:                KK = KK + J
                    271:    60       CONTINUE
                    272:          ELSE
                    273:             JX = KX
                    274:             JY = KY
                    275:             DO 80 J = 1, N
                    276:                TEMP1 = ALPHA*X( JX )
                    277:                TEMP2 = ZERO
                    278:                IX = KX
                    279:                IY = KY
                    280:                DO 70 K = KK, KK + J - 2
                    281:                   Y( IY ) = Y( IY ) + TEMP1*AP( K )
                    282:                   TEMP2 = TEMP2 + AP( K )*X( IX )
                    283:                   IX = IX + INCX
                    284:                   IY = IY + INCY
                    285:    70          CONTINUE
                    286:                Y( JY ) = Y( JY ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
                    287:                JX = JX + INCX
                    288:                JY = JY + INCY
                    289:                KK = KK + J
                    290:    80       CONTINUE
                    291:          END IF
                    292:       ELSE
                    293: *
                    294: *        Form  y  when AP contains the lower triangle.
                    295: *
                    296:          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
                    297:             DO 100 J = 1, N
                    298:                TEMP1 = ALPHA*X( J )
                    299:                TEMP2 = ZERO
                    300:                Y( J ) = Y( J ) + TEMP1*AP( KK )
                    301:                K = KK + 1
                    302:                DO 90 I = J + 1, N
                    303:                   Y( I ) = Y( I ) + TEMP1*AP( K )
                    304:                   TEMP2 = TEMP2 + AP( K )*X( I )
                    305:                   K = K + 1
                    306:    90          CONTINUE
                    307:                Y( J ) = Y( J ) + ALPHA*TEMP2
                    308:                KK = KK + ( N-J+1 )
                    309:   100       CONTINUE
                    310:          ELSE
                    311:             JX = KX
                    312:             JY = KY
                    313:             DO 120 J = 1, N
                    314:                TEMP1 = ALPHA*X( JX )
                    315:                TEMP2 = ZERO
                    316:                Y( JY ) = Y( JY ) + TEMP1*AP( KK )
                    317:                IX = JX
                    318:                IY = JY
                    319:                DO 110 K = KK + 1, KK + N - J
                    320:                   IX = IX + INCX
                    321:                   IY = IY + INCY
                    322:                   Y( IY ) = Y( IY ) + TEMP1*AP( K )
                    323:                   TEMP2 = TEMP2 + AP( K )*X( IX )
                    324:   110          CONTINUE
                    325:                Y( JY ) = Y( JY ) + ALPHA*TEMP2
                    326:                JX = JX + INCX
                    327:                JY = JY + INCY
                    328:                KK = KK + ( N-J+1 )
                    329:   120       CONTINUE
                    330:          END IF
                    331:       END IF
                    332: *
                    333:       RETURN
                    334: *
                    335: *     End of ZSPMV
                    336: *
                    337:       END

CVSweb interface <joel.bertrand@systella.fr>