LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zhpmv.f
Go to the documentation of this file.
00001 *> \brief \b ZHPMV
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE ZHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       COMPLEX*16 ALPHA,BETA
00015 *       INTEGER INCX,INCY,N
00016 *       CHARACTER UPLO
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       COMPLEX*16 AP(*),X(*),Y(*)
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> ZHPMV  performs the matrix-vector operation
00029 *>
00030 *>    y := alpha*A*x + beta*y,
00031 *>
00032 *> where alpha and beta are scalars, x and y are n element vectors and
00033 *> A is an n by n hermitian matrix, supplied in packed form.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] UPLO
00040 *> \verbatim
00041 *>          UPLO is CHARACTER*1
00042 *>           On entry, UPLO specifies whether the upper or lower
00043 *>           triangular part of the matrix A is supplied in the packed
00044 *>           array AP as follows:
00045 *>
00046 *>              UPLO = 'U' or 'u'   The upper triangular part of A is
00047 *>                                  supplied in AP.
00048 *>
00049 *>              UPLO = 'L' or 'l'   The lower triangular part of A is
00050 *>                                  supplied in AP.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] N
00054 *> \verbatim
00055 *>          N is INTEGER
00056 *>           On entry, N specifies the order of the matrix A.
00057 *>           N must be at least zero.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] ALPHA
00061 *> \verbatim
00062 *>          ALPHA is COMPLEX*16
00063 *>           On entry, ALPHA specifies the scalar alpha.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] AP
00067 *> \verbatim
00068 *>          AP is COMPLEX*16 array of DIMENSION at least
00069 *>           ( ( n*( n + 1 ) )/2 ).
00070 *>           Before entry with UPLO = 'U' or 'u', the array AP must
00071 *>           contain the upper triangular part of the hermitian matrix
00072 *>           packed sequentially, column by column, so that AP( 1 )
00073 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
00074 *>           and a( 2, 2 ) respectively, and so on.
00075 *>           Before entry with UPLO = 'L' or 'l', the array AP must
00076 *>           contain the lower triangular part of the hermitian matrix
00077 *>           packed sequentially, column by column, so that AP( 1 )
00078 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
00079 *>           and a( 3, 1 ) respectively, and so on.
00080 *>           Note that the imaginary parts of the diagonal elements need
00081 *>           not be set and are assumed to be zero.
00082 *> \endverbatim
00083 *>
00084 *> \param[in] X
00085 *> \verbatim
00086 *>          X is COMPLEX*16 array of dimension at least
00087 *>           ( 1 + ( n - 1 )*abs( INCX ) ).
00088 *>           Before entry, the incremented array X must contain the n
00089 *>           element vector x.
00090 *> \endverbatim
00091 *>
00092 *> \param[in] INCX
00093 *> \verbatim
00094 *>          INCX is INTEGER
00095 *>           On entry, INCX specifies the increment for the elements of
00096 *>           X. INCX must not be zero.
00097 *> \endverbatim
00098 *>
00099 *> \param[in] BETA
00100 *> \verbatim
00101 *>          BETA is COMPLEX*16
00102 *>           On entry, BETA specifies the scalar beta. When BETA is
00103 *>           supplied as zero then Y need not be set on input.
00104 *> \endverbatim
00105 *>
00106 *> \param[in,out] Y
00107 *> \verbatim
00108 *>          Y is COMPLEX*16 array of dimension at least
00109 *>           ( 1 + ( n - 1 )*abs( INCY ) ).
00110 *>           Before entry, the incremented array Y must contain the n
00111 *>           element vector y. On exit, Y is overwritten by the updated
00112 *>           vector y.
00113 *> \endverbatim
00114 *>
00115 *> \param[in] INCY
00116 *> \verbatim
00117 *>          INCY is INTEGER
00118 *>           On entry, INCY specifies the increment for the elements of
00119 *>           Y. INCY must not be zero.
00120 *> \endverbatim
00121 *
00122 *  Authors:
00123 *  ========
00124 *
00125 *> \author Univ. of Tennessee 
00126 *> \author Univ. of California Berkeley 
00127 *> \author Univ. of Colorado Denver 
00128 *> \author NAG Ltd. 
00129 *
00130 *> \date November 2011
00131 *
00132 *> \ingroup complex16_blas_level2
00133 *
00134 *> \par Further Details:
00135 *  =====================
00136 *>
00137 *> \verbatim
00138 *>
00139 *>  Level 2 Blas routine.
00140 *>  The vector and matrix arguments are not referenced when N = 0, or M = 0
00141 *>
00142 *>  -- Written on 22-October-1986.
00143 *>     Jack Dongarra, Argonne National Lab.
00144 *>     Jeremy Du Croz, Nag Central Office.
00145 *>     Sven Hammarling, Nag Central Office.
00146 *>     Richard Hanson, Sandia National Labs.
00147 *> \endverbatim
00148 *>
00149 *  =====================================================================
00150       SUBROUTINE ZHPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
00151 *
00152 *  -- Reference BLAS level2 routine (version 3.4.0) --
00153 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
00154 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00155 *     November 2011
00156 *
00157 *     .. Scalar Arguments ..
00158       COMPLEX*16 ALPHA,BETA
00159       INTEGER INCX,INCY,N
00160       CHARACTER UPLO
00161 *     ..
00162 *     .. Array Arguments ..
00163       COMPLEX*16 AP(*),X(*),Y(*)
00164 *     ..
00165 *
00166 *  =====================================================================
00167 *
00168 *     .. Parameters ..
00169       COMPLEX*16 ONE
00170       PARAMETER (ONE= (1.0D+0,0.0D+0))
00171       COMPLEX*16 ZERO
00172       PARAMETER (ZERO= (0.0D+0,0.0D+0))
00173 *     ..
00174 *     .. Local Scalars ..
00175       COMPLEX*16 TEMP1,TEMP2
00176       INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
00177 *     ..
00178 *     .. External Functions ..
00179       LOGICAL LSAME
00180       EXTERNAL LSAME
00181 *     ..
00182 *     .. External Subroutines ..
00183       EXTERNAL XERBLA
00184 *     ..
00185 *     .. Intrinsic Functions ..
00186       INTRINSIC DBLE,DCONJG
00187 *     ..
00188 *
00189 *     Test the input parameters.
00190 *
00191       INFO = 0
00192       IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
00193           INFO = 1
00194       ELSE IF (N.LT.0) THEN
00195           INFO = 2
00196       ELSE IF (INCX.EQ.0) THEN
00197           INFO = 6
00198       ELSE IF (INCY.EQ.0) THEN
00199           INFO = 9
00200       END IF
00201       IF (INFO.NE.0) THEN
00202           CALL XERBLA('ZHPMV ',INFO)
00203           RETURN
00204       END IF
00205 *
00206 *     Quick return if possible.
00207 *
00208       IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
00209 *
00210 *     Set up the start points in  X  and  Y.
00211 *
00212       IF (INCX.GT.0) THEN
00213           KX = 1
00214       ELSE
00215           KX = 1 - (N-1)*INCX
00216       END IF
00217       IF (INCY.GT.0) THEN
00218           KY = 1
00219       ELSE
00220           KY = 1 - (N-1)*INCY
00221       END IF
00222 *
00223 *     Start the operations. In this version the elements of the array AP
00224 *     are accessed sequentially with one pass through AP.
00225 *
00226 *     First form  y := beta*y.
00227 *
00228       IF (BETA.NE.ONE) THEN
00229           IF (INCY.EQ.1) THEN
00230               IF (BETA.EQ.ZERO) THEN
00231                   DO 10 I = 1,N
00232                       Y(I) = ZERO
00233    10             CONTINUE
00234               ELSE
00235                   DO 20 I = 1,N
00236                       Y(I) = BETA*Y(I)
00237    20             CONTINUE
00238               END IF
00239           ELSE
00240               IY = KY
00241               IF (BETA.EQ.ZERO) THEN
00242                   DO 30 I = 1,N
00243                       Y(IY) = ZERO
00244                       IY = IY + INCY
00245    30             CONTINUE
00246               ELSE
00247                   DO 40 I = 1,N
00248                       Y(IY) = BETA*Y(IY)
00249                       IY = IY + INCY
00250    40             CONTINUE
00251               END IF
00252           END IF
00253       END IF
00254       IF (ALPHA.EQ.ZERO) RETURN
00255       KK = 1
00256       IF (LSAME(UPLO,'U')) THEN
00257 *
00258 *        Form  y  when AP contains the upper triangle.
00259 *
00260           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
00261               DO 60 J = 1,N
00262                   TEMP1 = ALPHA*X(J)
00263                   TEMP2 = ZERO
00264                   K = KK
00265                   DO 50 I = 1,J - 1
00266                       Y(I) = Y(I) + TEMP1*AP(K)
00267                       TEMP2 = TEMP2 + DCONJG(AP(K))*X(I)
00268                       K = K + 1
00269    50             CONTINUE
00270                   Y(J) = Y(J) + TEMP1*DBLE(AP(KK+J-1)) + ALPHA*TEMP2
00271                   KK = KK + J
00272    60         CONTINUE
00273           ELSE
00274               JX = KX
00275               JY = KY
00276               DO 80 J = 1,N
00277                   TEMP1 = ALPHA*X(JX)
00278                   TEMP2 = ZERO
00279                   IX = KX
00280                   IY = KY
00281                   DO 70 K = KK,KK + J - 2
00282                       Y(IY) = Y(IY) + TEMP1*AP(K)
00283                       TEMP2 = TEMP2 + DCONJG(AP(K))*X(IX)
00284                       IX = IX + INCX
00285                       IY = IY + INCY
00286    70             CONTINUE
00287                   Y(JY) = Y(JY) + TEMP1*DBLE(AP(KK+J-1)) + ALPHA*TEMP2
00288                   JX = JX + INCX
00289                   JY = JY + INCY
00290                   KK = KK + J
00291    80         CONTINUE
00292           END IF
00293       ELSE
00294 *
00295 *        Form  y  when AP contains the lower triangle.
00296 *
00297           IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
00298               DO 100 J = 1,N
00299                   TEMP1 = ALPHA*X(J)
00300                   TEMP2 = ZERO
00301                   Y(J) = Y(J) + TEMP1*DBLE(AP(KK))
00302                   K = KK + 1
00303                   DO 90 I = J + 1,N
00304                       Y(I) = Y(I) + TEMP1*AP(K)
00305                       TEMP2 = TEMP2 + DCONJG(AP(K))*X(I)
00306                       K = K + 1
00307    90             CONTINUE
00308                   Y(J) = Y(J) + ALPHA*TEMP2
00309                   KK = KK + (N-J+1)
00310   100         CONTINUE
00311           ELSE
00312               JX = KX
00313               JY = KY
00314               DO 120 J = 1,N
00315                   TEMP1 = ALPHA*X(JX)
00316                   TEMP2 = ZERO
00317                   Y(JY) = Y(JY) + TEMP1*DBLE(AP(KK))
00318                   IX = JX
00319                   IY = JY
00320                   DO 110 K = KK + 1,KK + N - J
00321                       IX = IX + INCX
00322                       IY = IY + INCY
00323                       Y(IY) = Y(IY) + TEMP1*AP(K)
00324                       TEMP2 = TEMP2 + DCONJG(AP(K))*X(IX)
00325   110             CONTINUE
00326                   Y(JY) = Y(JY) + ALPHA*TEMP2
00327                   JX = JX + INCX
00328                   JY = JY + INCY
00329                   KK = KK + (N-J+1)
00330   120         CONTINUE
00331           END IF
00332       END IF
00333 *
00334       RETURN
00335 *
00336 *     End of ZHPMV .
00337 *
00338       END
 All Files Functions