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

1.8     ! bertrand    1: *> \brief \b ZSPMV
        !             2: *
        !             3: *  =========== DOCUMENTATION ===========
        !             4: *
        !             5: * Online html documentation available at 
        !             6: *            http://www.netlib.org/lapack/explore-html/ 
        !             7: *
        !             8: *> \htmlonly
        !             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"> 
        !            15: *> [TXT]</a>
        !            16: *> \endhtmlonly 
        !            17: *
        !            18: *  Definition:
        !            19: *  ===========
        !            20: *
        !            21: *       SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
        !            22: * 
        !            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: *       ..
        !            31: *  
        !            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: *
        !           142: *> \author Univ. of Tennessee 
        !           143: *> \author Univ. of California Berkeley 
        !           144: *> \author Univ. of Colorado Denver 
        !           145: *> \author NAG Ltd. 
        !           146: *
        !           147: *> \date November 2011
        !           148: *
        !           149: *> \ingroup complex16OTHERauxiliary
        !           150: *
        !           151: *  =====================================================================
1.1       bertrand  152:       SUBROUTINE ZSPMV( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
                    153: *
1.8     ! bertrand  154: *  -- LAPACK auxiliary routine (version 3.4.0) --
1.1       bertrand  155: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    156: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8     ! bertrand  157: *     November 2011
1.1       bertrand  158: *
                    159: *     .. Scalar Arguments ..
                    160:       CHARACTER          UPLO
                    161:       INTEGER            INCX, INCY, N
                    162:       COMPLEX*16         ALPHA, BETA
                    163: *     ..
                    164: *     .. Array Arguments ..
                    165:       COMPLEX*16         AP( * ), X( * ), Y( * )
                    166: *     ..
                    167: *
                    168: * =====================================================================
                    169: *
                    170: *     .. Parameters ..
                    171:       COMPLEX*16         ONE
                    172:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
                    173:       COMPLEX*16         ZERO
                    174:       PARAMETER          ( ZERO = ( 0.0D+0, 0.0D+0 ) )
                    175: *     ..
                    176: *     .. Local Scalars ..
                    177:       INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
                    178:       COMPLEX*16         TEMP1, TEMP2
                    179: *     ..
                    180: *     .. External Functions ..
                    181:       LOGICAL            LSAME
                    182:       EXTERNAL           LSAME
                    183: *     ..
                    184: *     .. External Subroutines ..
                    185:       EXTERNAL           XERBLA
                    186: *     ..
                    187: *     .. Executable Statements ..
                    188: *
                    189: *     Test the input parameters.
                    190: *
                    191:       INFO = 0
                    192:       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
                    193:          INFO = 1
                    194:       ELSE IF( N.LT.0 ) THEN
                    195:          INFO = 2
                    196:       ELSE IF( INCX.EQ.0 ) THEN
                    197:          INFO = 6
                    198:       ELSE IF( INCY.EQ.0 ) THEN
                    199:          INFO = 9
                    200:       END IF
                    201:       IF( INFO.NE.0 ) THEN
                    202:          CALL XERBLA( 'ZSPMV ', INFO )
                    203:          RETURN
                    204:       END IF
                    205: *
                    206: *     Quick return if possible.
                    207: *
                    208:       IF( ( N.EQ.0 ) .OR. ( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ONE ) ) )
                    209:      $   RETURN
                    210: *
                    211: *     Set up the start points in  X  and  Y.
                    212: *
                    213:       IF( INCX.GT.0 ) THEN
                    214:          KX = 1
                    215:       ELSE
                    216:          KX = 1 - ( N-1 )*INCX
                    217:       END IF
                    218:       IF( INCY.GT.0 ) THEN
                    219:          KY = 1
                    220:       ELSE
                    221:          KY = 1 - ( N-1 )*INCY
                    222:       END IF
                    223: *
                    224: *     Start the operations. In this version the elements of the array AP
                    225: *     are accessed sequentially with one pass through AP.
                    226: *
                    227: *     First form  y := beta*y.
                    228: *
                    229:       IF( BETA.NE.ONE ) THEN
                    230:          IF( INCY.EQ.1 ) THEN
                    231:             IF( BETA.EQ.ZERO ) THEN
                    232:                DO 10 I = 1, N
                    233:                   Y( I ) = ZERO
                    234:    10          CONTINUE
                    235:             ELSE
                    236:                DO 20 I = 1, N
                    237:                   Y( I ) = BETA*Y( I )
                    238:    20          CONTINUE
                    239:             END IF
                    240:          ELSE
                    241:             IY = KY
                    242:             IF( BETA.EQ.ZERO ) THEN
                    243:                DO 30 I = 1, N
                    244:                   Y( IY ) = ZERO
                    245:                   IY = IY + INCY
                    246:    30          CONTINUE
                    247:             ELSE
                    248:                DO 40 I = 1, N
                    249:                   Y( IY ) = BETA*Y( IY )
                    250:                   IY = IY + INCY
                    251:    40          CONTINUE
                    252:             END IF
                    253:          END IF
                    254:       END IF
                    255:       IF( ALPHA.EQ.ZERO )
                    256:      $   RETURN
                    257:       KK = 1
                    258:       IF( LSAME( UPLO, 'U' ) ) THEN
                    259: *
                    260: *        Form  y  when AP contains the upper triangle.
                    261: *
                    262:          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
                    263:             DO 60 J = 1, N
                    264:                TEMP1 = ALPHA*X( J )
                    265:                TEMP2 = ZERO
                    266:                K = KK
                    267:                DO 50 I = 1, J - 1
                    268:                   Y( I ) = Y( I ) + TEMP1*AP( K )
                    269:                   TEMP2 = TEMP2 + AP( K )*X( I )
                    270:                   K = K + 1
                    271:    50          CONTINUE
                    272:                Y( J ) = Y( J ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
                    273:                KK = KK + J
                    274:    60       CONTINUE
                    275:          ELSE
                    276:             JX = KX
                    277:             JY = KY
                    278:             DO 80 J = 1, N
                    279:                TEMP1 = ALPHA*X( JX )
                    280:                TEMP2 = ZERO
                    281:                IX = KX
                    282:                IY = KY
                    283:                DO 70 K = KK, KK + J - 2
                    284:                   Y( IY ) = Y( IY ) + TEMP1*AP( K )
                    285:                   TEMP2 = TEMP2 + AP( K )*X( IX )
                    286:                   IX = IX + INCX
                    287:                   IY = IY + INCY
                    288:    70          CONTINUE
                    289:                Y( JY ) = Y( JY ) + TEMP1*AP( KK+J-1 ) + ALPHA*TEMP2
                    290:                JX = JX + INCX
                    291:                JY = JY + INCY
                    292:                KK = KK + J
                    293:    80       CONTINUE
                    294:          END IF
                    295:       ELSE
                    296: *
                    297: *        Form  y  when AP contains the lower triangle.
                    298: *
                    299:          IF( ( INCX.EQ.1 ) .AND. ( INCY.EQ.1 ) ) THEN
                    300:             DO 100 J = 1, N
                    301:                TEMP1 = ALPHA*X( J )
                    302:                TEMP2 = ZERO
                    303:                Y( J ) = Y( J ) + TEMP1*AP( KK )
                    304:                K = KK + 1
                    305:                DO 90 I = J + 1, N
                    306:                   Y( I ) = Y( I ) + TEMP1*AP( K )
                    307:                   TEMP2 = TEMP2 + AP( K )*X( I )
                    308:                   K = K + 1
                    309:    90          CONTINUE
                    310:                Y( J ) = Y( J ) + ALPHA*TEMP2
                    311:                KK = KK + ( N-J+1 )
                    312:   100       CONTINUE
                    313:          ELSE
                    314:             JX = KX
                    315:             JY = KY
                    316:             DO 120 J = 1, N
                    317:                TEMP1 = ALPHA*X( JX )
                    318:                TEMP2 = ZERO
                    319:                Y( JY ) = Y( JY ) + TEMP1*AP( KK )
                    320:                IX = JX
                    321:                IY = JY
                    322:                DO 110 K = KK + 1, KK + N - J
                    323:                   IX = IX + INCX
                    324:                   IY = IY + INCY
                    325:                   Y( IY ) = Y( IY ) + TEMP1*AP( K )
                    326:                   TEMP2 = TEMP2 + AP( K )*X( IX )
                    327:   110          CONTINUE
                    328:                Y( JY ) = Y( JY ) + ALPHA*TEMP2
                    329:                JX = JX + INCX
                    330:                JY = JY + INCY
                    331:                KK = KK + ( N-J+1 )
                    332:   120       CONTINUE
                    333:          END IF
                    334:       END IF
                    335: *
                    336:       RETURN
                    337: *
                    338: *     End of ZSPMV
                    339: *
                    340:       END

CVSweb interface <joel.bertrand@systella.fr>