kusano 7d535a
kusano 7d535a
/*  -- translated by f2c (version 19940927).
kusano 7d535a
   You must link the resulting object file with the libraries:
kusano 7d535a
	-lf2c -lm   (in that order)
kusano 7d535a
*/
kusano 7d535a
kusano 7d535a
#include "f2c.h"
kusano 7d535a
kusano 7d535a
/* Subroutine */ int cgerc_(integer *m, integer *n, complex *alpha, complex *
kusano 7d535a
	x, integer *incx, complex *y, integer *incy, complex *a, integer *lda)
kusano 7d535a
{
kusano 7d535a
kusano 7d535a
kusano 7d535a
    /* System generated locals */
kusano 7d535a
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
kusano 7d535a
    complex q__1, q__2;
kusano 7d535a
kusano 7d535a
    /* Builtin functions */
kusano 7d535a
    void r_cnjg(complex *, complex *);
kusano 7d535a
kusano 7d535a
    /* Local variables */
kusano 7d535a
    static integer info;
kusano 7d535a
    static complex temp;
kusano 7d535a
    static integer i, j, ix, jy, kx;
kusano 7d535a
    extern /* Subroutine */ int xerbla_(char *, integer *);
kusano 7d535a
kusano 7d535a
kusano 7d535a
/*  Purpose   
kusano 7d535a
    =======   
kusano 7d535a
kusano 7d535a
    CGERC  performs the rank 1 operation   
kusano 7d535a
kusano 7d535a
       A := alpha*x*conjg( y' ) + A,   
kusano 7d535a
kusano 7d535a
    where alpha is a scalar, x is an m element vector, y is an n element 
kusano 7d535a
  
kusano 7d535a
    vector and A is an m by n matrix.   
kusano 7d535a
kusano 7d535a
    Parameters   
kusano 7d535a
    ==========   
kusano 7d535a
kusano 7d535a
    M      - INTEGER.   
kusano 7d535a
             On entry, M specifies the number of rows of the matrix A.   
kusano 7d535a
             M must be at least zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    N      - INTEGER.   
kusano 7d535a
             On entry, N specifies the number of columns of the matrix A. 
kusano 7d535a
  
kusano 7d535a
             N must be at least zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    ALPHA  - COMPLEX         .   
kusano 7d535a
             On entry, ALPHA specifies the scalar alpha.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    X      - COMPLEX          array of dimension at least   
kusano 7d535a
             ( 1 + ( m - 1 )*abs( INCX ) ).   
kusano 7d535a
             Before entry, the incremented array X must contain the m   
kusano 7d535a
             element vector x.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    INCX   - INTEGER.   
kusano 7d535a
             On entry, INCX specifies the increment for the elements of   
kusano 7d535a
             X. INCX must not be zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    Y      - COMPLEX          array of dimension at least   
kusano 7d535a
             ( 1 + ( n - 1 )*abs( INCY ) ).   
kusano 7d535a
             Before entry, the incremented array Y must contain the n   
kusano 7d535a
             element vector y.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    INCY   - INTEGER.   
kusano 7d535a
             On entry, INCY specifies the increment for the elements of   
kusano 7d535a
             Y. INCY must not be zero.   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
    A      - COMPLEX          array of DIMENSION ( LDA, n ).   
kusano 7d535a
             Before entry, the leading m by n part of the array A must   
kusano 7d535a
             contain the matrix of coefficients. On exit, A is   
kusano 7d535a
             overwritten by the updated matrix.   
kusano 7d535a
kusano 7d535a
    LDA    - INTEGER.   
kusano 7d535a
             On entry, LDA specifies the first dimension of A as declared 
kusano 7d535a
  
kusano 7d535a
             in the calling (sub) program. LDA must be at least   
kusano 7d535a
             max( 1, m ).   
kusano 7d535a
             Unchanged on exit.   
kusano 7d535a
kusano 7d535a
kusano 7d535a
    Level 2 Blas routine.   
kusano 7d535a
kusano 7d535a
    -- Written on 22-October-1986.   
kusano 7d535a
       Jack Dongarra, Argonne National Lab.   
kusano 7d535a
       Jeremy Du Croz, Nag Central Office.   
kusano 7d535a
       Sven Hammarling, Nag Central Office.   
kusano 7d535a
       Richard Hanson, Sandia National Labs.   
kusano 7d535a
kusano 7d535a
kusano 7d535a
kusano 7d535a
       Test the input parameters.   
kusano 7d535a
kusano 7d535a
    
kusano 7d535a
   Parameter adjustments   
kusano 7d535a
       Function Body */
kusano 7d535a
#define X(I) x[(I)-1]
kusano 7d535a
#define Y(I) y[(I)-1]
kusano 7d535a
kusano 7d535a
#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
kusano 7d535a
kusano 7d535a
    info = 0;
kusano 7d535a
    if (*m < 0) {
kusano 7d535a
	info = 1;
kusano 7d535a
    } else if (*n < 0) {
kusano 7d535a
	info = 2;
kusano 7d535a
    } else if (*incx == 0) {
kusano 7d535a
	info = 5;
kusano 7d535a
    } else if (*incy == 0) {
kusano 7d535a
	info = 7;
kusano 7d535a
    } else if (*lda < max(1,*m)) {
kusano 7d535a
	info = 9;
kusano 7d535a
    }
kusano 7d535a
    if (info != 0) {
kusano 7d535a
	xerbla_("CGERC ", &info);
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Quick return if possible. */
kusano 7d535a
kusano 7d535a
    if (*m == 0 || *n == 0 || alpha->r == 0.f && alpha->i == 0.f) {
kusano 7d535a
	return 0;
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
/*     Start the operations. In this version the elements of A are   
kusano 7d535a
       accessed sequentially with one pass through A. */
kusano 7d535a
kusano 7d535a
    if (*incy > 0) {
kusano 7d535a
	jy = 1;
kusano 7d535a
    } else {
kusano 7d535a
	jy = 1 - (*n - 1) * *incy;
kusano 7d535a
    }
kusano 7d535a
    if (*incx == 1) {
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (j = 1; j <= *n; ++j) {
kusano 7d535a
	    i__2 = jy;
kusano 7d535a
	    if (Y(jy).r != 0.f || Y(jy).i != 0.f) {
kusano 7d535a
		r_cnjg(&q__2, &Y(jy));
kusano 7d535a
		q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i = 
kusano 7d535a
			alpha->r * q__2.i + alpha->i * q__2.r;
kusano 7d535a
		temp.r = q__1.r, temp.i = q__1.i;
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = 1; i <= *m; ++i) {
kusano 7d535a
		    i__3 = i + j * a_dim1;
kusano 7d535a
		    i__4 = i + j * a_dim1;
kusano 7d535a
		    i__5 = i;
kusano 7d535a
		    q__2.r = X(i).r * temp.r - X(i).i * temp.i, q__2.i =
kusano 7d535a
			     X(i).r * temp.i + X(i).i * temp.r;
kusano 7d535a
		    q__1.r = A(i,j).r + q__2.r, q__1.i = A(i,j).i + q__2.i;
kusano 7d535a
		    A(i,j).r = q__1.r, A(i,j).i = q__1.i;
kusano 7d535a
/* L10: */
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
	    jy += *incy;
kusano 7d535a
/* L20: */
kusano 7d535a
	}
kusano 7d535a
    } else {
kusano 7d535a
	if (*incx > 0) {
kusano 7d535a
	    kx = 1;
kusano 7d535a
	} else {
kusano 7d535a
	    kx = 1 - (*m - 1) * *incx;
kusano 7d535a
	}
kusano 7d535a
	i__1 = *n;
kusano 7d535a
	for (j = 1; j <= *n; ++j) {
kusano 7d535a
	    i__2 = jy;
kusano 7d535a
	    if (Y(jy).r != 0.f || Y(jy).i != 0.f) {
kusano 7d535a
		r_cnjg(&q__2, &Y(jy));
kusano 7d535a
		q__1.r = alpha->r * q__2.r - alpha->i * q__2.i, q__1.i = 
kusano 7d535a
			alpha->r * q__2.i + alpha->i * q__2.r;
kusano 7d535a
		temp.r = q__1.r, temp.i = q__1.i;
kusano 7d535a
		ix = kx;
kusano 7d535a
		i__2 = *m;
kusano 7d535a
		for (i = 1; i <= *m; ++i) {
kusano 7d535a
		    i__3 = i + j * a_dim1;
kusano 7d535a
		    i__4 = i + j * a_dim1;
kusano 7d535a
		    i__5 = ix;
kusano 7d535a
		    q__2.r = X(ix).r * temp.r - X(ix).i * temp.i, q__2.i =
kusano 7d535a
			     X(ix).r * temp.i + X(ix).i * temp.r;
kusano 7d535a
		    q__1.r = A(i,j).r + q__2.r, q__1.i = A(i,j).i + q__2.i;
kusano 7d535a
		    A(i,j).r = q__1.r, A(i,j).i = q__1.i;
kusano 7d535a
		    ix += *incx;
kusano 7d535a
/* L30: */
kusano 7d535a
		}
kusano 7d535a
	    }
kusano 7d535a
	    jy += *incy;
kusano 7d535a
/* L40: */
kusano 7d535a
	}
kusano 7d535a
    }
kusano 7d535a
kusano 7d535a
    return 0;
kusano 7d535a
kusano 7d535a
/*     End of CGERC . */
kusano 7d535a
kusano 7d535a
} /* cgerc_ */
kusano 7d535a