00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016 int zlasr_(char *side, char *pivot, char *direct, integer *m,
00017 integer *n, doublereal *c__, doublereal *s, doublecomplex *a,
00018 integer *lda)
00019 {
00020
00021 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00022 doublecomplex z__1, z__2, z__3;
00023
00024
00025 integer i__, j, info;
00026 doublecomplex temp;
00027 extern logical lsame_(char *, char *);
00028 doublereal ctemp, stemp;
00029 extern int xerbla_(char *, integer *);
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183 --c__;
00184 --s;
00185 a_dim1 = *lda;
00186 a_offset = 1 + a_dim1;
00187 a -= a_offset;
00188
00189
00190 info = 0;
00191 if (! (lsame_(side, "L") || lsame_(side, "R"))) {
00192 info = 1;
00193 } else if (! (lsame_(pivot, "V") || lsame_(pivot,
00194 "T") || lsame_(pivot, "B"))) {
00195 info = 2;
00196 } else if (! (lsame_(direct, "F") || lsame_(direct,
00197 "B"))) {
00198 info = 3;
00199 } else if (*m < 0) {
00200 info = 4;
00201 } else if (*n < 0) {
00202 info = 5;
00203 } else if (*lda < max(1,*m)) {
00204 info = 9;
00205 }
00206 if (info != 0) {
00207 xerbla_("ZLASR ", &info);
00208 return 0;
00209 }
00210
00211
00212
00213 if (*m == 0 || *n == 0) {
00214 return 0;
00215 }
00216 if (lsame_(side, "L")) {
00217
00218
00219
00220 if (lsame_(pivot, "V")) {
00221 if (lsame_(direct, "F")) {
00222 i__1 = *m - 1;
00223 for (j = 1; j <= i__1; ++j) {
00224 ctemp = c__[j];
00225 stemp = s[j];
00226 if (ctemp != 1. || stemp != 0.) {
00227 i__2 = *n;
00228 for (i__ = 1; i__ <= i__2; ++i__) {
00229 i__3 = j + 1 + i__ * a_dim1;
00230 temp.r = a[i__3].r, temp.i = a[i__3].i;
00231 i__3 = j + 1 + i__ * a_dim1;
00232 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00233 i__4 = j + i__ * a_dim1;
00234 z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
00235 i__4].i;
00236 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00237 z__3.i;
00238 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00239 i__3 = j + i__ * a_dim1;
00240 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00241 i__4 = j + i__ * a_dim1;
00242 z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
00243 i__4].i;
00244 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00245 z__3.i;
00246 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00247
00248 }
00249 }
00250
00251 }
00252 } else if (lsame_(direct, "B")) {
00253 for (j = *m - 1; j >= 1; --j) {
00254 ctemp = c__[j];
00255 stemp = s[j];
00256 if (ctemp != 1. || stemp != 0.) {
00257 i__1 = *n;
00258 for (i__ = 1; i__ <= i__1; ++i__) {
00259 i__2 = j + 1 + i__ * a_dim1;
00260 temp.r = a[i__2].r, temp.i = a[i__2].i;
00261 i__2 = j + 1 + i__ * a_dim1;
00262 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00263 i__3 = j + i__ * a_dim1;
00264 z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
00265 i__3].i;
00266 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00267 z__3.i;
00268 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00269 i__2 = j + i__ * a_dim1;
00270 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00271 i__3 = j + i__ * a_dim1;
00272 z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
00273 i__3].i;
00274 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00275 z__3.i;
00276 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00277
00278 }
00279 }
00280
00281 }
00282 }
00283 } else if (lsame_(pivot, "T")) {
00284 if (lsame_(direct, "F")) {
00285 i__1 = *m;
00286 for (j = 2; j <= i__1; ++j) {
00287 ctemp = c__[j - 1];
00288 stemp = s[j - 1];
00289 if (ctemp != 1. || stemp != 0.) {
00290 i__2 = *n;
00291 for (i__ = 1; i__ <= i__2; ++i__) {
00292 i__3 = j + i__ * a_dim1;
00293 temp.r = a[i__3].r, temp.i = a[i__3].i;
00294 i__3 = j + i__ * a_dim1;
00295 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00296 i__4 = i__ * a_dim1 + 1;
00297 z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
00298 i__4].i;
00299 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00300 z__3.i;
00301 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00302 i__3 = i__ * a_dim1 + 1;
00303 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00304 i__4 = i__ * a_dim1 + 1;
00305 z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
00306 i__4].i;
00307 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00308 z__3.i;
00309 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00310
00311 }
00312 }
00313
00314 }
00315 } else if (lsame_(direct, "B")) {
00316 for (j = *m; j >= 2; --j) {
00317 ctemp = c__[j - 1];
00318 stemp = s[j - 1];
00319 if (ctemp != 1. || stemp != 0.) {
00320 i__1 = *n;
00321 for (i__ = 1; i__ <= i__1; ++i__) {
00322 i__2 = j + i__ * a_dim1;
00323 temp.r = a[i__2].r, temp.i = a[i__2].i;
00324 i__2 = j + i__ * a_dim1;
00325 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00326 i__3 = i__ * a_dim1 + 1;
00327 z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
00328 i__3].i;
00329 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00330 z__3.i;
00331 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00332 i__2 = i__ * a_dim1 + 1;
00333 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00334 i__3 = i__ * a_dim1 + 1;
00335 z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
00336 i__3].i;
00337 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00338 z__3.i;
00339 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00340
00341 }
00342 }
00343
00344 }
00345 }
00346 } else if (lsame_(pivot, "B")) {
00347 if (lsame_(direct, "F")) {
00348 i__1 = *m - 1;
00349 for (j = 1; j <= i__1; ++j) {
00350 ctemp = c__[j];
00351 stemp = s[j];
00352 if (ctemp != 1. || stemp != 0.) {
00353 i__2 = *n;
00354 for (i__ = 1; i__ <= i__2; ++i__) {
00355 i__3 = j + i__ * a_dim1;
00356 temp.r = a[i__3].r, temp.i = a[i__3].i;
00357 i__3 = j + i__ * a_dim1;
00358 i__4 = *m + i__ * a_dim1;
00359 z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
00360 i__4].i;
00361 z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
00362 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00363 z__3.i;
00364 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00365 i__3 = *m + i__ * a_dim1;
00366 i__4 = *m + i__ * a_dim1;
00367 z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
00368 i__4].i;
00369 z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
00370 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00371 z__3.i;
00372 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00373
00374 }
00375 }
00376
00377 }
00378 } else if (lsame_(direct, "B")) {
00379 for (j = *m - 1; j >= 1; --j) {
00380 ctemp = c__[j];
00381 stemp = s[j];
00382 if (ctemp != 1. || stemp != 0.) {
00383 i__1 = *n;
00384 for (i__ = 1; i__ <= i__1; ++i__) {
00385 i__2 = j + i__ * a_dim1;
00386 temp.r = a[i__2].r, temp.i = a[i__2].i;
00387 i__2 = j + i__ * a_dim1;
00388 i__3 = *m + i__ * a_dim1;
00389 z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
00390 i__3].i;
00391 z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
00392 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00393 z__3.i;
00394 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00395 i__2 = *m + i__ * a_dim1;
00396 i__3 = *m + i__ * a_dim1;
00397 z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
00398 i__3].i;
00399 z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
00400 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00401 z__3.i;
00402 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00403
00404 }
00405 }
00406
00407 }
00408 }
00409 }
00410 } else if (lsame_(side, "R")) {
00411
00412
00413
00414 if (lsame_(pivot, "V")) {
00415 if (lsame_(direct, "F")) {
00416 i__1 = *n - 1;
00417 for (j = 1; j <= i__1; ++j) {
00418 ctemp = c__[j];
00419 stemp = s[j];
00420 if (ctemp != 1. || stemp != 0.) {
00421 i__2 = *m;
00422 for (i__ = 1; i__ <= i__2; ++i__) {
00423 i__3 = i__ + (j + 1) * a_dim1;
00424 temp.r = a[i__3].r, temp.i = a[i__3].i;
00425 i__3 = i__ + (j + 1) * a_dim1;
00426 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00427 i__4 = i__ + j * a_dim1;
00428 z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
00429 i__4].i;
00430 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00431 z__3.i;
00432 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00433 i__3 = i__ + j * a_dim1;
00434 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00435 i__4 = i__ + j * a_dim1;
00436 z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
00437 i__4].i;
00438 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00439 z__3.i;
00440 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00441
00442 }
00443 }
00444
00445 }
00446 } else if (lsame_(direct, "B")) {
00447 for (j = *n - 1; j >= 1; --j) {
00448 ctemp = c__[j];
00449 stemp = s[j];
00450 if (ctemp != 1. || stemp != 0.) {
00451 i__1 = *m;
00452 for (i__ = 1; i__ <= i__1; ++i__) {
00453 i__2 = i__ + (j + 1) * a_dim1;
00454 temp.r = a[i__2].r, temp.i = a[i__2].i;
00455 i__2 = i__ + (j + 1) * a_dim1;
00456 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00457 i__3 = i__ + j * a_dim1;
00458 z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
00459 i__3].i;
00460 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00461 z__3.i;
00462 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00463 i__2 = i__ + j * a_dim1;
00464 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00465 i__3 = i__ + j * a_dim1;
00466 z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
00467 i__3].i;
00468 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00469 z__3.i;
00470 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00471
00472 }
00473 }
00474
00475 }
00476 }
00477 } else if (lsame_(pivot, "T")) {
00478 if (lsame_(direct, "F")) {
00479 i__1 = *n;
00480 for (j = 2; j <= i__1; ++j) {
00481 ctemp = c__[j - 1];
00482 stemp = s[j - 1];
00483 if (ctemp != 1. || stemp != 0.) {
00484 i__2 = *m;
00485 for (i__ = 1; i__ <= i__2; ++i__) {
00486 i__3 = i__ + j * a_dim1;
00487 temp.r = a[i__3].r, temp.i = a[i__3].i;
00488 i__3 = i__ + j * a_dim1;
00489 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00490 i__4 = i__ + a_dim1;
00491 z__3.r = stemp * a[i__4].r, z__3.i = stemp * a[
00492 i__4].i;
00493 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00494 z__3.i;
00495 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00496 i__3 = i__ + a_dim1;
00497 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00498 i__4 = i__ + a_dim1;
00499 z__3.r = ctemp * a[i__4].r, z__3.i = ctemp * a[
00500 i__4].i;
00501 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00502 z__3.i;
00503 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00504
00505 }
00506 }
00507
00508 }
00509 } else if (lsame_(direct, "B")) {
00510 for (j = *n; j >= 2; --j) {
00511 ctemp = c__[j - 1];
00512 stemp = s[j - 1];
00513 if (ctemp != 1. || stemp != 0.) {
00514 i__1 = *m;
00515 for (i__ = 1; i__ <= i__1; ++i__) {
00516 i__2 = i__ + j * a_dim1;
00517 temp.r = a[i__2].r, temp.i = a[i__2].i;
00518 i__2 = i__ + j * a_dim1;
00519 z__2.r = ctemp * temp.r, z__2.i = ctemp * temp.i;
00520 i__3 = i__ + a_dim1;
00521 z__3.r = stemp * a[i__3].r, z__3.i = stemp * a[
00522 i__3].i;
00523 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00524 z__3.i;
00525 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00526 i__2 = i__ + a_dim1;
00527 z__2.r = stemp * temp.r, z__2.i = stemp * temp.i;
00528 i__3 = i__ + a_dim1;
00529 z__3.r = ctemp * a[i__3].r, z__3.i = ctemp * a[
00530 i__3].i;
00531 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00532 z__3.i;
00533 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00534
00535 }
00536 }
00537
00538 }
00539 }
00540 } else if (lsame_(pivot, "B")) {
00541 if (lsame_(direct, "F")) {
00542 i__1 = *n - 1;
00543 for (j = 1; j <= i__1; ++j) {
00544 ctemp = c__[j];
00545 stemp = s[j];
00546 if (ctemp != 1. || stemp != 0.) {
00547 i__2 = *m;
00548 for (i__ = 1; i__ <= i__2; ++i__) {
00549 i__3 = i__ + j * a_dim1;
00550 temp.r = a[i__3].r, temp.i = a[i__3].i;
00551 i__3 = i__ + j * a_dim1;
00552 i__4 = i__ + *n * a_dim1;
00553 z__2.r = stemp * a[i__4].r, z__2.i = stemp * a[
00554 i__4].i;
00555 z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
00556 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00557 z__3.i;
00558 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00559 i__3 = i__ + *n * a_dim1;
00560 i__4 = i__ + *n * a_dim1;
00561 z__2.r = ctemp * a[i__4].r, z__2.i = ctemp * a[
00562 i__4].i;
00563 z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
00564 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00565 z__3.i;
00566 a[i__3].r = z__1.r, a[i__3].i = z__1.i;
00567
00568 }
00569 }
00570
00571 }
00572 } else if (lsame_(direct, "B")) {
00573 for (j = *n - 1; j >= 1; --j) {
00574 ctemp = c__[j];
00575 stemp = s[j];
00576 if (ctemp != 1. || stemp != 0.) {
00577 i__1 = *m;
00578 for (i__ = 1; i__ <= i__1; ++i__) {
00579 i__2 = i__ + j * a_dim1;
00580 temp.r = a[i__2].r, temp.i = a[i__2].i;
00581 i__2 = i__ + j * a_dim1;
00582 i__3 = i__ + *n * a_dim1;
00583 z__2.r = stemp * a[i__3].r, z__2.i = stemp * a[
00584 i__3].i;
00585 z__3.r = ctemp * temp.r, z__3.i = ctemp * temp.i;
00586 z__1.r = z__2.r + z__3.r, z__1.i = z__2.i +
00587 z__3.i;
00588 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00589 i__2 = i__ + *n * a_dim1;
00590 i__3 = i__ + *n * a_dim1;
00591 z__2.r = ctemp * a[i__3].r, z__2.i = ctemp * a[
00592 i__3].i;
00593 z__3.r = stemp * temp.r, z__3.i = stemp * temp.i;
00594 z__1.r = z__2.r - z__3.r, z__1.i = z__2.i -
00595 z__3.i;
00596 a[i__2].r = z__1.r, a[i__2].i = z__1.i;
00597
00598 }
00599 }
00600
00601 }
00602 }
00603 }
00604 }
00605
00606 return 0;
00607
00608
00609
00610 }