dlasr.c
Go to the documentation of this file.
00001 /* dlasr.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 /* Subroutine */ int dlasr_(char *side, char *pivot, char *direct, integer *m, 
00017          integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *
00018         lda)
00019 {
00020     /* System generated locals */
00021     integer a_dim1, a_offset, i__1, i__2;
00022 
00023     /* Local variables */
00024     integer i__, j, info;
00025     doublereal temp;
00026     extern logical lsame_(char *, char *);
00027     doublereal ctemp, stemp;
00028     extern /* Subroutine */ int xerbla_(char *, integer *);
00029 
00030 
00031 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00032 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00033 /*     November 2006 */
00034 
00035 /*     .. Scalar Arguments .. */
00036 /*     .. */
00037 /*     .. Array Arguments .. */
00038 /*     .. */
00039 
00040 /*  Purpose */
00041 /*  ======= */
00042 
00043 /*  DLASR applies a sequence of plane rotations to a real matrix A, */
00044 /*  from either the left or the right. */
00045 
00046 /*  When SIDE = 'L', the transformation takes the form */
00047 
00048 /*     A := P*A */
00049 
00050 /*  and when SIDE = 'R', the transformation takes the form */
00051 
00052 /*     A := A*P**T */
00053 
00054 /*  where P is an orthogonal matrix consisting of a sequence of z plane */
00055 /*  rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', */
00056 /*  and P**T is the transpose of P. */
00057 
00058 /*  When DIRECT = 'F' (Forward sequence), then */
00059 
00060 /*     P = P(z-1) * ... * P(2) * P(1) */
00061 
00062 /*  and when DIRECT = 'B' (Backward sequence), then */
00063 
00064 /*     P = P(1) * P(2) * ... * P(z-1) */
00065 
00066 /*  where P(k) is a plane rotation matrix defined by the 2-by-2 rotation */
00067 
00068 /*     R(k) = (  c(k)  s(k) ) */
00069 /*          = ( -s(k)  c(k) ). */
00070 
00071 /*  When PIVOT = 'V' (Variable pivot), the rotation is performed */
00072 /*  for the plane (k,k+1), i.e., P(k) has the form */
00073 
00074 /*     P(k) = (  1                                            ) */
00075 /*            (       ...                                     ) */
00076 /*            (              1                                ) */
00077 /*            (                   c(k)  s(k)                  ) */
00078 /*            (                  -s(k)  c(k)                  ) */
00079 /*            (                                1              ) */
00080 /*            (                                     ...       ) */
00081 /*            (                                            1  ) */
00082 
00083 /*  where R(k) appears as a rank-2 modification to the identity matrix in */
00084 /*  rows and columns k and k+1. */
00085 
00086 /*  When PIVOT = 'T' (Top pivot), the rotation is performed for the */
00087 /*  plane (1,k+1), so P(k) has the form */
00088 
00089 /*     P(k) = (  c(k)                    s(k)                 ) */
00090 /*            (         1                                     ) */
00091 /*            (              ...                              ) */
00092 /*            (                     1                         ) */
00093 /*            ( -s(k)                    c(k)                 ) */
00094 /*            (                                 1             ) */
00095 /*            (                                      ...      ) */
00096 /*            (                                             1 ) */
00097 
00098 /*  where R(k) appears in rows and columns 1 and k+1. */
00099 
00100 /*  Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is */
00101 /*  performed for the plane (k,z), giving P(k) the form */
00102 
00103 /*     P(k) = ( 1                                             ) */
00104 /*            (      ...                                      ) */
00105 /*            (             1                                 ) */
00106 /*            (                  c(k)                    s(k) ) */
00107 /*            (                         1                     ) */
00108 /*            (                              ...              ) */
00109 /*            (                                     1         ) */
00110 /*            (                 -s(k)                    c(k) ) */
00111 
00112 /*  where R(k) appears in rows and columns k and z.  The rotations are */
00113 /*  performed without ever forming P(k) explicitly. */
00114 
00115 /*  Arguments */
00116 /*  ========= */
00117 
00118 /*  SIDE    (input) CHARACTER*1 */
00119 /*          Specifies whether the plane rotation matrix P is applied to */
00120 /*          A on the left or the right. */
00121 /*          = 'L':  Left, compute A := P*A */
00122 /*          = 'R':  Right, compute A:= A*P**T */
00123 
00124 /*  PIVOT   (input) CHARACTER*1 */
00125 /*          Specifies the plane for which P(k) is a plane rotation */
00126 /*          matrix. */
00127 /*          = 'V':  Variable pivot, the plane (k,k+1) */
00128 /*          = 'T':  Top pivot, the plane (1,k+1) */
00129 /*          = 'B':  Bottom pivot, the plane (k,z) */
00130 
00131 /*  DIRECT  (input) CHARACTER*1 */
00132 /*          Specifies whether P is a forward or backward sequence of */
00133 /*          plane rotations. */
00134 /*          = 'F':  Forward, P = P(z-1)*...*P(2)*P(1) */
00135 /*          = 'B':  Backward, P = P(1)*P(2)*...*P(z-1) */
00136 
00137 /*  M       (input) INTEGER */
00138 /*          The number of rows of the matrix A.  If m <= 1, an immediate */
00139 /*          return is effected. */
00140 
00141 /*  N       (input) INTEGER */
00142 /*          The number of columns of the matrix A.  If n <= 1, an */
00143 /*          immediate return is effected. */
00144 
00145 /*  C       (input) DOUBLE PRECISION array, dimension */
00146 /*                  (M-1) if SIDE = 'L' */
00147 /*                  (N-1) if SIDE = 'R' */
00148 /*          The cosines c(k) of the plane rotations. */
00149 
00150 /*  S       (input) DOUBLE PRECISION array, dimension */
00151 /*                  (M-1) if SIDE = 'L' */
00152 /*                  (N-1) if SIDE = 'R' */
00153 /*          The sines s(k) of the plane rotations.  The 2-by-2 plane */
00154 /*          rotation part of the matrix P(k), R(k), has the form */
00155 /*          R(k) = (  c(k)  s(k) ) */
00156 /*                 ( -s(k)  c(k) ). */
00157 
00158 /*  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
00159 /*          The M-by-N matrix A.  On exit, A is overwritten by P*A if */
00160 /*          SIDE = 'R' or by A*P**T if SIDE = 'L'. */
00161 
00162 /*  LDA     (input) INTEGER */
00163 /*          The leading dimension of the array A.  LDA >= max(1,M). */
00164 
00165 /*  ===================================================================== */
00166 
00167 /*     .. Parameters .. */
00168 /*     .. */
00169 /*     .. Local Scalars .. */
00170 /*     .. */
00171 /*     .. External Functions .. */
00172 /*     .. */
00173 /*     .. External Subroutines .. */
00174 /*     .. */
00175 /*     .. Intrinsic Functions .. */
00176 /*     .. */
00177 /*     .. Executable Statements .. */
00178 
00179 /*     Test the input parameters */
00180 
00181     /* Parameter adjustments */
00182     --c__;
00183     --s;
00184     a_dim1 = *lda;
00185     a_offset = 1 + a_dim1;
00186     a -= a_offset;
00187 
00188     /* Function Body */
00189     info = 0;
00190     if (! (lsame_(side, "L") || lsame_(side, "R"))) {
00191         info = 1;
00192     } else if (! (lsame_(pivot, "V") || lsame_(pivot, 
00193             "T") || lsame_(pivot, "B"))) {
00194         info = 2;
00195     } else if (! (lsame_(direct, "F") || lsame_(direct, 
00196             "B"))) {
00197         info = 3;
00198     } else if (*m < 0) {
00199         info = 4;
00200     } else if (*n < 0) {
00201         info = 5;
00202     } else if (*lda < max(1,*m)) {
00203         info = 9;
00204     }
00205     if (info != 0) {
00206         xerbla_("DLASR ", &info);
00207         return 0;
00208     }
00209 
00210 /*     Quick return if possible */
00211 
00212     if (*m == 0 || *n == 0) {
00213         return 0;
00214     }
00215     if (lsame_(side, "L")) {
00216 
00217 /*        Form  P * A */
00218 
00219         if (lsame_(pivot, "V")) {
00220             if (lsame_(direct, "F")) {
00221                 i__1 = *m - 1;
00222                 for (j = 1; j <= i__1; ++j) {
00223                     ctemp = c__[j];
00224                     stemp = s[j];
00225                     if (ctemp != 1. || stemp != 0.) {
00226                         i__2 = *n;
00227                         for (i__ = 1; i__ <= i__2; ++i__) {
00228                             temp = a[j + 1 + i__ * a_dim1];
00229                             a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * 
00230                                     a[j + i__ * a_dim1];
00231                             a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j 
00232                                     + i__ * a_dim1];
00233 /* L10: */
00234                         }
00235                     }
00236 /* L20: */
00237                 }
00238             } else if (lsame_(direct, "B")) {
00239                 for (j = *m - 1; j >= 1; --j) {
00240                     ctemp = c__[j];
00241                     stemp = s[j];
00242                     if (ctemp != 1. || stemp != 0.) {
00243                         i__1 = *n;
00244                         for (i__ = 1; i__ <= i__1; ++i__) {
00245                             temp = a[j + 1 + i__ * a_dim1];
00246                             a[j + 1 + i__ * a_dim1] = ctemp * temp - stemp * 
00247                                     a[j + i__ * a_dim1];
00248                             a[j + i__ * a_dim1] = stemp * temp + ctemp * a[j 
00249                                     + i__ * a_dim1];
00250 /* L30: */
00251                         }
00252                     }
00253 /* L40: */
00254                 }
00255             }
00256         } else if (lsame_(pivot, "T")) {
00257             if (lsame_(direct, "F")) {
00258                 i__1 = *m;
00259                 for (j = 2; j <= i__1; ++j) {
00260                     ctemp = c__[j - 1];
00261                     stemp = s[j - 1];
00262                     if (ctemp != 1. || stemp != 0.) {
00263                         i__2 = *n;
00264                         for (i__ = 1; i__ <= i__2; ++i__) {
00265                             temp = a[j + i__ * a_dim1];
00266                             a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
00267                                     i__ * a_dim1 + 1];
00268                             a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
00269                                     i__ * a_dim1 + 1];
00270 /* L50: */
00271                         }
00272                     }
00273 /* L60: */
00274                 }
00275             } else if (lsame_(direct, "B")) {
00276                 for (j = *m; j >= 2; --j) {
00277                     ctemp = c__[j - 1];
00278                     stemp = s[j - 1];
00279                     if (ctemp != 1. || stemp != 0.) {
00280                         i__1 = *n;
00281                         for (i__ = 1; i__ <= i__1; ++i__) {
00282                             temp = a[j + i__ * a_dim1];
00283                             a[j + i__ * a_dim1] = ctemp * temp - stemp * a[
00284                                     i__ * a_dim1 + 1];
00285                             a[i__ * a_dim1 + 1] = stemp * temp + ctemp * a[
00286                                     i__ * a_dim1 + 1];
00287 /* L70: */
00288                         }
00289                     }
00290 /* L80: */
00291                 }
00292             }
00293         } else if (lsame_(pivot, "B")) {
00294             if (lsame_(direct, "F")) {
00295                 i__1 = *m - 1;
00296                 for (j = 1; j <= i__1; ++j) {
00297                     ctemp = c__[j];
00298                     stemp = s[j];
00299                     if (ctemp != 1. || stemp != 0.) {
00300                         i__2 = *n;
00301                         for (i__ = 1; i__ <= i__2; ++i__) {
00302                             temp = a[j + i__ * a_dim1];
00303                             a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
00304                                      + ctemp * temp;
00305                             a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * 
00306                                     a_dim1] - stemp * temp;
00307 /* L90: */
00308                         }
00309                     }
00310 /* L100: */
00311                 }
00312             } else if (lsame_(direct, "B")) {
00313                 for (j = *m - 1; j >= 1; --j) {
00314                     ctemp = c__[j];
00315                     stemp = s[j];
00316                     if (ctemp != 1. || stemp != 0.) {
00317                         i__1 = *n;
00318                         for (i__ = 1; i__ <= i__1; ++i__) {
00319                             temp = a[j + i__ * a_dim1];
00320                             a[j + i__ * a_dim1] = stemp * a[*m + i__ * a_dim1]
00321                                      + ctemp * temp;
00322                             a[*m + i__ * a_dim1] = ctemp * a[*m + i__ * 
00323                                     a_dim1] - stemp * temp;
00324 /* L110: */
00325                         }
00326                     }
00327 /* L120: */
00328                 }
00329             }
00330         }
00331     } else if (lsame_(side, "R")) {
00332 
00333 /*        Form A * P' */
00334 
00335         if (lsame_(pivot, "V")) {
00336             if (lsame_(direct, "F")) {
00337                 i__1 = *n - 1;
00338                 for (j = 1; j <= i__1; ++j) {
00339                     ctemp = c__[j];
00340                     stemp = s[j];
00341                     if (ctemp != 1. || stemp != 0.) {
00342                         i__2 = *m;
00343                         for (i__ = 1; i__ <= i__2; ++i__) {
00344                             temp = a[i__ + (j + 1) * a_dim1];
00345                             a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
00346                                      a[i__ + j * a_dim1];
00347                             a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
00348                                     i__ + j * a_dim1];
00349 /* L130: */
00350                         }
00351                     }
00352 /* L140: */
00353                 }
00354             } else if (lsame_(direct, "B")) {
00355                 for (j = *n - 1; j >= 1; --j) {
00356                     ctemp = c__[j];
00357                     stemp = s[j];
00358                     if (ctemp != 1. || stemp != 0.) {
00359                         i__1 = *m;
00360                         for (i__ = 1; i__ <= i__1; ++i__) {
00361                             temp = a[i__ + (j + 1) * a_dim1];
00362                             a[i__ + (j + 1) * a_dim1] = ctemp * temp - stemp *
00363                                      a[i__ + j * a_dim1];
00364                             a[i__ + j * a_dim1] = stemp * temp + ctemp * a[
00365                                     i__ + j * a_dim1];
00366 /* L150: */
00367                         }
00368                     }
00369 /* L160: */
00370                 }
00371             }
00372         } else if (lsame_(pivot, "T")) {
00373             if (lsame_(direct, "F")) {
00374                 i__1 = *n;
00375                 for (j = 2; j <= i__1; ++j) {
00376                     ctemp = c__[j - 1];
00377                     stemp = s[j - 1];
00378                     if (ctemp != 1. || stemp != 0.) {
00379                         i__2 = *m;
00380                         for (i__ = 1; i__ <= i__2; ++i__) {
00381                             temp = a[i__ + j * a_dim1];
00382                             a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
00383                                     i__ + a_dim1];
00384                             a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + 
00385                                     a_dim1];
00386 /* L170: */
00387                         }
00388                     }
00389 /* L180: */
00390                 }
00391             } else if (lsame_(direct, "B")) {
00392                 for (j = *n; j >= 2; --j) {
00393                     ctemp = c__[j - 1];
00394                     stemp = s[j - 1];
00395                     if (ctemp != 1. || stemp != 0.) {
00396                         i__1 = *m;
00397                         for (i__ = 1; i__ <= i__1; ++i__) {
00398                             temp = a[i__ + j * a_dim1];
00399                             a[i__ + j * a_dim1] = ctemp * temp - stemp * a[
00400                                     i__ + a_dim1];
00401                             a[i__ + a_dim1] = stemp * temp + ctemp * a[i__ + 
00402                                     a_dim1];
00403 /* L190: */
00404                         }
00405                     }
00406 /* L200: */
00407                 }
00408             }
00409         } else if (lsame_(pivot, "B")) {
00410             if (lsame_(direct, "F")) {
00411                 i__1 = *n - 1;
00412                 for (j = 1; j <= i__1; ++j) {
00413                     ctemp = c__[j];
00414                     stemp = s[j];
00415                     if (ctemp != 1. || stemp != 0.) {
00416                         i__2 = *m;
00417                         for (i__ = 1; i__ <= i__2; ++i__) {
00418                             temp = a[i__ + j * a_dim1];
00419                             a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
00420                                      + ctemp * temp;
00421                             a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * 
00422                                     a_dim1] - stemp * temp;
00423 /* L210: */
00424                         }
00425                     }
00426 /* L220: */
00427                 }
00428             } else if (lsame_(direct, "B")) {
00429                 for (j = *n - 1; j >= 1; --j) {
00430                     ctemp = c__[j];
00431                     stemp = s[j];
00432                     if (ctemp != 1. || stemp != 0.) {
00433                         i__1 = *m;
00434                         for (i__ = 1; i__ <= i__1; ++i__) {
00435                             temp = a[i__ + j * a_dim1];
00436                             a[i__ + j * a_dim1] = stemp * a[i__ + *n * a_dim1]
00437                                      + ctemp * temp;
00438                             a[i__ + *n * a_dim1] = ctemp * a[i__ + *n * 
00439                                     a_dim1] - stemp * temp;
00440 /* L230: */
00441                         }
00442                     }
00443 /* L240: */
00444                 }
00445             }
00446         }
00447     }
00448 
00449     return 0;
00450 
00451 /*     End of DLASR */
00452 
00453 } /* dlasr_ */

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