Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
eis_comhes.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int comhes_(integer *nm, integer *n, integer *low, integer *
00009 igh, doublereal *ar, doublereal *ai, integer *int__)
00010 {
00011
00012 integer ar_dim1, ar_offset, ai_dim1, ai_offset, i__1, i__2, i__3;
00013 doublereal d__1, d__2;
00014
00015
00016 extern int cdiv_(doublereal *, doublereal *, doublereal *
00017 , doublereal *, doublereal *, doublereal *);
00018 static integer i__, j, m, la;
00019 static doublereal xi, yi, xr, yr;
00020 static integer mm1, kp1, mp1;
00021
00022
00023
00024
00025
00026
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 ai_dim1 = *nm;
00073 ai_offset = ai_dim1 + 1;
00074 ai -= ai_offset;
00075 ar_dim1 = *nm;
00076 ar_offset = ar_dim1 + 1;
00077 ar -= ar_offset;
00078 --int__;
00079
00080
00081 la = *igh - 1;
00082 kp1 = *low + 1;
00083 if (la < kp1) {
00084 goto L200;
00085 }
00086
00087 i__1 = la;
00088 for (m = kp1; m <= i__1; ++m) {
00089 mm1 = m - 1;
00090 xr = 0.;
00091 xi = 0.;
00092 i__ = m;
00093
00094 i__2 = *igh;
00095 for (j = m; j <= i__2; ++j) {
00096 if ((d__1 = ar[j + mm1 * ar_dim1], abs(d__1)) + (d__2 = ai[j +
00097 mm1 * ai_dim1], abs(d__2)) <= abs(xr) + abs(xi)) {
00098 goto L100;
00099 }
00100 xr = ar[j + mm1 * ar_dim1];
00101 xi = ai[j + mm1 * ai_dim1];
00102 i__ = j;
00103 L100:
00104 ;
00105 }
00106
00107 int__[m] = i__;
00108 if (i__ == m) {
00109 goto L130;
00110 }
00111
00112
00113 i__2 = *n;
00114 for (j = mm1; j <= i__2; ++j) {
00115 yr = ar[i__ + j * ar_dim1];
00116 ar[i__ + j * ar_dim1] = ar[m + j * ar_dim1];
00117 ar[m + j * ar_dim1] = yr;
00118 yi = ai[i__ + j * ai_dim1];
00119 ai[i__ + j * ai_dim1] = ai[m + j * ai_dim1];
00120 ai[m + j * ai_dim1] = yi;
00121
00122 }
00123
00124 i__2 = *igh;
00125 for (j = 1; j <= i__2; ++j) {
00126 yr = ar[j + i__ * ar_dim1];
00127 ar[j + i__ * ar_dim1] = ar[j + m * ar_dim1];
00128 ar[j + m * ar_dim1] = yr;
00129 yi = ai[j + i__ * ai_dim1];
00130 ai[j + i__ * ai_dim1] = ai[j + m * ai_dim1];
00131 ai[j + m * ai_dim1] = yi;
00132
00133 }
00134
00135 L130:
00136 if (xr == 0. && xi == 0.) {
00137 goto L180;
00138 }
00139 mp1 = m + 1;
00140
00141 i__2 = *igh;
00142 for (i__ = mp1; i__ <= i__2; ++i__) {
00143 yr = ar[i__ + mm1 * ar_dim1];
00144 yi = ai[i__ + mm1 * ai_dim1];
00145 if (yr == 0. && yi == 0.) {
00146 goto L160;
00147 }
00148 cdiv_(&yr, &yi, &xr, &xi, &yr, &yi);
00149 ar[i__ + mm1 * ar_dim1] = yr;
00150 ai[i__ + mm1 * ai_dim1] = yi;
00151
00152 i__3 = *n;
00153 for (j = m; j <= i__3; ++j) {
00154 ar[i__ + j * ar_dim1] = ar[i__ + j * ar_dim1] - yr * ar[m + j
00155 * ar_dim1] + yi * ai[m + j * ai_dim1];
00156 ai[i__ + j * ai_dim1] = ai[i__ + j * ai_dim1] - yr * ai[m + j
00157 * ai_dim1] - yi * ar[m + j * ar_dim1];
00158
00159 }
00160
00161 i__3 = *igh;
00162 for (j = 1; j <= i__3; ++j) {
00163 ar[j + m * ar_dim1] = ar[j + m * ar_dim1] + yr * ar[j + i__ *
00164 ar_dim1] - yi * ai[j + i__ * ai_dim1];
00165 ai[j + m * ai_dim1] = ai[j + m * ai_dim1] + yr * ai[j + i__ *
00166 ai_dim1] + yi * ar[j + i__ * ar_dim1];
00167
00168 }
00169
00170 L160:
00171 ;
00172 }
00173
00174 L180:
00175 ;
00176 }
00177
00178 L200:
00179 return 0;
00180 }
00181