dlarot.c
Go to the documentation of this file.
00001 /* dlarot.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static integer c__4 = 4;
00019 static integer c__8 = 8;
00020 static integer c__1 = 1;
00021 
00022 /* Subroutine */ int dlarot_(logical *lrows, logical *lleft, logical *lright, 
00023         integer *nl, doublereal *c__, doublereal *s, doublereal *a, integer *
00024         lda, doublereal *xleft, doublereal *xright)
00025 {
00026     /* System generated locals */
00027     integer i__1;
00028 
00029     /* Local variables */
00030     integer ix, iy, nt;
00031     doublereal xt[2], yt[2];
00032     integer iyt, iinc;
00033     extern /* Subroutine */ int drot_(integer *, doublereal *, integer *, 
00034             doublereal *, integer *, doublereal *, doublereal *);
00035     integer inext;
00036     extern /* Subroutine */ int xerbla_(char *, integer *);
00037 
00038 
00039 /*  -- LAPACK auxiliary test routine (version 3.1) -- */
00040 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00041 /*     November 2006 */
00042 
00043 /*     .. Scalar Arguments .. */
00044 /*     .. */
00045 /*     .. Array Arguments .. */
00046 /*     .. */
00047 
00048 /*  Purpose */
00049 /*  ======= */
00050 
00051 /*     DLAROT applies a (Givens) rotation to two adjacent rows or */
00052 /*     columns, where one element of the first and/or last column/row */
00053 /*     for use on matrices stored in some format other than GE, so */
00054 /*     that elements of the matrix may be used or modified for which */
00055 /*     no array element is provided. */
00056 
00057 /*     One example is a symmetric matrix in SB format (bandwidth=4), for */
00058 /*     which UPLO='L':  Two adjacent rows will have the format: */
00059 
00060 /*     row j:     *  *  *  *  *  .  .  .  . */
00061 /*     row j+1:      *  *  *  *  *  .  .  .  . */
00062 
00063 /*     '*' indicates elements for which storage is provided, */
00064 /*     '.' indicates elements for which no storage is provided, but */
00065 /*     are not necessarily zero; their values are determined by */
00066 /*     symmetry.  ' ' indicates elements which are necessarily zero, */
00067 /*      and have no storage provided. */
00068 
00069 /*     Those columns which have two '*'s can be handled by DROT. */
00070 /*     Those columns which have no '*'s can be ignored, since as long */
00071 /*     as the Givens rotations are carefully applied to preserve */
00072 /*     symmetry, their values are determined. */
00073 /*     Those columns which have one '*' have to be handled separately, */
00074 /*     by using separate variables "p" and "q": */
00075 
00076 /*     row j:     *  *  *  *  *  p  .  .  . */
00077 /*     row j+1:   q  *  *  *  *  *  .  .  .  . */
00078 
00079 /*     The element p would have to be set correctly, then that column */
00080 /*     is rotated, setting p to its new value.  The next call to */
00081 /*     DLAROT would rotate columns j and j+1, using p, and restore */
00082 /*     symmetry.  The element q would start out being zero, and be */
00083 /*     made non-zero by the rotation.  Later, rotations would presumably */
00084 /*     be chosen to zero q out. */
00085 
00086 /*     Typical Calling Sequences: rotating the i-th and (i+1)-st rows. */
00087 /*     ------- ------- --------- */
00088 
00089 /*       General dense matrix: */
00090 
00091 /*               CALL DLAROT(.TRUE.,.FALSE.,.FALSE., N, C,S, */
00092 /*                       A(i,1),LDA, DUMMY, DUMMY) */
00093 
00094 /*       General banded matrix in GB format: */
00095 
00096 /*               j = MAX(1, i-KL ) */
00097 /*               NL = MIN( N, i+KU+1 ) + 1-j */
00098 /*               CALL DLAROT( .TRUE., i-KL.GE.1, i+KU.LT.N, NL, C,S, */
00099 /*                       A(KU+i+1-j,j),LDA-1, XLEFT, XRIGHT ) */
00100 
00101 /*               [ note that i+1-j is just MIN(i,KL+1) ] */
00102 
00103 /*       Symmetric banded matrix in SY format, bandwidth K, */
00104 /*       lower triangle only: */
00105 
00106 /*               j = MAX(1, i-K ) */
00107 /*               NL = MIN( K+1, i ) + 1 */
00108 /*               CALL DLAROT( .TRUE., i-K.GE.1, .TRUE., NL, C,S, */
00109 /*                       A(i,j), LDA, XLEFT, XRIGHT ) */
00110 
00111 /*       Same, but upper triangle only: */
00112 
00113 /*               NL = MIN( K+1, N-i ) + 1 */
00114 /*               CALL DLAROT( .TRUE., .TRUE., i+K.LT.N, NL, C,S, */
00115 /*                       A(i,i), LDA, XLEFT, XRIGHT ) */
00116 
00117 /*       Symmetric banded matrix in SB format, bandwidth K, */
00118 /*       lower triangle only: */
00119 
00120 /*               [ same as for SY, except:] */
00121 /*                   . . . . */
00122 /*                       A(i+1-j,j), LDA-1, XLEFT, XRIGHT ) */
00123 
00124 /*               [ note that i+1-j is just MIN(i,K+1) ] */
00125 
00126 /*       Same, but upper triangle only: */
00127 /*                    . . . */
00128 /*                       A(K+1,i), LDA-1, XLEFT, XRIGHT ) */
00129 
00130 /*       Rotating columns is just the transpose of rotating rows, except */
00131 /*       for GB and SB: (rotating columns i and i+1) */
00132 
00133 /*       GB: */
00134 /*               j = MAX(1, i-KU ) */
00135 /*               NL = MIN( N, i+KL+1 ) + 1-j */
00136 /*               CALL DLAROT( .TRUE., i-KU.GE.1, i+KL.LT.N, NL, C,S, */
00137 /*                       A(KU+j+1-i,i),LDA-1, XTOP, XBOTTM ) */
00138 
00139 /*               [note that KU+j+1-i is just MAX(1,KU+2-i)] */
00140 
00141 /*       SB: (upper triangle) */
00142 
00143 /*                    . . . . . . */
00144 /*                       A(K+j+1-i,i),LDA-1, XTOP, XBOTTM ) */
00145 
00146 /*       SB: (lower triangle) */
00147 
00148 /*                    . . . . . . */
00149 /*                       A(1,i),LDA-1, XTOP, XBOTTM ) */
00150 
00151 /*  Arguments */
00152 /*  ========= */
00153 
00154 /*  LROWS  - LOGICAL */
00155 /*           If .TRUE., then DLAROT will rotate two rows.  If .FALSE., */
00156 /*           then it will rotate two columns. */
00157 /*           Not modified. */
00158 
00159 /*  LLEFT  - LOGICAL */
00160 /*           If .TRUE., then XLEFT will be used instead of the */
00161 /*           corresponding element of A for the first element in the */
00162 /*           second row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) */
00163 /*           If .FALSE., then the corresponding element of A will be */
00164 /*           used. */
00165 /*           Not modified. */
00166 
00167 /*  LRIGHT - LOGICAL */
00168 /*           If .TRUE., then XRIGHT will be used instead of the */
00169 /*           corresponding element of A for the last element in the */
00170 /*           first row (if LROWS=.FALSE.) or column (if LROWS=.TRUE.) If */
00171 /*           .FALSE., then the corresponding element of A will be used. */
00172 /*           Not modified. */
00173 
00174 /*  NL     - INTEGER */
00175 /*           The length of the rows (if LROWS=.TRUE.) or columns (if */
00176 /*           LROWS=.FALSE.) to be rotated.  If XLEFT and/or XRIGHT are */
00177 /*           used, the columns/rows they are in should be included in */
00178 /*           NL, e.g., if LLEFT = LRIGHT = .TRUE., then NL must be at */
00179 /*           least 2.  The number of rows/columns to be rotated */
00180 /*           exclusive of those involving XLEFT and/or XRIGHT may */
00181 /*           not be negative, i.e., NL minus how many of LLEFT and */
00182 /*           LRIGHT are .TRUE. must be at least zero; if not, XERBLA */
00183 /*           will be called. */
00184 /*           Not modified. */
00185 
00186 /*  C, S   - DOUBLE PRECISION */
00187 /*           Specify the Givens rotation to be applied.  If LROWS is */
00188 /*           true, then the matrix ( c  s ) */
00189 /*                                 (-s  c )  is applied from the left; */
00190 /*           if false, then the transpose thereof is applied from the */
00191 /*           right.  For a Givens rotation, C**2 + S**2 should be 1, */
00192 /*           but this is not checked. */
00193 /*           Not modified. */
00194 
00195 /*  A      - DOUBLE PRECISION array. */
00196 /*           The array containing the rows/columns to be rotated.  The */
00197 /*           first element of A should be the upper left element to */
00198 /*           be rotated. */
00199 /*           Read and modified. */
00200 
00201 /*  LDA    - INTEGER */
00202 /*           The "effective" leading dimension of A.  If A contains */
00203 /*           a matrix stored in GE or SY format, then this is just */
00204 /*           the leading dimension of A as dimensioned in the calling */
00205 /*           routine.  If A contains a matrix stored in band (GB or SB) */
00206 /*           format, then this should be *one less* than the leading */
00207 /*           dimension used in the calling routine.  Thus, if */
00208 /*           A were dimensioned A(LDA,*) in DLAROT, then A(1,j) would */
00209 /*           be the j-th element in the first of the two rows */
00210 /*           to be rotated, and A(2,j) would be the j-th in the second, */
00211 /*           regardless of how the array may be stored in the calling */
00212 /*           routine.  [A cannot, however, actually be dimensioned thus, */
00213 /*           since for band format, the row number may exceed LDA, which */
00214 /*           is not legal FORTRAN.] */
00215 /*           If LROWS=.TRUE., then LDA must be at least 1, otherwise */
00216 /*           it must be at least NL minus the number of .TRUE. values */
00217 /*           in XLEFT and XRIGHT. */
00218 /*           Not modified. */
00219 
00220 /*  XLEFT  - DOUBLE PRECISION */
00221 /*           If LLEFT is .TRUE., then XLEFT will be used and modified */
00222 /*           instead of A(2,1) (if LROWS=.TRUE.) or A(1,2) */
00223 /*           (if LROWS=.FALSE.). */
00224 /*           Read and modified. */
00225 
00226 /*  XRIGHT - DOUBLE PRECISION */
00227 /*           If LRIGHT is .TRUE., then XRIGHT will be used and modified */
00228 /*           instead of A(1,NL) (if LROWS=.TRUE.) or A(NL,1) */
00229 /*           (if LROWS=.FALSE.). */
00230 /*           Read and modified. */
00231 
00232 /*  ===================================================================== */
00233 
00234 /*     .. Local Scalars .. */
00235 /*     .. */
00236 /*     .. Local Arrays .. */
00237 /*     .. */
00238 /*     .. External Subroutines .. */
00239 /*     .. */
00240 /*     .. Executable Statements .. */
00241 
00242 /*     Set up indices, arrays for ends */
00243 
00244     /* Parameter adjustments */
00245     --a;
00246 
00247     /* Function Body */
00248     if (*lrows) {
00249         iinc = *lda;
00250         inext = 1;
00251     } else {
00252         iinc = 1;
00253         inext = *lda;
00254     }
00255 
00256     if (*lleft) {
00257         nt = 1;
00258         ix = iinc + 1;
00259         iy = *lda + 2;
00260         xt[0] = a[1];
00261         yt[0] = *xleft;
00262     } else {
00263         nt = 0;
00264         ix = 1;
00265         iy = inext + 1;
00266     }
00267 
00268     if (*lright) {
00269         iyt = inext + 1 + (*nl - 1) * iinc;
00270         ++nt;
00271         xt[nt - 1] = *xright;
00272         yt[nt - 1] = a[iyt];
00273     }
00274 
00275 /*     Check for errors */
00276 
00277     if (*nl < nt) {
00278         xerbla_("DLAROT", &c__4);
00279         return 0;
00280     }
00281     if (*lda <= 0 || ! (*lrows) && *lda < *nl - nt) {
00282         xerbla_("DLAROT", &c__8);
00283         return 0;
00284     }
00285 
00286 /*     Rotate */
00287 
00288     i__1 = *nl - nt;
00289     drot_(&i__1, &a[ix], &iinc, &a[iy], &iinc, c__, s);
00290     drot_(&nt, xt, &c__1, yt, &c__1, c__, s);
00291 
00292 /*     Stuff values back into XLEFT, XRIGHT, etc. */
00293 
00294     if (*lleft) {
00295         a[1] = xt[0];
00296         *xleft = yt[0];
00297     }
00298 
00299     if (*lright) {
00300         *xright = xt[nt - 1];
00301         a[iyt] = yt[nt - 1];
00302     }
00303 
00304     return 0;
00305 
00306 /*     End of DLAROT */
00307 
00308 } /* dlarot_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:46