swiftnav: slasr.c Source File

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