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 #ifndef TEMPLATE_BLAS_SYR2K_HEADER
00036 #define TEMPLATE_BLAS_SYR2K_HEADER
00037
00038
00039 template<class Treal>
00040 int template_blas_syr2k(const char *uplo, const char *trans, const integer *n,
00041 const integer *k, const Treal *alpha, const Treal *a,
00042 const integer *lda, const Treal *b, const integer *ldb,
00043 const Treal *beta, Treal *c__, const integer *ldc)
00044 {
00045
00046 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
00047 i__3;
00048
00049 integer info;
00050 Treal temp1, temp2;
00051 integer i__, j, l;
00052 integer nrowa;
00053 logical upper;
00054 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00055 #define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
00056 #define c___ref(a_1,a_2) c__[(a_2)*c_dim1 + a_1]
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 a_dim1 = *lda;
00156 a_offset = 1 + a_dim1 * 1;
00157 a -= a_offset;
00158 b_dim1 = *ldb;
00159 b_offset = 1 + b_dim1 * 1;
00160 b -= b_offset;
00161 c_dim1 = *ldc;
00162 c_offset = 1 + c_dim1 * 1;
00163 c__ -= c_offset;
00164
00165 if (template_blas_lsame(trans, "N")) {
00166 nrowa = *n;
00167 } else {
00168 nrowa = *k;
00169 }
00170 upper = template_blas_lsame(uplo, "U");
00171 info = 0;
00172 if (! upper && ! template_blas_lsame(uplo, "L")) {
00173 info = 1;
00174 } else if (! template_blas_lsame(trans, "N") && ! template_blas_lsame(trans,
00175 "T") && ! template_blas_lsame(trans, "C")) {
00176 info = 2;
00177 } else if (*n < 0) {
00178 info = 3;
00179 } else if (*k < 0) {
00180 info = 4;
00181 } else if (*lda < maxMACRO(1,nrowa)) {
00182 info = 7;
00183 } else if (*ldb < maxMACRO(1,nrowa)) {
00184 info = 9;
00185 } else if (*ldc < maxMACRO(1,*n)) {
00186 info = 12;
00187 }
00188 if (info != 0) {
00189 template_blas_erbla("SYR2K ", &info);
00190 return 0;
00191 }
00192
00193 if (*n == 0 || ( (*alpha == 0. || *k == 0) && *beta == 1. ) ) {
00194 return 0;
00195 }
00196
00197 if (*alpha == 0.) {
00198 if (upper) {
00199 if (*beta == 0.) {
00200 i__1 = *n;
00201 for (j = 1; j <= i__1; ++j) {
00202 i__2 = j;
00203 for (i__ = 1; i__ <= i__2; ++i__) {
00204 c___ref(i__, j) = 0.;
00205
00206 }
00207
00208 }
00209 } else {
00210 i__1 = *n;
00211 for (j = 1; j <= i__1; ++j) {
00212 i__2 = j;
00213 for (i__ = 1; i__ <= i__2; ++i__) {
00214 c___ref(i__, j) = *beta * c___ref(i__, j);
00215
00216 }
00217
00218 }
00219 }
00220 } else {
00221 if (*beta == 0.) {
00222 i__1 = *n;
00223 for (j = 1; j <= i__1; ++j) {
00224 i__2 = *n;
00225 for (i__ = j; i__ <= i__2; ++i__) {
00226 c___ref(i__, j) = 0.;
00227
00228 }
00229
00230 }
00231 } else {
00232 i__1 = *n;
00233 for (j = 1; j <= i__1; ++j) {
00234 i__2 = *n;
00235 for (i__ = j; i__ <= i__2; ++i__) {
00236 c___ref(i__, j) = *beta * c___ref(i__, j);
00237
00238 }
00239
00240 }
00241 }
00242 }
00243 return 0;
00244 }
00245
00246 if (template_blas_lsame(trans, "N")) {
00247
00248 if (upper) {
00249 i__1 = *n;
00250 for (j = 1; j <= i__1; ++j) {
00251 if (*beta == 0.) {
00252 i__2 = j;
00253 for (i__ = 1; i__ <= i__2; ++i__) {
00254 c___ref(i__, j) = 0.;
00255
00256 }
00257 } else if (*beta != 1.) {
00258 i__2 = j;
00259 for (i__ = 1; i__ <= i__2; ++i__) {
00260 c___ref(i__, j) = *beta * c___ref(i__, j);
00261
00262 }
00263 }
00264 i__2 = *k;
00265 for (l = 1; l <= i__2; ++l) {
00266 if (a_ref(j, l) != 0. || b_ref(j, l) != 0.) {
00267 temp1 = *alpha * b_ref(j, l);
00268 temp2 = *alpha * a_ref(j, l);
00269 i__3 = j;
00270 for (i__ = 1; i__ <= i__3; ++i__) {
00271 c___ref(i__, j) = c___ref(i__, j) + a_ref(i__, l)
00272 * temp1 + b_ref(i__, l) * temp2;
00273
00274 }
00275 }
00276
00277 }
00278
00279 }
00280 } else {
00281 i__1 = *n;
00282 for (j = 1; j <= i__1; ++j) {
00283 if (*beta == 0.) {
00284 i__2 = *n;
00285 for (i__ = j; i__ <= i__2; ++i__) {
00286 c___ref(i__, j) = 0.;
00287
00288 }
00289 } else if (*beta != 1.) {
00290 i__2 = *n;
00291 for (i__ = j; i__ <= i__2; ++i__) {
00292 c___ref(i__, j) = *beta * c___ref(i__, j);
00293
00294 }
00295 }
00296 i__2 = *k;
00297 for (l = 1; l <= i__2; ++l) {
00298 if (a_ref(j, l) != 0. || b_ref(j, l) != 0.) {
00299 temp1 = *alpha * b_ref(j, l);
00300 temp2 = *alpha * a_ref(j, l);
00301 i__3 = *n;
00302 for (i__ = j; i__ <= i__3; ++i__) {
00303 c___ref(i__, j) = c___ref(i__, j) + a_ref(i__, l)
00304 * temp1 + b_ref(i__, l) * temp2;
00305
00306 }
00307 }
00308
00309 }
00310
00311 }
00312 }
00313 } else {
00314
00315 if (upper) {
00316 i__1 = *n;
00317 for (j = 1; j <= i__1; ++j) {
00318 i__2 = j;
00319 for (i__ = 1; i__ <= i__2; ++i__) {
00320 temp1 = 0.;
00321 temp2 = 0.;
00322 i__3 = *k;
00323 for (l = 1; l <= i__3; ++l) {
00324 temp1 += a_ref(l, i__) * b_ref(l, j);
00325 temp2 += b_ref(l, i__) * a_ref(l, j);
00326
00327 }
00328 if (*beta == 0.) {
00329 c___ref(i__, j) = *alpha * temp1 + *alpha * temp2;
00330 } else {
00331 c___ref(i__, j) = *beta * c___ref(i__, j) + *alpha *
00332 temp1 + *alpha * temp2;
00333 }
00334
00335 }
00336
00337 }
00338 } else {
00339 i__1 = *n;
00340 for (j = 1; j <= i__1; ++j) {
00341 i__2 = *n;
00342 for (i__ = j; i__ <= i__2; ++i__) {
00343 temp1 = 0.;
00344 temp2 = 0.;
00345 i__3 = *k;
00346 for (l = 1; l <= i__3; ++l) {
00347 temp1 += a_ref(l, i__) * b_ref(l, j);
00348 temp2 += b_ref(l, i__) * a_ref(l, j);
00349
00350 }
00351 if (*beta == 0.) {
00352 c___ref(i__, j) = *alpha * temp1 + *alpha * temp2;
00353 } else {
00354 c___ref(i__, j) = *beta * c___ref(i__, j) + *alpha *
00355 temp1 + *alpha * temp2;
00356 }
00357
00358 }
00359
00360 }
00361 }
00362 }
00363 return 0;
00364
00365 }
00366 #undef c___ref
00367 #undef b_ref
00368 #undef a_ref
00369
00370 #endif