Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
eis_htridi.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int htridi_(integer *nm, integer *n, doublereal *ar,
00009 doublereal *ai, doublereal *d__, doublereal *e, doublereal *e2,
00010 doublereal *tau)
00011 {
00012
00013 integer ar_dim1, ar_offset, ai_dim1, ai_offset, i__1, i__2, i__3;
00014 doublereal d__1, d__2;
00015
00016
00017 double sqrt(doublereal);
00018
00019
00020 static doublereal f, g, h__;
00021 static integer i__, j, k, l;
00022 static doublereal scale, fi, gi, hh;
00023 static integer ii;
00024 static doublereal si;
00025 extern doublereal pythag_(doublereal *, doublereal *);
00026 static integer jp1;
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
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 tau -= 3;
00082 --e2;
00083 --e;
00084 --d__;
00085 ai_dim1 = *nm;
00086 ai_offset = ai_dim1 + 1;
00087 ai -= ai_offset;
00088 ar_dim1 = *nm;
00089 ar_offset = ar_dim1 + 1;
00090 ar -= ar_offset;
00091
00092
00093 tau[(*n << 1) + 1] = 1.;
00094 tau[(*n << 1) + 2] = 0.;
00095
00096 i__1 = *n;
00097 for (i__ = 1; i__ <= i__1; ++i__) {
00098
00099 d__[i__] = ar[i__ + i__ * ar_dim1];
00100 }
00101
00102 i__1 = *n;
00103 for (ii = 1; ii <= i__1; ++ii) {
00104 i__ = *n + 1 - ii;
00105 l = i__ - 1;
00106 h__ = 0.;
00107 scale = 0.;
00108 if (l < 1) {
00109 goto L130;
00110 }
00111
00112 i__2 = l;
00113 for (k = 1; k <= i__2; ++k) {
00114
00115 scale = scale + (d__1 = ar[i__ + k * ar_dim1], abs(d__1)) + (d__2
00116 = ai[i__ + k * ai_dim1], abs(d__2));
00117 }
00118
00119 if (scale != 0.) {
00120 goto L140;
00121 }
00122 tau[(l << 1) + 1] = 1.;
00123 tau[(l << 1) + 2] = 0.;
00124 L130:
00125 e[i__] = 0.;
00126 e2[i__] = 0.;
00127 goto L290;
00128
00129 L140:
00130 i__2 = l;
00131 for (k = 1; k <= i__2; ++k) {
00132 ar[i__ + k * ar_dim1] /= scale;
00133 ai[i__ + k * ai_dim1] /= scale;
00134 h__ = h__ + ar[i__ + k * ar_dim1] * ar[i__ + k * ar_dim1] + ai[
00135 i__ + k * ai_dim1] * ai[i__ + k * ai_dim1];
00136
00137 }
00138
00139 e2[i__] = scale * scale * h__;
00140 g = sqrt(h__);
00141 e[i__] = scale * g;
00142 f = pythag_(&ar[i__ + l * ar_dim1], &ai[i__ + l * ai_dim1]);
00143
00144 if (f == 0.) {
00145 goto L160;
00146 }
00147 tau[(l << 1) + 1] = (ai[i__ + l * ai_dim1] * tau[(i__ << 1) + 2] - ar[
00148 i__ + l * ar_dim1] * tau[(i__ << 1) + 1]) / f;
00149 si = (ar[i__ + l * ar_dim1] * tau[(i__ << 1) + 2] + ai[i__ + l *
00150 ai_dim1] * tau[(i__ << 1) + 1]) / f;
00151 h__ += f * g;
00152 g = g / f + 1.;
00153 ar[i__ + l * ar_dim1] = g * ar[i__ + l * ar_dim1];
00154 ai[i__ + l * ai_dim1] = g * ai[i__ + l * ai_dim1];
00155 if (l == 1) {
00156 goto L270;
00157 }
00158 goto L170;
00159 L160:
00160 tau[(l << 1) + 1] = -tau[(i__ << 1) + 1];
00161 si = tau[(i__ << 1) + 2];
00162 ar[i__ + l * ar_dim1] = g;
00163 L170:
00164 f = 0.;
00165
00166 i__2 = l;
00167 for (j = 1; j <= i__2; ++j) {
00168 g = 0.;
00169 gi = 0.;
00170
00171 i__3 = j;
00172 for (k = 1; k <= i__3; ++k) {
00173 g = g + ar[j + k * ar_dim1] * ar[i__ + k * ar_dim1] + ai[j +
00174 k * ai_dim1] * ai[i__ + k * ai_dim1];
00175 gi = gi - ar[j + k * ar_dim1] * ai[i__ + k * ai_dim1] + ai[j
00176 + k * ai_dim1] * ar[i__ + k * ar_dim1];
00177
00178 }
00179
00180 jp1 = j + 1;
00181 if (l < jp1) {
00182 goto L220;
00183 }
00184
00185 i__3 = l;
00186 for (k = jp1; k <= i__3; ++k) {
00187 g = g + ar[k + j * ar_dim1] * ar[i__ + k * ar_dim1] - ai[k +
00188 j * ai_dim1] * ai[i__ + k * ai_dim1];
00189 gi = gi - ar[k + j * ar_dim1] * ai[i__ + k * ai_dim1] - ai[k
00190 + j * ai_dim1] * ar[i__ + k * ar_dim1];
00191
00192 }
00193
00194 L220:
00195 e[j] = g / h__;
00196 tau[(j << 1) + 2] = gi / h__;
00197 f = f + e[j] * ar[i__ + j * ar_dim1] - tau[(j << 1) + 2] * ai[i__
00198 + j * ai_dim1];
00199
00200 }
00201
00202 hh = f / (h__ + h__);
00203
00204 i__2 = l;
00205 for (j = 1; j <= i__2; ++j) {
00206 f = ar[i__ + j * ar_dim1];
00207 g = e[j] - hh * f;
00208 e[j] = g;
00209 fi = -ai[i__ + j * ai_dim1];
00210 gi = tau[(j << 1) + 2] - hh * fi;
00211 tau[(j << 1) + 2] = -gi;
00212
00213 i__3 = j;
00214 for (k = 1; k <= i__3; ++k) {
00215 ar[j + k * ar_dim1] = ar[j + k * ar_dim1] - f * e[k] - g * ar[
00216 i__ + k * ar_dim1] + fi * tau[(k << 1) + 2] + gi * ai[
00217 i__ + k * ai_dim1];
00218 ai[j + k * ai_dim1] = ai[j + k * ai_dim1] - f * tau[(k << 1)
00219 + 2] - g * ai[i__ + k * ai_dim1] - fi * e[k] - gi *
00220 ar[i__ + k * ar_dim1];
00221
00222 }
00223 }
00224
00225 L270:
00226 i__3 = l;
00227 for (k = 1; k <= i__3; ++k) {
00228 ar[i__ + k * ar_dim1] = scale * ar[i__ + k * ar_dim1];
00229 ai[i__ + k * ai_dim1] = scale * ai[i__ + k * ai_dim1];
00230
00231 }
00232
00233 tau[(l << 1) + 2] = -si;
00234 L290:
00235 hh = d__[i__];
00236 d__[i__] = ar[i__ + i__ * ar_dim1];
00237 ar[i__ + i__ * ar_dim1] = hh;
00238 ai[i__ + i__ * ai_dim1] = scale * sqrt(h__);
00239
00240 }
00241
00242 return 0;
00243 }
00244