Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
eis_ortran.c
Go to the documentation of this file.00001
00002
00003
00004
00005
00006 #include "f2c.h"
00007
00008 int ortran_(integer *nm, integer *n, integer *low, integer *
00009 igh, doublereal *a, doublereal *ort, doublereal *z__)
00010 {
00011
00012 integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2, i__3;
00013
00014
00015 static doublereal g;
00016 static integer i__, j, kl, mm, mp, mp1;
00017
00018
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 z_dim1 = *nm;
00067 z_offset = z_dim1 + 1;
00068 z__ -= z_offset;
00069 --ort;
00070 a_dim1 = *nm;
00071 a_offset = a_dim1 + 1;
00072 a -= a_offset;
00073
00074
00075 i__1 = *n;
00076 for (j = 1; j <= i__1; ++j) {
00077
00078 i__2 = *n;
00079 for (i__ = 1; i__ <= i__2; ++i__) {
00080
00081 z__[i__ + j * z_dim1] = 0.;
00082 }
00083
00084 z__[j + j * z_dim1] = 1.;
00085
00086 }
00087
00088 kl = *igh - *low - 1;
00089 if (kl < 1) {
00090 goto L200;
00091 }
00092
00093 i__1 = kl;
00094 for (mm = 1; mm <= i__1; ++mm) {
00095 mp = *igh - mm;
00096 if (a[mp + (mp - 1) * a_dim1] == 0.) {
00097 goto L140;
00098 }
00099 mp1 = mp + 1;
00100
00101 i__2 = *igh;
00102 for (i__ = mp1; i__ <= i__2; ++i__) {
00103
00104 ort[i__] = a[i__ + (mp - 1) * a_dim1];
00105 }
00106
00107 i__2 = *igh;
00108 for (j = mp; j <= i__2; ++j) {
00109 g = 0.;
00110
00111 i__3 = *igh;
00112 for (i__ = mp; i__ <= i__3; ++i__) {
00113
00114 g += ort[i__] * z__[i__ + j * z_dim1];
00115 }
00116
00117
00118
00119
00120 g = g / ort[mp] / a[mp + (mp - 1) * a_dim1];
00121
00122 i__3 = *igh;
00123 for (i__ = mp; i__ <= i__3; ++i__) {
00124
00125 z__[i__ + j * z_dim1] += g * ort[i__];
00126 }
00127
00128
00129 }
00130
00131 L140:
00132 ;
00133 }
00134
00135 L200:
00136 return 0;
00137 }
00138