bdfactor.c 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819
  1. /**************************************************************************
  2. **
  3. ** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  4. **
  5. ** Meschach Library
  6. **
  7. ** This Meschach Library is provided "as is" without any express
  8. ** or implied warranty of any kind with respect to this software.
  9. ** In particular the authors shall not be liable for any direct,
  10. ** indirect, special, incidental or consequential damages arising
  11. ** in any way from use of the software.
  12. **
  13. ** Everyone is granted permission to copy, modify and redistribute this
  14. ** Meschach Library, provided:
  15. ** 1. All copies contain this copyright notice.
  16. ** 2. All modified copies shall carry a notice stating who
  17. ** made the last modification and the date of such modification.
  18. ** 3. No charge is made for this software or works derived from it.
  19. ** This clause shall not be construed as constraining other software
  20. ** distributed on the same medium as this software, nor is a
  21. ** distribution fee considered a charge.
  22. **
  23. ***************************************************************************/
  24. /*
  25. Band matrix factorisation routines
  26. */
  27. /* bdfactor.c 18/11/93 */
  28. static char rcsid[] = "$Id: ";
  29. #include <stdio.h>
  30. #include <math.h>
  31. #include "matrix2.h"
  32. /* generate band matrix
  33. for a matrix with n columns,
  34. lb subdiagonals and ub superdiagonals;
  35. Way of saving a band of a matrix:
  36. first we save subdiagonals (from 0 to lb-1);
  37. then main diagonal (in the lb row)
  38. and then superdiagonals (from lb+1 to lb+ub)
  39. in such a way that the elements which were previously
  40. in one column are now also in one column
  41. */
  42. #ifndef ANSI_C
  43. BAND *bd_get(lb,ub,n)
  44. int lb, ub, n;
  45. #else
  46. BAND *bd_get(int lb, int ub, int n)
  47. #endif
  48. {
  49. BAND *A;
  50. if (lb < 0 || ub < 0 || n <= 0)
  51. error(E_NEG,"bd_get");
  52. if ((A = NEW(BAND)) == (BAND *)NULL)
  53. error(E_MEM,"bd_get");
  54. else if (mem_info_is_on()) {
  55. mem_bytes(TYPE_BAND,0,sizeof(BAND));
  56. mem_numvar(TYPE_BAND,1);
  57. }
  58. lb = A->lb = min(n-1,lb);
  59. ub = A->ub = min(n-1,ub);
  60. A->mat = m_get(lb+ub+1,n);
  61. return A;
  62. }
  63. /* bd_free -- frees BAND matrix -- returns (-1) on error and 0 otherwise */
  64. #ifndef ANSI_C
  65. int bd_free(A)
  66. BAND *A;
  67. #else
  68. int bd_free(BAND *A)
  69. #endif
  70. {
  71. if ( A == (BAND *)NULL || A->lb < 0 || A->ub < 0 )
  72. /* don't trust it */
  73. return (-1);
  74. if (A->mat) m_free(A->mat);
  75. if (mem_info_is_on()) {
  76. mem_bytes(TYPE_BAND,sizeof(BAND),0);
  77. mem_numvar(TYPE_BAND,-1);
  78. }
  79. free((char *)A);
  80. return 0;
  81. }
  82. /* resize band matrix */
  83. #ifndef ANSI_C
  84. BAND *bd_resize(A,new_lb,new_ub,new_n)
  85. BAND *A;
  86. int new_lb,new_ub,new_n;
  87. #else
  88. BAND *bd_resize(BAND *A, int new_lb, int new_ub, int new_n)
  89. #endif
  90. {
  91. int lb,ub,i,j,l,shift,umin;
  92. Real **Av;
  93. if (new_lb < 0 || new_ub < 0 || new_n <= 0)
  94. error(E_NEG,"bd_resize");
  95. if ( ! A )
  96. return bd_get(new_lb,new_ub,new_n);
  97. if ( A->lb+A->ub+1 > A->mat->m )
  98. error(E_INTERN,"bd_resize");
  99. if ( A->lb == new_lb && A->ub == new_ub && A->mat->n == new_n )
  100. return A;
  101. lb = A->lb;
  102. ub = A->ub;
  103. Av = A->mat->me;
  104. umin = min(ub,new_ub);
  105. /* ensure that unused triangles at edges are zero'd */
  106. for ( i = 0; i < lb; i++ )
  107. for ( j = A->mat->n - lb + i; j < A->mat->n; j++ )
  108. Av[i][j] = 0.0;
  109. for ( i = lb+1,l=1; l <= umin; i++,l++ )
  110. for ( j = 0; j < l; j++ )
  111. Av[i][j] = 0.0;
  112. new_lb = A->lb = min(new_lb,new_n-1);
  113. new_ub = A->ub = min(new_ub,new_n-1);
  114. A->mat = m_resize(A->mat,new_lb+new_ub+1,new_n);
  115. Av = A->mat->me;
  116. /* if new_lb != lb then move the rows to get the main diag
  117. in the new_lb row */
  118. if (new_lb > lb) {
  119. shift = new_lb-lb;
  120. for (i=lb+umin, l=i+shift; i >= 0; i--,l--)
  121. MEM_COPY(Av[i],Av[l],new_n*sizeof(Real));
  122. for (l=shift-1; l >= 0; l--)
  123. __zero__(Av[l],new_n);
  124. }
  125. else if (new_lb < lb) {
  126. shift = lb - new_lb;
  127. for (i=shift, l=0; i <= lb+umin; i++,l++)
  128. MEM_COPY(Av[i],Av[l],new_n*sizeof(Real));
  129. for (i=lb+umin+1; i <= new_lb+new_ub; i++)
  130. __zero__(Av[i],new_n);
  131. }
  132. return A;
  133. }
  134. /* bd_copy -- copies band matrix A to B, returning B
  135. -- if B is NULL, create
  136. -- B is set to the correct size */
  137. #ifndef ANSI_C
  138. BAND *bd_copy(A,B)
  139. BAND *A,*B;
  140. #else
  141. BAND *bd_copy(const BAND *A, BAND *B)
  142. #endif
  143. {
  144. int lb,ub,i,j,n;
  145. if ( !A )
  146. error(E_NULL,"bd_copy");
  147. if (A == B) return B;
  148. n = A->mat->n;
  149. if ( !B )
  150. B = bd_get(A->lb,A->ub,n);
  151. else if (B->lb != A->lb || B->ub != A->ub || B->mat->n != n )
  152. B = bd_resize(B,A->lb,A->ub,n);
  153. if (A->mat == B->mat) return B;
  154. ub = B->ub = A->ub;
  155. lb = B->lb = A->lb;
  156. for ( i=0, j=n-lb; i <= lb; i++, j++ )
  157. MEM_COPY(A->mat->me[i],B->mat->me[i],j*sizeof(Real));
  158. for ( i=lb+1, j=1; i <= lb+ub; i++, j++ )
  159. MEM_COPY(A->mat->me[i]+j,B->mat->me[i]+j,(n - j)*sizeof(Real));
  160. return B;
  161. }
  162. /* copy band matrix bA to a square matrix A returning A */
  163. #ifndef ANSI_C
  164. MAT *band2mat(bA,A)
  165. BAND *bA;
  166. MAT *A;
  167. #else
  168. MAT *band2mat(const BAND *bA, MAT *A)
  169. #endif
  170. {
  171. int i,j,l,n,n1;
  172. int lb, ub;
  173. Real **bmat;
  174. if ( !bA )
  175. error(E_NULL,"band2mat");
  176. if ( bA->mat == A )
  177. error(E_INSITU,"band2mat");
  178. ub = bA->ub;
  179. lb = bA->lb;
  180. n = bA->mat->n;
  181. n1 = n-1;
  182. bmat = bA->mat->me;
  183. A = m_resize(A,n,n);
  184. m_zero(A);
  185. for (j=0; j < n; j++)
  186. for (i=min(n1,j+lb),l=lb+j-i; i >= max(0,j-ub); i--,l++)
  187. A->me[i][j] = bmat[l][j];
  188. return A;
  189. }
  190. /* copy a square matrix to a band matrix with
  191. lb subdiagonals and ub superdiagonals */
  192. #ifndef ANSI_C
  193. BAND *mat2band(A,lb,ub,bA)
  194. BAND *bA;
  195. MAT *A;
  196. int lb, ub;
  197. #else
  198. BAND *mat2band(const MAT *A, int lb, int ub,BAND *bA)
  199. #endif
  200. {
  201. int i, j, l, n1;
  202. Real **bmat;
  203. if (! A )
  204. error(E_NULL,"mat2band");
  205. if (ub < 0 || lb < 0)
  206. error(E_SIZES,"mat2band");
  207. if ( bA != (BAND *)NULL && bA->mat == A )
  208. error(E_INSITU,"mat2band");
  209. n1 = A->n-1;
  210. lb = min(n1,lb);
  211. ub = min(n1,ub);
  212. bA = bd_resize(bA,lb,ub,n1+1);
  213. bmat = bA->mat->me;
  214. for (j=0; j <= n1; j++)
  215. for (i=min(n1,j+lb),l=lb+j-i; i >= max(0,j-ub); i--,l++)
  216. bmat[l][j] = A->me[i][j];
  217. return bA;
  218. }
  219. /* transposition of matrix in;
  220. out - matrix after transposition;
  221. can be done in situ
  222. */
  223. #ifndef ANSI_C
  224. BAND *bd_transp(in,out)
  225. BAND *in, *out;
  226. #else
  227. BAND *bd_transp(const BAND *in, BAND *out)
  228. #endif
  229. {
  230. int i, j, jj, l, k, lb, ub, lub, n, n1;
  231. int in_situ;
  232. Real **in_v, **out_v;
  233. if ( in == (BAND *)NULL || in->mat == (MAT *)NULL )
  234. error(E_NULL,"bd_transp");
  235. lb = in->lb;
  236. ub = in->ub;
  237. lub = lb+ub;
  238. n = in->mat->n;
  239. n1 = n-1;
  240. in_situ = ( in == out );
  241. if ( ! in_situ )
  242. out = bd_resize(out,ub,lb,n);
  243. else
  244. { /* only need to swap lb and ub fields */
  245. out->lb = ub;
  246. out->ub = lb;
  247. }
  248. in_v = in->mat->me;
  249. if (! in_situ) {
  250. int sh_in,sh_out;
  251. out_v = out->mat->me;
  252. for (i=0, l=lub, k=lb-i; i <= lub; i++,l--,k--) {
  253. sh_in = max(-k,0);
  254. sh_out = max(k,0);
  255. MEM_COPY(&(in_v[i][sh_in]),&(out_v[l][sh_out]),
  256. (n-sh_in-sh_out)*sizeof(Real));
  257. /**********************************
  258. for (j=n1-sh_out, jj=n1-sh_in; j >= sh_in; j--,jj--) {
  259. out_v[l][jj] = in_v[i][j];
  260. }
  261. **********************************/
  262. }
  263. }
  264. else if (ub == lb) {
  265. Real tmp;
  266. for (i=0, l=lub, k=lb-i; i < lb; i++,l--,k--) {
  267. for (j=n1-k, jj=n1; j >= 0; j--,jj--) {
  268. tmp = in_v[l][jj];
  269. in_v[l][jj] = in_v[i][j];
  270. in_v[i][j] = tmp;
  271. }
  272. }
  273. }
  274. else if (ub > lb) { /* hence i-ub <= 0 & l-lb >= 0 */
  275. int p,pp,lbi;
  276. for (i=0, l=lub; i < (lub+1)/2; i++,l--) {
  277. lbi = lb-i;
  278. for (j=l-lb, jj=0, p=max(-lbi,0), pp = max(l-ub,0); j <= n1;
  279. j++,jj++,p++,pp++) {
  280. in_v[l][pp] = in_v[i][p];
  281. in_v[i][jj] = in_v[l][j];
  282. }
  283. for ( ; p <= n1-max(lbi,0); p++,pp++)
  284. in_v[l][pp] = in_v[i][p];
  285. }
  286. if (lub%2 == 0) { /* shift only */
  287. i = lub/2;
  288. for (j=max(i-lb,0), jj=0; jj <= n1-ub+i; j++,jj++)
  289. in_v[i][jj] = in_v[i][j];
  290. }
  291. }
  292. else { /* ub < lb, hence ub-l <= 0 & lb-i >= 0 */
  293. int p,pp,ubi;
  294. for (i=0, l=lub; i < (lub+1)/2; i++,l--) {
  295. ubi = i-ub;
  296. for (j=n1-max(lb-l,0), jj=n1-max(-ubi,0), p=n1-lb+i, pp=n1;
  297. p >= 0; j--, jj--, pp--, p--) {
  298. in_v[i][jj] = in_v[l][j];
  299. in_v[l][pp] = in_v[i][p];
  300. }
  301. for ( ; jj >= max(ubi,0); j--, jj--)
  302. in_v[i][jj] = in_v[l][j];
  303. }
  304. if (lub%2 == 0) { /* shift only */
  305. i = lub/2;
  306. for (j=n1-lb+i, jj=n1-max(ub-i,0); j >= 0; j--, jj--)
  307. in_v[i][jj] = in_v[i][j];
  308. }
  309. }
  310. return out;
  311. }
  312. /* bdv_mltadd -- band matrix-vector multiply and add
  313. -- returns out <- x + s.bA.y
  314. -- if y is NULL then create y (as zero vector)
  315. -- error if either A or x is NULL */
  316. #ifndef ANSI_C
  317. VEC *bdv_mltadd(x,y,bA,s,out)
  318. BAND *bA;
  319. VEC *x, *y;
  320. double s;
  321. VEC *out;
  322. #else
  323. VEC *bdv_mltadd(const VEC *x, const VEC *y, const BAND *bA,
  324. double s, VEC *out)
  325. #endif
  326. {
  327. int i, j;
  328. if ( ! bA || ! x || ! y )
  329. error(E_NULL,"bdv_mltadd");
  330. if ( bA->mat->n != x->dim || y->dim != x->dim )
  331. error(E_SIZES,"bdv_mltadd");
  332. if ( ! out || out->dim != x->dim )
  333. out = v_resize(out,x->dim);
  334. out = v_copy(x,out);
  335. for ( j = 0; j < x->dim; j++ )
  336. for ( i = max(j-bA->ub,0); i <= j+bA->lb && i < x->dim; i++ )
  337. out->ve[i] += s*bd_get_val(bA,i,j)*y->ve[j];
  338. return out;
  339. }
  340. /* vbd_mltadd -- band matrix-vector multiply and add
  341. -- returns out^T <- x^T + s.y^T.bA
  342. -- if out is NULL then create out (as zero vector)
  343. -- error if either bA or x is NULL */
  344. #ifndef ANSI_C
  345. VEC *vbd_mltadd(x,y,bA,s,out)
  346. BAND *bA;
  347. VEC *x, *y;
  348. double s;
  349. VEC *out;
  350. #else
  351. VEC *vbd_mltadd(const VEC *x, const VEC *y, const BAND *bA,
  352. double s, VEC *out)
  353. #endif
  354. {
  355. int i, j;
  356. if ( ! bA || ! x || ! y )
  357. error(E_NULL,"vbd_mltadd");
  358. if ( bA->mat->n != x->dim || y->dim != x->dim )
  359. error(E_SIZES,"vbd_mltadd");
  360. if ( ! out || out->dim != x->dim )
  361. out = v_resize(out,x->dim);
  362. out = v_copy(x,out);
  363. for ( j = 0; j < x->dim; j++ )
  364. for ( i = max(j-bA->ub,0); i <= j+bA->lb && i < x->dim; i++ )
  365. out->ve[j] += s*bd_get_val(bA,i,j)*y->ve[i];
  366. return out;
  367. }
  368. /* bd_zero -- zeros band matrix A which is returned */
  369. #ifndef ANSI_C
  370. BAND *bd_zero(A)
  371. BAND *A;
  372. #else
  373. BAND *bd_zero(BAND *A)
  374. #endif
  375. {
  376. if ( ! A )
  377. error(E_NULL,"bd_zero");
  378. m_zero(A->mat);
  379. return A;
  380. }
  381. /* bds_mltadd -- returns OUT <- A+alpha*B
  382. -- OUT is created (as zero) if NULL
  383. -- if OUT is not the correct size, it is re-sized before the operation
  384. -- if A or B are null, and error is generated */
  385. #ifndef ANSI_C
  386. BAND *bds_mltadd(A,B,alpha,OUT)
  387. BAND *A, *B, *OUT;
  388. Real alpha;
  389. #else
  390. BAND *bds_mltadd(const BAND *A, const BAND *B, double alpha, BAND *OUT)
  391. #endif
  392. {
  393. int i;
  394. if ( ! A || ! B )
  395. error(E_NULL,"bds_mltadd");
  396. if ( A->mat->n != B->mat->n )
  397. error(E_SIZES,"bds_mltadd");
  398. if ( A == OUT || B == OUT )
  399. error(E_INSITU,"bds_mltadd");
  400. OUT = bd_copy(A,OUT);
  401. OUT = bd_resize(OUT,max(A->lb,B->lb),max(A->ub,B->ub),A->mat->n);
  402. for ( i = 0; i <= B->lb + B->ub; i++ )
  403. __mltadd__(OUT->mat->me[i+OUT->lb-B->lb],B->mat->me[i],alpha,B->mat->n);
  404. return OUT;
  405. }
  406. /* sbd_mlt -- returns OUT <- s.A */
  407. #ifndef ANSI_C
  408. BAND *sbd_mlt(Real s, BAND *A, BAND *OUT)
  409. #else
  410. BAND *sbd_mlt(Real s, const BAND *A, BAND *OUT)
  411. #endif
  412. {
  413. if ( ! A )
  414. error(E_NULL,"sbd_mlt");
  415. OUT = bd_resize(OUT,A->lb,A->ub,A->mat->n);
  416. sm_mlt(s,A->mat,OUT->mat);
  417. return OUT;
  418. }
  419. /* bdLUfactor -- gaussian elimination with partial pivoting
  420. -- on entry, the matrix A in band storage with elements
  421. in rows 0 to lb+ub;
  422. The jth column of A is stored in the jth column of
  423. band A (bA) as follows:
  424. bA->mat->me[lb+j-i][j] = A->me[i][j] for
  425. max(0,j-lb) <= i <= min(A->n-1,j+ub);
  426. -- on exit: U is stored as an upper triangular matrix
  427. with lb+ub superdiagonals in rows lb to 2*lb+ub,
  428. and the matrix L is stored in rows 0 to lb-1.
  429. Matrix U is permuted, whereas L is not permuted !!!
  430. Therefore we save some memory.
  431. */
  432. #ifndef ANSI_C
  433. BAND *bdLUfactor(bA,pivot)
  434. BAND *bA;
  435. PERM *pivot;
  436. #else
  437. BAND *bdLUfactor(BAND *bA, PERM *pivot)
  438. #endif
  439. {
  440. int i, j, k, l, n, n1, lb, ub, lub, k_end, k_lub;
  441. int i_max, shift;
  442. Real **bA_v;
  443. Real max1, temp;
  444. if ( bA==(BAND *)NULL || pivot==(PERM *)NULL )
  445. error(E_NULL,"bdLUfactor");
  446. lb = bA->lb;
  447. ub = bA->ub;
  448. lub = lb+ub;
  449. n = bA->mat->n;
  450. n1 = n-1;
  451. lub = lb+ub;
  452. if ( pivot->size != n )
  453. error(E_SIZES,"bdLUfactor");
  454. /* initialise pivot with identity permutation */
  455. for ( i=0; i < n; i++ )
  456. pivot->pe[i] = i;
  457. /* extend band matrix */
  458. /* extended part is filled with zeros */
  459. bA = bd_resize(bA,lb,min(n1,lub),n);
  460. bA_v = bA->mat->me;
  461. /* main loop */
  462. for ( k=0; k < n1; k++ )
  463. {
  464. k_end = max(0,lb+k-n1);
  465. k_lub = min(k+lub,n1);
  466. /* find the best pivot row */
  467. max1 = 0.0;
  468. i_max = -1;
  469. for ( i=lb; i >= k_end; i-- ) {
  470. temp = fabs(bA_v[i][k]);
  471. if ( temp > max1 )
  472. { max1 = temp; i_max = i; }
  473. }
  474. /* if no pivot then ignore column k... */
  475. if ( i_max == -1 )
  476. continue;
  477. /* do we pivot ? */
  478. if ( i_max != lb ) /* yes we do... */
  479. {
  480. /* save transposition using non-shifted indices */
  481. shift = lb-i_max;
  482. px_transp(pivot,k+shift,k);
  483. for ( i=lb, j=k; j <= k_lub; i++,j++ )
  484. {
  485. temp = bA_v[i][j];
  486. bA_v[i][j] = bA_v[i-shift][j];
  487. bA_v[i-shift][j] = temp;
  488. }
  489. }
  490. /* row operations */
  491. for ( i=lb-1; i >= k_end; i-- ) {
  492. temp = bA_v[i][k] /= bA_v[lb][k];
  493. shift = lb-i;
  494. for ( j=k+1,l=i+1; j <= k_lub; l++,j++ )
  495. bA_v[l][j] -= temp*bA_v[l+shift][j];
  496. }
  497. }
  498. return bA;
  499. }
  500. /* bdLUsolve -- given an LU factorisation in bA, solve bA*x=b */
  501. /* pivot is changed upon return */
  502. #ifndef ANSI_C
  503. VEC *bdLUsolve(bA,pivot,b,x)
  504. BAND *bA;
  505. PERM *pivot;
  506. VEC *b,*x;
  507. #else
  508. VEC *bdLUsolve(const BAND *bA, PERM *pivot, const VEC *b, VEC *x)
  509. #endif
  510. {
  511. int i,j,l,n,n1,pi,lb,ub,jmin, maxj;
  512. Real c;
  513. Real **bA_v;
  514. if ( bA==(BAND *)NULL || b==(VEC *)NULL || pivot==(PERM *)NULL )
  515. error(E_NULL,"bdLUsolve");
  516. if ( bA->mat->n != b->dim || bA->mat->n != pivot->size)
  517. error(E_SIZES,"bdLUsolve");
  518. lb = bA->lb;
  519. ub = bA->ub;
  520. n = b->dim;
  521. n1 = n-1;
  522. bA_v = bA->mat->me;
  523. x = v_resize(x,b->dim);
  524. px_vec(pivot,b,x);
  525. /* solve Lx = b; implicit diagonal = 1
  526. L is not permuted, therefore it must be permuted now
  527. */
  528. px_inv(pivot,pivot);
  529. for (j=0; j < n; j++) {
  530. jmin = j+1;
  531. c = x->ve[j];
  532. maxj = max(0,j+lb-n1);
  533. for (i=jmin,l=lb-1; l >= maxj; i++,l--) {
  534. if ( (pi = pivot->pe[i]) < jmin)
  535. pi = pivot->pe[i] = pivot->pe[pi];
  536. x->ve[pi] -= bA_v[l][j]*c;
  537. }
  538. }
  539. /* solve Ux = b; explicit diagonal */
  540. x->ve[n1] /= bA_v[lb][n1];
  541. for (i=n-2; i >= 0; i--) {
  542. c = x->ve[i];
  543. for (j=min(n1,i+ub), l=lb+j-i; j > i; j--,l--)
  544. c -= bA_v[l][j]*x->ve[j];
  545. x->ve[i] = c/bA_v[lb][i];
  546. }
  547. return (x);
  548. }
  549. /* LDLfactor -- L.D.L' factorisation of A in-situ;
  550. A is a band matrix
  551. it works using only lower bandwidth & main diagonal
  552. so it is possible to set A->ub = 0
  553. */
  554. #ifndef ANSI_C
  555. BAND *bdLDLfactor(A)
  556. BAND *A;
  557. #else
  558. BAND *bdLDLfactor(BAND *A)
  559. #endif
  560. {
  561. int i,j,k,n,n1,lb,ki,jk,ji,lbkm,lbkp;
  562. Real **Av;
  563. Real c, cc;
  564. if ( ! A )
  565. error(E_NULL,"bdLDLfactor");
  566. if (A->lb == 0) return A;
  567. lb = A->lb;
  568. n = A->mat->n;
  569. n1 = n-1;
  570. Av = A->mat->me;
  571. for (k=0; k < n; k++) {
  572. lbkm = lb-k;
  573. lbkp = lb+k;
  574. /* matrix D */
  575. c = Av[lb][k];
  576. for (j=max(0,-lbkm), jk=lbkm+j; j < k; j++, jk++) {
  577. cc = Av[jk][j];
  578. c -= Av[lb][j]*cc*cc;
  579. }
  580. if (c == 0.0)
  581. error(E_SING,"bdLDLfactor");
  582. Av[lb][k] = c;
  583. /* matrix L */
  584. for (i=min(n1,lbkp), ki=lbkp-i; i > k; i--,ki++) {
  585. c = Av[ki][k];
  586. for (j=max(0,i-lb), ji=lb+j-i, jk=lbkm+j; j < k;
  587. j++, ji++, jk++)
  588. c -= Av[lb][j]*Av[ji][j]*Av[jk][j];
  589. Av[ki][k] = c/Av[lb][k];
  590. }
  591. }
  592. return A;
  593. }
  594. /* solve A*x = b, where A is factorized by
  595. Choleski LDL^T factorization */
  596. #ifndef ANSI_C
  597. VEC *bdLDLsolve(A,b,x)
  598. BAND *A;
  599. VEC *b, *x;
  600. #else
  601. VEC *bdLDLsolve(const BAND *A, const VEC *b, VEC *x)
  602. #endif
  603. {
  604. int i,j,l,n,n1,lb,ilb;
  605. Real **Av, *Avlb;
  606. Real c;
  607. if ( ! A || ! b )
  608. error(E_NULL,"bdLDLsolve");
  609. if ( A->mat->n != b->dim )
  610. error(E_SIZES,"bdLDLsolve");
  611. n = A->mat->n;
  612. n1 = n-1;
  613. x = v_resize(x,n);
  614. lb = A->lb;
  615. Av = A->mat->me;
  616. Avlb = Av[lb];
  617. /* solve L*y = b */
  618. x->ve[0] = b->ve[0];
  619. for (i=1; i < n; i++) {
  620. ilb = i-lb;
  621. c = b->ve[i];
  622. for (j=max(0,ilb), l=j-ilb; j < i; j++,l++)
  623. c -= Av[l][j]*x->ve[j];
  624. x->ve[i] = c;
  625. }
  626. /* solve D*z = y */
  627. for (i=0; i < n; i++)
  628. x->ve[i] /= Avlb[i];
  629. /* solve L^T*x = z */
  630. for (i=n-2; i >= 0; i--) {
  631. ilb = i+lb;
  632. c = x->ve[i];
  633. for (j=min(n1,ilb), l=ilb-j; j > i; j--,l++)
  634. c -= Av[l][i]*x->ve[j];
  635. x->ve[i] = c;
  636. }
  637. return x;
  638. }
  639. /* ******************************************************
  640. This function is a contribution from Ruediger Franke.
  641. His e-mail addres is: Ruediger.Franke@rz.tu-ilmenau.de
  642. ******************************************************
  643. */
  644. /* bd_mv_mlt --
  645. * computes out = A * x
  646. * may not work in situ (x != out)
  647. */
  648. VEC *bd_mv_mlt(A, x, out)
  649. BAND *A;
  650. VEC *x, *out;
  651. {
  652. int i, j, j_end, k;
  653. int start_idx, end_idx;
  654. int n, m, lb, ub;
  655. Real **A_me;
  656. Real *x_ve;
  657. Real sum;
  658. if (!A || !x)
  659. error(E_NULL,"bd_mv_mlt");
  660. if (x->dim != A->mat->n)
  661. error(E_SIZES,"bd_mv_mlt");
  662. if (!out || out->dim != A->mat->n)
  663. out = v_resize(out, A->mat->n);
  664. if (out == x)
  665. error(E_INSITU,"bd_mv_mlt");
  666. n = A->mat->n;
  667. m = A->mat->m;
  668. lb = A->lb;
  669. ub = A->ub;
  670. A_me = A->mat->me;
  671. start_idx = lb;
  672. end_idx = m + n-1 - ub;
  673. for (i=0; i<n; i++, start_idx--, end_idx--) {
  674. j = max(0, start_idx);
  675. k = max(0, -start_idx);
  676. j_end = min(m, end_idx);
  677. x_ve = x->ve + k;
  678. sum = 0.0;
  679. for (; j < j_end; j++, k++)
  680. sum += A_me[j][k] * *x_ve++;
  681. out->ve[i] = sum;
  682. }
  683. return out;
  684. }