4 #include "gmx_lapack.h"
7 F77_FUNC(dlansy,DLANSY)(const char *norm, const char *uplo, int *n, double *a, int
10 /* System generated locals */
11 int a_dim1, a_offset, i__1, i__2;
12 double ret_val, d__1, d__2, d__3;
17 double sum, absa, scale;
21 a_offset = 1 + a_dim1;
27 } else if (*norm=='M' || *norm=='m') {
30 if (*uplo=='U' || *uplo=='u') {
32 for (j = 1; j <= i__1; ++j) {
34 for (i__ = 1; i__ <= i__2; ++i__) {
36 d__3 = fabs(a[i__ + j * a_dim1]);
37 value = (d__2>d__3) ? d__2 : d__3;
42 for (j = 1; j <= i__1; ++j) {
44 for (i__ = j; i__ <= i__2; ++i__) {
46 d__3 = fabs(a[i__ + j * a_dim1]);
47 value = (d__2>d__3) ? d__2 : d__3;
51 } else if (*norm=='I' || *norm=='i' || *norm=='O' || *norm=='o' || *norm=='1') {
54 if (*uplo=='U' || *uplo=='u') {
56 for (j = 1; j <= i__1; ++j) {
59 for (i__ = 1; i__ <= i__2; ++i__) {
60 absa = fabs(a[i__ + j * a_dim1]);
64 work[j] = sum + fabs(a[j + j * a_dim1]);
67 for (i__ = 1; i__ <= i__1; ++i__) {
68 d__1 = value, d__2 = work[i__];
69 value = (d__1>d__2) ? d__1 : d__2;
73 for (i__ = 1; i__ <= i__1; ++i__) {
77 for (j = 1; j <= i__1; ++j) {
78 sum = work[j] + fabs(a[j + j * a_dim1]);
80 for (i__ = j + 1; i__ <= i__2; ++i__) {
81 absa = fabs(a[i__ + j * a_dim1]);
89 } else if (*norm=='F' || *norm=='f' || *norm=='E' || *norm=='e') {
93 if (*uplo=='U' || *uplo=='u') {
95 for (j = 2; j <= i__1; ++j) {
97 F77_FUNC(dlassq,DLASSQ)(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
101 for (j = 1; j <= i__1; ++j) {
103 F77_FUNC(dlassq,DLASSQ)(&i__2, &a[j + 1 + j * a_dim1], &c__1, &scale, &sum);
108 F77_FUNC(dlassq,DLASSQ)(n, &a[a_offset], &i__1, &scale, &sum);
109 value = scale * sqrt(sum);