00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016 int ztrmm_(char *side, char *uplo, char *transa, char *diag,
00017 integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
00018 integer *lda, doublecomplex *b, integer *ldb)
00019 {
00020
00021 integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
00022 i__6;
00023 doublecomplex z__1, z__2, z__3;
00024
00025
00026 void d_cnjg(doublecomplex *, doublecomplex *);
00027
00028
00029 integer i__, j, k, info;
00030 doublecomplex temp;
00031 logical lside;
00032 extern logical lsame_(char *, char *);
00033 integer nrowa;
00034 logical upper;
00035 extern int xerbla_(char *, integer *);
00036 logical noconj, nounit;
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 a_dim1 = *lda;
00174 a_offset = 1 + a_dim1;
00175 a -= a_offset;
00176 b_dim1 = *ldb;
00177 b_offset = 1 + b_dim1;
00178 b -= b_offset;
00179
00180
00181 lside = lsame_(side, "L");
00182 if (lside) {
00183 nrowa = *m;
00184 } else {
00185 nrowa = *n;
00186 }
00187 noconj = lsame_(transa, "T");
00188 nounit = lsame_(diag, "N");
00189 upper = lsame_(uplo, "U");
00190
00191 info = 0;
00192 if (! lside && ! lsame_(side, "R")) {
00193 info = 1;
00194 } else if (! upper && ! lsame_(uplo, "L")) {
00195 info = 2;
00196 } else if (! lsame_(transa, "N") && ! lsame_(transa,
00197 "T") && ! lsame_(transa, "C")) {
00198 info = 3;
00199 } else if (! lsame_(diag, "U") && ! lsame_(diag,
00200 "N")) {
00201 info = 4;
00202 } else if (*m < 0) {
00203 info = 5;
00204 } else if (*n < 0) {
00205 info = 6;
00206 } else if (*lda < max(1,nrowa)) {
00207 info = 9;
00208 } else if (*ldb < max(1,*m)) {
00209 info = 11;
00210 }
00211 if (info != 0) {
00212 xerbla_("ZTRMM ", &info);
00213 return 0;
00214 }
00215
00216
00217
00218 if (*m == 0 || *n == 0) {
00219 return 0;
00220 }
00221
00222
00223
00224 if (alpha->r == 0. && alpha->i == 0.) {
00225 i__1 = *n;
00226 for (j = 1; j <= i__1; ++j) {
00227 i__2 = *m;
00228 for (i__ = 1; i__ <= i__2; ++i__) {
00229 i__3 = i__ + j * b_dim1;
00230 b[i__3].r = 0., b[i__3].i = 0.;
00231
00232 }
00233
00234 }
00235 return 0;
00236 }
00237
00238
00239
00240 if (lside) {
00241 if (lsame_(transa, "N")) {
00242
00243
00244
00245 if (upper) {
00246 i__1 = *n;
00247 for (j = 1; j <= i__1; ++j) {
00248 i__2 = *m;
00249 for (k = 1; k <= i__2; ++k) {
00250 i__3 = k + j * b_dim1;
00251 if (b[i__3].r != 0. || b[i__3].i != 0.) {
00252 i__3 = k + j * b_dim1;
00253 z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
00254 .i, z__1.i = alpha->r * b[i__3].i +
00255 alpha->i * b[i__3].r;
00256 temp.r = z__1.r, temp.i = z__1.i;
00257 i__3 = k - 1;
00258 for (i__ = 1; i__ <= i__3; ++i__) {
00259 i__4 = i__ + j * b_dim1;
00260 i__5 = i__ + j * b_dim1;
00261 i__6 = i__ + k * a_dim1;
00262 z__2.r = temp.r * a[i__6].r - temp.i * a[i__6]
00263 .i, z__2.i = temp.r * a[i__6].i +
00264 temp.i * a[i__6].r;
00265 z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
00266 .i + z__2.i;
00267 b[i__4].r = z__1.r, b[i__4].i = z__1.i;
00268
00269 }
00270 if (nounit) {
00271 i__3 = k + k * a_dim1;
00272 z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
00273 .i, z__1.i = temp.r * a[i__3].i +
00274 temp.i * a[i__3].r;
00275 temp.r = z__1.r, temp.i = z__1.i;
00276 }
00277 i__3 = k + j * b_dim1;
00278 b[i__3].r = temp.r, b[i__3].i = temp.i;
00279 }
00280
00281 }
00282
00283 }
00284 } else {
00285 i__1 = *n;
00286 for (j = 1; j <= i__1; ++j) {
00287 for (k = *m; k >= 1; --k) {
00288 i__2 = k + j * b_dim1;
00289 if (b[i__2].r != 0. || b[i__2].i != 0.) {
00290 i__2 = k + j * b_dim1;
00291 z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2]
00292 .i, z__1.i = alpha->r * b[i__2].i +
00293 alpha->i * b[i__2].r;
00294 temp.r = z__1.r, temp.i = z__1.i;
00295 i__2 = k + j * b_dim1;
00296 b[i__2].r = temp.r, b[i__2].i = temp.i;
00297 if (nounit) {
00298 i__2 = k + j * b_dim1;
00299 i__3 = k + j * b_dim1;
00300 i__4 = k + k * a_dim1;
00301 z__1.r = b[i__3].r * a[i__4].r - b[i__3].i *
00302 a[i__4].i, z__1.i = b[i__3].r * a[
00303 i__4].i + b[i__3].i * a[i__4].r;
00304 b[i__2].r = z__1.r, b[i__2].i = z__1.i;
00305 }
00306 i__2 = *m;
00307 for (i__ = k + 1; i__ <= i__2; ++i__) {
00308 i__3 = i__ + j * b_dim1;
00309 i__4 = i__ + j * b_dim1;
00310 i__5 = i__ + k * a_dim1;
00311 z__2.r = temp.r * a[i__5].r - temp.i * a[i__5]
00312 .i, z__2.i = temp.r * a[i__5].i +
00313 temp.i * a[i__5].r;
00314 z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
00315 .i + z__2.i;
00316 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00317
00318 }
00319 }
00320
00321 }
00322
00323 }
00324 }
00325 } else {
00326
00327
00328
00329 if (upper) {
00330 i__1 = *n;
00331 for (j = 1; j <= i__1; ++j) {
00332 for (i__ = *m; i__ >= 1; --i__) {
00333 i__2 = i__ + j * b_dim1;
00334 temp.r = b[i__2].r, temp.i = b[i__2].i;
00335 if (noconj) {
00336 if (nounit) {
00337 i__2 = i__ + i__ * a_dim1;
00338 z__1.r = temp.r * a[i__2].r - temp.i * a[i__2]
00339 .i, z__1.i = temp.r * a[i__2].i +
00340 temp.i * a[i__2].r;
00341 temp.r = z__1.r, temp.i = z__1.i;
00342 }
00343 i__2 = i__ - 1;
00344 for (k = 1; k <= i__2; ++k) {
00345 i__3 = k + i__ * a_dim1;
00346 i__4 = k + j * b_dim1;
00347 z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
00348 b[i__4].i, z__2.i = a[i__3].r * b[
00349 i__4].i + a[i__3].i * b[i__4].r;
00350 z__1.r = temp.r + z__2.r, z__1.i = temp.i +
00351 z__2.i;
00352 temp.r = z__1.r, temp.i = z__1.i;
00353
00354 }
00355 } else {
00356 if (nounit) {
00357 d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
00358 z__1.r = temp.r * z__2.r - temp.i * z__2.i,
00359 z__1.i = temp.r * z__2.i + temp.i *
00360 z__2.r;
00361 temp.r = z__1.r, temp.i = z__1.i;
00362 }
00363 i__2 = i__ - 1;
00364 for (k = 1; k <= i__2; ++k) {
00365 d_cnjg(&z__3, &a[k + i__ * a_dim1]);
00366 i__3 = k + j * b_dim1;
00367 z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
00368 .i, z__2.i = z__3.r * b[i__3].i +
00369 z__3.i * b[i__3].r;
00370 z__1.r = temp.r + z__2.r, z__1.i = temp.i +
00371 z__2.i;
00372 temp.r = z__1.r, temp.i = z__1.i;
00373
00374 }
00375 }
00376 i__2 = i__ + j * b_dim1;
00377 z__1.r = alpha->r * temp.r - alpha->i * temp.i,
00378 z__1.i = alpha->r * temp.i + alpha->i *
00379 temp.r;
00380 b[i__2].r = z__1.r, b[i__2].i = z__1.i;
00381
00382 }
00383
00384 }
00385 } else {
00386 i__1 = *n;
00387 for (j = 1; j <= i__1; ++j) {
00388 i__2 = *m;
00389 for (i__ = 1; i__ <= i__2; ++i__) {
00390 i__3 = i__ + j * b_dim1;
00391 temp.r = b[i__3].r, temp.i = b[i__3].i;
00392 if (noconj) {
00393 if (nounit) {
00394 i__3 = i__ + i__ * a_dim1;
00395 z__1.r = temp.r * a[i__3].r - temp.i * a[i__3]
00396 .i, z__1.i = temp.r * a[i__3].i +
00397 temp.i * a[i__3].r;
00398 temp.r = z__1.r, temp.i = z__1.i;
00399 }
00400 i__3 = *m;
00401 for (k = i__ + 1; k <= i__3; ++k) {
00402 i__4 = k + i__ * a_dim1;
00403 i__5 = k + j * b_dim1;
00404 z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
00405 b[i__5].i, z__2.i = a[i__4].r * b[
00406 i__5].i + a[i__4].i * b[i__5].r;
00407 z__1.r = temp.r + z__2.r, z__1.i = temp.i +
00408 z__2.i;
00409 temp.r = z__1.r, temp.i = z__1.i;
00410
00411 }
00412 } else {
00413 if (nounit) {
00414 d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
00415 z__1.r = temp.r * z__2.r - temp.i * z__2.i,
00416 z__1.i = temp.r * z__2.i + temp.i *
00417 z__2.r;
00418 temp.r = z__1.r, temp.i = z__1.i;
00419 }
00420 i__3 = *m;
00421 for (k = i__ + 1; k <= i__3; ++k) {
00422 d_cnjg(&z__3, &a[k + i__ * a_dim1]);
00423 i__4 = k + j * b_dim1;
00424 z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
00425 .i, z__2.i = z__3.r * b[i__4].i +
00426 z__3.i * b[i__4].r;
00427 z__1.r = temp.r + z__2.r, z__1.i = temp.i +
00428 z__2.i;
00429 temp.r = z__1.r, temp.i = z__1.i;
00430
00431 }
00432 }
00433 i__3 = i__ + j * b_dim1;
00434 z__1.r = alpha->r * temp.r - alpha->i * temp.i,
00435 z__1.i = alpha->r * temp.i + alpha->i *
00436 temp.r;
00437 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00438
00439 }
00440
00441 }
00442 }
00443 }
00444 } else {
00445 if (lsame_(transa, "N")) {
00446
00447
00448
00449 if (upper) {
00450 for (j = *n; j >= 1; --j) {
00451 temp.r = alpha->r, temp.i = alpha->i;
00452 if (nounit) {
00453 i__1 = j + j * a_dim1;
00454 z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
00455 z__1.i = temp.r * a[i__1].i + temp.i * a[i__1]
00456 .r;
00457 temp.r = z__1.r, temp.i = z__1.i;
00458 }
00459 i__1 = *m;
00460 for (i__ = 1; i__ <= i__1; ++i__) {
00461 i__2 = i__ + j * b_dim1;
00462 i__3 = i__ + j * b_dim1;
00463 z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
00464 z__1.i = temp.r * b[i__3].i + temp.i * b[i__3]
00465 .r;
00466 b[i__2].r = z__1.r, b[i__2].i = z__1.i;
00467
00468 }
00469 i__1 = j - 1;
00470 for (k = 1; k <= i__1; ++k) {
00471 i__2 = k + j * a_dim1;
00472 if (a[i__2].r != 0. || a[i__2].i != 0.) {
00473 i__2 = k + j * a_dim1;
00474 z__1.r = alpha->r * a[i__2].r - alpha->i * a[i__2]
00475 .i, z__1.i = alpha->r * a[i__2].i +
00476 alpha->i * a[i__2].r;
00477 temp.r = z__1.r, temp.i = z__1.i;
00478 i__2 = *m;
00479 for (i__ = 1; i__ <= i__2; ++i__) {
00480 i__3 = i__ + j * b_dim1;
00481 i__4 = i__ + j * b_dim1;
00482 i__5 = i__ + k * b_dim1;
00483 z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
00484 .i, z__2.i = temp.r * b[i__5].i +
00485 temp.i * b[i__5].r;
00486 z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
00487 .i + z__2.i;
00488 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00489
00490 }
00491 }
00492
00493 }
00494
00495 }
00496 } else {
00497 i__1 = *n;
00498 for (j = 1; j <= i__1; ++j) {
00499 temp.r = alpha->r, temp.i = alpha->i;
00500 if (nounit) {
00501 i__2 = j + j * a_dim1;
00502 z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
00503 z__1.i = temp.r * a[i__2].i + temp.i * a[i__2]
00504 .r;
00505 temp.r = z__1.r, temp.i = z__1.i;
00506 }
00507 i__2 = *m;
00508 for (i__ = 1; i__ <= i__2; ++i__) {
00509 i__3 = i__ + j * b_dim1;
00510 i__4 = i__ + j * b_dim1;
00511 z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
00512 z__1.i = temp.r * b[i__4].i + temp.i * b[i__4]
00513 .r;
00514 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00515
00516 }
00517 i__2 = *n;
00518 for (k = j + 1; k <= i__2; ++k) {
00519 i__3 = k + j * a_dim1;
00520 if (a[i__3].r != 0. || a[i__3].i != 0.) {
00521 i__3 = k + j * a_dim1;
00522 z__1.r = alpha->r * a[i__3].r - alpha->i * a[i__3]
00523 .i, z__1.i = alpha->r * a[i__3].i +
00524 alpha->i * a[i__3].r;
00525 temp.r = z__1.r, temp.i = z__1.i;
00526 i__3 = *m;
00527 for (i__ = 1; i__ <= i__3; ++i__) {
00528 i__4 = i__ + j * b_dim1;
00529 i__5 = i__ + j * b_dim1;
00530 i__6 = i__ + k * b_dim1;
00531 z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
00532 .i, z__2.i = temp.r * b[i__6].i +
00533 temp.i * b[i__6].r;
00534 z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
00535 .i + z__2.i;
00536 b[i__4].r = z__1.r, b[i__4].i = z__1.i;
00537
00538 }
00539 }
00540
00541 }
00542
00543 }
00544 }
00545 } else {
00546
00547
00548
00549 if (upper) {
00550 i__1 = *n;
00551 for (k = 1; k <= i__1; ++k) {
00552 i__2 = k - 1;
00553 for (j = 1; j <= i__2; ++j) {
00554 i__3 = j + k * a_dim1;
00555 if (a[i__3].r != 0. || a[i__3].i != 0.) {
00556 if (noconj) {
00557 i__3 = j + k * a_dim1;
00558 z__1.r = alpha->r * a[i__3].r - alpha->i * a[
00559 i__3].i, z__1.i = alpha->r * a[i__3]
00560 .i + alpha->i * a[i__3].r;
00561 temp.r = z__1.r, temp.i = z__1.i;
00562 } else {
00563 d_cnjg(&z__2, &a[j + k * a_dim1]);
00564 z__1.r = alpha->r * z__2.r - alpha->i *
00565 z__2.i, z__1.i = alpha->r * z__2.i +
00566 alpha->i * z__2.r;
00567 temp.r = z__1.r, temp.i = z__1.i;
00568 }
00569 i__3 = *m;
00570 for (i__ = 1; i__ <= i__3; ++i__) {
00571 i__4 = i__ + j * b_dim1;
00572 i__5 = i__ + j * b_dim1;
00573 i__6 = i__ + k * b_dim1;
00574 z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
00575 .i, z__2.i = temp.r * b[i__6].i +
00576 temp.i * b[i__6].r;
00577 z__1.r = b[i__5].r + z__2.r, z__1.i = b[i__5]
00578 .i + z__2.i;
00579 b[i__4].r = z__1.r, b[i__4].i = z__1.i;
00580
00581 }
00582 }
00583
00584 }
00585 temp.r = alpha->r, temp.i = alpha->i;
00586 if (nounit) {
00587 if (noconj) {
00588 i__2 = k + k * a_dim1;
00589 z__1.r = temp.r * a[i__2].r - temp.i * a[i__2].i,
00590 z__1.i = temp.r * a[i__2].i + temp.i * a[
00591 i__2].r;
00592 temp.r = z__1.r, temp.i = z__1.i;
00593 } else {
00594 d_cnjg(&z__2, &a[k + k * a_dim1]);
00595 z__1.r = temp.r * z__2.r - temp.i * z__2.i,
00596 z__1.i = temp.r * z__2.i + temp.i *
00597 z__2.r;
00598 temp.r = z__1.r, temp.i = z__1.i;
00599 }
00600 }
00601 if (temp.r != 1. || temp.i != 0.) {
00602 i__2 = *m;
00603 for (i__ = 1; i__ <= i__2; ++i__) {
00604 i__3 = i__ + k * b_dim1;
00605 i__4 = i__ + k * b_dim1;
00606 z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
00607 z__1.i = temp.r * b[i__4].i + temp.i * b[
00608 i__4].r;
00609 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00610
00611 }
00612 }
00613
00614 }
00615 } else {
00616 for (k = *n; k >= 1; --k) {
00617 i__1 = *n;
00618 for (j = k + 1; j <= i__1; ++j) {
00619 i__2 = j + k * a_dim1;
00620 if (a[i__2].r != 0. || a[i__2].i != 0.) {
00621 if (noconj) {
00622 i__2 = j + k * a_dim1;
00623 z__1.r = alpha->r * a[i__2].r - alpha->i * a[
00624 i__2].i, z__1.i = alpha->r * a[i__2]
00625 .i + alpha->i * a[i__2].r;
00626 temp.r = z__1.r, temp.i = z__1.i;
00627 } else {
00628 d_cnjg(&z__2, &a[j + k * a_dim1]);
00629 z__1.r = alpha->r * z__2.r - alpha->i *
00630 z__2.i, z__1.i = alpha->r * z__2.i +
00631 alpha->i * z__2.r;
00632 temp.r = z__1.r, temp.i = z__1.i;
00633 }
00634 i__2 = *m;
00635 for (i__ = 1; i__ <= i__2; ++i__) {
00636 i__3 = i__ + j * b_dim1;
00637 i__4 = i__ + j * b_dim1;
00638 i__5 = i__ + k * b_dim1;
00639 z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
00640 .i, z__2.i = temp.r * b[i__5].i +
00641 temp.i * b[i__5].r;
00642 z__1.r = b[i__4].r + z__2.r, z__1.i = b[i__4]
00643 .i + z__2.i;
00644 b[i__3].r = z__1.r, b[i__3].i = z__1.i;
00645
00646 }
00647 }
00648
00649 }
00650 temp.r = alpha->r, temp.i = alpha->i;
00651 if (nounit) {
00652 if (noconj) {
00653 i__1 = k + k * a_dim1;
00654 z__1.r = temp.r * a[i__1].r - temp.i * a[i__1].i,
00655 z__1.i = temp.r * a[i__1].i + temp.i * a[
00656 i__1].r;
00657 temp.r = z__1.r, temp.i = z__1.i;
00658 } else {
00659 d_cnjg(&z__2, &a[k + k * a_dim1]);
00660 z__1.r = temp.r * z__2.r - temp.i * z__2.i,
00661 z__1.i = temp.r * z__2.i + temp.i *
00662 z__2.r;
00663 temp.r = z__1.r, temp.i = z__1.i;
00664 }
00665 }
00666 if (temp.r != 1. || temp.i != 0.) {
00667 i__1 = *m;
00668 for (i__ = 1; i__ <= i__1; ++i__) {
00669 i__2 = i__ + k * b_dim1;
00670 i__3 = i__ + k * b_dim1;
00671 z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
00672 z__1.i = temp.r * b[i__3].i + temp.i * b[
00673 i__3].r;
00674 b[i__2].r = z__1.r, b[i__2].i = z__1.i;
00675
00676 }
00677 }
00678
00679 }
00680 }
00681 }
00682 }
00683
00684 return 0;
00685
00686
00687
00688 }