00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 #ifndef TEMPLATE_LAPACK_TRTRI_HEADER
00038 #define TEMPLATE_LAPACK_TRTRI_HEADER
00039
00040
00041 template<class Treal>
00042 int template_lapack_trtri(const char *uplo, const char *diag,
00043 const integer *n, Treal *a,
00044 const integer *lda, integer *info)
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 integer c__1 = 1;
00104 integer c_n1 = -1;
00105 integer c__2 = 2;
00106 Treal c_b18 = 1.;
00107 Treal c_b22 = -1.;
00108
00109
00110 address a__1[2];
00111 integer a_dim1, a_offset, i__1, i__2[2], i__3, i__4, i__5;
00112 char ch__1[2];
00113
00114 integer j;
00115 logical upper;
00116 integer jb, nb, nn;
00117 logical nounit;
00118 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00119
00120
00121 a_dim1 = *lda;
00122 a_offset = 1 + a_dim1 * 1;
00123 a -= a_offset;
00124
00125
00126 *info = 0;
00127 upper = template_blas_lsame(uplo, "U");
00128 nounit = template_blas_lsame(diag, "N");
00129 if (! upper && ! template_blas_lsame(uplo, "L")) {
00130 *info = -1;
00131 } else if (! nounit && ! template_blas_lsame(diag, "U")) {
00132 *info = -2;
00133 } else if (*n < 0) {
00134 *info = -3;
00135 } else if (*lda < maxMACRO(1,*n)) {
00136 *info = -5;
00137 }
00138 if (*info != 0) {
00139 i__1 = -(*info);
00140 template_blas_erbla("TRTRI ", &i__1);
00141 return 0;
00142 }
00143
00144
00145
00146 if (*n == 0) {
00147 return 0;
00148 }
00149
00150
00151
00152 if (nounit) {
00153 i__1 = *n;
00154 for (*info = 1; *info <= i__1; ++(*info)) {
00155 if (a_ref(*info, *info) == 0.) {
00156 return 0;
00157 }
00158
00159 }
00160 *info = 0;
00161 }
00162
00163
00164
00165
00166 i__2[0] = 1, a__1[0] = (char*)uplo;
00167 i__2[1] = 1, a__1[1] = (char*)diag;
00168 template_blas_s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
00169 nb = template_lapack_ilaenv(&c__1, "DTRTRI", ch__1, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (
00170 ftnlen)2);
00171 if (nb <= 1 || nb >= *n) {
00172
00173
00174
00175 template_lapack_trti2(uplo, diag, n, &a[a_offset], lda, info);
00176 } else {
00177
00178
00179
00180 if (upper) {
00181
00182
00183
00184 i__1 = *n;
00185 i__3 = nb;
00186 for (j = 1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
00187
00188 i__4 = nb, i__5 = *n - j + 1;
00189 jb = minMACRO(i__4,i__5);
00190
00191
00192
00193 i__4 = j - 1;
00194 template_blas_trmm("Left", "Upper", "No transpose", diag, &i__4, &jb, &
00195 c_b18, &a[a_offset], lda, &a_ref(1, j), lda);
00196 i__4 = j - 1;
00197 template_blas_trsm("Right", "Upper", "No transpose", diag, &i__4, &jb, &
00198 c_b22, &a_ref(j, j), lda, &a_ref(1, j), lda);
00199
00200
00201
00202 template_lapack_trti2("Upper", diag, &jb, &a_ref(j, j), lda, info);
00203
00204 }
00205 } else {
00206
00207
00208
00209 nn = (*n - 1) / nb * nb + 1;
00210 i__3 = -nb;
00211 for (j = nn; i__3 < 0 ? j >= 1 : j <= 1; j += i__3) {
00212
00213 i__1 = nb, i__4 = *n - j + 1;
00214 jb = minMACRO(i__1,i__4);
00215 if (j + jb <= *n) {
00216
00217
00218
00219 i__1 = *n - j - jb + 1;
00220 template_blas_trmm("Left", "Lower", "No transpose", diag, &i__1, &jb,
00221 &c_b18, &a_ref(j + jb, j + jb), lda, &a_ref(j +
00222 jb, j), lda);
00223 i__1 = *n - j - jb + 1;
00224 template_blas_trsm("Right", "Lower", "No transpose", diag, &i__1, &jb,
00225 &c_b22, &a_ref(j, j), lda, &a_ref(j + jb, j),
00226 lda);
00227 }
00228
00229
00230
00231 template_lapack_trti2("Lower", diag, &jb, &a_ref(j, j), lda, info);
00232
00233 }
00234 }
00235 }
00236
00237 return 0;
00238
00239
00240
00241 }
00242
00243 #undef a_ref
00244
00245
00246 #endif