mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
165 lines
4.9 KiB
Fortran
165 lines
4.9 KiB
Fortran
*DECK CGERC
|
|
SUBROUTINE CGERC (M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
|
|
C***BEGIN PROLOGUE CGERC
|
|
C***PURPOSE Perform conjugated rank 1 update of a complex general
|
|
C matrix.
|
|
C***LIBRARY SLATEC (BLAS)
|
|
C***CATEGORY D1B4
|
|
C***TYPE COMPLEX (SGERC-S, DGERC-D, CGERC-C)
|
|
C***KEYWORDS LEVEL 2 BLAS, LINEAR ALGEBRA
|
|
C***AUTHOR Dongarra, J. J., (ANL)
|
|
C Du Croz, J., (NAG)
|
|
C Hammarling, S., (NAG)
|
|
C Hanson, R. J., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C CGERC performs the rank 1 operation
|
|
C
|
|
C A := alpha*x*conjg( y') + A,
|
|
C
|
|
C where alpha is a scalar, x is an m element vector, y is an n element
|
|
C vector and A is an m by n matrix.
|
|
C
|
|
C Parameters
|
|
C ==========
|
|
C
|
|
C M - INTEGER.
|
|
C On entry, M specifies the number of rows of the matrix A.
|
|
C M must be at least zero.
|
|
C Unchanged on exit.
|
|
C
|
|
C N - INTEGER.
|
|
C On entry, N specifies the number of columns of the matrix A.
|
|
C N must be at least zero.
|
|
C Unchanged on exit.
|
|
C
|
|
C ALPHA - COMPLEX .
|
|
C On entry, ALPHA specifies the scalar alpha.
|
|
C Unchanged on exit.
|
|
C
|
|
C X - COMPLEX array of dimension at least
|
|
C ( 1 + ( m - 1 )*abs( INCX ) ).
|
|
C Before entry, the incremented array X must contain the m
|
|
C element vector x.
|
|
C Unchanged on exit.
|
|
C
|
|
C INCX - INTEGER.
|
|
C On entry, INCX specifies the increment for the elements of
|
|
C X. INCX must not be zero.
|
|
C Unchanged on exit.
|
|
C
|
|
C Y - COMPLEX array of dimension at least
|
|
C ( 1 + ( n - 1 )*abs( INCY ) ).
|
|
C Before entry, the incremented array Y must contain the n
|
|
C element vector y.
|
|
C Unchanged on exit.
|
|
C
|
|
C INCY - INTEGER.
|
|
C On entry, INCY specifies the increment for the elements of
|
|
C Y. INCY must not be zero.
|
|
C Unchanged on exit.
|
|
C
|
|
C A - COMPLEX array of DIMENSION ( LDA, n ).
|
|
C Before entry, the leading m by n part of the array A must
|
|
C contain the matrix of coefficients. On exit, A is
|
|
C overwritten by the updated matrix.
|
|
C
|
|
C LDA - INTEGER.
|
|
C On entry, LDA specifies the first dimension of A as declared
|
|
C in the calling (sub) program. LDA must be at least
|
|
C max( 1, m ).
|
|
C Unchanged on exit.
|
|
C
|
|
C***REFERENCES Dongarra, J. J., Du Croz, J., Hammarling, S., and
|
|
C Hanson, R. J. An extended set of Fortran basic linear
|
|
C algebra subprograms. ACM TOMS, Vol. 14, No. 1,
|
|
C pp. 1-17, March 1988.
|
|
C***ROUTINES CALLED XERBLA
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 861022 DATE WRITTEN
|
|
C 910605 Modified to meet SLATEC prologue standards. Only comment
|
|
C lines were modified. (BKS)
|
|
C***END PROLOGUE CGERC
|
|
C .. Scalar Arguments ..
|
|
COMPLEX ALPHA
|
|
INTEGER INCX, INCY, LDA, M, N
|
|
C .. Array Arguments ..
|
|
COMPLEX A( LDA, * ), X( * ), Y( * )
|
|
C .. Parameters ..
|
|
COMPLEX ZERO
|
|
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
|
|
C .. Local Scalars ..
|
|
COMPLEX TEMP
|
|
INTEGER I, INFO, IX, J, JY, KX
|
|
C .. External Subroutines ..
|
|
EXTERNAL XERBLA
|
|
C .. Intrinsic Functions ..
|
|
INTRINSIC CONJG, MAX
|
|
C***FIRST EXECUTABLE STATEMENT CGERC
|
|
C
|
|
C Test the input parameters.
|
|
C
|
|
INFO = 0
|
|
IF ( M.LT.0 )THEN
|
|
INFO = 1
|
|
ELSE IF( N.LT.0 )THEN
|
|
INFO = 2
|
|
ELSE IF( INCX.EQ.0 )THEN
|
|
INFO = 5
|
|
ELSE IF( INCY.EQ.0 )THEN
|
|
INFO = 7
|
|
ELSE IF( LDA.LT.MAX( 1, M ) )THEN
|
|
INFO = 9
|
|
END IF
|
|
IF( INFO.NE.0 )THEN
|
|
CALL XERBLA( 'CGERC ', INFO )
|
|
RETURN
|
|
END IF
|
|
C
|
|
C Quick return if possible.
|
|
C
|
|
IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.( ALPHA.EQ.ZERO ) )
|
|
$ RETURN
|
|
C
|
|
C Start the operations. In this version the elements of A are
|
|
C accessed sequentially with one pass through A.
|
|
C
|
|
IF( INCY.GT.0 )THEN
|
|
JY = 1
|
|
ELSE
|
|
JY = 1 - ( N - 1 )*INCY
|
|
END IF
|
|
IF( INCX.EQ.1 )THEN
|
|
DO 20, J = 1, N
|
|
IF( Y( JY ).NE.ZERO )THEN
|
|
TEMP = ALPHA*CONJG( Y( JY ) )
|
|
DO 10, I = 1, M
|
|
A( I, J ) = A( I, J ) + X( I )*TEMP
|
|
10 CONTINUE
|
|
END IF
|
|
JY = JY + INCY
|
|
20 CONTINUE
|
|
ELSE
|
|
IF( INCX.GT.0 )THEN
|
|
KX = 1
|
|
ELSE
|
|
KX = 1 - ( M - 1 )*INCX
|
|
END IF
|
|
DO 40, J = 1, N
|
|
IF( Y( JY ).NE.ZERO )THEN
|
|
TEMP = ALPHA*CONJG( Y( JY ) )
|
|
IX = KX
|
|
DO 30, I = 1, M
|
|
A( I, J ) = A( I, J ) + X( IX )*TEMP
|
|
IX = IX + INCX
|
|
30 CONTINUE
|
|
END IF
|
|
JY = JY + INCY
|
|
40 CONTINUE
|
|
END IF
|
|
C
|
|
RETURN
|
|
C
|
|
C End of CGERC .
|
|
C
|
|
END
|