00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016 int clasr_(char *side, char *pivot, char *direct, integer *m,
00017 integer *n, real *c__, real *s, complex *a, integer *lda)
00018 {
00019
00020 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
00021 complex q__1, q__2, q__3;
00022
00023
00024 integer i__, j, info;
00025 complex temp;
00026 extern logical lsame_(char *, char *);
00027 real ctemp, stemp;
00028 extern int xerbla_(char *, integer *);
00029
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 --c__;
00183 --s;
00184 a_dim1 = *lda;
00185 a_offset = 1 + a_dim1;
00186 a -= a_offset;
00187
00188
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_("CLASR ", &info);
00207 return 0;
00208 }
00209
00210
00211
00212 if (*m == 0 || *n == 0) {
00213 return 0;
00214 }
00215 if (lsame_(side, "L")) {
00216
00217
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.f || stemp != 0.f) {
00226 i__2 = *n;
00227 for (i__ = 1; i__ <= i__2; ++i__) {
00228 i__3 = j + 1 + i__ * a_dim1;
00229 temp.r = a[i__3].r, temp.i = a[i__3].i;
00230 i__3 = j + 1 + i__ * a_dim1;
00231 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00232 i__4 = j + i__ * a_dim1;
00233 q__3.r = stemp * a[i__4].r, q__3.i = stemp * a[
00234 i__4].i;
00235 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00236 q__3.i;
00237 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00238 i__3 = j + i__ * a_dim1;
00239 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00240 i__4 = j + i__ * a_dim1;
00241 q__3.r = ctemp * a[i__4].r, q__3.i = ctemp * a[
00242 i__4].i;
00243 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00244 q__3.i;
00245 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00246
00247 }
00248 }
00249
00250 }
00251 } else if (lsame_(direct, "B")) {
00252 for (j = *m - 1; j >= 1; --j) {
00253 ctemp = c__[j];
00254 stemp = s[j];
00255 if (ctemp != 1.f || stemp != 0.f) {
00256 i__1 = *n;
00257 for (i__ = 1; i__ <= i__1; ++i__) {
00258 i__2 = j + 1 + i__ * a_dim1;
00259 temp.r = a[i__2].r, temp.i = a[i__2].i;
00260 i__2 = j + 1 + i__ * a_dim1;
00261 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00262 i__3 = j + i__ * a_dim1;
00263 q__3.r = stemp * a[i__3].r, q__3.i = stemp * a[
00264 i__3].i;
00265 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00266 q__3.i;
00267 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00268 i__2 = j + i__ * a_dim1;
00269 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00270 i__3 = j + i__ * a_dim1;
00271 q__3.r = ctemp * a[i__3].r, q__3.i = ctemp * a[
00272 i__3].i;
00273 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00274 q__3.i;
00275 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00276
00277 }
00278 }
00279
00280 }
00281 }
00282 } else if (lsame_(pivot, "T")) {
00283 if (lsame_(direct, "F")) {
00284 i__1 = *m;
00285 for (j = 2; j <= i__1; ++j) {
00286 ctemp = c__[j - 1];
00287 stemp = s[j - 1];
00288 if (ctemp != 1.f || stemp != 0.f) {
00289 i__2 = *n;
00290 for (i__ = 1; i__ <= i__2; ++i__) {
00291 i__3 = j + i__ * a_dim1;
00292 temp.r = a[i__3].r, temp.i = a[i__3].i;
00293 i__3 = j + i__ * a_dim1;
00294 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00295 i__4 = i__ * a_dim1 + 1;
00296 q__3.r = stemp * a[i__4].r, q__3.i = stemp * a[
00297 i__4].i;
00298 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00299 q__3.i;
00300 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00301 i__3 = i__ * a_dim1 + 1;
00302 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00303 i__4 = i__ * a_dim1 + 1;
00304 q__3.r = ctemp * a[i__4].r, q__3.i = ctemp * a[
00305 i__4].i;
00306 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00307 q__3.i;
00308 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00309
00310 }
00311 }
00312
00313 }
00314 } else if (lsame_(direct, "B")) {
00315 for (j = *m; j >= 2; --j) {
00316 ctemp = c__[j - 1];
00317 stemp = s[j - 1];
00318 if (ctemp != 1.f || stemp != 0.f) {
00319 i__1 = *n;
00320 for (i__ = 1; i__ <= i__1; ++i__) {
00321 i__2 = j + i__ * a_dim1;
00322 temp.r = a[i__2].r, temp.i = a[i__2].i;
00323 i__2 = j + i__ * a_dim1;
00324 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00325 i__3 = i__ * a_dim1 + 1;
00326 q__3.r = stemp * a[i__3].r, q__3.i = stemp * a[
00327 i__3].i;
00328 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00329 q__3.i;
00330 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00331 i__2 = i__ * a_dim1 + 1;
00332 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00333 i__3 = i__ * a_dim1 + 1;
00334 q__3.r = ctemp * a[i__3].r, q__3.i = ctemp * a[
00335 i__3].i;
00336 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00337 q__3.i;
00338 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00339
00340 }
00341 }
00342
00343 }
00344 }
00345 } else if (lsame_(pivot, "B")) {
00346 if (lsame_(direct, "F")) {
00347 i__1 = *m - 1;
00348 for (j = 1; j <= i__1; ++j) {
00349 ctemp = c__[j];
00350 stemp = s[j];
00351 if (ctemp != 1.f || stemp != 0.f) {
00352 i__2 = *n;
00353 for (i__ = 1; i__ <= i__2; ++i__) {
00354 i__3 = j + i__ * a_dim1;
00355 temp.r = a[i__3].r, temp.i = a[i__3].i;
00356 i__3 = j + i__ * a_dim1;
00357 i__4 = *m + i__ * a_dim1;
00358 q__2.r = stemp * a[i__4].r, q__2.i = stemp * a[
00359 i__4].i;
00360 q__3.r = ctemp * temp.r, q__3.i = ctemp * temp.i;
00361 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00362 q__3.i;
00363 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00364 i__3 = *m + i__ * a_dim1;
00365 i__4 = *m + i__ * a_dim1;
00366 q__2.r = ctemp * a[i__4].r, q__2.i = ctemp * a[
00367 i__4].i;
00368 q__3.r = stemp * temp.r, q__3.i = stemp * temp.i;
00369 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00370 q__3.i;
00371 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00372
00373 }
00374 }
00375
00376 }
00377 } else if (lsame_(direct, "B")) {
00378 for (j = *m - 1; j >= 1; --j) {
00379 ctemp = c__[j];
00380 stemp = s[j];
00381 if (ctemp != 1.f || stemp != 0.f) {
00382 i__1 = *n;
00383 for (i__ = 1; i__ <= i__1; ++i__) {
00384 i__2 = j + i__ * a_dim1;
00385 temp.r = a[i__2].r, temp.i = a[i__2].i;
00386 i__2 = j + i__ * a_dim1;
00387 i__3 = *m + i__ * a_dim1;
00388 q__2.r = stemp * a[i__3].r, q__2.i = stemp * a[
00389 i__3].i;
00390 q__3.r = ctemp * temp.r, q__3.i = ctemp * temp.i;
00391 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00392 q__3.i;
00393 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00394 i__2 = *m + i__ * a_dim1;
00395 i__3 = *m + i__ * a_dim1;
00396 q__2.r = ctemp * a[i__3].r, q__2.i = ctemp * a[
00397 i__3].i;
00398 q__3.r = stemp * temp.r, q__3.i = stemp * temp.i;
00399 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00400 q__3.i;
00401 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00402
00403 }
00404 }
00405
00406 }
00407 }
00408 }
00409 } else if (lsame_(side, "R")) {
00410
00411
00412
00413 if (lsame_(pivot, "V")) {
00414 if (lsame_(direct, "F")) {
00415 i__1 = *n - 1;
00416 for (j = 1; j <= i__1; ++j) {
00417 ctemp = c__[j];
00418 stemp = s[j];
00419 if (ctemp != 1.f || stemp != 0.f) {
00420 i__2 = *m;
00421 for (i__ = 1; i__ <= i__2; ++i__) {
00422 i__3 = i__ + (j + 1) * a_dim1;
00423 temp.r = a[i__3].r, temp.i = a[i__3].i;
00424 i__3 = i__ + (j + 1) * a_dim1;
00425 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00426 i__4 = i__ + j * a_dim1;
00427 q__3.r = stemp * a[i__4].r, q__3.i = stemp * a[
00428 i__4].i;
00429 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00430 q__3.i;
00431 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00432 i__3 = i__ + j * a_dim1;
00433 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00434 i__4 = i__ + j * a_dim1;
00435 q__3.r = ctemp * a[i__4].r, q__3.i = ctemp * a[
00436 i__4].i;
00437 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00438 q__3.i;
00439 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00440
00441 }
00442 }
00443
00444 }
00445 } else if (lsame_(direct, "B")) {
00446 for (j = *n - 1; j >= 1; --j) {
00447 ctemp = c__[j];
00448 stemp = s[j];
00449 if (ctemp != 1.f || stemp != 0.f) {
00450 i__1 = *m;
00451 for (i__ = 1; i__ <= i__1; ++i__) {
00452 i__2 = i__ + (j + 1) * a_dim1;
00453 temp.r = a[i__2].r, temp.i = a[i__2].i;
00454 i__2 = i__ + (j + 1) * a_dim1;
00455 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00456 i__3 = i__ + j * a_dim1;
00457 q__3.r = stemp * a[i__3].r, q__3.i = stemp * a[
00458 i__3].i;
00459 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00460 q__3.i;
00461 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00462 i__2 = i__ + j * a_dim1;
00463 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00464 i__3 = i__ + j * a_dim1;
00465 q__3.r = ctemp * a[i__3].r, q__3.i = ctemp * a[
00466 i__3].i;
00467 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00468 q__3.i;
00469 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00470
00471 }
00472 }
00473
00474 }
00475 }
00476 } else if (lsame_(pivot, "T")) {
00477 if (lsame_(direct, "F")) {
00478 i__1 = *n;
00479 for (j = 2; j <= i__1; ++j) {
00480 ctemp = c__[j - 1];
00481 stemp = s[j - 1];
00482 if (ctemp != 1.f || stemp != 0.f) {
00483 i__2 = *m;
00484 for (i__ = 1; i__ <= i__2; ++i__) {
00485 i__3 = i__ + j * a_dim1;
00486 temp.r = a[i__3].r, temp.i = a[i__3].i;
00487 i__3 = i__ + j * a_dim1;
00488 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00489 i__4 = i__ + a_dim1;
00490 q__3.r = stemp * a[i__4].r, q__3.i = stemp * a[
00491 i__4].i;
00492 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00493 q__3.i;
00494 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00495 i__3 = i__ + a_dim1;
00496 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00497 i__4 = i__ + a_dim1;
00498 q__3.r = ctemp * a[i__4].r, q__3.i = ctemp * a[
00499 i__4].i;
00500 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00501 q__3.i;
00502 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00503
00504 }
00505 }
00506
00507 }
00508 } else if (lsame_(direct, "B")) {
00509 for (j = *n; j >= 2; --j) {
00510 ctemp = c__[j - 1];
00511 stemp = s[j - 1];
00512 if (ctemp != 1.f || stemp != 0.f) {
00513 i__1 = *m;
00514 for (i__ = 1; i__ <= i__1; ++i__) {
00515 i__2 = i__ + j * a_dim1;
00516 temp.r = a[i__2].r, temp.i = a[i__2].i;
00517 i__2 = i__ + j * a_dim1;
00518 q__2.r = ctemp * temp.r, q__2.i = ctemp * temp.i;
00519 i__3 = i__ + a_dim1;
00520 q__3.r = stemp * a[i__3].r, q__3.i = stemp * a[
00521 i__3].i;
00522 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00523 q__3.i;
00524 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00525 i__2 = i__ + a_dim1;
00526 q__2.r = stemp * temp.r, q__2.i = stemp * temp.i;
00527 i__3 = i__ + a_dim1;
00528 q__3.r = ctemp * a[i__3].r, q__3.i = ctemp * a[
00529 i__3].i;
00530 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00531 q__3.i;
00532 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00533
00534 }
00535 }
00536
00537 }
00538 }
00539 } else if (lsame_(pivot, "B")) {
00540 if (lsame_(direct, "F")) {
00541 i__1 = *n - 1;
00542 for (j = 1; j <= i__1; ++j) {
00543 ctemp = c__[j];
00544 stemp = s[j];
00545 if (ctemp != 1.f || stemp != 0.f) {
00546 i__2 = *m;
00547 for (i__ = 1; i__ <= i__2; ++i__) {
00548 i__3 = i__ + j * a_dim1;
00549 temp.r = a[i__3].r, temp.i = a[i__3].i;
00550 i__3 = i__ + j * a_dim1;
00551 i__4 = i__ + *n * a_dim1;
00552 q__2.r = stemp * a[i__4].r, q__2.i = stemp * a[
00553 i__4].i;
00554 q__3.r = ctemp * temp.r, q__3.i = ctemp * temp.i;
00555 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00556 q__3.i;
00557 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00558 i__3 = i__ + *n * a_dim1;
00559 i__4 = i__ + *n * a_dim1;
00560 q__2.r = ctemp * a[i__4].r, q__2.i = ctemp * a[
00561 i__4].i;
00562 q__3.r = stemp * temp.r, q__3.i = stemp * temp.i;
00563 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00564 q__3.i;
00565 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
00566
00567 }
00568 }
00569
00570 }
00571 } else if (lsame_(direct, "B")) {
00572 for (j = *n - 1; j >= 1; --j) {
00573 ctemp = c__[j];
00574 stemp = s[j];
00575 if (ctemp != 1.f || stemp != 0.f) {
00576 i__1 = *m;
00577 for (i__ = 1; i__ <= i__1; ++i__) {
00578 i__2 = i__ + j * a_dim1;
00579 temp.r = a[i__2].r, temp.i = a[i__2].i;
00580 i__2 = i__ + j * a_dim1;
00581 i__3 = i__ + *n * a_dim1;
00582 q__2.r = stemp * a[i__3].r, q__2.i = stemp * a[
00583 i__3].i;
00584 q__3.r = ctemp * temp.r, q__3.i = ctemp * temp.i;
00585 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i +
00586 q__3.i;
00587 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00588 i__2 = i__ + *n * a_dim1;
00589 i__3 = i__ + *n * a_dim1;
00590 q__2.r = ctemp * a[i__3].r, q__2.i = ctemp * a[
00591 i__3].i;
00592 q__3.r = stemp * temp.r, q__3.i = stemp * temp.i;
00593 q__1.r = q__2.r - q__3.r, q__1.i = q__2.i -
00594 q__3.i;
00595 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
00596
00597 }
00598 }
00599
00600 }
00601 }
00602 }
00603 }
00604
00605 return 0;
00606
00607
00608
00609 }