LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cspr.f
Go to the documentation of this file.
00001 *> \brief \b CSPR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CSPR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cspr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cspr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cspr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CSPR( UPLO, N, ALPHA, X, INCX, AP )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          UPLO
00025 *       INTEGER            INCX, N
00026 *       COMPLEX            ALPHA
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       COMPLEX            AP( * ), X( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> CSPR    performs the symmetric rank 1 operation
00039 *>
00040 *>    A := alpha*x*x**H + A,
00041 *>
00042 *> where alpha is a complex scalar, x is an n element vector and A is an
00043 *> n by n symmetric matrix, supplied in packed form.
00044 *> \endverbatim
00045 *
00046 *  Arguments:
00047 *  ==========
00048 *
00049 *> \param[in] UPLO
00050 *> \verbatim
00051 *>          UPLO is CHARACTER*1
00052 *>           On entry, UPLO specifies whether the upper or lower
00053 *>           triangular part of the matrix A is supplied in the packed
00054 *>           array AP as follows:
00055 *>
00056 *>              UPLO = 'U' or 'u'   The upper triangular part of A is
00057 *>                                  supplied in AP.
00058 *>
00059 *>              UPLO = 'L' or 'l'   The lower triangular part of A is
00060 *>                                  supplied in AP.
00061 *>
00062 *>           Unchanged on exit.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] N
00066 *> \verbatim
00067 *>          N is INTEGER
00068 *>           On entry, N specifies the order of the matrix A.
00069 *>           N must be at least zero.
00070 *>           Unchanged on exit.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] ALPHA
00074 *> \verbatim
00075 *>          ALPHA is COMPLEX
00076 *>           On entry, ALPHA specifies the scalar alpha.
00077 *>           Unchanged on exit.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] X
00081 *> \verbatim
00082 *>          X is COMPLEX array, dimension at least
00083 *>           ( 1 + ( N - 1 )*abs( INCX ) ).
00084 *>           Before entry, the incremented array X must contain the N-
00085 *>           element vector x.
00086 *>           Unchanged on exit.
00087 *> \endverbatim
00088 *>
00089 *> \param[in] INCX
00090 *> \verbatim
00091 *>          INCX is INTEGER
00092 *>           On entry, INCX specifies the increment for the elements of
00093 *>           X. INCX must not be zero.
00094 *>           Unchanged on exit.
00095 *> \endverbatim
00096 *>
00097 *> \param[in,out] AP
00098 *> \verbatim
00099 *>          AP is COMPLEX array, dimension at least
00100 *>           ( ( N*( N + 1 ) )/2 ).
00101 *>           Before entry, with  UPLO = 'U' or 'u', the array AP must
00102 *>           contain the upper triangular part of the symmetric matrix
00103 *>           packed sequentially, column by column, so that AP( 1 )
00104 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
00105 *>           and a( 2, 2 ) respectively, and so on. On exit, the array
00106 *>           AP is overwritten by the upper triangular part of the
00107 *>           updated matrix.
00108 *>           Before entry, with UPLO = 'L' or 'l', the array AP must
00109 *>           contain the lower triangular part of the symmetric matrix
00110 *>           packed sequentially, column by column, so that AP( 1 )
00111 *>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
00112 *>           and a( 3, 1 ) respectively, and so on. On exit, the array
00113 *>           AP is overwritten by the lower triangular part of the
00114 *>           updated matrix.
00115 *>           Note that the imaginary parts of the diagonal elements need
00116 *>           not be set, they are assumed to be zero, and on exit they
00117 *>           are set to zero.
00118 *> \endverbatim
00119 *
00120 *  Authors:
00121 *  ========
00122 *
00123 *> \author Univ. of Tennessee 
00124 *> \author Univ. of California Berkeley 
00125 *> \author Univ. of Colorado Denver 
00126 *> \author NAG Ltd. 
00127 *
00128 *> \date November 2011
00129 *
00130 *> \ingroup complexOTHERauxiliary
00131 *
00132 *  =====================================================================
00133       SUBROUTINE CSPR( UPLO, N, ALPHA, X, INCX, AP )
00134 *
00135 *  -- LAPACK auxiliary routine (version 3.4.0) --
00136 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00137 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00138 *     November 2011
00139 *
00140 *     .. Scalar Arguments ..
00141       CHARACTER          UPLO
00142       INTEGER            INCX, N
00143       COMPLEX            ALPHA
00144 *     ..
00145 *     .. Array Arguments ..
00146       COMPLEX            AP( * ), X( * )
00147 *     ..
00148 *
00149 * =====================================================================
00150 *
00151 *     .. Parameters ..
00152       COMPLEX            ZERO
00153       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00154 *     ..
00155 *     .. Local Scalars ..
00156       INTEGER            I, INFO, IX, J, JX, K, KK, KX
00157       COMPLEX            TEMP
00158 *     ..
00159 *     .. External Functions ..
00160       LOGICAL            LSAME
00161       EXTERNAL           LSAME
00162 *     ..
00163 *     .. External Subroutines ..
00164       EXTERNAL           XERBLA
00165 *     ..
00166 *     .. Executable Statements ..
00167 *
00168 *     Test the input parameters.
00169 *
00170       INFO = 0
00171       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00172          INFO = 1
00173       ELSE IF( N.LT.0 ) THEN
00174          INFO = 2
00175       ELSE IF( INCX.EQ.0 ) THEN
00176          INFO = 5
00177       END IF
00178       IF( INFO.NE.0 ) THEN
00179          CALL XERBLA( 'CSPR  ', INFO )
00180          RETURN
00181       END IF
00182 *
00183 *     Quick return if possible.
00184 *
00185       IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) )
00186      $   RETURN
00187 *
00188 *     Set the start point in X if the increment is not unity.
00189 *
00190       IF( INCX.LE.0 ) THEN
00191          KX = 1 - ( N-1 )*INCX
00192       ELSE IF( INCX.NE.1 ) THEN
00193          KX = 1
00194       END IF
00195 *
00196 *     Start the operations. In this version the elements of the array AP
00197 *     are accessed sequentially with one pass through AP.
00198 *
00199       KK = 1
00200       IF( LSAME( UPLO, 'U' ) ) THEN
00201 *
00202 *        Form  A  when upper triangle is stored in AP.
00203 *
00204          IF( INCX.EQ.1 ) THEN
00205             DO 20 J = 1, N
00206                IF( X( J ).NE.ZERO ) THEN
00207                   TEMP = ALPHA*X( J )
00208                   K = KK
00209                   DO 10 I = 1, J - 1
00210                      AP( K ) = AP( K ) + X( I )*TEMP
00211                      K = K + 1
00212    10             CONTINUE
00213                   AP( KK+J-1 ) = AP( KK+J-1 ) + X( J )*TEMP
00214                ELSE
00215                   AP( KK+J-1 ) = AP( KK+J-1 )
00216                END IF
00217                KK = KK + J
00218    20       CONTINUE
00219          ELSE
00220             JX = KX
00221             DO 40 J = 1, N
00222                IF( X( JX ).NE.ZERO ) THEN
00223                   TEMP = ALPHA*X( JX )
00224                   IX = KX
00225                   DO 30 K = KK, KK + J - 2
00226                      AP( K ) = AP( K ) + X( IX )*TEMP
00227                      IX = IX + INCX
00228    30             CONTINUE
00229                   AP( KK+J-1 ) = AP( KK+J-1 ) + X( JX )*TEMP
00230                ELSE
00231                   AP( KK+J-1 ) = AP( KK+J-1 )
00232                END IF
00233                JX = JX + INCX
00234                KK = KK + J
00235    40       CONTINUE
00236          END IF
00237       ELSE
00238 *
00239 *        Form  A  when lower triangle is stored in AP.
00240 *
00241          IF( INCX.EQ.1 ) THEN
00242             DO 60 J = 1, N
00243                IF( X( J ).NE.ZERO ) THEN
00244                   TEMP = ALPHA*X( J )
00245                   AP( KK ) = AP( KK ) + TEMP*X( J )
00246                   K = KK + 1
00247                   DO 50 I = J + 1, N
00248                      AP( K ) = AP( K ) + X( I )*TEMP
00249                      K = K + 1
00250    50             CONTINUE
00251                ELSE
00252                   AP( KK ) = AP( KK )
00253                END IF
00254                KK = KK + N - J + 1
00255    60       CONTINUE
00256          ELSE
00257             JX = KX
00258             DO 80 J = 1, N
00259                IF( X( JX ).NE.ZERO ) THEN
00260                   TEMP = ALPHA*X( JX )
00261                   AP( KK ) = AP( KK ) + TEMP*X( JX )
00262                   IX = JX
00263                   DO 70 K = KK + 1, KK + N - J
00264                      IX = IX + INCX
00265                      AP( K ) = AP( K ) + X( IX )*TEMP
00266    70             CONTINUE
00267                ELSE
00268                   AP( KK ) = AP( KK )
00269                END IF
00270                JX = JX + INCX
00271                KK = KK + N - J + 1
00272    80       CONTINUE
00273          END IF
00274       END IF
00275 *
00276       RETURN
00277 *
00278 *     End of CSPR
00279 *
00280       END
 All Files Functions