PageRenderTime 52ms CodeModel.GetById 21ms RepoModel.GetById 1ms app.codeStats 0ms

/tags/R2004-11-16/octave-forge/main/sparse/sparse_ops.h

#
C Header | 640 lines | 440 code | 22 blank | 178 comment | 119 complexity | 5ced31bc0797ae4ca5a09bf5af108ab7 MD5 | raw file
Possible License(s): GPL-2.0, BSD-3-Clause, LGPL-2.1, GPL-3.0, LGPL-3.0
  1. /*
  2. Copyright (C) 1999 Andy Adler
  3. This program is free software; you can redistribute it and/or modify it
  4. under the terms of the GNU General Public License as published by
  5. the Free Software Foundation; either version 2, or (at your option)
  6. any later version.
  7. This program is distributed in the hope that it will be useful, but
  8. WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  10. General Public License for more details.
  11. You should have received a copy of the GNU General Public License
  12. along with Octave; see the file COPYING. If not, write to the Free
  13. Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  14. $Id: sparse_ops.h 1819 2004-11-09 23:34:49Z adb014 $
  15. $Log$
  16. Revision 1.15 2004/11/09 23:34:49 adb014
  17. Fix concatenation for recent octave core CVS changes
  18. Revision 1.14 2004/08/31 15:23:45 adb014
  19. Small build fix for the macro SPARSE_RESIZE
  20. Revision 1.13 2004/08/25 16:13:57 adb014
  21. Working, but inefficient, concatentaion code
  22. Revision 1.12 2004/08/03 14:45:31 aadler
  23. clean up ASSEMBLE_SPARSE macro
  24. Revision 1.11 2003/12/22 15:13:23 pkienzle
  25. Use error/return rather than SP_FATAL_ERROR where possible.
  26. Test for zero elements from scalar multiply/power and shrink sparse
  27. accordingly; accomodate libstdc++ bugs with mixed real/complex power.
  28. Revision 1.10 2003/10/13 03:44:26 aadler
  29. check for out of bounds in allocation
  30. Revision 1.9 2003/04/03 22:06:41 aadler
  31. sparse create bug - need to use heap for large temp vars
  32. Revision 1.8 2003/02/20 23:03:59 pkienzle
  33. Use of "T x[n]" where n is not constant is a g++ extension so replace it with
  34. OCTAVE_LOCAL_BUFFER(T,x,n), and other things to keep the picky MipsPRO CC
  35. compiler happy.
  36. Revision 1.7 2002/12/25 01:33:00 aadler
  37. fixed bug which allowed zero values to be stored in sparse matrices.
  38. improved print output
  39. Revision 1.6 2002/11/27 04:46:42 pkienzle
  40. Use new exception handling infrastructure.
  41. Revision 1.5 2002/01/04 15:53:57 pkienzle
  42. Changes required to compile for gcc-3.0 in debian hppa/unstable
  43. Revision 1.4 2001/11/04 19:54:49 aadler
  44. fix bug with multiple entries in sparse creation.
  45. Added "summation" mode for matrix creation
  46. Revision 1.3 2001/10/14 03:06:31 aadler
  47. fixed memory leak in complex sparse solve
  48. fixed malloc bugs for zero size allocs
  49. Revision 1.2 2001/10/12 02:24:28 aadler
  50. Mods to fix bugs
  51. add support for all zero sparse matrices
  52. add support fom complex sparse inverse
  53. Revision 1.2 2001/04/04 02:13:46 aadler
  54. complete complex_sparse, templates, fix memory leaks
  55. Revision 1.1 2001/03/30 04:34:23 aadler
  56. "template" functions for sparse operations
  57. */
  58. // I would like to do this with templates,
  59. // but I don't think you can specify operators
  60. //
  61. // TYPX -> output type ( Complex or double)
  62. // _OP_ -> operation to implement ( + , - , != , .* )
  63. // A_B_INTERACT -> evaluate operations where A or B ==0
  64. //
  65. // I'm assuming that compiler optimization will remove
  66. // the if (0) and x+0 operations
  67. #define SPARSE_EL_OP( TYPX, _OP_, A_B_INTERACT ) \
  68. SuperMatrix X; \
  69. if ( (Anc != Bnc) || (Anr != Bnr) ) { \
  70. gripe_nonconformant ("operator " #_OP_, Anr, Anc, Bnr, Bnc); \
  71. } else { \
  72. assert(Anr == Bnr); assert(Anc == Bnc); \
  73. TYPX* coefX= (TYPX*)oct_sparse_malloc( nnz * sizeof(TYPX)); \
  74. int * ridxX= (int *)oct_sparse_malloc( nnz * sizeof(int) ); \
  75. int * cidxX= (int *)oct_sparse_malloc((Anc+1)*sizeof(int)); cidxX[0]= 0; \
  76. \
  77. int jx= 0; \
  78. for (int i= 0 ; i < Anc ; i++ ) { \
  79. int ja= cidxA[ i ]; \
  80. int ja_max= cidxA[ i+1 ]; \
  81. bool ja_lt_max= ja < ja_max; \
  82. \
  83. int jb= cidxB[ i ]; \
  84. int jb_max= cidxB[ i+1 ]; \
  85. bool jb_lt_max= jb < jb_max; \
  86. \
  87. while( ja_lt_max || jb_lt_max ) { \
  88. OCTAVE_QUIT; \
  89. if( ( !jb_lt_max ) || \
  90. ( ja_lt_max && (ridxA[ja] < ridxB[jb]) ) ) \
  91. { \
  92. if (A_B_INTERACT) { \
  93. ridxX[ jx ] = ridxA[ja]; \
  94. coefX[ jx ] = coefA[ ja ] _OP_ 0.0; \
  95. jx++; \
  96. } \
  97. ja++; ja_lt_max= ja < ja_max; \
  98. } else \
  99. if( ( !ja_lt_max ) || \
  100. ( jb_lt_max && (ridxB[jb] < ridxA[ja]) ) ) \
  101. { \
  102. if (A_B_INTERACT) { \
  103. ridxX[ jx ] = ridxB[jb]; \
  104. coefX[ jx ] = 0.0 _OP_ coefB[ jb ]; \
  105. jx++; \
  106. } \
  107. jb++; jb_lt_max= jb < jb_max; \
  108. } else \
  109. { \
  110. assert( ridxA[ja] == ridxB[jb] ); \
  111. TYPX tmpval= coefA[ ja ] _OP_ coefB[ jb ]; \
  112. if (tmpval !=0.0) { \
  113. coefX[ jx ] = tmpval; \
  114. ridxX[ jx ] = ridxA[ja]; \
  115. jx++; \
  116. } \
  117. ja++; ja_lt_max= ja < ja_max; \
  118. jb++; jb_lt_max= jb < jb_max; \
  119. } \
  120. } \
  121. cidxX[i+1] = jx; \
  122. } \
  123. maybe_shrink( jx, nnz, ridxX, coefX ); \
  124. X= create_SuperMatrix( Anr, Anc, jx, coefX, ridxX, cidxX ); \
  125. }
  126. #define SPARSE_MATRIX_EL_OP( TYPX, _OP_ ) \
  127. SuperMatrix X; \
  128. if ( (Anc != Bnc) || (Anr != Bnr) ) { \
  129. gripe_nonconformant ("operator .*", Anr, Anc, Bnr, Bnc); \
  130. } else { \
  131. assert(Anr == Bnr); assert(Anc == Bnc); \
  132. TYPX* coefX= (TYPX*)oct_sparse_malloc( nnz * sizeof(TYPX)); \
  133. int * ridxX= (int *)oct_sparse_malloc( nnz * sizeof(int) ); \
  134. int * cidxX= (int *)oct_sparse_malloc((Anc+1)*sizeof(int)); cidxX[0]= 0; \
  135. \
  136. int cx= 0; \
  137. for (int i=0; i < Anc ; i++) { \
  138. for (int j= cidxA[i] ; \
  139. j< cidxA[i+1]; j++) { \
  140. OCTAVE_QUIT; \
  141. int rowidx = ridxA[j]; \
  142. TYPX tmpval = B(rowidx,i); \
  143. if (tmpval != 0.0) { \
  144. ridxX[ cx ] = rowidx; \
  145. coefX[ cx ] = tmpval * coefA[ j ]; \
  146. cx++; \
  147. } \
  148. } \
  149. cidxX[i+1] = cx; \
  150. } \
  151. maybe_shrink( cx, nnz, ridxX, coefX ); \
  152. X= create_SuperMatrix( Anr, Anc, cx, coefX, ridxX, cidxX ); \
  153. }
  154. // multiply type ops
  155. // TYPM is the output matrix type
  156. // TYPX is the sparse matrix type
  157. #define SPARSE_MATRIX_MUL( TYPM, TYPX) \
  158. TYPM X (Anr , Bnc); \
  159. if (Anc != Bnr) { \
  160. gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
  161. } else { \
  162. assert (Anc == Bnr); \
  163. for (int i=0; i< Anr; i++ ) \
  164. for (int j=0; j< Bnc; j++ ) \
  165. X.elem(i,j)=0.; \
  166. for ( int i=0; i < Anc ; i++) { \
  167. for ( int j= cidxA[i]; j< cidxA[i+1]; j++) { \
  168. OCTAVE_QUIT; \
  169. int col = ridxA[j]; \
  170. TYPX tmpval = coefA[j]; \
  171. for ( int k=0 ; k< Bnc; k++) { \
  172. X.elem(col , k)+= tmpval * B(i,k); \
  173. } \
  174. } \
  175. } \
  176. }
  177. #define MATRIX_SPARSE_MUL( TYPM, TYPX ) \
  178. TYPM X (Anr , Bnc); \
  179. if (Anc != Bnr) { \
  180. gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
  181. } else { \
  182. assert (Anc == Bnr); \
  183. for (int i=0; i< Anr; i++ ) \
  184. for (int j=0; j< Bnc; j++ ) \
  185. X.elem(i,j)=0.; \
  186. for ( int i=0; i < Bnc ; i++) { \
  187. for ( int j= cidxB[i]; j< cidxB[i+1]; j++) { \
  188. OCTAVE_QUIT; \
  189. int col = ridxB[j]; \
  190. TYPX tmpval = coefB[j]; \
  191. for ( int k=0 ; k< Anr; k++) { \
  192. X(k, i)+= A(k,col) * tmpval; \
  193. } \
  194. } \
  195. } \
  196. }
  197. //
  198. // Multiply sparse by sparse, element by element
  199. // This algorithm allocates a full column of the output
  200. // matrix. Hopefully that won't be a storage problem.
  201. //
  202. // TODO: allocate a row or column depending on the larger
  203. // dimention.
  204. //
  205. // I'm sure there are good sparse multiplication algorithms
  206. // available in the litterature. I invented this one
  207. // to fill a gap. Tell me if you know of better ones.
  208. //
  209. #define SPARSE_SPARSE_MUL( TYPX ) \
  210. SuperMatrix X; \
  211. if (Anc != Bnr) { \
  212. gripe_nonconformant ("operator *", Anr, Anc, Bnr, Bnc); \
  213. } else { \
  214. assert (Anc == Bnr ); \
  215. int nnz = NCFA->nnz + NCFB->nnz ; \
  216. TYPX* coefX= (TYPX*)oct_sparse_malloc( nnz * sizeof(TYPX)); \
  217. int * ridxX= (int *)oct_sparse_malloc( nnz * sizeof(int) ); \
  218. int * cidxX= (int *)oct_sparse_malloc((Bnc+1)*sizeof(int)); cidxX[0]= 0; \
  219. \
  220. TYPX * Xcol= (TYPX*)oct_sparse_malloc( Anr * sizeof(TYPX)); \
  221. int cx= 0; \
  222. for ( int i=0; i < Bnc ; i++) { \
  223. OCTAVE_QUIT; \
  224. for (int k=0; k<Anr; k++) Xcol[k]= 0.; \
  225. for (int j= cidxB[i]; j< cidxB[i+1]; j++) { \
  226. int col= ridxB[j]; \
  227. TYPX tmpval = coefB[j]; \
  228. for (int k= cidxA[col] ; k< cidxA[col+1]; k++) \
  229. Xcol[ ridxA[k] ]+= tmpval * coefA[k]; \
  230. } \
  231. for (int k=0; k<Anr; k++) { \
  232. if ( Xcol[k] !=0. ) { \
  233. check_bounds( cx, nnz, ridxX, coefX ); \
  234. ridxX[ cx ]= k; \
  235. coefX[ cx ]= Xcol[k]; \
  236. cx++; \
  237. } \
  238. } \
  239. cidxX[i+1] = cx; \
  240. } \
  241. free( Xcol ); \
  242. maybe_shrink( cx, nnz, ridxX, coefX ); \
  243. X= create_SuperMatrix( Anr, Bnc, cx, coefX, ridxX, cidxX ); \
  244. }
  245. // assemble a sparse matrix from elements
  246. // called by > 1 args for sparse
  247. // NOTE: index vectors are 1 based!
  248. //
  249. // NOTE2: be careful about when we convert ri to int,
  250. // otherwise the maximum matrix size will be m*n < maxint/2
  251. //
  252. // The OCTAVE_LOCAL_BUFFER can't be used for the sort index
  253. // when the requested size is too big. we need to put it on the
  254. // heap.
  255. #define ASSEMBLE_SPARSE( TYPX , REJECT_OUT_OF_RANGE ) \
  256. int nnz= MAX( ridxA.length(), cidxA.length() ); \
  257. TYPX* coefX= (TYPX*)oct_sparse_malloc( nnz * sizeof(TYPX)); \
  258. int * ridxX= (int *)oct_sparse_malloc( nnz * sizeof(int) ); \
  259. int * cidxX= (int *)oct_sparse_malloc( (n+1)* sizeof(int)); cidxX[0]= 0; \
  260. \
  261. bool ri_scalar = (ridxA.length() == 1); \
  262. bool ci_scalar = (cidxA.length() == 1); \
  263. bool cf_scalar = (coefA.length() == 1); \
  264. \
  265. sort_idxl* sidx = (sort_idxl *)oct_sparse_malloc( nnz* sizeof(sort_idxl) );\
  266. int actual_nnz=0; \
  267. OCTAVE_QUIT; \
  268. for (int i=0; i<nnz; i++) { \
  269. double rowidx= ( ri_scalar ? ridxA(0) : ridxA(i) ) - 1; \
  270. double colidx= ( ci_scalar ? cidxA(0) : cidxA(i) ) - 1; \
  271. if (rowidx < m && rowidx >= 0 && \
  272. colidx < n && colidx >= 0 ) { \
  273. if ( coefA( cf_scalar ? 0 : i ) != 0. ) { \
  274. sidx[actual_nnz].val = (long) ( rowidx + m * colidx ); \
  275. sidx[actual_nnz].idx = i; \
  276. actual_nnz++; \
  277. } \
  278. } \
  279. else { \
  280. if( REJECT_OUT_OF_RANGE ) { \
  281. error("sparse (row,col) index (%d,%d) out of range", rowidx,colidx);\
  282. actual_nnz=0; \
  283. break; \
  284. } \
  285. } \
  286. } \
  287. \
  288. OCTAVE_QUIT; \
  289. qsort( sidx, actual_nnz, sizeof(sort_idxl), sidxl_comp ); \
  290. \
  291. OCTAVE_QUIT; \
  292. int cx= 0; \
  293. long prev_val=-1; \
  294. int ii= -1; \
  295. for (int i=0; i<actual_nnz; i++) { \
  296. OCTAVE_QUIT; \
  297. long idx= (long) sidx[i].idx; \
  298. long val= (long) sidx[i].val; \
  299. if (prev_val < val) { \
  300. ii++; \
  301. coefX[ii]= coefA( cf_scalar ? 0 : idx ); \
  302. double ri = ridxA( ri_scalar ? 0 : idx ) - 1 ; \
  303. ridxX[ii]= (long) (ri - ((long) (ri/m))*m ) ; \
  304. long ci = (long) cidxA( ci_scalar ? 0 : idx ) - 1 ; \
  305. while( cx < ci ) cidxX[++cx]= ii; \
  306. } else { \
  307. if (assemble_do_sum) \
  308. coefX[ii]+= coefA( cf_scalar ? 0 : idx ); \
  309. else \
  310. coefX[ii] = coefA( cf_scalar ? 0 : idx ); \
  311. } \
  312. prev_val= val;\
  313. } \
  314. while( cx < n ) cidxX[++cx]= ii+1; \
  315. OCTAVE_QUIT; \
  316. maybe_shrink( ii+1, actual_nnz, ridxX, coefX ); \
  317. \
  318. OCTAVE_QUIT; \
  319. SuperMatrix X= create_SuperMatrix( m, n, ii+1, coefX, ridxX, cidxX ); \
  320. oct_sparse_free( sidx );
  321. // destructively resize a sparse matrix
  322. #define SPARSE_RESIZE( TYPX, VECTYP1, VECTYP2) \
  323. /* Special case the redimensioning to an empty matrix */ \
  324. if (dv.numel() == 0) \
  325. return new octave_sparse (create_SuperMatrix (0, 0, 0, (TYPX *)0, \
  326. 0, 0)); \
  327. \
  328. /* Special case the redimensioning of an empty matrix */ \
  329. NCformat * Xstore = (NCformat * ) X.Store; \
  330. if (Xstore->nnz == 0) \
  331. { \
  332. int * colptr = (int *) oct_sparse_malloc ((dv(1) + 1) * sizeof(int)); \
  333. for (int i = 0; i <= dv(1); i++) \
  334. colptr [i] = 0; \
  335. return new octave_sparse (create_SuperMatrix (dv(0), dv(1), 0, \
  336. (TYPX *)0, 0, colptr)); \
  337. } \
  338. \
  339. octave_value_list find_val= find(); \
  340. int n= (int) dv(1); \
  341. int m= (int) dv(0); \
  342. ColumnVector ridxA= find_val(0).column_vector_value(); \
  343. ColumnVector cidxA= find_val(1).column_vector_value(); \
  344. VECTYP1 ## ColumnVector coefA= find_val(2). VECTYP2 ## column_vector_value(); \
  345. int assemble_do_sum = 0; \
  346. ASSEMBLE_SPARSE( TYPX, false);
  347. // assemble a sparse matrix from full
  348. // called by one arg for sparse
  349. // start with an initial estimate for nnz and
  350. // work with it.
  351. #define MATRIX_TO_SPARSE( TYPX ) \
  352. int nnz= 100; \
  353. TYPX * coef = (TYPX *) oct_sparse_malloc ( nnz * sizeof(TYPX) ); \
  354. int * ridx = (int *) oct_sparse_malloc ( nnz * sizeof(int) ); \
  355. int * cidx = (int *) oct_sparse_malloc ((Anc+1)* sizeof(int) ); cidx[0]= 0; \
  356. int jx=0; \
  357. for (int j= 0; j<Anc ; j++ ) { \
  358. for (int i= 0; i<Anr ; i++ ) { \
  359. OCTAVE_QUIT; \
  360. TYPX tmpval= A(i,j); \
  361. if (tmpval != 0.) { \
  362. check_bounds( jx, nnz, ridx, coef ); \
  363. ridx[ jx ]= i; \
  364. coef[ jx ]= tmpval; \
  365. jx++; \
  366. } \
  367. } \
  368. cidx[j+1]= jx; \
  369. } \
  370. maybe_shrink( jx, nnz, ridx, coef ); \
  371. SuperMatrix X= create_SuperMatrix( Anr, Anc, jx, coef, ridx, cidx );
  372. //
  373. // Next three functions
  374. //
  375. // Fix the row ordering problems that
  376. // LUExtract seems to cause
  377. // NOTE: we don't try to fix other structural errors
  378. // in the generated matrices, but we bail out
  379. // if we find any. This should work since I
  380. // haven't seen any problems other than ordering
  381. //
  382. // NOTE: The right way to fix this, of course, is to
  383. // track down the bug in the superlu codebase.
  384. // define a struct and qsort
  385. // comparison function to do the reordering
  386. #define FIX_ROW_ORDER_SORT_FUNCTIONS( TYPE ) \
  387. typedef struct { unsigned int idx; \
  388. TYPE val; } fixrow_sort; \
  389. static inline int \
  390. fixrow_comp( const void *i, const void *j) \
  391. { \
  392. return ((fixrow_sort *) i)->idx - \
  393. ((fixrow_sort *) j)->idx ; \
  394. }
  395. // this define ends function like
  396. // void
  397. // fix_row_order ## TYPE( SuperMatrix X )
  398. // {
  399. // DEBUGMSG("fix_row_order");
  400. // DEFINE_SP_POINTERS_REAL( X )
  401. // FIX_ROW_ORDER_FUNCTIONS( TYPE )
  402. // }
  403. #define FIX_ROW_ORDER_FUNCTIONS \
  404. for ( int i=0; i < Xnr ; i++) { \
  405. OCTAVE_QUIT; \
  406. assert( cidxX[i] >= 0.); \
  407. assert( cidxX[i] <= NCFX->nnz); \
  408. assert( cidxX[i] <= cidxX[i+1]); \
  409. int reorder=0; \
  410. for( int j= cidxX[i]; \
  411. j< cidxX[i+1]; \
  412. j++ ) { \
  413. assert( ridxX[j] >= 0.); \
  414. assert( ridxX[j] < Xnc); \
  415. assert( coefX[j] != 0.); /* don't keep zero values */ \
  416. if (j> cidxX[i]) \
  417. if ( ridxX[j-1] > ridxX[j] ) \
  418. reorder=1; \
  419. } /* for j */ \
  420. if(reorder) { \
  421. int snum= cidxX[i+1] - cidxX[i]; \
  422. OCTAVE_LOCAL_BUFFER (fixrow_sort, arry, snum); \
  423. /* copy to the sort struct */ \
  424. for( int k=0, \
  425. j= cidxX[i]; \
  426. j< cidxX[i+1]; \
  427. j++ ) { \
  428. arry[k].idx= ridxX[j]; \
  429. arry[k].val= coefX[j]; \
  430. k++; \
  431. } \
  432. OCTAVE_QUIT; \
  433. qsort( arry, snum, sizeof(fixrow_sort), fixrow_comp ); \
  434. OCTAVE_QUIT; \
  435. /* copy back to the position */ \
  436. for( int k=0, \
  437. j= cidxX[i]; \
  438. j< cidxX[i+1]; \
  439. j++ ) { \
  440. ridxX[j]= arry[k].idx; \
  441. coefX[j]= arry[k].val; \
  442. k++; \
  443. } \
  444. } \
  445. } // for i
  446. // endof FIX_ROW_ORDER_FUNCTIONS
  447. // calculate the inverse of an
  448. // upper triangular sparse matrix
  449. //
  450. // iUt = inv(U)
  451. // Note that the transpose is returned
  452. //
  453. // CODE:
  454. //
  455. // note that the input matrix is accesses in
  456. // row major order, and the output is accessed
  457. // in column major. This is the reason that the
  458. // output matrix is the transpose of the input
  459. //
  460. // I= eye( size(A) );
  461. // for n=1:N # across
  462. // for m= n+1:N # down
  463. // v=0;
  464. // for i= m-1:-1:n
  465. // v=v- A(m,i)*I(i,n);
  466. // end
  467. // I(m,n)= v/A(m,m);
  468. // end
  469. // I(:,n)= I(:,n)/A(n,n); <- for non unit norm
  470. // end
  471. //
  472. // we need to be careful here,
  473. // U is uppertriangular, but we're treating
  474. // it as though it is a lower triag matrix in NR form
  475. //
  476. // debug code
  477. // printf("n=%d, m=%d, X[%d]=%7.4f U[%d]=%7.4f cXp=%d cUp=%d v=%7.4f\n",
  478. // n,m, rpX, coefX[ scolXp ], rpU, coefU[ scolUp ],
  479. // scolXp,scolUp, v);
  480. #if 0
  481. // this is a pain - we can't use c++ constructors because
  482. // dmalloc complains when they're free'd
  483. int * ridxX = new int [nnz]; \
  484. TYPE* coefX = new TYPE [nnz]; \
  485. int * cidxX = new int [Unc+1]; \
  486. #endif
  487. #define SPARSE_INV_UPPERTRIANG( TYPE ) \
  488. assert ( Unc == Unr ); \
  489. /* estimate inverse nnz= input nnz */ \
  490. int nnz = NCFU->nnz; \
  491. int * ridxX = (int * ) oct_sparse_malloc ( sizeof(int) *nnz); \
  492. TYPE* coefX = (TYPE* ) oct_sparse_malloc ( sizeof(TYPE)*nnz); \
  493. int * cidxX = (int * ) oct_sparse_malloc ( sizeof(int )*(Unc+1)); \
  494. \
  495. int cx= 0; \
  496. \
  497. /* iterate accross columns of output matrix */ \
  498. for ( int n=0; n < Unr ; n++) { \
  499. OCTAVE_QUIT; \
  500. /* place the 1 in the identity position */ \
  501. int cx_colstart= cx; \
  502. \
  503. cidxX[n]= cx; \
  504. check_bounds( cx, nnz, ridxX, coefX ); \
  505. ridxX[cx]= n; \
  506. coefX[cx]= 1.0; \
  507. cx++; \
  508. \
  509. /* iterate accross columns of input matrix */ \
  510. for ( int m= n+1; m< Unr; m++) { \
  511. TYPE v=0.; \
  512. /* iterate to calculate sum */ \
  513. int colXp= cidxX[n]; \
  514. int colUp= cidxU[m]; \
  515. \
  516. int rpX, rpU; \
  517. do { \
  518. OCTAVE_QUIT; \
  519. rpX= ridxX [ colXp ]; \
  520. rpU= ridxU [ colUp ]; \
  521. \
  522. if (rpX < rpU) { \
  523. colXp++; \
  524. } else \
  525. if (rpX > rpU) { \
  526. colUp++; \
  527. } else { \
  528. assert(rpX == rpU); \
  529. assert(rpX >= n); \
  530. \
  531. v-= coefX[ colXp ]*coefU[ colUp ]; \
  532. colXp++; \
  533. colUp++; \
  534. } \
  535. \
  536. } while ((rpX<m) && (rpU<m) && (colXp<cx) && (colUp<nnzU)); \
  537. \
  538. /* get A(m,m) */ \
  539. colUp= cidxU[m+1]-1; \
  540. assert (ridxU[ colUp ] == m ); /* assert U is upper triangular */ \
  541. \
  542. TYPE pivot= coefU[ colUp ]; \
  543. if (pivot == 0.) gripe_divide_by_zero (); \
  544. \
  545. if (v!=0.) { \
  546. check_bounds( cx, nnz, ridxX, coefX ); \
  547. ridxX[cx]= m; \
  548. coefX[cx]= v / pivot; \
  549. cx++; \
  550. } \
  551. } /* for m */ \
  552. \
  553. /* get A(m,m) */ \
  554. int colUp= cidxU[n+1]-1; \
  555. assert (ridxU[ colUp ] == n ); /* assert U upper triangular */ \
  556. TYPE pivot= coefU[ colUp ]; \
  557. if (pivot == 0.) gripe_divide_by_zero (); \
  558. \
  559. if (pivot!=1.0) \
  560. for( int i= cx_colstart; i< cx; i++) \
  561. coefX[i]/= pivot; \
  562. } /* for n */ \
  563. cidxX[Unr]= cx; \
  564. maybe_shrink( cx, nnz, ridxX, coefX );
  565. #ifdef HAVE_OLD_OCTAVE_CONCAT
  566. #define DEFCATOP_SPARSE_FN(name, ret, t1, t2, e1, e2, f) \
  567. CATOPDECL (name, a1, a2) \
  568. { \
  569. DEBUGMSG("CATOP ## name ## t1 ## t2 ## f"); \
  570. CAST_BINOP_ARGS (const octave_ ## t1&, const octave_ ## t2&); \
  571. SuperMatrix B = f (v1.e1 (), v2.e2 (), ra_idx); \
  572. if (error_state) \
  573. return new octave_ ## ret (); \
  574. else \
  575. return new octave_ ## ret (B); \
  576. }
  577. #define INSTALL_SPARSE_CATOP(t1, t2, f) INSTALL_CATOP(t1, t2, f)
  578. #elif defined (HAVE_OCTAVE_CONCAT)
  579. #define DEFCATOP_SPARSE_FN(name, ret, t1, t2, e1, e2, f) \
  580. CATOPDECL (name, a1, a2) \
  581. { \
  582. DEBUGMSG("CATOP ## name ## t1 ## t2 ## f"); \
  583. CAST_BINOP_ARGS (octave_ ## t1&, const octave_ ## t2&); \
  584. SuperMatrix B = f (v1.e1 (), v2.e2 (), ra_idx); \
  585. if (error_state) \
  586. return new octave_ ## ret (); \
  587. else \
  588. return new octave_ ## ret (B); \
  589. }
  590. #define INSTALL_SPARSE_CATOP(t1, t2, f) INSTALL_CATOP(t1, t2, f)
  591. #else
  592. #define DEFCATOP_SPARSE_FN(name, ret, t1, t2, e1, e2, f)
  593. #define INSTALL_SPARSE_CATOP(t1, t2, f)
  594. #endif