template_lapack_ggbak.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_LAPACK_GGBAK_HEADER
00036 #define TEMPLATE_LAPACK_GGBAK_HEADER
00037 
00038 
00039 template<class Treal>
00040 int template_lapack_ggbak(const char *job, const char *side, const integer *n, const integer *ilo, 
00041         const integer *ihi, const Treal *lscale, const Treal *rscale, const integer *m, 
00042         Treal *v, const integer *ldv, integer *info)
00043 {
00044 /*  -- LAPACK routine (version 3.0) --   
00045        Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,   
00046        Courant Institute, Argonne National Lab, and Rice University   
00047        September 30, 1994   
00048 
00049 
00050     Purpose   
00051     =======   
00052 
00053     DGGBAK forms the right or left eigenvectors of a real generalized   
00054     eigenvalue problem A*x = lambda*B*x, by backward transformation on   
00055     the computed eigenvectors of the balanced pair of matrices output by   
00056     DGGBAL.   
00057 
00058     Arguments   
00059     =========   
00060 
00061     JOB     (input) CHARACTER*1   
00062             Specifies the type of backward transformation required:   
00063             = 'N':  do nothing, return immediately;   
00064             = 'P':  do backward transformation for permutation only;   
00065             = 'S':  do backward transformation for scaling only;   
00066             = 'B':  do backward transformations for both permutation and   
00067                     scaling.   
00068             JOB must be the same as the argument JOB supplied to DGGBAL.   
00069 
00070     SIDE    (input) CHARACTER*1   
00071             = 'R':  V contains right eigenvectors;   
00072             = 'L':  V contains left eigenvectors.   
00073 
00074     N       (input) INTEGER   
00075             The number of rows of the matrix V.  N >= 0.   
00076 
00077     ILO     (input) INTEGER   
00078     IHI     (input) INTEGER   
00079             The integers ILO and IHI determined by DGGBAL.   
00080             1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.   
00081 
00082     LSCALE  (input) DOUBLE PRECISION array, dimension (N)   
00083             Details of the permutations and/or scaling factors applied   
00084             to the left side of A and B, as returned by DGGBAL.   
00085 
00086     RSCALE  (input) DOUBLE PRECISION array, dimension (N)   
00087             Details of the permutations and/or scaling factors applied   
00088             to the right side of A and B, as returned by DGGBAL.   
00089 
00090     M       (input) INTEGER   
00091             The number of columns of the matrix V.  M >= 0.   
00092 
00093     V       (input/output) DOUBLE PRECISION array, dimension (LDV,M)   
00094             On entry, the matrix of right or left eigenvectors to be   
00095             transformed, as returned by DTGEVC.   
00096             On exit, V is overwritten by the transformed eigenvectors.   
00097 
00098     LDV     (input) INTEGER   
00099             The leading dimension of the matrix V. LDV >= max(1,N).   
00100 
00101     INFO    (output) INTEGER   
00102             = 0:  successful exit.   
00103             < 0:  if INFO = -i, the i-th argument had an illegal value.   
00104 
00105     Further Details   
00106     ===============   
00107 
00108     See R.C. Ward, Balancing the generalized eigenvalue problem,   
00109                    SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.   
00110 
00111     =====================================================================   
00112 
00113 
00114        Test the input parameters   
00115 
00116        Parameter adjustments */
00117     /* System generated locals */
00118     integer v_dim1, v_offset, i__1;
00119     /* Local variables */
00120      integer i__, k;
00121      logical leftv;
00122      logical rightv;
00123 #define v_ref(a_1,a_2) v[(a_2)*v_dim1 + a_1]
00124 
00125     --lscale;
00126     --rscale;
00127     v_dim1 = *ldv;
00128     v_offset = 1 + v_dim1 * 1;
00129     v -= v_offset;
00130 
00131     /* Function Body */
00132     rightv = template_blas_lsame(side, "R");
00133     leftv = template_blas_lsame(side, "L");
00134 
00135     *info = 0;
00136     if (! template_blas_lsame(job, "N") && ! template_blas_lsame(job, "P") && ! template_blas_lsame(job, "S") 
00137             && ! template_blas_lsame(job, "B")) {
00138         *info = -1;
00139     } else if (! rightv && ! leftv) {
00140         *info = -2;
00141     } else if (*n < 0) {
00142         *info = -3;
00143     } else if (*ilo < 1) {
00144         *info = -4;
00145     } else if (*ihi < *ilo || *ihi > maxMACRO(1,*n)) {
00146         *info = -5;
00147     } else if (*m < 0) {
00148         *info = -6;
00149     } else if (*ldv < maxMACRO(1,*n)) {
00150         *info = -10;
00151     }
00152     if (*info != 0) {
00153         i__1 = -(*info);
00154         template_blas_erbla("GGBAK ", &i__1);
00155         return 0;
00156     }
00157 
00158 /*     Quick return if possible */
00159 
00160     if (*n == 0) {
00161         return 0;
00162     }
00163     if (*m == 0) {
00164         return 0;
00165     }
00166     if (template_blas_lsame(job, "N")) {
00167         return 0;
00168     }
00169 
00170     if (*ilo == *ihi) {
00171         goto L30;
00172     }
00173 
00174 /*     Backward balance */
00175 
00176     if (template_blas_lsame(job, "S") || template_blas_lsame(job, "B")) {
00177 
00178 /*        Backward transformation on right eigenvectors */
00179 
00180         if (rightv) {
00181             i__1 = *ihi;
00182             for (i__ = *ilo; i__ <= i__1; ++i__) {
00183                 template_blas_scal(m, &rscale[i__], &v_ref(i__, 1), ldv);
00184 /* L10: */
00185             }
00186         }
00187 
00188 /*        Backward transformation on left eigenvectors */
00189 
00190         if (leftv) {
00191             i__1 = *ihi;
00192             for (i__ = *ilo; i__ <= i__1; ++i__) {
00193                 template_blas_scal(m, &lscale[i__], &v_ref(i__, 1), ldv);
00194 /* L20: */
00195             }
00196         }
00197     }
00198 
00199 /*     Backward permutation */
00200 
00201 L30:
00202     if (template_blas_lsame(job, "P") || template_blas_lsame(job, "B")) {
00203 
00204 /*        Backward permutation on right eigenvectors */
00205 
00206         if (rightv) {
00207             if (*ilo == 1) {
00208                 goto L50;
00209             }
00210 
00211             for (i__ = *ilo - 1; i__ >= 1; --i__) {
00212                 k = (integer) rscale[i__];
00213                 if (k == i__) {
00214                     goto L40;
00215                 }
00216                 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00217 L40:
00218                 ;
00219             }
00220 
00221 L50:
00222             if (*ihi == *n) {
00223                 goto L70;
00224             }
00225             i__1 = *n;
00226             for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
00227                 k = (integer) rscale[i__];
00228                 if (k == i__) {
00229                     goto L60;
00230                 }
00231                 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00232 L60:
00233                 ;
00234             }
00235         }
00236 
00237 /*        Backward permutation on left eigenvectors */
00238 
00239 L70:
00240         if (leftv) {
00241             if (*ilo == 1) {
00242                 goto L90;
00243             }
00244             for (i__ = *ilo - 1; i__ >= 1; --i__) {
00245                 k = (integer) lscale[i__];
00246                 if (k == i__) {
00247                     goto L80;
00248                 }
00249                 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00250 L80:
00251                 ;
00252             }
00253 
00254 L90:
00255             if (*ihi == *n) {
00256                 goto L110;
00257             }
00258             i__1 = *n;
00259             for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
00260                 k = (integer) lscale[i__];
00261                 if (k == i__) {
00262                     goto L100;
00263                 }
00264                 template_blas_swap(m, &v_ref(i__, 1), ldv, &v_ref(k, 1), ldv);
00265 L100:
00266                 ;
00267             }
00268         }
00269     }
00270 
00271 L110:
00272 
00273     return 0;
00274 
00275 /*     End of DGGBAK */
00276 
00277 } /* dggbak_ */
00278 
00279 #undef v_ref
00280 
00281 
00282 #endif

Generated on Mon Sep 17 14:32:56 2012 for ergo by  doxygen 1.4.7