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_LANSY_HEADER
00038 #define TEMPLATE_LAPACK_LANSY_HEADER
00039
00040
00041 template<class Treal>
00042 Treal template_lapack_lansy(const char *norm, const char *uplo, const integer *n, const Treal *a, const integer
00043 *lda, Treal *work)
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 integer c__1 = 1;
00115
00116
00117 integer a_dim1, a_offset, i__1, i__2;
00118 Treal ret_val, d__1, d__2, d__3;
00119
00120 Treal absa;
00121 integer i__, j;
00122 Treal scale;
00123 Treal value;
00124 Treal sum;
00125 #define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
00126
00127
00128 a_dim1 = *lda;
00129 a_offset = 1 + a_dim1 * 1;
00130 a -= a_offset;
00131 --work;
00132
00133
00134 value = 0;
00135
00136 if (*n == 0) {
00137 value = 0.;
00138 } else if (template_blas_lsame(norm, "M")) {
00139
00140
00141
00142 value = 0.;
00143 if (template_blas_lsame(uplo, "U")) {
00144 i__1 = *n;
00145 for (j = 1; j <= i__1; ++j) {
00146 i__2 = j;
00147 for (i__ = 1; i__ <= i__2; ++i__) {
00148
00149 d__2 = value, d__3 = (d__1 = a_ref(i__, j), absMACRO(d__1));
00150 value = maxMACRO(d__2,d__3);
00151
00152 }
00153
00154 }
00155 } else {
00156 i__1 = *n;
00157 for (j = 1; j <= i__1; ++j) {
00158 i__2 = *n;
00159 for (i__ = j; i__ <= i__2; ++i__) {
00160
00161 d__2 = value, d__3 = (d__1 = a_ref(i__, j), absMACRO(d__1));
00162 value = maxMACRO(d__2,d__3);
00163
00164 }
00165
00166 }
00167 }
00168 } else if (template_blas_lsame(norm, "I") || template_blas_lsame(norm, "O") || *(unsigned char *)norm == '1') {
00169
00170
00171
00172 value = 0.;
00173 if (template_blas_lsame(uplo, "U")) {
00174 i__1 = *n;
00175 for (j = 1; j <= i__1; ++j) {
00176 sum = 0.;
00177 i__2 = j - 1;
00178 for (i__ = 1; i__ <= i__2; ++i__) {
00179 absa = (d__1 = a_ref(i__, j), absMACRO(d__1));
00180 sum += absa;
00181 work[i__] += absa;
00182
00183 }
00184 work[j] = sum + (d__1 = a_ref(j, j), absMACRO(d__1));
00185
00186 }
00187 i__1 = *n;
00188 for (i__ = 1; i__ <= i__1; ++i__) {
00189
00190 d__1 = value, d__2 = work[i__];
00191 value = maxMACRO(d__1,d__2);
00192
00193 }
00194 } else {
00195 i__1 = *n;
00196 for (i__ = 1; i__ <= i__1; ++i__) {
00197 work[i__] = 0.;
00198
00199 }
00200 i__1 = *n;
00201 for (j = 1; j <= i__1; ++j) {
00202 sum = work[j] + (d__1 = a_ref(j, j), absMACRO(d__1));
00203 i__2 = *n;
00204 for (i__ = j + 1; i__ <= i__2; ++i__) {
00205 absa = (d__1 = a_ref(i__, j), absMACRO(d__1));
00206 sum += absa;
00207 work[i__] += absa;
00208
00209 }
00210 value = maxMACRO(value,sum);
00211
00212 }
00213 }
00214 } else if (template_blas_lsame(norm, "F") || template_blas_lsame(norm, "E")) {
00215
00216
00217
00218 scale = 0.;
00219 sum = 1.;
00220 if (template_blas_lsame(uplo, "U")) {
00221 i__1 = *n;
00222 for (j = 2; j <= i__1; ++j) {
00223 i__2 = j - 1;
00224 template_lapack_lassq(&i__2, &a_ref(1, j), &c__1, &scale, &sum);
00225
00226 }
00227 } else {
00228 i__1 = *n - 1;
00229 for (j = 1; j <= i__1; ++j) {
00230 i__2 = *n - j;
00231 template_lapack_lassq(&i__2, &a_ref(j + 1, j), &c__1, &scale, &sum);
00232
00233 }
00234 }
00235 sum *= 2;
00236 i__1 = *lda + 1;
00237 template_lapack_lassq(n, &a[a_offset], &i__1, &scale, &sum);
00238 value = scale * template_blas_sqrt(sum);
00239 }
00240
00241 ret_val = value;
00242 return ret_val;
00243
00244
00245
00246 }
00247
00248 #undef a_ref
00249
00250
00251 #endif