5 #include "sphinxbase/f2c.h"
10 extern doublereal slamch_(
char *);
11 #define EPSILON slamch_("Epsilon")
12 #define SAFEMINIMUM slamch_("Safe minimum")
13 #define PRECISION slamch_("Precision")
14 #define BASE slamch_("Base")
18 extern doublereal slapy2_(real *, real *);
24 static integer c__0 = 0;
25 static real c_b163 = 0.f;
26 static real c_b164 = 1.f;
27 static integer c__1 = 1;
28 static real c_b181 = -1.f;
29 static integer c_n1 = -1;
31 integer ieeeck_(integer *ispec, real *zero, real *one)
37 static real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro,
80 posinf = *one / *zero;
86 neginf = -(*one) / *zero;
87 if (neginf >= *zero) {
92 negzro = *one / (neginf + *one);
93 if (negzro != *zero) {
98 neginf = *one / negzro;
99 if (neginf >= *zero) {
104 newzro = negzro + *zero;
105 if (newzro != *zero) {
110 posinf = *one / newzro;
111 if (posinf <= *one) {
117 if (neginf >= *zero) {
123 if (posinf <= *one) {
135 nan1 = posinf + neginf;
137 nan2 = posinf / neginf;
139 nan3 = posinf / posinf;
141 nan4 = posinf * *zero;
143 nan5 = neginf * negzro;
180 integer ilaenv_(integer *ispec,
char *name__,
char *opts, integer *n1,
181 integer *n2, integer *n3, integer *n4, ftnlen name_len, ftnlen
188 int s_copy(
char *,
char *, ftnlen, ftnlen);
189 integer s_cmp(
char *,
char *, ftnlen, ftnlen);
193 static char c1[1], c2[2], c3[3], c4[2];
194 static integer ic, nb, iz, nx;
195 static logical cname, sname;
196 static integer nbmin;
197 extern integer ieeeck_(integer *, real *, real *);
198 static char subnam[6];
324 s_copy(subnam, name__, (ftnlen)6, name_len);
325 ic = *(
unsigned char *)subnam;
327 if (iz == 90 || iz == 122) {
331 if (ic >= 97 && ic <= 122) {
332 *(
unsigned char *)subnam = (
char) (ic - 32);
333 for (i__ = 2; i__ <= 6; ++i__) {
334 ic = *(
unsigned char *)&subnam[i__ - 1];
335 if (ic >= 97 && ic <= 122) {
336 *(
unsigned char *)&subnam[i__ - 1] = (
char) (ic - 32);
342 }
else if (iz == 233 || iz == 169) {
346 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
348 *(
unsigned char *)subnam = (
char) (ic + 64);
349 for (i__ = 2; i__ <= 6; ++i__) {
350 ic = *(
unsigned char *)&subnam[i__ - 1];
351 if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
353 *(
unsigned char *)&subnam[i__ - 1] = (
char) (ic + 64);
359 }
else if (iz == 218 || iz == 250) {
363 if (ic >= 225 && ic <= 250) {
364 *(
unsigned char *)subnam = (
char) (ic - 32);
365 for (i__ = 2; i__ <= 6; ++i__) {
366 ic = *(
unsigned char *)&subnam[i__ - 1];
367 if (ic >= 225 && ic <= 250) {
368 *(
unsigned char *)&subnam[i__ - 1] = (
char) (ic - 32);
375 *(
unsigned char *)c1 = *(
unsigned char *)subnam;
376 sname = *(
unsigned char *)c1 ==
'S' || *(
unsigned char *)c1 ==
'D';
377 cname = *(
unsigned char *)c1 ==
'C' || *(
unsigned char *)c1 ==
'Z';
378 if (! (cname || sname)) {
381 s_copy(c2, subnam + 1, (ftnlen)2, (ftnlen)2);
382 s_copy(c3, subnam + 3, (ftnlen)3, (ftnlen)3);
383 s_copy(c4, c3 + 1, (ftnlen)2, (ftnlen)2);
403 if (s_cmp(c2,
"GE", (ftnlen)2, (ftnlen)2) == 0) {
404 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
410 }
else if (s_cmp(c3,
"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
411 "RQF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
"LQF", (ftnlen)
412 3, (ftnlen)3) == 0 || s_cmp(c3,
"QLF", (ftnlen)3, (ftnlen)3)
419 }
else if (s_cmp(c3,
"HRD", (ftnlen)3, (ftnlen)3) == 0) {
425 }
else if (s_cmp(c3,
"BRD", (ftnlen)3, (ftnlen)3) == 0) {
431 }
else if (s_cmp(c3,
"TRI", (ftnlen)3, (ftnlen)3) == 0) {
438 }
else if (s_cmp(c2,
"PO", (ftnlen)2, (ftnlen)2) == 0) {
439 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
446 }
else if (s_cmp(c2,
"SY", (ftnlen)2, (ftnlen)2) == 0) {
447 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
453 }
else if (sname && s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
455 }
else if (sname && s_cmp(c3,
"GST", (ftnlen)3, (ftnlen)3) == 0) {
458 }
else if (cname && s_cmp(c2,
"HE", (ftnlen)2, (ftnlen)2) == 0) {
459 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
461 }
else if (s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
463 }
else if (s_cmp(c3,
"GST", (ftnlen)3, (ftnlen)3) == 0) {
466 }
else if (sname && s_cmp(c2,
"OR", (ftnlen)2, (ftnlen)2) == 0) {
467 if (*(
unsigned char *)c3 ==
'G') {
468 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
469 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
470 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
471 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
472 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
473 ftnlen)2, (ftnlen)2) == 0) {
476 }
else if (*(
unsigned char *)c3 ==
'M') {
477 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
478 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
479 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
480 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
481 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
482 ftnlen)2, (ftnlen)2) == 0) {
486 }
else if (cname && s_cmp(c2,
"UN", (ftnlen)2, (ftnlen)2) == 0) {
487 if (*(
unsigned char *)c3 ==
'G') {
488 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
489 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
490 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
491 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
492 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
493 ftnlen)2, (ftnlen)2) == 0) {
496 }
else if (*(
unsigned char *)c3 ==
'M') {
497 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
498 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
499 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
500 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
501 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
502 ftnlen)2, (ftnlen)2) == 0) {
506 }
else if (s_cmp(c2,
"GB", (ftnlen)2, (ftnlen)2) == 0) {
507 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
522 }
else if (s_cmp(c2,
"PB", (ftnlen)2, (ftnlen)2) == 0) {
523 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
538 }
else if (s_cmp(c2,
"TR", (ftnlen)2, (ftnlen)2) == 0) {
539 if (s_cmp(c3,
"TRI", (ftnlen)3, (ftnlen)3) == 0) {
546 }
else if (s_cmp(c2,
"LA", (ftnlen)2, (ftnlen)2) == 0) {
547 if (s_cmp(c3,
"UUM", (ftnlen)3, (ftnlen)3) == 0) {
554 }
else if (sname && s_cmp(c2,
"ST", (ftnlen)2, (ftnlen)2) == 0) {
555 if (s_cmp(c3,
"EBZ", (ftnlen)3, (ftnlen)3) == 0) {
567 if (s_cmp(c2,
"GE", (ftnlen)2, (ftnlen)2) == 0) {
568 if (s_cmp(c3,
"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
"RQF", (
569 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
"LQF", (ftnlen)3, (
570 ftnlen)3) == 0 || s_cmp(c3,
"QLF", (ftnlen)3, (ftnlen)3) == 0)
577 }
else if (s_cmp(c3,
"HRD", (ftnlen)3, (ftnlen)3) == 0) {
583 }
else if (s_cmp(c3,
"BRD", (ftnlen)3, (ftnlen)3) == 0) {
589 }
else if (s_cmp(c3,
"TRI", (ftnlen)3, (ftnlen)3) == 0) {
596 }
else if (s_cmp(c2,
"SY", (ftnlen)2, (ftnlen)2) == 0) {
597 if (s_cmp(c3,
"TRF", (ftnlen)3, (ftnlen)3) == 0) {
603 }
else if (sname && s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
606 }
else if (cname && s_cmp(c2,
"HE", (ftnlen)2, (ftnlen)2) == 0) {
607 if (s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
610 }
else if (sname && s_cmp(c2,
"OR", (ftnlen)2, (ftnlen)2) == 0) {
611 if (*(
unsigned char *)c3 ==
'G') {
612 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
613 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
614 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
615 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
616 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
617 ftnlen)2, (ftnlen)2) == 0) {
620 }
else if (*(
unsigned char *)c3 ==
'M') {
621 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
622 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
623 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
624 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
625 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
626 ftnlen)2, (ftnlen)2) == 0) {
630 }
else if (cname && s_cmp(c2,
"UN", (ftnlen)2, (ftnlen)2) == 0) {
631 if (*(
unsigned char *)c3 ==
'G') {
632 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
633 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
634 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
635 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
636 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
637 ftnlen)2, (ftnlen)2) == 0) {
640 }
else if (*(
unsigned char *)c3 ==
'M') {
641 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
642 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
643 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
644 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
645 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
646 ftnlen)2, (ftnlen)2) == 0) {
659 if (s_cmp(c2,
"GE", (ftnlen)2, (ftnlen)2) == 0) {
660 if (s_cmp(c3,
"QRF", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
"RQF", (
661 ftnlen)3, (ftnlen)3) == 0 || s_cmp(c3,
"LQF", (ftnlen)3, (
662 ftnlen)3) == 0 || s_cmp(c3,
"QLF", (ftnlen)3, (ftnlen)3) == 0)
669 }
else if (s_cmp(c3,
"HRD", (ftnlen)3, (ftnlen)3) == 0) {
675 }
else if (s_cmp(c3,
"BRD", (ftnlen)3, (ftnlen)3) == 0) {
682 }
else if (s_cmp(c2,
"SY", (ftnlen)2, (ftnlen)2) == 0) {
683 if (sname && s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
686 }
else if (cname && s_cmp(c2,
"HE", (ftnlen)2, (ftnlen)2) == 0) {
687 if (s_cmp(c3,
"TRD", (ftnlen)3, (ftnlen)3) == 0) {
690 }
else if (sname && s_cmp(c2,
"OR", (ftnlen)2, (ftnlen)2) == 0) {
691 if (*(
unsigned char *)c3 ==
'G') {
692 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
693 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
694 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
695 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
696 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
697 ftnlen)2, (ftnlen)2) == 0) {
701 }
else if (cname && s_cmp(c2,
"UN", (ftnlen)2, (ftnlen)2) == 0) {
702 if (*(
unsigned char *)c3 ==
'G') {
703 if (s_cmp(c4,
"QR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"RQ",
704 (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"LQ", (ftnlen)2, (
705 ftnlen)2) == 0 || s_cmp(c4,
"QL", (ftnlen)2, (ftnlen)2) ==
706 0 || s_cmp(c4,
"HR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(
707 c4,
"TR", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(c4,
"BR", (
708 ftnlen)2, (ftnlen)2) == 0) {
734 ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
771 ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
784 ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
792 int sposv_(
char *uplo, integer *n, integer *nrhs, real *a,
793 integer *lda, real *b, integer *ldb, integer *info)
796 integer a_dim1, a_offset, b_dim1, b_offset, i__1;
799 extern logical lsame_(
char *,
char *);
800 extern int xerbla_(
char *, integer *), spotrf_(
801 char *, integer *, real *, integer *, integer *), spotrs_(
802 char *, integer *, integer *, real *, integer *, real *, integer *
880 a_offset = 1 + a_dim1;
883 b_offset = 1 + b_dim1;
888 if (! lsame_(uplo,
"U") && ! lsame_(uplo,
"L")) {
892 }
else if (*nrhs < 0) {
894 }
else if (*lda < max(1,*n)) {
896 }
else if (*ldb < max(1,*n)) {
901 xerbla_(
"SPOSV ", &i__1);
907 spotrf_(uplo, n, &a[a_offset], lda, info);
912 spotrs_(uplo, n, nrhs, &a[a_offset], lda, &b[b_offset], ldb, info);
921 int spotf2_(
char *uplo, integer *n, real *a, integer *lda,
925 integer a_dim1, a_offset, i__1, i__2, i__3;
929 double sqrt(doublereal);
934 extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
935 extern logical lsame_(
char *,
char *);
936 extern int sscal_(integer *, real *, real *, integer *),
937 sgemv_(
char *, integer *, integer *, real *, real *, integer *,
938 real *, integer *, real *, real *, integer *);
939 static logical upper;
940 extern int xerbla_(
char *, integer *);
1005 a_offset = 1 + a_dim1;
1010 upper = lsame_(uplo,
"U");
1011 if (! upper && ! lsame_(uplo,
"L")) {
1013 }
else if (*n < 0) {
1015 }
else if (*lda < max(1,*n)) {
1020 xerbla_(
"SPOTF2", &i__1);
1035 for (j = 1; j <= i__1; ++j) {
1040 ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j * a_dim1 + 1], &c__1,
1041 &a[j * a_dim1 + 1], &c__1);
1043 a[j + j * a_dim1] = ajj;
1047 a[j + j * a_dim1] = ajj;
1054 sgemv_(
"Transpose", &i__2, &i__3, &c_b181, &a[(j + 1) *
1055 a_dim1 + 1], lda, &a[j * a_dim1 + 1], &c__1, &c_b164,
1056 &a[j + (j + 1) * a_dim1], lda);
1059 sscal_(&i__2, &r__1, &a[j + (j + 1) * a_dim1], lda);
1068 for (j = 1; j <= i__1; ++j) {
1073 ajj = a[j + j * a_dim1] - sdot_(&i__2, &a[j + a_dim1], lda, &a[j
1076 a[j + j * a_dim1] = ajj;
1080 a[j + j * a_dim1] = ajj;
1087 sgemv_(
"No transpose", &i__2, &i__3, &c_b181, &a[j + 1 +
1088 a_dim1], lda, &a[j + a_dim1], lda, &c_b164, &a[j + 1
1089 + j * a_dim1], &c__1);
1092 sscal_(&i__2, &r__1, &a[j + 1 + j * a_dim1], &c__1);
1109 int spotrf_(
char *uplo, integer *n, real *a, integer *lda,
1113 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
1116 static integer j, jb, nb;
1117 extern logical lsame_(
char *,
char *);
1118 extern int sgemm_(
char *,
char *, integer *, integer *,
1119 integer *, real *, real *, integer *, real *, integer *, real *,
1121 static logical upper;
1122 extern int strsm_(
char *,
char *,
char *,
char *,
1123 integer *, integer *, real *, real *, integer *, real *, integer *
1124 ), ssyrk_(
char *,
char *, integer
1125 *, integer *, real *, real *, integer *, real *, real *, integer *
1126 ), spotf2_(
char *, integer *, real *, integer *,
1127 integer *), xerbla_(
char *, integer *);
1128 extern integer ilaenv_(integer *,
char *,
char *, integer *, integer *,
1129 integer *, integer *, ftnlen, ftnlen);
1192 a_offset = 1 + a_dim1;
1197 upper = lsame_(uplo,
"U");
1198 if (! upper && ! lsame_(uplo,
"L")) {
1200 }
else if (*n < 0) {
1202 }
else if (*lda < max(1,*n)) {
1207 xerbla_(
"SPOTRF", &i__1);
1219 nb = ilaenv_(&c__1,
"SPOTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
1221 if (nb <= 1 || nb >= *n) {
1225 spotf2_(uplo, n, &a[a_offset], lda, info);
1236 for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
1244 i__3 = nb, i__4 = *n - j + 1;
1245 jb = min(i__3,i__4);
1247 ssyrk_(
"Upper",
"Transpose", &jb, &i__3, &c_b181, &a[j *
1248 a_dim1 + 1], lda, &c_b164, &a[j + j * a_dim1], lda);
1249 spotf2_(
"Upper", &jb, &a[j + j * a_dim1], lda, info);
1257 i__3 = *n - j - jb + 1;
1259 sgemm_(
"Transpose",
"No transpose", &jb, &i__3, &i__4, &
1260 c_b181, &a[j * a_dim1 + 1], lda, &a[(j + jb) *
1261 a_dim1 + 1], lda, &c_b164, &a[j + (j + jb) *
1263 i__3 = *n - j - jb + 1;
1264 strsm_(
"Left",
"Upper",
"Transpose",
"Non-unit", &jb, &
1265 i__3, &c_b164, &a[j + j * a_dim1], lda, &a[j + (j
1266 + jb) * a_dim1], lda);
1277 for (j = 1; i__1 < 0 ? j >= i__2 : j <= i__2; j += i__1) {
1285 i__3 = nb, i__4 = *n - j + 1;
1286 jb = min(i__3,i__4);
1288 ssyrk_(
"Lower",
"No transpose", &jb, &i__3, &c_b181, &a[j +
1289 a_dim1], lda, &c_b164, &a[j + j * a_dim1], lda);
1290 spotf2_(
"Lower", &jb, &a[j + j * a_dim1], lda, info);
1298 i__3 = *n - j - jb + 1;
1300 sgemm_(
"No transpose",
"Transpose", &i__3, &jb, &i__4, &
1301 c_b181, &a[j + jb + a_dim1], lda, &a[j + a_dim1],
1302 lda, &c_b164, &a[j + jb + j * a_dim1], lda);
1303 i__3 = *n - j - jb + 1;
1304 strsm_(
"Right",
"Lower",
"Transpose",
"Non-unit", &i__3, &
1305 jb, &c_b164, &a[j + j * a_dim1], lda, &a[j + jb +
1315 *info = *info + j - 1;
1324 int spotrs_(
char *uplo, integer *n, integer *nrhs, real *a,
1325 integer *lda, real *b, integer *ldb, integer *info)
1328 integer a_dim1, a_offset, b_dim1, b_offset, i__1;
1331 extern logical lsame_(
char *,
char *);
1332 static logical upper;
1333 extern int strsm_(
char *,
char *,
char *,
char *,
1334 integer *, integer *, real *, real *, integer *, real *, integer *
1335 ), xerbla_(
char *, integer *);
1392 a_offset = 1 + a_dim1;
1395 b_offset = 1 + b_dim1;
1400 upper = lsame_(uplo,
"U");
1401 if (! upper && ! lsame_(uplo,
"L")) {
1403 }
else if (*n < 0) {
1405 }
else if (*nrhs < 0) {
1407 }
else if (*lda < max(1,*n)) {
1409 }
else if (*ldb < max(1,*n)) {
1414 xerbla_(
"SPOTRS", &i__1);
1420 if (*n == 0 || *nrhs == 0) {
1432 strsm_(
"Left",
"Upper",
"Transpose",
"Non-unit", n, nrhs, &c_b164, &a[
1433 a_offset], lda, &b[b_offset], ldb);
1437 strsm_(
"Left",
"Upper",
"No transpose",
"Non-unit", n, nrhs, &c_b164,
1438 &a[a_offset], lda, &b[b_offset], ldb);
1447 strsm_(
"Left",
"Lower",
"No transpose",
"Non-unit", n, nrhs, &c_b164,
1448 &a[a_offset], lda, &b[b_offset], ldb);
1452 strsm_(
"Left",
"Lower",
"Transpose",
"Non-unit", n, nrhs, &c_b164, &a[
1453 a_offset], lda, &b[b_offset], ldb);