00001 /* DGER.F -- translated by f2c (version 19941215). 00002 You must link the resulting object file with the libraries: 00003 -lf2c -lm (in that order) 00004 */ 00005 00006 #include "f2c.h" 00007 #include "cblasimpexp.h" 00008 00009 00010 /* *********************************************************************** */ 00011 00012 /* Subroutine */ int __IMPEXP__ dger_(m, n, alpha, x, incx, y, incy, a, lda) 00013 integer *m, *n; 00014 doublereal *alpha, *x; 00015 integer *incx; 00016 doublereal *y; 00017 integer *incy; 00018 doublereal *a; 00019 integer *lda; 00020 { 00021 /* System generated locals */ 00022 integer a_dim1, a_offset, i__1, i__2; 00023 00024 /* Local variables */ 00025 static integer info; 00026 static doublereal temp; 00027 static integer i, j, ix, jy, kx; 00028 extern /* Subroutine */ int xerbla_(); 00029 00030 /* .. Scalar Arguments .. */ 00031 /* .. Array Arguments .. */ 00032 /* .. */ 00033 00034 /* Purpose */ 00035 /* ======= */ 00036 00037 /* DGER performs the rank 1 operation */ 00038 00039 /* A := alpha*x*y' + A, */ 00040 00041 /* where alpha is a scalar, x is an m element vector, y is an n element 00042 */ 00043 /* vector and A is an m by n matrix. */ 00044 00045 /* Parameters */ 00046 /* ========== */ 00047 00048 /* M - INTEGER. */ 00049 /* On entry, M specifies the number of rows of the matrix A. */ 00050 /* M must be at least zero. */ 00051 /* Unchanged on exit. */ 00052 00053 /* N - INTEGER. */ 00054 /* On entry, N specifies the number of columns of the matrix A. 00055 */ 00056 /* N must be at least zero. */ 00057 /* Unchanged on exit. */ 00058 00059 /* ALPHA - DOUBLE PRECISION. */ 00060 /* On entry, ALPHA specifies the scalar alpha. */ 00061 /* Unchanged on exit. */ 00062 00063 /* X - DOUBLE PRECISION array of dimension at least */ 00064 /* ( 1 + ( m - 1 )*abs( INCX ) ). */ 00065 /* Before entry, the incremented array X must contain the m */ 00066 /* element vector x. */ 00067 /* Unchanged on exit. */ 00068 00069 /* INCX - INTEGER. */ 00070 /* On entry, INCX specifies the increment for the elements of */ 00071 /* X. INCX must not be zero. */ 00072 /* Unchanged on exit. */ 00073 00074 /* Y - DOUBLE PRECISION array of dimension at least */ 00075 /* ( 1 + ( n - 1 )*abs( INCY ) ). */ 00076 /* Before entry, the incremented array Y must contain the n */ 00077 /* element vector y. */ 00078 /* Unchanged on exit. */ 00079 00080 /* INCY - INTEGER. */ 00081 /* On entry, INCY specifies the increment for the elements of */ 00082 /* Y. INCY must not be zero. */ 00083 /* Unchanged on exit. */ 00084 00085 /* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */ 00086 /* Before entry, the leading m by n part of the array A must */ 00087 /* contain the matrix of coefficients. On exit, A is */ 00088 /* overwritten by the updated matrix. */ 00089 00090 /* LDA - INTEGER. */ 00091 /* On entry, LDA specifies the first dimension of A as declared 00092 */ 00093 /* in the calling (sub) program. LDA must be at least */ 00094 /* max( 1, m ). */ 00095 /* Unchanged on exit. */ 00096 00097 00098 /* Level 2 Blas routine. */ 00099 00100 /* -- Written on 22-October-1986. */ 00101 /* Jack Dongarra, Argonne National Lab. */ 00102 /* Jeremy Du Croz, Nag Central Office. */ 00103 /* Sven Hammarling, Nag Central Office. */ 00104 /* Richard Hanson, Sandia National Labs. */ 00105 00106 00107 /* .. Parameters .. */ 00108 /* .. Local Scalars .. */ 00109 /* .. External Subroutines .. */ 00110 /* .. Intrinsic Functions .. */ 00111 /* .. */ 00112 /* .. Executable Statements .. */ 00113 00114 /* Test the input parameters. */ 00115 00116 /* Parameter adjustments */ 00117 --x; 00118 --y; 00119 a_dim1 = *lda; 00120 a_offset = a_dim1 + 1; 00121 a -= a_offset; 00122 00123 /* Function Body */ 00124 info = 0; 00125 if (*m < 0) { 00126 info = 1; 00127 } else if (*n < 0) { 00128 info = 2; 00129 } else if (*incx == 0) { 00130 info = 5; 00131 } else if (*incy == 0) { 00132 info = 7; 00133 } else if (*lda < max(1,*m)) { 00134 info = 9; 00135 } 00136 if (info != 0) { 00137 xerbla_("DGER ", &info, 6L); 00138 return 0; 00139 } 00140 00141 /* Quick return if possible. */ 00142 00143 if (*m == 0 || *n == 0 || *alpha == 0.) { 00144 return 0; 00145 } 00146 00147 /* Start the operations. In this version the elements of A are */ 00148 /* accessed sequentially with one pass through A. */ 00149 00150 if (*incy > 0) { 00151 jy = 1; 00152 } else { 00153 jy = 1 - (*n - 1) * *incy; 00154 } 00155 if (*incx == 1) { 00156 i__1 = *n; 00157 for (j = 1; j <= i__1; ++j) { 00158 if (y[jy] != 0.) { 00159 temp = *alpha * y[jy]; 00160 i__2 = *m; 00161 for (i = 1; i <= i__2; ++i) { 00162 a[i + j * a_dim1] += x[i] * temp; 00163 /* L10: */ 00164 } 00165 } 00166 jy += *incy; 00167 /* L20: */ 00168 } 00169 } else { 00170 if (*incx > 0) { 00171 kx = 1; 00172 } else { 00173 kx = 1 - (*m - 1) * *incx; 00174 } 00175 i__1 = *n; 00176 for (j = 1; j <= i__1; ++j) { 00177 if (y[jy] != 0.) { 00178 temp = *alpha * y[jy]; 00179 ix = kx; 00180 i__2 = *m; 00181 for (i = 1; i <= i__2; ++i) { 00182 a[i + j * a_dim1] += x[ix] * temp; 00183 ix += *incx; 00184 /* L30: */ 00185 } 00186 } 00187 jy += *incy; 00188 /* L40: */ 00189 } 00190 } 00191 00192 return 0; 00193 00194 /* End of DGER . */ 00195 00196 } /* dger_ */ 00197