00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024 #ifdef HAVE_CONFIG_H
00025 #include <config.h>
00026 #endif
00027
00028 #include "floatLU.h"
00029 #include "f77-fcn.h"
00030 #include "lo-error.h"
00031 #include "oct-locbuf.h"
00032 #include "fColVector.h"
00033
00034
00035
00036 #include <base-lu.h>
00037 #include <base-lu.cc>
00038
00039 template class base_lu <FloatMatrix>;
00040
00041
00042
00043 extern "C"
00044 {
00045 F77_RET_T
00046 F77_FUNC (sgetrf, SGETRF) (const octave_idx_type&, const octave_idx_type&,
00047 float*, const octave_idx_type&, octave_idx_type*,
00048 octave_idx_type&);
00049
00050 #ifdef HAVE_QRUPDATE_LUU
00051 F77_RET_T
00052 F77_FUNC (slu1up, SLU1UP) (const octave_idx_type&, const octave_idx_type&,
00053 float *, const octave_idx_type&,
00054 float *, const octave_idx_type&,
00055 float *, float *);
00056
00057 F77_RET_T
00058 F77_FUNC (slup1up, SLUP1UP) (const octave_idx_type&, const octave_idx_type&,
00059 float *, const octave_idx_type&,
00060 float *, const octave_idx_type&,
00061 octave_idx_type *, const float *,
00062 const float *, float *);
00063 #endif
00064 }
00065
00066 FloatLU::FloatLU (const FloatMatrix& a)
00067 {
00068 octave_idx_type a_nr = a.rows ();
00069 octave_idx_type a_nc = a.cols ();
00070 octave_idx_type mn = (a_nr < a_nc ? a_nr : a_nc);
00071
00072 ipvt.resize (dim_vector (mn, 1));
00073 octave_idx_type *pipvt = ipvt.fortran_vec ();
00074
00075 a_fact = a;
00076 float *tmp_data = a_fact.fortran_vec ();
00077
00078 octave_idx_type info = 0;
00079
00080 F77_XFCN (sgetrf, SGETRF, (a_nr, a_nc, tmp_data, a_nr, pipvt, info));
00081
00082 for (octave_idx_type i = 0; i < mn; i++)
00083 pipvt[i] -= 1;
00084 }
00085
00086 #ifdef HAVE_QRUPDATE_LUU
00087
00088 void FloatLU::update (const FloatColumnVector& u, const FloatColumnVector& v)
00089 {
00090 if (packed ())
00091 unpack ();
00092
00093 FloatMatrix& l = l_fact;
00094 FloatMatrix& r = a_fact;
00095
00096 octave_idx_type m = l.rows ();
00097 octave_idx_type n = r.columns ();
00098 octave_idx_type k = l.columns ();
00099
00100 if (u.length () == m && v.length () == n)
00101 {
00102 FloatColumnVector utmp = u, vtmp = v;
00103 F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k,
00104 utmp.fortran_vec (), vtmp.fortran_vec ()));
00105 }
00106 else
00107 (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
00108 }
00109
00110 void FloatLU::update (const FloatMatrix& u, const FloatMatrix& v)
00111 {
00112 if (packed ())
00113 unpack ();
00114
00115 FloatMatrix& l = l_fact;
00116 FloatMatrix& r = a_fact;
00117
00118 octave_idx_type m = l.rows ();
00119 octave_idx_type n = r.columns ();
00120 octave_idx_type k = l.columns ();
00121
00122 if (u.rows () == m && v.rows () == n && u.cols () == v.cols ())
00123 {
00124 for (volatile octave_idx_type i = 0; i < u.cols (); i++)
00125 {
00126 FloatColumnVector utmp = u.column (i), vtmp = v.column (i);
00127 F77_XFCN (slu1up, SLU1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k,
00128 utmp.fortran_vec (), vtmp.fortran_vec ()));
00129 }
00130 }
00131 else
00132 (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
00133 }
00134
00135 void FloatLU::update_piv (const FloatColumnVector& u, const FloatColumnVector& v)
00136 {
00137 if (packed ())
00138 unpack ();
00139
00140 FloatMatrix& l = l_fact;
00141 FloatMatrix& r = a_fact;
00142
00143 octave_idx_type m = l.rows ();
00144 octave_idx_type n = r.columns ();
00145 octave_idx_type k = l.columns ();
00146
00147 if (u.length () == m && v.length () == n)
00148 {
00149 FloatColumnVector utmp = u, vtmp = v;
00150 OCTAVE_LOCAL_BUFFER (float, w, m);
00151 for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1;
00152 F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k,
00153 ipvt.fortran_vec (), utmp.data (), vtmp.data (), w));
00154 for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1;
00155 }
00156 else
00157 (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
00158 }
00159
00160 void FloatLU::update_piv (const FloatMatrix& u, const FloatMatrix& v)
00161 {
00162 if (packed ())
00163 unpack ();
00164
00165 FloatMatrix& l = l_fact;
00166 FloatMatrix& r = a_fact;
00167
00168 octave_idx_type m = l.rows ();
00169 octave_idx_type n = r.columns ();
00170 octave_idx_type k = l.columns ();
00171
00172 if (u.rows () == m && v.rows () == n && u.cols () == v.cols ())
00173 {
00174 OCTAVE_LOCAL_BUFFER (float, w, m);
00175 for (octave_idx_type i = 0; i < m; i++) ipvt(i) += 1;
00176 for (volatile octave_idx_type i = 0; i < u.cols (); i++)
00177 {
00178 FloatColumnVector utmp = u.column (i), vtmp = v.column (i);
00179 F77_XFCN (slup1up, SLUP1UP, (m, n, l.fortran_vec (), m, r.fortran_vec (), k,
00180 ipvt.fortran_vec (), utmp.data (), vtmp.data (), w));
00181 }
00182 for (octave_idx_type i = 0; i < m; i++) ipvt(i) -= 1;
00183 }
00184 else
00185 (*current_liboctave_error_handler) ("luupdate: dimensions mismatch");
00186 }
00187
00188 #else
00189
00190 void FloatLU::update (const FloatColumnVector&, const FloatColumnVector&)
00191 {
00192 (*current_liboctave_error_handler) ("luupdate: not available in this version");
00193 }
00194
00195 void FloatLU::update (const FloatMatrix&, const FloatMatrix&)
00196 {
00197 (*current_liboctave_error_handler) ("luupdate: not available in this version");
00198 }
00199
00200 void FloatLU::update_piv (const FloatColumnVector&, const FloatColumnVector&)
00201 {
00202 (*current_liboctave_error_handler) ("luupdate: not available in this version");
00203 }
00204
00205 void FloatLU::update_piv (const FloatMatrix&, const FloatMatrix&)
00206 {
00207 (*current_liboctave_error_handler) ("luupdate: not available in this version");
00208 }
00209
00210 #endif