template_blas_ger.h

Go to the documentation of this file.
00001 /* Ergo, version 3.2, a program for linear scaling electronic structure
00002  * calculations.
00003  * Copyright (C) 2012 Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek.
00004  * 
00005  * This program is free software: you can redistribute it and/or modify
00006  * it under the terms of the GNU General Public License as published by
00007  * the Free Software Foundation, either version 3 of the License, or
00008  * (at your option) any later version.
00009  * 
00010  * This program is distributed in the hope that it will be useful,
00011  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00012  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00013  * GNU General Public License for more details.
00014  * 
00015  * You should have received a copy of the GNU General Public License
00016  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
00017  * 
00018  * Primary academic reference:
00019  * Kohn−Sham Density Functional Theory Electronic Structure Calculations 
00020  * with Linearly Scaling Computational Time and Memory Usage,
00021  * Elias Rudberg, Emanuel H. Rubensson, and Pawel Salek,
00022  * J. Chem. Theory Comput. 7, 340 (2011),
00023  * <http://dx.doi.org/10.1021/ct100611z>
00024  * 
00025  * For further information about Ergo, see <http://www.ergoscf.org>.
00026  */
00027  
00028  /* This file belongs to the template_lapack part of the Ergo source 
00029   * code. The source files in the template_lapack directory are modified
00030   * versions of files originally distributed as CLAPACK, see the
00031   * Copyright/license notice in the file template_lapack/COPYING.
00032   */
00033  
00034 
00035 #ifndef TEMPLATE_BLAS_GER_HEADER
00036 #define TEMPLATE_BLAS_GER_HEADER
00037 
00038 
00039 template<class Treal>
00040 int template_blas_ger(const integer *m, const integer *n, const Treal *alpha, 
00041         const Treal *x, const integer *incx, const Treal *y, const integer *incy, 
00042         Treal *a, const integer *lda)
00043 {
00044     /* System generated locals */
00045     integer a_dim1, a_offset, i__1, i__2;
00046     /* Local variables */
00047      integer info;
00048      Treal temp;
00049      integer i__, j, ix, jy, kx;
00050 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00051 /*  Purpose   
00052     =======   
00053     DGER   performs the rank 1 operation   
00054        A := alpha*x*y' + A,   
00055     where alpha is a scalar, x is an m element vector, y is an n element   
00056     vector and A is an m by n matrix.   
00057     Parameters   
00058     ==========   
00059     M      - INTEGER.   
00060              On entry, M specifies the number of rows of the matrix A.   
00061              M must be at least zero.   
00062              Unchanged on exit.   
00063     N      - INTEGER.   
00064              On entry, N specifies the number of columns of the matrix A.   
00065              N must be at least zero.   
00066              Unchanged on exit.   
00067     ALPHA  - DOUBLE PRECISION.   
00068              On entry, ALPHA specifies the scalar alpha.   
00069              Unchanged on exit.   
00070     X      - DOUBLE PRECISION array of dimension at least   
00071              ( 1 + ( m - 1 )*abs( INCX ) ).   
00072              Before entry, the incremented array X must contain the m   
00073              element vector x.   
00074              Unchanged on exit.   
00075     INCX   - INTEGER.   
00076              On entry, INCX specifies the increment for the elements of   
00077              X. INCX must not be zero.   
00078              Unchanged on exit.   
00079     Y      - DOUBLE PRECISION array of dimension at least   
00080              ( 1 + ( n - 1 )*abs( INCY ) ).   
00081              Before entry, the incremented array Y must contain the n   
00082              element vector y.   
00083              Unchanged on exit.   
00084     INCY   - INTEGER.   
00085              On entry, INCY specifies the increment for the elements of   
00086              Y. INCY must not be zero.   
00087              Unchanged on exit.   
00088     A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).   
00089              Before entry, the leading m by n part of the array A must   
00090              contain the matrix of coefficients. On exit, A is   
00091              overwritten by the updated matrix.   
00092     LDA    - INTEGER.   
00093              On entry, LDA specifies the first dimension of A as declared   
00094              in the calling (sub) program. LDA must be at least   
00095              max( 1, m ).   
00096              Unchanged on exit.   
00097     Level 2 Blas routine.   
00098     -- Written on 22-October-1986.   
00099        Jack Dongarra, Argonne National Lab.   
00100        Jeremy Du Croz, Nag Central Office.   
00101        Sven Hammarling, Nag Central Office.   
00102        Richard Hanson, Sandia National Labs.   
00103        Test the input parameters.   
00104        Parameter adjustments */
00105     --x;
00106     --y;
00107     a_dim1 = *lda;
00108     a_offset = 1 + a_dim1 * 1;
00109     a -= a_offset;
00110     /* Function Body */
00111     info = 0;
00112     if (*m < 0) {
00113         info = 1;
00114     } else if (*n < 0) {
00115         info = 2;
00116     } else if (*incx == 0) {
00117         info = 5;
00118     } else if (*incy == 0) {
00119         info = 7;
00120     } else if (*lda < maxMACRO(1,*m)) {
00121         info = 9;
00122     }
00123     if (info != 0) {
00124         template_blas_erbla("GER   ", &info);
00125         return 0;
00126     }
00127 /*     Quick return if possible. */
00128     if (*m == 0 || *n == 0 || *alpha == 0.) {
00129         return 0;
00130     }
00131 /*     Start the operations. In this version the elements of A are   
00132        accessed sequentially with one pass through A. */
00133     if (*incy > 0) {
00134         jy = 1;
00135     } else {
00136         jy = 1 - (*n - 1) * *incy;
00137     }
00138     if (*incx == 1) {
00139         i__1 = *n;
00140         for (j = 1; j <= i__1; ++j) {
00141             if (y[jy] != 0.) {
00142                 temp = *alpha * y[jy];
00143                 i__2 = *m;
00144                 for (i__ = 1; i__ <= i__2; ++i__) {
00145                     a_ref(i__, j) = a_ref(i__, j) + x[i__] * temp;
00146 /* L10: */
00147                 }
00148             }
00149             jy += *incy;
00150 /* L20: */
00151         }
00152     } else {
00153         if (*incx > 0) {
00154             kx = 1;
00155         } else {
00156             kx = 1 - (*m - 1) * *incx;
00157         }
00158         i__1 = *n;
00159         for (j = 1; j <= i__1; ++j) {
00160             if (y[jy] != 0.) {
00161                 temp = *alpha * y[jy];
00162                 ix = kx;
00163                 i__2 = *m;
00164                 for (i__ = 1; i__ <= i__2; ++i__) {
00165                     a_ref(i__, j) = a_ref(i__, j) + x[ix] * temp;
00166                     ix += *incx;
00167 /* L30: */
00168                 }
00169             }
00170             jy += *incy;
00171 /* L40: */
00172         }
00173     }
00174     return 0;
00175 /*     End of DGER  . */
00176 } /* dger_ */
00177 #undef a_ref
00178 
00179 #endif

Generated on 21 Nov 2012 for ergo by  doxygen 1.6.1