Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
eis_htrib3.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int htrib3_(integer *nm, integer *n, doublereal *a,
00009 doublereal *tau, integer *m, doublereal *zr, doublereal *zi)
00010 {
00011
00012 integer a_dim1, a_offset, zr_dim1, zr_offset, zi_dim1, zi_offset, i__1,
00013 i__2, i__3;
00014
00015
00016 static doublereal h__;
00017 static integer i__, j, k, l;
00018 static doublereal s, si;
00019
00020
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 tau -= 3;
00069 a_dim1 = *nm;
00070 a_offset = a_dim1 + 1;
00071 a -= a_offset;
00072 zi_dim1 = *nm;
00073 zi_offset = zi_dim1 + 1;
00074 zi -= zi_offset;
00075 zr_dim1 = *nm;
00076 zr_offset = zr_dim1 + 1;
00077 zr -= zr_offset;
00078
00079
00080 if (*m == 0) {
00081 goto L200;
00082 }
00083
00084
00085
00086 i__1 = *n;
00087 for (k = 1; k <= i__1; ++k) {
00088
00089 i__2 = *m;
00090 for (j = 1; j <= i__2; ++j) {
00091 zi[k + j * zi_dim1] = -zr[k + j * zr_dim1] * tau[(k << 1) + 2];
00092 zr[k + j * zr_dim1] *= tau[(k << 1) + 1];
00093
00094 }
00095 }
00096
00097 if (*n == 1) {
00098 goto L200;
00099 }
00100
00101 i__2 = *n;
00102 for (i__ = 2; i__ <= i__2; ++i__) {
00103 l = i__ - 1;
00104 h__ = a[i__ + i__ * a_dim1];
00105 if (h__ == 0.) {
00106 goto L140;
00107 }
00108
00109 i__1 = *m;
00110 for (j = 1; j <= i__1; ++j) {
00111 s = 0.;
00112 si = 0.;
00113
00114 i__3 = l;
00115 for (k = 1; k <= i__3; ++k) {
00116 s = s + a[i__ + k * a_dim1] * zr[k + j * zr_dim1] - a[k + i__
00117 * a_dim1] * zi[k + j * zi_dim1];
00118 si = si + a[i__ + k * a_dim1] * zi[k + j * zi_dim1] + a[k +
00119 i__ * a_dim1] * zr[k + j * zr_dim1];
00120
00121 }
00122
00123
00124 s = s / h__ / h__;
00125 si = si / h__ / h__;
00126
00127 i__3 = l;
00128 for (k = 1; k <= i__3; ++k) {
00129 zr[k + j * zr_dim1] = zr[k + j * zr_dim1] - s * a[i__ + k *
00130 a_dim1] - si * a[k + i__ * a_dim1];
00131 zi[k + j * zi_dim1] = zi[k + j * zi_dim1] - si * a[i__ + k *
00132 a_dim1] + s * a[k + i__ * a_dim1];
00133
00134 }
00135
00136
00137 }
00138
00139 L140:
00140 ;
00141 }
00142
00143 L200:
00144 return 0;
00145 }
00146