LAPACK 3.3.0

csyr.f

Go to the documentation of this file.
00001       SUBROUTINE CSYR( UPLO, N, ALPHA, X, INCX, A, LDA )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          UPLO
00010       INTEGER            INCX, LDA, N
00011       COMPLEX            ALPHA
00012 *     ..
00013 *     .. Array Arguments ..
00014       COMPLEX            A( LDA, * ), X( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  CSYR   performs the symmetric rank 1 operation
00021 *
00022 *     A := alpha*x*( x' ) + A,
00023 *
00024 *  where alpha is a complex scalar, x is an n element vector and A is an
00025 *  n by n symmetric matrix.
00026 *
00027 *  Arguments
00028 *  ==========
00029 *
00030 *  UPLO     (input) CHARACTER*1
00031 *           On entry, UPLO specifies whether the upper or lower
00032 *           triangular part of the array A is to be referenced as
00033 *           follows:
00034 *
00035 *              UPLO = 'U' or 'u'   Only the upper triangular part of A
00036 *                                  is to be referenced.
00037 *
00038 *              UPLO = 'L' or 'l'   Only the lower triangular part of A
00039 *                                  is to be referenced.
00040 *
00041 *           Unchanged on exit.
00042 *
00043 *  N        (input) INTEGER
00044 *           On entry, N specifies the order of the matrix A.
00045 *           N must be at least zero.
00046 *           Unchanged on exit.
00047 *
00048 *  ALPHA    (input) COMPLEX
00049 *           On entry, ALPHA specifies the scalar alpha.
00050 *           Unchanged on exit.
00051 *
00052 *  X        (input) COMPLEX array, dimension at least
00053 *           ( 1 + ( N - 1 )*abs( INCX ) ).
00054 *           Before entry, the incremented array X must contain the N-
00055 *           element vector x.
00056 *           Unchanged on exit.
00057 *
00058 *  INCX     (input) INTEGER
00059 *           On entry, INCX specifies the increment for the elements of
00060 *           X. INCX must not be zero.
00061 *           Unchanged on exit.
00062 *
00063 *  A        (input/output) COMPLEX array, dimension ( LDA, N )
00064 *           Before entry, with  UPLO = 'U' or 'u', the leading n by n
00065 *           upper triangular part of the array A must contain the upper
00066 *           triangular part of the symmetric matrix and the strictly
00067 *           lower triangular part of A is not referenced. On exit, the
00068 *           upper triangular part of the array A is overwritten by the
00069 *           upper triangular part of the updated matrix.
00070 *           Before entry, with UPLO = 'L' or 'l', the leading n by n
00071 *           lower triangular part of the array A must contain the lower
00072 *           triangular part of the symmetric matrix and the strictly
00073 *           upper triangular part of A is not referenced. On exit, the
00074 *           lower triangular part of the array A is overwritten by the
00075 *           lower triangular part of the updated matrix.
00076 *
00077 *  LDA      (input) INTEGER
00078 *           On entry, LDA specifies the first dimension of A as declared
00079 *           in the calling (sub) program. LDA must be at least
00080 *           max( 1, N ).
00081 *           Unchanged on exit.
00082 *
00083 * =====================================================================
00084 *
00085 *     .. Parameters ..
00086       COMPLEX            ZERO
00087       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00088 *     ..
00089 *     .. Local Scalars ..
00090       INTEGER            I, INFO, IX, J, JX, KX
00091       COMPLEX            TEMP
00092 *     ..
00093 *     .. External Functions ..
00094       LOGICAL            LSAME
00095       EXTERNAL           LSAME
00096 *     ..
00097 *     .. External Subroutines ..
00098       EXTERNAL           XERBLA
00099 *     ..
00100 *     .. Intrinsic Functions ..
00101       INTRINSIC          MAX
00102 *     ..
00103 *     .. Executable Statements ..
00104 *
00105 *     Test the input parameters.
00106 *
00107       INFO = 0
00108       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00109          INFO = 1
00110       ELSE IF( N.LT.0 ) THEN
00111          INFO = 2
00112       ELSE IF( INCX.EQ.0 ) THEN
00113          INFO = 5
00114       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00115          INFO = 7
00116       END IF
00117       IF( INFO.NE.0 ) THEN
00118          CALL XERBLA( 'CSYR  ', INFO )
00119          RETURN
00120       END IF
00121 *
00122 *     Quick return if possible.
00123 *
00124       IF( ( N.EQ.0 ) .OR. ( ALPHA.EQ.ZERO ) )
00125      $   RETURN
00126 *
00127 *     Set the start point in X if the increment is not unity.
00128 *
00129       IF( INCX.LE.0 ) THEN
00130          KX = 1 - ( N-1 )*INCX
00131       ELSE IF( INCX.NE.1 ) THEN
00132          KX = 1
00133       END IF
00134 *
00135 *     Start the operations. In this version the elements of A are
00136 *     accessed sequentially with one pass through the triangular part
00137 *     of A.
00138 *
00139       IF( LSAME( UPLO, 'U' ) ) THEN
00140 *
00141 *        Form  A  when A is stored in upper triangle.
00142 *
00143          IF( INCX.EQ.1 ) THEN
00144             DO 20 J = 1, N
00145                IF( X( J ).NE.ZERO ) THEN
00146                   TEMP = ALPHA*X( J )
00147                   DO 10 I = 1, J
00148                      A( I, J ) = A( I, J ) + X( I )*TEMP
00149    10             CONTINUE
00150                END IF
00151    20       CONTINUE
00152          ELSE
00153             JX = KX
00154             DO 40 J = 1, N
00155                IF( X( JX ).NE.ZERO ) THEN
00156                   TEMP = ALPHA*X( JX )
00157                   IX = KX
00158                   DO 30 I = 1, J
00159                      A( I, J ) = A( I, J ) + X( IX )*TEMP
00160                      IX = IX + INCX
00161    30             CONTINUE
00162                END IF
00163                JX = JX + INCX
00164    40       CONTINUE
00165          END IF
00166       ELSE
00167 *
00168 *        Form  A  when A is stored in lower triangle.
00169 *
00170          IF( INCX.EQ.1 ) THEN
00171             DO 60 J = 1, N
00172                IF( X( J ).NE.ZERO ) THEN
00173                   TEMP = ALPHA*X( J )
00174                   DO 50 I = J, N
00175                      A( I, J ) = A( I, J ) + X( I )*TEMP
00176    50             CONTINUE
00177                END IF
00178    60       CONTINUE
00179          ELSE
00180             JX = KX
00181             DO 80 J = 1, N
00182                IF( X( JX ).NE.ZERO ) THEN
00183                   TEMP = ALPHA*X( JX )
00184                   IX = JX
00185                   DO 70 I = J, N
00186                      A( I, J ) = A( I, J ) + X( IX )*TEMP
00187                      IX = IX + INCX
00188    70             CONTINUE
00189                END IF
00190                JX = JX + INCX
00191    80       CONTINUE
00192          END IF
00193       END IF
00194 *
00195       RETURN
00196 *
00197 *     End of CSYR
00198 *
00199       END
 All Files Functions