Line data Source code
1 : /*************************************************************************
2 : ALGLIB 3.17.0 (source code generated 2020-12-27)
3 : Copyright (c) Sergey Bochkanov (ALGLIB project).
4 :
5 : >>> SOURCE LICENSE >>>
6 : This program is free software; you can redistribute it and/or modify
7 : it under the terms of the GNU General Public License as published by
8 : the Free Software Foundation (www.fsf.org); either version 2 of the
9 : License, or (at your option) any later version.
10 :
11 : This program is distributed in the hope that it will be useful,
12 : but WITHOUT ANY WARRANTY; without even the implied warranty of
13 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 : GNU General Public License for more details.
15 :
16 : A copy of the GNU General Public License is available at
17 : http://www.fsf.org/licensing/licenses
18 : >>> END OF LICENSE >>>
19 : *************************************************************************/
20 : #ifdef _MSC_VER
21 : #define _CRT_SECURE_NO_WARNINGS
22 : #endif
23 : #include "stdafx.h"
24 : #include "linalg.h"
25 :
26 : // disable some irrelevant warnings
27 : #if (AE_COMPILER==AE_MSVC) && !defined(AE_ALL_WARNINGS)
28 : #pragma warning(disable:4100)
29 : #pragma warning(disable:4127)
30 : #pragma warning(disable:4611)
31 : #pragma warning(disable:4702)
32 : #pragma warning(disable:4996)
33 : #endif
34 :
35 : /////////////////////////////////////////////////////////////////////////
36 : //
37 : // THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE
38 : //
39 : /////////////////////////////////////////////////////////////////////////
40 : namespace alglib
41 : {
42 :
43 : #if defined(AE_COMPILE_SPARSE) || !defined(AE_PARTIAL_BUILD)
44 :
45 : #endif
46 :
47 : #if defined(AE_COMPILE_ABLAS) || !defined(AE_PARTIAL_BUILD)
48 :
49 : #endif
50 :
51 : #if defined(AE_COMPILE_DLU) || !defined(AE_PARTIAL_BUILD)
52 :
53 : #endif
54 :
55 : #if defined(AE_COMPILE_SPTRF) || !defined(AE_PARTIAL_BUILD)
56 :
57 : #endif
58 :
59 : #if defined(AE_COMPILE_AMDORDERING) || !defined(AE_PARTIAL_BUILD)
60 :
61 : #endif
62 :
63 : #if defined(AE_COMPILE_SPCHOL) || !defined(AE_PARTIAL_BUILD)
64 :
65 : #endif
66 :
67 : #if defined(AE_COMPILE_MATGEN) || !defined(AE_PARTIAL_BUILD)
68 :
69 : #endif
70 :
71 : #if defined(AE_COMPILE_TRFAC) || !defined(AE_PARTIAL_BUILD)
72 :
73 : #endif
74 :
75 : #if defined(AE_COMPILE_RCOND) || !defined(AE_PARTIAL_BUILD)
76 :
77 : #endif
78 :
79 : #if defined(AE_COMPILE_MATINV) || !defined(AE_PARTIAL_BUILD)
80 :
81 : #endif
82 :
83 : #if defined(AE_COMPILE_ORTFAC) || !defined(AE_PARTIAL_BUILD)
84 :
85 : #endif
86 :
87 : #if defined(AE_COMPILE_FBLS) || !defined(AE_PARTIAL_BUILD)
88 :
89 : #endif
90 :
91 : #if defined(AE_COMPILE_BDSVD) || !defined(AE_PARTIAL_BUILD)
92 :
93 : #endif
94 :
95 : #if defined(AE_COMPILE_SVD) || !defined(AE_PARTIAL_BUILD)
96 :
97 : #endif
98 :
99 : #if defined(AE_COMPILE_NORMESTIMATOR) || !defined(AE_PARTIAL_BUILD)
100 :
101 : #endif
102 :
103 : #if defined(AE_COMPILE_HSSCHUR) || !defined(AE_PARTIAL_BUILD)
104 :
105 : #endif
106 :
107 : #if defined(AE_COMPILE_EVD) || !defined(AE_PARTIAL_BUILD)
108 :
109 : #endif
110 :
111 : #if defined(AE_COMPILE_SCHUR) || !defined(AE_PARTIAL_BUILD)
112 :
113 : #endif
114 :
115 : #if defined(AE_COMPILE_SPDGEVD) || !defined(AE_PARTIAL_BUILD)
116 :
117 : #endif
118 :
119 : #if defined(AE_COMPILE_INVERSEUPDATE) || !defined(AE_PARTIAL_BUILD)
120 :
121 : #endif
122 :
123 : #if defined(AE_COMPILE_MATDET) || !defined(AE_PARTIAL_BUILD)
124 :
125 : #endif
126 :
127 : #if defined(AE_COMPILE_SPARSE) || !defined(AE_PARTIAL_BUILD)
128 : /*************************************************************************
129 : Sparse matrix structure.
130 :
131 : You should use ALGLIB functions to work with sparse matrix. Never try to
132 : access its fields directly!
133 :
134 : NOTES ON THE SPARSE STORAGE FORMATS
135 :
136 : Sparse matrices can be stored using several formats:
137 : * Hash-Table representation
138 : * Compressed Row Storage (CRS)
139 : * Skyline matrix storage (SKS)
140 :
141 : Each of the formats has benefits and drawbacks:
142 : * Hash-table is good for dynamic operations (insertion of new elements),
143 : but does not support linear algebra operations
144 : * CRS is good for operations like matrix-vector or matrix-matrix products,
145 : but its initialization is less convenient - you have to tell row sizes
146 : at the initialization, and you have to fill matrix only row by row,
147 : from left to right.
148 : * SKS is a special format which is used to store triangular factors from
149 : Cholesky factorization. It does not support dynamic modification, and
150 : support for linear algebra operations is very limited.
151 :
152 : Tables below outline information about these two formats:
153 :
154 : OPERATIONS WITH MATRIX HASH CRS SKS
155 : creation + + +
156 : SparseGet + + +
157 : SparseExists + + +
158 : SparseRewriteExisting + + +
159 : SparseSet + + +
160 : SparseAdd +
161 : SparseGetRow + +
162 : SparseGetCompressedRow + +
163 : sparse-dense linear algebra + +
164 : *************************************************************************/
165 0 : _sparsematrix_owner::_sparsematrix_owner()
166 : {
167 : jmp_buf _break_jump;
168 : alglib_impl::ae_state _state;
169 :
170 0 : alglib_impl::ae_state_init(&_state);
171 0 : if( setjmp(_break_jump) )
172 : {
173 0 : if( p_struct!=NULL )
174 : {
175 0 : alglib_impl::_sparsematrix_destroy(p_struct);
176 0 : alglib_impl::ae_free(p_struct);
177 : }
178 0 : p_struct = NULL;
179 : #if !defined(AE_NO_EXCEPTIONS)
180 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
181 : #else
182 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
183 : return;
184 : #endif
185 : }
186 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
187 0 : p_struct = NULL;
188 0 : p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), &_state);
189 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsematrix));
190 0 : alglib_impl::_sparsematrix_init(p_struct, &_state, ae_false);
191 0 : ae_state_clear(&_state);
192 0 : }
193 :
194 0 : _sparsematrix_owner::_sparsematrix_owner(const _sparsematrix_owner &rhs)
195 : {
196 : jmp_buf _break_jump;
197 : alglib_impl::ae_state _state;
198 :
199 0 : alglib_impl::ae_state_init(&_state);
200 0 : if( setjmp(_break_jump) )
201 : {
202 0 : if( p_struct!=NULL )
203 : {
204 0 : alglib_impl::_sparsematrix_destroy(p_struct);
205 0 : alglib_impl::ae_free(p_struct);
206 : }
207 0 : p_struct = NULL;
208 : #if !defined(AE_NO_EXCEPTIONS)
209 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
210 : #else
211 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
212 : return;
213 : #endif
214 : }
215 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
216 0 : p_struct = NULL;
217 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsematrix copy constructor failure (source is not initialized)", &_state);
218 0 : p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), &_state);
219 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsematrix));
220 0 : alglib_impl::_sparsematrix_init_copy(p_struct, const_cast<alglib_impl::sparsematrix*>(rhs.p_struct), &_state, ae_false);
221 0 : ae_state_clear(&_state);
222 0 : }
223 :
224 0 : _sparsematrix_owner& _sparsematrix_owner::operator=(const _sparsematrix_owner &rhs)
225 : {
226 0 : if( this==&rhs )
227 0 : return *this;
228 : jmp_buf _break_jump;
229 : alglib_impl::ae_state _state;
230 :
231 0 : alglib_impl::ae_state_init(&_state);
232 0 : if( setjmp(_break_jump) )
233 : {
234 : #if !defined(AE_NO_EXCEPTIONS)
235 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
236 : #else
237 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
238 : return *this;
239 : #endif
240 : }
241 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
242 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: sparsematrix assignment constructor failure (destination is not initialized)", &_state);
243 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsematrix assignment constructor failure (source is not initialized)", &_state);
244 0 : alglib_impl::_sparsematrix_destroy(p_struct);
245 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsematrix));
246 0 : alglib_impl::_sparsematrix_init_copy(p_struct, const_cast<alglib_impl::sparsematrix*>(rhs.p_struct), &_state, ae_false);
247 0 : ae_state_clear(&_state);
248 0 : return *this;
249 : }
250 :
251 0 : _sparsematrix_owner::~_sparsematrix_owner()
252 : {
253 0 : if( p_struct!=NULL )
254 : {
255 0 : alglib_impl::_sparsematrix_destroy(p_struct);
256 0 : ae_free(p_struct);
257 : }
258 0 : }
259 :
260 0 : alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr()
261 : {
262 0 : return p_struct;
263 : }
264 :
265 0 : alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr() const
266 : {
267 0 : return const_cast<alglib_impl::sparsematrix*>(p_struct);
268 : }
269 0 : sparsematrix::sparsematrix() : _sparsematrix_owner()
270 : {
271 0 : }
272 :
273 0 : sparsematrix::sparsematrix(const sparsematrix &rhs):_sparsematrix_owner(rhs)
274 : {
275 0 : }
276 :
277 0 : sparsematrix& sparsematrix::operator=(const sparsematrix &rhs)
278 : {
279 0 : if( this==&rhs )
280 0 : return *this;
281 0 : _sparsematrix_owner::operator=(rhs);
282 0 : return *this;
283 : }
284 :
285 0 : sparsematrix::~sparsematrix()
286 : {
287 0 : }
288 :
289 :
290 : /*************************************************************************
291 : Temporary buffers for sparse matrix operations.
292 :
293 : You should pass an instance of this structure to factorization functions.
294 : It allows to reuse memory during repeated sparse factorizations. You do
295 : not have to call some initialization function - simply passing an instance
296 : to factorization function is enough.
297 : *************************************************************************/
298 0 : _sparsebuffers_owner::_sparsebuffers_owner()
299 : {
300 : jmp_buf _break_jump;
301 : alglib_impl::ae_state _state;
302 :
303 0 : alglib_impl::ae_state_init(&_state);
304 0 : if( setjmp(_break_jump) )
305 : {
306 0 : if( p_struct!=NULL )
307 : {
308 0 : alglib_impl::_sparsebuffers_destroy(p_struct);
309 0 : alglib_impl::ae_free(p_struct);
310 : }
311 0 : p_struct = NULL;
312 : #if !defined(AE_NO_EXCEPTIONS)
313 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
314 : #else
315 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
316 : return;
317 : #endif
318 : }
319 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
320 0 : p_struct = NULL;
321 0 : p_struct = (alglib_impl::sparsebuffers*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsebuffers), &_state);
322 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsebuffers));
323 0 : alglib_impl::_sparsebuffers_init(p_struct, &_state, ae_false);
324 0 : ae_state_clear(&_state);
325 0 : }
326 :
327 0 : _sparsebuffers_owner::_sparsebuffers_owner(const _sparsebuffers_owner &rhs)
328 : {
329 : jmp_buf _break_jump;
330 : alglib_impl::ae_state _state;
331 :
332 0 : alglib_impl::ae_state_init(&_state);
333 0 : if( setjmp(_break_jump) )
334 : {
335 0 : if( p_struct!=NULL )
336 : {
337 0 : alglib_impl::_sparsebuffers_destroy(p_struct);
338 0 : alglib_impl::ae_free(p_struct);
339 : }
340 0 : p_struct = NULL;
341 : #if !defined(AE_NO_EXCEPTIONS)
342 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
343 : #else
344 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
345 : return;
346 : #endif
347 : }
348 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
349 0 : p_struct = NULL;
350 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsebuffers copy constructor failure (source is not initialized)", &_state);
351 0 : p_struct = (alglib_impl::sparsebuffers*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsebuffers), &_state);
352 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsebuffers));
353 0 : alglib_impl::_sparsebuffers_init_copy(p_struct, const_cast<alglib_impl::sparsebuffers*>(rhs.p_struct), &_state, ae_false);
354 0 : ae_state_clear(&_state);
355 0 : }
356 :
357 0 : _sparsebuffers_owner& _sparsebuffers_owner::operator=(const _sparsebuffers_owner &rhs)
358 : {
359 0 : if( this==&rhs )
360 0 : return *this;
361 : jmp_buf _break_jump;
362 : alglib_impl::ae_state _state;
363 :
364 0 : alglib_impl::ae_state_init(&_state);
365 0 : if( setjmp(_break_jump) )
366 : {
367 : #if !defined(AE_NO_EXCEPTIONS)
368 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
369 : #else
370 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
371 : return *this;
372 : #endif
373 : }
374 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
375 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: sparsebuffers assignment constructor failure (destination is not initialized)", &_state);
376 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsebuffers assignment constructor failure (source is not initialized)", &_state);
377 0 : alglib_impl::_sparsebuffers_destroy(p_struct);
378 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsebuffers));
379 0 : alglib_impl::_sparsebuffers_init_copy(p_struct, const_cast<alglib_impl::sparsebuffers*>(rhs.p_struct), &_state, ae_false);
380 0 : ae_state_clear(&_state);
381 0 : return *this;
382 : }
383 :
384 0 : _sparsebuffers_owner::~_sparsebuffers_owner()
385 : {
386 0 : if( p_struct!=NULL )
387 : {
388 0 : alglib_impl::_sparsebuffers_destroy(p_struct);
389 0 : ae_free(p_struct);
390 : }
391 0 : }
392 :
393 0 : alglib_impl::sparsebuffers* _sparsebuffers_owner::c_ptr()
394 : {
395 0 : return p_struct;
396 : }
397 :
398 0 : alglib_impl::sparsebuffers* _sparsebuffers_owner::c_ptr() const
399 : {
400 0 : return const_cast<alglib_impl::sparsebuffers*>(p_struct);
401 : }
402 0 : sparsebuffers::sparsebuffers() : _sparsebuffers_owner()
403 : {
404 0 : }
405 :
406 0 : sparsebuffers::sparsebuffers(const sparsebuffers &rhs):_sparsebuffers_owner(rhs)
407 : {
408 0 : }
409 :
410 0 : sparsebuffers& sparsebuffers::operator=(const sparsebuffers &rhs)
411 : {
412 0 : if( this==&rhs )
413 0 : return *this;
414 0 : _sparsebuffers_owner::operator=(rhs);
415 0 : return *this;
416 : }
417 :
418 0 : sparsebuffers::~sparsebuffers()
419 : {
420 0 : }
421 :
422 : /*************************************************************************
423 : This function creates sparse matrix in a Hash-Table format.
424 :
425 : This function creates Hast-Table matrix, which can be converted to CRS
426 : format after its initialization is over. Typical usage scenario for a
427 : sparse matrix is:
428 : 1. creation in a Hash-Table format
429 : 2. insertion of the matrix elements
430 : 3. conversion to the CRS representation
431 : 4. matrix is passed to some linear algebra algorithm
432 :
433 : Some information about different matrix formats can be found below, in
434 : the "NOTES" section.
435 :
436 : INPUT PARAMETERS
437 : M - number of rows in a matrix, M>=1
438 : N - number of columns in a matrix, N>=1
439 : K - K>=0, expected number of non-zero elements in a matrix.
440 : K can be inexact approximation, can be less than actual
441 : number of elements (table will grow when needed) or
442 : even zero).
443 : It is important to understand that although hash-table
444 : may grow automatically, it is better to provide good
445 : estimate of data size.
446 :
447 : OUTPUT PARAMETERS
448 : S - sparse M*N matrix in Hash-Table representation.
449 : All elements of the matrix are zero.
450 :
451 : NOTE 1
452 :
453 : Hash-tables use memory inefficiently, and they have to keep some amount
454 : of the "spare memory" in order to have good performance. Hash table for
455 : matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes,
456 : where C is a small constant, about 1.5-2 in magnitude.
457 :
458 : CRS storage, from the other side, is more memory-efficient, and needs
459 : just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows
460 : in a matrix.
461 :
462 : When you convert from the Hash-Table to CRS representation, all unneeded
463 : memory will be freed.
464 :
465 : NOTE 2
466 :
467 : Comments of SparseMatrix structure outline information about different
468 : sparse storage formats. We recommend you to read them before starting to
469 : use ALGLIB sparse matrices.
470 :
471 : NOTE 3
472 :
473 : This function completely overwrites S with new sparse matrix. Previously
474 : allocated storage is NOT reused. If you want to reuse already allocated
475 : memory, call SparseCreateBuf function.
476 :
477 : -- ALGLIB PROJECT --
478 : Copyright 14.10.2011 by Bochkanov Sergey
479 : *************************************************************************/
480 0 : void sparsecreate(const ae_int_t m, const ae_int_t n, const ae_int_t k, sparsematrix &s, const xparams _xparams)
481 : {
482 : jmp_buf _break_jump;
483 : alglib_impl::ae_state _alglib_env_state;
484 0 : alglib_impl::ae_state_init(&_alglib_env_state);
485 0 : if( setjmp(_break_jump) )
486 : {
487 : #if !defined(AE_NO_EXCEPTIONS)
488 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
489 : #else
490 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
491 : return;
492 : #endif
493 : }
494 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
495 0 : if( _xparams.flags!=0x0 )
496 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
497 0 : alglib_impl::sparsecreate(m, n, k, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
498 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
499 0 : return;
500 : }
501 :
502 : /*************************************************************************
503 : This function creates sparse matrix in a Hash-Table format.
504 :
505 : This function creates Hast-Table matrix, which can be converted to CRS
506 : format after its initialization is over. Typical usage scenario for a
507 : sparse matrix is:
508 : 1. creation in a Hash-Table format
509 : 2. insertion of the matrix elements
510 : 3. conversion to the CRS representation
511 : 4. matrix is passed to some linear algebra algorithm
512 :
513 : Some information about different matrix formats can be found below, in
514 : the "NOTES" section.
515 :
516 : INPUT PARAMETERS
517 : M - number of rows in a matrix, M>=1
518 : N - number of columns in a matrix, N>=1
519 : K - K>=0, expected number of non-zero elements in a matrix.
520 : K can be inexact approximation, can be less than actual
521 : number of elements (table will grow when needed) or
522 : even zero).
523 : It is important to understand that although hash-table
524 : may grow automatically, it is better to provide good
525 : estimate of data size.
526 :
527 : OUTPUT PARAMETERS
528 : S - sparse M*N matrix in Hash-Table representation.
529 : All elements of the matrix are zero.
530 :
531 : NOTE 1
532 :
533 : Hash-tables use memory inefficiently, and they have to keep some amount
534 : of the "spare memory" in order to have good performance. Hash table for
535 : matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes,
536 : where C is a small constant, about 1.5-2 in magnitude.
537 :
538 : CRS storage, from the other side, is more memory-efficient, and needs
539 : just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows
540 : in a matrix.
541 :
542 : When you convert from the Hash-Table to CRS representation, all unneeded
543 : memory will be freed.
544 :
545 : NOTE 2
546 :
547 : Comments of SparseMatrix structure outline information about different
548 : sparse storage formats. We recommend you to read them before starting to
549 : use ALGLIB sparse matrices.
550 :
551 : NOTE 3
552 :
553 : This function completely overwrites S with new sparse matrix. Previously
554 : allocated storage is NOT reused. If you want to reuse already allocated
555 : memory, call SparseCreateBuf function.
556 :
557 : -- ALGLIB PROJECT --
558 : Copyright 14.10.2011 by Bochkanov Sergey
559 : *************************************************************************/
560 : #if !defined(AE_NO_EXCEPTIONS)
561 0 : void sparsecreate(const ae_int_t m, const ae_int_t n, sparsematrix &s, const xparams _xparams)
562 : {
563 : jmp_buf _break_jump;
564 : alglib_impl::ae_state _alglib_env_state;
565 : ae_int_t k;
566 :
567 0 : k = 0;
568 0 : alglib_impl::ae_state_init(&_alglib_env_state);
569 0 : if( setjmp(_break_jump) )
570 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
571 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
572 0 : if( _xparams.flags!=0x0 )
573 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
574 0 : alglib_impl::sparsecreate(m, n, k, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
575 :
576 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
577 0 : return;
578 : }
579 : #endif
580 :
581 : /*************************************************************************
582 : This version of SparseCreate function creates sparse matrix in Hash-Table
583 : format, reusing previously allocated storage as much as possible. Read
584 : comments for SparseCreate() for more information.
585 :
586 : INPUT PARAMETERS
587 : M - number of rows in a matrix, M>=1
588 : N - number of columns in a matrix, N>=1
589 : K - K>=0, expected number of non-zero elements in a matrix.
590 : K can be inexact approximation, can be less than actual
591 : number of elements (table will grow when needed) or
592 : even zero).
593 : It is important to understand that although hash-table
594 : may grow automatically, it is better to provide good
595 : estimate of data size.
596 : S - SparseMatrix structure which MAY contain some already
597 : allocated storage.
598 :
599 : OUTPUT PARAMETERS
600 : S - sparse M*N matrix in Hash-Table representation.
601 : All elements of the matrix are zero.
602 : Previously allocated storage is reused, if its size
603 : is compatible with expected number of non-zeros K.
604 :
605 : -- ALGLIB PROJECT --
606 : Copyright 14.01.2014 by Bochkanov Sergey
607 : *************************************************************************/
608 0 : void sparsecreatebuf(const ae_int_t m, const ae_int_t n, const ae_int_t k, const sparsematrix &s, const xparams _xparams)
609 : {
610 : jmp_buf _break_jump;
611 : alglib_impl::ae_state _alglib_env_state;
612 0 : alglib_impl::ae_state_init(&_alglib_env_state);
613 0 : if( setjmp(_break_jump) )
614 : {
615 : #if !defined(AE_NO_EXCEPTIONS)
616 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
617 : #else
618 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
619 : return;
620 : #endif
621 : }
622 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
623 0 : if( _xparams.flags!=0x0 )
624 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
625 0 : alglib_impl::sparsecreatebuf(m, n, k, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
626 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
627 0 : return;
628 : }
629 :
630 : /*************************************************************************
631 : This version of SparseCreate function creates sparse matrix in Hash-Table
632 : format, reusing previously allocated storage as much as possible. Read
633 : comments for SparseCreate() for more information.
634 :
635 : INPUT PARAMETERS
636 : M - number of rows in a matrix, M>=1
637 : N - number of columns in a matrix, N>=1
638 : K - K>=0, expected number of non-zero elements in a matrix.
639 : K can be inexact approximation, can be less than actual
640 : number of elements (table will grow when needed) or
641 : even zero).
642 : It is important to understand that although hash-table
643 : may grow automatically, it is better to provide good
644 : estimate of data size.
645 : S - SparseMatrix structure which MAY contain some already
646 : allocated storage.
647 :
648 : OUTPUT PARAMETERS
649 : S - sparse M*N matrix in Hash-Table representation.
650 : All elements of the matrix are zero.
651 : Previously allocated storage is reused, if its size
652 : is compatible with expected number of non-zeros K.
653 :
654 : -- ALGLIB PROJECT --
655 : Copyright 14.01.2014 by Bochkanov Sergey
656 : *************************************************************************/
657 : #if !defined(AE_NO_EXCEPTIONS)
658 0 : void sparsecreatebuf(const ae_int_t m, const ae_int_t n, const sparsematrix &s, const xparams _xparams)
659 : {
660 : jmp_buf _break_jump;
661 : alglib_impl::ae_state _alglib_env_state;
662 : ae_int_t k;
663 :
664 0 : k = 0;
665 0 : alglib_impl::ae_state_init(&_alglib_env_state);
666 0 : if( setjmp(_break_jump) )
667 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
668 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
669 0 : if( _xparams.flags!=0x0 )
670 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
671 0 : alglib_impl::sparsecreatebuf(m, n, k, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
672 :
673 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
674 0 : return;
675 : }
676 : #endif
677 :
678 : /*************************************************************************
679 : This function creates sparse matrix in a CRS format (expert function for
680 : situations when you are running out of memory).
681 :
682 : This function creates CRS matrix. Typical usage scenario for a CRS matrix
683 : is:
684 : 1. creation (you have to tell number of non-zero elements at each row at
685 : this moment)
686 : 2. insertion of the matrix elements (row by row, from left to right)
687 : 3. matrix is passed to some linear algebra algorithm
688 :
689 : This function is a memory-efficient alternative to SparseCreate(), but it
690 : is more complex because it requires you to know in advance how large your
691 : matrix is. Some information about different matrix formats can be found
692 : in comments on SparseMatrix structure. We recommend you to read them
693 : before starting to use ALGLIB sparse matrices..
694 :
695 : INPUT PARAMETERS
696 : M - number of rows in a matrix, M>=1
697 : N - number of columns in a matrix, N>=1
698 : NER - number of elements at each row, array[M], NER[I]>=0
699 :
700 : OUTPUT PARAMETERS
701 : S - sparse M*N matrix in CRS representation.
702 : You have to fill ALL non-zero elements by calling
703 : SparseSet() BEFORE you try to use this matrix.
704 :
705 : NOTE: this function completely overwrites S with new sparse matrix.
706 : Previously allocated storage is NOT reused. If you want to reuse
707 : already allocated memory, call SparseCreateCRSBuf function.
708 :
709 : -- ALGLIB PROJECT --
710 : Copyright 14.10.2011 by Bochkanov Sergey
711 : *************************************************************************/
712 0 : void sparsecreatecrs(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, sparsematrix &s, const xparams _xparams)
713 : {
714 : jmp_buf _break_jump;
715 : alglib_impl::ae_state _alglib_env_state;
716 0 : alglib_impl::ae_state_init(&_alglib_env_state);
717 0 : if( setjmp(_break_jump) )
718 : {
719 : #if !defined(AE_NO_EXCEPTIONS)
720 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
721 : #else
722 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
723 : return;
724 : #endif
725 : }
726 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
727 0 : if( _xparams.flags!=0x0 )
728 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
729 0 : alglib_impl::sparsecreatecrs(m, n, const_cast<alglib_impl::ae_vector*>(ner.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
730 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
731 0 : return;
732 : }
733 :
734 : /*************************************************************************
735 : This function creates sparse matrix in a CRS format (expert function for
736 : situations when you are running out of memory). This version of CRS
737 : matrix creation function may reuse memory already allocated in S.
738 :
739 : This function creates CRS matrix. Typical usage scenario for a CRS matrix
740 : is:
741 : 1. creation (you have to tell number of non-zero elements at each row at
742 : this moment)
743 : 2. insertion of the matrix elements (row by row, from left to right)
744 : 3. matrix is passed to some linear algebra algorithm
745 :
746 : This function is a memory-efficient alternative to SparseCreate(), but it
747 : is more complex because it requires you to know in advance how large your
748 : matrix is. Some information about different matrix formats can be found
749 : in comments on SparseMatrix structure. We recommend you to read them
750 : before starting to use ALGLIB sparse matrices..
751 :
752 : INPUT PARAMETERS
753 : M - number of rows in a matrix, M>=1
754 : N - number of columns in a matrix, N>=1
755 : NER - number of elements at each row, array[M], NER[I]>=0
756 : S - sparse matrix structure with possibly preallocated
757 : memory.
758 :
759 : OUTPUT PARAMETERS
760 : S - sparse M*N matrix in CRS representation.
761 : You have to fill ALL non-zero elements by calling
762 : SparseSet() BEFORE you try to use this matrix.
763 :
764 : -- ALGLIB PROJECT --
765 : Copyright 14.10.2011 by Bochkanov Sergey
766 : *************************************************************************/
767 0 : void sparsecreatecrsbuf(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, const sparsematrix &s, const xparams _xparams)
768 : {
769 : jmp_buf _break_jump;
770 : alglib_impl::ae_state _alglib_env_state;
771 0 : alglib_impl::ae_state_init(&_alglib_env_state);
772 0 : if( setjmp(_break_jump) )
773 : {
774 : #if !defined(AE_NO_EXCEPTIONS)
775 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
776 : #else
777 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
778 : return;
779 : #endif
780 : }
781 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
782 0 : if( _xparams.flags!=0x0 )
783 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
784 0 : alglib_impl::sparsecreatecrsbuf(m, n, const_cast<alglib_impl::ae_vector*>(ner.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
785 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
786 0 : return;
787 : }
788 :
789 : /*************************************************************************
790 : This function creates sparse matrix in a SKS format (skyline storage
791 : format). In most cases you do not need this function - CRS format better
792 : suits most use cases.
793 :
794 : INPUT PARAMETERS
795 : M, N - number of rows(M) and columns (N) in a matrix:
796 : * M=N (as for now, ALGLIB supports only square SKS)
797 : * N>=1
798 : * M>=1
799 : D - "bottom" bandwidths, array[M], D[I]>=0.
800 : I-th element stores number of non-zeros at I-th row,
801 : below the diagonal (diagonal itself is not included)
802 : U - "top" bandwidths, array[N], U[I]>=0.
803 : I-th element stores number of non-zeros at I-th row,
804 : above the diagonal (diagonal itself is not included)
805 :
806 : OUTPUT PARAMETERS
807 : S - sparse M*N matrix in SKS representation.
808 : All elements are filled by zeros.
809 : You may use sparseset() to change their values.
810 :
811 : NOTE: this function completely overwrites S with new sparse matrix.
812 : Previously allocated storage is NOT reused. If you want to reuse
813 : already allocated memory, call SparseCreateSKSBuf function.
814 :
815 : -- ALGLIB PROJECT --
816 : Copyright 13.01.2014 by Bochkanov Sergey
817 : *************************************************************************/
818 0 : void sparsecreatesks(const ae_int_t m, const ae_int_t n, const integer_1d_array &d, const integer_1d_array &u, sparsematrix &s, const xparams _xparams)
819 : {
820 : jmp_buf _break_jump;
821 : alglib_impl::ae_state _alglib_env_state;
822 0 : alglib_impl::ae_state_init(&_alglib_env_state);
823 0 : if( setjmp(_break_jump) )
824 : {
825 : #if !defined(AE_NO_EXCEPTIONS)
826 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
827 : #else
828 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
829 : return;
830 : #endif
831 : }
832 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
833 0 : if( _xparams.flags!=0x0 )
834 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
835 0 : alglib_impl::sparsecreatesks(m, n, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(u.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
836 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
837 0 : return;
838 : }
839 :
840 : /*************************************************************************
841 : This is "buffered" version of SparseCreateSKS() which reuses memory
842 : previously allocated in S (of course, memory is reallocated if needed).
843 :
844 : This function creates sparse matrix in a SKS format (skyline storage
845 : format). In most cases you do not need this function - CRS format better
846 : suits most use cases.
847 :
848 : INPUT PARAMETERS
849 : M, N - number of rows(M) and columns (N) in a matrix:
850 : * M=N (as for now, ALGLIB supports only square SKS)
851 : * N>=1
852 : * M>=1
853 : D - "bottom" bandwidths, array[M], 0<=D[I]<=I.
854 : I-th element stores number of non-zeros at I-th row,
855 : below the diagonal (diagonal itself is not included)
856 : U - "top" bandwidths, array[N], 0<=U[I]<=I.
857 : I-th element stores number of non-zeros at I-th row,
858 : above the diagonal (diagonal itself is not included)
859 :
860 : OUTPUT PARAMETERS
861 : S - sparse M*N matrix in SKS representation.
862 : All elements are filled by zeros.
863 : You may use sparseset() to change their values.
864 :
865 : -- ALGLIB PROJECT --
866 : Copyright 13.01.2014 by Bochkanov Sergey
867 : *************************************************************************/
868 0 : void sparsecreatesksbuf(const ae_int_t m, const ae_int_t n, const integer_1d_array &d, const integer_1d_array &u, const sparsematrix &s, const xparams _xparams)
869 : {
870 : jmp_buf _break_jump;
871 : alglib_impl::ae_state _alglib_env_state;
872 0 : alglib_impl::ae_state_init(&_alglib_env_state);
873 0 : if( setjmp(_break_jump) )
874 : {
875 : #if !defined(AE_NO_EXCEPTIONS)
876 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
877 : #else
878 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
879 : return;
880 : #endif
881 : }
882 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
883 0 : if( _xparams.flags!=0x0 )
884 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
885 0 : alglib_impl::sparsecreatesksbuf(m, n, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(u.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
886 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
887 0 : return;
888 : }
889 :
890 : /*************************************************************************
891 : This function creates sparse matrix in a SKS format (skyline storage
892 : format). Unlike more general sparsecreatesks(), this function creates
893 : sparse matrix with constant bandwidth.
894 :
895 : You may want to use this function instead of sparsecreatesks() when your
896 : matrix has constant or nearly-constant bandwidth, and you want to
897 : simplify source code.
898 :
899 : INPUT PARAMETERS
900 : M, N - number of rows(M) and columns (N) in a matrix:
901 : * M=N (as for now, ALGLIB supports only square SKS)
902 : * N>=1
903 : * M>=1
904 : BW - matrix bandwidth, BW>=0
905 :
906 : OUTPUT PARAMETERS
907 : S - sparse M*N matrix in SKS representation.
908 : All elements are filled by zeros.
909 : You may use sparseset() to change their values.
910 :
911 : NOTE: this function completely overwrites S with new sparse matrix.
912 : Previously allocated storage is NOT reused. If you want to reuse
913 : already allocated memory, call sparsecreatesksbandbuf function.
914 :
915 : -- ALGLIB PROJECT --
916 : Copyright 25.12.2017 by Bochkanov Sergey
917 : *************************************************************************/
918 0 : void sparsecreatesksband(const ae_int_t m, const ae_int_t n, const ae_int_t bw, sparsematrix &s, const xparams _xparams)
919 : {
920 : jmp_buf _break_jump;
921 : alglib_impl::ae_state _alglib_env_state;
922 0 : alglib_impl::ae_state_init(&_alglib_env_state);
923 0 : if( setjmp(_break_jump) )
924 : {
925 : #if !defined(AE_NO_EXCEPTIONS)
926 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
927 : #else
928 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
929 : return;
930 : #endif
931 : }
932 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
933 0 : if( _xparams.flags!=0x0 )
934 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
935 0 : alglib_impl::sparsecreatesksband(m, n, bw, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
936 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
937 0 : return;
938 : }
939 :
940 : /*************************************************************************
941 : This is "buffered" version of sparsecreatesksband() which reuses memory
942 : previously allocated in S (of course, memory is reallocated if needed).
943 :
944 : You may want to use this function instead of sparsecreatesksbuf() when
945 : your matrix has constant or nearly-constant bandwidth, and you want to
946 : simplify source code.
947 :
948 : INPUT PARAMETERS
949 : M, N - number of rows(M) and columns (N) in a matrix:
950 : * M=N (as for now, ALGLIB supports only square SKS)
951 : * N>=1
952 : * M>=1
953 : BW - bandwidth, BW>=0
954 :
955 : OUTPUT PARAMETERS
956 : S - sparse M*N matrix in SKS representation.
957 : All elements are filled by zeros.
958 : You may use sparseset() to change their values.
959 :
960 : -- ALGLIB PROJECT --
961 : Copyright 13.01.2014 by Bochkanov Sergey
962 : *************************************************************************/
963 0 : void sparsecreatesksbandbuf(const ae_int_t m, const ae_int_t n, const ae_int_t bw, const sparsematrix &s, const xparams _xparams)
964 : {
965 : jmp_buf _break_jump;
966 : alglib_impl::ae_state _alglib_env_state;
967 0 : alglib_impl::ae_state_init(&_alglib_env_state);
968 0 : if( setjmp(_break_jump) )
969 : {
970 : #if !defined(AE_NO_EXCEPTIONS)
971 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
972 : #else
973 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
974 : return;
975 : #endif
976 : }
977 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
978 0 : if( _xparams.flags!=0x0 )
979 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
980 0 : alglib_impl::sparsecreatesksbandbuf(m, n, bw, const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
981 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
982 0 : return;
983 : }
984 :
985 : /*************************************************************************
986 : This function copies S0 to S1.
987 : This function completely deallocates memory owned by S1 before creating a
988 : copy of S0. If you want to reuse memory, use SparseCopyBuf.
989 :
990 : NOTE: this function does not verify its arguments, it just copies all
991 : fields of the structure.
992 :
993 : -- ALGLIB PROJECT --
994 : Copyright 14.10.2011 by Bochkanov Sergey
995 : *************************************************************************/
996 0 : void sparsecopy(const sparsematrix &s0, sparsematrix &s1, const xparams _xparams)
997 : {
998 : jmp_buf _break_jump;
999 : alglib_impl::ae_state _alglib_env_state;
1000 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1001 0 : if( setjmp(_break_jump) )
1002 : {
1003 : #if !defined(AE_NO_EXCEPTIONS)
1004 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1005 : #else
1006 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1007 : return;
1008 : #endif
1009 : }
1010 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1011 0 : if( _xparams.flags!=0x0 )
1012 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1013 0 : alglib_impl::sparsecopy(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
1014 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1015 0 : return;
1016 : }
1017 :
1018 : /*************************************************************************
1019 : This function copies S0 to S1.
1020 : Memory already allocated in S1 is reused as much as possible.
1021 :
1022 : NOTE: this function does not verify its arguments, it just copies all
1023 : fields of the structure.
1024 :
1025 : -- ALGLIB PROJECT --
1026 : Copyright 14.10.2011 by Bochkanov Sergey
1027 : *************************************************************************/
1028 0 : void sparsecopybuf(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
1029 : {
1030 : jmp_buf _break_jump;
1031 : alglib_impl::ae_state _alglib_env_state;
1032 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1033 0 : if( setjmp(_break_jump) )
1034 : {
1035 : #if !defined(AE_NO_EXCEPTIONS)
1036 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1037 : #else
1038 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1039 : return;
1040 : #endif
1041 : }
1042 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1043 0 : if( _xparams.flags!=0x0 )
1044 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1045 0 : alglib_impl::sparsecopybuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
1046 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1047 0 : return;
1048 : }
1049 :
1050 : /*************************************************************************
1051 : This function efficiently swaps contents of S0 and S1.
1052 :
1053 : -- ALGLIB PROJECT --
1054 : Copyright 16.01.2014 by Bochkanov Sergey
1055 : *************************************************************************/
1056 0 : void sparseswap(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
1057 : {
1058 : jmp_buf _break_jump;
1059 : alglib_impl::ae_state _alglib_env_state;
1060 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1061 0 : if( setjmp(_break_jump) )
1062 : {
1063 : #if !defined(AE_NO_EXCEPTIONS)
1064 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1065 : #else
1066 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1067 : return;
1068 : #endif
1069 : }
1070 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1071 0 : if( _xparams.flags!=0x0 )
1072 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1073 0 : alglib_impl::sparseswap(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
1074 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1075 0 : return;
1076 : }
1077 :
1078 : /*************************************************************************
1079 : This function adds value to S[i,j] - element of the sparse matrix. Matrix
1080 : must be in a Hash-Table mode.
1081 :
1082 : In case S[i,j] already exists in the table, V i added to its value. In
1083 : case S[i,j] is non-existent, it is inserted in the table. Table
1084 : automatically grows when necessary.
1085 :
1086 : INPUT PARAMETERS
1087 : S - sparse M*N matrix in Hash-Table representation.
1088 : Exception will be thrown for CRS matrix.
1089 : I - row index of the element to modify, 0<=I<M
1090 : J - column index of the element to modify, 0<=J<N
1091 : V - value to add, must be finite number
1092 :
1093 : OUTPUT PARAMETERS
1094 : S - modified matrix
1095 :
1096 : NOTE 1: when S[i,j] is exactly zero after modification, it is deleted
1097 : from the table.
1098 :
1099 : -- ALGLIB PROJECT --
1100 : Copyright 14.10.2011 by Bochkanov Sergey
1101 : *************************************************************************/
1102 0 : void sparseadd(const sparsematrix &s, const ae_int_t i, const ae_int_t j, const double v, const xparams _xparams)
1103 : {
1104 : jmp_buf _break_jump;
1105 : alglib_impl::ae_state _alglib_env_state;
1106 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1107 0 : if( setjmp(_break_jump) )
1108 : {
1109 : #if !defined(AE_NO_EXCEPTIONS)
1110 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1111 : #else
1112 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1113 : return;
1114 : #endif
1115 : }
1116 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1117 0 : if( _xparams.flags!=0x0 )
1118 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1119 0 : alglib_impl::sparseadd(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, j, v, &_alglib_env_state);
1120 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1121 0 : return;
1122 : }
1123 :
1124 : /*************************************************************************
1125 : This function modifies S[i,j] - element of the sparse matrix.
1126 :
1127 : For Hash-based storage format:
1128 : * this function can be called at any moment - during matrix initialization
1129 : or later
1130 : * new value can be zero or non-zero. In case new value of S[i,j] is zero,
1131 : this element is deleted from the table.
1132 : * this function has no effect when called with zero V for non-existent
1133 : element.
1134 :
1135 : For CRS-bases storage format:
1136 : * this function can be called ONLY DURING MATRIX INITIALIZATION
1137 : * zero values are stored in the matrix similarly to non-zero ones
1138 : * elements must be initialized in correct order - from top row to bottom,
1139 : within row - from left to right.
1140 :
1141 : For SKS storage:
1142 : * this function can be called at any moment - during matrix initialization
1143 : or later
1144 : * zero values are stored in the matrix similarly to non-zero ones
1145 : * this function CAN NOT be called for non-existent (outside of the band
1146 : specified during SKS matrix creation) elements. Say, if you created SKS
1147 : matrix with bandwidth=2 and tried to call sparseset(s,0,10,VAL), an
1148 : exception will be generated.
1149 :
1150 : INPUT PARAMETERS
1151 : S - sparse M*N matrix in Hash-Table, SKS or CRS format.
1152 : I - row index of the element to modify, 0<=I<M
1153 : J - column index of the element to modify, 0<=J<N
1154 : V - value to set, must be finite number, can be zero
1155 :
1156 : OUTPUT PARAMETERS
1157 : S - modified matrix
1158 :
1159 : -- ALGLIB PROJECT --
1160 : Copyright 14.10.2011 by Bochkanov Sergey
1161 : *************************************************************************/
1162 0 : void sparseset(const sparsematrix &s, const ae_int_t i, const ae_int_t j, const double v, const xparams _xparams)
1163 : {
1164 : jmp_buf _break_jump;
1165 : alglib_impl::ae_state _alglib_env_state;
1166 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1167 0 : if( setjmp(_break_jump) )
1168 : {
1169 : #if !defined(AE_NO_EXCEPTIONS)
1170 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1171 : #else
1172 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1173 : return;
1174 : #endif
1175 : }
1176 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1177 0 : if( _xparams.flags!=0x0 )
1178 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1179 0 : alglib_impl::sparseset(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, j, v, &_alglib_env_state);
1180 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1181 0 : return;
1182 : }
1183 :
1184 : /*************************************************************************
1185 : This function returns S[i,j] - element of the sparse matrix. Matrix can
1186 : be in any mode (Hash-Table, CRS, SKS), but this function is less efficient
1187 : for CRS matrices. Hash-Table and SKS matrices can find element in O(1)
1188 : time, while CRS matrices need O(log(RS)) time, where RS is an number of
1189 : non-zero elements in a row.
1190 :
1191 : INPUT PARAMETERS
1192 : S - sparse M*N matrix
1193 : I - row index of the element to modify, 0<=I<M
1194 : J - column index of the element to modify, 0<=J<N
1195 :
1196 : RESULT
1197 : value of S[I,J] or zero (in case no element with such index is found)
1198 :
1199 : -- ALGLIB PROJECT --
1200 : Copyright 14.10.2011 by Bochkanov Sergey
1201 : *************************************************************************/
1202 0 : double sparseget(const sparsematrix &s, const ae_int_t i, const ae_int_t j, const xparams _xparams)
1203 : {
1204 : jmp_buf _break_jump;
1205 : alglib_impl::ae_state _alglib_env_state;
1206 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1207 0 : if( setjmp(_break_jump) )
1208 : {
1209 : #if !defined(AE_NO_EXCEPTIONS)
1210 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1211 : #else
1212 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1213 : return 0;
1214 : #endif
1215 : }
1216 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1217 0 : if( _xparams.flags!=0x0 )
1218 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1219 0 : double result = alglib_impl::sparseget(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, j, &_alglib_env_state);
1220 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1221 0 : return *(reinterpret_cast<double*>(&result));
1222 : }
1223 :
1224 : /*************************************************************************
1225 : This function checks whether S[i,j] is present in the sparse matrix. It
1226 : returns True even for elements that are numerically zero (but still
1227 : have place allocated for them).
1228 :
1229 : The matrix can be in any mode (Hash-Table, CRS, SKS), but this function
1230 : is less efficient for CRS matrices. Hash-Table and SKS matrices can find
1231 : element in O(1) time, while CRS matrices need O(log(RS)) time, where RS
1232 : is an number of non-zero elements in a row.
1233 :
1234 : INPUT PARAMETERS
1235 : S - sparse M*N matrix
1236 : I - row index of the element to modify, 0<=I<M
1237 : J - column index of the element to modify, 0<=J<N
1238 :
1239 : RESULT
1240 : whether S[I,J] is present in the data structure or not
1241 :
1242 : -- ALGLIB PROJECT --
1243 : Copyright 14.10.2020 by Bochkanov Sergey
1244 : *************************************************************************/
1245 0 : bool sparseexists(const sparsematrix &s, const ae_int_t i, const ae_int_t j, const xparams _xparams)
1246 : {
1247 : jmp_buf _break_jump;
1248 : alglib_impl::ae_state _alglib_env_state;
1249 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1250 0 : if( setjmp(_break_jump) )
1251 : {
1252 : #if !defined(AE_NO_EXCEPTIONS)
1253 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1254 : #else
1255 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1256 : return 0;
1257 : #endif
1258 : }
1259 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1260 0 : if( _xparams.flags!=0x0 )
1261 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1262 0 : ae_bool result = alglib_impl::sparseexists(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, j, &_alglib_env_state);
1263 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1264 0 : return *(reinterpret_cast<bool*>(&result));
1265 : }
1266 :
1267 : /*************************************************************************
1268 : This function returns I-th diagonal element of the sparse matrix.
1269 :
1270 : Matrix can be in any mode (Hash-Table or CRS storage), but this function
1271 : is most efficient for CRS matrices - it requires less than 50 CPU cycles
1272 : to extract diagonal element. For Hash-Table matrices we still have O(1)
1273 : query time, but function is many times slower.
1274 :
1275 : INPUT PARAMETERS
1276 : S - sparse M*N matrix in Hash-Table representation.
1277 : Exception will be thrown for CRS matrix.
1278 : I - index of the element to modify, 0<=I<min(M,N)
1279 :
1280 : RESULT
1281 : value of S[I,I] or zero (in case no element with such index is found)
1282 :
1283 : -- ALGLIB PROJECT --
1284 : Copyright 14.10.2011 by Bochkanov Sergey
1285 : *************************************************************************/
1286 0 : double sparsegetdiagonal(const sparsematrix &s, const ae_int_t i, const xparams _xparams)
1287 : {
1288 : jmp_buf _break_jump;
1289 : alglib_impl::ae_state _alglib_env_state;
1290 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1291 0 : if( setjmp(_break_jump) )
1292 : {
1293 : #if !defined(AE_NO_EXCEPTIONS)
1294 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1295 : #else
1296 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1297 : return 0;
1298 : #endif
1299 : }
1300 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1301 0 : if( _xparams.flags!=0x0 )
1302 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1303 0 : double result = alglib_impl::sparsegetdiagonal(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, &_alglib_env_state);
1304 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1305 0 : return *(reinterpret_cast<double*>(&result));
1306 : }
1307 :
1308 : /*************************************************************************
1309 : This function calculates matrix-vector product S*x. Matrix S must be
1310 : stored in CRS or SKS format (exception will be thrown otherwise).
1311 :
1312 : INPUT PARAMETERS
1313 : S - sparse M*N matrix in CRS or SKS format.
1314 : X - array[N], input vector. For performance reasons we
1315 : make only quick checks - we check that array size is
1316 : at least N, but we do not check for NAN's or INF's.
1317 : Y - output buffer, possibly preallocated. In case buffer
1318 : size is too small to store result, this buffer is
1319 : automatically resized.
1320 :
1321 : OUTPUT PARAMETERS
1322 : Y - array[M], S*x
1323 :
1324 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1325 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1326 : this function.
1327 :
1328 : -- ALGLIB PROJECT --
1329 : Copyright 14.10.2011 by Bochkanov Sergey
1330 : *************************************************************************/
1331 0 : void sparsemv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y, const xparams _xparams)
1332 : {
1333 : jmp_buf _break_jump;
1334 : alglib_impl::ae_state _alglib_env_state;
1335 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1336 0 : if( setjmp(_break_jump) )
1337 : {
1338 : #if !defined(AE_NO_EXCEPTIONS)
1339 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1340 : #else
1341 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1342 : return;
1343 : #endif
1344 : }
1345 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1346 0 : if( _xparams.flags!=0x0 )
1347 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1348 0 : alglib_impl::sparsemv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(y.c_ptr()), &_alglib_env_state);
1349 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1350 0 : return;
1351 : }
1352 :
1353 : /*************************************************************************
1354 : This function calculates matrix-vector product S^T*x. Matrix S must be
1355 : stored in CRS or SKS format (exception will be thrown otherwise).
1356 :
1357 : INPUT PARAMETERS
1358 : S - sparse M*N matrix in CRS or SKS format.
1359 : X - array[M], input vector. For performance reasons we
1360 : make only quick checks - we check that array size is
1361 : at least M, but we do not check for NAN's or INF's.
1362 : Y - output buffer, possibly preallocated. In case buffer
1363 : size is too small to store result, this buffer is
1364 : automatically resized.
1365 :
1366 : OUTPUT PARAMETERS
1367 : Y - array[N], S^T*x
1368 :
1369 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1370 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1371 : this function.
1372 :
1373 : -- ALGLIB PROJECT --
1374 : Copyright 14.10.2011 by Bochkanov Sergey
1375 : *************************************************************************/
1376 0 : void sparsemtv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y, const xparams _xparams)
1377 : {
1378 : jmp_buf _break_jump;
1379 : alglib_impl::ae_state _alglib_env_state;
1380 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1381 0 : if( setjmp(_break_jump) )
1382 : {
1383 : #if !defined(AE_NO_EXCEPTIONS)
1384 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1385 : #else
1386 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1387 : return;
1388 : #endif
1389 : }
1390 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1391 0 : if( _xparams.flags!=0x0 )
1392 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1393 0 : alglib_impl::sparsemtv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(y.c_ptr()), &_alglib_env_state);
1394 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1395 0 : return;
1396 : }
1397 :
1398 : /*************************************************************************
1399 : This function calculates generalized sparse matrix-vector product
1400 :
1401 : y := alpha*op(S)*x + beta*y
1402 :
1403 : Matrix S must be stored in CRS or SKS format (exception will be thrown
1404 : otherwise). op(S) can be either S or S^T.
1405 :
1406 : NOTE: this function expects Y to be large enough to store result. No
1407 : automatic preallocation happens for smaller arrays.
1408 :
1409 : INPUT PARAMETERS
1410 : S - sparse matrix in CRS or SKS format.
1411 : Alpha - source coefficient
1412 : OpS - operation type:
1413 : * OpS=0 => op(S) = S
1414 : * OpS=1 => op(S) = S^T
1415 : X - input vector, must have at least Cols(op(S))+IX elements
1416 : IX - subvector offset
1417 : Beta - destination coefficient
1418 : Y - preallocated output array, must have at least Rows(op(S))+IY elements
1419 : IY - subvector offset
1420 :
1421 : OUTPUT PARAMETERS
1422 : Y - elements [IY...IY+Rows(op(S))-1] are replaced by result,
1423 : other elements are not modified
1424 :
1425 : HANDLING OF SPECIAL CASES:
1426 : * below M=Rows(op(S)) and N=Cols(op(S)). Although current ALGLIB version
1427 : does not allow you to create zero-sized sparse matrices, internally
1428 : ALGLIB can deal with such matrices. So, comments for M or N equal to
1429 : zero are for internal use only.
1430 : * if M=0, then subroutine does nothing. It does not even touch arrays.
1431 : * if N=0 or Alpha=0.0, then:
1432 : * if Beta=0, then Y is filled by zeros. S and X are not referenced at
1433 : all. Initial values of Y are ignored (we do not multiply Y by zero,
1434 : we just rewrite it by zeros)
1435 : * if Beta<>0, then Y is replaced by Beta*Y
1436 : * if M>0, N>0, Alpha<>0, but Beta=0, then Y is replaced by alpha*op(S)*x
1437 : initial state of Y is ignored (rewritten without initial multiplication
1438 : by zeros).
1439 :
1440 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1441 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1442 : this function.
1443 :
1444 : -- ALGLIB PROJECT --
1445 : Copyright 10.12.2019 by Bochkanov Sergey
1446 : *************************************************************************/
1447 0 : void sparsegemv(const sparsematrix &s, const double alpha, const ae_int_t ops, const real_1d_array &x, const ae_int_t ix, const double beta, const real_1d_array &y, const ae_int_t iy, const xparams _xparams)
1448 : {
1449 : jmp_buf _break_jump;
1450 : alglib_impl::ae_state _alglib_env_state;
1451 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1452 0 : if( setjmp(_break_jump) )
1453 : {
1454 : #if !defined(AE_NO_EXCEPTIONS)
1455 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1456 : #else
1457 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1458 : return;
1459 : #endif
1460 : }
1461 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1462 0 : if( _xparams.flags!=0x0 )
1463 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1464 0 : alglib_impl::sparsegemv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), alpha, ops, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, beta, const_cast<alglib_impl::ae_vector*>(y.c_ptr()), iy, &_alglib_env_state);
1465 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1466 0 : return;
1467 : }
1468 :
1469 : /*************************************************************************
1470 : This function simultaneously calculates two matrix-vector products:
1471 : S*x and S^T*x.
1472 : S must be square (non-rectangular) matrix stored in CRS or SKS format
1473 : (exception will be thrown otherwise).
1474 :
1475 : INPUT PARAMETERS
1476 : S - sparse N*N matrix in CRS or SKS format.
1477 : X - array[N], input vector. For performance reasons we
1478 : make only quick checks - we check that array size is
1479 : at least N, but we do not check for NAN's or INF's.
1480 : Y0 - output buffer, possibly preallocated. In case buffer
1481 : size is too small to store result, this buffer is
1482 : automatically resized.
1483 : Y1 - output buffer, possibly preallocated. In case buffer
1484 : size is too small to store result, this buffer is
1485 : automatically resized.
1486 :
1487 : OUTPUT PARAMETERS
1488 : Y0 - array[N], S*x
1489 : Y1 - array[N], S^T*x
1490 :
1491 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1492 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1493 : this function.
1494 :
1495 : -- ALGLIB PROJECT --
1496 : Copyright 14.10.2011 by Bochkanov Sergey
1497 : *************************************************************************/
1498 0 : void sparsemv2(const sparsematrix &s, const real_1d_array &x, real_1d_array &y0, real_1d_array &y1, const xparams _xparams)
1499 : {
1500 : jmp_buf _break_jump;
1501 : alglib_impl::ae_state _alglib_env_state;
1502 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1503 0 : if( setjmp(_break_jump) )
1504 : {
1505 : #if !defined(AE_NO_EXCEPTIONS)
1506 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1507 : #else
1508 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1509 : return;
1510 : #endif
1511 : }
1512 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1513 0 : if( _xparams.flags!=0x0 )
1514 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1515 0 : alglib_impl::sparsemv2(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(y0.c_ptr()), const_cast<alglib_impl::ae_vector*>(y1.c_ptr()), &_alglib_env_state);
1516 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1517 0 : return;
1518 : }
1519 :
1520 : /*************************************************************************
1521 : This function calculates matrix-vector product S*x, when S is symmetric
1522 : matrix. Matrix S must be stored in CRS or SKS format (exception will be
1523 : thrown otherwise).
1524 :
1525 : INPUT PARAMETERS
1526 : S - sparse M*M matrix in CRS or SKS format.
1527 : IsUpper - whether upper or lower triangle of S is given:
1528 : * if upper triangle is given, only S[i,j] for j>=i
1529 : are used, and lower triangle is ignored (it can be
1530 : empty - these elements are not referenced at all).
1531 : * if lower triangle is given, only S[i,j] for j<=i
1532 : are used, and upper triangle is ignored.
1533 : X - array[N], input vector. For performance reasons we
1534 : make only quick checks - we check that array size is
1535 : at least N, but we do not check for NAN's or INF's.
1536 : Y - output buffer, possibly preallocated. In case buffer
1537 : size is too small to store result, this buffer is
1538 : automatically resized.
1539 :
1540 : OUTPUT PARAMETERS
1541 : Y - array[M], S*x
1542 :
1543 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1544 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1545 : this function.
1546 :
1547 : -- ALGLIB PROJECT --
1548 : Copyright 14.10.2011 by Bochkanov Sergey
1549 : *************************************************************************/
1550 0 : void sparsesmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, real_1d_array &y, const xparams _xparams)
1551 : {
1552 : jmp_buf _break_jump;
1553 : alglib_impl::ae_state _alglib_env_state;
1554 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1555 0 : if( setjmp(_break_jump) )
1556 : {
1557 : #if !defined(AE_NO_EXCEPTIONS)
1558 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1559 : #else
1560 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1561 : return;
1562 : #endif
1563 : }
1564 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1565 0 : if( _xparams.flags!=0x0 )
1566 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1567 0 : alglib_impl::sparsesmv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(y.c_ptr()), &_alglib_env_state);
1568 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1569 0 : return;
1570 : }
1571 :
1572 : /*************************************************************************
1573 : This function calculates vector-matrix-vector product x'*S*x, where S is
1574 : symmetric matrix. Matrix S must be stored in CRS or SKS format (exception
1575 : will be thrown otherwise).
1576 :
1577 : INPUT PARAMETERS
1578 : S - sparse M*M matrix in CRS or SKS format.
1579 : IsUpper - whether upper or lower triangle of S is given:
1580 : * if upper triangle is given, only S[i,j] for j>=i
1581 : are used, and lower triangle is ignored (it can be
1582 : empty - these elements are not referenced at all).
1583 : * if lower triangle is given, only S[i,j] for j<=i
1584 : are used, and upper triangle is ignored.
1585 : X - array[N], input vector. For performance reasons we
1586 : make only quick checks - we check that array size is
1587 : at least N, but we do not check for NAN's or INF's.
1588 :
1589 : RESULT
1590 : x'*S*x
1591 :
1592 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1593 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1594 : this function.
1595 :
1596 : -- ALGLIB PROJECT --
1597 : Copyright 27.01.2014 by Bochkanov Sergey
1598 : *************************************************************************/
1599 0 : double sparsevsmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, const xparams _xparams)
1600 : {
1601 : jmp_buf _break_jump;
1602 : alglib_impl::ae_state _alglib_env_state;
1603 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1604 0 : if( setjmp(_break_jump) )
1605 : {
1606 : #if !defined(AE_NO_EXCEPTIONS)
1607 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1608 : #else
1609 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1610 : return 0;
1611 : #endif
1612 : }
1613 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1614 0 : if( _xparams.flags!=0x0 )
1615 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1616 0 : double result = alglib_impl::sparsevsmv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), &_alglib_env_state);
1617 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1618 0 : return *(reinterpret_cast<double*>(&result));
1619 : }
1620 :
1621 : /*************************************************************************
1622 : This function calculates matrix-matrix product S*A. Matrix S must be
1623 : stored in CRS or SKS format (exception will be thrown otherwise).
1624 :
1625 : INPUT PARAMETERS
1626 : S - sparse M*N matrix in CRS or SKS format.
1627 : A - array[N][K], input dense matrix. For performance reasons
1628 : we make only quick checks - we check that array size
1629 : is at least N, but we do not check for NAN's or INF's.
1630 : K - number of columns of matrix (A).
1631 : B - output buffer, possibly preallocated. In case buffer
1632 : size is too small to store result, this buffer is
1633 : automatically resized.
1634 :
1635 : OUTPUT PARAMETERS
1636 : B - array[M][K], S*A
1637 :
1638 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1639 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1640 : this function.
1641 :
1642 : -- ALGLIB PROJECT --
1643 : Copyright 14.10.2011 by Bochkanov Sergey
1644 : *************************************************************************/
1645 0 : void sparsemm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b, const xparams _xparams)
1646 : {
1647 : jmp_buf _break_jump;
1648 : alglib_impl::ae_state _alglib_env_state;
1649 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1650 0 : if( setjmp(_break_jump) )
1651 : {
1652 : #if !defined(AE_NO_EXCEPTIONS)
1653 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1654 : #else
1655 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1656 : return;
1657 : #endif
1658 : }
1659 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1660 0 : if( _xparams.flags!=0x0 )
1661 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1662 0 : alglib_impl::sparsemm(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), k, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), &_alglib_env_state);
1663 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1664 0 : return;
1665 : }
1666 :
1667 : /*************************************************************************
1668 : This function calculates matrix-matrix product S^T*A. Matrix S must be
1669 : stored in CRS or SKS format (exception will be thrown otherwise).
1670 :
1671 : INPUT PARAMETERS
1672 : S - sparse M*N matrix in CRS or SKS format.
1673 : A - array[M][K], input dense matrix. For performance reasons
1674 : we make only quick checks - we check that array size is
1675 : at least M, but we do not check for NAN's or INF's.
1676 : K - number of columns of matrix (A).
1677 : B - output buffer, possibly preallocated. In case buffer
1678 : size is too small to store result, this buffer is
1679 : automatically resized.
1680 :
1681 : OUTPUT PARAMETERS
1682 : B - array[N][K], S^T*A
1683 :
1684 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1685 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1686 : this function.
1687 :
1688 : -- ALGLIB PROJECT --
1689 : Copyright 14.10.2011 by Bochkanov Sergey
1690 : *************************************************************************/
1691 0 : void sparsemtm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b, const xparams _xparams)
1692 : {
1693 : jmp_buf _break_jump;
1694 : alglib_impl::ae_state _alglib_env_state;
1695 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1696 0 : if( setjmp(_break_jump) )
1697 : {
1698 : #if !defined(AE_NO_EXCEPTIONS)
1699 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1700 : #else
1701 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1702 : return;
1703 : #endif
1704 : }
1705 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1706 0 : if( _xparams.flags!=0x0 )
1707 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1708 0 : alglib_impl::sparsemtm(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), k, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), &_alglib_env_state);
1709 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1710 0 : return;
1711 : }
1712 :
1713 : /*************************************************************************
1714 : This function simultaneously calculates two matrix-matrix products:
1715 : S*A and S^T*A.
1716 : S must be square (non-rectangular) matrix stored in CRS or SKS format
1717 : (exception will be thrown otherwise).
1718 :
1719 : INPUT PARAMETERS
1720 : S - sparse N*N matrix in CRS or SKS format.
1721 : A - array[N][K], input dense matrix. For performance reasons
1722 : we make only quick checks - we check that array size is
1723 : at least N, but we do not check for NAN's or INF's.
1724 : K - number of columns of matrix (A).
1725 : B0 - output buffer, possibly preallocated. In case buffer
1726 : size is too small to store result, this buffer is
1727 : automatically resized.
1728 : B1 - output buffer, possibly preallocated. In case buffer
1729 : size is too small to store result, this buffer is
1730 : automatically resized.
1731 :
1732 : OUTPUT PARAMETERS
1733 : B0 - array[N][K], S*A
1734 : B1 - array[N][K], S^T*A
1735 :
1736 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1737 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1738 : this function.
1739 :
1740 : -- ALGLIB PROJECT --
1741 : Copyright 14.10.2011 by Bochkanov Sergey
1742 : *************************************************************************/
1743 0 : void sparsemm2(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b0, real_2d_array &b1, const xparams _xparams)
1744 : {
1745 : jmp_buf _break_jump;
1746 : alglib_impl::ae_state _alglib_env_state;
1747 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1748 0 : if( setjmp(_break_jump) )
1749 : {
1750 : #if !defined(AE_NO_EXCEPTIONS)
1751 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1752 : #else
1753 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1754 : return;
1755 : #endif
1756 : }
1757 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1758 0 : if( _xparams.flags!=0x0 )
1759 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1760 0 : alglib_impl::sparsemm2(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), k, const_cast<alglib_impl::ae_matrix*>(b0.c_ptr()), const_cast<alglib_impl::ae_matrix*>(b1.c_ptr()), &_alglib_env_state);
1761 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1762 0 : return;
1763 : }
1764 :
1765 : /*************************************************************************
1766 : This function calculates matrix-matrix product S*A, when S is symmetric
1767 : matrix. Matrix S must be stored in CRS or SKS format (exception will be
1768 : thrown otherwise).
1769 :
1770 : INPUT PARAMETERS
1771 : S - sparse M*M matrix in CRS or SKS format.
1772 : IsUpper - whether upper or lower triangle of S is given:
1773 : * if upper triangle is given, only S[i,j] for j>=i
1774 : are used, and lower triangle is ignored (it can be
1775 : empty - these elements are not referenced at all).
1776 : * if lower triangle is given, only S[i,j] for j<=i
1777 : are used, and upper triangle is ignored.
1778 : A - array[N][K], input dense matrix. For performance reasons
1779 : we make only quick checks - we check that array size is
1780 : at least N, but we do not check for NAN's or INF's.
1781 : K - number of columns of matrix (A).
1782 : B - output buffer, possibly preallocated. In case buffer
1783 : size is too small to store result, this buffer is
1784 : automatically resized.
1785 :
1786 : OUTPUT PARAMETERS
1787 : B - array[M][K], S*A
1788 :
1789 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1790 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1791 : this function.
1792 :
1793 : -- ALGLIB PROJECT --
1794 : Copyright 14.10.2011 by Bochkanov Sergey
1795 : *************************************************************************/
1796 0 : void sparsesmm(const sparsematrix &s, const bool isupper, const real_2d_array &a, const ae_int_t k, real_2d_array &b, const xparams _xparams)
1797 : {
1798 : jmp_buf _break_jump;
1799 : alglib_impl::ae_state _alglib_env_state;
1800 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1801 0 : if( setjmp(_break_jump) )
1802 : {
1803 : #if !defined(AE_NO_EXCEPTIONS)
1804 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1805 : #else
1806 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1807 : return;
1808 : #endif
1809 : }
1810 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1811 0 : if( _xparams.flags!=0x0 )
1812 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1813 0 : alglib_impl::sparsesmm(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), isupper, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), k, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), &_alglib_env_state);
1814 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1815 0 : return;
1816 : }
1817 :
1818 : /*************************************************************************
1819 : This function calculates matrix-vector product op(S)*x, when x is vector,
1820 : S is symmetric triangular matrix, op(S) is transposition or no operation.
1821 : Matrix S must be stored in CRS or SKS format (exception will be thrown
1822 : otherwise).
1823 :
1824 : INPUT PARAMETERS
1825 : S - sparse square matrix in CRS or SKS format.
1826 : IsUpper - whether upper or lower triangle of S is used:
1827 : * if upper triangle is given, only S[i,j] for j>=i
1828 : are used, and lower triangle is ignored (it can be
1829 : empty - these elements are not referenced at all).
1830 : * if lower triangle is given, only S[i,j] for j<=i
1831 : are used, and upper triangle is ignored.
1832 : IsUnit - unit or non-unit diagonal:
1833 : * if True, diagonal elements of triangular matrix are
1834 : considered equal to 1.0. Actual elements stored in
1835 : S are not referenced at all.
1836 : * if False, diagonal stored in S is used
1837 : OpType - operation type:
1838 : * if 0, S*x is calculated
1839 : * if 1, (S^T)*x is calculated (transposition)
1840 : X - array[N] which stores input vector. For performance
1841 : reasons we make only quick checks - we check that
1842 : array size is at least N, but we do not check for
1843 : NAN's or INF's.
1844 : Y - possibly preallocated input buffer. Automatically
1845 : resized if its size is too small.
1846 :
1847 : OUTPUT PARAMETERS
1848 : Y - array[N], op(S)*x
1849 :
1850 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1851 : You must convert your matrix with SparseConvertToCRS/SKS() before using
1852 : this function.
1853 :
1854 : -- ALGLIB PROJECT --
1855 : Copyright 20.01.2014 by Bochkanov Sergey
1856 : *************************************************************************/
1857 0 : void sparsetrmv(const sparsematrix &s, const bool isupper, const bool isunit, const ae_int_t optype, const real_1d_array &x, real_1d_array &y, const xparams _xparams)
1858 : {
1859 : jmp_buf _break_jump;
1860 : alglib_impl::ae_state _alglib_env_state;
1861 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1862 0 : if( setjmp(_break_jump) )
1863 : {
1864 : #if !defined(AE_NO_EXCEPTIONS)
1865 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1866 : #else
1867 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1868 : return;
1869 : #endif
1870 : }
1871 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1872 0 : if( _xparams.flags!=0x0 )
1873 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1874 0 : alglib_impl::sparsetrmv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), isupper, isunit, optype, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), const_cast<alglib_impl::ae_vector*>(y.c_ptr()), &_alglib_env_state);
1875 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1876 0 : return;
1877 : }
1878 :
1879 : /*************************************************************************
1880 : This function solves linear system op(S)*y=x where x is vector, S is
1881 : symmetric triangular matrix, op(S) is transposition or no operation.
1882 : Matrix S must be stored in CRS or SKS format (exception will be thrown
1883 : otherwise).
1884 :
1885 : INPUT PARAMETERS
1886 : S - sparse square matrix in CRS or SKS format.
1887 : IsUpper - whether upper or lower triangle of S is used:
1888 : * if upper triangle is given, only S[i,j] for j>=i
1889 : are used, and lower triangle is ignored (it can be
1890 : empty - these elements are not referenced at all).
1891 : * if lower triangle is given, only S[i,j] for j<=i
1892 : are used, and upper triangle is ignored.
1893 : IsUnit - unit or non-unit diagonal:
1894 : * if True, diagonal elements of triangular matrix are
1895 : considered equal to 1.0. Actual elements stored in
1896 : S are not referenced at all.
1897 : * if False, diagonal stored in S is used. It is your
1898 : responsibility to make sure that diagonal is
1899 : non-zero.
1900 : OpType - operation type:
1901 : * if 0, S*x is calculated
1902 : * if 1, (S^T)*x is calculated (transposition)
1903 : X - array[N] which stores input vector. For performance
1904 : reasons we make only quick checks - we check that
1905 : array size is at least N, but we do not check for
1906 : NAN's or INF's.
1907 :
1908 : OUTPUT PARAMETERS
1909 : X - array[N], inv(op(S))*x
1910 :
1911 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
1912 : You must convert your matrix with SparseConvertToCRS/SKS() before
1913 : using this function.
1914 :
1915 : NOTE: no assertion or tests are done during algorithm operation. It is
1916 : your responsibility to provide invertible matrix to algorithm.
1917 :
1918 : -- ALGLIB PROJECT --
1919 : Copyright 20.01.2014 by Bochkanov Sergey
1920 : *************************************************************************/
1921 0 : void sparsetrsv(const sparsematrix &s, const bool isupper, const bool isunit, const ae_int_t optype, const real_1d_array &x, const xparams _xparams)
1922 : {
1923 : jmp_buf _break_jump;
1924 : alglib_impl::ae_state _alglib_env_state;
1925 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1926 0 : if( setjmp(_break_jump) )
1927 : {
1928 : #if !defined(AE_NO_EXCEPTIONS)
1929 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1930 : #else
1931 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1932 : return;
1933 : #endif
1934 : }
1935 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1936 0 : if( _xparams.flags!=0x0 )
1937 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1938 0 : alglib_impl::sparsetrsv(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), isupper, isunit, optype, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), &_alglib_env_state);
1939 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1940 0 : return;
1941 : }
1942 :
1943 : /*************************************************************************
1944 : This function applies permutation given by permutation table P (as opposed
1945 : to product form of permutation) to sparse symmetric matrix A, given by
1946 : either upper or lower triangle: B := P*A*P'.
1947 :
1948 : This function allocates completely new instance of B. Use buffered version
1949 : SparseSymmPermTblBuf() if you want to reuse already allocated structure.
1950 :
1951 : INPUT PARAMETERS
1952 : A - sparse square matrix in CRS format.
1953 : IsUpper - whether upper or lower triangle of A is used:
1954 : * if upper triangle is given, only A[i,j] for j>=i
1955 : are used, and lower triangle is ignored (it can be
1956 : empty - these elements are not referenced at all).
1957 : * if lower triangle is given, only A[i,j] for j<=i
1958 : are used, and upper triangle is ignored.
1959 : P - array[N] which stores permutation table; P[I]=J means
1960 : that I-th row/column of matrix A is moved to J-th
1961 : position. For performance reasons we do NOT check that
1962 : P[] is a correct permutation (that there is no
1963 : repetitions, just that all its elements are in [0,N)
1964 : range.
1965 :
1966 : OUTPUT PARAMETERS
1967 : B - permuted matrix. Permutation is applied to A from
1968 : the both sides, only upper or lower triangle (depending
1969 : on IsUpper) is stored.
1970 :
1971 : NOTE: this function throws exception when called for non-CRS matrix. You
1972 : must convert your matrix with SparseConvertToCRS() before using this
1973 : function.
1974 :
1975 : -- ALGLIB PROJECT --
1976 : Copyright 05.10.2020 by Bochkanov Sergey.
1977 : *************************************************************************/
1978 0 : void sparsesymmpermtbl(const sparsematrix &a, const bool isupper, const integer_1d_array &p, sparsematrix &b, const xparams _xparams)
1979 : {
1980 : jmp_buf _break_jump;
1981 : alglib_impl::ae_state _alglib_env_state;
1982 0 : alglib_impl::ae_state_init(&_alglib_env_state);
1983 0 : if( setjmp(_break_jump) )
1984 : {
1985 : #if !defined(AE_NO_EXCEPTIONS)
1986 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
1987 : #else
1988 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
1989 : return;
1990 : #endif
1991 : }
1992 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
1993 0 : if( _xparams.flags!=0x0 )
1994 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
1995 0 : alglib_impl::sparsesymmpermtbl(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(p.c_ptr()), const_cast<alglib_impl::sparsematrix*>(b.c_ptr()), &_alglib_env_state);
1996 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
1997 0 : return;
1998 : }
1999 :
2000 : /*************************************************************************
2001 : This function is a buffered version of SparseSymmPermTbl() that reuses
2002 : previously allocated storage in B as much as possible.
2003 :
2004 : This function applies permutation given by permutation table P (as opposed
2005 : to product form of permutation) to sparse symmetric matrix A, given by
2006 : either upper or lower triangle: B := P*A*P'.
2007 :
2008 : INPUT PARAMETERS
2009 : A - sparse square matrix in CRS format.
2010 : IsUpper - whether upper or lower triangle of A is used:
2011 : * if upper triangle is given, only A[i,j] for j>=i
2012 : are used, and lower triangle is ignored (it can be
2013 : empty - these elements are not referenced at all).
2014 : * if lower triangle is given, only A[i,j] for j<=i
2015 : are used, and upper triangle is ignored.
2016 : P - array[N] which stores permutation table; P[I]=J means
2017 : that I-th row/column of matrix A is moved to J-th
2018 : position. For performance reasons we do NOT check that
2019 : P[] is a correct permutation (that there is no
2020 : repetitions, just that all its elements are in [0,N)
2021 : range.
2022 : B - sparse matrix object that will hold output.
2023 : Previously allocated memory will be reused as much as
2024 : possible.
2025 :
2026 : OUTPUT PARAMETERS
2027 : B - permuted matrix. Permutation is applied to A from
2028 : the both sides, only upper or lower triangle (depending
2029 : on IsUpper) is stored.
2030 :
2031 : NOTE: this function throws exception when called for non-CRS matrix. You
2032 : must convert your matrix with SparseConvertToCRS() before using this
2033 : function.
2034 :
2035 : -- ALGLIB PROJECT --
2036 : Copyright 05.10.2020 by Bochkanov Sergey.
2037 : *************************************************************************/
2038 0 : void sparsesymmpermtblbuf(const sparsematrix &a, const bool isupper, const integer_1d_array &p, const sparsematrix &b, const xparams _xparams)
2039 : {
2040 : jmp_buf _break_jump;
2041 : alglib_impl::ae_state _alglib_env_state;
2042 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2043 0 : if( setjmp(_break_jump) )
2044 : {
2045 : #if !defined(AE_NO_EXCEPTIONS)
2046 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2047 : #else
2048 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2049 : return;
2050 : #endif
2051 : }
2052 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2053 0 : if( _xparams.flags!=0x0 )
2054 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2055 0 : alglib_impl::sparsesymmpermtblbuf(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(p.c_ptr()), const_cast<alglib_impl::sparsematrix*>(b.c_ptr()), &_alglib_env_state);
2056 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2057 0 : return;
2058 : }
2059 :
2060 : /*************************************************************************
2061 : This procedure resizes Hash-Table matrix. It can be called when you have
2062 : deleted too many elements from the matrix, and you want to free unneeded
2063 : memory.
2064 :
2065 : -- ALGLIB PROJECT --
2066 : Copyright 14.10.2011 by Bochkanov Sergey
2067 : *************************************************************************/
2068 0 : void sparseresizematrix(const sparsematrix &s, const xparams _xparams)
2069 : {
2070 : jmp_buf _break_jump;
2071 : alglib_impl::ae_state _alglib_env_state;
2072 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2073 0 : if( setjmp(_break_jump) )
2074 : {
2075 : #if !defined(AE_NO_EXCEPTIONS)
2076 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2077 : #else
2078 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2079 : return;
2080 : #endif
2081 : }
2082 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2083 0 : if( _xparams.flags!=0x0 )
2084 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2085 0 : alglib_impl::sparseresizematrix(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2086 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2087 0 : return;
2088 : }
2089 :
2090 : /*************************************************************************
2091 : This function is used to enumerate all elements of the sparse matrix.
2092 : Before first call user initializes T0 and T1 counters by zero. These
2093 : counters are used to remember current position in a matrix; after each
2094 : call they are updated by the function.
2095 :
2096 : Subsequent calls to this function return non-zero elements of the sparse
2097 : matrix, one by one. If you enumerate CRS matrix, matrix is traversed from
2098 : left to right, from top to bottom. In case you enumerate matrix stored as
2099 : Hash table, elements are returned in random order.
2100 :
2101 : EXAMPLE
2102 : > T0=0
2103 : > T1=0
2104 : > while SparseEnumerate(S,T0,T1,I,J,V) do
2105 : > ....do something with I,J,V
2106 :
2107 : INPUT PARAMETERS
2108 : S - sparse M*N matrix in Hash-Table or CRS representation.
2109 : T0 - internal counter
2110 : T1 - internal counter
2111 :
2112 : OUTPUT PARAMETERS
2113 : T0 - new value of the internal counter
2114 : T1 - new value of the internal counter
2115 : I - row index of non-zero element, 0<=I<M.
2116 : J - column index of non-zero element, 0<=J<N
2117 : V - value of the T-th element
2118 :
2119 : RESULT
2120 : True in case of success (next non-zero element was retrieved)
2121 : False in case all non-zero elements were enumerated
2122 :
2123 : NOTE: you may call SparseRewriteExisting() during enumeration, but it is
2124 : THE ONLY matrix modification function you can call!!! Other
2125 : matrix modification functions should not be called during enumeration!
2126 :
2127 : -- ALGLIB PROJECT --
2128 : Copyright 14.03.2012 by Bochkanov Sergey
2129 : *************************************************************************/
2130 0 : bool sparseenumerate(const sparsematrix &s, ae_int_t &t0, ae_int_t &t1, ae_int_t &i, ae_int_t &j, double &v, const xparams _xparams)
2131 : {
2132 : jmp_buf _break_jump;
2133 : alglib_impl::ae_state _alglib_env_state;
2134 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2135 0 : if( setjmp(_break_jump) )
2136 : {
2137 : #if !defined(AE_NO_EXCEPTIONS)
2138 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2139 : #else
2140 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2141 : return 0;
2142 : #endif
2143 : }
2144 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2145 0 : if( _xparams.flags!=0x0 )
2146 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2147 0 : ae_bool result = alglib_impl::sparseenumerate(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &t0, &t1, &i, &j, &v, &_alglib_env_state);
2148 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2149 0 : return *(reinterpret_cast<bool*>(&result));
2150 : }
2151 :
2152 : /*************************************************************************
2153 : This function rewrites existing (non-zero) element. It returns True if
2154 : element exists or False, when it is called for non-existing (zero)
2155 : element.
2156 :
2157 : This function works with any kind of the matrix.
2158 :
2159 : The purpose of this function is to provide convenient thread-safe way to
2160 : modify sparse matrix. Such modification (already existing element is
2161 : rewritten) is guaranteed to be thread-safe without any synchronization, as
2162 : long as different threads modify different elements.
2163 :
2164 : INPUT PARAMETERS
2165 : S - sparse M*N matrix in any kind of representation
2166 : (Hash, SKS, CRS).
2167 : I - row index of non-zero element to modify, 0<=I<M
2168 : J - column index of non-zero element to modify, 0<=J<N
2169 : V - value to rewrite, must be finite number
2170 :
2171 : OUTPUT PARAMETERS
2172 : S - modified matrix
2173 : RESULT
2174 : True in case when element exists
2175 : False in case when element doesn't exist or it is zero
2176 :
2177 : -- ALGLIB PROJECT --
2178 : Copyright 14.03.2012 by Bochkanov Sergey
2179 : *************************************************************************/
2180 0 : bool sparserewriteexisting(const sparsematrix &s, const ae_int_t i, const ae_int_t j, const double v, const xparams _xparams)
2181 : {
2182 : jmp_buf _break_jump;
2183 : alglib_impl::ae_state _alglib_env_state;
2184 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2185 0 : if( setjmp(_break_jump) )
2186 : {
2187 : #if !defined(AE_NO_EXCEPTIONS)
2188 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2189 : #else
2190 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2191 : return 0;
2192 : #endif
2193 : }
2194 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2195 0 : if( _xparams.flags!=0x0 )
2196 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2197 0 : ae_bool result = alglib_impl::sparserewriteexisting(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, j, v, &_alglib_env_state);
2198 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2199 0 : return *(reinterpret_cast<bool*>(&result));
2200 : }
2201 :
2202 : /*************************************************************************
2203 : This function returns I-th row of the sparse matrix. Matrix must be stored
2204 : in CRS or SKS format.
2205 :
2206 : INPUT PARAMETERS:
2207 : S - sparse M*N matrix in CRS format
2208 : I - row index, 0<=I<M
2209 : IRow - output buffer, can be preallocated. In case buffer
2210 : size is too small to store I-th row, it is
2211 : automatically reallocated.
2212 :
2213 : OUTPUT PARAMETERS:
2214 : IRow - array[M], I-th row.
2215 :
2216 : NOTE: this function has O(N) running time, where N is a column count. It
2217 : allocates and fills N-element array, even although most of its
2218 : elemets are zero.
2219 :
2220 : NOTE: If you have O(non-zeros-per-row) time and memory requirements, use
2221 : SparseGetCompressedRow() function. It returns data in compressed
2222 : format.
2223 :
2224 : NOTE: when incorrect I (outside of [0,M-1]) or matrix (non CRS/SKS)
2225 : is passed, this function throws exception.
2226 :
2227 : -- ALGLIB PROJECT --
2228 : Copyright 10.12.2014 by Bochkanov Sergey
2229 : *************************************************************************/
2230 0 : void sparsegetrow(const sparsematrix &s, const ae_int_t i, real_1d_array &irow, const xparams _xparams)
2231 : {
2232 : jmp_buf _break_jump;
2233 : alglib_impl::ae_state _alglib_env_state;
2234 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2235 0 : if( setjmp(_break_jump) )
2236 : {
2237 : #if !defined(AE_NO_EXCEPTIONS)
2238 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2239 : #else
2240 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2241 : return;
2242 : #endif
2243 : }
2244 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2245 0 : if( _xparams.flags!=0x0 )
2246 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2247 0 : alglib_impl::sparsegetrow(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, const_cast<alglib_impl::ae_vector*>(irow.c_ptr()), &_alglib_env_state);
2248 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2249 0 : return;
2250 : }
2251 :
2252 : /*************************************************************************
2253 : This function returns I-th row of the sparse matrix IN COMPRESSED FORMAT -
2254 : only non-zero elements are returned (with their indexes). Matrix must be
2255 : stored in CRS or SKS format.
2256 :
2257 : INPUT PARAMETERS:
2258 : S - sparse M*N matrix in CRS format
2259 : I - row index, 0<=I<M
2260 : ColIdx - output buffer for column indexes, can be preallocated.
2261 : In case buffer size is too small to store I-th row, it
2262 : is automatically reallocated.
2263 : Vals - output buffer for values, can be preallocated. In case
2264 : buffer size is too small to store I-th row, it is
2265 : automatically reallocated.
2266 :
2267 : OUTPUT PARAMETERS:
2268 : ColIdx - column indexes of non-zero elements, sorted by
2269 : ascending. Symbolically non-zero elements are counted
2270 : (i.e. if you allocated place for element, but it has
2271 : zero numerical value - it is counted).
2272 : Vals - values. Vals[K] stores value of matrix element with
2273 : indexes (I,ColIdx[K]). Symbolically non-zero elements
2274 : are counted (i.e. if you allocated place for element,
2275 : but it has zero numerical value - it is counted).
2276 : NZCnt - number of symbolically non-zero elements per row.
2277 :
2278 : NOTE: when incorrect I (outside of [0,M-1]) or matrix (non CRS/SKS)
2279 : is passed, this function throws exception.
2280 :
2281 : NOTE: this function may allocate additional, unnecessary place for ColIdx
2282 : and Vals arrays. It is dictated by performance reasons - on SKS
2283 : matrices it is faster to allocate space at the beginning with
2284 : some "extra"-space, than performing two passes over matrix - first
2285 : time to calculate exact space required for data, second time - to
2286 : store data itself.
2287 :
2288 : -- ALGLIB PROJECT --
2289 : Copyright 10.12.2014 by Bochkanov Sergey
2290 : *************************************************************************/
2291 0 : void sparsegetcompressedrow(const sparsematrix &s, const ae_int_t i, integer_1d_array &colidx, real_1d_array &vals, ae_int_t &nzcnt, const xparams _xparams)
2292 : {
2293 : jmp_buf _break_jump;
2294 : alglib_impl::ae_state _alglib_env_state;
2295 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2296 0 : if( setjmp(_break_jump) )
2297 : {
2298 : #if !defined(AE_NO_EXCEPTIONS)
2299 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2300 : #else
2301 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2302 : return;
2303 : #endif
2304 : }
2305 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2306 0 : if( _xparams.flags!=0x0 )
2307 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2308 0 : alglib_impl::sparsegetcompressedrow(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), i, const_cast<alglib_impl::ae_vector*>(colidx.c_ptr()), const_cast<alglib_impl::ae_vector*>(vals.c_ptr()), &nzcnt, &_alglib_env_state);
2309 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2310 0 : return;
2311 : }
2312 :
2313 : /*************************************************************************
2314 : This function performs efficient in-place transpose of SKS matrix. No
2315 : additional memory is allocated during transposition.
2316 :
2317 : This function supports only skyline storage format (SKS).
2318 :
2319 : INPUT PARAMETERS
2320 : S - sparse matrix in SKS format.
2321 :
2322 : OUTPUT PARAMETERS
2323 : S - sparse matrix, transposed.
2324 :
2325 : -- ALGLIB PROJECT --
2326 : Copyright 16.01.2014 by Bochkanov Sergey
2327 : *************************************************************************/
2328 0 : void sparsetransposesks(const sparsematrix &s, const xparams _xparams)
2329 : {
2330 : jmp_buf _break_jump;
2331 : alglib_impl::ae_state _alglib_env_state;
2332 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2333 0 : if( setjmp(_break_jump) )
2334 : {
2335 : #if !defined(AE_NO_EXCEPTIONS)
2336 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2337 : #else
2338 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2339 : return;
2340 : #endif
2341 : }
2342 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2343 0 : if( _xparams.flags!=0x0 )
2344 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2345 0 : alglib_impl::sparsetransposesks(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2346 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2347 0 : return;
2348 : }
2349 :
2350 : /*************************************************************************
2351 : This function performs transpose of CRS matrix.
2352 :
2353 : INPUT PARAMETERS
2354 : S - sparse matrix in CRS format.
2355 :
2356 : OUTPUT PARAMETERS
2357 : S - sparse matrix, transposed.
2358 :
2359 : NOTE: internal temporary copy is allocated for the purposes of
2360 : transposition. It is deallocated after transposition.
2361 :
2362 : -- ALGLIB PROJECT --
2363 : Copyright 30.01.2018 by Bochkanov Sergey
2364 : *************************************************************************/
2365 0 : void sparsetransposecrs(const sparsematrix &s, const xparams _xparams)
2366 : {
2367 : jmp_buf _break_jump;
2368 : alglib_impl::ae_state _alglib_env_state;
2369 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2370 0 : if( setjmp(_break_jump) )
2371 : {
2372 : #if !defined(AE_NO_EXCEPTIONS)
2373 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2374 : #else
2375 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2376 : return;
2377 : #endif
2378 : }
2379 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2380 0 : if( _xparams.flags!=0x0 )
2381 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2382 0 : alglib_impl::sparsetransposecrs(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2383 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2384 0 : return;
2385 : }
2386 :
2387 : /*************************************************************************
2388 : This function performs copying with transposition of CRS matrix.
2389 :
2390 : INPUT PARAMETERS
2391 : S0 - sparse matrix in CRS format.
2392 :
2393 : OUTPUT PARAMETERS
2394 : S1 - sparse matrix, transposed
2395 :
2396 : -- ALGLIB PROJECT --
2397 : Copyright 23.07.2018 by Bochkanov Sergey
2398 : *************************************************************************/
2399 0 : void sparsecopytransposecrs(const sparsematrix &s0, sparsematrix &s1, const xparams _xparams)
2400 : {
2401 : jmp_buf _break_jump;
2402 : alglib_impl::ae_state _alglib_env_state;
2403 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2404 0 : if( setjmp(_break_jump) )
2405 : {
2406 : #if !defined(AE_NO_EXCEPTIONS)
2407 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2408 : #else
2409 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2410 : return;
2411 : #endif
2412 : }
2413 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2414 0 : if( _xparams.flags!=0x0 )
2415 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2416 0 : alglib_impl::sparsecopytransposecrs(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2417 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2418 0 : return;
2419 : }
2420 :
2421 : /*************************************************************************
2422 : This function performs copying with transposition of CRS matrix (buffered
2423 : version which reuses memory already allocated by the target as much as
2424 : possible).
2425 :
2426 : INPUT PARAMETERS
2427 : S0 - sparse matrix in CRS format.
2428 :
2429 : OUTPUT PARAMETERS
2430 : S1 - sparse matrix, transposed; previously allocated memory is
2431 : reused if possible.
2432 :
2433 : -- ALGLIB PROJECT --
2434 : Copyright 23.07.2018 by Bochkanov Sergey
2435 : *************************************************************************/
2436 0 : void sparsecopytransposecrsbuf(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
2437 : {
2438 : jmp_buf _break_jump;
2439 : alglib_impl::ae_state _alglib_env_state;
2440 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2441 0 : if( setjmp(_break_jump) )
2442 : {
2443 : #if !defined(AE_NO_EXCEPTIONS)
2444 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2445 : #else
2446 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2447 : return;
2448 : #endif
2449 : }
2450 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2451 0 : if( _xparams.flags!=0x0 )
2452 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2453 0 : alglib_impl::sparsecopytransposecrsbuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2454 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2455 0 : return;
2456 : }
2457 :
2458 : /*************************************************************************
2459 : This function performs in-place conversion to desired sparse storage
2460 : format.
2461 :
2462 : INPUT PARAMETERS
2463 : S0 - sparse matrix in any format.
2464 : Fmt - desired storage format of the output, as returned by
2465 : SparseGetMatrixType() function:
2466 : * 0 for hash-based storage
2467 : * 1 for CRS
2468 : * 2 for SKS
2469 :
2470 : OUTPUT PARAMETERS
2471 : S0 - sparse matrix in requested format.
2472 :
2473 : NOTE: in-place conversion wastes a lot of memory which is used to store
2474 : temporaries. If you perform a lot of repeated conversions, we
2475 : recommend to use out-of-place buffered conversion functions, like
2476 : SparseCopyToBuf(), which can reuse already allocated memory.
2477 :
2478 : -- ALGLIB PROJECT --
2479 : Copyright 16.01.2014 by Bochkanov Sergey
2480 : *************************************************************************/
2481 0 : void sparseconvertto(const sparsematrix &s0, const ae_int_t fmt, const xparams _xparams)
2482 : {
2483 : jmp_buf _break_jump;
2484 : alglib_impl::ae_state _alglib_env_state;
2485 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2486 0 : if( setjmp(_break_jump) )
2487 : {
2488 : #if !defined(AE_NO_EXCEPTIONS)
2489 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2490 : #else
2491 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2492 : return;
2493 : #endif
2494 : }
2495 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2496 0 : if( _xparams.flags!=0x0 )
2497 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2498 0 : alglib_impl::sparseconvertto(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), fmt, &_alglib_env_state);
2499 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2500 0 : return;
2501 : }
2502 :
2503 : /*************************************************************************
2504 : This function performs out-of-place conversion to desired sparse storage
2505 : format. S0 is copied to S1 and converted on-the-fly. Memory allocated in
2506 : S1 is reused to maximum extent possible.
2507 :
2508 : INPUT PARAMETERS
2509 : S0 - sparse matrix in any format.
2510 : Fmt - desired storage format of the output, as returned by
2511 : SparseGetMatrixType() function:
2512 : * 0 for hash-based storage
2513 : * 1 for CRS
2514 : * 2 for SKS
2515 :
2516 : OUTPUT PARAMETERS
2517 : S1 - sparse matrix in requested format.
2518 :
2519 : -- ALGLIB PROJECT --
2520 : Copyright 16.01.2014 by Bochkanov Sergey
2521 : *************************************************************************/
2522 0 : void sparsecopytobuf(const sparsematrix &s0, const ae_int_t fmt, const sparsematrix &s1, const xparams _xparams)
2523 : {
2524 : jmp_buf _break_jump;
2525 : alglib_impl::ae_state _alglib_env_state;
2526 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2527 0 : if( setjmp(_break_jump) )
2528 : {
2529 : #if !defined(AE_NO_EXCEPTIONS)
2530 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2531 : #else
2532 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2533 : return;
2534 : #endif
2535 : }
2536 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2537 0 : if( _xparams.flags!=0x0 )
2538 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2539 0 : alglib_impl::sparsecopytobuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), fmt, const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2540 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2541 0 : return;
2542 : }
2543 :
2544 : /*************************************************************************
2545 : This function performs in-place conversion to Hash table storage.
2546 :
2547 : INPUT PARAMETERS
2548 : S - sparse matrix in CRS format.
2549 :
2550 : OUTPUT PARAMETERS
2551 : S - sparse matrix in Hash table format.
2552 :
2553 : NOTE: this function has no effect when called with matrix which is
2554 : already in Hash table mode.
2555 :
2556 : NOTE: in-place conversion involves allocation of temporary arrays. If you
2557 : perform a lot of repeated in- place conversions, it may lead to
2558 : memory fragmentation. Consider using out-of-place SparseCopyToHashBuf()
2559 : function in this case.
2560 :
2561 : -- ALGLIB PROJECT --
2562 : Copyright 20.07.2012 by Bochkanov Sergey
2563 : *************************************************************************/
2564 0 : void sparseconverttohash(const sparsematrix &s, const xparams _xparams)
2565 : {
2566 : jmp_buf _break_jump;
2567 : alglib_impl::ae_state _alglib_env_state;
2568 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2569 0 : if( setjmp(_break_jump) )
2570 : {
2571 : #if !defined(AE_NO_EXCEPTIONS)
2572 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2573 : #else
2574 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2575 : return;
2576 : #endif
2577 : }
2578 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2579 0 : if( _xparams.flags!=0x0 )
2580 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2581 0 : alglib_impl::sparseconverttohash(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2582 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2583 0 : return;
2584 : }
2585 :
2586 : /*************************************************************************
2587 : This function performs out-of-place conversion to Hash table storage
2588 : format. S0 is copied to S1 and converted on-the-fly.
2589 :
2590 : INPUT PARAMETERS
2591 : S0 - sparse matrix in any format.
2592 :
2593 : OUTPUT PARAMETERS
2594 : S1 - sparse matrix in Hash table format.
2595 :
2596 : NOTE: if S0 is stored as Hash-table, it is just copied without conversion.
2597 :
2598 : NOTE: this function de-allocates memory occupied by S1 before starting
2599 : conversion. If you perform a lot of repeated conversions, it may
2600 : lead to memory fragmentation. In this case we recommend you to use
2601 : SparseCopyToHashBuf() function which re-uses memory in S1 as much as
2602 : possible.
2603 :
2604 : -- ALGLIB PROJECT --
2605 : Copyright 20.07.2012 by Bochkanov Sergey
2606 : *************************************************************************/
2607 0 : void sparsecopytohash(const sparsematrix &s0, sparsematrix &s1, const xparams _xparams)
2608 : {
2609 : jmp_buf _break_jump;
2610 : alglib_impl::ae_state _alglib_env_state;
2611 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2612 0 : if( setjmp(_break_jump) )
2613 : {
2614 : #if !defined(AE_NO_EXCEPTIONS)
2615 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2616 : #else
2617 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2618 : return;
2619 : #endif
2620 : }
2621 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2622 0 : if( _xparams.flags!=0x0 )
2623 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2624 0 : alglib_impl::sparsecopytohash(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2625 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2626 0 : return;
2627 : }
2628 :
2629 : /*************************************************************************
2630 : This function performs out-of-place conversion to Hash table storage
2631 : format. S0 is copied to S1 and converted on-the-fly. Memory allocated in
2632 : S1 is reused to maximum extent possible.
2633 :
2634 : INPUT PARAMETERS
2635 : S0 - sparse matrix in any format.
2636 :
2637 : OUTPUT PARAMETERS
2638 : S1 - sparse matrix in Hash table format.
2639 :
2640 : NOTE: if S0 is stored as Hash-table, it is just copied without conversion.
2641 :
2642 : -- ALGLIB PROJECT --
2643 : Copyright 20.07.2012 by Bochkanov Sergey
2644 : *************************************************************************/
2645 0 : void sparsecopytohashbuf(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
2646 : {
2647 : jmp_buf _break_jump;
2648 : alglib_impl::ae_state _alglib_env_state;
2649 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2650 0 : if( setjmp(_break_jump) )
2651 : {
2652 : #if !defined(AE_NO_EXCEPTIONS)
2653 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2654 : #else
2655 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2656 : return;
2657 : #endif
2658 : }
2659 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2660 0 : if( _xparams.flags!=0x0 )
2661 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2662 0 : alglib_impl::sparsecopytohashbuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2663 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2664 0 : return;
2665 : }
2666 :
2667 : /*************************************************************************
2668 : This function converts matrix to CRS format.
2669 :
2670 : Some algorithms (linear algebra ones, for example) require matrices in
2671 : CRS format. This function allows to perform in-place conversion.
2672 :
2673 : INPUT PARAMETERS
2674 : S - sparse M*N matrix in any format
2675 :
2676 : OUTPUT PARAMETERS
2677 : S - matrix in CRS format
2678 :
2679 : NOTE: this function has no effect when called with matrix which is
2680 : already in CRS mode.
2681 :
2682 : NOTE: this function allocates temporary memory to store a copy of the
2683 : matrix. If you perform a lot of repeated conversions, we recommend
2684 : you to use SparseCopyToCRSBuf() function, which can reuse
2685 : previously allocated memory.
2686 :
2687 : -- ALGLIB PROJECT --
2688 : Copyright 14.10.2011 by Bochkanov Sergey
2689 : *************************************************************************/
2690 0 : void sparseconverttocrs(const sparsematrix &s, const xparams _xparams)
2691 : {
2692 : jmp_buf _break_jump;
2693 : alglib_impl::ae_state _alglib_env_state;
2694 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2695 0 : if( setjmp(_break_jump) )
2696 : {
2697 : #if !defined(AE_NO_EXCEPTIONS)
2698 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2699 : #else
2700 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2701 : return;
2702 : #endif
2703 : }
2704 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2705 0 : if( _xparams.flags!=0x0 )
2706 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2707 0 : alglib_impl::sparseconverttocrs(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2708 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2709 0 : return;
2710 : }
2711 :
2712 : /*************************************************************************
2713 : This function performs out-of-place conversion to CRS format. S0 is
2714 : copied to S1 and converted on-the-fly.
2715 :
2716 : INPUT PARAMETERS
2717 : S0 - sparse matrix in any format.
2718 :
2719 : OUTPUT PARAMETERS
2720 : S1 - sparse matrix in CRS format.
2721 :
2722 : NOTE: if S0 is stored as CRS, it is just copied without conversion.
2723 :
2724 : NOTE: this function de-allocates memory occupied by S1 before starting CRS
2725 : conversion. If you perform a lot of repeated CRS conversions, it may
2726 : lead to memory fragmentation. In this case we recommend you to use
2727 : SparseCopyToCRSBuf() function which re-uses memory in S1 as much as
2728 : possible.
2729 :
2730 : -- ALGLIB PROJECT --
2731 : Copyright 20.07.2012 by Bochkanov Sergey
2732 : *************************************************************************/
2733 0 : void sparsecopytocrs(const sparsematrix &s0, sparsematrix &s1, const xparams _xparams)
2734 : {
2735 : jmp_buf _break_jump;
2736 : alglib_impl::ae_state _alglib_env_state;
2737 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2738 0 : if( setjmp(_break_jump) )
2739 : {
2740 : #if !defined(AE_NO_EXCEPTIONS)
2741 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2742 : #else
2743 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2744 : return;
2745 : #endif
2746 : }
2747 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2748 0 : if( _xparams.flags!=0x0 )
2749 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2750 0 : alglib_impl::sparsecopytocrs(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2751 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2752 0 : return;
2753 : }
2754 :
2755 : /*************************************************************************
2756 : This function performs out-of-place conversion to CRS format. S0 is
2757 : copied to S1 and converted on-the-fly. Memory allocated in S1 is reused to
2758 : maximum extent possible.
2759 :
2760 : INPUT PARAMETERS
2761 : S0 - sparse matrix in any format.
2762 : S1 - matrix which may contain some pre-allocated memory, or
2763 : can be just uninitialized structure.
2764 :
2765 : OUTPUT PARAMETERS
2766 : S1 - sparse matrix in CRS format.
2767 :
2768 : NOTE: if S0 is stored as CRS, it is just copied without conversion.
2769 :
2770 : -- ALGLIB PROJECT --
2771 : Copyright 20.07.2012 by Bochkanov Sergey
2772 : *************************************************************************/
2773 0 : void sparsecopytocrsbuf(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
2774 : {
2775 : jmp_buf _break_jump;
2776 : alglib_impl::ae_state _alglib_env_state;
2777 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2778 0 : if( setjmp(_break_jump) )
2779 : {
2780 : #if !defined(AE_NO_EXCEPTIONS)
2781 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2782 : #else
2783 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2784 : return;
2785 : #endif
2786 : }
2787 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2788 0 : if( _xparams.flags!=0x0 )
2789 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2790 0 : alglib_impl::sparsecopytocrsbuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2791 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2792 0 : return;
2793 : }
2794 :
2795 : /*************************************************************************
2796 : This function performs in-place conversion to SKS format.
2797 :
2798 : INPUT PARAMETERS
2799 : S - sparse matrix in any format.
2800 :
2801 : OUTPUT PARAMETERS
2802 : S - sparse matrix in SKS format.
2803 :
2804 : NOTE: this function has no effect when called with matrix which is
2805 : already in SKS mode.
2806 :
2807 : NOTE: in-place conversion involves allocation of temporary arrays. If you
2808 : perform a lot of repeated in- place conversions, it may lead to
2809 : memory fragmentation. Consider using out-of-place SparseCopyToSKSBuf()
2810 : function in this case.
2811 :
2812 : -- ALGLIB PROJECT --
2813 : Copyright 15.01.2014 by Bochkanov Sergey
2814 : *************************************************************************/
2815 0 : void sparseconverttosks(const sparsematrix &s, const xparams _xparams)
2816 : {
2817 : jmp_buf _break_jump;
2818 : alglib_impl::ae_state _alglib_env_state;
2819 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2820 0 : if( setjmp(_break_jump) )
2821 : {
2822 : #if !defined(AE_NO_EXCEPTIONS)
2823 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2824 : #else
2825 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2826 : return;
2827 : #endif
2828 : }
2829 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2830 0 : if( _xparams.flags!=0x0 )
2831 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2832 0 : alglib_impl::sparseconverttosks(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2833 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2834 0 : return;
2835 : }
2836 :
2837 : /*************************************************************************
2838 : This function performs out-of-place conversion to SKS storage format.
2839 : S0 is copied to S1 and converted on-the-fly.
2840 :
2841 : INPUT PARAMETERS
2842 : S0 - sparse matrix in any format.
2843 :
2844 : OUTPUT PARAMETERS
2845 : S1 - sparse matrix in SKS format.
2846 :
2847 : NOTE: if S0 is stored as SKS, it is just copied without conversion.
2848 :
2849 : NOTE: this function de-allocates memory occupied by S1 before starting
2850 : conversion. If you perform a lot of repeated conversions, it may
2851 : lead to memory fragmentation. In this case we recommend you to use
2852 : SparseCopyToSKSBuf() function which re-uses memory in S1 as much as
2853 : possible.
2854 :
2855 : -- ALGLIB PROJECT --
2856 : Copyright 20.07.2012 by Bochkanov Sergey
2857 : *************************************************************************/
2858 0 : void sparsecopytosks(const sparsematrix &s0, sparsematrix &s1, const xparams _xparams)
2859 : {
2860 : jmp_buf _break_jump;
2861 : alglib_impl::ae_state _alglib_env_state;
2862 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2863 0 : if( setjmp(_break_jump) )
2864 : {
2865 : #if !defined(AE_NO_EXCEPTIONS)
2866 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2867 : #else
2868 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2869 : return;
2870 : #endif
2871 : }
2872 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2873 0 : if( _xparams.flags!=0x0 )
2874 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2875 0 : alglib_impl::sparsecopytosks(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2876 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2877 0 : return;
2878 : }
2879 :
2880 : /*************************************************************************
2881 : This function performs out-of-place conversion to SKS format. S0 is
2882 : copied to S1 and converted on-the-fly. Memory allocated in S1 is reused
2883 : to maximum extent possible.
2884 :
2885 : INPUT PARAMETERS
2886 : S0 - sparse matrix in any format.
2887 :
2888 : OUTPUT PARAMETERS
2889 : S1 - sparse matrix in SKS format.
2890 :
2891 : NOTE: if S0 is stored as SKS, it is just copied without conversion.
2892 :
2893 : -- ALGLIB PROJECT --
2894 : Copyright 20.07.2012 by Bochkanov Sergey
2895 : *************************************************************************/
2896 0 : void sparsecopytosksbuf(const sparsematrix &s0, const sparsematrix &s1, const xparams _xparams)
2897 : {
2898 : jmp_buf _break_jump;
2899 : alglib_impl::ae_state _alglib_env_state;
2900 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2901 0 : if( setjmp(_break_jump) )
2902 : {
2903 : #if !defined(AE_NO_EXCEPTIONS)
2904 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2905 : #else
2906 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2907 : return;
2908 : #endif
2909 : }
2910 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2911 0 : if( _xparams.flags!=0x0 )
2912 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2913 0 : alglib_impl::sparsecopytosksbuf(const_cast<alglib_impl::sparsematrix*>(s0.c_ptr()), const_cast<alglib_impl::sparsematrix*>(s1.c_ptr()), &_alglib_env_state);
2914 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2915 0 : return;
2916 : }
2917 :
2918 : /*************************************************************************
2919 : This function returns type of the matrix storage format.
2920 :
2921 : INPUT PARAMETERS:
2922 : S - sparse matrix.
2923 :
2924 : RESULT:
2925 : sparse storage format used by matrix:
2926 : 0 - Hash-table
2927 : 1 - CRS (compressed row storage)
2928 : 2 - SKS (skyline)
2929 :
2930 : NOTE: future versions of ALGLIB may include additional sparse storage
2931 : formats.
2932 :
2933 :
2934 : -- ALGLIB PROJECT --
2935 : Copyright 20.07.2012 by Bochkanov Sergey
2936 : *************************************************************************/
2937 0 : ae_int_t sparsegetmatrixtype(const sparsematrix &s, const xparams _xparams)
2938 : {
2939 : jmp_buf _break_jump;
2940 : alglib_impl::ae_state _alglib_env_state;
2941 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2942 0 : if( setjmp(_break_jump) )
2943 : {
2944 : #if !defined(AE_NO_EXCEPTIONS)
2945 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2946 : #else
2947 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2948 : return 0;
2949 : #endif
2950 : }
2951 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2952 0 : if( _xparams.flags!=0x0 )
2953 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2954 0 : alglib_impl::ae_int_t result = alglib_impl::sparsegetmatrixtype(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2955 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2956 0 : return *(reinterpret_cast<ae_int_t*>(&result));
2957 : }
2958 :
2959 : /*************************************************************************
2960 : This function checks matrix storage format and returns True when matrix is
2961 : stored using Hash table representation.
2962 :
2963 : INPUT PARAMETERS:
2964 : S - sparse matrix.
2965 :
2966 : RESULT:
2967 : True if matrix type is Hash table
2968 : False if matrix type is not Hash table
2969 :
2970 : -- ALGLIB PROJECT --
2971 : Copyright 20.07.2012 by Bochkanov Sergey
2972 : *************************************************************************/
2973 0 : bool sparseishash(const sparsematrix &s, const xparams _xparams)
2974 : {
2975 : jmp_buf _break_jump;
2976 : alglib_impl::ae_state _alglib_env_state;
2977 0 : alglib_impl::ae_state_init(&_alglib_env_state);
2978 0 : if( setjmp(_break_jump) )
2979 : {
2980 : #if !defined(AE_NO_EXCEPTIONS)
2981 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
2982 : #else
2983 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
2984 : return 0;
2985 : #endif
2986 : }
2987 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
2988 0 : if( _xparams.flags!=0x0 )
2989 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
2990 0 : ae_bool result = alglib_impl::sparseishash(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
2991 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
2992 0 : return *(reinterpret_cast<bool*>(&result));
2993 : }
2994 :
2995 : /*************************************************************************
2996 : This function checks matrix storage format and returns True when matrix is
2997 : stored using CRS representation.
2998 :
2999 : INPUT PARAMETERS:
3000 : S - sparse matrix.
3001 :
3002 : RESULT:
3003 : True if matrix type is CRS
3004 : False if matrix type is not CRS
3005 :
3006 : -- ALGLIB PROJECT --
3007 : Copyright 20.07.2012 by Bochkanov Sergey
3008 : *************************************************************************/
3009 0 : bool sparseiscrs(const sparsematrix &s, const xparams _xparams)
3010 : {
3011 : jmp_buf _break_jump;
3012 : alglib_impl::ae_state _alglib_env_state;
3013 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3014 0 : if( setjmp(_break_jump) )
3015 : {
3016 : #if !defined(AE_NO_EXCEPTIONS)
3017 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3018 : #else
3019 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3020 : return 0;
3021 : #endif
3022 : }
3023 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3024 0 : if( _xparams.flags!=0x0 )
3025 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3026 0 : ae_bool result = alglib_impl::sparseiscrs(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3027 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3028 0 : return *(reinterpret_cast<bool*>(&result));
3029 : }
3030 :
3031 : /*************************************************************************
3032 : This function checks matrix storage format and returns True when matrix is
3033 : stored using SKS representation.
3034 :
3035 : INPUT PARAMETERS:
3036 : S - sparse matrix.
3037 :
3038 : RESULT:
3039 : True if matrix type is SKS
3040 : False if matrix type is not SKS
3041 :
3042 : -- ALGLIB PROJECT --
3043 : Copyright 20.07.2012 by Bochkanov Sergey
3044 : *************************************************************************/
3045 0 : bool sparseissks(const sparsematrix &s, const xparams _xparams)
3046 : {
3047 : jmp_buf _break_jump;
3048 : alglib_impl::ae_state _alglib_env_state;
3049 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3050 0 : if( setjmp(_break_jump) )
3051 : {
3052 : #if !defined(AE_NO_EXCEPTIONS)
3053 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3054 : #else
3055 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3056 : return 0;
3057 : #endif
3058 : }
3059 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3060 0 : if( _xparams.flags!=0x0 )
3061 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3062 0 : ae_bool result = alglib_impl::sparseissks(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3063 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3064 0 : return *(reinterpret_cast<bool*>(&result));
3065 : }
3066 :
3067 : /*************************************************************************
3068 : The function frees all memory occupied by sparse matrix. Sparse matrix
3069 : structure becomes unusable after this call.
3070 :
3071 : OUTPUT PARAMETERS
3072 : S - sparse matrix to delete
3073 :
3074 : -- ALGLIB PROJECT --
3075 : Copyright 24.07.2012 by Bochkanov Sergey
3076 : *************************************************************************/
3077 0 : void sparsefree(sparsematrix &s, const xparams _xparams)
3078 : {
3079 : jmp_buf _break_jump;
3080 : alglib_impl::ae_state _alglib_env_state;
3081 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3082 0 : if( setjmp(_break_jump) )
3083 : {
3084 : #if !defined(AE_NO_EXCEPTIONS)
3085 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3086 : #else
3087 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3088 : return;
3089 : #endif
3090 : }
3091 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3092 0 : if( _xparams.flags!=0x0 )
3093 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3094 0 : alglib_impl::sparsefree(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3095 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3096 0 : return;
3097 : }
3098 :
3099 : /*************************************************************************
3100 : The function returns number of rows of a sparse matrix.
3101 :
3102 : RESULT: number of rows of a sparse matrix.
3103 :
3104 : -- ALGLIB PROJECT --
3105 : Copyright 23.08.2012 by Bochkanov Sergey
3106 : *************************************************************************/
3107 0 : ae_int_t sparsegetnrows(const sparsematrix &s, const xparams _xparams)
3108 : {
3109 : jmp_buf _break_jump;
3110 : alglib_impl::ae_state _alglib_env_state;
3111 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3112 0 : if( setjmp(_break_jump) )
3113 : {
3114 : #if !defined(AE_NO_EXCEPTIONS)
3115 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3116 : #else
3117 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3118 : return 0;
3119 : #endif
3120 : }
3121 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3122 0 : if( _xparams.flags!=0x0 )
3123 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3124 0 : alglib_impl::ae_int_t result = alglib_impl::sparsegetnrows(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3125 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3126 0 : return *(reinterpret_cast<ae_int_t*>(&result));
3127 : }
3128 :
3129 : /*************************************************************************
3130 : The function returns number of columns of a sparse matrix.
3131 :
3132 : RESULT: number of columns of a sparse matrix.
3133 :
3134 : -- ALGLIB PROJECT --
3135 : Copyright 23.08.2012 by Bochkanov Sergey
3136 : *************************************************************************/
3137 0 : ae_int_t sparsegetncols(const sparsematrix &s, const xparams _xparams)
3138 : {
3139 : jmp_buf _break_jump;
3140 : alglib_impl::ae_state _alglib_env_state;
3141 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3142 0 : if( setjmp(_break_jump) )
3143 : {
3144 : #if !defined(AE_NO_EXCEPTIONS)
3145 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3146 : #else
3147 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3148 : return 0;
3149 : #endif
3150 : }
3151 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3152 0 : if( _xparams.flags!=0x0 )
3153 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3154 0 : alglib_impl::ae_int_t result = alglib_impl::sparsegetncols(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3155 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3156 0 : return *(reinterpret_cast<ae_int_t*>(&result));
3157 : }
3158 :
3159 : /*************************************************************************
3160 : The function returns number of strictly upper triangular non-zero elements
3161 : in the matrix. It counts SYMBOLICALLY non-zero elements, i.e. entries
3162 : in the sparse matrix data structure. If some element has zero numerical
3163 : value, it is still counted.
3164 :
3165 : This function has different cost for different types of matrices:
3166 : * for hash-based matrices it involves complete pass over entire hash-table
3167 : with O(NNZ) cost, where NNZ is number of non-zero elements
3168 : * for CRS and SKS matrix types cost of counting is O(N) (N - matrix size).
3169 :
3170 : RESULT: number of non-zero elements strictly above main diagonal
3171 :
3172 : -- ALGLIB PROJECT --
3173 : Copyright 12.02.2014 by Bochkanov Sergey
3174 : *************************************************************************/
3175 0 : ae_int_t sparsegetuppercount(const sparsematrix &s, const xparams _xparams)
3176 : {
3177 : jmp_buf _break_jump;
3178 : alglib_impl::ae_state _alglib_env_state;
3179 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3180 0 : if( setjmp(_break_jump) )
3181 : {
3182 : #if !defined(AE_NO_EXCEPTIONS)
3183 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3184 : #else
3185 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3186 : return 0;
3187 : #endif
3188 : }
3189 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3190 0 : if( _xparams.flags!=0x0 )
3191 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3192 0 : alglib_impl::ae_int_t result = alglib_impl::sparsegetuppercount(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3193 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3194 0 : return *(reinterpret_cast<ae_int_t*>(&result));
3195 : }
3196 :
3197 : /*************************************************************************
3198 : The function returns number of strictly lower triangular non-zero elements
3199 : in the matrix. It counts SYMBOLICALLY non-zero elements, i.e. entries
3200 : in the sparse matrix data structure. If some element has zero numerical
3201 : value, it is still counted.
3202 :
3203 : This function has different cost for different types of matrices:
3204 : * for hash-based matrices it involves complete pass over entire hash-table
3205 : with O(NNZ) cost, where NNZ is number of non-zero elements
3206 : * for CRS and SKS matrix types cost of counting is O(N) (N - matrix size).
3207 :
3208 : RESULT: number of non-zero elements strictly below main diagonal
3209 :
3210 : -- ALGLIB PROJECT --
3211 : Copyright 12.02.2014 by Bochkanov Sergey
3212 : *************************************************************************/
3213 0 : ae_int_t sparsegetlowercount(const sparsematrix &s, const xparams _xparams)
3214 : {
3215 : jmp_buf _break_jump;
3216 : alglib_impl::ae_state _alglib_env_state;
3217 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3218 0 : if( setjmp(_break_jump) )
3219 : {
3220 : #if !defined(AE_NO_EXCEPTIONS)
3221 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3222 : #else
3223 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3224 : return 0;
3225 : #endif
3226 : }
3227 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3228 0 : if( _xparams.flags!=0x0 )
3229 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3230 0 : alglib_impl::ae_int_t result = alglib_impl::sparsegetlowercount(const_cast<alglib_impl::sparsematrix*>(s.c_ptr()), &_alglib_env_state);
3231 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3232 0 : return *(reinterpret_cast<ae_int_t*>(&result));
3233 : }
3234 : #endif
3235 :
3236 : #if defined(AE_COMPILE_ABLAS) || !defined(AE_PARTIAL_BUILD)
3237 : /*************************************************************************
3238 : Cache-oblivous complex "copy-and-transpose"
3239 :
3240 : Input parameters:
3241 : M - number of rows
3242 : N - number of columns
3243 : A - source matrix, MxN submatrix is copied and transposed
3244 : IA - submatrix offset (row index)
3245 : JA - submatrix offset (column index)
3246 : B - destination matrix, must be large enough to store result
3247 : IB - submatrix offset (row index)
3248 : JB - submatrix offset (column index)
3249 : *************************************************************************/
3250 0 : void cmatrixtranspose(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const xparams _xparams)
3251 : {
3252 : jmp_buf _break_jump;
3253 : alglib_impl::ae_state _alglib_env_state;
3254 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3255 0 : if( setjmp(_break_jump) )
3256 : {
3257 : #if !defined(AE_NO_EXCEPTIONS)
3258 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3259 : #else
3260 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3261 : return;
3262 : #endif
3263 : }
3264 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3265 0 : if( _xparams.flags!=0x0 )
3266 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3267 0 : alglib_impl::cmatrixtranspose(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, &_alglib_env_state);
3268 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3269 0 : return;
3270 : }
3271 :
3272 : /*************************************************************************
3273 : Cache-oblivous real "copy-and-transpose"
3274 :
3275 : Input parameters:
3276 : M - number of rows
3277 : N - number of columns
3278 : A - source matrix, MxN submatrix is copied and transposed
3279 : IA - submatrix offset (row index)
3280 : JA - submatrix offset (column index)
3281 : B - destination matrix, must be large enough to store result
3282 : IB - submatrix offset (row index)
3283 : JB - submatrix offset (column index)
3284 : *************************************************************************/
3285 0 : void rmatrixtranspose(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const xparams _xparams)
3286 : {
3287 : jmp_buf _break_jump;
3288 : alglib_impl::ae_state _alglib_env_state;
3289 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3290 0 : if( setjmp(_break_jump) )
3291 : {
3292 : #if !defined(AE_NO_EXCEPTIONS)
3293 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3294 : #else
3295 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3296 : return;
3297 : #endif
3298 : }
3299 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3300 0 : if( _xparams.flags!=0x0 )
3301 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3302 0 : alglib_impl::rmatrixtranspose(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, &_alglib_env_state);
3303 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3304 0 : return;
3305 : }
3306 :
3307 : /*************************************************************************
3308 : This code enforces symmetricy of the matrix by copying Upper part to lower
3309 : one (or vice versa).
3310 :
3311 : INPUT PARAMETERS:
3312 : A - matrix
3313 : N - number of rows/columns
3314 : IsUpper - whether we want to copy upper triangle to lower one (True)
3315 : or vice versa (False).
3316 : *************************************************************************/
3317 0 : void rmatrixenforcesymmetricity(const real_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
3318 : {
3319 : jmp_buf _break_jump;
3320 : alglib_impl::ae_state _alglib_env_state;
3321 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3322 0 : if( setjmp(_break_jump) )
3323 : {
3324 : #if !defined(AE_NO_EXCEPTIONS)
3325 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3326 : #else
3327 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3328 : return;
3329 : #endif
3330 : }
3331 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3332 0 : if( _xparams.flags!=0x0 )
3333 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3334 0 : alglib_impl::rmatrixenforcesymmetricity(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
3335 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3336 0 : return;
3337 : }
3338 :
3339 : /*************************************************************************
3340 : Copy
3341 :
3342 : Input parameters:
3343 : M - number of rows
3344 : N - number of columns
3345 : A - source matrix, MxN submatrix is copied and transposed
3346 : IA - submatrix offset (row index)
3347 : JA - submatrix offset (column index)
3348 : B - destination matrix, must be large enough to store result
3349 : IB - submatrix offset (row index)
3350 : JB - submatrix offset (column index)
3351 : *************************************************************************/
3352 0 : void cmatrixcopy(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const xparams _xparams)
3353 : {
3354 : jmp_buf _break_jump;
3355 : alglib_impl::ae_state _alglib_env_state;
3356 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3357 0 : if( setjmp(_break_jump) )
3358 : {
3359 : #if !defined(AE_NO_EXCEPTIONS)
3360 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3361 : #else
3362 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3363 : return;
3364 : #endif
3365 : }
3366 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3367 0 : if( _xparams.flags!=0x0 )
3368 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3369 0 : alglib_impl::cmatrixcopy(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, &_alglib_env_state);
3370 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3371 0 : return;
3372 : }
3373 :
3374 : /*************************************************************************
3375 : Copy
3376 :
3377 : Input parameters:
3378 : N - subvector size
3379 : A - source vector, N elements are copied
3380 : IA - source offset (first element index)
3381 : B - destination vector, must be large enough to store result
3382 : IB - destination offset (first element index)
3383 : *************************************************************************/
3384 0 : void rvectorcopy(const ae_int_t n, const real_1d_array &a, const ae_int_t ia, const real_1d_array &b, const ae_int_t ib, const xparams _xparams)
3385 : {
3386 : jmp_buf _break_jump;
3387 : alglib_impl::ae_state _alglib_env_state;
3388 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3389 0 : if( setjmp(_break_jump) )
3390 : {
3391 : #if !defined(AE_NO_EXCEPTIONS)
3392 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3393 : #else
3394 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3395 : return;
3396 : #endif
3397 : }
3398 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3399 0 : if( _xparams.flags!=0x0 )
3400 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3401 0 : alglib_impl::rvectorcopy(n, const_cast<alglib_impl::ae_vector*>(a.c_ptr()), ia, const_cast<alglib_impl::ae_vector*>(b.c_ptr()), ib, &_alglib_env_state);
3402 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3403 0 : return;
3404 : }
3405 :
3406 : /*************************************************************************
3407 : Copy
3408 :
3409 : Input parameters:
3410 : M - number of rows
3411 : N - number of columns
3412 : A - source matrix, MxN submatrix is copied and transposed
3413 : IA - submatrix offset (row index)
3414 : JA - submatrix offset (column index)
3415 : B - destination matrix, must be large enough to store result
3416 : IB - submatrix offset (row index)
3417 : JB - submatrix offset (column index)
3418 : *************************************************************************/
3419 0 : void rmatrixcopy(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const xparams _xparams)
3420 : {
3421 : jmp_buf _break_jump;
3422 : alglib_impl::ae_state _alglib_env_state;
3423 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3424 0 : if( setjmp(_break_jump) )
3425 : {
3426 : #if !defined(AE_NO_EXCEPTIONS)
3427 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3428 : #else
3429 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3430 : return;
3431 : #endif
3432 : }
3433 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3434 0 : if( _xparams.flags!=0x0 )
3435 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3436 0 : alglib_impl::rmatrixcopy(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, &_alglib_env_state);
3437 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3438 0 : return;
3439 : }
3440 :
3441 : /*************************************************************************
3442 : Performs generalized copy: B := Beta*B + Alpha*A.
3443 :
3444 : If Beta=0, then previous contents of B is simply ignored. If Alpha=0, then
3445 : A is ignored and not referenced. If both Alpha and Beta are zero, B is
3446 : filled by zeros.
3447 :
3448 : Input parameters:
3449 : M - number of rows
3450 : N - number of columns
3451 : Alpha- coefficient
3452 : A - source matrix, MxN submatrix is copied and transposed
3453 : IA - submatrix offset (row index)
3454 : JA - submatrix offset (column index)
3455 : Beta- coefficient
3456 : B - destination matrix, must be large enough to store result
3457 : IB - submatrix offset (row index)
3458 : JB - submatrix offset (column index)
3459 : *************************************************************************/
3460 0 : void rmatrixgencopy(const ae_int_t m, const ae_int_t n, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const double beta, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const xparams _xparams)
3461 : {
3462 : jmp_buf _break_jump;
3463 : alglib_impl::ae_state _alglib_env_state;
3464 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3465 0 : if( setjmp(_break_jump) )
3466 : {
3467 : #if !defined(AE_NO_EXCEPTIONS)
3468 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3469 : #else
3470 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3471 : return;
3472 : #endif
3473 : }
3474 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3475 0 : if( _xparams.flags!=0x0 )
3476 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3477 0 : alglib_impl::rmatrixgencopy(m, n, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, beta, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, &_alglib_env_state);
3478 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3479 0 : return;
3480 : }
3481 :
3482 : /*************************************************************************
3483 : Rank-1 correction: A := A + alpha*u*v'
3484 :
3485 : NOTE: this function expects A to be large enough to store result. No
3486 : automatic preallocation happens for smaller arrays. No integrity
3487 : checks is performed for sizes of A, u, v.
3488 :
3489 : INPUT PARAMETERS:
3490 : M - number of rows
3491 : N - number of columns
3492 : A - target matrix, MxN submatrix is updated
3493 : IA - submatrix offset (row index)
3494 : JA - submatrix offset (column index)
3495 : Alpha- coefficient
3496 : U - vector #1
3497 : IU - subvector offset
3498 : V - vector #2
3499 : IV - subvector offset
3500 :
3501 :
3502 : -- ALGLIB routine --
3503 :
3504 : 16.10.2017
3505 : Bochkanov Sergey
3506 : *************************************************************************/
3507 0 : void rmatrixger(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const double alpha, const real_1d_array &u, const ae_int_t iu, const real_1d_array &v, const ae_int_t iv, const xparams _xparams)
3508 : {
3509 : jmp_buf _break_jump;
3510 : alglib_impl::ae_state _alglib_env_state;
3511 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3512 0 : if( setjmp(_break_jump) )
3513 : {
3514 : #if !defined(AE_NO_EXCEPTIONS)
3515 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3516 : #else
3517 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3518 : return;
3519 : #endif
3520 : }
3521 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3522 0 : if( _xparams.flags!=0x0 )
3523 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3524 0 : alglib_impl::rmatrixger(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, alpha, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), iu, const_cast<alglib_impl::ae_vector*>(v.c_ptr()), iv, &_alglib_env_state);
3525 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3526 0 : return;
3527 : }
3528 :
3529 : /*************************************************************************
3530 : Rank-1 correction: A := A + u*v'
3531 :
3532 : INPUT PARAMETERS:
3533 : M - number of rows
3534 : N - number of columns
3535 : A - target matrix, MxN submatrix is updated
3536 : IA - submatrix offset (row index)
3537 : JA - submatrix offset (column index)
3538 : U - vector #1
3539 : IU - subvector offset
3540 : V - vector #2
3541 : IV - subvector offset
3542 : *************************************************************************/
3543 0 : void cmatrixrank1(const ae_int_t m, const ae_int_t n, complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_1d_array &u, const ae_int_t iu, complex_1d_array &v, const ae_int_t iv, const xparams _xparams)
3544 : {
3545 : jmp_buf _break_jump;
3546 : alglib_impl::ae_state _alglib_env_state;
3547 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3548 0 : if( setjmp(_break_jump) )
3549 : {
3550 : #if !defined(AE_NO_EXCEPTIONS)
3551 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3552 : #else
3553 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3554 : return;
3555 : #endif
3556 : }
3557 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3558 0 : if( _xparams.flags!=0x0 )
3559 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3560 0 : alglib_impl::cmatrixrank1(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), iu, const_cast<alglib_impl::ae_vector*>(v.c_ptr()), iv, &_alglib_env_state);
3561 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3562 0 : return;
3563 : }
3564 :
3565 : /*************************************************************************
3566 : IMPORTANT: this function is deprecated since ALGLIB 3.13. Use RMatrixGER()
3567 : which is more generic version of this function.
3568 :
3569 : Rank-1 correction: A := A + u*v'
3570 :
3571 : INPUT PARAMETERS:
3572 : M - number of rows
3573 : N - number of columns
3574 : A - target matrix, MxN submatrix is updated
3575 : IA - submatrix offset (row index)
3576 : JA - submatrix offset (column index)
3577 : U - vector #1
3578 : IU - subvector offset
3579 : V - vector #2
3580 : IV - subvector offset
3581 : *************************************************************************/
3582 0 : void rmatrixrank1(const ae_int_t m, const ae_int_t n, real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_1d_array &u, const ae_int_t iu, real_1d_array &v, const ae_int_t iv, const xparams _xparams)
3583 : {
3584 : jmp_buf _break_jump;
3585 : alglib_impl::ae_state _alglib_env_state;
3586 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3587 0 : if( setjmp(_break_jump) )
3588 : {
3589 : #if !defined(AE_NO_EXCEPTIONS)
3590 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3591 : #else
3592 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3593 : return;
3594 : #endif
3595 : }
3596 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3597 0 : if( _xparams.flags!=0x0 )
3598 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3599 0 : alglib_impl::rmatrixrank1(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), iu, const_cast<alglib_impl::ae_vector*>(v.c_ptr()), iv, &_alglib_env_state);
3600 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3601 0 : return;
3602 : }
3603 :
3604 : /*************************************************************************
3605 :
3606 : *************************************************************************/
3607 0 : void rmatrixgemv(const ae_int_t m, const ae_int_t n, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, const double beta, const real_1d_array &y, const ae_int_t iy, const xparams _xparams)
3608 : {
3609 : jmp_buf _break_jump;
3610 : alglib_impl::ae_state _alglib_env_state;
3611 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3612 0 : if( setjmp(_break_jump) )
3613 : {
3614 : #if !defined(AE_NO_EXCEPTIONS)
3615 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3616 : #else
3617 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3618 : return;
3619 : #endif
3620 : }
3621 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3622 0 : if( _xparams.flags!=0x0 )
3623 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3624 0 : alglib_impl::rmatrixgemv(m, n, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, opa, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, beta, const_cast<alglib_impl::ae_vector*>(y.c_ptr()), iy, &_alglib_env_state);
3625 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3626 0 : return;
3627 : }
3628 :
3629 : /*************************************************************************
3630 : Matrix-vector product: y := op(A)*x
3631 :
3632 : INPUT PARAMETERS:
3633 : M - number of rows of op(A)
3634 : M>=0
3635 : N - number of columns of op(A)
3636 : N>=0
3637 : A - target matrix
3638 : IA - submatrix offset (row index)
3639 : JA - submatrix offset (column index)
3640 : OpA - operation type:
3641 : * OpA=0 => op(A) = A
3642 : * OpA=1 => op(A) = A^T
3643 : * OpA=2 => op(A) = A^H
3644 : X - input vector
3645 : IX - subvector offset
3646 : IY - subvector offset
3647 : Y - preallocated matrix, must be large enough to store result
3648 :
3649 : OUTPUT PARAMETERS:
3650 : Y - vector which stores result
3651 :
3652 : if M=0, then subroutine does nothing.
3653 : if N=0, Y is filled by zeros.
3654 :
3655 :
3656 : -- ALGLIB routine --
3657 :
3658 : 28.01.2010
3659 : Bochkanov Sergey
3660 : *************************************************************************/
3661 0 : void cmatrixmv(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const complex_1d_array &x, const ae_int_t ix, complex_1d_array &y, const ae_int_t iy, const xparams _xparams)
3662 : {
3663 : jmp_buf _break_jump;
3664 : alglib_impl::ae_state _alglib_env_state;
3665 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3666 0 : if( setjmp(_break_jump) )
3667 : {
3668 : #if !defined(AE_NO_EXCEPTIONS)
3669 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3670 : #else
3671 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3672 : return;
3673 : #endif
3674 : }
3675 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3676 0 : if( _xparams.flags!=0x0 )
3677 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3678 0 : alglib_impl::cmatrixmv(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, opa, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, const_cast<alglib_impl::ae_vector*>(y.c_ptr()), iy, &_alglib_env_state);
3679 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3680 0 : return;
3681 : }
3682 :
3683 : /*************************************************************************
3684 : IMPORTANT: this function is deprecated since ALGLIB 3.13. Use RMatrixGEMV()
3685 : which is more generic version of this function.
3686 :
3687 : Matrix-vector product: y := op(A)*x
3688 :
3689 : INPUT PARAMETERS:
3690 : M - number of rows of op(A)
3691 : N - number of columns of op(A)
3692 : A - target matrix
3693 : IA - submatrix offset (row index)
3694 : JA - submatrix offset (column index)
3695 : OpA - operation type:
3696 : * OpA=0 => op(A) = A
3697 : * OpA=1 => op(A) = A^T
3698 : X - input vector
3699 : IX - subvector offset
3700 : IY - subvector offset
3701 : Y - preallocated matrix, must be large enough to store result
3702 :
3703 : OUTPUT PARAMETERS:
3704 : Y - vector which stores result
3705 :
3706 : if M=0, then subroutine does nothing.
3707 : if N=0, Y is filled by zeros.
3708 :
3709 :
3710 : -- ALGLIB routine --
3711 :
3712 : 28.01.2010
3713 : Bochkanov Sergey
3714 : *************************************************************************/
3715 0 : void rmatrixmv(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, const real_1d_array &y, const ae_int_t iy, const xparams _xparams)
3716 : {
3717 : jmp_buf _break_jump;
3718 : alglib_impl::ae_state _alglib_env_state;
3719 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3720 0 : if( setjmp(_break_jump) )
3721 : {
3722 : #if !defined(AE_NO_EXCEPTIONS)
3723 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3724 : #else
3725 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3726 : return;
3727 : #endif
3728 : }
3729 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3730 0 : if( _xparams.flags!=0x0 )
3731 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3732 0 : alglib_impl::rmatrixmv(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, opa, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, const_cast<alglib_impl::ae_vector*>(y.c_ptr()), iy, &_alglib_env_state);
3733 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3734 0 : return;
3735 : }
3736 :
3737 : /*************************************************************************
3738 :
3739 : *************************************************************************/
3740 0 : void rmatrixsymv(const ae_int_t n, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const bool isupper, const real_1d_array &x, const ae_int_t ix, const double beta, const real_1d_array &y, const ae_int_t iy, const xparams _xparams)
3741 : {
3742 : jmp_buf _break_jump;
3743 : alglib_impl::ae_state _alglib_env_state;
3744 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3745 0 : if( setjmp(_break_jump) )
3746 : {
3747 : #if !defined(AE_NO_EXCEPTIONS)
3748 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3749 : #else
3750 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3751 : return;
3752 : #endif
3753 : }
3754 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3755 0 : if( _xparams.flags!=0x0 )
3756 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3757 0 : alglib_impl::rmatrixsymv(n, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, isupper, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, beta, const_cast<alglib_impl::ae_vector*>(y.c_ptr()), iy, &_alglib_env_state);
3758 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3759 0 : return;
3760 : }
3761 :
3762 : /*************************************************************************
3763 :
3764 : *************************************************************************/
3765 0 : double rmatrixsyvmv(const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const bool isupper, const real_1d_array &x, const ae_int_t ix, const real_1d_array &tmp, const xparams _xparams)
3766 : {
3767 : jmp_buf _break_jump;
3768 : alglib_impl::ae_state _alglib_env_state;
3769 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3770 0 : if( setjmp(_break_jump) )
3771 : {
3772 : #if !defined(AE_NO_EXCEPTIONS)
3773 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3774 : #else
3775 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3776 : return 0;
3777 : #endif
3778 : }
3779 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3780 0 : if( _xparams.flags!=0x0 )
3781 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3782 0 : double result = alglib_impl::rmatrixsyvmv(n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, isupper, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, const_cast<alglib_impl::ae_vector*>(tmp.c_ptr()), &_alglib_env_state);
3783 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3784 0 : return *(reinterpret_cast<double*>(&result));
3785 : }
3786 :
3787 : /*************************************************************************
3788 : This subroutine solves linear system op(A)*x=b where:
3789 : * A is NxN upper/lower triangular/unitriangular matrix
3790 : * X and B are Nx1 vectors
3791 : * "op" may be identity transformation, transposition, conjugate transposition
3792 :
3793 : Solution replaces X.
3794 :
3795 : IMPORTANT: * no overflow/underflow/denegeracy tests is performed.
3796 : * no integrity checks for operand sizes, out-of-bounds accesses
3797 : and so on is performed
3798 :
3799 : INPUT PARAMETERS
3800 : N - matrix size, N>=0
3801 : A - matrix, actial matrix is stored in A[IA:IA+N-1,JA:JA+N-1]
3802 : IA - submatrix offset
3803 : JA - submatrix offset
3804 : IsUpper - whether matrix is upper triangular
3805 : IsUnit - whether matrix is unitriangular
3806 : OpType - transformation type:
3807 : * 0 - no transformation
3808 : * 1 - transposition
3809 : X - right part, actual vector is stored in X[IX:IX+N-1]
3810 : IX - offset
3811 :
3812 : OUTPUT PARAMETERS
3813 : X - solution replaces elements X[IX:IX+N-1]
3814 :
3815 : -- ALGLIB routine / remastering of LAPACK's DTRSV --
3816 : (c) 2017 Bochkanov Sergey - converted to ALGLIB
3817 : (c) 2016 Reference BLAS level1 routine (LAPACK version 3.7.0)
3818 : Reference BLAS is a software package provided by Univ. of Tennessee,
3819 : Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.
3820 : *************************************************************************/
3821 0 : void rmatrixtrsv(const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const bool isupper, const bool isunit, const ae_int_t optype, const real_1d_array &x, const ae_int_t ix, const xparams _xparams)
3822 : {
3823 : jmp_buf _break_jump;
3824 : alglib_impl::ae_state _alglib_env_state;
3825 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3826 0 : if( setjmp(_break_jump) )
3827 : {
3828 : #if !defined(AE_NO_EXCEPTIONS)
3829 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3830 : #else
3831 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3832 : return;
3833 : #endif
3834 : }
3835 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3836 0 : if( _xparams.flags!=0x0 )
3837 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3838 0 : alglib_impl::rmatrixtrsv(n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, isupper, isunit, optype, const_cast<alglib_impl::ae_vector*>(x.c_ptr()), ix, &_alglib_env_state);
3839 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3840 0 : return;
3841 : }
3842 :
3843 : /*************************************************************************
3844 : This subroutine calculates X*op(A^-1) where:
3845 : * X is MxN general matrix
3846 : * A is NxN upper/lower triangular/unitriangular matrix
3847 : * "op" may be identity transformation, transposition, conjugate transposition
3848 : Multiplication result replaces X.
3849 :
3850 : ! COMMERCIAL EDITION OF ALGLIB:
3851 : !
3852 : ! Commercial Edition of ALGLIB includes following important improvements
3853 : ! of this function:
3854 : ! * high-performance native backend with same C# interface (C# version)
3855 : ! * multithreading support (C++ and C# versions)
3856 : ! * hardware vendor (Intel) implementations of linear algebra primitives
3857 : ! (C++ and C# versions, x86/x64 platform)
3858 : !
3859 : ! We recommend you to read 'Working with commercial version' section of
3860 : ! ALGLIB Reference Manual in order to find out how to use performance-
3861 : ! related features provided by commercial edition of ALGLIB.
3862 :
3863 : INPUT PARAMETERS
3864 : N - matrix size, N>=0
3865 : M - matrix size, N>=0
3866 : A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1]
3867 : I1 - submatrix offset
3868 : J1 - submatrix offset
3869 : IsUpper - whether matrix is upper triangular
3870 : IsUnit - whether matrix is unitriangular
3871 : OpType - transformation type:
3872 : * 0 - no transformation
3873 : * 1 - transposition
3874 : * 2 - conjugate transposition
3875 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
3876 : I2 - submatrix offset
3877 : J2 - submatrix offset
3878 :
3879 : -- ALGLIB routine --
3880 : 20.01.2018
3881 : Bochkanov Sergey
3882 : *************************************************************************/
3883 0 : void cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2, const xparams _xparams)
3884 : {
3885 : jmp_buf _break_jump;
3886 : alglib_impl::ae_state _alglib_env_state;
3887 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3888 0 : if( setjmp(_break_jump) )
3889 : {
3890 : #if !defined(AE_NO_EXCEPTIONS)
3891 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3892 : #else
3893 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3894 : return;
3895 : #endif
3896 : }
3897 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3898 0 : if( _xparams.flags!=0x0 )
3899 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3900 0 : alglib_impl::cmatrixrighttrsm(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast<alglib_impl::ae_matrix*>(x.c_ptr()), i2, j2, &_alglib_env_state);
3901 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3902 0 : return;
3903 : }
3904 :
3905 : /*************************************************************************
3906 : This subroutine calculates op(A^-1)*X where:
3907 : * X is MxN general matrix
3908 : * A is MxM upper/lower triangular/unitriangular matrix
3909 : * "op" may be identity transformation, transposition, conjugate transposition
3910 : Multiplication result replaces X.
3911 :
3912 : ! COMMERCIAL EDITION OF ALGLIB:
3913 : !
3914 : ! Commercial Edition of ALGLIB includes following important improvements
3915 : ! of this function:
3916 : ! * high-performance native backend with same C# interface (C# version)
3917 : ! * multithreading support (C++ and C# versions)
3918 : ! * hardware vendor (Intel) implementations of linear algebra primitives
3919 : ! (C++ and C# versions, x86/x64 platform)
3920 : !
3921 : ! We recommend you to read 'Working with commercial version' section of
3922 : ! ALGLIB Reference Manual in order to find out how to use performance-
3923 : ! related features provided by commercial edition of ALGLIB.
3924 :
3925 : INPUT PARAMETERS
3926 : N - matrix size, N>=0
3927 : M - matrix size, N>=0
3928 : A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1]
3929 : I1 - submatrix offset
3930 : J1 - submatrix offset
3931 : IsUpper - whether matrix is upper triangular
3932 : IsUnit - whether matrix is unitriangular
3933 : OpType - transformation type:
3934 : * 0 - no transformation
3935 : * 1 - transposition
3936 : * 2 - conjugate transposition
3937 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
3938 : I2 - submatrix offset
3939 : J2 - submatrix offset
3940 :
3941 : -- ALGLIB routine --
3942 : 15.12.2009-22.01.2018
3943 : Bochkanov Sergey
3944 : *************************************************************************/
3945 0 : void cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2, const xparams _xparams)
3946 : {
3947 : jmp_buf _break_jump;
3948 : alglib_impl::ae_state _alglib_env_state;
3949 0 : alglib_impl::ae_state_init(&_alglib_env_state);
3950 0 : if( setjmp(_break_jump) )
3951 : {
3952 : #if !defined(AE_NO_EXCEPTIONS)
3953 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
3954 : #else
3955 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
3956 : return;
3957 : #endif
3958 : }
3959 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
3960 0 : if( _xparams.flags!=0x0 )
3961 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
3962 0 : alglib_impl::cmatrixlefttrsm(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast<alglib_impl::ae_matrix*>(x.c_ptr()), i2, j2, &_alglib_env_state);
3963 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
3964 0 : return;
3965 : }
3966 :
3967 : /*************************************************************************
3968 : This subroutine calculates X*op(A^-1) where:
3969 : * X is MxN general matrix
3970 : * A is NxN upper/lower triangular/unitriangular matrix
3971 : * "op" may be identity transformation, transposition
3972 : Multiplication result replaces X.
3973 :
3974 : ! COMMERCIAL EDITION OF ALGLIB:
3975 : !
3976 : ! Commercial Edition of ALGLIB includes following important improvements
3977 : ! of this function:
3978 : ! * high-performance native backend with same C# interface (C# version)
3979 : ! * multithreading support (C++ and C# versions)
3980 : ! * hardware vendor (Intel) implementations of linear algebra primitives
3981 : ! (C++ and C# versions, x86/x64 platform)
3982 : !
3983 : ! We recommend you to read 'Working with commercial version' section of
3984 : ! ALGLIB Reference Manual in order to find out how to use performance-
3985 : ! related features provided by commercial edition of ALGLIB.
3986 :
3987 : INPUT PARAMETERS
3988 : N - matrix size, N>=0
3989 : M - matrix size, N>=0
3990 : A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1]
3991 : I1 - submatrix offset
3992 : J1 - submatrix offset
3993 : IsUpper - whether matrix is upper triangular
3994 : IsUnit - whether matrix is unitriangular
3995 : OpType - transformation type:
3996 : * 0 - no transformation
3997 : * 1 - transposition
3998 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
3999 : I2 - submatrix offset
4000 : J2 - submatrix offset
4001 :
4002 : -- ALGLIB routine --
4003 : 15.12.2009-22.01.2018
4004 : Bochkanov Sergey
4005 : *************************************************************************/
4006 0 : void rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2, const xparams _xparams)
4007 : {
4008 : jmp_buf _break_jump;
4009 : alglib_impl::ae_state _alglib_env_state;
4010 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4011 0 : if( setjmp(_break_jump) )
4012 : {
4013 : #if !defined(AE_NO_EXCEPTIONS)
4014 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4015 : #else
4016 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4017 : return;
4018 : #endif
4019 : }
4020 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4021 0 : if( _xparams.flags!=0x0 )
4022 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4023 0 : alglib_impl::rmatrixrighttrsm(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast<alglib_impl::ae_matrix*>(x.c_ptr()), i2, j2, &_alglib_env_state);
4024 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4025 0 : return;
4026 : }
4027 :
4028 : /*************************************************************************
4029 : This subroutine calculates op(A^-1)*X where:
4030 : * X is MxN general matrix
4031 : * A is MxM upper/lower triangular/unitriangular matrix
4032 : * "op" may be identity transformation, transposition
4033 : Multiplication result replaces X.
4034 :
4035 : ! COMMERCIAL EDITION OF ALGLIB:
4036 : !
4037 : ! Commercial Edition of ALGLIB includes following important improvements
4038 : ! of this function:
4039 : ! * high-performance native backend with same C# interface (C# version)
4040 : ! * multithreading support (C++ and C# versions)
4041 : ! * hardware vendor (Intel) implementations of linear algebra primitives
4042 : ! (C++ and C# versions, x86/x64 platform)
4043 : !
4044 : ! We recommend you to read 'Working with commercial version' section of
4045 : ! ALGLIB Reference Manual in order to find out how to use performance-
4046 : ! related features provided by commercial edition of ALGLIB.
4047 :
4048 : INPUT PARAMETERS
4049 : N - matrix size, N>=0
4050 : M - matrix size, N>=0
4051 : A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1]
4052 : I1 - submatrix offset
4053 : J1 - submatrix offset
4054 : IsUpper - whether matrix is upper triangular
4055 : IsUnit - whether matrix is unitriangular
4056 : OpType - transformation type:
4057 : * 0 - no transformation
4058 : * 1 - transposition
4059 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
4060 : I2 - submatrix offset
4061 : J2 - submatrix offset
4062 :
4063 : -- ALGLIB routine --
4064 : 15.12.2009-22.01.2018
4065 : Bochkanov Sergey
4066 : *************************************************************************/
4067 0 : void rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2, const xparams _xparams)
4068 : {
4069 : jmp_buf _break_jump;
4070 : alglib_impl::ae_state _alglib_env_state;
4071 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4072 0 : if( setjmp(_break_jump) )
4073 : {
4074 : #if !defined(AE_NO_EXCEPTIONS)
4075 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4076 : #else
4077 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4078 : return;
4079 : #endif
4080 : }
4081 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4082 0 : if( _xparams.flags!=0x0 )
4083 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4084 0 : alglib_impl::rmatrixlefttrsm(m, n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast<alglib_impl::ae_matrix*>(x.c_ptr()), i2, j2, &_alglib_env_state);
4085 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4086 0 : return;
4087 : }
4088 :
4089 : /*************************************************************************
4090 : This subroutine calculates C=alpha*A*A^H+beta*C or C=alpha*A^H*A+beta*C
4091 : where:
4092 : * C is NxN Hermitian matrix given by its upper/lower triangle
4093 : * A is NxK matrix when A*A^H is calculated, KxN matrix otherwise
4094 :
4095 : Additional info:
4096 : * multiplication result replaces C. If Beta=0, C elements are not used in
4097 : calculations (not multiplied by zero - just not referenced)
4098 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
4099 : * if both Beta and Alpha are zero, C is filled by zeros.
4100 :
4101 : ! COMMERCIAL EDITION OF ALGLIB:
4102 : !
4103 : ! Commercial Edition of ALGLIB includes following important improvements
4104 : ! of this function:
4105 : ! * high-performance native backend with same C# interface (C# version)
4106 : ! * multithreading support (C++ and C# versions)
4107 : ! * hardware vendor (Intel) implementations of linear algebra primitives
4108 : ! (C++ and C# versions, x86/x64 platform)
4109 : !
4110 : ! We recommend you to read 'Working with commercial version' section of
4111 : ! ALGLIB Reference Manual in order to find out how to use performance-
4112 : ! related features provided by commercial edition of ALGLIB.
4113 :
4114 : INPUT PARAMETERS
4115 : N - matrix size, N>=0
4116 : K - matrix size, K>=0
4117 : Alpha - coefficient
4118 : A - matrix
4119 : IA - submatrix offset (row index)
4120 : JA - submatrix offset (column index)
4121 : OpTypeA - multiplication type:
4122 : * 0 - A*A^H is calculated
4123 : * 2 - A^H*A is calculated
4124 : Beta - coefficient
4125 : C - preallocated input/output matrix
4126 : IC - submatrix offset (row index)
4127 : JC - submatrix offset (column index)
4128 : IsUpper - whether upper or lower triangle of C is updated;
4129 : this function updates only one half of C, leaving
4130 : other half unchanged (not referenced at all).
4131 :
4132 : -- ALGLIB routine --
4133 : 16.12.2009-22.01.2018
4134 : Bochkanov Sergey
4135 : *************************************************************************/
4136 0 : void cmatrixherk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper, const xparams _xparams)
4137 : {
4138 : jmp_buf _break_jump;
4139 : alglib_impl::ae_state _alglib_env_state;
4140 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4141 0 : if( setjmp(_break_jump) )
4142 : {
4143 : #if !defined(AE_NO_EXCEPTIONS)
4144 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4145 : #else
4146 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4147 : return;
4148 : #endif
4149 : }
4150 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4151 0 : if( _xparams.flags!=0x0 )
4152 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4153 0 : alglib_impl::cmatrixherk(n, k, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, optypea, beta, const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ic, jc, isupper, &_alglib_env_state);
4154 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4155 0 : return;
4156 : }
4157 :
4158 : /*************************************************************************
4159 : This subroutine calculates C=alpha*A*A^T+beta*C or C=alpha*A^T*A+beta*C
4160 : where:
4161 : * C is NxN symmetric matrix given by its upper/lower triangle
4162 : * A is NxK matrix when A*A^T is calculated, KxN matrix otherwise
4163 :
4164 : Additional info:
4165 : * multiplication result replaces C. If Beta=0, C elements are not used in
4166 : calculations (not multiplied by zero - just not referenced)
4167 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
4168 : * if both Beta and Alpha are zero, C is filled by zeros.
4169 :
4170 : ! COMMERCIAL EDITION OF ALGLIB:
4171 : !
4172 : ! Commercial Edition of ALGLIB includes following important improvements
4173 : ! of this function:
4174 : ! * high-performance native backend with same C# interface (C# version)
4175 : ! * multithreading support (C++ and C# versions)
4176 : ! * hardware vendor (Intel) implementations of linear algebra primitives
4177 : ! (C++ and C# versions, x86/x64 platform)
4178 : !
4179 : ! We recommend you to read 'Working with commercial version' section of
4180 : ! ALGLIB Reference Manual in order to find out how to use performance-
4181 : ! related features provided by commercial edition of ALGLIB.
4182 :
4183 : INPUT PARAMETERS
4184 : N - matrix size, N>=0
4185 : K - matrix size, K>=0
4186 : Alpha - coefficient
4187 : A - matrix
4188 : IA - submatrix offset (row index)
4189 : JA - submatrix offset (column index)
4190 : OpTypeA - multiplication type:
4191 : * 0 - A*A^T is calculated
4192 : * 2 - A^T*A is calculated
4193 : Beta - coefficient
4194 : C - preallocated input/output matrix
4195 : IC - submatrix offset (row index)
4196 : JC - submatrix offset (column index)
4197 : IsUpper - whether C is upper triangular or lower triangular
4198 :
4199 : -- ALGLIB routine --
4200 : 16.12.2009-22.01.2018
4201 : Bochkanov Sergey
4202 : *************************************************************************/
4203 0 : void rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper, const xparams _xparams)
4204 : {
4205 : jmp_buf _break_jump;
4206 : alglib_impl::ae_state _alglib_env_state;
4207 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4208 0 : if( setjmp(_break_jump) )
4209 : {
4210 : #if !defined(AE_NO_EXCEPTIONS)
4211 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4212 : #else
4213 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4214 : return;
4215 : #endif
4216 : }
4217 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4218 0 : if( _xparams.flags!=0x0 )
4219 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4220 0 : alglib_impl::rmatrixsyrk(n, k, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, optypea, beta, const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ic, jc, isupper, &_alglib_env_state);
4221 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4222 0 : return;
4223 : }
4224 :
4225 : /*************************************************************************
4226 : This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:
4227 : * C is MxN general matrix
4228 : * op1(A) is MxK matrix
4229 : * op2(B) is KxN matrix
4230 : * "op" may be identity transformation, transposition, conjugate transposition
4231 :
4232 : Additional info:
4233 : * cache-oblivious algorithm is used.
4234 : * multiplication result replaces C. If Beta=0, C elements are not used in
4235 : calculations (not multiplied by zero - just not referenced)
4236 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
4237 : * if both Beta and Alpha are zero, C is filled by zeros.
4238 :
4239 : ! COMMERCIAL EDITION OF ALGLIB:
4240 : !
4241 : ! Commercial Edition of ALGLIB includes following important improvements
4242 : ! of this function:
4243 : ! * high-performance native backend with same C# interface (C# version)
4244 : ! * multithreading support (C++ and C# versions)
4245 : ! * hardware vendor (Intel) implementations of linear algebra primitives
4246 : ! (C++ and C# versions, x86/x64 platform)
4247 : !
4248 : ! We recommend you to read 'Working with commercial version' section of
4249 : ! ALGLIB Reference Manual in order to find out how to use performance-
4250 : ! related features provided by commercial edition of ALGLIB.
4251 :
4252 : IMPORTANT:
4253 :
4254 : This function does NOT preallocate output matrix C, it MUST be preallocated
4255 : by caller prior to calling this function. In case C does not have enough
4256 : space to store result, exception will be generated.
4257 :
4258 : INPUT PARAMETERS
4259 : M - matrix size, M>0
4260 : N - matrix size, N>0
4261 : K - matrix size, K>0
4262 : Alpha - coefficient
4263 : A - matrix
4264 : IA - submatrix offset
4265 : JA - submatrix offset
4266 : OpTypeA - transformation type:
4267 : * 0 - no transformation
4268 : * 1 - transposition
4269 : * 2 - conjugate transposition
4270 : B - matrix
4271 : IB - submatrix offset
4272 : JB - submatrix offset
4273 : OpTypeB - transformation type:
4274 : * 0 - no transformation
4275 : * 1 - transposition
4276 : * 2 - conjugate transposition
4277 : Beta - coefficient
4278 : C - matrix (PREALLOCATED, large enough to store result)
4279 : IC - submatrix offset
4280 : JC - submatrix offset
4281 :
4282 : -- ALGLIB routine --
4283 : 2009-2019
4284 : Bochkanov Sergey
4285 : *************************************************************************/
4286 0 : void cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const xparams _xparams)
4287 : {
4288 : jmp_buf _break_jump;
4289 : alglib_impl::ae_state _alglib_env_state;
4290 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4291 0 : if( setjmp(_break_jump) )
4292 : {
4293 : #if !defined(AE_NO_EXCEPTIONS)
4294 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4295 : #else
4296 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4297 : return;
4298 : #endif
4299 : }
4300 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4301 0 : if( _xparams.flags!=0x0 )
4302 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4303 0 : alglib_impl::cmatrixgemm(m, n, k, *alpha.c_ptr(), const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, optypea, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, optypeb, *beta.c_ptr(), const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ic, jc, &_alglib_env_state);
4304 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4305 0 : return;
4306 : }
4307 :
4308 : /*************************************************************************
4309 : This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:
4310 : * C is MxN general matrix
4311 : * op1(A) is MxK matrix
4312 : * op2(B) is KxN matrix
4313 : * "op" may be identity transformation, transposition
4314 :
4315 : Additional info:
4316 : * cache-oblivious algorithm is used.
4317 : * multiplication result replaces C. If Beta=0, C elements are not used in
4318 : calculations (not multiplied by zero - just not referenced)
4319 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
4320 : * if both Beta and Alpha are zero, C is filled by zeros.
4321 :
4322 : ! COMMERCIAL EDITION OF ALGLIB:
4323 : !
4324 : ! Commercial Edition of ALGLIB includes following important improvements
4325 : ! of this function:
4326 : ! * high-performance native backend with same C# interface (C# version)
4327 : ! * multithreading support (C++ and C# versions)
4328 : ! * hardware vendor (Intel) implementations of linear algebra primitives
4329 : ! (C++ and C# versions, x86/x64 platform)
4330 : !
4331 : ! We recommend you to read 'Working with commercial version' section of
4332 : ! ALGLIB Reference Manual in order to find out how to use performance-
4333 : ! related features provided by commercial edition of ALGLIB.
4334 :
4335 : IMPORTANT:
4336 :
4337 : This function does NOT preallocate output matrix C, it MUST be preallocated
4338 : by caller prior to calling this function. In case C does not have enough
4339 : space to store result, exception will be generated.
4340 :
4341 : INPUT PARAMETERS
4342 : M - matrix size, M>0
4343 : N - matrix size, N>0
4344 : K - matrix size, K>0
4345 : Alpha - coefficient
4346 : A - matrix
4347 : IA - submatrix offset
4348 : JA - submatrix offset
4349 : OpTypeA - transformation type:
4350 : * 0 - no transformation
4351 : * 1 - transposition
4352 : B - matrix
4353 : IB - submatrix offset
4354 : JB - submatrix offset
4355 : OpTypeB - transformation type:
4356 : * 0 - no transformation
4357 : * 1 - transposition
4358 : Beta - coefficient
4359 : C - PREALLOCATED output matrix, large enough to store result
4360 : IC - submatrix offset
4361 : JC - submatrix offset
4362 :
4363 : -- ALGLIB routine --
4364 : 2009-2019
4365 : Bochkanov Sergey
4366 : *************************************************************************/
4367 0 : void rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const xparams _xparams)
4368 : {
4369 : jmp_buf _break_jump;
4370 : alglib_impl::ae_state _alglib_env_state;
4371 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4372 0 : if( setjmp(_break_jump) )
4373 : {
4374 : #if !defined(AE_NO_EXCEPTIONS)
4375 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4376 : #else
4377 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4378 : return;
4379 : #endif
4380 : }
4381 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4382 0 : if( _xparams.flags!=0x0 )
4383 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4384 0 : alglib_impl::rmatrixgemm(m, n, k, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, optypea, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), ib, jb, optypeb, beta, const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ic, jc, &_alglib_env_state);
4385 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4386 0 : return;
4387 : }
4388 :
4389 : /*************************************************************************
4390 : This subroutine is an older version of CMatrixHERK(), one with wrong name
4391 : (it is HErmitian update, not SYmmetric). It is left here for backward
4392 : compatibility.
4393 :
4394 : -- ALGLIB routine --
4395 : 16.12.2009
4396 : Bochkanov Sergey
4397 : *************************************************************************/
4398 0 : void cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper, const xparams _xparams)
4399 : {
4400 : jmp_buf _break_jump;
4401 : alglib_impl::ae_state _alglib_env_state;
4402 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4403 0 : if( setjmp(_break_jump) )
4404 : {
4405 : #if !defined(AE_NO_EXCEPTIONS)
4406 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4407 : #else
4408 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4409 : return;
4410 : #endif
4411 : }
4412 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4413 0 : if( _xparams.flags!=0x0 )
4414 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4415 0 : alglib_impl::cmatrixsyrk(n, k, alpha, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), ia, ja, optypea, beta, const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ic, jc, isupper, &_alglib_env_state);
4416 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4417 0 : return;
4418 : }
4419 : #endif
4420 :
4421 : #if defined(AE_COMPILE_DLU) || !defined(AE_PARTIAL_BUILD)
4422 :
4423 : #endif
4424 :
4425 : #if defined(AE_COMPILE_SPTRF) || !defined(AE_PARTIAL_BUILD)
4426 :
4427 : #endif
4428 :
4429 : #if defined(AE_COMPILE_AMDORDERING) || !defined(AE_PARTIAL_BUILD)
4430 :
4431 : #endif
4432 :
4433 : #if defined(AE_COMPILE_SPCHOL) || !defined(AE_PARTIAL_BUILD)
4434 :
4435 : #endif
4436 :
4437 : #if defined(AE_COMPILE_MATGEN) || !defined(AE_PARTIAL_BUILD)
4438 : /*************************************************************************
4439 : Generation of a random uniformly distributed (Haar) orthogonal matrix
4440 :
4441 : INPUT PARAMETERS:
4442 : N - matrix size, N>=1
4443 :
4444 : OUTPUT PARAMETERS:
4445 : A - orthogonal NxN matrix, array[0..N-1,0..N-1]
4446 :
4447 : NOTE: this function uses algorithm described in Stewart, G. W. (1980),
4448 : "The Efficient Generation of Random Orthogonal Matrices with an
4449 : Application to Condition Estimators".
4450 :
4451 : Speaking short, to generate an (N+1)x(N+1) orthogonal matrix, it:
4452 : * takes an NxN one
4453 : * takes uniformly distributed unit vector of dimension N+1.
4454 : * constructs a Householder reflection from the vector, then applies
4455 : it to the smaller matrix (embedded in the larger size with a 1 at
4456 : the bottom right corner).
4457 :
4458 : -- ALGLIB routine --
4459 : 04.12.2009
4460 : Bochkanov Sergey
4461 : *************************************************************************/
4462 0 : void rmatrixrndorthogonal(const ae_int_t n, real_2d_array &a, const xparams _xparams)
4463 : {
4464 : jmp_buf _break_jump;
4465 : alglib_impl::ae_state _alglib_env_state;
4466 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4467 0 : if( setjmp(_break_jump) )
4468 : {
4469 : #if !defined(AE_NO_EXCEPTIONS)
4470 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4471 : #else
4472 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4473 : return;
4474 : #endif
4475 : }
4476 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4477 0 : if( _xparams.flags!=0x0 )
4478 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4479 0 : alglib_impl::rmatrixrndorthogonal(n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4480 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4481 0 : return;
4482 : }
4483 :
4484 : /*************************************************************************
4485 : Generation of random NxN matrix with given condition number and norm2(A)=1
4486 :
4487 : INPUT PARAMETERS:
4488 : N - matrix size
4489 : C - condition number (in 2-norm)
4490 :
4491 : OUTPUT PARAMETERS:
4492 : A - random matrix with norm2(A)=1 and cond(A)=C
4493 :
4494 : -- ALGLIB routine --
4495 : 04.12.2009
4496 : Bochkanov Sergey
4497 : *************************************************************************/
4498 0 : void rmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a, const xparams _xparams)
4499 : {
4500 : jmp_buf _break_jump;
4501 : alglib_impl::ae_state _alglib_env_state;
4502 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4503 0 : if( setjmp(_break_jump) )
4504 : {
4505 : #if !defined(AE_NO_EXCEPTIONS)
4506 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4507 : #else
4508 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4509 : return;
4510 : #endif
4511 : }
4512 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4513 0 : if( _xparams.flags!=0x0 )
4514 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4515 0 : alglib_impl::rmatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4516 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4517 0 : return;
4518 : }
4519 :
4520 : /*************************************************************************
4521 : Generation of a random Haar distributed orthogonal complex matrix
4522 :
4523 : INPUT PARAMETERS:
4524 : N - matrix size, N>=1
4525 :
4526 : OUTPUT PARAMETERS:
4527 : A - orthogonal NxN matrix, array[0..N-1,0..N-1]
4528 :
4529 : NOTE: this function uses algorithm described in Stewart, G. W. (1980),
4530 : "The Efficient Generation of Random Orthogonal Matrices with an
4531 : Application to Condition Estimators".
4532 :
4533 : Speaking short, to generate an (N+1)x(N+1) orthogonal matrix, it:
4534 : * takes an NxN one
4535 : * takes uniformly distributed unit vector of dimension N+1.
4536 : * constructs a Householder reflection from the vector, then applies
4537 : it to the smaller matrix (embedded in the larger size with a 1 at
4538 : the bottom right corner).
4539 :
4540 : -- ALGLIB routine --
4541 : 04.12.2009
4542 : Bochkanov Sergey
4543 : *************************************************************************/
4544 0 : void cmatrixrndorthogonal(const ae_int_t n, complex_2d_array &a, const xparams _xparams)
4545 : {
4546 : jmp_buf _break_jump;
4547 : alglib_impl::ae_state _alglib_env_state;
4548 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4549 0 : if( setjmp(_break_jump) )
4550 : {
4551 : #if !defined(AE_NO_EXCEPTIONS)
4552 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4553 : #else
4554 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4555 : return;
4556 : #endif
4557 : }
4558 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4559 0 : if( _xparams.flags!=0x0 )
4560 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4561 0 : alglib_impl::cmatrixrndorthogonal(n, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4562 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4563 0 : return;
4564 : }
4565 :
4566 : /*************************************************************************
4567 : Generation of random NxN complex matrix with given condition number C and
4568 : norm2(A)=1
4569 :
4570 : INPUT PARAMETERS:
4571 : N - matrix size
4572 : C - condition number (in 2-norm)
4573 :
4574 : OUTPUT PARAMETERS:
4575 : A - random matrix with norm2(A)=1 and cond(A)=C
4576 :
4577 : -- ALGLIB routine --
4578 : 04.12.2009
4579 : Bochkanov Sergey
4580 : *************************************************************************/
4581 0 : void cmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a, const xparams _xparams)
4582 : {
4583 : jmp_buf _break_jump;
4584 : alglib_impl::ae_state _alglib_env_state;
4585 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4586 0 : if( setjmp(_break_jump) )
4587 : {
4588 : #if !defined(AE_NO_EXCEPTIONS)
4589 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4590 : #else
4591 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4592 : return;
4593 : #endif
4594 : }
4595 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4596 0 : if( _xparams.flags!=0x0 )
4597 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4598 0 : alglib_impl::cmatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4599 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4600 0 : return;
4601 : }
4602 :
4603 : /*************************************************************************
4604 : Generation of random NxN symmetric matrix with given condition number and
4605 : norm2(A)=1
4606 :
4607 : INPUT PARAMETERS:
4608 : N - matrix size
4609 : C - condition number (in 2-norm)
4610 :
4611 : OUTPUT PARAMETERS:
4612 : A - random matrix with norm2(A)=1 and cond(A)=C
4613 :
4614 : -- ALGLIB routine --
4615 : 04.12.2009
4616 : Bochkanov Sergey
4617 : *************************************************************************/
4618 0 : void smatrixrndcond(const ae_int_t n, const double c, real_2d_array &a, const xparams _xparams)
4619 : {
4620 : jmp_buf _break_jump;
4621 : alglib_impl::ae_state _alglib_env_state;
4622 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4623 0 : if( setjmp(_break_jump) )
4624 : {
4625 : #if !defined(AE_NO_EXCEPTIONS)
4626 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4627 : #else
4628 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4629 : return;
4630 : #endif
4631 : }
4632 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4633 0 : if( _xparams.flags!=0x0 )
4634 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4635 0 : alglib_impl::smatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4636 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4637 0 : return;
4638 : }
4639 :
4640 : /*************************************************************************
4641 : Generation of random NxN symmetric positive definite matrix with given
4642 : condition number and norm2(A)=1
4643 :
4644 : INPUT PARAMETERS:
4645 : N - matrix size
4646 : C - condition number (in 2-norm)
4647 :
4648 : OUTPUT PARAMETERS:
4649 : A - random SPD matrix with norm2(A)=1 and cond(A)=C
4650 :
4651 : -- ALGLIB routine --
4652 : 04.12.2009
4653 : Bochkanov Sergey
4654 : *************************************************************************/
4655 0 : void spdmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a, const xparams _xparams)
4656 : {
4657 : jmp_buf _break_jump;
4658 : alglib_impl::ae_state _alglib_env_state;
4659 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4660 0 : if( setjmp(_break_jump) )
4661 : {
4662 : #if !defined(AE_NO_EXCEPTIONS)
4663 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4664 : #else
4665 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4666 : return;
4667 : #endif
4668 : }
4669 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4670 0 : if( _xparams.flags!=0x0 )
4671 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4672 0 : alglib_impl::spdmatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4673 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4674 0 : return;
4675 : }
4676 :
4677 : /*************************************************************************
4678 : Generation of random NxN Hermitian matrix with given condition number and
4679 : norm2(A)=1
4680 :
4681 : INPUT PARAMETERS:
4682 : N - matrix size
4683 : C - condition number (in 2-norm)
4684 :
4685 : OUTPUT PARAMETERS:
4686 : A - random matrix with norm2(A)=1 and cond(A)=C
4687 :
4688 : -- ALGLIB routine --
4689 : 04.12.2009
4690 : Bochkanov Sergey
4691 : *************************************************************************/
4692 0 : void hmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a, const xparams _xparams)
4693 : {
4694 : jmp_buf _break_jump;
4695 : alglib_impl::ae_state _alglib_env_state;
4696 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4697 0 : if( setjmp(_break_jump) )
4698 : {
4699 : #if !defined(AE_NO_EXCEPTIONS)
4700 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4701 : #else
4702 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4703 : return;
4704 : #endif
4705 : }
4706 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4707 0 : if( _xparams.flags!=0x0 )
4708 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4709 0 : alglib_impl::hmatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4710 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4711 0 : return;
4712 : }
4713 :
4714 : /*************************************************************************
4715 : Generation of random NxN Hermitian positive definite matrix with given
4716 : condition number and norm2(A)=1
4717 :
4718 : INPUT PARAMETERS:
4719 : N - matrix size
4720 : C - condition number (in 2-norm)
4721 :
4722 : OUTPUT PARAMETERS:
4723 : A - random HPD matrix with norm2(A)=1 and cond(A)=C
4724 :
4725 : -- ALGLIB routine --
4726 : 04.12.2009
4727 : Bochkanov Sergey
4728 : *************************************************************************/
4729 0 : void hpdmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a, const xparams _xparams)
4730 : {
4731 : jmp_buf _break_jump;
4732 : alglib_impl::ae_state _alglib_env_state;
4733 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4734 0 : if( setjmp(_break_jump) )
4735 : {
4736 : #if !defined(AE_NO_EXCEPTIONS)
4737 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4738 : #else
4739 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4740 : return;
4741 : #endif
4742 : }
4743 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4744 0 : if( _xparams.flags!=0x0 )
4745 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4746 0 : alglib_impl::hpdmatrixrndcond(n, c, const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), &_alglib_env_state);
4747 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4748 0 : return;
4749 : }
4750 :
4751 : /*************************************************************************
4752 : Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix
4753 :
4754 : INPUT PARAMETERS:
4755 : A - matrix, array[0..M-1, 0..N-1]
4756 : M, N- matrix size
4757 :
4758 : OUTPUT PARAMETERS:
4759 : A - A*Q, where Q is random NxN orthogonal matrix
4760 :
4761 : -- ALGLIB routine --
4762 : 04.12.2009
4763 : Bochkanov Sergey
4764 : *************************************************************************/
4765 0 : void rmatrixrndorthogonalfromtheright(real_2d_array &a, const ae_int_t m, const ae_int_t n, const xparams _xparams)
4766 : {
4767 : jmp_buf _break_jump;
4768 : alglib_impl::ae_state _alglib_env_state;
4769 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4770 0 : if( setjmp(_break_jump) )
4771 : {
4772 : #if !defined(AE_NO_EXCEPTIONS)
4773 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4774 : #else
4775 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4776 : return;
4777 : #endif
4778 : }
4779 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4780 0 : if( _xparams.flags!=0x0 )
4781 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4782 0 : alglib_impl::rmatrixrndorthogonalfromtheright(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, &_alglib_env_state);
4783 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4784 0 : return;
4785 : }
4786 :
4787 : /*************************************************************************
4788 : Multiplication of MxN matrix by MxM random Haar distributed orthogonal matrix
4789 :
4790 : INPUT PARAMETERS:
4791 : A - matrix, array[0..M-1, 0..N-1]
4792 : M, N- matrix size
4793 :
4794 : OUTPUT PARAMETERS:
4795 : A - Q*A, where Q is random MxM orthogonal matrix
4796 :
4797 : -- ALGLIB routine --
4798 : 04.12.2009
4799 : Bochkanov Sergey
4800 : *************************************************************************/
4801 0 : void rmatrixrndorthogonalfromtheleft(real_2d_array &a, const ae_int_t m, const ae_int_t n, const xparams _xparams)
4802 : {
4803 : jmp_buf _break_jump;
4804 : alglib_impl::ae_state _alglib_env_state;
4805 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4806 0 : if( setjmp(_break_jump) )
4807 : {
4808 : #if !defined(AE_NO_EXCEPTIONS)
4809 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4810 : #else
4811 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4812 : return;
4813 : #endif
4814 : }
4815 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4816 0 : if( _xparams.flags!=0x0 )
4817 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4818 0 : alglib_impl::rmatrixrndorthogonalfromtheleft(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, &_alglib_env_state);
4819 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4820 0 : return;
4821 : }
4822 :
4823 : /*************************************************************************
4824 : Multiplication of MxN complex matrix by NxN random Haar distributed
4825 : complex orthogonal matrix
4826 :
4827 : INPUT PARAMETERS:
4828 : A - matrix, array[0..M-1, 0..N-1]
4829 : M, N- matrix size
4830 :
4831 : OUTPUT PARAMETERS:
4832 : A - A*Q, where Q is random NxN orthogonal matrix
4833 :
4834 : -- ALGLIB routine --
4835 : 04.12.2009
4836 : Bochkanov Sergey
4837 : *************************************************************************/
4838 0 : void cmatrixrndorthogonalfromtheright(complex_2d_array &a, const ae_int_t m, const ae_int_t n, const xparams _xparams)
4839 : {
4840 : jmp_buf _break_jump;
4841 : alglib_impl::ae_state _alglib_env_state;
4842 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4843 0 : if( setjmp(_break_jump) )
4844 : {
4845 : #if !defined(AE_NO_EXCEPTIONS)
4846 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4847 : #else
4848 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4849 : return;
4850 : #endif
4851 : }
4852 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4853 0 : if( _xparams.flags!=0x0 )
4854 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4855 0 : alglib_impl::cmatrixrndorthogonalfromtheright(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, &_alglib_env_state);
4856 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4857 0 : return;
4858 : }
4859 :
4860 : /*************************************************************************
4861 : Multiplication of MxN complex matrix by MxM random Haar distributed
4862 : complex orthogonal matrix
4863 :
4864 : INPUT PARAMETERS:
4865 : A - matrix, array[0..M-1, 0..N-1]
4866 : M, N- matrix size
4867 :
4868 : OUTPUT PARAMETERS:
4869 : A - Q*A, where Q is random MxM orthogonal matrix
4870 :
4871 : -- ALGLIB routine --
4872 : 04.12.2009
4873 : Bochkanov Sergey
4874 : *************************************************************************/
4875 0 : void cmatrixrndorthogonalfromtheleft(complex_2d_array &a, const ae_int_t m, const ae_int_t n, const xparams _xparams)
4876 : {
4877 : jmp_buf _break_jump;
4878 : alglib_impl::ae_state _alglib_env_state;
4879 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4880 0 : if( setjmp(_break_jump) )
4881 : {
4882 : #if !defined(AE_NO_EXCEPTIONS)
4883 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4884 : #else
4885 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4886 : return;
4887 : #endif
4888 : }
4889 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4890 0 : if( _xparams.flags!=0x0 )
4891 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4892 0 : alglib_impl::cmatrixrndorthogonalfromtheleft(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, &_alglib_env_state);
4893 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4894 0 : return;
4895 : }
4896 :
4897 : /*************************************************************************
4898 : Symmetric multiplication of NxN matrix by random Haar distributed
4899 : orthogonal matrix
4900 :
4901 : INPUT PARAMETERS:
4902 : A - matrix, array[0..N-1, 0..N-1]
4903 : N - matrix size
4904 :
4905 : OUTPUT PARAMETERS:
4906 : A - Q'*A*Q, where Q is random NxN orthogonal matrix
4907 :
4908 : -- ALGLIB routine --
4909 : 04.12.2009
4910 : Bochkanov Sergey
4911 : *************************************************************************/
4912 0 : void smatrixrndmultiply(real_2d_array &a, const ae_int_t n, const xparams _xparams)
4913 : {
4914 : jmp_buf _break_jump;
4915 : alglib_impl::ae_state _alglib_env_state;
4916 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4917 0 : if( setjmp(_break_jump) )
4918 : {
4919 : #if !defined(AE_NO_EXCEPTIONS)
4920 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4921 : #else
4922 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4923 : return;
4924 : #endif
4925 : }
4926 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4927 0 : if( _xparams.flags!=0x0 )
4928 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4929 0 : alglib_impl::smatrixrndmultiply(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
4930 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4931 0 : return;
4932 : }
4933 :
4934 : /*************************************************************************
4935 : Hermitian multiplication of NxN matrix by random Haar distributed
4936 : complex orthogonal matrix
4937 :
4938 : INPUT PARAMETERS:
4939 : A - matrix, array[0..N-1, 0..N-1]
4940 : N - matrix size
4941 :
4942 : OUTPUT PARAMETERS:
4943 : A - Q^H*A*Q, where Q is random NxN orthogonal matrix
4944 :
4945 : -- ALGLIB routine --
4946 : 04.12.2009
4947 : Bochkanov Sergey
4948 : *************************************************************************/
4949 0 : void hmatrixrndmultiply(complex_2d_array &a, const ae_int_t n, const xparams _xparams)
4950 : {
4951 : jmp_buf _break_jump;
4952 : alglib_impl::ae_state _alglib_env_state;
4953 0 : alglib_impl::ae_state_init(&_alglib_env_state);
4954 0 : if( setjmp(_break_jump) )
4955 : {
4956 : #if !defined(AE_NO_EXCEPTIONS)
4957 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
4958 : #else
4959 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
4960 : return;
4961 : #endif
4962 : }
4963 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
4964 0 : if( _xparams.flags!=0x0 )
4965 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
4966 0 : alglib_impl::hmatrixrndmultiply(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
4967 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
4968 0 : return;
4969 : }
4970 : #endif
4971 :
4972 : #if defined(AE_COMPILE_TRFAC) || !defined(AE_PARTIAL_BUILD)
4973 : /*************************************************************************
4974 : An analysis of the sparse matrix decomposition, performed prior to actual
4975 : numerical factorization. You should not directly access fields of this
4976 : object - use appropriate ALGLIB functions to work with this object.
4977 : *************************************************************************/
4978 0 : _sparsedecompositionanalysis_owner::_sparsedecompositionanalysis_owner()
4979 : {
4980 : jmp_buf _break_jump;
4981 : alglib_impl::ae_state _state;
4982 :
4983 0 : alglib_impl::ae_state_init(&_state);
4984 0 : if( setjmp(_break_jump) )
4985 : {
4986 0 : if( p_struct!=NULL )
4987 : {
4988 0 : alglib_impl::_sparsedecompositionanalysis_destroy(p_struct);
4989 0 : alglib_impl::ae_free(p_struct);
4990 : }
4991 0 : p_struct = NULL;
4992 : #if !defined(AE_NO_EXCEPTIONS)
4993 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
4994 : #else
4995 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
4996 : return;
4997 : #endif
4998 : }
4999 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
5000 0 : p_struct = NULL;
5001 0 : p_struct = (alglib_impl::sparsedecompositionanalysis*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsedecompositionanalysis), &_state);
5002 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsedecompositionanalysis));
5003 0 : alglib_impl::_sparsedecompositionanalysis_init(p_struct, &_state, ae_false);
5004 0 : ae_state_clear(&_state);
5005 0 : }
5006 :
5007 0 : _sparsedecompositionanalysis_owner::_sparsedecompositionanalysis_owner(const _sparsedecompositionanalysis_owner &rhs)
5008 : {
5009 : jmp_buf _break_jump;
5010 : alglib_impl::ae_state _state;
5011 :
5012 0 : alglib_impl::ae_state_init(&_state);
5013 0 : if( setjmp(_break_jump) )
5014 : {
5015 0 : if( p_struct!=NULL )
5016 : {
5017 0 : alglib_impl::_sparsedecompositionanalysis_destroy(p_struct);
5018 0 : alglib_impl::ae_free(p_struct);
5019 : }
5020 0 : p_struct = NULL;
5021 : #if !defined(AE_NO_EXCEPTIONS)
5022 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
5023 : #else
5024 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
5025 : return;
5026 : #endif
5027 : }
5028 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
5029 0 : p_struct = NULL;
5030 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsedecompositionanalysis copy constructor failure (source is not initialized)", &_state);
5031 0 : p_struct = (alglib_impl::sparsedecompositionanalysis*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsedecompositionanalysis), &_state);
5032 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsedecompositionanalysis));
5033 0 : alglib_impl::_sparsedecompositionanalysis_init_copy(p_struct, const_cast<alglib_impl::sparsedecompositionanalysis*>(rhs.p_struct), &_state, ae_false);
5034 0 : ae_state_clear(&_state);
5035 0 : }
5036 :
5037 0 : _sparsedecompositionanalysis_owner& _sparsedecompositionanalysis_owner::operator=(const _sparsedecompositionanalysis_owner &rhs)
5038 : {
5039 0 : if( this==&rhs )
5040 0 : return *this;
5041 : jmp_buf _break_jump;
5042 : alglib_impl::ae_state _state;
5043 :
5044 0 : alglib_impl::ae_state_init(&_state);
5045 0 : if( setjmp(_break_jump) )
5046 : {
5047 : #if !defined(AE_NO_EXCEPTIONS)
5048 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
5049 : #else
5050 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
5051 : return *this;
5052 : #endif
5053 : }
5054 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
5055 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: sparsedecompositionanalysis assignment constructor failure (destination is not initialized)", &_state);
5056 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: sparsedecompositionanalysis assignment constructor failure (source is not initialized)", &_state);
5057 0 : alglib_impl::_sparsedecompositionanalysis_destroy(p_struct);
5058 0 : memset(p_struct, 0, sizeof(alglib_impl::sparsedecompositionanalysis));
5059 0 : alglib_impl::_sparsedecompositionanalysis_init_copy(p_struct, const_cast<alglib_impl::sparsedecompositionanalysis*>(rhs.p_struct), &_state, ae_false);
5060 0 : ae_state_clear(&_state);
5061 0 : return *this;
5062 : }
5063 :
5064 0 : _sparsedecompositionanalysis_owner::~_sparsedecompositionanalysis_owner()
5065 : {
5066 0 : if( p_struct!=NULL )
5067 : {
5068 0 : alglib_impl::_sparsedecompositionanalysis_destroy(p_struct);
5069 0 : ae_free(p_struct);
5070 : }
5071 0 : }
5072 :
5073 0 : alglib_impl::sparsedecompositionanalysis* _sparsedecompositionanalysis_owner::c_ptr()
5074 : {
5075 0 : return p_struct;
5076 : }
5077 :
5078 0 : alglib_impl::sparsedecompositionanalysis* _sparsedecompositionanalysis_owner::c_ptr() const
5079 : {
5080 0 : return const_cast<alglib_impl::sparsedecompositionanalysis*>(p_struct);
5081 : }
5082 0 : sparsedecompositionanalysis::sparsedecompositionanalysis() : _sparsedecompositionanalysis_owner()
5083 : {
5084 0 : }
5085 :
5086 0 : sparsedecompositionanalysis::sparsedecompositionanalysis(const sparsedecompositionanalysis &rhs):_sparsedecompositionanalysis_owner(rhs)
5087 : {
5088 0 : }
5089 :
5090 0 : sparsedecompositionanalysis& sparsedecompositionanalysis::operator=(const sparsedecompositionanalysis &rhs)
5091 : {
5092 0 : if( this==&rhs )
5093 0 : return *this;
5094 0 : _sparsedecompositionanalysis_owner::operator=(rhs);
5095 0 : return *this;
5096 : }
5097 :
5098 0 : sparsedecompositionanalysis::~sparsedecompositionanalysis()
5099 : {
5100 0 : }
5101 :
5102 : /*************************************************************************
5103 : LU decomposition of a general real matrix with row pivoting
5104 :
5105 : A is represented as A = P*L*U, where:
5106 : * L is lower unitriangular matrix
5107 : * U is upper triangular matrix
5108 : * P = P0*P1*...*PK, K=min(M,N)-1,
5109 : Pi - permutation matrix for I and Pivots[I]
5110 :
5111 : ! COMMERCIAL EDITION OF ALGLIB:
5112 : !
5113 : ! Commercial Edition of ALGLIB includes following important improvements
5114 : ! of this function:
5115 : ! * high-performance native backend with same C# interface (C# version)
5116 : ! * multithreading support (C++ and C# versions)
5117 : ! * hardware vendor (Intel) implementations of linear algebra primitives
5118 : ! (C++ and C# versions, x86/x64 platform)
5119 : !
5120 : ! We recommend you to read 'Working with commercial version' section of
5121 : ! ALGLIB Reference Manual in order to find out how to use performance-
5122 : ! related features provided by commercial edition of ALGLIB.
5123 :
5124 : INPUT PARAMETERS:
5125 : A - array[0..M-1, 0..N-1].
5126 : M - number of rows in matrix A.
5127 : N - number of columns in matrix A.
5128 :
5129 :
5130 : OUTPUT PARAMETERS:
5131 : A - matrices L and U in compact form:
5132 : * L is stored under main diagonal
5133 : * U is stored on and above main diagonal
5134 : Pivots - permutation matrix in compact form.
5135 : array[0..Min(M-1,N-1)].
5136 :
5137 : -- ALGLIB routine --
5138 : 10.01.2010
5139 : Bochkanov Sergey
5140 : *************************************************************************/
5141 0 : void rmatrixlu(real_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots, const xparams _xparams)
5142 : {
5143 : jmp_buf _break_jump;
5144 : alglib_impl::ae_state _alglib_env_state;
5145 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5146 0 : if( setjmp(_break_jump) )
5147 : {
5148 : #if !defined(AE_NO_EXCEPTIONS)
5149 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5150 : #else
5151 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5152 : return;
5153 : #endif
5154 : }
5155 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5156 0 : if( _xparams.flags!=0x0 )
5157 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5158 0 : alglib_impl::rmatrixlu(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), &_alglib_env_state);
5159 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5160 0 : return;
5161 : }
5162 :
5163 : /*************************************************************************
5164 : LU decomposition of a general complex matrix with row pivoting
5165 :
5166 : A is represented as A = P*L*U, where:
5167 : * L is lower unitriangular matrix
5168 : * U is upper triangular matrix
5169 : * P = P0*P1*...*PK, K=min(M,N)-1,
5170 : Pi - permutation matrix for I and Pivots[I]
5171 :
5172 : ! COMMERCIAL EDITION OF ALGLIB:
5173 : !
5174 : ! Commercial Edition of ALGLIB includes following important improvements
5175 : ! of this function:
5176 : ! * high-performance native backend with same C# interface (C# version)
5177 : ! * multithreading support (C++ and C# versions)
5178 : ! * hardware vendor (Intel) implementations of linear algebra primitives
5179 : ! (C++ and C# versions, x86/x64 platform)
5180 : !
5181 : ! We recommend you to read 'Working with commercial version' section of
5182 : ! ALGLIB Reference Manual in order to find out how to use performance-
5183 : ! related features provided by commercial edition of ALGLIB.
5184 :
5185 : INPUT PARAMETERS:
5186 : A - array[0..M-1, 0..N-1].
5187 : M - number of rows in matrix A.
5188 : N - number of columns in matrix A.
5189 :
5190 :
5191 : OUTPUT PARAMETERS:
5192 : A - matrices L and U in compact form:
5193 : * L is stored under main diagonal
5194 : * U is stored on and above main diagonal
5195 : Pivots - permutation matrix in compact form.
5196 : array[0..Min(M-1,N-1)].
5197 :
5198 : -- ALGLIB routine --
5199 : 10.01.2010
5200 : Bochkanov Sergey
5201 : *************************************************************************/
5202 0 : void cmatrixlu(complex_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots, const xparams _xparams)
5203 : {
5204 : jmp_buf _break_jump;
5205 : alglib_impl::ae_state _alglib_env_state;
5206 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5207 0 : if( setjmp(_break_jump) )
5208 : {
5209 : #if !defined(AE_NO_EXCEPTIONS)
5210 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5211 : #else
5212 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5213 : return;
5214 : #endif
5215 : }
5216 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5217 0 : if( _xparams.flags!=0x0 )
5218 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5219 0 : alglib_impl::cmatrixlu(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), &_alglib_env_state);
5220 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5221 0 : return;
5222 : }
5223 :
5224 : /*************************************************************************
5225 : Cache-oblivious Cholesky decomposition
5226 :
5227 : The algorithm computes Cholesky decomposition of a Hermitian positive-
5228 : definite matrix. The result of an algorithm is a representation of A as
5229 : A=U'*U or A=L*L' (here X' denotes conj(X^T)).
5230 :
5231 : ! COMMERCIAL EDITION OF ALGLIB:
5232 : !
5233 : ! Commercial Edition of ALGLIB includes following important improvements
5234 : ! of this function:
5235 : ! * high-performance native backend with same C# interface (C# version)
5236 : ! * multithreading support (C++ and C# versions)
5237 : ! * hardware vendor (Intel) implementations of linear algebra primitives
5238 : ! (C++ and C# versions, x86/x64 platform)
5239 : !
5240 : ! We recommend you to read 'Working with commercial version' section of
5241 : ! ALGLIB Reference Manual in order to find out how to use performance-
5242 : ! related features provided by commercial edition of ALGLIB.
5243 :
5244 : INPUT PARAMETERS:
5245 : A - upper or lower triangle of a factorized matrix.
5246 : array with elements [0..N-1, 0..N-1].
5247 : N - size of matrix A.
5248 : IsUpper - if IsUpper=True, then A contains an upper triangle of
5249 : a symmetric matrix, otherwise A contains a lower one.
5250 :
5251 : OUTPUT PARAMETERS:
5252 : A - the result of factorization. If IsUpper=True, then
5253 : the upper triangle contains matrix U, so that A = U'*U,
5254 : and the elements below the main diagonal are not modified.
5255 : Similarly, if IsUpper = False.
5256 :
5257 : RESULT:
5258 : If the matrix is positive-definite, the function returns True.
5259 : Otherwise, the function returns False. Contents of A is not determined
5260 : in such case.
5261 :
5262 : -- ALGLIB routine --
5263 : 15.12.2009-22.01.2018
5264 : Bochkanov Sergey
5265 : *************************************************************************/
5266 0 : bool hpdmatrixcholesky(complex_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
5267 : {
5268 : jmp_buf _break_jump;
5269 : alglib_impl::ae_state _alglib_env_state;
5270 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5271 0 : if( setjmp(_break_jump) )
5272 : {
5273 : #if !defined(AE_NO_EXCEPTIONS)
5274 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5275 : #else
5276 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5277 : return 0;
5278 : #endif
5279 : }
5280 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5281 0 : if( _xparams.flags!=0x0 )
5282 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5283 0 : ae_bool result = alglib_impl::hpdmatrixcholesky(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
5284 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5285 0 : return *(reinterpret_cast<bool*>(&result));
5286 : }
5287 :
5288 : /*************************************************************************
5289 : Cache-oblivious Cholesky decomposition
5290 :
5291 : The algorithm computes Cholesky decomposition of a symmetric positive-
5292 : definite matrix. The result of an algorithm is a representation of A as
5293 : A=U^T*U or A=L*L^T
5294 :
5295 : ! COMMERCIAL EDITION OF ALGLIB:
5296 : !
5297 : ! Commercial Edition of ALGLIB includes following important improvements
5298 : ! of this function:
5299 : ! * high-performance native backend with same C# interface (C# version)
5300 : ! * multithreading support (C++ and C# versions)
5301 : ! * hardware vendor (Intel) implementations of linear algebra primitives
5302 : ! (C++ and C# versions, x86/x64 platform)
5303 : !
5304 : ! We recommend you to read 'Working with commercial version' section of
5305 : ! ALGLIB Reference Manual in order to find out how to use performance-
5306 : ! related features provided by commercial edition of ALGLIB.
5307 :
5308 : INPUT PARAMETERS:
5309 : A - upper or lower triangle of a factorized matrix.
5310 : array with elements [0..N-1, 0..N-1].
5311 : N - size of matrix A.
5312 : IsUpper - if IsUpper=True, then A contains an upper triangle of
5313 : a symmetric matrix, otherwise A contains a lower one.
5314 :
5315 : OUTPUT PARAMETERS:
5316 : A - the result of factorization. If IsUpper=True, then
5317 : the upper triangle contains matrix U, so that A = U^T*U,
5318 : and the elements below the main diagonal are not modified.
5319 : Similarly, if IsUpper = False.
5320 :
5321 : RESULT:
5322 : If the matrix is positive-definite, the function returns True.
5323 : Otherwise, the function returns False. Contents of A is not determined
5324 : in such case.
5325 :
5326 : -- ALGLIB routine --
5327 : 15.12.2009
5328 : Bochkanov Sergey
5329 : *************************************************************************/
5330 0 : bool spdmatrixcholesky(real_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
5331 : {
5332 : jmp_buf _break_jump;
5333 : alglib_impl::ae_state _alglib_env_state;
5334 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5335 0 : if( setjmp(_break_jump) )
5336 : {
5337 : #if !defined(AE_NO_EXCEPTIONS)
5338 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5339 : #else
5340 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5341 : return 0;
5342 : #endif
5343 : }
5344 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5345 0 : if( _xparams.flags!=0x0 )
5346 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5347 0 : ae_bool result = alglib_impl::spdmatrixcholesky(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
5348 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5349 0 : return *(reinterpret_cast<bool*>(&result));
5350 : }
5351 :
5352 : /*************************************************************************
5353 : Update of Cholesky decomposition: rank-1 update to original A. "Buffered"
5354 : version which uses preallocated buffer which is saved between subsequent
5355 : function calls.
5356 :
5357 : This function uses internally allocated buffer which is not saved between
5358 : subsequent calls. So, if you perform a lot of subsequent updates,
5359 : we recommend you to use "buffered" version of this function:
5360 : SPDMatrixCholeskyUpdateAdd1Buf().
5361 :
5362 : INPUT PARAMETERS:
5363 : A - upper or lower Cholesky factor.
5364 : array with elements [0..N-1, 0..N-1].
5365 : Exception is thrown if array size is too small.
5366 : N - size of matrix A, N>0
5367 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
5368 : otherwise A contains a lower one.
5369 : U - array[N], rank-1 update to A: A_mod = A + u*u'
5370 : Exception is thrown if array size is too small.
5371 : BufR - possibly preallocated buffer; automatically resized if
5372 : needed. It is recommended to reuse this buffer if you
5373 : perform a lot of subsequent decompositions.
5374 :
5375 : OUTPUT PARAMETERS:
5376 : A - updated factorization. If IsUpper=True, then the upper
5377 : triangle contains matrix U, and the elements below the main
5378 : diagonal are not modified. Similarly, if IsUpper = False.
5379 :
5380 : NOTE: this function always succeeds, so it does not return completion code
5381 :
5382 : NOTE: this function checks sizes of input arrays, but it does NOT checks
5383 : for presence of infinities or NAN's.
5384 :
5385 : -- ALGLIB --
5386 : 03.02.2014
5387 : Sergey Bochkanov
5388 : *************************************************************************/
5389 0 : void spdmatrixcholeskyupdateadd1(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &u, const xparams _xparams)
5390 : {
5391 : jmp_buf _break_jump;
5392 : alglib_impl::ae_state _alglib_env_state;
5393 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5394 0 : if( setjmp(_break_jump) )
5395 : {
5396 : #if !defined(AE_NO_EXCEPTIONS)
5397 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5398 : #else
5399 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5400 : return;
5401 : #endif
5402 : }
5403 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5404 0 : if( _xparams.flags!=0x0 )
5405 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5406 0 : alglib_impl::spdmatrixcholeskyupdateadd1(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), &_alglib_env_state);
5407 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5408 0 : return;
5409 : }
5410 :
5411 : /*************************************************************************
5412 : Update of Cholesky decomposition: "fixing" some variables.
5413 :
5414 : This function uses internally allocated buffer which is not saved between
5415 : subsequent calls. So, if you perform a lot of subsequent updates,
5416 : we recommend you to use "buffered" version of this function:
5417 : SPDMatrixCholeskyUpdateFixBuf().
5418 :
5419 : "FIXING" EXPLAINED:
5420 :
5421 : Suppose we have N*N positive definite matrix A. "Fixing" some variable
5422 : means filling corresponding row/column of A by zeros, and setting
5423 : diagonal element to 1.
5424 :
5425 : For example, if we fix 2nd variable in 4*4 matrix A, it becomes Af:
5426 :
5427 : ( A00 A01 A02 A03 ) ( Af00 0 Af02 Af03 )
5428 : ( A10 A11 A12 A13 ) ( 0 1 0 0 )
5429 : ( A20 A21 A22 A23 ) => ( Af20 0 Af22 Af23 )
5430 : ( A30 A31 A32 A33 ) ( Af30 0 Af32 Af33 )
5431 :
5432 : If we have Cholesky decomposition of A, it must be recalculated after
5433 : variables were fixed. However, it is possible to use efficient
5434 : algorithm, which needs O(K*N^2) time to "fix" K variables, given
5435 : Cholesky decomposition of original, "unfixed" A.
5436 :
5437 : INPUT PARAMETERS:
5438 : A - upper or lower Cholesky factor.
5439 : array with elements [0..N-1, 0..N-1].
5440 : Exception is thrown if array size is too small.
5441 : N - size of matrix A, N>0
5442 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
5443 : otherwise A contains a lower one.
5444 : Fix - array[N], I-th element is True if I-th variable must be
5445 : fixed. Exception is thrown if array size is too small.
5446 : BufR - possibly preallocated buffer; automatically resized if
5447 : needed. It is recommended to reuse this buffer if you
5448 : perform a lot of subsequent decompositions.
5449 :
5450 : OUTPUT PARAMETERS:
5451 : A - updated factorization. If IsUpper=True, then the upper
5452 : triangle contains matrix U, and the elements below the main
5453 : diagonal are not modified. Similarly, if IsUpper = False.
5454 :
5455 : NOTE: this function always succeeds, so it does not return completion code
5456 :
5457 : NOTE: this function checks sizes of input arrays, but it does NOT checks
5458 : for presence of infinities or NAN's.
5459 :
5460 : NOTE: this function is efficient only for moderate amount of updated
5461 : variables - say, 0.1*N or 0.3*N. For larger amount of variables it
5462 : will still work, but you may get better performance with
5463 : straightforward Cholesky.
5464 :
5465 : -- ALGLIB --
5466 : 03.02.2014
5467 : Sergey Bochkanov
5468 : *************************************************************************/
5469 0 : void spdmatrixcholeskyupdatefix(const real_2d_array &a, const ae_int_t n, const bool isupper, const boolean_1d_array &fix, const xparams _xparams)
5470 : {
5471 : jmp_buf _break_jump;
5472 : alglib_impl::ae_state _alglib_env_state;
5473 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5474 0 : if( setjmp(_break_jump) )
5475 : {
5476 : #if !defined(AE_NO_EXCEPTIONS)
5477 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5478 : #else
5479 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5480 : return;
5481 : #endif
5482 : }
5483 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5484 0 : if( _xparams.flags!=0x0 )
5485 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5486 0 : alglib_impl::spdmatrixcholeskyupdatefix(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(fix.c_ptr()), &_alglib_env_state);
5487 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5488 0 : return;
5489 : }
5490 :
5491 : /*************************************************************************
5492 : Update of Cholesky decomposition: rank-1 update to original A. "Buffered"
5493 : version which uses preallocated buffer which is saved between subsequent
5494 : function calls.
5495 :
5496 : See comments for SPDMatrixCholeskyUpdateAdd1() for more information.
5497 :
5498 : INPUT PARAMETERS:
5499 : A - upper or lower Cholesky factor.
5500 : array with elements [0..N-1, 0..N-1].
5501 : Exception is thrown if array size is too small.
5502 : N - size of matrix A, N>0
5503 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
5504 : otherwise A contains a lower one.
5505 : U - array[N], rank-1 update to A: A_mod = A + u*u'
5506 : Exception is thrown if array size is too small.
5507 : BufR - possibly preallocated buffer; automatically resized if
5508 : needed. It is recommended to reuse this buffer if you
5509 : perform a lot of subsequent decompositions.
5510 :
5511 : OUTPUT PARAMETERS:
5512 : A - updated factorization. If IsUpper=True, then the upper
5513 : triangle contains matrix U, and the elements below the main
5514 : diagonal are not modified. Similarly, if IsUpper = False.
5515 :
5516 : -- ALGLIB --
5517 : 03.02.2014
5518 : Sergey Bochkanov
5519 : *************************************************************************/
5520 0 : void spdmatrixcholeskyupdateadd1buf(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &u, real_1d_array &bufr, const xparams _xparams)
5521 : {
5522 : jmp_buf _break_jump;
5523 : alglib_impl::ae_state _alglib_env_state;
5524 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5525 0 : if( setjmp(_break_jump) )
5526 : {
5527 : #if !defined(AE_NO_EXCEPTIONS)
5528 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5529 : #else
5530 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5531 : return;
5532 : #endif
5533 : }
5534 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5535 0 : if( _xparams.flags!=0x0 )
5536 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5537 0 : alglib_impl::spdmatrixcholeskyupdateadd1buf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), const_cast<alglib_impl::ae_vector*>(bufr.c_ptr()), &_alglib_env_state);
5538 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5539 0 : return;
5540 : }
5541 :
5542 : /*************************************************************************
5543 : Update of Cholesky decomposition: "fixing" some variables. "Buffered"
5544 : version which uses preallocated buffer which is saved between subsequent
5545 : function calls.
5546 :
5547 : See comments for SPDMatrixCholeskyUpdateFix() for more information.
5548 :
5549 : INPUT PARAMETERS:
5550 : A - upper or lower Cholesky factor.
5551 : array with elements [0..N-1, 0..N-1].
5552 : Exception is thrown if array size is too small.
5553 : N - size of matrix A, N>0
5554 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
5555 : otherwise A contains a lower one.
5556 : Fix - array[N], I-th element is True if I-th variable must be
5557 : fixed. Exception is thrown if array size is too small.
5558 : BufR - possibly preallocated buffer; automatically resized if
5559 : needed. It is recommended to reuse this buffer if you
5560 : perform a lot of subsequent decompositions.
5561 :
5562 : OUTPUT PARAMETERS:
5563 : A - updated factorization. If IsUpper=True, then the upper
5564 : triangle contains matrix U, and the elements below the main
5565 : diagonal are not modified. Similarly, if IsUpper = False.
5566 :
5567 : -- ALGLIB --
5568 : 03.02.2014
5569 : Sergey Bochkanov
5570 : *************************************************************************/
5571 0 : void spdmatrixcholeskyupdatefixbuf(const real_2d_array &a, const ae_int_t n, const bool isupper, const boolean_1d_array &fix, real_1d_array &bufr, const xparams _xparams)
5572 : {
5573 : jmp_buf _break_jump;
5574 : alglib_impl::ae_state _alglib_env_state;
5575 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5576 0 : if( setjmp(_break_jump) )
5577 : {
5578 : #if !defined(AE_NO_EXCEPTIONS)
5579 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5580 : #else
5581 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5582 : return;
5583 : #endif
5584 : }
5585 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5586 0 : if( _xparams.flags!=0x0 )
5587 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5588 0 : alglib_impl::spdmatrixcholeskyupdatefixbuf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(fix.c_ptr()), const_cast<alglib_impl::ae_vector*>(bufr.c_ptr()), &_alglib_env_state);
5589 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5590 0 : return;
5591 : }
5592 :
5593 : /*************************************************************************
5594 : Sparse LU decomposition with column pivoting for sparsity and row pivoting
5595 : for stability. Input must be square sparse matrix stored in CRS format.
5596 :
5597 : The algorithm computes LU decomposition of a general square matrix
5598 : (rectangular ones are not supported). The result of an algorithm is a
5599 : representation of A as A = P*L*U*Q, where:
5600 : * L is lower unitriangular matrix
5601 : * U is upper triangular matrix
5602 : * P = P0*P1*...*PK, K=N-1, Pi - permutation matrix for I and P[I]
5603 : * Q = QK*...*Q1*Q0, K=N-1, Qi - permutation matrix for I and Q[I]
5604 :
5605 : This function pivots columns for higher sparsity, and then pivots rows for
5606 : stability (larger element at the diagonal).
5607 :
5608 : INPUT PARAMETERS:
5609 : A - sparse NxN matrix in CRS format. An exception is generated
5610 : if matrix is non-CRS or non-square.
5611 : PivotType- pivoting strategy:
5612 : * 0 for best pivoting available (2 in current version)
5613 : * 1 for row-only pivoting (NOT RECOMMENDED)
5614 : * 2 for complete pivoting which produces most sparse outputs
5615 :
5616 : OUTPUT PARAMETERS:
5617 : A - the result of factorization, matrices L and U stored in
5618 : compact form using CRS sparse storage format:
5619 : * lower unitriangular L is stored strictly under main diagonal
5620 : * upper triangilar U is stored ON and ABOVE main diagonal
5621 : P - row permutation matrix in compact form, array[N]
5622 : Q - col permutation matrix in compact form, array[N]
5623 :
5624 : This function always succeeds, i.e. it ALWAYS returns valid factorization,
5625 : but for your convenience it also returns boolean value which helps to
5626 : detect symbolically degenerate matrices:
5627 : * function returns TRUE, if the matrix was factorized AND symbolically
5628 : non-degenerate
5629 : * function returns FALSE, if the matrix was factorized but U has strictly
5630 : zero elements at the diagonal (the factorization is returned anyway).
5631 :
5632 :
5633 : -- ALGLIB routine --
5634 : 03.09.2018
5635 : Bochkanov Sergey
5636 : *************************************************************************/
5637 0 : bool sparselu(const sparsematrix &a, const ae_int_t pivottype, integer_1d_array &p, integer_1d_array &q, const xparams _xparams)
5638 : {
5639 : jmp_buf _break_jump;
5640 : alglib_impl::ae_state _alglib_env_state;
5641 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5642 0 : if( setjmp(_break_jump) )
5643 : {
5644 : #if !defined(AE_NO_EXCEPTIONS)
5645 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5646 : #else
5647 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5648 : return 0;
5649 : #endif
5650 : }
5651 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5652 0 : if( _xparams.flags!=0x0 )
5653 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5654 0 : ae_bool result = alglib_impl::sparselu(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), pivottype, const_cast<alglib_impl::ae_vector*>(p.c_ptr()), const_cast<alglib_impl::ae_vector*>(q.c_ptr()), &_alglib_env_state);
5655 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5656 0 : return *(reinterpret_cast<bool*>(&result));
5657 : }
5658 :
5659 : /*************************************************************************
5660 : Sparse Cholesky decomposition for skyline matrixm using in-place algorithm
5661 : without allocating additional storage.
5662 :
5663 : The algorithm computes Cholesky decomposition of a symmetric positive-
5664 : definite sparse matrix. The result of an algorithm is a representation of
5665 : A as A=U^T*U or A=L*L^T
5666 :
5667 : This function allows to perform very efficient decomposition of low-profile
5668 : matrices (average bandwidth is ~5-10 elements). For larger matrices it is
5669 : recommended to use supernodal Cholesky decomposition: SparseCholeskyP() or
5670 : SparseCholeskyAnalyze()/SparseCholeskyFactorize().
5671 :
5672 : INPUT PARAMETERS:
5673 : A - sparse matrix in skyline storage (SKS) format.
5674 : N - size of matrix A (can be smaller than actual size of A)
5675 : IsUpper - if IsUpper=True, then factorization is performed on upper
5676 : triangle. Another triangle is ignored (it may contant some
5677 : data, but it is not changed).
5678 :
5679 :
5680 : OUTPUT PARAMETERS:
5681 : A - the result of factorization, stored in SKS. If IsUpper=True,
5682 : then the upper triangle contains matrix U, such that
5683 : A = U^T*U. Lower triangle is not changed.
5684 : Similarly, if IsUpper = False. In this case L is returned,
5685 : and we have A = L*(L^T).
5686 : Note that THIS function does not perform permutation of
5687 : rows to reduce bandwidth.
5688 :
5689 : RESULT:
5690 : If the matrix is positive-definite, the function returns True.
5691 : Otherwise, the function returns False. Contents of A is not determined
5692 : in such case.
5693 :
5694 : NOTE: for performance reasons this function does NOT check that input
5695 : matrix includes only finite values. It is your responsibility to
5696 : make sure that there are no infinite or NAN values in the matrix.
5697 :
5698 : -- ALGLIB routine --
5699 : 16.01.2014
5700 : Bochkanov Sergey
5701 : *************************************************************************/
5702 0 : bool sparsecholeskyskyline(const sparsematrix &a, const ae_int_t n, const bool isupper, const xparams _xparams)
5703 : {
5704 : jmp_buf _break_jump;
5705 : alglib_impl::ae_state _alglib_env_state;
5706 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5707 0 : if( setjmp(_break_jump) )
5708 : {
5709 : #if !defined(AE_NO_EXCEPTIONS)
5710 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5711 : #else
5712 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5713 : return 0;
5714 : #endif
5715 : }
5716 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5717 0 : if( _xparams.flags!=0x0 )
5718 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5719 0 : ae_bool result = alglib_impl::sparsecholeskyskyline(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
5720 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5721 0 : return *(reinterpret_cast<bool*>(&result));
5722 : }
5723 :
5724 : /*************************************************************************
5725 : Sparse Cholesky decomposition for a matrix stored in any sparse storage,
5726 : without rows/cols permutation.
5727 :
5728 : This function is the most convenient (less parameters to specify), although
5729 : less efficient, version of sparse Cholesky.
5730 :
5731 : Internally it:
5732 : * calls SparseCholeskyAnalyze() function to perform symbolic analysis
5733 : phase with no permutation being configured.
5734 : * calls SparseCholeskyFactorize() function to perform numerical phase of
5735 : the factorization
5736 :
5737 : Following alternatives may result in better performance:
5738 : * using SparseCholeskyP(), which selects best pivoting available, which
5739 : almost always results in improved sparsity and cache locality
5740 : * using SparseCholeskyAnalyze() and SparseCholeskyFactorize() functions
5741 : directly, which may improve performance of repetitive factorizations
5742 : with same sparsity patterns.
5743 :
5744 : The latter also allows one to perform LDLT factorization of indefinite
5745 : matrix (one with strictly diagonal D, which is known to be stable only
5746 : in few special cases, like quasi-definite matrices).
5747 :
5748 : INPUT PARAMETERS:
5749 : A - a square NxN sparse matrix, stored in any storage format.
5750 : IsUpper - if IsUpper=True, then factorization is performed on upper
5751 : triangle. Another triangle is ignored on input, dropped
5752 : on output. Similarly, if IsUpper=False, the lower triangle
5753 : is processed.
5754 :
5755 : OUTPUT PARAMETERS:
5756 : A - the result of factorization, stored in CRS format:
5757 : * if IsUpper=True, then the upper triangle contains matrix
5758 : U such that A = U^T*U and the lower triangle is empty.
5759 : * similarly, if IsUpper=False, then lower triangular L is
5760 : returned and we have A = L*(L^T).
5761 : Note that THIS function does not perform permutation of
5762 : the rows to reduce fill-in.
5763 :
5764 : RESULT:
5765 : If the matrix is positive-definite, the function returns True.
5766 : Otherwise, the function returns False. Contents of A is undefined
5767 : in such case.
5768 :
5769 : NOTE: for performance reasons this function does NOT check that input
5770 : matrix includes only finite values. It is your responsibility to
5771 : make sure that there are no infinite or NAN values in the matrix.
5772 :
5773 : -- ALGLIB routine --
5774 : 16.09.2020
5775 : Bochkanov Sergey
5776 : *************************************************************************/
5777 0 : bool sparsecholesky(const sparsematrix &a, const bool isupper, const xparams _xparams)
5778 : {
5779 : jmp_buf _break_jump;
5780 : alglib_impl::ae_state _alglib_env_state;
5781 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5782 0 : if( setjmp(_break_jump) )
5783 : {
5784 : #if !defined(AE_NO_EXCEPTIONS)
5785 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5786 : #else
5787 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5788 : return 0;
5789 : #endif
5790 : }
5791 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5792 0 : if( _xparams.flags!=0x0 )
5793 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5794 0 : ae_bool result = alglib_impl::sparsecholesky(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, &_alglib_env_state);
5795 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5796 0 : return *(reinterpret_cast<bool*>(&result));
5797 : }
5798 :
5799 : /*************************************************************************
5800 : Sparse Cholesky decomposition for a matrix stored in any sparse storage
5801 : format, with performance-enhancing permutation of rows/cols.
5802 :
5803 : Present version is configured to perform supernodal permutation which
5804 : sparsity reducing ordering.
5805 :
5806 : This function is a wrapper around generic sparse decomposition functions
5807 : that internally:
5808 : * calls SparseCholeskyAnalyze() function to perform symbolic analysis
5809 : phase with best available permutation being configured.
5810 : * calls SparseCholeskyFactorize() function to perform numerical phase of
5811 : the factorization.
5812 :
5813 : NOTE: using SparseCholeskyAnalyze() and SparseCholeskyFactorize() directly
5814 : may improve performance of repetitive factorizations with same
5815 : sparsity patterns. It also allows one to perform LDLT factorization
5816 : of indefinite matrix - a factorization with strictly diagonal D,
5817 : which is known to be stable only in few special cases, like quasi-
5818 : definite matrices.
5819 :
5820 : INPUT PARAMETERS:
5821 : A - a square NxN sparse matrix, stored in any storage format.
5822 : IsUpper - if IsUpper=True, then factorization is performed on upper
5823 : triangle. Another triangle is ignored on input, dropped
5824 : on output. Similarly, if IsUpper=False, the lower triangle
5825 : is processed.
5826 :
5827 : OUTPUT PARAMETERS:
5828 : A - the result of factorization, stored in CRS format:
5829 : * if IsUpper=True, then the upper triangle contains matrix
5830 : U such that A = U^T*U and the lower triangle is empty.
5831 : * similarly, if IsUpper=False, then lower triangular L is
5832 : returned and we have A = L*(L^T).
5833 : P - a row/column permutation, a product of P0*P1*...*Pk, k=N-1,
5834 : with Pi being permutation of rows/cols I and P[I]
5835 :
5836 : RESULT:
5837 : If the matrix is positive-definite, the function returns True.
5838 : Otherwise, the function returns False. Contents of A is undefined
5839 : in such case.
5840 :
5841 : NOTE: for performance reasons this function does NOT check that input
5842 : matrix includes only finite values. It is your responsibility to
5843 : make sure that there are no infinite or NAN values in the matrix.
5844 :
5845 : -- ALGLIB routine --
5846 : 16.09.2020
5847 : Bochkanov Sergey
5848 : *************************************************************************/
5849 0 : bool sparsecholeskyp(const sparsematrix &a, const bool isupper, integer_1d_array &p, const xparams _xparams)
5850 : {
5851 : jmp_buf _break_jump;
5852 : alglib_impl::ae_state _alglib_env_state;
5853 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5854 0 : if( setjmp(_break_jump) )
5855 : {
5856 : #if !defined(AE_NO_EXCEPTIONS)
5857 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5858 : #else
5859 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5860 : return 0;
5861 : #endif
5862 : }
5863 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5864 0 : if( _xparams.flags!=0x0 )
5865 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5866 0 : ae_bool result = alglib_impl::sparsecholeskyp(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(p.c_ptr()), &_alglib_env_state);
5867 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5868 0 : return *(reinterpret_cast<bool*>(&result));
5869 : }
5870 :
5871 : /*************************************************************************
5872 : Sparse Cholesky/LDLT decomposition: symbolic analysis phase.
5873 :
5874 : This function is a part of the 'expert' sparse Cholesky API:
5875 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
5876 : matrix to be factorized into internal storage
5877 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
5878 : with lower bounds on pivot magnitudes and additional overflow safeguards
5879 : * SparseCholeskyFactorize(), that performs numeric factorization using
5880 : precomputed symbolic analysis and internally stored matrix - and outputs
5881 : result
5882 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
5883 : pattern into internal storage so one may reuse previously allocated
5884 : temporaries and previously performed symbolic analysis
5885 :
5886 : This specific function performs preliminary analysis of the Cholesky/LDLT
5887 : factorization. It allows to choose different permutation types and to
5888 : choose between classic Cholesky and indefinite LDLT factorization (the
5889 : latter is computed with strictly diagonal D, i.e. without Bunch-Kauffman
5890 : pivoting).
5891 :
5892 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
5893 : matrices. However, numerical stability is guaranteed ONLY for a class
5894 : of quasi-definite matrices.
5895 :
5896 : NOTE: all internal processing is performed with lower triangular matrices
5897 : stored in CRS format. Any other storage formats and/or upper
5898 : triangular storage means that one format conversion and/or one
5899 : transposition will be performed internally for the analysis and
5900 : factorization phases. Thus, highest performance is achieved when
5901 : input is a lower triangular CRS matrix.
5902 :
5903 : INPUT PARAMETERS:
5904 : A - sparse square matrix in any sparse storage format.
5905 : IsUpper - whether upper or lower triangle is decomposed (the
5906 : other one is ignored).
5907 : FactType - factorization type:
5908 : * 0 for traditional Cholesky of SPD matrix
5909 : * 1 for LDLT decomposition with strictly diagonal D,
5910 : which may have non-positive entries.
5911 : PermType - permutation type:
5912 : *-1 for absence of permutation
5913 : * 0 for best fill-in reducing permutation available
5914 : * 1 for supernodal ordering (improves locality and
5915 : performance, does NOT change fill-in factor)
5916 : * 2 for AMD (approximate minimum degree) ordering
5917 :
5918 : OUTPUT PARAMETERS:
5919 : Analysis - contains:
5920 : * symbolic analysis of the matrix structure which will
5921 : be used later to guide numerical factorization.
5922 : * specific numeric values loaded into internal memory
5923 : waiting for the factorization to be performed
5924 :
5925 : This function fails if and only if the matrix A is symbolically degenerate
5926 : i.e. has diagonal element which is exactly zero. In such case False is
5927 : returned, contents of Analysis object is undefined.
5928 :
5929 : -- ALGLIB routine --
5930 : 20.09.2020
5931 : Bochkanov Sergey
5932 : *************************************************************************/
5933 0 : bool sparsecholeskyanalyze(const sparsematrix &a, const bool isupper, const ae_int_t facttype, const ae_int_t permtype, sparsedecompositionanalysis &analysis, const xparams _xparams)
5934 : {
5935 : jmp_buf _break_jump;
5936 : alglib_impl::ae_state _alglib_env_state;
5937 0 : alglib_impl::ae_state_init(&_alglib_env_state);
5938 0 : if( setjmp(_break_jump) )
5939 : {
5940 : #if !defined(AE_NO_EXCEPTIONS)
5941 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
5942 : #else
5943 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
5944 : return 0;
5945 : #endif
5946 : }
5947 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
5948 0 : if( _xparams.flags!=0x0 )
5949 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
5950 0 : ae_bool result = alglib_impl::sparsecholeskyanalyze(const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, facttype, permtype, const_cast<alglib_impl::sparsedecompositionanalysis*>(analysis.c_ptr()), &_alglib_env_state);
5951 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
5952 0 : return *(reinterpret_cast<bool*>(&result));
5953 : }
5954 :
5955 : /*************************************************************************
5956 : Sparse Cholesky decomposition: numerical analysis phase.
5957 :
5958 : This function is a part of the 'expert' sparse Cholesky API:
5959 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
5960 : matrix to be factorized into internal storage
5961 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
5962 : with lower bounds on pivot magnitudes and additional overflow safeguards
5963 : * SparseCholeskyFactorize(), that performs numeric factorization using
5964 : precomputed symbolic analysis and internally stored matrix - and outputs
5965 : result
5966 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
5967 : pattern into internal storage so one may reuse previously allocated
5968 : temporaries and previously performed symbolic analysis
5969 :
5970 : Depending on settings specified during SparseCholeskyAnalyze() call it may
5971 : produce classic Cholesky or L*D*LT decomposition (with strictly diagonal
5972 : D), without permutation or with performance-enhancing permutation P.
5973 :
5974 : NOTE: all internal processing is performed with lower triangular matrices
5975 : stored in CRS format. Any other storage formats and/or upper
5976 : triangular storage means that one format conversion and/or one
5977 : transposition will be performed internally for the analysis and
5978 : factorization phases. Thus, highest performance is achieved when
5979 : input is a lower triangular CRS matrix, and lower triangular output
5980 : is requested.
5981 :
5982 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
5983 : matrices. However, numerical stability is guaranteed ONLY for a class
5984 : of quasi-definite matrices.
5985 :
5986 : INPUT PARAMETERS:
5987 : Analysis - prior analysis with internally stored matrix which will
5988 : be factorized
5989 : NeedUpper - whether upper triangular or lower triangular output is
5990 : needed
5991 :
5992 : OUTPUT PARAMETERS:
5993 : A - Cholesky decomposition of A stored in lower triangular
5994 : CRS format, i.e. A=L*L' (or upper triangular CRS, with
5995 : A=U'*U, depending on NeedUpper parameter).
5996 : D - array[N], diagonal factor. If no diagonal factor was
5997 : required during analysis phase, still returned but
5998 : filled with 1's
5999 : P - array[N], pivots. Permutation matrix P is a product of
6000 : P(0)*P(1)*...*P(N-1), where P(i) is a permutation of
6001 : row/col I and P[I] (with P[I]>=I).
6002 : If no permutation was requested during analysis phase,
6003 : still returned but filled with identity permutation.
6004 :
6005 : The function returns True when factorization resulted in nondegenerate
6006 : matrix. False is returned when factorization fails (Cholesky factorization
6007 : of indefinite matrix) or LDLT factorization has exactly zero elements at
6008 : the diagonal. In the latter case contents of A, D and P is undefined.
6009 :
6010 : The analysis object is not changed during the factorization. Subsequent
6011 : calls to SparseCholeskyFactorize() will result in same factorization being
6012 : performed one more time.
6013 :
6014 : -- ALGLIB routine --
6015 : 20.09.2020
6016 : Bochkanov Sergey
6017 : *************************************************************************/
6018 0 : bool sparsecholeskyfactorize(const sparsedecompositionanalysis &analysis, const bool needupper, sparsematrix &a, real_1d_array &d, integer_1d_array &p, const xparams _xparams)
6019 : {
6020 : jmp_buf _break_jump;
6021 : alglib_impl::ae_state _alglib_env_state;
6022 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6023 0 : if( setjmp(_break_jump) )
6024 : {
6025 : #if !defined(AE_NO_EXCEPTIONS)
6026 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6027 : #else
6028 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6029 : return 0;
6030 : #endif
6031 : }
6032 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6033 0 : if( _xparams.flags!=0x0 )
6034 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6035 0 : ae_bool result = alglib_impl::sparsecholeskyfactorize(const_cast<alglib_impl::sparsedecompositionanalysis*>(analysis.c_ptr()), needupper, const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(p.c_ptr()), &_alglib_env_state);
6036 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6037 0 : return *(reinterpret_cast<bool*>(&result));
6038 : }
6039 :
6040 : /*************************************************************************
6041 : Sparse Cholesky decomposition: update internally stored matrix with
6042 : another one with exactly same sparsity pattern.
6043 :
6044 : This function is a part of the 'expert' sparse Cholesky API:
6045 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
6046 : matrix to be factorized into internal storage
6047 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
6048 : with lower bounds on pivot magnitudes and additional overflow safeguards
6049 : * SparseCholeskyFactorize(), that performs numeric factorization using
6050 : precomputed symbolic analysis and internally stored matrix - and outputs
6051 : result
6052 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
6053 : pattern into internal storage so one may reuse previously allocated
6054 : temporaries and previously performed symbolic analysis
6055 :
6056 : This specific function replaces internally stored numerical values with
6057 : ones from another sparse matrix (but having exactly same sparsity pattern
6058 : as one that was used for initial SparseCholeskyAnalyze() call).
6059 :
6060 : NOTE: all internal processing is performed with lower triangular matrices
6061 : stored in CRS format. Any other storage formats and/or upper
6062 : triangular storage means that one format conversion and/or one
6063 : transposition will be performed internally for the analysis and
6064 : factorization phases. Thus, highest performance is achieved when
6065 : input is a lower triangular CRS matrix.
6066 :
6067 : INPUT PARAMETERS:
6068 : Analysis - analysis object
6069 : A - sparse square matrix in any sparse storage format. It
6070 : MUST have exactly same sparsity pattern as that of the
6071 : matrix that was passed to SparseCholeskyAnalyze().
6072 : Any difference (missing elements or additional elements)
6073 : may result in unpredictable and undefined behavior -
6074 : an algorithm may fail due to memory access violation.
6075 : IsUpper - whether upper or lower triangle is decomposed (the
6076 : other one is ignored).
6077 :
6078 : OUTPUT PARAMETERS:
6079 : Analysis - contains:
6080 : * symbolic analysis of the matrix structure which will
6081 : be used later to guide numerical factorization.
6082 : * specific numeric values loaded into internal memory
6083 : waiting for the factorization to be performed
6084 :
6085 : -- ALGLIB routine --
6086 : 20.09.2020
6087 : Bochkanov Sergey
6088 : *************************************************************************/
6089 0 : void sparsecholeskyreload(const sparsedecompositionanalysis &analysis, const sparsematrix &a, const bool isupper, const xparams _xparams)
6090 : {
6091 : jmp_buf _break_jump;
6092 : alglib_impl::ae_state _alglib_env_state;
6093 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6094 0 : if( setjmp(_break_jump) )
6095 : {
6096 : #if !defined(AE_NO_EXCEPTIONS)
6097 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6098 : #else
6099 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6100 : return;
6101 : #endif
6102 : }
6103 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6104 0 : if( _xparams.flags!=0x0 )
6105 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6106 0 : alglib_impl::sparsecholeskyreload(const_cast<alglib_impl::sparsedecompositionanalysis*>(analysis.c_ptr()), const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, &_alglib_env_state);
6107 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6108 0 : return;
6109 : }
6110 : #endif
6111 :
6112 : #if defined(AE_COMPILE_RCOND) || !defined(AE_PARTIAL_BUILD)
6113 : /*************************************************************************
6114 : Estimate of a matrix condition number (1-norm)
6115 :
6116 : The algorithm calculates a lower bound of the condition number. In this case,
6117 : the algorithm does not return a lower bound of the condition number, but an
6118 : inverse number (to avoid an overflow in case of a singular matrix).
6119 :
6120 : Input parameters:
6121 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6122 : N - size of matrix A.
6123 :
6124 : Result: 1/LowerBound(cond(A))
6125 :
6126 : NOTE:
6127 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6128 : 0.0 is returned in such cases.
6129 : *************************************************************************/
6130 0 : double rmatrixrcond1(const real_2d_array &a, const ae_int_t n, const xparams _xparams)
6131 : {
6132 : jmp_buf _break_jump;
6133 : alglib_impl::ae_state _alglib_env_state;
6134 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6135 0 : if( setjmp(_break_jump) )
6136 : {
6137 : #if !defined(AE_NO_EXCEPTIONS)
6138 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6139 : #else
6140 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6141 : return 0;
6142 : #endif
6143 : }
6144 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6145 0 : if( _xparams.flags!=0x0 )
6146 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6147 0 : double result = alglib_impl::rmatrixrcond1(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
6148 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6149 0 : return *(reinterpret_cast<double*>(&result));
6150 : }
6151 :
6152 : /*************************************************************************
6153 : Estimate of a matrix condition number (infinity-norm).
6154 :
6155 : The algorithm calculates a lower bound of the condition number. In this case,
6156 : the algorithm does not return a lower bound of the condition number, but an
6157 : inverse number (to avoid an overflow in case of a singular matrix).
6158 :
6159 : Input parameters:
6160 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6161 : N - size of matrix A.
6162 :
6163 : Result: 1/LowerBound(cond(A))
6164 :
6165 : NOTE:
6166 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6167 : 0.0 is returned in such cases.
6168 : *************************************************************************/
6169 0 : double rmatrixrcondinf(const real_2d_array &a, const ae_int_t n, const xparams _xparams)
6170 : {
6171 : jmp_buf _break_jump;
6172 : alglib_impl::ae_state _alglib_env_state;
6173 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6174 0 : if( setjmp(_break_jump) )
6175 : {
6176 : #if !defined(AE_NO_EXCEPTIONS)
6177 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6178 : #else
6179 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6180 : return 0;
6181 : #endif
6182 : }
6183 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6184 0 : if( _xparams.flags!=0x0 )
6185 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6186 0 : double result = alglib_impl::rmatrixrcondinf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
6187 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6188 0 : return *(reinterpret_cast<double*>(&result));
6189 : }
6190 :
6191 : /*************************************************************************
6192 : Condition number estimate of a symmetric positive definite matrix.
6193 :
6194 : The algorithm calculates a lower bound of the condition number. In this case,
6195 : the algorithm does not return a lower bound of the condition number, but an
6196 : inverse number (to avoid an overflow in case of a singular matrix).
6197 :
6198 : It should be noted that 1-norm and inf-norm of condition numbers of symmetric
6199 : matrices are equal, so the algorithm doesn't take into account the
6200 : differences between these types of norms.
6201 :
6202 : Input parameters:
6203 : A - symmetric positive definite matrix which is given by its
6204 : upper or lower triangle depending on the value of
6205 : IsUpper. Array with elements [0..N-1, 0..N-1].
6206 : N - size of matrix A.
6207 : IsUpper - storage format.
6208 :
6209 : Result:
6210 : 1/LowerBound(cond(A)), if matrix A is positive definite,
6211 : -1, if matrix A is not positive definite, and its condition number
6212 : could not be found by this algorithm.
6213 :
6214 : NOTE:
6215 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6216 : 0.0 is returned in such cases.
6217 : *************************************************************************/
6218 0 : double spdmatrixrcond(const real_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
6219 : {
6220 : jmp_buf _break_jump;
6221 : alglib_impl::ae_state _alglib_env_state;
6222 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6223 0 : if( setjmp(_break_jump) )
6224 : {
6225 : #if !defined(AE_NO_EXCEPTIONS)
6226 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6227 : #else
6228 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6229 : return 0;
6230 : #endif
6231 : }
6232 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6233 0 : if( _xparams.flags!=0x0 )
6234 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6235 0 : double result = alglib_impl::spdmatrixrcond(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
6236 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6237 0 : return *(reinterpret_cast<double*>(&result));
6238 : }
6239 :
6240 : /*************************************************************************
6241 : Triangular matrix: estimate of a condition number (1-norm)
6242 :
6243 : The algorithm calculates a lower bound of the condition number. In this case,
6244 : the algorithm does not return a lower bound of the condition number, but an
6245 : inverse number (to avoid an overflow in case of a singular matrix).
6246 :
6247 : Input parameters:
6248 : A - matrix. Array[0..N-1, 0..N-1].
6249 : N - size of A.
6250 : IsUpper - True, if the matrix is upper triangular.
6251 : IsUnit - True, if the matrix has a unit diagonal.
6252 :
6253 : Result: 1/LowerBound(cond(A))
6254 :
6255 : NOTE:
6256 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6257 : 0.0 is returned in such cases.
6258 : *************************************************************************/
6259 0 : double rmatrixtrrcond1(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, const xparams _xparams)
6260 : {
6261 : jmp_buf _break_jump;
6262 : alglib_impl::ae_state _alglib_env_state;
6263 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6264 0 : if( setjmp(_break_jump) )
6265 : {
6266 : #if !defined(AE_NO_EXCEPTIONS)
6267 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6268 : #else
6269 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6270 : return 0;
6271 : #endif
6272 : }
6273 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6274 0 : if( _xparams.flags!=0x0 )
6275 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6276 0 : double result = alglib_impl::rmatrixtrrcond1(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &_alglib_env_state);
6277 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6278 0 : return *(reinterpret_cast<double*>(&result));
6279 : }
6280 :
6281 : /*************************************************************************
6282 : Triangular matrix: estimate of a matrix condition number (infinity-norm).
6283 :
6284 : The algorithm calculates a lower bound of the condition number. In this case,
6285 : the algorithm does not return a lower bound of the condition number, but an
6286 : inverse number (to avoid an overflow in case of a singular matrix).
6287 :
6288 : Input parameters:
6289 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6290 : N - size of matrix A.
6291 : IsUpper - True, if the matrix is upper triangular.
6292 : IsUnit - True, if the matrix has a unit diagonal.
6293 :
6294 : Result: 1/LowerBound(cond(A))
6295 :
6296 : NOTE:
6297 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6298 : 0.0 is returned in such cases.
6299 : *************************************************************************/
6300 0 : double rmatrixtrrcondinf(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, const xparams _xparams)
6301 : {
6302 : jmp_buf _break_jump;
6303 : alglib_impl::ae_state _alglib_env_state;
6304 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6305 0 : if( setjmp(_break_jump) )
6306 : {
6307 : #if !defined(AE_NO_EXCEPTIONS)
6308 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6309 : #else
6310 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6311 : return 0;
6312 : #endif
6313 : }
6314 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6315 0 : if( _xparams.flags!=0x0 )
6316 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6317 0 : double result = alglib_impl::rmatrixtrrcondinf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &_alglib_env_state);
6318 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6319 0 : return *(reinterpret_cast<double*>(&result));
6320 : }
6321 :
6322 : /*************************************************************************
6323 : Condition number estimate of a Hermitian positive definite matrix.
6324 :
6325 : The algorithm calculates a lower bound of the condition number. In this case,
6326 : the algorithm does not return a lower bound of the condition number, but an
6327 : inverse number (to avoid an overflow in case of a singular matrix).
6328 :
6329 : It should be noted that 1-norm and inf-norm of condition numbers of symmetric
6330 : matrices are equal, so the algorithm doesn't take into account the
6331 : differences between these types of norms.
6332 :
6333 : Input parameters:
6334 : A - Hermitian positive definite matrix which is given by its
6335 : upper or lower triangle depending on the value of
6336 : IsUpper. Array with elements [0..N-1, 0..N-1].
6337 : N - size of matrix A.
6338 : IsUpper - storage format.
6339 :
6340 : Result:
6341 : 1/LowerBound(cond(A)), if matrix A is positive definite,
6342 : -1, if matrix A is not positive definite, and its condition number
6343 : could not be found by this algorithm.
6344 :
6345 : NOTE:
6346 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6347 : 0.0 is returned in such cases.
6348 : *************************************************************************/
6349 0 : double hpdmatrixrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
6350 : {
6351 : jmp_buf _break_jump;
6352 : alglib_impl::ae_state _alglib_env_state;
6353 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6354 0 : if( setjmp(_break_jump) )
6355 : {
6356 : #if !defined(AE_NO_EXCEPTIONS)
6357 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6358 : #else
6359 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6360 : return 0;
6361 : #endif
6362 : }
6363 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6364 0 : if( _xparams.flags!=0x0 )
6365 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6366 0 : double result = alglib_impl::hpdmatrixrcond(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
6367 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6368 0 : return *(reinterpret_cast<double*>(&result));
6369 : }
6370 :
6371 : /*************************************************************************
6372 : Estimate of a matrix condition number (1-norm)
6373 :
6374 : The algorithm calculates a lower bound of the condition number. In this case,
6375 : the algorithm does not return a lower bound of the condition number, but an
6376 : inverse number (to avoid an overflow in case of a singular matrix).
6377 :
6378 : Input parameters:
6379 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6380 : N - size of matrix A.
6381 :
6382 : Result: 1/LowerBound(cond(A))
6383 :
6384 : NOTE:
6385 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6386 : 0.0 is returned in such cases.
6387 : *************************************************************************/
6388 0 : double cmatrixrcond1(const complex_2d_array &a, const ae_int_t n, const xparams _xparams)
6389 : {
6390 : jmp_buf _break_jump;
6391 : alglib_impl::ae_state _alglib_env_state;
6392 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6393 0 : if( setjmp(_break_jump) )
6394 : {
6395 : #if !defined(AE_NO_EXCEPTIONS)
6396 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6397 : #else
6398 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6399 : return 0;
6400 : #endif
6401 : }
6402 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6403 0 : if( _xparams.flags!=0x0 )
6404 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6405 0 : double result = alglib_impl::cmatrixrcond1(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
6406 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6407 0 : return *(reinterpret_cast<double*>(&result));
6408 : }
6409 :
6410 : /*************************************************************************
6411 : Estimate of a matrix condition number (infinity-norm).
6412 :
6413 : The algorithm calculates a lower bound of the condition number. In this case,
6414 : the algorithm does not return a lower bound of the condition number, but an
6415 : inverse number (to avoid an overflow in case of a singular matrix).
6416 :
6417 : Input parameters:
6418 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6419 : N - size of matrix A.
6420 :
6421 : Result: 1/LowerBound(cond(A))
6422 :
6423 : NOTE:
6424 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6425 : 0.0 is returned in such cases.
6426 : *************************************************************************/
6427 0 : double cmatrixrcondinf(const complex_2d_array &a, const ae_int_t n, const xparams _xparams)
6428 : {
6429 : jmp_buf _break_jump;
6430 : alglib_impl::ae_state _alglib_env_state;
6431 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6432 0 : if( setjmp(_break_jump) )
6433 : {
6434 : #if !defined(AE_NO_EXCEPTIONS)
6435 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6436 : #else
6437 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6438 : return 0;
6439 : #endif
6440 : }
6441 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6442 0 : if( _xparams.flags!=0x0 )
6443 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6444 0 : double result = alglib_impl::cmatrixrcondinf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
6445 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6446 0 : return *(reinterpret_cast<double*>(&result));
6447 : }
6448 :
6449 : /*************************************************************************
6450 : Estimate of the condition number of a matrix given by its LU decomposition (1-norm)
6451 :
6452 : The algorithm calculates a lower bound of the condition number. In this case,
6453 : the algorithm does not return a lower bound of the condition number, but an
6454 : inverse number (to avoid an overflow in case of a singular matrix).
6455 :
6456 : Input parameters:
6457 : LUA - LU decomposition of a matrix in compact form. Output of
6458 : the RMatrixLU subroutine.
6459 : N - size of matrix A.
6460 :
6461 : Result: 1/LowerBound(cond(A))
6462 :
6463 : NOTE:
6464 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6465 : 0.0 is returned in such cases.
6466 : *************************************************************************/
6467 0 : double rmatrixlurcond1(const real_2d_array &lua, const ae_int_t n, const xparams _xparams)
6468 : {
6469 : jmp_buf _break_jump;
6470 : alglib_impl::ae_state _alglib_env_state;
6471 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6472 0 : if( setjmp(_break_jump) )
6473 : {
6474 : #if !defined(AE_NO_EXCEPTIONS)
6475 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6476 : #else
6477 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6478 : return 0;
6479 : #endif
6480 : }
6481 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6482 0 : if( _xparams.flags!=0x0 )
6483 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6484 0 : double result = alglib_impl::rmatrixlurcond1(const_cast<alglib_impl::ae_matrix*>(lua.c_ptr()), n, &_alglib_env_state);
6485 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6486 0 : return *(reinterpret_cast<double*>(&result));
6487 : }
6488 :
6489 : /*************************************************************************
6490 : Estimate of the condition number of a matrix given by its LU decomposition
6491 : (infinity norm).
6492 :
6493 : The algorithm calculates a lower bound of the condition number. In this case,
6494 : the algorithm does not return a lower bound of the condition number, but an
6495 : inverse number (to avoid an overflow in case of a singular matrix).
6496 :
6497 : Input parameters:
6498 : LUA - LU decomposition of a matrix in compact form. Output of
6499 : the RMatrixLU subroutine.
6500 : N - size of matrix A.
6501 :
6502 : Result: 1/LowerBound(cond(A))
6503 :
6504 : NOTE:
6505 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6506 : 0.0 is returned in such cases.
6507 : *************************************************************************/
6508 0 : double rmatrixlurcondinf(const real_2d_array &lua, const ae_int_t n, const xparams _xparams)
6509 : {
6510 : jmp_buf _break_jump;
6511 : alglib_impl::ae_state _alglib_env_state;
6512 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6513 0 : if( setjmp(_break_jump) )
6514 : {
6515 : #if !defined(AE_NO_EXCEPTIONS)
6516 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6517 : #else
6518 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6519 : return 0;
6520 : #endif
6521 : }
6522 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6523 0 : if( _xparams.flags!=0x0 )
6524 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6525 0 : double result = alglib_impl::rmatrixlurcondinf(const_cast<alglib_impl::ae_matrix*>(lua.c_ptr()), n, &_alglib_env_state);
6526 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6527 0 : return *(reinterpret_cast<double*>(&result));
6528 : }
6529 :
6530 : /*************************************************************************
6531 : Condition number estimate of a symmetric positive definite matrix given by
6532 : Cholesky decomposition.
6533 :
6534 : The algorithm calculates a lower bound of the condition number. In this
6535 : case, the algorithm does not return a lower bound of the condition number,
6536 : but an inverse number (to avoid an overflow in case of a singular matrix).
6537 :
6538 : It should be noted that 1-norm and inf-norm condition numbers of symmetric
6539 : matrices are equal, so the algorithm doesn't take into account the
6540 : differences between these types of norms.
6541 :
6542 : Input parameters:
6543 : CD - Cholesky decomposition of matrix A,
6544 : output of SMatrixCholesky subroutine.
6545 : N - size of matrix A.
6546 :
6547 : Result: 1/LowerBound(cond(A))
6548 :
6549 : NOTE:
6550 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6551 : 0.0 is returned in such cases.
6552 : *************************************************************************/
6553 0 : double spdmatrixcholeskyrcond(const real_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
6554 : {
6555 : jmp_buf _break_jump;
6556 : alglib_impl::ae_state _alglib_env_state;
6557 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6558 0 : if( setjmp(_break_jump) )
6559 : {
6560 : #if !defined(AE_NO_EXCEPTIONS)
6561 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6562 : #else
6563 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6564 : return 0;
6565 : #endif
6566 : }
6567 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6568 0 : if( _xparams.flags!=0x0 )
6569 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6570 0 : double result = alglib_impl::spdmatrixcholeskyrcond(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
6571 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6572 0 : return *(reinterpret_cast<double*>(&result));
6573 : }
6574 :
6575 : /*************************************************************************
6576 : Condition number estimate of a Hermitian positive definite matrix given by
6577 : Cholesky decomposition.
6578 :
6579 : The algorithm calculates a lower bound of the condition number. In this
6580 : case, the algorithm does not return a lower bound of the condition number,
6581 : but an inverse number (to avoid an overflow in case of a singular matrix).
6582 :
6583 : It should be noted that 1-norm and inf-norm condition numbers of symmetric
6584 : matrices are equal, so the algorithm doesn't take into account the
6585 : differences between these types of norms.
6586 :
6587 : Input parameters:
6588 : CD - Cholesky decomposition of matrix A,
6589 : output of SMatrixCholesky subroutine.
6590 : N - size of matrix A.
6591 :
6592 : Result: 1/LowerBound(cond(A))
6593 :
6594 : NOTE:
6595 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6596 : 0.0 is returned in such cases.
6597 : *************************************************************************/
6598 0 : double hpdmatrixcholeskyrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
6599 : {
6600 : jmp_buf _break_jump;
6601 : alglib_impl::ae_state _alglib_env_state;
6602 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6603 0 : if( setjmp(_break_jump) )
6604 : {
6605 : #if !defined(AE_NO_EXCEPTIONS)
6606 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6607 : #else
6608 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6609 : return 0;
6610 : #endif
6611 : }
6612 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6613 0 : if( _xparams.flags!=0x0 )
6614 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6615 0 : double result = alglib_impl::hpdmatrixcholeskyrcond(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
6616 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6617 0 : return *(reinterpret_cast<double*>(&result));
6618 : }
6619 :
6620 : /*************************************************************************
6621 : Estimate of the condition number of a matrix given by its LU decomposition (1-norm)
6622 :
6623 : The algorithm calculates a lower bound of the condition number. In this case,
6624 : the algorithm does not return a lower bound of the condition number, but an
6625 : inverse number (to avoid an overflow in case of a singular matrix).
6626 :
6627 : Input parameters:
6628 : LUA - LU decomposition of a matrix in compact form. Output of
6629 : the CMatrixLU subroutine.
6630 : N - size of matrix A.
6631 :
6632 : Result: 1/LowerBound(cond(A))
6633 :
6634 : NOTE:
6635 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6636 : 0.0 is returned in such cases.
6637 : *************************************************************************/
6638 0 : double cmatrixlurcond1(const complex_2d_array &lua, const ae_int_t n, const xparams _xparams)
6639 : {
6640 : jmp_buf _break_jump;
6641 : alglib_impl::ae_state _alglib_env_state;
6642 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6643 0 : if( setjmp(_break_jump) )
6644 : {
6645 : #if !defined(AE_NO_EXCEPTIONS)
6646 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6647 : #else
6648 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6649 : return 0;
6650 : #endif
6651 : }
6652 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6653 0 : if( _xparams.flags!=0x0 )
6654 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6655 0 : double result = alglib_impl::cmatrixlurcond1(const_cast<alglib_impl::ae_matrix*>(lua.c_ptr()), n, &_alglib_env_state);
6656 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6657 0 : return *(reinterpret_cast<double*>(&result));
6658 : }
6659 :
6660 : /*************************************************************************
6661 : Estimate of the condition number of a matrix given by its LU decomposition
6662 : (infinity norm).
6663 :
6664 : The algorithm calculates a lower bound of the condition number. In this case,
6665 : the algorithm does not return a lower bound of the condition number, but an
6666 : inverse number (to avoid an overflow in case of a singular matrix).
6667 :
6668 : Input parameters:
6669 : LUA - LU decomposition of a matrix in compact form. Output of
6670 : the CMatrixLU subroutine.
6671 : N - size of matrix A.
6672 :
6673 : Result: 1/LowerBound(cond(A))
6674 :
6675 : NOTE:
6676 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6677 : 0.0 is returned in such cases.
6678 : *************************************************************************/
6679 0 : double cmatrixlurcondinf(const complex_2d_array &lua, const ae_int_t n, const xparams _xparams)
6680 : {
6681 : jmp_buf _break_jump;
6682 : alglib_impl::ae_state _alglib_env_state;
6683 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6684 0 : if( setjmp(_break_jump) )
6685 : {
6686 : #if !defined(AE_NO_EXCEPTIONS)
6687 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6688 : #else
6689 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6690 : return 0;
6691 : #endif
6692 : }
6693 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6694 0 : if( _xparams.flags!=0x0 )
6695 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6696 0 : double result = alglib_impl::cmatrixlurcondinf(const_cast<alglib_impl::ae_matrix*>(lua.c_ptr()), n, &_alglib_env_state);
6697 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6698 0 : return *(reinterpret_cast<double*>(&result));
6699 : }
6700 :
6701 : /*************************************************************************
6702 : Triangular matrix: estimate of a condition number (1-norm)
6703 :
6704 : The algorithm calculates a lower bound of the condition number. In this case,
6705 : the algorithm does not return a lower bound of the condition number, but an
6706 : inverse number (to avoid an overflow in case of a singular matrix).
6707 :
6708 : Input parameters:
6709 : A - matrix. Array[0..N-1, 0..N-1].
6710 : N - size of A.
6711 : IsUpper - True, if the matrix is upper triangular.
6712 : IsUnit - True, if the matrix has a unit diagonal.
6713 :
6714 : Result: 1/LowerBound(cond(A))
6715 :
6716 : NOTE:
6717 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6718 : 0.0 is returned in such cases.
6719 : *************************************************************************/
6720 0 : double cmatrixtrrcond1(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, const xparams _xparams)
6721 : {
6722 : jmp_buf _break_jump;
6723 : alglib_impl::ae_state _alglib_env_state;
6724 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6725 0 : if( setjmp(_break_jump) )
6726 : {
6727 : #if !defined(AE_NO_EXCEPTIONS)
6728 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6729 : #else
6730 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6731 : return 0;
6732 : #endif
6733 : }
6734 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6735 0 : if( _xparams.flags!=0x0 )
6736 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6737 0 : double result = alglib_impl::cmatrixtrrcond1(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &_alglib_env_state);
6738 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6739 0 : return *(reinterpret_cast<double*>(&result));
6740 : }
6741 :
6742 : /*************************************************************************
6743 : Triangular matrix: estimate of a matrix condition number (infinity-norm).
6744 :
6745 : The algorithm calculates a lower bound of the condition number. In this case,
6746 : the algorithm does not return a lower bound of the condition number, but an
6747 : inverse number (to avoid an overflow in case of a singular matrix).
6748 :
6749 : Input parameters:
6750 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
6751 : N - size of matrix A.
6752 : IsUpper - True, if the matrix is upper triangular.
6753 : IsUnit - True, if the matrix has a unit diagonal.
6754 :
6755 : Result: 1/LowerBound(cond(A))
6756 :
6757 : NOTE:
6758 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
6759 : 0.0 is returned in such cases.
6760 : *************************************************************************/
6761 0 : double cmatrixtrrcondinf(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, const xparams _xparams)
6762 : {
6763 : jmp_buf _break_jump;
6764 : alglib_impl::ae_state _alglib_env_state;
6765 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6766 0 : if( setjmp(_break_jump) )
6767 : {
6768 : #if !defined(AE_NO_EXCEPTIONS)
6769 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6770 : #else
6771 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6772 : return 0;
6773 : #endif
6774 : }
6775 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6776 0 : if( _xparams.flags!=0x0 )
6777 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6778 0 : double result = alglib_impl::cmatrixtrrcondinf(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &_alglib_env_state);
6779 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6780 0 : return *(reinterpret_cast<double*>(&result));
6781 : }
6782 : #endif
6783 :
6784 : #if defined(AE_COMPILE_MATINV) || !defined(AE_PARTIAL_BUILD)
6785 : /*************************************************************************
6786 : Matrix inverse report:
6787 : * R1 reciprocal of condition number in 1-norm
6788 : * RInf reciprocal of condition number in inf-norm
6789 : *************************************************************************/
6790 0 : _matinvreport_owner::_matinvreport_owner()
6791 : {
6792 : jmp_buf _break_jump;
6793 : alglib_impl::ae_state _state;
6794 :
6795 0 : alglib_impl::ae_state_init(&_state);
6796 0 : if( setjmp(_break_jump) )
6797 : {
6798 0 : if( p_struct!=NULL )
6799 : {
6800 0 : alglib_impl::_matinvreport_destroy(p_struct);
6801 0 : alglib_impl::ae_free(p_struct);
6802 : }
6803 0 : p_struct = NULL;
6804 : #if !defined(AE_NO_EXCEPTIONS)
6805 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
6806 : #else
6807 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
6808 : return;
6809 : #endif
6810 : }
6811 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
6812 0 : p_struct = NULL;
6813 0 : p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), &_state);
6814 0 : memset(p_struct, 0, sizeof(alglib_impl::matinvreport));
6815 0 : alglib_impl::_matinvreport_init(p_struct, &_state, ae_false);
6816 0 : ae_state_clear(&_state);
6817 0 : }
6818 :
6819 0 : _matinvreport_owner::_matinvreport_owner(const _matinvreport_owner &rhs)
6820 : {
6821 : jmp_buf _break_jump;
6822 : alglib_impl::ae_state _state;
6823 :
6824 0 : alglib_impl::ae_state_init(&_state);
6825 0 : if( setjmp(_break_jump) )
6826 : {
6827 0 : if( p_struct!=NULL )
6828 : {
6829 0 : alglib_impl::_matinvreport_destroy(p_struct);
6830 0 : alglib_impl::ae_free(p_struct);
6831 : }
6832 0 : p_struct = NULL;
6833 : #if !defined(AE_NO_EXCEPTIONS)
6834 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
6835 : #else
6836 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
6837 : return;
6838 : #endif
6839 : }
6840 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
6841 0 : p_struct = NULL;
6842 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: matinvreport copy constructor failure (source is not initialized)", &_state);
6843 0 : p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), &_state);
6844 0 : memset(p_struct, 0, sizeof(alglib_impl::matinvreport));
6845 0 : alglib_impl::_matinvreport_init_copy(p_struct, const_cast<alglib_impl::matinvreport*>(rhs.p_struct), &_state, ae_false);
6846 0 : ae_state_clear(&_state);
6847 0 : }
6848 :
6849 0 : _matinvreport_owner& _matinvreport_owner::operator=(const _matinvreport_owner &rhs)
6850 : {
6851 0 : if( this==&rhs )
6852 0 : return *this;
6853 : jmp_buf _break_jump;
6854 : alglib_impl::ae_state _state;
6855 :
6856 0 : alglib_impl::ae_state_init(&_state);
6857 0 : if( setjmp(_break_jump) )
6858 : {
6859 : #if !defined(AE_NO_EXCEPTIONS)
6860 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
6861 : #else
6862 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
6863 : return *this;
6864 : #endif
6865 : }
6866 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
6867 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: matinvreport assignment constructor failure (destination is not initialized)", &_state);
6868 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: matinvreport assignment constructor failure (source is not initialized)", &_state);
6869 0 : alglib_impl::_matinvreport_destroy(p_struct);
6870 0 : memset(p_struct, 0, sizeof(alglib_impl::matinvreport));
6871 0 : alglib_impl::_matinvreport_init_copy(p_struct, const_cast<alglib_impl::matinvreport*>(rhs.p_struct), &_state, ae_false);
6872 0 : ae_state_clear(&_state);
6873 0 : return *this;
6874 : }
6875 :
6876 0 : _matinvreport_owner::~_matinvreport_owner()
6877 : {
6878 0 : if( p_struct!=NULL )
6879 : {
6880 0 : alglib_impl::_matinvreport_destroy(p_struct);
6881 0 : ae_free(p_struct);
6882 : }
6883 0 : }
6884 :
6885 0 : alglib_impl::matinvreport* _matinvreport_owner::c_ptr()
6886 : {
6887 0 : return p_struct;
6888 : }
6889 :
6890 0 : alglib_impl::matinvreport* _matinvreport_owner::c_ptr() const
6891 : {
6892 0 : return const_cast<alglib_impl::matinvreport*>(p_struct);
6893 : }
6894 0 : matinvreport::matinvreport() : _matinvreport_owner() ,r1(p_struct->r1),rinf(p_struct->rinf)
6895 : {
6896 0 : }
6897 :
6898 0 : matinvreport::matinvreport(const matinvreport &rhs):_matinvreport_owner(rhs) ,r1(p_struct->r1),rinf(p_struct->rinf)
6899 : {
6900 0 : }
6901 :
6902 0 : matinvreport& matinvreport::operator=(const matinvreport &rhs)
6903 : {
6904 0 : if( this==&rhs )
6905 0 : return *this;
6906 0 : _matinvreport_owner::operator=(rhs);
6907 0 : return *this;
6908 : }
6909 :
6910 0 : matinvreport::~matinvreport()
6911 : {
6912 0 : }
6913 :
6914 : /*************************************************************************
6915 : Inversion of a matrix given by its LU decomposition.
6916 :
6917 : ! COMMERCIAL EDITION OF ALGLIB:
6918 : !
6919 : ! Commercial Edition of ALGLIB includes following important improvements
6920 : ! of this function:
6921 : ! * high-performance native backend with same C# interface (C# version)
6922 : ! * multithreading support (C++ and C# versions)
6923 : ! * hardware vendor (Intel) implementations of linear algebra primitives
6924 : ! (C++ and C# versions, x86/x64 platform)
6925 : !
6926 : ! We recommend you to read 'Working with commercial version' section of
6927 : ! ALGLIB Reference Manual in order to find out how to use performance-
6928 : ! related features provided by commercial edition of ALGLIB.
6929 :
6930 : INPUT PARAMETERS:
6931 : A - LU decomposition of the matrix
6932 : (output of RMatrixLU subroutine).
6933 : Pivots - table of permutations
6934 : (the output of RMatrixLU subroutine).
6935 : N - size of matrix A (optional) :
6936 : * if given, only principal NxN submatrix is processed and
6937 : overwritten. other elements are unchanged.
6938 : * if not given, size is automatically determined from
6939 : matrix size (A must be square matrix)
6940 :
6941 : OUTPUT PARAMETERS:
6942 : Info - return code:
6943 : * -3 A is singular, or VERY close to singular.
6944 : it is filled by zeros in such cases.
6945 : * 1 task is solved (but matrix A may be ill-conditioned,
6946 : check R1/RInf parameters for condition numbers).
6947 : Rep - solver report, see below for more info
6948 : A - inverse of matrix A.
6949 : Array whose indexes range within [0..N-1, 0..N-1].
6950 :
6951 : SOLVER REPORT
6952 :
6953 : Subroutine sets following fields of the Rep structure:
6954 : * R1 reciprocal of condition number: 1/cond(A), 1-norm.
6955 : * RInf reciprocal of condition number: 1/cond(A), inf-norm.
6956 :
6957 : -- ALGLIB routine --
6958 : 05.02.2010
6959 : Bochkanov Sergey
6960 : *************************************************************************/
6961 0 : void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep, const xparams _xparams)
6962 : {
6963 : jmp_buf _break_jump;
6964 : alglib_impl::ae_state _alglib_env_state;
6965 0 : alglib_impl::ae_state_init(&_alglib_env_state);
6966 0 : if( setjmp(_break_jump) )
6967 : {
6968 : #if !defined(AE_NO_EXCEPTIONS)
6969 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
6970 : #else
6971 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
6972 : return;
6973 : #endif
6974 : }
6975 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
6976 0 : if( _xparams.flags!=0x0 )
6977 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
6978 0 : alglib_impl::rmatrixluinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
6979 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
6980 0 : return;
6981 : }
6982 :
6983 : /*************************************************************************
6984 : Inversion of a matrix given by its LU decomposition.
6985 :
6986 : ! COMMERCIAL EDITION OF ALGLIB:
6987 : !
6988 : ! Commercial Edition of ALGLIB includes following important improvements
6989 : ! of this function:
6990 : ! * high-performance native backend with same C# interface (C# version)
6991 : ! * multithreading support (C++ and C# versions)
6992 : ! * hardware vendor (Intel) implementations of linear algebra primitives
6993 : ! (C++ and C# versions, x86/x64 platform)
6994 : !
6995 : ! We recommend you to read 'Working with commercial version' section of
6996 : ! ALGLIB Reference Manual in order to find out how to use performance-
6997 : ! related features provided by commercial edition of ALGLIB.
6998 :
6999 : INPUT PARAMETERS:
7000 : A - LU decomposition of the matrix
7001 : (output of RMatrixLU subroutine).
7002 : Pivots - table of permutations
7003 : (the output of RMatrixLU subroutine).
7004 : N - size of matrix A (optional) :
7005 : * if given, only principal NxN submatrix is processed and
7006 : overwritten. other elements are unchanged.
7007 : * if not given, size is automatically determined from
7008 : matrix size (A must be square matrix)
7009 :
7010 : OUTPUT PARAMETERS:
7011 : Info - return code:
7012 : * -3 A is singular, or VERY close to singular.
7013 : it is filled by zeros in such cases.
7014 : * 1 task is solved (but matrix A may be ill-conditioned,
7015 : check R1/RInf parameters for condition numbers).
7016 : Rep - solver report, see below for more info
7017 : A - inverse of matrix A.
7018 : Array whose indexes range within [0..N-1, 0..N-1].
7019 :
7020 : SOLVER REPORT
7021 :
7022 : Subroutine sets following fields of the Rep structure:
7023 : * R1 reciprocal of condition number: 1/cond(A), 1-norm.
7024 : * RInf reciprocal of condition number: 1/cond(A), inf-norm.
7025 :
7026 : -- ALGLIB routine --
7027 : 05.02.2010
7028 : Bochkanov Sergey
7029 : *************************************************************************/
7030 : #if !defined(AE_NO_EXCEPTIONS)
7031 0 : void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7032 : {
7033 : jmp_buf _break_jump;
7034 : alglib_impl::ae_state _alglib_env_state;
7035 : ae_int_t n;
7036 0 : if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length()))
7037 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'rmatrixluinverse': looks like one of arguments has wrong size");
7038 0 : n = a.cols();
7039 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7040 0 : if( setjmp(_break_jump) )
7041 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7042 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7043 0 : if( _xparams.flags!=0x0 )
7044 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7045 0 : alglib_impl::rmatrixluinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7046 :
7047 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7048 0 : return;
7049 : }
7050 : #endif
7051 :
7052 : /*************************************************************************
7053 : Inversion of a general matrix.
7054 :
7055 : ! COMMERCIAL EDITION OF ALGLIB:
7056 : !
7057 : ! Commercial Edition of ALGLIB includes following important improvements
7058 : ! of this function:
7059 : ! * high-performance native backend with same C# interface (C# version)
7060 : ! * multithreading support (C++ and C# versions)
7061 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7062 : ! (C++ and C# versions, x86/x64 platform)
7063 : !
7064 : ! We recommend you to read 'Working with commercial version' section of
7065 : ! ALGLIB Reference Manual in order to find out how to use performance-
7066 : ! related features provided by commercial edition of ALGLIB.
7067 :
7068 : Input parameters:
7069 : A - matrix.
7070 : N - size of matrix A (optional) :
7071 : * if given, only principal NxN submatrix is processed and
7072 : overwritten. other elements are unchanged.
7073 : * if not given, size is automatically determined from
7074 : matrix size (A must be square matrix)
7075 :
7076 : Output parameters:
7077 : Info - return code, same as in RMatrixLUInverse
7078 : Rep - solver report, same as in RMatrixLUInverse
7079 : A - inverse of matrix A, same as in RMatrixLUInverse
7080 :
7081 : Result:
7082 : True, if the matrix is not singular.
7083 : False, if the matrix is singular.
7084 :
7085 : -- ALGLIB --
7086 : Copyright 2005-2010 by Bochkanov Sergey
7087 : *************************************************************************/
7088 0 : void rmatrixinverse(real_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7089 : {
7090 : jmp_buf _break_jump;
7091 : alglib_impl::ae_state _alglib_env_state;
7092 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7093 0 : if( setjmp(_break_jump) )
7094 : {
7095 : #if !defined(AE_NO_EXCEPTIONS)
7096 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7097 : #else
7098 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7099 : return;
7100 : #endif
7101 : }
7102 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7103 0 : if( _xparams.flags!=0x0 )
7104 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7105 0 : alglib_impl::rmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7106 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7107 0 : return;
7108 : }
7109 :
7110 : /*************************************************************************
7111 : Inversion of a general matrix.
7112 :
7113 : ! COMMERCIAL EDITION OF ALGLIB:
7114 : !
7115 : ! Commercial Edition of ALGLIB includes following important improvements
7116 : ! of this function:
7117 : ! * high-performance native backend with same C# interface (C# version)
7118 : ! * multithreading support (C++ and C# versions)
7119 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7120 : ! (C++ and C# versions, x86/x64 platform)
7121 : !
7122 : ! We recommend you to read 'Working with commercial version' section of
7123 : ! ALGLIB Reference Manual in order to find out how to use performance-
7124 : ! related features provided by commercial edition of ALGLIB.
7125 :
7126 : Input parameters:
7127 : A - matrix.
7128 : N - size of matrix A (optional) :
7129 : * if given, only principal NxN submatrix is processed and
7130 : overwritten. other elements are unchanged.
7131 : * if not given, size is automatically determined from
7132 : matrix size (A must be square matrix)
7133 :
7134 : Output parameters:
7135 : Info - return code, same as in RMatrixLUInverse
7136 : Rep - solver report, same as in RMatrixLUInverse
7137 : A - inverse of matrix A, same as in RMatrixLUInverse
7138 :
7139 : Result:
7140 : True, if the matrix is not singular.
7141 : False, if the matrix is singular.
7142 :
7143 : -- ALGLIB --
7144 : Copyright 2005-2010 by Bochkanov Sergey
7145 : *************************************************************************/
7146 : #if !defined(AE_NO_EXCEPTIONS)
7147 0 : void rmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7148 : {
7149 : jmp_buf _break_jump;
7150 : alglib_impl::ae_state _alglib_env_state;
7151 : ae_int_t n;
7152 0 : if( (a.cols()!=a.rows()))
7153 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'rmatrixinverse': looks like one of arguments has wrong size");
7154 0 : n = a.cols();
7155 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7156 0 : if( setjmp(_break_jump) )
7157 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7158 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7159 0 : if( _xparams.flags!=0x0 )
7160 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7161 0 : alglib_impl::rmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7162 :
7163 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7164 0 : return;
7165 : }
7166 : #endif
7167 :
7168 : /*************************************************************************
7169 : Inversion of a matrix given by its LU decomposition.
7170 :
7171 : ! COMMERCIAL EDITION OF ALGLIB:
7172 : !
7173 : ! Commercial Edition of ALGLIB includes following important improvements
7174 : ! of this function:
7175 : ! * high-performance native backend with same C# interface (C# version)
7176 : ! * multithreading support (C++ and C# versions)
7177 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7178 : ! (C++ and C# versions, x86/x64 platform)
7179 : !
7180 : ! We recommend you to read 'Working with commercial version' section of
7181 : ! ALGLIB Reference Manual in order to find out how to use performance-
7182 : ! related features provided by commercial edition of ALGLIB.
7183 :
7184 : INPUT PARAMETERS:
7185 : A - LU decomposition of the matrix
7186 : (output of CMatrixLU subroutine).
7187 : Pivots - table of permutations
7188 : (the output of CMatrixLU subroutine).
7189 : N - size of matrix A (optional) :
7190 : * if given, only principal NxN submatrix is processed and
7191 : overwritten. other elements are unchanged.
7192 : * if not given, size is automatically determined from
7193 : matrix size (A must be square matrix)
7194 :
7195 : OUTPUT PARAMETERS:
7196 : Info - return code, same as in RMatrixLUInverse
7197 : Rep - solver report, same as in RMatrixLUInverse
7198 : A - inverse of matrix A, same as in RMatrixLUInverse
7199 :
7200 : -- ALGLIB routine --
7201 : 05.02.2010
7202 : Bochkanov Sergey
7203 : *************************************************************************/
7204 0 : void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7205 : {
7206 : jmp_buf _break_jump;
7207 : alglib_impl::ae_state _alglib_env_state;
7208 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7209 0 : if( setjmp(_break_jump) )
7210 : {
7211 : #if !defined(AE_NO_EXCEPTIONS)
7212 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7213 : #else
7214 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7215 : return;
7216 : #endif
7217 : }
7218 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7219 0 : if( _xparams.flags!=0x0 )
7220 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7221 0 : alglib_impl::cmatrixluinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7222 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7223 0 : return;
7224 : }
7225 :
7226 : /*************************************************************************
7227 : Inversion of a matrix given by its LU decomposition.
7228 :
7229 : ! COMMERCIAL EDITION OF ALGLIB:
7230 : !
7231 : ! Commercial Edition of ALGLIB includes following important improvements
7232 : ! of this function:
7233 : ! * high-performance native backend with same C# interface (C# version)
7234 : ! * multithreading support (C++ and C# versions)
7235 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7236 : ! (C++ and C# versions, x86/x64 platform)
7237 : !
7238 : ! We recommend you to read 'Working with commercial version' section of
7239 : ! ALGLIB Reference Manual in order to find out how to use performance-
7240 : ! related features provided by commercial edition of ALGLIB.
7241 :
7242 : INPUT PARAMETERS:
7243 : A - LU decomposition of the matrix
7244 : (output of CMatrixLU subroutine).
7245 : Pivots - table of permutations
7246 : (the output of CMatrixLU subroutine).
7247 : N - size of matrix A (optional) :
7248 : * if given, only principal NxN submatrix is processed and
7249 : overwritten. other elements are unchanged.
7250 : * if not given, size is automatically determined from
7251 : matrix size (A must be square matrix)
7252 :
7253 : OUTPUT PARAMETERS:
7254 : Info - return code, same as in RMatrixLUInverse
7255 : Rep - solver report, same as in RMatrixLUInverse
7256 : A - inverse of matrix A, same as in RMatrixLUInverse
7257 :
7258 : -- ALGLIB routine --
7259 : 05.02.2010
7260 : Bochkanov Sergey
7261 : *************************************************************************/
7262 : #if !defined(AE_NO_EXCEPTIONS)
7263 0 : void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7264 : {
7265 : jmp_buf _break_jump;
7266 : alglib_impl::ae_state _alglib_env_state;
7267 : ae_int_t n;
7268 0 : if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length()))
7269 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'cmatrixluinverse': looks like one of arguments has wrong size");
7270 0 : n = a.cols();
7271 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7272 0 : if( setjmp(_break_jump) )
7273 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7274 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7275 0 : if( _xparams.flags!=0x0 )
7276 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7277 0 : alglib_impl::cmatrixluinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7278 :
7279 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7280 0 : return;
7281 : }
7282 : #endif
7283 :
7284 : /*************************************************************************
7285 : Inversion of a general matrix.
7286 :
7287 : ! COMMERCIAL EDITION OF ALGLIB:
7288 : !
7289 : ! Commercial Edition of ALGLIB includes following important improvements
7290 : ! of this function:
7291 : ! * high-performance native backend with same C# interface (C# version)
7292 : ! * multithreading support (C++ and C# versions)
7293 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7294 : ! (C++ and C# versions, x86/x64 platform)
7295 : !
7296 : ! We recommend you to read 'Working with commercial version' section of
7297 : ! ALGLIB Reference Manual in order to find out how to use performance-
7298 : ! related features provided by commercial edition of ALGLIB.
7299 :
7300 : Input parameters:
7301 : A - matrix
7302 : N - size of matrix A (optional) :
7303 : * if given, only principal NxN submatrix is processed and
7304 : overwritten. other elements are unchanged.
7305 : * if not given, size is automatically determined from
7306 : matrix size (A must be square matrix)
7307 :
7308 : Output parameters:
7309 : Info - return code, same as in RMatrixLUInverse
7310 : Rep - solver report, same as in RMatrixLUInverse
7311 : A - inverse of matrix A, same as in RMatrixLUInverse
7312 :
7313 : -- ALGLIB --
7314 : Copyright 2005 by Bochkanov Sergey
7315 : *************************************************************************/
7316 0 : void cmatrixinverse(complex_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7317 : {
7318 : jmp_buf _break_jump;
7319 : alglib_impl::ae_state _alglib_env_state;
7320 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7321 0 : if( setjmp(_break_jump) )
7322 : {
7323 : #if !defined(AE_NO_EXCEPTIONS)
7324 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7325 : #else
7326 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7327 : return;
7328 : #endif
7329 : }
7330 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7331 0 : if( _xparams.flags!=0x0 )
7332 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7333 0 : alglib_impl::cmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7334 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7335 0 : return;
7336 : }
7337 :
7338 : /*************************************************************************
7339 : Inversion of a general matrix.
7340 :
7341 : ! COMMERCIAL EDITION OF ALGLIB:
7342 : !
7343 : ! Commercial Edition of ALGLIB includes following important improvements
7344 : ! of this function:
7345 : ! * high-performance native backend with same C# interface (C# version)
7346 : ! * multithreading support (C++ and C# versions)
7347 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7348 : ! (C++ and C# versions, x86/x64 platform)
7349 : !
7350 : ! We recommend you to read 'Working with commercial version' section of
7351 : ! ALGLIB Reference Manual in order to find out how to use performance-
7352 : ! related features provided by commercial edition of ALGLIB.
7353 :
7354 : Input parameters:
7355 : A - matrix
7356 : N - size of matrix A (optional) :
7357 : * if given, only principal NxN submatrix is processed and
7358 : overwritten. other elements are unchanged.
7359 : * if not given, size is automatically determined from
7360 : matrix size (A must be square matrix)
7361 :
7362 : Output parameters:
7363 : Info - return code, same as in RMatrixLUInverse
7364 : Rep - solver report, same as in RMatrixLUInverse
7365 : A - inverse of matrix A, same as in RMatrixLUInverse
7366 :
7367 : -- ALGLIB --
7368 : Copyright 2005 by Bochkanov Sergey
7369 : *************************************************************************/
7370 : #if !defined(AE_NO_EXCEPTIONS)
7371 0 : void cmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7372 : {
7373 : jmp_buf _break_jump;
7374 : alglib_impl::ae_state _alglib_env_state;
7375 : ae_int_t n;
7376 0 : if( (a.cols()!=a.rows()))
7377 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'cmatrixinverse': looks like one of arguments has wrong size");
7378 0 : n = a.cols();
7379 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7380 0 : if( setjmp(_break_jump) )
7381 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7382 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7383 0 : if( _xparams.flags!=0x0 )
7384 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7385 0 : alglib_impl::cmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7386 :
7387 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7388 0 : return;
7389 : }
7390 : #endif
7391 :
7392 : /*************************************************************************
7393 : Inversion of a symmetric positive definite matrix which is given
7394 : by Cholesky decomposition.
7395 :
7396 : ! COMMERCIAL EDITION OF ALGLIB:
7397 : !
7398 : ! Commercial Edition of ALGLIB includes following important improvements
7399 : ! of this function:
7400 : ! * high-performance native backend with same C# interface (C# version)
7401 : ! * multithreading support (C++ and C# versions)
7402 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7403 : ! (C++ and C# versions, x86/x64 platform)
7404 : !
7405 : ! We recommend you to read 'Working with commercial version' section of
7406 : ! ALGLIB Reference Manual in order to find out how to use performance-
7407 : ! related features provided by commercial edition of ALGLIB.
7408 :
7409 : Input parameters:
7410 : A - Cholesky decomposition of the matrix to be inverted:
7411 : A=U'*U or A = L*L'.
7412 : Output of SPDMatrixCholesky subroutine.
7413 : N - size of matrix A (optional) :
7414 : * if given, only principal NxN submatrix is processed and
7415 : overwritten. other elements are unchanged.
7416 : * if not given, size is automatically determined from
7417 : matrix size (A must be square matrix)
7418 : IsUpper - storage type (optional):
7419 : * if True, symmetric matrix A is given by its upper
7420 : triangle, and the lower triangle isn't used/changed by
7421 : function
7422 : * if False, symmetric matrix A is given by its lower
7423 : triangle, and the upper triangle isn't used/changed by
7424 : function
7425 : * if not given, lower half is used.
7426 :
7427 : Output parameters:
7428 : Info - return code, same as in RMatrixLUInverse
7429 : Rep - solver report, same as in RMatrixLUInverse
7430 : A - inverse of matrix A, same as in RMatrixLUInverse
7431 :
7432 : -- ALGLIB routine --
7433 : 10.02.2010
7434 : Bochkanov Sergey
7435 : *************************************************************************/
7436 0 : void spdmatrixcholeskyinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7437 : {
7438 : jmp_buf _break_jump;
7439 : alglib_impl::ae_state _alglib_env_state;
7440 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7441 0 : if( setjmp(_break_jump) )
7442 : {
7443 : #if !defined(AE_NO_EXCEPTIONS)
7444 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7445 : #else
7446 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7447 : return;
7448 : #endif
7449 : }
7450 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7451 0 : if( _xparams.flags!=0x0 )
7452 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7453 0 : alglib_impl::spdmatrixcholeskyinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7454 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7455 0 : return;
7456 : }
7457 :
7458 : /*************************************************************************
7459 : Inversion of a symmetric positive definite matrix which is given
7460 : by Cholesky decomposition.
7461 :
7462 : ! COMMERCIAL EDITION OF ALGLIB:
7463 : !
7464 : ! Commercial Edition of ALGLIB includes following important improvements
7465 : ! of this function:
7466 : ! * high-performance native backend with same C# interface (C# version)
7467 : ! * multithreading support (C++ and C# versions)
7468 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7469 : ! (C++ and C# versions, x86/x64 platform)
7470 : !
7471 : ! We recommend you to read 'Working with commercial version' section of
7472 : ! ALGLIB Reference Manual in order to find out how to use performance-
7473 : ! related features provided by commercial edition of ALGLIB.
7474 :
7475 : Input parameters:
7476 : A - Cholesky decomposition of the matrix to be inverted:
7477 : A=U'*U or A = L*L'.
7478 : Output of SPDMatrixCholesky subroutine.
7479 : N - size of matrix A (optional) :
7480 : * if given, only principal NxN submatrix is processed and
7481 : overwritten. other elements are unchanged.
7482 : * if not given, size is automatically determined from
7483 : matrix size (A must be square matrix)
7484 : IsUpper - storage type (optional):
7485 : * if True, symmetric matrix A is given by its upper
7486 : triangle, and the lower triangle isn't used/changed by
7487 : function
7488 : * if False, symmetric matrix A is given by its lower
7489 : triangle, and the upper triangle isn't used/changed by
7490 : function
7491 : * if not given, lower half is used.
7492 :
7493 : Output parameters:
7494 : Info - return code, same as in RMatrixLUInverse
7495 : Rep - solver report, same as in RMatrixLUInverse
7496 : A - inverse of matrix A, same as in RMatrixLUInverse
7497 :
7498 : -- ALGLIB routine --
7499 : 10.02.2010
7500 : Bochkanov Sergey
7501 : *************************************************************************/
7502 : #if !defined(AE_NO_EXCEPTIONS)
7503 0 : void spdmatrixcholeskyinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7504 : {
7505 : jmp_buf _break_jump;
7506 : alglib_impl::ae_state _alglib_env_state;
7507 : ae_int_t n;
7508 : bool isupper;
7509 0 : if( (a.cols()!=a.rows()))
7510 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'spdmatrixcholeskyinverse': looks like one of arguments has wrong size");
7511 0 : n = a.cols();
7512 0 : isupper = false;
7513 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7514 0 : if( setjmp(_break_jump) )
7515 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7516 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7517 0 : if( _xparams.flags!=0x0 )
7518 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7519 0 : alglib_impl::spdmatrixcholeskyinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7520 :
7521 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7522 0 : return;
7523 : }
7524 : #endif
7525 :
7526 : /*************************************************************************
7527 : Inversion of a symmetric positive definite matrix.
7528 :
7529 : Given an upper or lower triangle of a symmetric positive definite matrix,
7530 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
7531 : depending on the input.
7532 :
7533 : ! COMMERCIAL EDITION OF ALGLIB:
7534 : !
7535 : ! Commercial Edition of ALGLIB includes following important improvements
7536 : ! of this function:
7537 : ! * high-performance native backend with same C# interface (C# version)
7538 : ! * multithreading support (C++ and C# versions)
7539 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7540 : ! (C++ and C# versions, x86/x64 platform)
7541 : !
7542 : ! We recommend you to read 'Working with commercial version' section of
7543 : ! ALGLIB Reference Manual in order to find out how to use performance-
7544 : ! related features provided by commercial edition of ALGLIB.
7545 :
7546 : Input parameters:
7547 : A - matrix to be inverted (upper or lower triangle).
7548 : Array with elements [0..N-1,0..N-1].
7549 : N - size of matrix A (optional) :
7550 : * if given, only principal NxN submatrix is processed and
7551 : overwritten. other elements are unchanged.
7552 : * if not given, size is automatically determined from
7553 : matrix size (A must be square matrix)
7554 : IsUpper - storage type (optional):
7555 : * if True, symmetric matrix A is given by its upper
7556 : triangle, and the lower triangle isn't used/changed by
7557 : function
7558 : * if False, symmetric matrix A is given by its lower
7559 : triangle, and the upper triangle isn't used/changed by
7560 : function
7561 : * if not given, both lower and upper triangles must be
7562 : filled.
7563 :
7564 : Output parameters:
7565 : Info - return code, same as in RMatrixLUInverse
7566 : Rep - solver report, same as in RMatrixLUInverse
7567 : A - inverse of matrix A, same as in RMatrixLUInverse
7568 :
7569 : -- ALGLIB routine --
7570 : 10.02.2010
7571 : Bochkanov Sergey
7572 : *************************************************************************/
7573 0 : void spdmatrixinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7574 : {
7575 : jmp_buf _break_jump;
7576 : alglib_impl::ae_state _alglib_env_state;
7577 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7578 0 : if( setjmp(_break_jump) )
7579 : {
7580 : #if !defined(AE_NO_EXCEPTIONS)
7581 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7582 : #else
7583 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7584 : return;
7585 : #endif
7586 : }
7587 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7588 0 : if( _xparams.flags!=0x0 )
7589 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7590 0 : alglib_impl::spdmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7591 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7592 0 : return;
7593 : }
7594 :
7595 : /*************************************************************************
7596 : Inversion of a symmetric positive definite matrix.
7597 :
7598 : Given an upper or lower triangle of a symmetric positive definite matrix,
7599 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
7600 : depending on the input.
7601 :
7602 : ! COMMERCIAL EDITION OF ALGLIB:
7603 : !
7604 : ! Commercial Edition of ALGLIB includes following important improvements
7605 : ! of this function:
7606 : ! * high-performance native backend with same C# interface (C# version)
7607 : ! * multithreading support (C++ and C# versions)
7608 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7609 : ! (C++ and C# versions, x86/x64 platform)
7610 : !
7611 : ! We recommend you to read 'Working with commercial version' section of
7612 : ! ALGLIB Reference Manual in order to find out how to use performance-
7613 : ! related features provided by commercial edition of ALGLIB.
7614 :
7615 : Input parameters:
7616 : A - matrix to be inverted (upper or lower triangle).
7617 : Array with elements [0..N-1,0..N-1].
7618 : N - size of matrix A (optional) :
7619 : * if given, only principal NxN submatrix is processed and
7620 : overwritten. other elements are unchanged.
7621 : * if not given, size is automatically determined from
7622 : matrix size (A must be square matrix)
7623 : IsUpper - storage type (optional):
7624 : * if True, symmetric matrix A is given by its upper
7625 : triangle, and the lower triangle isn't used/changed by
7626 : function
7627 : * if False, symmetric matrix A is given by its lower
7628 : triangle, and the upper triangle isn't used/changed by
7629 : function
7630 : * if not given, both lower and upper triangles must be
7631 : filled.
7632 :
7633 : Output parameters:
7634 : Info - return code, same as in RMatrixLUInverse
7635 : Rep - solver report, same as in RMatrixLUInverse
7636 : A - inverse of matrix A, same as in RMatrixLUInverse
7637 :
7638 : -- ALGLIB routine --
7639 : 10.02.2010
7640 : Bochkanov Sergey
7641 : *************************************************************************/
7642 : #if !defined(AE_NO_EXCEPTIONS)
7643 0 : void spdmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7644 : {
7645 : jmp_buf _break_jump;
7646 : alglib_impl::ae_state _alglib_env_state;
7647 : ae_int_t n;
7648 : bool isupper;
7649 0 : if( (a.cols()!=a.rows()))
7650 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'spdmatrixinverse': looks like one of arguments has wrong size");
7651 0 : if( !alglib_impl::ae_is_symmetric(const_cast<alglib_impl::ae_matrix*>(a.c_ptr())) )
7652 0 : _ALGLIB_CPP_EXCEPTION("'a' parameter is not symmetric matrix");
7653 0 : n = a.cols();
7654 0 : isupper = false;
7655 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7656 0 : if( setjmp(_break_jump) )
7657 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7658 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7659 0 : if( _xparams.flags!=0x0 )
7660 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7661 0 : alglib_impl::spdmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7662 0 : if( !alglib_impl::ae_force_symmetric(const_cast<alglib_impl::ae_matrix*>(a.c_ptr())) )
7663 0 : _ALGLIB_CPP_EXCEPTION("Internal error while forcing symmetricity of 'a' parameter");
7664 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7665 0 : return;
7666 : }
7667 : #endif
7668 :
7669 : /*************************************************************************
7670 : Inversion of a Hermitian positive definite matrix which is given
7671 : by Cholesky decomposition.
7672 :
7673 : ! COMMERCIAL EDITION OF ALGLIB:
7674 : !
7675 : ! Commercial Edition of ALGLIB includes following important improvements
7676 : ! of this function:
7677 : ! * high-performance native backend with same C# interface (C# version)
7678 : ! * multithreading support (C++ and C# versions)
7679 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7680 : ! (C++ and C# versions, x86/x64 platform)
7681 : !
7682 : ! We recommend you to read 'Working with commercial version' section of
7683 : ! ALGLIB Reference Manual in order to find out how to use performance-
7684 : ! related features provided by commercial edition of ALGLIB.
7685 :
7686 : Input parameters:
7687 : A - Cholesky decomposition of the matrix to be inverted:
7688 : A=U'*U or A = L*L'.
7689 : Output of HPDMatrixCholesky subroutine.
7690 : N - size of matrix A (optional) :
7691 : * if given, only principal NxN submatrix is processed and
7692 : overwritten. other elements are unchanged.
7693 : * if not given, size is automatically determined from
7694 : matrix size (A must be square matrix)
7695 : IsUpper - storage type (optional):
7696 : * if True, symmetric matrix A is given by its upper
7697 : triangle, and the lower triangle isn't used/changed by
7698 : function
7699 : * if False, symmetric matrix A is given by its lower
7700 : triangle, and the upper triangle isn't used/changed by
7701 : function
7702 : * if not given, lower half is used.
7703 :
7704 : Output parameters:
7705 : Info - return code, same as in RMatrixLUInverse
7706 : Rep - solver report, same as in RMatrixLUInverse
7707 : A - inverse of matrix A, same as in RMatrixLUInverse
7708 :
7709 : -- ALGLIB routine --
7710 : 10.02.2010
7711 : Bochkanov Sergey
7712 : *************************************************************************/
7713 0 : void hpdmatrixcholeskyinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7714 : {
7715 : jmp_buf _break_jump;
7716 : alglib_impl::ae_state _alglib_env_state;
7717 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7718 0 : if( setjmp(_break_jump) )
7719 : {
7720 : #if !defined(AE_NO_EXCEPTIONS)
7721 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7722 : #else
7723 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7724 : return;
7725 : #endif
7726 : }
7727 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7728 0 : if( _xparams.flags!=0x0 )
7729 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7730 0 : alglib_impl::hpdmatrixcholeskyinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7731 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7732 0 : return;
7733 : }
7734 :
7735 : /*************************************************************************
7736 : Inversion of a Hermitian positive definite matrix which is given
7737 : by Cholesky decomposition.
7738 :
7739 : ! COMMERCIAL EDITION OF ALGLIB:
7740 : !
7741 : ! Commercial Edition of ALGLIB includes following important improvements
7742 : ! of this function:
7743 : ! * high-performance native backend with same C# interface (C# version)
7744 : ! * multithreading support (C++ and C# versions)
7745 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7746 : ! (C++ and C# versions, x86/x64 platform)
7747 : !
7748 : ! We recommend you to read 'Working with commercial version' section of
7749 : ! ALGLIB Reference Manual in order to find out how to use performance-
7750 : ! related features provided by commercial edition of ALGLIB.
7751 :
7752 : Input parameters:
7753 : A - Cholesky decomposition of the matrix to be inverted:
7754 : A=U'*U or A = L*L'.
7755 : Output of HPDMatrixCholesky subroutine.
7756 : N - size of matrix A (optional) :
7757 : * if given, only principal NxN submatrix is processed and
7758 : overwritten. other elements are unchanged.
7759 : * if not given, size is automatically determined from
7760 : matrix size (A must be square matrix)
7761 : IsUpper - storage type (optional):
7762 : * if True, symmetric matrix A is given by its upper
7763 : triangle, and the lower triangle isn't used/changed by
7764 : function
7765 : * if False, symmetric matrix A is given by its lower
7766 : triangle, and the upper triangle isn't used/changed by
7767 : function
7768 : * if not given, lower half is used.
7769 :
7770 : Output parameters:
7771 : Info - return code, same as in RMatrixLUInverse
7772 : Rep - solver report, same as in RMatrixLUInverse
7773 : A - inverse of matrix A, same as in RMatrixLUInverse
7774 :
7775 : -- ALGLIB routine --
7776 : 10.02.2010
7777 : Bochkanov Sergey
7778 : *************************************************************************/
7779 : #if !defined(AE_NO_EXCEPTIONS)
7780 0 : void hpdmatrixcholeskyinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7781 : {
7782 : jmp_buf _break_jump;
7783 : alglib_impl::ae_state _alglib_env_state;
7784 : ae_int_t n;
7785 : bool isupper;
7786 0 : if( (a.cols()!=a.rows()))
7787 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'hpdmatrixcholeskyinverse': looks like one of arguments has wrong size");
7788 0 : n = a.cols();
7789 0 : isupper = false;
7790 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7791 0 : if( setjmp(_break_jump) )
7792 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7793 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7794 0 : if( _xparams.flags!=0x0 )
7795 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7796 0 : alglib_impl::hpdmatrixcholeskyinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7797 :
7798 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7799 0 : return;
7800 : }
7801 : #endif
7802 :
7803 : /*************************************************************************
7804 : Inversion of a Hermitian positive definite matrix.
7805 :
7806 : Given an upper or lower triangle of a Hermitian positive definite matrix,
7807 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
7808 : depending on the input.
7809 :
7810 : ! COMMERCIAL EDITION OF ALGLIB:
7811 : !
7812 : ! Commercial Edition of ALGLIB includes following important improvements
7813 : ! of this function:
7814 : ! * high-performance native backend with same C# interface (C# version)
7815 : ! * multithreading support (C++ and C# versions)
7816 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7817 : ! (C++ and C# versions, x86/x64 platform)
7818 : !
7819 : ! We recommend you to read 'Working with commercial version' section of
7820 : ! ALGLIB Reference Manual in order to find out how to use performance-
7821 : ! related features provided by commercial edition of ALGLIB.
7822 :
7823 : Input parameters:
7824 : A - matrix to be inverted (upper or lower triangle).
7825 : Array with elements [0..N-1,0..N-1].
7826 : N - size of matrix A (optional) :
7827 : * if given, only principal NxN submatrix is processed and
7828 : overwritten. other elements are unchanged.
7829 : * if not given, size is automatically determined from
7830 : matrix size (A must be square matrix)
7831 : IsUpper - storage type (optional):
7832 : * if True, symmetric matrix A is given by its upper
7833 : triangle, and the lower triangle isn't used/changed by
7834 : function
7835 : * if False, symmetric matrix A is given by its lower
7836 : triangle, and the upper triangle isn't used/changed by
7837 : function
7838 : * if not given, both lower and upper triangles must be
7839 : filled.
7840 :
7841 : Output parameters:
7842 : Info - return code, same as in RMatrixLUInverse
7843 : Rep - solver report, same as in RMatrixLUInverse
7844 : A - inverse of matrix A, same as in RMatrixLUInverse
7845 :
7846 : -- ALGLIB routine --
7847 : 10.02.2010
7848 : Bochkanov Sergey
7849 : *************************************************************************/
7850 0 : void hpdmatrixinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7851 : {
7852 : jmp_buf _break_jump;
7853 : alglib_impl::ae_state _alglib_env_state;
7854 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7855 0 : if( setjmp(_break_jump) )
7856 : {
7857 : #if !defined(AE_NO_EXCEPTIONS)
7858 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7859 : #else
7860 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
7861 : return;
7862 : #endif
7863 : }
7864 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7865 0 : if( _xparams.flags!=0x0 )
7866 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7867 0 : alglib_impl::hpdmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7868 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7869 0 : return;
7870 : }
7871 :
7872 : /*************************************************************************
7873 : Inversion of a Hermitian positive definite matrix.
7874 :
7875 : Given an upper or lower triangle of a Hermitian positive definite matrix,
7876 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
7877 : depending on the input.
7878 :
7879 : ! COMMERCIAL EDITION OF ALGLIB:
7880 : !
7881 : ! Commercial Edition of ALGLIB includes following important improvements
7882 : ! of this function:
7883 : ! * high-performance native backend with same C# interface (C# version)
7884 : ! * multithreading support (C++ and C# versions)
7885 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7886 : ! (C++ and C# versions, x86/x64 platform)
7887 : !
7888 : ! We recommend you to read 'Working with commercial version' section of
7889 : ! ALGLIB Reference Manual in order to find out how to use performance-
7890 : ! related features provided by commercial edition of ALGLIB.
7891 :
7892 : Input parameters:
7893 : A - matrix to be inverted (upper or lower triangle).
7894 : Array with elements [0..N-1,0..N-1].
7895 : N - size of matrix A (optional) :
7896 : * if given, only principal NxN submatrix is processed and
7897 : overwritten. other elements are unchanged.
7898 : * if not given, size is automatically determined from
7899 : matrix size (A must be square matrix)
7900 : IsUpper - storage type (optional):
7901 : * if True, symmetric matrix A is given by its upper
7902 : triangle, and the lower triangle isn't used/changed by
7903 : function
7904 : * if False, symmetric matrix A is given by its lower
7905 : triangle, and the upper triangle isn't used/changed by
7906 : function
7907 : * if not given, both lower and upper triangles must be
7908 : filled.
7909 :
7910 : Output parameters:
7911 : Info - return code, same as in RMatrixLUInverse
7912 : Rep - solver report, same as in RMatrixLUInverse
7913 : A - inverse of matrix A, same as in RMatrixLUInverse
7914 :
7915 : -- ALGLIB routine --
7916 : 10.02.2010
7917 : Bochkanov Sergey
7918 : *************************************************************************/
7919 : #if !defined(AE_NO_EXCEPTIONS)
7920 0 : void hpdmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7921 : {
7922 : jmp_buf _break_jump;
7923 : alglib_impl::ae_state _alglib_env_state;
7924 : ae_int_t n;
7925 : bool isupper;
7926 0 : if( (a.cols()!=a.rows()))
7927 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'hpdmatrixinverse': looks like one of arguments has wrong size");
7928 0 : if( !alglib_impl::ae_is_hermitian(const_cast<alglib_impl::ae_matrix*>(a.c_ptr())) )
7929 0 : _ALGLIB_CPP_EXCEPTION("'a' parameter is not Hermitian matrix");
7930 0 : n = a.cols();
7931 0 : isupper = false;
7932 0 : alglib_impl::ae_state_init(&_alglib_env_state);
7933 0 : if( setjmp(_break_jump) )
7934 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
7935 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
7936 0 : if( _xparams.flags!=0x0 )
7937 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
7938 0 : alglib_impl::hpdmatrixinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
7939 0 : if( !alglib_impl::ae_force_hermitian(const_cast<alglib_impl::ae_matrix*>(a.c_ptr())) )
7940 0 : _ALGLIB_CPP_EXCEPTION("Internal error while forcing Hermitian properties of 'a' parameter");
7941 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
7942 0 : return;
7943 : }
7944 : #endif
7945 :
7946 : /*************************************************************************
7947 : Triangular matrix inverse (real)
7948 :
7949 : The subroutine inverts the following types of matrices:
7950 : * upper triangular
7951 : * upper triangular with unit diagonal
7952 : * lower triangular
7953 : * lower triangular with unit diagonal
7954 :
7955 : In case of an upper (lower) triangular matrix, the inverse matrix will
7956 : also be upper (lower) triangular, and after the end of the algorithm, the
7957 : inverse matrix replaces the source matrix. The elements below (above) the
7958 : main diagonal are not changed by the algorithm.
7959 :
7960 : If the matrix has a unit diagonal, the inverse matrix also has a unit
7961 : diagonal, and the diagonal elements are not passed to the algorithm.
7962 :
7963 : ! COMMERCIAL EDITION OF ALGLIB:
7964 : !
7965 : ! Commercial Edition of ALGLIB includes following important improvements
7966 : ! of this function:
7967 : ! * high-performance native backend with same C# interface (C# version)
7968 : ! * multithreading support (C++ and C# versions)
7969 : ! * hardware vendor (Intel) implementations of linear algebra primitives
7970 : ! (C++ and C# versions, x86/x64 platform)
7971 : !
7972 : ! We recommend you to read 'Working with commercial version' section of
7973 : ! ALGLIB Reference Manual in order to find out how to use performance-
7974 : ! related features provided by commercial edition of ALGLIB.
7975 :
7976 : Input parameters:
7977 : A - matrix, array[0..N-1, 0..N-1].
7978 : N - size of matrix A (optional) :
7979 : * if given, only principal NxN submatrix is processed and
7980 : overwritten. other elements are unchanged.
7981 : * if not given, size is automatically determined from
7982 : matrix size (A must be square matrix)
7983 : IsUpper - True, if the matrix is upper triangular.
7984 : IsUnit - diagonal type (optional):
7985 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
7986 : * if False, matrix diagonal is arbitrary
7987 : * if not given, False is assumed
7988 :
7989 : Output parameters:
7990 : Info - same as for RMatrixLUInverse
7991 : Rep - same as for RMatrixLUInverse
7992 : A - same as for RMatrixLUInverse.
7993 :
7994 : -- ALGLIB --
7995 : Copyright 05.02.2010 by Bochkanov Sergey
7996 : *************************************************************************/
7997 0 : void rmatrixtrinverse(real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep, const xparams _xparams)
7998 : {
7999 : jmp_buf _break_jump;
8000 : alglib_impl::ae_state _alglib_env_state;
8001 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8002 0 : if( setjmp(_break_jump) )
8003 : {
8004 : #if !defined(AE_NO_EXCEPTIONS)
8005 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8006 : #else
8007 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8008 : return;
8009 : #endif
8010 : }
8011 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8012 0 : if( _xparams.flags!=0x0 )
8013 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8014 0 : alglib_impl::rmatrixtrinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
8015 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8016 0 : return;
8017 : }
8018 :
8019 : /*************************************************************************
8020 : Triangular matrix inverse (real)
8021 :
8022 : The subroutine inverts the following types of matrices:
8023 : * upper triangular
8024 : * upper triangular with unit diagonal
8025 : * lower triangular
8026 : * lower triangular with unit diagonal
8027 :
8028 : In case of an upper (lower) triangular matrix, the inverse matrix will
8029 : also be upper (lower) triangular, and after the end of the algorithm, the
8030 : inverse matrix replaces the source matrix. The elements below (above) the
8031 : main diagonal are not changed by the algorithm.
8032 :
8033 : If the matrix has a unit diagonal, the inverse matrix also has a unit
8034 : diagonal, and the diagonal elements are not passed to the algorithm.
8035 :
8036 : ! COMMERCIAL EDITION OF ALGLIB:
8037 : !
8038 : ! Commercial Edition of ALGLIB includes following important improvements
8039 : ! of this function:
8040 : ! * high-performance native backend with same C# interface (C# version)
8041 : ! * multithreading support (C++ and C# versions)
8042 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8043 : ! (C++ and C# versions, x86/x64 platform)
8044 : !
8045 : ! We recommend you to read 'Working with commercial version' section of
8046 : ! ALGLIB Reference Manual in order to find out how to use performance-
8047 : ! related features provided by commercial edition of ALGLIB.
8048 :
8049 : Input parameters:
8050 : A - matrix, array[0..N-1, 0..N-1].
8051 : N - size of matrix A (optional) :
8052 : * if given, only principal NxN submatrix is processed and
8053 : overwritten. other elements are unchanged.
8054 : * if not given, size is automatically determined from
8055 : matrix size (A must be square matrix)
8056 : IsUpper - True, if the matrix is upper triangular.
8057 : IsUnit - diagonal type (optional):
8058 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
8059 : * if False, matrix diagonal is arbitrary
8060 : * if not given, False is assumed
8061 :
8062 : Output parameters:
8063 : Info - same as for RMatrixLUInverse
8064 : Rep - same as for RMatrixLUInverse
8065 : A - same as for RMatrixLUInverse.
8066 :
8067 : -- ALGLIB --
8068 : Copyright 05.02.2010 by Bochkanov Sergey
8069 : *************************************************************************/
8070 : #if !defined(AE_NO_EXCEPTIONS)
8071 0 : void rmatrixtrinverse(real_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
8072 : {
8073 : jmp_buf _break_jump;
8074 : alglib_impl::ae_state _alglib_env_state;
8075 : ae_int_t n;
8076 : bool isunit;
8077 0 : if( (a.cols()!=a.rows()))
8078 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'rmatrixtrinverse': looks like one of arguments has wrong size");
8079 0 : n = a.cols();
8080 0 : isunit = false;
8081 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8082 0 : if( setjmp(_break_jump) )
8083 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8084 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8085 0 : if( _xparams.flags!=0x0 )
8086 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8087 0 : alglib_impl::rmatrixtrinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
8088 :
8089 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8090 0 : return;
8091 : }
8092 : #endif
8093 :
8094 : /*************************************************************************
8095 : Triangular matrix inverse (complex)
8096 :
8097 : The subroutine inverts the following types of matrices:
8098 : * upper triangular
8099 : * upper triangular with unit diagonal
8100 : * lower triangular
8101 : * lower triangular with unit diagonal
8102 :
8103 : In case of an upper (lower) triangular matrix, the inverse matrix will
8104 : also be upper (lower) triangular, and after the end of the algorithm, the
8105 : inverse matrix replaces the source matrix. The elements below (above) the
8106 : main diagonal are not changed by the algorithm.
8107 :
8108 : If the matrix has a unit diagonal, the inverse matrix also has a unit
8109 : diagonal, and the diagonal elements are not passed to the algorithm.
8110 :
8111 : ! COMMERCIAL EDITION OF ALGLIB:
8112 : !
8113 : ! Commercial Edition of ALGLIB includes following important improvements
8114 : ! of this function:
8115 : ! * high-performance native backend with same C# interface (C# version)
8116 : ! * multithreading support (C++ and C# versions)
8117 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8118 : ! (C++ and C# versions, x86/x64 platform)
8119 : !
8120 : ! We recommend you to read 'Working with commercial version' section of
8121 : ! ALGLIB Reference Manual in order to find out how to use performance-
8122 : ! related features provided by commercial edition of ALGLIB.
8123 :
8124 : Input parameters:
8125 : A - matrix, array[0..N-1, 0..N-1].
8126 : N - size of matrix A (optional) :
8127 : * if given, only principal NxN submatrix is processed and
8128 : overwritten. other elements are unchanged.
8129 : * if not given, size is automatically determined from
8130 : matrix size (A must be square matrix)
8131 : IsUpper - True, if the matrix is upper triangular.
8132 : IsUnit - diagonal type (optional):
8133 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
8134 : * if False, matrix diagonal is arbitrary
8135 : * if not given, False is assumed
8136 :
8137 : Output parameters:
8138 : Info - same as for RMatrixLUInverse
8139 : Rep - same as for RMatrixLUInverse
8140 : A - same as for RMatrixLUInverse.
8141 :
8142 : -- ALGLIB --
8143 : Copyright 05.02.2010 by Bochkanov Sergey
8144 : *************************************************************************/
8145 0 : void cmatrixtrinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep, const xparams _xparams)
8146 : {
8147 : jmp_buf _break_jump;
8148 : alglib_impl::ae_state _alglib_env_state;
8149 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8150 0 : if( setjmp(_break_jump) )
8151 : {
8152 : #if !defined(AE_NO_EXCEPTIONS)
8153 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8154 : #else
8155 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8156 : return;
8157 : #endif
8158 : }
8159 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8160 0 : if( _xparams.flags!=0x0 )
8161 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8162 0 : alglib_impl::cmatrixtrinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
8163 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8164 0 : return;
8165 : }
8166 :
8167 : /*************************************************************************
8168 : Triangular matrix inverse (complex)
8169 :
8170 : The subroutine inverts the following types of matrices:
8171 : * upper triangular
8172 : * upper triangular with unit diagonal
8173 : * lower triangular
8174 : * lower triangular with unit diagonal
8175 :
8176 : In case of an upper (lower) triangular matrix, the inverse matrix will
8177 : also be upper (lower) triangular, and after the end of the algorithm, the
8178 : inverse matrix replaces the source matrix. The elements below (above) the
8179 : main diagonal are not changed by the algorithm.
8180 :
8181 : If the matrix has a unit diagonal, the inverse matrix also has a unit
8182 : diagonal, and the diagonal elements are not passed to the algorithm.
8183 :
8184 : ! COMMERCIAL EDITION OF ALGLIB:
8185 : !
8186 : ! Commercial Edition of ALGLIB includes following important improvements
8187 : ! of this function:
8188 : ! * high-performance native backend with same C# interface (C# version)
8189 : ! * multithreading support (C++ and C# versions)
8190 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8191 : ! (C++ and C# versions, x86/x64 platform)
8192 : !
8193 : ! We recommend you to read 'Working with commercial version' section of
8194 : ! ALGLIB Reference Manual in order to find out how to use performance-
8195 : ! related features provided by commercial edition of ALGLIB.
8196 :
8197 : Input parameters:
8198 : A - matrix, array[0..N-1, 0..N-1].
8199 : N - size of matrix A (optional) :
8200 : * if given, only principal NxN submatrix is processed and
8201 : overwritten. other elements are unchanged.
8202 : * if not given, size is automatically determined from
8203 : matrix size (A must be square matrix)
8204 : IsUpper - True, if the matrix is upper triangular.
8205 : IsUnit - diagonal type (optional):
8206 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
8207 : * if False, matrix diagonal is arbitrary
8208 : * if not given, False is assumed
8209 :
8210 : Output parameters:
8211 : Info - same as for RMatrixLUInverse
8212 : Rep - same as for RMatrixLUInverse
8213 : A - same as for RMatrixLUInverse.
8214 :
8215 : -- ALGLIB --
8216 : Copyright 05.02.2010 by Bochkanov Sergey
8217 : *************************************************************************/
8218 : #if !defined(AE_NO_EXCEPTIONS)
8219 0 : void cmatrixtrinverse(complex_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep, const xparams _xparams)
8220 : {
8221 : jmp_buf _break_jump;
8222 : alglib_impl::ae_state _alglib_env_state;
8223 : ae_int_t n;
8224 : bool isunit;
8225 0 : if( (a.cols()!=a.rows()))
8226 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'cmatrixtrinverse': looks like one of arguments has wrong size");
8227 0 : n = a.cols();
8228 0 : isunit = false;
8229 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8230 0 : if( setjmp(_break_jump) )
8231 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8232 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8233 0 : if( _xparams.flags!=0x0 )
8234 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8235 0 : alglib_impl::cmatrixtrinverse(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, isunit, &info, const_cast<alglib_impl::matinvreport*>(rep.c_ptr()), &_alglib_env_state);
8236 :
8237 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8238 0 : return;
8239 : }
8240 : #endif
8241 : #endif
8242 :
8243 : #if defined(AE_COMPILE_ORTFAC) || !defined(AE_PARTIAL_BUILD)
8244 : /*************************************************************************
8245 : QR decomposition of a rectangular matrix of size MxN
8246 :
8247 : ! COMMERCIAL EDITION OF ALGLIB:
8248 : !
8249 : ! Commercial Edition of ALGLIB includes following important improvements
8250 : ! of this function:
8251 : ! * high-performance native backend with same C# interface (C# version)
8252 : ! * multithreading support (C++ and C# versions)
8253 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8254 : ! (C++ and C# versions, x86/x64 platform)
8255 : !
8256 : ! We recommend you to read 'Working with commercial version' section of
8257 : ! ALGLIB Reference Manual in order to find out how to use performance-
8258 : ! related features provided by commercial edition of ALGLIB.
8259 :
8260 : Input parameters:
8261 : A - matrix A whose indexes range within [0..M-1, 0..N-1].
8262 : M - number of rows in matrix A.
8263 : N - number of columns in matrix A.
8264 :
8265 : Output parameters:
8266 : A - matrices Q and R in compact form (see below).
8267 : Tau - array of scalar factors which are used to form
8268 : matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)].
8269 :
8270 : Matrix A is represented as A = QR, where Q is an orthogonal matrix of size
8271 : MxM, R - upper triangular (or upper trapezoid) matrix of size M x N.
8272 :
8273 : The elements of matrix R are located on and above the main diagonal of
8274 : matrix A. The elements which are located in Tau array and below the main
8275 : diagonal of matrix A are used to form matrix Q as follows:
8276 :
8277 : Matrix Q is represented as a product of elementary reflections
8278 :
8279 : Q = H(0)*H(2)*...*H(k-1),
8280 :
8281 : where k = min(m,n), and each H(i) is in the form
8282 :
8283 : H(i) = 1 - tau * v * (v^T)
8284 :
8285 : where tau is a scalar stored in Tau[I]; v - real vector,
8286 : so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i).
8287 :
8288 : -- ALGLIB routine --
8289 : 17.02.2010
8290 : Bochkanov Sergey
8291 : *************************************************************************/
8292 0 : void rmatrixqr(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau, const xparams _xparams)
8293 : {
8294 : jmp_buf _break_jump;
8295 : alglib_impl::ae_state _alglib_env_state;
8296 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8297 0 : if( setjmp(_break_jump) )
8298 : {
8299 : #if !defined(AE_NO_EXCEPTIONS)
8300 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8301 : #else
8302 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8303 : return;
8304 : #endif
8305 : }
8306 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8307 0 : if( _xparams.flags!=0x0 )
8308 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8309 0 : alglib_impl::rmatrixqr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), &_alglib_env_state);
8310 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8311 0 : return;
8312 : }
8313 :
8314 : /*************************************************************************
8315 : LQ decomposition of a rectangular matrix of size MxN
8316 :
8317 : ! COMMERCIAL EDITION OF ALGLIB:
8318 : !
8319 : ! Commercial Edition of ALGLIB includes following important improvements
8320 : ! of this function:
8321 : ! * high-performance native backend with same C# interface (C# version)
8322 : ! * multithreading support (C++ and C# versions)
8323 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8324 : ! (C++ and C# versions, x86/x64 platform)
8325 : !
8326 : ! We recommend you to read 'Working with commercial version' section of
8327 : ! ALGLIB Reference Manual in order to find out how to use performance-
8328 : ! related features provided by commercial edition of ALGLIB.
8329 :
8330 : Input parameters:
8331 : A - matrix A whose indexes range within [0..M-1, 0..N-1].
8332 : M - number of rows in matrix A.
8333 : N - number of columns in matrix A.
8334 :
8335 : Output parameters:
8336 : A - matrices L and Q in compact form (see below)
8337 : Tau - array of scalar factors which are used to form
8338 : matrix Q. Array whose index ranges within [0..Min(M,N)-1].
8339 :
8340 : Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size
8341 : MxM, L - lower triangular (or lower trapezoid) matrix of size M x N.
8342 :
8343 : The elements of matrix L are located on and below the main diagonal of
8344 : matrix A. The elements which are located in Tau array and above the main
8345 : diagonal of matrix A are used to form matrix Q as follows:
8346 :
8347 : Matrix Q is represented as a product of elementary reflections
8348 :
8349 : Q = H(k-1)*H(k-2)*...*H(1)*H(0),
8350 :
8351 : where k = min(m,n), and each H(i) is of the form
8352 :
8353 : H(i) = 1 - tau * v * (v^T)
8354 :
8355 : where tau is a scalar stored in Tau[I]; v - real vector, so that v(0:i-1)=0,
8356 : v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1).
8357 :
8358 : -- ALGLIB routine --
8359 : 17.02.2010
8360 : Bochkanov Sergey
8361 : *************************************************************************/
8362 0 : void rmatrixlq(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau, const xparams _xparams)
8363 : {
8364 : jmp_buf _break_jump;
8365 : alglib_impl::ae_state _alglib_env_state;
8366 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8367 0 : if( setjmp(_break_jump) )
8368 : {
8369 : #if !defined(AE_NO_EXCEPTIONS)
8370 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8371 : #else
8372 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8373 : return;
8374 : #endif
8375 : }
8376 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8377 0 : if( _xparams.flags!=0x0 )
8378 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8379 0 : alglib_impl::rmatrixlq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), &_alglib_env_state);
8380 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8381 0 : return;
8382 : }
8383 :
8384 : /*************************************************************************
8385 : QR decomposition of a rectangular complex matrix of size MxN
8386 :
8387 : ! COMMERCIAL EDITION OF ALGLIB:
8388 : !
8389 : ! Commercial Edition of ALGLIB includes following important improvements
8390 : ! of this function:
8391 : ! * high-performance native backend with same C# interface (C# version)
8392 : ! * multithreading support (C++ and C# versions)
8393 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8394 : ! (C++ and C# versions, x86/x64 platform)
8395 : !
8396 : ! We recommend you to read 'Working with commercial version' section of
8397 : ! ALGLIB Reference Manual in order to find out how to use performance-
8398 : ! related features provided by commercial edition of ALGLIB.
8399 :
8400 : Input parameters:
8401 : A - matrix A whose indexes range within [0..M-1, 0..N-1]
8402 : M - number of rows in matrix A.
8403 : N - number of columns in matrix A.
8404 :
8405 : Output parameters:
8406 : A - matrices Q and R in compact form
8407 : Tau - array of scalar factors which are used to form matrix Q. Array
8408 : whose indexes range within [0.. Min(M,N)-1]
8409 :
8410 : Matrix A is represented as A = QR, where Q is an orthogonal matrix of size
8411 : MxM, R - upper triangular (or upper trapezoid) matrix of size MxN.
8412 :
8413 : -- LAPACK routine (version 3.0) --
8414 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
8415 : Courant Institute, Argonne National Lab, and Rice University
8416 : September 30, 1994
8417 : *************************************************************************/
8418 0 : void cmatrixqr(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau, const xparams _xparams)
8419 : {
8420 : jmp_buf _break_jump;
8421 : alglib_impl::ae_state _alglib_env_state;
8422 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8423 0 : if( setjmp(_break_jump) )
8424 : {
8425 : #if !defined(AE_NO_EXCEPTIONS)
8426 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8427 : #else
8428 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8429 : return;
8430 : #endif
8431 : }
8432 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8433 0 : if( _xparams.flags!=0x0 )
8434 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8435 0 : alglib_impl::cmatrixqr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), &_alglib_env_state);
8436 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8437 0 : return;
8438 : }
8439 :
8440 : /*************************************************************************
8441 : LQ decomposition of a rectangular complex matrix of size MxN
8442 :
8443 : ! COMMERCIAL EDITION OF ALGLIB:
8444 : !
8445 : ! Commercial Edition of ALGLIB includes following important improvements
8446 : ! of this function:
8447 : ! * high-performance native backend with same C# interface (C# version)
8448 : ! * multithreading support (C++ and C# versions)
8449 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8450 : ! (C++ and C# versions, x86/x64 platform)
8451 : !
8452 : ! We recommend you to read 'Working with commercial version' section of
8453 : ! ALGLIB Reference Manual in order to find out how to use performance-
8454 : ! related features provided by commercial edition of ALGLIB.
8455 :
8456 : Input parameters:
8457 : A - matrix A whose indexes range within [0..M-1, 0..N-1]
8458 : M - number of rows in matrix A.
8459 : N - number of columns in matrix A.
8460 :
8461 : Output parameters:
8462 : A - matrices Q and L in compact form
8463 : Tau - array of scalar factors which are used to form matrix Q. Array
8464 : whose indexes range within [0.. Min(M,N)-1]
8465 :
8466 : Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size
8467 : MxM, L - lower triangular (or lower trapezoid) matrix of size MxN.
8468 :
8469 : -- LAPACK routine (version 3.0) --
8470 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
8471 : Courant Institute, Argonne National Lab, and Rice University
8472 : September 30, 1994
8473 : *************************************************************************/
8474 0 : void cmatrixlq(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau, const xparams _xparams)
8475 : {
8476 : jmp_buf _break_jump;
8477 : alglib_impl::ae_state _alglib_env_state;
8478 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8479 0 : if( setjmp(_break_jump) )
8480 : {
8481 : #if !defined(AE_NO_EXCEPTIONS)
8482 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8483 : #else
8484 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8485 : return;
8486 : #endif
8487 : }
8488 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8489 0 : if( _xparams.flags!=0x0 )
8490 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8491 0 : alglib_impl::cmatrixlq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), &_alglib_env_state);
8492 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8493 0 : return;
8494 : }
8495 :
8496 : /*************************************************************************
8497 : Partial unpacking of matrix Q from the QR decomposition of a matrix A
8498 :
8499 : ! COMMERCIAL EDITION OF ALGLIB:
8500 : !
8501 : ! Commercial Edition of ALGLIB includes following important improvements
8502 : ! of this function:
8503 : ! * high-performance native backend with same C# interface (C# version)
8504 : ! * multithreading support (C++ and C# versions)
8505 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8506 : ! (C++ and C# versions, x86/x64 platform)
8507 : !
8508 : ! We recommend you to read 'Working with commercial version' section of
8509 : ! ALGLIB Reference Manual in order to find out how to use performance-
8510 : ! related features provided by commercial edition of ALGLIB.
8511 :
8512 : Input parameters:
8513 : A - matrices Q and R in compact form.
8514 : Output of RMatrixQR subroutine.
8515 : M - number of rows in given matrix A. M>=0.
8516 : N - number of columns in given matrix A. N>=0.
8517 : Tau - scalar factors which are used to form Q.
8518 : Output of the RMatrixQR subroutine.
8519 : QColumns - required number of columns of matrix Q. M>=QColumns>=0.
8520 :
8521 : Output parameters:
8522 : Q - first QColumns columns of matrix Q.
8523 : Array whose indexes range within [0..M-1, 0..QColumns-1].
8524 : If QColumns=0, the array remains unchanged.
8525 :
8526 : -- ALGLIB routine --
8527 : 17.02.2010
8528 : Bochkanov Sergey
8529 : *************************************************************************/
8530 0 : void rmatrixqrunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qcolumns, real_2d_array &q, const xparams _xparams)
8531 : {
8532 : jmp_buf _break_jump;
8533 : alglib_impl::ae_state _alglib_env_state;
8534 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8535 0 : if( setjmp(_break_jump) )
8536 : {
8537 : #if !defined(AE_NO_EXCEPTIONS)
8538 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8539 : #else
8540 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8541 : return;
8542 : #endif
8543 : }
8544 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8545 0 : if( _xparams.flags!=0x0 )
8546 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8547 0 : alglib_impl::rmatrixqrunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), qcolumns, const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
8548 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8549 0 : return;
8550 : }
8551 :
8552 : /*************************************************************************
8553 : Unpacking of matrix R from the QR decomposition of a matrix A
8554 :
8555 : Input parameters:
8556 : A - matrices Q and R in compact form.
8557 : Output of RMatrixQR subroutine.
8558 : M - number of rows in given matrix A. M>=0.
8559 : N - number of columns in given matrix A. N>=0.
8560 :
8561 : Output parameters:
8562 : R - matrix R, array[0..M-1, 0..N-1].
8563 :
8564 : -- ALGLIB routine --
8565 : 17.02.2010
8566 : Bochkanov Sergey
8567 : *************************************************************************/
8568 0 : void rmatrixqrunpackr(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &r, const xparams _xparams)
8569 : {
8570 : jmp_buf _break_jump;
8571 : alglib_impl::ae_state _alglib_env_state;
8572 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8573 0 : if( setjmp(_break_jump) )
8574 : {
8575 : #if !defined(AE_NO_EXCEPTIONS)
8576 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8577 : #else
8578 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8579 : return;
8580 : #endif
8581 : }
8582 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8583 0 : if( _xparams.flags!=0x0 )
8584 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8585 0 : alglib_impl::rmatrixqrunpackr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_matrix*>(r.c_ptr()), &_alglib_env_state);
8586 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8587 0 : return;
8588 : }
8589 :
8590 : /*************************************************************************
8591 : Partial unpacking of matrix Q from the LQ decomposition of a matrix A
8592 :
8593 : ! COMMERCIAL EDITION OF ALGLIB:
8594 : !
8595 : ! Commercial Edition of ALGLIB includes following important improvements
8596 : ! of this function:
8597 : ! * high-performance native backend with same C# interface (C# version)
8598 : ! * multithreading support (C++ and C# versions)
8599 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8600 : ! (C++ and C# versions, x86/x64 platform)
8601 : !
8602 : ! We recommend you to read 'Working with commercial version' section of
8603 : ! ALGLIB Reference Manual in order to find out how to use performance-
8604 : ! related features provided by commercial edition of ALGLIB.
8605 :
8606 : Input parameters:
8607 : A - matrices L and Q in compact form.
8608 : Output of RMatrixLQ subroutine.
8609 : M - number of rows in given matrix A. M>=0.
8610 : N - number of columns in given matrix A. N>=0.
8611 : Tau - scalar factors which are used to form Q.
8612 : Output of the RMatrixLQ subroutine.
8613 : QRows - required number of rows in matrix Q. N>=QRows>=0.
8614 :
8615 : Output parameters:
8616 : Q - first QRows rows of matrix Q. Array whose indexes range
8617 : within [0..QRows-1, 0..N-1]. If QRows=0, the array remains
8618 : unchanged.
8619 :
8620 : -- ALGLIB routine --
8621 : 17.02.2010
8622 : Bochkanov Sergey
8623 : *************************************************************************/
8624 0 : void rmatrixlqunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qrows, real_2d_array &q, const xparams _xparams)
8625 : {
8626 : jmp_buf _break_jump;
8627 : alglib_impl::ae_state _alglib_env_state;
8628 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8629 0 : if( setjmp(_break_jump) )
8630 : {
8631 : #if !defined(AE_NO_EXCEPTIONS)
8632 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8633 : #else
8634 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8635 : return;
8636 : #endif
8637 : }
8638 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8639 0 : if( _xparams.flags!=0x0 )
8640 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8641 0 : alglib_impl::rmatrixlqunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), qrows, const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
8642 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8643 0 : return;
8644 : }
8645 :
8646 : /*************************************************************************
8647 : Unpacking of matrix L from the LQ decomposition of a matrix A
8648 :
8649 : Input parameters:
8650 : A - matrices Q and L in compact form.
8651 : Output of RMatrixLQ subroutine.
8652 : M - number of rows in given matrix A. M>=0.
8653 : N - number of columns in given matrix A. N>=0.
8654 :
8655 : Output parameters:
8656 : L - matrix L, array[0..M-1, 0..N-1].
8657 :
8658 : -- ALGLIB routine --
8659 : 17.02.2010
8660 : Bochkanov Sergey
8661 : *************************************************************************/
8662 0 : void rmatrixlqunpackl(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &l, const xparams _xparams)
8663 : {
8664 : jmp_buf _break_jump;
8665 : alglib_impl::ae_state _alglib_env_state;
8666 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8667 0 : if( setjmp(_break_jump) )
8668 : {
8669 : #if !defined(AE_NO_EXCEPTIONS)
8670 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8671 : #else
8672 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8673 : return;
8674 : #endif
8675 : }
8676 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8677 0 : if( _xparams.flags!=0x0 )
8678 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8679 0 : alglib_impl::rmatrixlqunpackl(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_matrix*>(l.c_ptr()), &_alglib_env_state);
8680 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8681 0 : return;
8682 : }
8683 :
8684 : /*************************************************************************
8685 : Partial unpacking of matrix Q from QR decomposition of a complex matrix A.
8686 :
8687 : ! COMMERCIAL EDITION OF ALGLIB:
8688 : !
8689 : ! Commercial Edition of ALGLIB includes following important improvements
8690 : ! of this function:
8691 : ! * high-performance native backend with same C# interface (C# version)
8692 : ! * multithreading support (C++ and C# versions)
8693 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8694 : ! (C++ and C# versions, x86/x64 platform)
8695 : !
8696 : ! We recommend you to read 'Working with commercial version' section of
8697 : ! ALGLIB Reference Manual in order to find out how to use performance-
8698 : ! related features provided by commercial edition of ALGLIB.
8699 :
8700 : Input parameters:
8701 : A - matrices Q and R in compact form.
8702 : Output of CMatrixQR subroutine .
8703 : M - number of rows in matrix A. M>=0.
8704 : N - number of columns in matrix A. N>=0.
8705 : Tau - scalar factors which are used to form Q.
8706 : Output of CMatrixQR subroutine .
8707 : QColumns - required number of columns in matrix Q. M>=QColumns>=0.
8708 :
8709 : Output parameters:
8710 : Q - first QColumns columns of matrix Q.
8711 : Array whose index ranges within [0..M-1, 0..QColumns-1].
8712 : If QColumns=0, array isn't changed.
8713 :
8714 : -- ALGLIB routine --
8715 : 17.02.2010
8716 : Bochkanov Sergey
8717 : *************************************************************************/
8718 0 : void cmatrixqrunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qcolumns, complex_2d_array &q, const xparams _xparams)
8719 : {
8720 : jmp_buf _break_jump;
8721 : alglib_impl::ae_state _alglib_env_state;
8722 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8723 0 : if( setjmp(_break_jump) )
8724 : {
8725 : #if !defined(AE_NO_EXCEPTIONS)
8726 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8727 : #else
8728 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8729 : return;
8730 : #endif
8731 : }
8732 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8733 0 : if( _xparams.flags!=0x0 )
8734 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8735 0 : alglib_impl::cmatrixqrunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), qcolumns, const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
8736 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8737 0 : return;
8738 : }
8739 :
8740 : /*************************************************************************
8741 : Unpacking of matrix R from the QR decomposition of a matrix A
8742 :
8743 : Input parameters:
8744 : A - matrices Q and R in compact form.
8745 : Output of CMatrixQR subroutine.
8746 : M - number of rows in given matrix A. M>=0.
8747 : N - number of columns in given matrix A. N>=0.
8748 :
8749 : Output parameters:
8750 : R - matrix R, array[0..M-1, 0..N-1].
8751 :
8752 : -- ALGLIB routine --
8753 : 17.02.2010
8754 : Bochkanov Sergey
8755 : *************************************************************************/
8756 0 : void cmatrixqrunpackr(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &r, const xparams _xparams)
8757 : {
8758 : jmp_buf _break_jump;
8759 : alglib_impl::ae_state _alglib_env_state;
8760 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8761 0 : if( setjmp(_break_jump) )
8762 : {
8763 : #if !defined(AE_NO_EXCEPTIONS)
8764 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8765 : #else
8766 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8767 : return;
8768 : #endif
8769 : }
8770 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8771 0 : if( _xparams.flags!=0x0 )
8772 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8773 0 : alglib_impl::cmatrixqrunpackr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_matrix*>(r.c_ptr()), &_alglib_env_state);
8774 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8775 0 : return;
8776 : }
8777 :
8778 : /*************************************************************************
8779 : Partial unpacking of matrix Q from LQ decomposition of a complex matrix A.
8780 :
8781 : ! COMMERCIAL EDITION OF ALGLIB:
8782 : !
8783 : ! Commercial Edition of ALGLIB includes following important improvements
8784 : ! of this function:
8785 : ! * high-performance native backend with same C# interface (C# version)
8786 : ! * multithreading support (C++ and C# versions)
8787 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8788 : ! (C++ and C# versions, x86/x64 platform)
8789 : !
8790 : ! We recommend you to read 'Working with commercial version' section of
8791 : ! ALGLIB Reference Manual in order to find out how to use performance-
8792 : ! related features provided by commercial edition of ALGLIB.
8793 :
8794 : Input parameters:
8795 : A - matrices Q and R in compact form.
8796 : Output of CMatrixLQ subroutine .
8797 : M - number of rows in matrix A. M>=0.
8798 : N - number of columns in matrix A. N>=0.
8799 : Tau - scalar factors which are used to form Q.
8800 : Output of CMatrixLQ subroutine .
8801 : QRows - required number of rows in matrix Q. N>=QColumns>=0.
8802 :
8803 : Output parameters:
8804 : Q - first QRows rows of matrix Q.
8805 : Array whose index ranges within [0..QRows-1, 0..N-1].
8806 : If QRows=0, array isn't changed.
8807 :
8808 : -- ALGLIB routine --
8809 : 17.02.2010
8810 : Bochkanov Sergey
8811 : *************************************************************************/
8812 0 : void cmatrixlqunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qrows, complex_2d_array &q, const xparams _xparams)
8813 : {
8814 : jmp_buf _break_jump;
8815 : alglib_impl::ae_state _alglib_env_state;
8816 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8817 0 : if( setjmp(_break_jump) )
8818 : {
8819 : #if !defined(AE_NO_EXCEPTIONS)
8820 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8821 : #else
8822 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8823 : return;
8824 : #endif
8825 : }
8826 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8827 0 : if( _xparams.flags!=0x0 )
8828 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8829 0 : alglib_impl::cmatrixlqunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), qrows, const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
8830 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8831 0 : return;
8832 : }
8833 :
8834 : /*************************************************************************
8835 : Unpacking of matrix L from the LQ decomposition of a matrix A
8836 :
8837 : Input parameters:
8838 : A - matrices Q and L in compact form.
8839 : Output of CMatrixLQ subroutine.
8840 : M - number of rows in given matrix A. M>=0.
8841 : N - number of columns in given matrix A. N>=0.
8842 :
8843 : Output parameters:
8844 : L - matrix L, array[0..M-1, 0..N-1].
8845 :
8846 : -- ALGLIB routine --
8847 : 17.02.2010
8848 : Bochkanov Sergey
8849 : *************************************************************************/
8850 0 : void cmatrixlqunpackl(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &l, const xparams _xparams)
8851 : {
8852 : jmp_buf _break_jump;
8853 : alglib_impl::ae_state _alglib_env_state;
8854 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8855 0 : if( setjmp(_break_jump) )
8856 : {
8857 : #if !defined(AE_NO_EXCEPTIONS)
8858 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8859 : #else
8860 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8861 : return;
8862 : #endif
8863 : }
8864 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8865 0 : if( _xparams.flags!=0x0 )
8866 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8867 0 : alglib_impl::cmatrixlqunpackl(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_matrix*>(l.c_ptr()), &_alglib_env_state);
8868 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8869 0 : return;
8870 : }
8871 :
8872 : /*************************************************************************
8873 : Reduction of a rectangular matrix to bidiagonal form
8874 :
8875 : The algorithm reduces the rectangular matrix A to bidiagonal form by
8876 : orthogonal transformations P and Q: A = Q*B*(P^T).
8877 :
8878 : ! COMMERCIAL EDITION OF ALGLIB:
8879 : !
8880 : ! Commercial Edition of ALGLIB includes following important improvements
8881 : ! of this function:
8882 : ! * high-performance native backend with same C# interface (C# version)
8883 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8884 : ! (C++ and C# versions, x86/x64 platform)
8885 : !
8886 : ! We recommend you to read 'Working with commercial version' section of
8887 : ! ALGLIB Reference Manual in order to find out how to use performance-
8888 : ! related features provided by commercial edition of ALGLIB.
8889 :
8890 : Input parameters:
8891 : A - source matrix. array[0..M-1, 0..N-1]
8892 : M - number of rows in matrix A.
8893 : N - number of columns in matrix A.
8894 :
8895 : Output parameters:
8896 : A - matrices Q, B, P in compact form (see below).
8897 : TauQ - scalar factors which are used to form matrix Q.
8898 : TauP - scalar factors which are used to form matrix P.
8899 :
8900 : The main diagonal and one of the secondary diagonals of matrix A are
8901 : replaced with bidiagonal matrix B. Other elements contain elementary
8902 : reflections which form MxM matrix Q and NxN matrix P, respectively.
8903 :
8904 : If M>=N, B is the upper bidiagonal MxN matrix and is stored in the
8905 : corresponding elements of matrix A. Matrix Q is represented as a
8906 : product of elementary reflections Q = H(0)*H(1)*...*H(n-1), where
8907 : H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in TauQ[i], and
8908 : vector v has the following structure: v(0:i-1)=0, v(i)=1, v(i+1:m-1) is
8909 : stored in elements A(i+1:m-1,i). Matrix P is as follows: P =
8910 : G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. Tau is stored in TauP[i],
8911 : u(0:i)=0, u(i+1)=1, u(i+2:n-1) is stored in elements A(i,i+2:n-1).
8912 :
8913 : If M<N, B is the lower bidiagonal MxN matrix and is stored in the
8914 : corresponding elements of matrix A. Q = H(0)*H(1)*...*H(m-2), where
8915 : H(i) = 1 - tau*v*v', tau is stored in TauQ, v(0:i)=0, v(i+1)=1, v(i+2:m-1)
8916 : is stored in elements A(i+2:m-1,i). P = G(0)*G(1)*...*G(m-1),
8917 : G(i) = 1-tau*u*u', tau is stored in TauP, u(0:i-1)=0, u(i)=1, u(i+1:n-1)
8918 : is stored in A(i,i+1:n-1).
8919 :
8920 : EXAMPLE:
8921 :
8922 : m=6, n=5 (m > n): m=5, n=6 (m < n):
8923 :
8924 : ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
8925 : ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
8926 : ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
8927 : ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
8928 : ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
8929 : ( v1 v2 v3 v4 v5 )
8930 :
8931 : Here vi and ui are vectors which form H(i) and G(i), and d and e -
8932 : are the diagonal and off-diagonal elements of matrix B.
8933 :
8934 : -- LAPACK routine (version 3.0) --
8935 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
8936 : Courant Institute, Argonne National Lab, and Rice University
8937 : September 30, 1994.
8938 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
8939 : pseudocode, 2007-2010.
8940 : *************************************************************************/
8941 0 : void rmatrixbd(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tauq, real_1d_array &taup, const xparams _xparams)
8942 : {
8943 : jmp_buf _break_jump;
8944 : alglib_impl::ae_state _alglib_env_state;
8945 0 : alglib_impl::ae_state_init(&_alglib_env_state);
8946 0 : if( setjmp(_break_jump) )
8947 : {
8948 : #if !defined(AE_NO_EXCEPTIONS)
8949 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
8950 : #else
8951 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
8952 : return;
8953 : #endif
8954 : }
8955 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
8956 0 : if( _xparams.flags!=0x0 )
8957 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
8958 0 : alglib_impl::rmatrixbd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tauq.c_ptr()), const_cast<alglib_impl::ae_vector*>(taup.c_ptr()), &_alglib_env_state);
8959 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
8960 0 : return;
8961 : }
8962 :
8963 : /*************************************************************************
8964 : Unpacking matrix Q which reduces a matrix to bidiagonal form.
8965 :
8966 : ! COMMERCIAL EDITION OF ALGLIB:
8967 : !
8968 : ! Commercial Edition of ALGLIB includes following important improvements
8969 : ! of this function:
8970 : ! * high-performance native backend with same C# interface (C# version)
8971 : ! * hardware vendor (Intel) implementations of linear algebra primitives
8972 : ! (C++ and C# versions, x86/x64 platform)
8973 : !
8974 : ! We recommend you to read 'Working with commercial version' section of
8975 : ! ALGLIB Reference Manual in order to find out how to use performance-
8976 : ! related features provided by commercial edition of ALGLIB.
8977 :
8978 : Input parameters:
8979 : QP - matrices Q and P in compact form.
8980 : Output of ToBidiagonal subroutine.
8981 : M - number of rows in matrix A.
8982 : N - number of columns in matrix A.
8983 : TAUQ - scalar factors which are used to form Q.
8984 : Output of ToBidiagonal subroutine.
8985 : QColumns - required number of columns in matrix Q.
8986 : M>=QColumns>=0.
8987 :
8988 : Output parameters:
8989 : Q - first QColumns columns of matrix Q.
8990 : Array[0..M-1, 0..QColumns-1]
8991 : If QColumns=0, the array is not modified.
8992 :
8993 : -- ALGLIB --
8994 : 2005-2010
8995 : Bochkanov Sergey
8996 : *************************************************************************/
8997 0 : void rmatrixbdunpackq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, const ae_int_t qcolumns, real_2d_array &q, const xparams _xparams)
8998 : {
8999 : jmp_buf _break_jump;
9000 : alglib_impl::ae_state _alglib_env_state;
9001 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9002 0 : if( setjmp(_break_jump) )
9003 : {
9004 : #if !defined(AE_NO_EXCEPTIONS)
9005 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9006 : #else
9007 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9008 : return;
9009 : #endif
9010 : }
9011 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9012 0 : if( _xparams.flags!=0x0 )
9013 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9014 0 : alglib_impl::rmatrixbdunpackq(const_cast<alglib_impl::ae_matrix*>(qp.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tauq.c_ptr()), qcolumns, const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
9015 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9016 0 : return;
9017 : }
9018 :
9019 : /*************************************************************************
9020 : Multiplication by matrix Q which reduces matrix A to bidiagonal form.
9021 :
9022 : The algorithm allows pre- or post-multiply by Q or Q'.
9023 :
9024 : ! COMMERCIAL EDITION OF ALGLIB:
9025 : !
9026 : ! Commercial Edition of ALGLIB includes following important improvements
9027 : ! of this function:
9028 : ! * high-performance native backend with same C# interface (C# version)
9029 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9030 : ! (C++ and C# versions, x86/x64 platform)
9031 : !
9032 : ! We recommend you to read 'Working with commercial version' section of
9033 : ! ALGLIB Reference Manual in order to find out how to use performance-
9034 : ! related features provided by commercial edition of ALGLIB.
9035 :
9036 : Input parameters:
9037 : QP - matrices Q and P in compact form.
9038 : Output of ToBidiagonal subroutine.
9039 : M - number of rows in matrix A.
9040 : N - number of columns in matrix A.
9041 : TAUQ - scalar factors which are used to form Q.
9042 : Output of ToBidiagonal subroutine.
9043 : Z - multiplied matrix.
9044 : array[0..ZRows-1,0..ZColumns-1]
9045 : ZRows - number of rows in matrix Z. If FromTheRight=False,
9046 : ZRows=M, otherwise ZRows can be arbitrary.
9047 : ZColumns - number of columns in matrix Z. If FromTheRight=True,
9048 : ZColumns=M, otherwise ZColumns can be arbitrary.
9049 : FromTheRight - pre- or post-multiply.
9050 : DoTranspose - multiply by Q or Q'.
9051 :
9052 : Output parameters:
9053 : Z - product of Z and Q.
9054 : Array[0..ZRows-1,0..ZColumns-1]
9055 : If ZRows=0 or ZColumns=0, the array is not modified.
9056 :
9057 : -- ALGLIB --
9058 : 2005-2010
9059 : Bochkanov Sergey
9060 : *************************************************************************/
9061 0 : void rmatrixbdmultiplybyq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose, const xparams _xparams)
9062 : {
9063 : jmp_buf _break_jump;
9064 : alglib_impl::ae_state _alglib_env_state;
9065 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9066 0 : if( setjmp(_break_jump) )
9067 : {
9068 : #if !defined(AE_NO_EXCEPTIONS)
9069 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9070 : #else
9071 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9072 : return;
9073 : #endif
9074 : }
9075 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9076 0 : if( _xparams.flags!=0x0 )
9077 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9078 0 : alglib_impl::rmatrixbdmultiplybyq(const_cast<alglib_impl::ae_matrix*>(qp.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(tauq.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state);
9079 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9080 0 : return;
9081 : }
9082 :
9083 : /*************************************************************************
9084 : Unpacking matrix P which reduces matrix A to bidiagonal form.
9085 : The subroutine returns transposed matrix P.
9086 :
9087 : Input parameters:
9088 : QP - matrices Q and P in compact form.
9089 : Output of ToBidiagonal subroutine.
9090 : M - number of rows in matrix A.
9091 : N - number of columns in matrix A.
9092 : TAUP - scalar factors which are used to form P.
9093 : Output of ToBidiagonal subroutine.
9094 : PTRows - required number of rows of matrix P^T. N >= PTRows >= 0.
9095 :
9096 : Output parameters:
9097 : PT - first PTRows columns of matrix P^T
9098 : Array[0..PTRows-1, 0..N-1]
9099 : If PTRows=0, the array is not modified.
9100 :
9101 : -- ALGLIB --
9102 : 2005-2010
9103 : Bochkanov Sergey
9104 : *************************************************************************/
9105 0 : void rmatrixbdunpackpt(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, const ae_int_t ptrows, real_2d_array &pt, const xparams _xparams)
9106 : {
9107 : jmp_buf _break_jump;
9108 : alglib_impl::ae_state _alglib_env_state;
9109 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9110 0 : if( setjmp(_break_jump) )
9111 : {
9112 : #if !defined(AE_NO_EXCEPTIONS)
9113 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9114 : #else
9115 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9116 : return;
9117 : #endif
9118 : }
9119 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9120 0 : if( _xparams.flags!=0x0 )
9121 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9122 0 : alglib_impl::rmatrixbdunpackpt(const_cast<alglib_impl::ae_matrix*>(qp.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(taup.c_ptr()), ptrows, const_cast<alglib_impl::ae_matrix*>(pt.c_ptr()), &_alglib_env_state);
9123 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9124 0 : return;
9125 : }
9126 :
9127 : /*************************************************************************
9128 : Multiplication by matrix P which reduces matrix A to bidiagonal form.
9129 :
9130 : The algorithm allows pre- or post-multiply by P or P'.
9131 :
9132 : Input parameters:
9133 : QP - matrices Q and P in compact form.
9134 : Output of RMatrixBD subroutine.
9135 : M - number of rows in matrix A.
9136 : N - number of columns in matrix A.
9137 : TAUP - scalar factors which are used to form P.
9138 : Output of RMatrixBD subroutine.
9139 : Z - multiplied matrix.
9140 : Array whose indexes range within [0..ZRows-1,0..ZColumns-1].
9141 : ZRows - number of rows in matrix Z. If FromTheRight=False,
9142 : ZRows=N, otherwise ZRows can be arbitrary.
9143 : ZColumns - number of columns in matrix Z. If FromTheRight=True,
9144 : ZColumns=N, otherwise ZColumns can be arbitrary.
9145 : FromTheRight - pre- or post-multiply.
9146 : DoTranspose - multiply by P or P'.
9147 :
9148 : Output parameters:
9149 : Z - product of Z and P.
9150 : Array whose indexes range within [0..ZRows-1,0..ZColumns-1].
9151 : If ZRows=0 or ZColumns=0, the array is not modified.
9152 :
9153 : -- ALGLIB --
9154 : 2005-2010
9155 : Bochkanov Sergey
9156 : *************************************************************************/
9157 0 : void rmatrixbdmultiplybyp(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose, const xparams _xparams)
9158 : {
9159 : jmp_buf _break_jump;
9160 : alglib_impl::ae_state _alglib_env_state;
9161 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9162 0 : if( setjmp(_break_jump) )
9163 : {
9164 : #if !defined(AE_NO_EXCEPTIONS)
9165 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9166 : #else
9167 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9168 : return;
9169 : #endif
9170 : }
9171 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9172 0 : if( _xparams.flags!=0x0 )
9173 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9174 0 : alglib_impl::rmatrixbdmultiplybyp(const_cast<alglib_impl::ae_matrix*>(qp.c_ptr()), m, n, const_cast<alglib_impl::ae_vector*>(taup.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state);
9175 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9176 0 : return;
9177 : }
9178 :
9179 : /*************************************************************************
9180 : Unpacking of the main and secondary diagonals of bidiagonal decomposition
9181 : of matrix A.
9182 :
9183 : Input parameters:
9184 : B - output of RMatrixBD subroutine.
9185 : M - number of rows in matrix B.
9186 : N - number of columns in matrix B.
9187 :
9188 : Output parameters:
9189 : IsUpper - True, if the matrix is upper bidiagonal.
9190 : otherwise IsUpper is False.
9191 : D - the main diagonal.
9192 : Array whose index ranges within [0..Min(M,N)-1].
9193 : E - the secondary diagonal (upper or lower, depending on
9194 : the value of IsUpper).
9195 : Array index ranges within [0..Min(M,N)-1], the last
9196 : element is not used.
9197 :
9198 : -- ALGLIB --
9199 : 2005-2010
9200 : Bochkanov Sergey
9201 : *************************************************************************/
9202 0 : void rmatrixbdunpackdiagonals(const real_2d_array &b, const ae_int_t m, const ae_int_t n, bool &isupper, real_1d_array &d, real_1d_array &e, const xparams _xparams)
9203 : {
9204 : jmp_buf _break_jump;
9205 : alglib_impl::ae_state _alglib_env_state;
9206 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9207 0 : if( setjmp(_break_jump) )
9208 : {
9209 : #if !defined(AE_NO_EXCEPTIONS)
9210 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9211 : #else
9212 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9213 : return;
9214 : #endif
9215 : }
9216 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9217 0 : if( _xparams.flags!=0x0 )
9218 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9219 0 : alglib_impl::rmatrixbdunpackdiagonals(const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), m, n, &isupper, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), &_alglib_env_state);
9220 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9221 0 : return;
9222 : }
9223 :
9224 : /*************************************************************************
9225 : Reduction of a square matrix to upper Hessenberg form: Q'*A*Q = H,
9226 : where Q is an orthogonal matrix, H - Hessenberg matrix.
9227 :
9228 : ! COMMERCIAL EDITION OF ALGLIB:
9229 : !
9230 : ! Commercial Edition of ALGLIB includes following important improvements
9231 : ! of this function:
9232 : ! * high-performance native backend with same C# interface (C# version)
9233 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9234 : ! (C++ and C# versions, x86/x64 platform)
9235 : !
9236 : ! We recommend you to read 'Working with commercial version' section of
9237 : ! ALGLIB Reference Manual in order to find out how to use performance-
9238 : ! related features provided by commercial edition of ALGLIB.
9239 :
9240 : Input parameters:
9241 : A - matrix A with elements [0..N-1, 0..N-1]
9242 : N - size of matrix A.
9243 :
9244 : Output parameters:
9245 : A - matrices Q and P in compact form (see below).
9246 : Tau - array of scalar factors which are used to form matrix Q.
9247 : Array whose index ranges within [0..N-2]
9248 :
9249 : Matrix H is located on the main diagonal, on the lower secondary diagonal
9250 : and above the main diagonal of matrix A. The elements which are used to
9251 : form matrix Q are situated in array Tau and below the lower secondary
9252 : diagonal of matrix A as follows:
9253 :
9254 : Matrix Q is represented as a product of elementary reflections
9255 :
9256 : Q = H(0)*H(2)*...*H(n-2),
9257 :
9258 : where each H(i) is given by
9259 :
9260 : H(i) = 1 - tau * v * (v^T)
9261 :
9262 : where tau is a scalar stored in Tau[I]; v - is a real vector,
9263 : so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in A(i+2:n-1,i).
9264 :
9265 : -- LAPACK routine (version 3.0) --
9266 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
9267 : Courant Institute, Argonne National Lab, and Rice University
9268 : October 31, 1992
9269 : *************************************************************************/
9270 0 : void rmatrixhessenberg(real_2d_array &a, const ae_int_t n, real_1d_array &tau, const xparams _xparams)
9271 : {
9272 : jmp_buf _break_jump;
9273 : alglib_impl::ae_state _alglib_env_state;
9274 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9275 0 : if( setjmp(_break_jump) )
9276 : {
9277 : #if !defined(AE_NO_EXCEPTIONS)
9278 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9279 : #else
9280 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9281 : return;
9282 : #endif
9283 : }
9284 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9285 0 : if( _xparams.flags!=0x0 )
9286 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9287 0 : alglib_impl::rmatrixhessenberg(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), &_alglib_env_state);
9288 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9289 0 : return;
9290 : }
9291 :
9292 : /*************************************************************************
9293 : Unpacking matrix Q which reduces matrix A to upper Hessenberg form
9294 :
9295 : ! COMMERCIAL EDITION OF ALGLIB:
9296 : !
9297 : ! Commercial Edition of ALGLIB includes following important improvements
9298 : ! of this function:
9299 : ! * high-performance native backend with same C# interface (C# version)
9300 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9301 : ! (C++ and C# versions, x86/x64 platform)
9302 : !
9303 : ! We recommend you to read 'Working with commercial version' section of
9304 : ! ALGLIB Reference Manual in order to find out how to use performance-
9305 : ! related features provided by commercial edition of ALGLIB.
9306 :
9307 : Input parameters:
9308 : A - output of RMatrixHessenberg subroutine.
9309 : N - size of matrix A.
9310 : Tau - scalar factors which are used to form Q.
9311 : Output of RMatrixHessenberg subroutine.
9312 :
9313 : Output parameters:
9314 : Q - matrix Q.
9315 : Array whose indexes range within [0..N-1, 0..N-1].
9316 :
9317 : -- ALGLIB --
9318 : 2005-2010
9319 : Bochkanov Sergey
9320 : *************************************************************************/
9321 0 : void rmatrixhessenbergunpackq(const real_2d_array &a, const ae_int_t n, const real_1d_array &tau, real_2d_array &q, const xparams _xparams)
9322 : {
9323 : jmp_buf _break_jump;
9324 : alglib_impl::ae_state _alglib_env_state;
9325 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9326 0 : if( setjmp(_break_jump) )
9327 : {
9328 : #if !defined(AE_NO_EXCEPTIONS)
9329 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9330 : #else
9331 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9332 : return;
9333 : #endif
9334 : }
9335 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9336 0 : if( _xparams.flags!=0x0 )
9337 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9338 0 : alglib_impl::rmatrixhessenbergunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
9339 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9340 0 : return;
9341 : }
9342 :
9343 : /*************************************************************************
9344 : Unpacking matrix H (the result of matrix A reduction to upper Hessenberg form)
9345 :
9346 : Input parameters:
9347 : A - output of RMatrixHessenberg subroutine.
9348 : N - size of matrix A.
9349 :
9350 : Output parameters:
9351 : H - matrix H. Array whose indexes range within [0..N-1, 0..N-1].
9352 :
9353 : -- ALGLIB --
9354 : 2005-2010
9355 : Bochkanov Sergey
9356 : *************************************************************************/
9357 0 : void rmatrixhessenbergunpackh(const real_2d_array &a, const ae_int_t n, real_2d_array &h, const xparams _xparams)
9358 : {
9359 : jmp_buf _break_jump;
9360 : alglib_impl::ae_state _alglib_env_state;
9361 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9362 0 : if( setjmp(_break_jump) )
9363 : {
9364 : #if !defined(AE_NO_EXCEPTIONS)
9365 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9366 : #else
9367 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9368 : return;
9369 : #endif
9370 : }
9371 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9372 0 : if( _xparams.flags!=0x0 )
9373 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9374 0 : alglib_impl::rmatrixhessenbergunpackh(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, const_cast<alglib_impl::ae_matrix*>(h.c_ptr()), &_alglib_env_state);
9375 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9376 0 : return;
9377 : }
9378 :
9379 : /*************************************************************************
9380 : Reduction of a symmetric matrix which is given by its higher or lower
9381 : triangular part to a tridiagonal matrix using orthogonal similarity
9382 : transformation: Q'*A*Q=T.
9383 :
9384 : ! COMMERCIAL EDITION OF ALGLIB:
9385 : !
9386 : ! Commercial Edition of ALGLIB includes following important improvements
9387 : ! of this function:
9388 : ! * high-performance native backend with same C# interface (C# version)
9389 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9390 : ! (C++ and C# versions, x86/x64 platform)
9391 : !
9392 : ! We recommend you to read 'Working with commercial version' section of
9393 : ! ALGLIB Reference Manual in order to find out how to use performance-
9394 : ! related features provided by commercial edition of ALGLIB.
9395 :
9396 : Input parameters:
9397 : A - matrix to be transformed
9398 : array with elements [0..N-1, 0..N-1].
9399 : N - size of matrix A.
9400 : IsUpper - storage format. If IsUpper = True, then matrix A is given
9401 : by its upper triangle, and the lower triangle is not used
9402 : and not modified by the algorithm, and vice versa
9403 : if IsUpper = False.
9404 :
9405 : Output parameters:
9406 : A - matrices T and Q in compact form (see lower)
9407 : Tau - array of factors which are forming matrices H(i)
9408 : array with elements [0..N-2].
9409 : D - main diagonal of symmetric matrix T.
9410 : array with elements [0..N-1].
9411 : E - secondary diagonal of symmetric matrix T.
9412 : array with elements [0..N-2].
9413 :
9414 :
9415 : If IsUpper=True, the matrix Q is represented as a product of elementary
9416 : reflectors
9417 :
9418 : Q = H(n-2) . . . H(2) H(0).
9419 :
9420 : Each H(i) has the form
9421 :
9422 : H(i) = I - tau * v * v'
9423 :
9424 : where tau is a real scalar, and v is a real vector with
9425 : v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
9426 : A(0:i-1,i+1), and tau in TAU(i).
9427 :
9428 : If IsUpper=False, the matrix Q is represented as a product of elementary
9429 : reflectors
9430 :
9431 : Q = H(0) H(2) . . . H(n-2).
9432 :
9433 : Each H(i) has the form
9434 :
9435 : H(i) = I - tau * v * v'
9436 :
9437 : where tau is a real scalar, and v is a real vector with
9438 : v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
9439 : and tau in TAU(i).
9440 :
9441 : The contents of A on exit are illustrated by the following examples
9442 : with n = 5:
9443 :
9444 : if UPLO = 'U': if UPLO = 'L':
9445 :
9446 : ( d e v1 v2 v3 ) ( d )
9447 : ( d e v2 v3 ) ( e d )
9448 : ( d e v3 ) ( v0 e d )
9449 : ( d e ) ( v0 v1 e d )
9450 : ( d ) ( v0 v1 v2 e d )
9451 :
9452 : where d and e denote diagonal and off-diagonal elements of T, and vi
9453 : denotes an element of the vector defining H(i).
9454 :
9455 : -- LAPACK routine (version 3.0) --
9456 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
9457 : Courant Institute, Argonne National Lab, and Rice University
9458 : October 31, 1992
9459 : *************************************************************************/
9460 0 : void smatrixtd(real_2d_array &a, const ae_int_t n, const bool isupper, real_1d_array &tau, real_1d_array &d, real_1d_array &e, const xparams _xparams)
9461 : {
9462 : jmp_buf _break_jump;
9463 : alglib_impl::ae_state _alglib_env_state;
9464 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9465 0 : if( setjmp(_break_jump) )
9466 : {
9467 : #if !defined(AE_NO_EXCEPTIONS)
9468 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9469 : #else
9470 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9471 : return;
9472 : #endif
9473 : }
9474 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9475 0 : if( _xparams.flags!=0x0 )
9476 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9477 0 : alglib_impl::smatrixtd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), &_alglib_env_state);
9478 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9479 0 : return;
9480 : }
9481 :
9482 : /*************************************************************************
9483 : Unpacking matrix Q which reduces symmetric matrix to a tridiagonal
9484 : form.
9485 :
9486 : ! COMMERCIAL EDITION OF ALGLIB:
9487 : !
9488 : ! Commercial Edition of ALGLIB includes following important improvements
9489 : ! of this function:
9490 : ! * high-performance native backend with same C# interface (C# version)
9491 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9492 : ! (C++ and C# versions, x86/x64 platform)
9493 : !
9494 : ! We recommend you to read 'Working with commercial version' section of
9495 : ! ALGLIB Reference Manual in order to find out how to use performance-
9496 : ! related features provided by commercial edition of ALGLIB.
9497 :
9498 : Input parameters:
9499 : A - the result of a SMatrixTD subroutine
9500 : N - size of matrix A.
9501 : IsUpper - storage format (a parameter of SMatrixTD subroutine)
9502 : Tau - the result of a SMatrixTD subroutine
9503 :
9504 : Output parameters:
9505 : Q - transformation matrix.
9506 : array with elements [0..N-1, 0..N-1].
9507 :
9508 : -- ALGLIB --
9509 : Copyright 2005-2010 by Bochkanov Sergey
9510 : *************************************************************************/
9511 0 : void smatrixtdunpackq(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &tau, real_2d_array &q, const xparams _xparams)
9512 : {
9513 : jmp_buf _break_jump;
9514 : alglib_impl::ae_state _alglib_env_state;
9515 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9516 0 : if( setjmp(_break_jump) )
9517 : {
9518 : #if !defined(AE_NO_EXCEPTIONS)
9519 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9520 : #else
9521 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9522 : return;
9523 : #endif
9524 : }
9525 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9526 0 : if( _xparams.flags!=0x0 )
9527 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9528 0 : alglib_impl::smatrixtdunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
9529 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9530 0 : return;
9531 : }
9532 :
9533 : /*************************************************************************
9534 : Reduction of a Hermitian matrix which is given by its higher or lower
9535 : triangular part to a real tridiagonal matrix using unitary similarity
9536 : transformation: Q'*A*Q = T.
9537 :
9538 : ! COMMERCIAL EDITION OF ALGLIB:
9539 : !
9540 : ! Commercial Edition of ALGLIB includes following important improvements
9541 : ! of this function:
9542 : ! * high-performance native backend with same C# interface (C# version)
9543 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9544 : ! (C++ and C# versions, x86/x64 platform)
9545 : !
9546 : ! We recommend you to read 'Working with commercial version' section of
9547 : ! ALGLIB Reference Manual in order to find out how to use performance-
9548 : ! related features provided by commercial edition of ALGLIB.
9549 :
9550 : Input parameters:
9551 : A - matrix to be transformed
9552 : array with elements [0..N-1, 0..N-1].
9553 : N - size of matrix A.
9554 : IsUpper - storage format. If IsUpper = True, then matrix A is given
9555 : by its upper triangle, and the lower triangle is not used
9556 : and not modified by the algorithm, and vice versa
9557 : if IsUpper = False.
9558 :
9559 : Output parameters:
9560 : A - matrices T and Q in compact form (see lower)
9561 : Tau - array of factors which are forming matrices H(i)
9562 : array with elements [0..N-2].
9563 : D - main diagonal of real symmetric matrix T.
9564 : array with elements [0..N-1].
9565 : E - secondary diagonal of real symmetric matrix T.
9566 : array with elements [0..N-2].
9567 :
9568 :
9569 : If IsUpper=True, the matrix Q is represented as a product of elementary
9570 : reflectors
9571 :
9572 : Q = H(n-2) . . . H(2) H(0).
9573 :
9574 : Each H(i) has the form
9575 :
9576 : H(i) = I - tau * v * v'
9577 :
9578 : where tau is a complex scalar, and v is a complex vector with
9579 : v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
9580 : A(0:i-1,i+1), and tau in TAU(i).
9581 :
9582 : If IsUpper=False, the matrix Q is represented as a product of elementary
9583 : reflectors
9584 :
9585 : Q = H(0) H(2) . . . H(n-2).
9586 :
9587 : Each H(i) has the form
9588 :
9589 : H(i) = I - tau * v * v'
9590 :
9591 : where tau is a complex scalar, and v is a complex vector with
9592 : v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
9593 : and tau in TAU(i).
9594 :
9595 : The contents of A on exit are illustrated by the following examples
9596 : with n = 5:
9597 :
9598 : if UPLO = 'U': if UPLO = 'L':
9599 :
9600 : ( d e v1 v2 v3 ) ( d )
9601 : ( d e v2 v3 ) ( e d )
9602 : ( d e v3 ) ( v0 e d )
9603 : ( d e ) ( v0 v1 e d )
9604 : ( d ) ( v0 v1 v2 e d )
9605 :
9606 : where d and e denote diagonal and off-diagonal elements of T, and vi
9607 : denotes an element of the vector defining H(i).
9608 :
9609 : -- LAPACK routine (version 3.0) --
9610 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
9611 : Courant Institute, Argonne National Lab, and Rice University
9612 : October 31, 1992
9613 : *************************************************************************/
9614 0 : void hmatrixtd(complex_2d_array &a, const ae_int_t n, const bool isupper, complex_1d_array &tau, real_1d_array &d, real_1d_array &e, const xparams _xparams)
9615 : {
9616 : jmp_buf _break_jump;
9617 : alglib_impl::ae_state _alglib_env_state;
9618 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9619 0 : if( setjmp(_break_jump) )
9620 : {
9621 : #if !defined(AE_NO_EXCEPTIONS)
9622 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9623 : #else
9624 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9625 : return;
9626 : #endif
9627 : }
9628 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9629 0 : if( _xparams.flags!=0x0 )
9630 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9631 0 : alglib_impl::hmatrixtd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), &_alglib_env_state);
9632 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9633 0 : return;
9634 : }
9635 :
9636 : /*************************************************************************
9637 : Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal
9638 : form.
9639 :
9640 : ! COMMERCIAL EDITION OF ALGLIB:
9641 : !
9642 : ! Commercial Edition of ALGLIB includes following important improvements
9643 : ! of this function:
9644 : ! * high-performance native backend with same C# interface (C# version)
9645 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9646 : ! (C++ and C# versions, x86/x64 platform)
9647 : !
9648 : ! We recommend you to read 'Working with commercial version' section of
9649 : ! ALGLIB Reference Manual in order to find out how to use performance-
9650 : ! related features provided by commercial edition of ALGLIB.
9651 :
9652 : Input parameters:
9653 : A - the result of a HMatrixTD subroutine
9654 : N - size of matrix A.
9655 : IsUpper - storage format (a parameter of HMatrixTD subroutine)
9656 : Tau - the result of a HMatrixTD subroutine
9657 :
9658 : Output parameters:
9659 : Q - transformation matrix.
9660 : array with elements [0..N-1, 0..N-1].
9661 :
9662 : -- ALGLIB --
9663 : Copyright 2005-2010 by Bochkanov Sergey
9664 : *************************************************************************/
9665 0 : void hmatrixtdunpackq(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &tau, complex_2d_array &q, const xparams _xparams)
9666 : {
9667 : jmp_buf _break_jump;
9668 : alglib_impl::ae_state _alglib_env_state;
9669 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9670 0 : if( setjmp(_break_jump) )
9671 : {
9672 : #if !defined(AE_NO_EXCEPTIONS)
9673 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9674 : #else
9675 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9676 : return;
9677 : #endif
9678 : }
9679 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9680 0 : if( _xparams.flags!=0x0 )
9681 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9682 0 : alglib_impl::hmatrixtdunpackq(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, const_cast<alglib_impl::ae_vector*>(tau.c_ptr()), const_cast<alglib_impl::ae_matrix*>(q.c_ptr()), &_alglib_env_state);
9683 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9684 0 : return;
9685 : }
9686 : #endif
9687 :
9688 : #if defined(AE_COMPILE_FBLS) || !defined(AE_PARTIAL_BUILD)
9689 :
9690 : #endif
9691 :
9692 : #if defined(AE_COMPILE_BDSVD) || !defined(AE_PARTIAL_BUILD)
9693 : /*************************************************************************
9694 : Singular value decomposition of a bidiagonal matrix (extended algorithm)
9695 :
9696 : COMMERCIAL EDITION OF ALGLIB:
9697 :
9698 : ! Commercial version of ALGLIB includes one important improvement of
9699 : ! this function, which can be used from C++ and C#:
9700 : ! * Intel MKL support (lightweight Intel MKL is shipped with ALGLIB)
9701 : !
9702 : ! Intel MKL gives approximately constant (with respect to number of
9703 : ! worker threads) acceleration factor which depends on CPU being used,
9704 : ! problem size and "baseline" ALGLIB edition which is used for
9705 : ! comparison.
9706 : !
9707 : ! Generally, commercial ALGLIB is several times faster than open-source
9708 : ! generic C edition, and many times faster than open-source C# edition.
9709 : !
9710 : ! Multithreaded acceleration is NOT supported for this function.
9711 : !
9712 : ! We recommend you to read 'Working with commercial version' section of
9713 : ! ALGLIB Reference Manual in order to find out how to use performance-
9714 : ! related features provided by commercial edition of ALGLIB.
9715 :
9716 : The algorithm performs the singular value decomposition of a bidiagonal
9717 : matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and P -
9718 : orthogonal matrices, S - diagonal matrix with non-negative elements on the
9719 : main diagonal, in descending order.
9720 :
9721 : The algorithm finds singular values. In addition, the algorithm can
9722 : calculate matrices Q and P (more precisely, not the matrices, but their
9723 : product with given matrices U and VT - U*Q and (P^T)*VT)). Of course,
9724 : matrices U and VT can be of any type, including identity. Furthermore, the
9725 : algorithm can calculate Q'*C (this product is calculated more effectively
9726 : than U*Q, because this calculation operates with rows instead of matrix
9727 : columns).
9728 :
9729 : The feature of the algorithm is its ability to find all singular values
9730 : including those which are arbitrarily close to 0 with relative accuracy
9731 : close to machine precision. If the parameter IsFractionalAccuracyRequired
9732 : is set to True, all singular values will have high relative accuracy close
9733 : to machine precision. If the parameter is set to False, only the biggest
9734 : singular value will have relative accuracy close to machine precision.
9735 : The absolute error of other singular values is equal to the absolute error
9736 : of the biggest singular value.
9737 :
9738 : Input parameters:
9739 : D - main diagonal of matrix B.
9740 : Array whose index ranges within [0..N-1].
9741 : E - superdiagonal (or subdiagonal) of matrix B.
9742 : Array whose index ranges within [0..N-2].
9743 : N - size of matrix B.
9744 : IsUpper - True, if the matrix is upper bidiagonal.
9745 : IsFractionalAccuracyRequired -
9746 : THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0
9747 : SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY.
9748 : U - matrix to be multiplied by Q.
9749 : Array whose indexes range within [0..NRU-1, 0..N-1].
9750 : The matrix can be bigger, in that case only the submatrix
9751 : [0..NRU-1, 0..N-1] will be multiplied by Q.
9752 : NRU - number of rows in matrix U.
9753 : C - matrix to be multiplied by Q'.
9754 : Array whose indexes range within [0..N-1, 0..NCC-1].
9755 : The matrix can be bigger, in that case only the submatrix
9756 : [0..N-1, 0..NCC-1] will be multiplied by Q'.
9757 : NCC - number of columns in matrix C.
9758 : VT - matrix to be multiplied by P^T.
9759 : Array whose indexes range within [0..N-1, 0..NCVT-1].
9760 : The matrix can be bigger, in that case only the submatrix
9761 : [0..N-1, 0..NCVT-1] will be multiplied by P^T.
9762 : NCVT - number of columns in matrix VT.
9763 :
9764 : Output parameters:
9765 : D - singular values of matrix B in descending order.
9766 : U - if NRU>0, contains matrix U*Q.
9767 : VT - if NCVT>0, contains matrix (P^T)*VT.
9768 : C - if NCC>0, contains matrix Q'*C.
9769 :
9770 : Result:
9771 : True, if the algorithm has converged.
9772 : False, if the algorithm hasn't converged (rare case).
9773 :
9774 : NOTE: multiplication U*Q is performed by means of transposition to internal
9775 : buffer, multiplication and backward transposition. It helps to avoid
9776 : costly columnwise operations and speed-up algorithm.
9777 :
9778 : Additional information:
9779 : The type of convergence is controlled by the internal parameter TOL.
9780 : If the parameter is greater than 0, the singular values will have
9781 : relative accuracy TOL. If TOL<0, the singular values will have
9782 : absolute accuracy ABS(TOL)*norm(B).
9783 : By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon,
9784 : where Epsilon is the machine precision. It is not recommended to use
9785 : TOL less than 10*Epsilon since this will considerably slow down the
9786 : algorithm and may not lead to error decreasing.
9787 :
9788 : History:
9789 : * 31 March, 2007.
9790 : changed MAXITR from 6 to 12.
9791 :
9792 : -- LAPACK routine (version 3.0) --
9793 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
9794 : Courant Institute, Argonne National Lab, and Rice University
9795 : October 31, 1999.
9796 : *************************************************************************/
9797 0 : bool rmatrixbdsvd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const bool isupper, const bool isfractionalaccuracyrequired, real_2d_array &u, const ae_int_t nru, real_2d_array &c, const ae_int_t ncc, real_2d_array &vt, const ae_int_t ncvt, const xparams _xparams)
9798 : {
9799 : jmp_buf _break_jump;
9800 : alglib_impl::ae_state _alglib_env_state;
9801 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9802 0 : if( setjmp(_break_jump) )
9803 : {
9804 : #if !defined(AE_NO_EXCEPTIONS)
9805 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9806 : #else
9807 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9808 : return 0;
9809 : #endif
9810 : }
9811 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9812 0 : if( _xparams.flags!=0x0 )
9813 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9814 0 : ae_bool result = alglib_impl::rmatrixbdsvd(const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), n, isupper, isfractionalaccuracyrequired, const_cast<alglib_impl::ae_matrix*>(u.c_ptr()), nru, const_cast<alglib_impl::ae_matrix*>(c.c_ptr()), ncc, const_cast<alglib_impl::ae_matrix*>(vt.c_ptr()), ncvt, &_alglib_env_state);
9815 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9816 0 : return *(reinterpret_cast<bool*>(&result));
9817 : }
9818 : #endif
9819 :
9820 : #if defined(AE_COMPILE_SVD) || !defined(AE_PARTIAL_BUILD)
9821 : /*************************************************************************
9822 : Singular value decomposition of a rectangular matrix.
9823 :
9824 : ! COMMERCIAL EDITION OF ALGLIB:
9825 : !
9826 : ! Commercial Edition of ALGLIB includes following important improvements
9827 : ! of this function:
9828 : ! * high-performance native backend with same C# interface (C# version)
9829 : ! * hardware vendor (Intel) implementations of linear algebra primitives
9830 : ! (C++ and C# versions, x86/x64 platform)
9831 : !
9832 : ! We recommend you to read 'Working with commercial version' section of
9833 : ! ALGLIB Reference Manual in order to find out how to use performance-
9834 : ! related features provided by commercial edition of ALGLIB.
9835 :
9836 : The algorithm calculates the singular value decomposition of a matrix of
9837 : size MxN: A = U * S * V^T
9838 :
9839 : The algorithm finds the singular values and, optionally, matrices U and V^T.
9840 : The algorithm can find both first min(M,N) columns of matrix U and rows of
9841 : matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM
9842 : and NxN respectively).
9843 :
9844 : Take into account that the subroutine does not return matrix V but V^T.
9845 :
9846 : Input parameters:
9847 : A - matrix to be decomposed.
9848 : Array whose indexes range within [0..M-1, 0..N-1].
9849 : M - number of rows in matrix A.
9850 : N - number of columns in matrix A.
9851 : UNeeded - 0, 1 or 2. See the description of the parameter U.
9852 : VTNeeded - 0, 1 or 2. See the description of the parameter VT.
9853 : AdditionalMemory -
9854 : If the parameter:
9855 : * equals 0, the algorithm doesn't use additional
9856 : memory (lower requirements, lower performance).
9857 : * equals 1, the algorithm uses additional
9858 : memory of size min(M,N)*min(M,N) of real numbers.
9859 : It often speeds up the algorithm.
9860 : * equals 2, the algorithm uses additional
9861 : memory of size M*min(M,N) of real numbers.
9862 : It allows to get a maximum performance.
9863 : The recommended value of the parameter is 2.
9864 :
9865 : Output parameters:
9866 : W - contains singular values in descending order.
9867 : U - if UNeeded=0, U isn't changed, the left singular vectors
9868 : are not calculated.
9869 : if Uneeded=1, U contains left singular vectors (first
9870 : min(M,N) columns of matrix U). Array whose indexes range
9871 : within [0..M-1, 0..Min(M,N)-1].
9872 : if UNeeded=2, U contains matrix U wholly. Array whose
9873 : indexes range within [0..M-1, 0..M-1].
9874 : VT - if VTNeeded=0, VT isn't changed, the right singular vectors
9875 : are not calculated.
9876 : if VTNeeded=1, VT contains right singular vectors (first
9877 : min(M,N) rows of matrix V^T). Array whose indexes range
9878 : within [0..min(M,N)-1, 0..N-1].
9879 : if VTNeeded=2, VT contains matrix V^T wholly. Array whose
9880 : indexes range within [0..N-1, 0..N-1].
9881 :
9882 : -- ALGLIB --
9883 : Copyright 2005 by Bochkanov Sergey
9884 : *************************************************************************/
9885 0 : bool rmatrixsvd(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const ae_int_t uneeded, const ae_int_t vtneeded, const ae_int_t additionalmemory, real_1d_array &w, real_2d_array &u, real_2d_array &vt, const xparams _xparams)
9886 : {
9887 : jmp_buf _break_jump;
9888 : alglib_impl::ae_state _alglib_env_state;
9889 0 : alglib_impl::ae_state_init(&_alglib_env_state);
9890 0 : if( setjmp(_break_jump) )
9891 : {
9892 : #if !defined(AE_NO_EXCEPTIONS)
9893 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
9894 : #else
9895 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
9896 : return 0;
9897 : #endif
9898 : }
9899 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
9900 0 : if( _xparams.flags!=0x0 )
9901 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
9902 0 : ae_bool result = alglib_impl::rmatrixsvd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), m, n, uneeded, vtneeded, additionalmemory, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(u.c_ptr()), const_cast<alglib_impl::ae_matrix*>(vt.c_ptr()), &_alglib_env_state);
9903 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
9904 0 : return *(reinterpret_cast<bool*>(&result));
9905 : }
9906 : #endif
9907 :
9908 : #if defined(AE_COMPILE_NORMESTIMATOR) || !defined(AE_PARTIAL_BUILD)
9909 : /*************************************************************************
9910 : This object stores state of the iterative norm estimation algorithm.
9911 :
9912 : You should use ALGLIB functions to work with this object.
9913 : *************************************************************************/
9914 0 : _normestimatorstate_owner::_normestimatorstate_owner()
9915 : {
9916 : jmp_buf _break_jump;
9917 : alglib_impl::ae_state _state;
9918 :
9919 0 : alglib_impl::ae_state_init(&_state);
9920 0 : if( setjmp(_break_jump) )
9921 : {
9922 0 : if( p_struct!=NULL )
9923 : {
9924 0 : alglib_impl::_normestimatorstate_destroy(p_struct);
9925 0 : alglib_impl::ae_free(p_struct);
9926 : }
9927 0 : p_struct = NULL;
9928 : #if !defined(AE_NO_EXCEPTIONS)
9929 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
9930 : #else
9931 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
9932 : return;
9933 : #endif
9934 : }
9935 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
9936 0 : p_struct = NULL;
9937 0 : p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), &_state);
9938 0 : memset(p_struct, 0, sizeof(alglib_impl::normestimatorstate));
9939 0 : alglib_impl::_normestimatorstate_init(p_struct, &_state, ae_false);
9940 0 : ae_state_clear(&_state);
9941 0 : }
9942 :
9943 0 : _normestimatorstate_owner::_normestimatorstate_owner(const _normestimatorstate_owner &rhs)
9944 : {
9945 : jmp_buf _break_jump;
9946 : alglib_impl::ae_state _state;
9947 :
9948 0 : alglib_impl::ae_state_init(&_state);
9949 0 : if( setjmp(_break_jump) )
9950 : {
9951 0 : if( p_struct!=NULL )
9952 : {
9953 0 : alglib_impl::_normestimatorstate_destroy(p_struct);
9954 0 : alglib_impl::ae_free(p_struct);
9955 : }
9956 0 : p_struct = NULL;
9957 : #if !defined(AE_NO_EXCEPTIONS)
9958 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
9959 : #else
9960 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
9961 : return;
9962 : #endif
9963 : }
9964 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
9965 0 : p_struct = NULL;
9966 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: normestimatorstate copy constructor failure (source is not initialized)", &_state);
9967 0 : p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), &_state);
9968 0 : memset(p_struct, 0, sizeof(alglib_impl::normestimatorstate));
9969 0 : alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast<alglib_impl::normestimatorstate*>(rhs.p_struct), &_state, ae_false);
9970 0 : ae_state_clear(&_state);
9971 0 : }
9972 :
9973 0 : _normestimatorstate_owner& _normestimatorstate_owner::operator=(const _normestimatorstate_owner &rhs)
9974 : {
9975 0 : if( this==&rhs )
9976 0 : return *this;
9977 : jmp_buf _break_jump;
9978 : alglib_impl::ae_state _state;
9979 :
9980 0 : alglib_impl::ae_state_init(&_state);
9981 0 : if( setjmp(_break_jump) )
9982 : {
9983 : #if !defined(AE_NO_EXCEPTIONS)
9984 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
9985 : #else
9986 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
9987 : return *this;
9988 : #endif
9989 : }
9990 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
9991 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: normestimatorstate assignment constructor failure (destination is not initialized)", &_state);
9992 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: normestimatorstate assignment constructor failure (source is not initialized)", &_state);
9993 0 : alglib_impl::_normestimatorstate_destroy(p_struct);
9994 0 : memset(p_struct, 0, sizeof(alglib_impl::normestimatorstate));
9995 0 : alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast<alglib_impl::normestimatorstate*>(rhs.p_struct), &_state, ae_false);
9996 0 : ae_state_clear(&_state);
9997 0 : return *this;
9998 : }
9999 :
10000 0 : _normestimatorstate_owner::~_normestimatorstate_owner()
10001 : {
10002 0 : if( p_struct!=NULL )
10003 : {
10004 0 : alglib_impl::_normestimatorstate_destroy(p_struct);
10005 0 : ae_free(p_struct);
10006 : }
10007 0 : }
10008 :
10009 0 : alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr()
10010 : {
10011 0 : return p_struct;
10012 : }
10013 :
10014 0 : alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr() const
10015 : {
10016 0 : return const_cast<alglib_impl::normestimatorstate*>(p_struct);
10017 : }
10018 0 : normestimatorstate::normestimatorstate() : _normestimatorstate_owner()
10019 : {
10020 0 : }
10021 :
10022 0 : normestimatorstate::normestimatorstate(const normestimatorstate &rhs):_normestimatorstate_owner(rhs)
10023 : {
10024 0 : }
10025 :
10026 0 : normestimatorstate& normestimatorstate::operator=(const normestimatorstate &rhs)
10027 : {
10028 0 : if( this==&rhs )
10029 0 : return *this;
10030 0 : _normestimatorstate_owner::operator=(rhs);
10031 0 : return *this;
10032 : }
10033 :
10034 0 : normestimatorstate::~normestimatorstate()
10035 : {
10036 0 : }
10037 :
10038 : /*************************************************************************
10039 : This procedure initializes matrix norm estimator.
10040 :
10041 : USAGE:
10042 : 1. User initializes algorithm state with NormEstimatorCreate() call
10043 : 2. User calls NormEstimatorEstimateSparse() (or NormEstimatorIteration())
10044 : 3. User calls NormEstimatorResults() to get solution.
10045 :
10046 : INPUT PARAMETERS:
10047 : M - number of rows in the matrix being estimated, M>0
10048 : N - number of columns in the matrix being estimated, N>0
10049 : NStart - number of random starting vectors
10050 : recommended value - at least 5.
10051 : NIts - number of iterations to do with best starting vector
10052 : recommended value - at least 5.
10053 :
10054 : OUTPUT PARAMETERS:
10055 : State - structure which stores algorithm state
10056 :
10057 :
10058 : NOTE: this algorithm is effectively deterministic, i.e. it always returns
10059 : same result when repeatedly called for the same matrix. In fact, algorithm
10060 : uses randomized starting vectors, but internal random numbers generator
10061 : always generates same sequence of the random values (it is a feature, not
10062 : bug).
10063 :
10064 : Algorithm can be made non-deterministic with NormEstimatorSetSeed(0) call.
10065 :
10066 : -- ALGLIB --
10067 : Copyright 06.12.2011 by Bochkanov Sergey
10068 : *************************************************************************/
10069 0 : void normestimatorcreate(const ae_int_t m, const ae_int_t n, const ae_int_t nstart, const ae_int_t nits, normestimatorstate &state, const xparams _xparams)
10070 : {
10071 : jmp_buf _break_jump;
10072 : alglib_impl::ae_state _alglib_env_state;
10073 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10074 0 : if( setjmp(_break_jump) )
10075 : {
10076 : #if !defined(AE_NO_EXCEPTIONS)
10077 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10078 : #else
10079 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10080 : return;
10081 : #endif
10082 : }
10083 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10084 0 : if( _xparams.flags!=0x0 )
10085 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10086 0 : alglib_impl::normestimatorcreate(m, n, nstart, nits, const_cast<alglib_impl::normestimatorstate*>(state.c_ptr()), &_alglib_env_state);
10087 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10088 0 : return;
10089 : }
10090 :
10091 : /*************************************************************************
10092 : This function changes seed value used by algorithm. In some cases we need
10093 : deterministic processing, i.e. subsequent calls must return equal results,
10094 : in other cases we need non-deterministic algorithm which returns different
10095 : results for the same matrix on every pass.
10096 :
10097 : Setting zero seed will lead to non-deterministic algorithm, while non-zero
10098 : value will make our algorithm deterministic.
10099 :
10100 : INPUT PARAMETERS:
10101 : State - norm estimator state, must be initialized with a call
10102 : to NormEstimatorCreate()
10103 : SeedVal - seed value, >=0. Zero value = non-deterministic algo.
10104 :
10105 : -- ALGLIB --
10106 : Copyright 06.12.2011 by Bochkanov Sergey
10107 : *************************************************************************/
10108 0 : void normestimatorsetseed(const normestimatorstate &state, const ae_int_t seedval, const xparams _xparams)
10109 : {
10110 : jmp_buf _break_jump;
10111 : alglib_impl::ae_state _alglib_env_state;
10112 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10113 0 : if( setjmp(_break_jump) )
10114 : {
10115 : #if !defined(AE_NO_EXCEPTIONS)
10116 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10117 : #else
10118 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10119 : return;
10120 : #endif
10121 : }
10122 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10123 0 : if( _xparams.flags!=0x0 )
10124 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10125 0 : alglib_impl::normestimatorsetseed(const_cast<alglib_impl::normestimatorstate*>(state.c_ptr()), seedval, &_alglib_env_state);
10126 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10127 0 : return;
10128 : }
10129 :
10130 : /*************************************************************************
10131 : This function estimates norm of the sparse M*N matrix A.
10132 :
10133 : INPUT PARAMETERS:
10134 : State - norm estimator state, must be initialized with a call
10135 : to NormEstimatorCreate()
10136 : A - sparse M*N matrix, must be converted to CRS format
10137 : prior to calling this function.
10138 :
10139 : After this function is over you can call NormEstimatorResults() to get
10140 : estimate of the norm(A).
10141 :
10142 : -- ALGLIB --
10143 : Copyright 06.12.2011 by Bochkanov Sergey
10144 : *************************************************************************/
10145 0 : void normestimatorestimatesparse(const normestimatorstate &state, const sparsematrix &a, const xparams _xparams)
10146 : {
10147 : jmp_buf _break_jump;
10148 : alglib_impl::ae_state _alglib_env_state;
10149 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10150 0 : if( setjmp(_break_jump) )
10151 : {
10152 : #if !defined(AE_NO_EXCEPTIONS)
10153 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10154 : #else
10155 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10156 : return;
10157 : #endif
10158 : }
10159 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10160 0 : if( _xparams.flags!=0x0 )
10161 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10162 0 : alglib_impl::normestimatorestimatesparse(const_cast<alglib_impl::normestimatorstate*>(state.c_ptr()), const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), &_alglib_env_state);
10163 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10164 0 : return;
10165 : }
10166 :
10167 : /*************************************************************************
10168 : Matrix norm estimation results
10169 :
10170 : INPUT PARAMETERS:
10171 : State - algorithm state
10172 :
10173 : OUTPUT PARAMETERS:
10174 : Nrm - estimate of the matrix norm, Nrm>=0
10175 :
10176 : -- ALGLIB --
10177 : Copyright 06.12.2011 by Bochkanov Sergey
10178 : *************************************************************************/
10179 0 : void normestimatorresults(const normestimatorstate &state, double &nrm, const xparams _xparams)
10180 : {
10181 : jmp_buf _break_jump;
10182 : alglib_impl::ae_state _alglib_env_state;
10183 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10184 0 : if( setjmp(_break_jump) )
10185 : {
10186 : #if !defined(AE_NO_EXCEPTIONS)
10187 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10188 : #else
10189 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10190 : return;
10191 : #endif
10192 : }
10193 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10194 0 : if( _xparams.flags!=0x0 )
10195 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10196 0 : alglib_impl::normestimatorresults(const_cast<alglib_impl::normestimatorstate*>(state.c_ptr()), &nrm, &_alglib_env_state);
10197 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10198 0 : return;
10199 : }
10200 : #endif
10201 :
10202 : #if defined(AE_COMPILE_HSSCHUR) || !defined(AE_PARTIAL_BUILD)
10203 :
10204 : #endif
10205 :
10206 : #if defined(AE_COMPILE_EVD) || !defined(AE_PARTIAL_BUILD)
10207 : /*************************************************************************
10208 : This object stores state of the subspace iteration algorithm.
10209 :
10210 : You should use ALGLIB functions to work with this object.
10211 : *************************************************************************/
10212 0 : _eigsubspacestate_owner::_eigsubspacestate_owner()
10213 : {
10214 : jmp_buf _break_jump;
10215 : alglib_impl::ae_state _state;
10216 :
10217 0 : alglib_impl::ae_state_init(&_state);
10218 0 : if( setjmp(_break_jump) )
10219 : {
10220 0 : if( p_struct!=NULL )
10221 : {
10222 0 : alglib_impl::_eigsubspacestate_destroy(p_struct);
10223 0 : alglib_impl::ae_free(p_struct);
10224 : }
10225 0 : p_struct = NULL;
10226 : #if !defined(AE_NO_EXCEPTIONS)
10227 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10228 : #else
10229 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10230 : return;
10231 : #endif
10232 : }
10233 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10234 0 : p_struct = NULL;
10235 0 : p_struct = (alglib_impl::eigsubspacestate*)alglib_impl::ae_malloc(sizeof(alglib_impl::eigsubspacestate), &_state);
10236 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacestate));
10237 0 : alglib_impl::_eigsubspacestate_init(p_struct, &_state, ae_false);
10238 0 : ae_state_clear(&_state);
10239 0 : }
10240 :
10241 0 : _eigsubspacestate_owner::_eigsubspacestate_owner(const _eigsubspacestate_owner &rhs)
10242 : {
10243 : jmp_buf _break_jump;
10244 : alglib_impl::ae_state _state;
10245 :
10246 0 : alglib_impl::ae_state_init(&_state);
10247 0 : if( setjmp(_break_jump) )
10248 : {
10249 0 : if( p_struct!=NULL )
10250 : {
10251 0 : alglib_impl::_eigsubspacestate_destroy(p_struct);
10252 0 : alglib_impl::ae_free(p_struct);
10253 : }
10254 0 : p_struct = NULL;
10255 : #if !defined(AE_NO_EXCEPTIONS)
10256 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10257 : #else
10258 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10259 : return;
10260 : #endif
10261 : }
10262 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10263 0 : p_struct = NULL;
10264 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: eigsubspacestate copy constructor failure (source is not initialized)", &_state);
10265 0 : p_struct = (alglib_impl::eigsubspacestate*)alglib_impl::ae_malloc(sizeof(alglib_impl::eigsubspacestate), &_state);
10266 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacestate));
10267 0 : alglib_impl::_eigsubspacestate_init_copy(p_struct, const_cast<alglib_impl::eigsubspacestate*>(rhs.p_struct), &_state, ae_false);
10268 0 : ae_state_clear(&_state);
10269 0 : }
10270 :
10271 0 : _eigsubspacestate_owner& _eigsubspacestate_owner::operator=(const _eigsubspacestate_owner &rhs)
10272 : {
10273 0 : if( this==&rhs )
10274 0 : return *this;
10275 : jmp_buf _break_jump;
10276 : alglib_impl::ae_state _state;
10277 :
10278 0 : alglib_impl::ae_state_init(&_state);
10279 0 : if( setjmp(_break_jump) )
10280 : {
10281 : #if !defined(AE_NO_EXCEPTIONS)
10282 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10283 : #else
10284 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10285 : return *this;
10286 : #endif
10287 : }
10288 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10289 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: eigsubspacestate assignment constructor failure (destination is not initialized)", &_state);
10290 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: eigsubspacestate assignment constructor failure (source is not initialized)", &_state);
10291 0 : alglib_impl::_eigsubspacestate_destroy(p_struct);
10292 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacestate));
10293 0 : alglib_impl::_eigsubspacestate_init_copy(p_struct, const_cast<alglib_impl::eigsubspacestate*>(rhs.p_struct), &_state, ae_false);
10294 0 : ae_state_clear(&_state);
10295 0 : return *this;
10296 : }
10297 :
10298 0 : _eigsubspacestate_owner::~_eigsubspacestate_owner()
10299 : {
10300 0 : if( p_struct!=NULL )
10301 : {
10302 0 : alglib_impl::_eigsubspacestate_destroy(p_struct);
10303 0 : ae_free(p_struct);
10304 : }
10305 0 : }
10306 :
10307 0 : alglib_impl::eigsubspacestate* _eigsubspacestate_owner::c_ptr()
10308 : {
10309 0 : return p_struct;
10310 : }
10311 :
10312 0 : alglib_impl::eigsubspacestate* _eigsubspacestate_owner::c_ptr() const
10313 : {
10314 0 : return const_cast<alglib_impl::eigsubspacestate*>(p_struct);
10315 : }
10316 0 : eigsubspacestate::eigsubspacestate() : _eigsubspacestate_owner()
10317 : {
10318 0 : }
10319 :
10320 0 : eigsubspacestate::eigsubspacestate(const eigsubspacestate &rhs):_eigsubspacestate_owner(rhs)
10321 : {
10322 0 : }
10323 :
10324 0 : eigsubspacestate& eigsubspacestate::operator=(const eigsubspacestate &rhs)
10325 : {
10326 0 : if( this==&rhs )
10327 0 : return *this;
10328 0 : _eigsubspacestate_owner::operator=(rhs);
10329 0 : return *this;
10330 : }
10331 :
10332 0 : eigsubspacestate::~eigsubspacestate()
10333 : {
10334 0 : }
10335 :
10336 :
10337 : /*************************************************************************
10338 : This object stores state of the subspace iteration algorithm.
10339 :
10340 : You should use ALGLIB functions to work with this object.
10341 : *************************************************************************/
10342 0 : _eigsubspacereport_owner::_eigsubspacereport_owner()
10343 : {
10344 : jmp_buf _break_jump;
10345 : alglib_impl::ae_state _state;
10346 :
10347 0 : alglib_impl::ae_state_init(&_state);
10348 0 : if( setjmp(_break_jump) )
10349 : {
10350 0 : if( p_struct!=NULL )
10351 : {
10352 0 : alglib_impl::_eigsubspacereport_destroy(p_struct);
10353 0 : alglib_impl::ae_free(p_struct);
10354 : }
10355 0 : p_struct = NULL;
10356 : #if !defined(AE_NO_EXCEPTIONS)
10357 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10358 : #else
10359 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10360 : return;
10361 : #endif
10362 : }
10363 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10364 0 : p_struct = NULL;
10365 0 : p_struct = (alglib_impl::eigsubspacereport*)alglib_impl::ae_malloc(sizeof(alglib_impl::eigsubspacereport), &_state);
10366 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacereport));
10367 0 : alglib_impl::_eigsubspacereport_init(p_struct, &_state, ae_false);
10368 0 : ae_state_clear(&_state);
10369 0 : }
10370 :
10371 0 : _eigsubspacereport_owner::_eigsubspacereport_owner(const _eigsubspacereport_owner &rhs)
10372 : {
10373 : jmp_buf _break_jump;
10374 : alglib_impl::ae_state _state;
10375 :
10376 0 : alglib_impl::ae_state_init(&_state);
10377 0 : if( setjmp(_break_jump) )
10378 : {
10379 0 : if( p_struct!=NULL )
10380 : {
10381 0 : alglib_impl::_eigsubspacereport_destroy(p_struct);
10382 0 : alglib_impl::ae_free(p_struct);
10383 : }
10384 0 : p_struct = NULL;
10385 : #if !defined(AE_NO_EXCEPTIONS)
10386 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10387 : #else
10388 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10389 : return;
10390 : #endif
10391 : }
10392 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10393 0 : p_struct = NULL;
10394 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: eigsubspacereport copy constructor failure (source is not initialized)", &_state);
10395 0 : p_struct = (alglib_impl::eigsubspacereport*)alglib_impl::ae_malloc(sizeof(alglib_impl::eigsubspacereport), &_state);
10396 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacereport));
10397 0 : alglib_impl::_eigsubspacereport_init_copy(p_struct, const_cast<alglib_impl::eigsubspacereport*>(rhs.p_struct), &_state, ae_false);
10398 0 : ae_state_clear(&_state);
10399 0 : }
10400 :
10401 0 : _eigsubspacereport_owner& _eigsubspacereport_owner::operator=(const _eigsubspacereport_owner &rhs)
10402 : {
10403 0 : if( this==&rhs )
10404 0 : return *this;
10405 : jmp_buf _break_jump;
10406 : alglib_impl::ae_state _state;
10407 :
10408 0 : alglib_impl::ae_state_init(&_state);
10409 0 : if( setjmp(_break_jump) )
10410 : {
10411 : #if !defined(AE_NO_EXCEPTIONS)
10412 0 : _ALGLIB_CPP_EXCEPTION(_state.error_msg);
10413 : #else
10414 : _ALGLIB_SET_ERROR_FLAG(_state.error_msg);
10415 : return *this;
10416 : #endif
10417 : }
10418 0 : alglib_impl::ae_state_set_break_jump(&_state, &_break_jump);
10419 0 : alglib_impl::ae_assert(p_struct!=NULL, "ALGLIB: eigsubspacereport assignment constructor failure (destination is not initialized)", &_state);
10420 0 : alglib_impl::ae_assert(rhs.p_struct!=NULL, "ALGLIB: eigsubspacereport assignment constructor failure (source is not initialized)", &_state);
10421 0 : alglib_impl::_eigsubspacereport_destroy(p_struct);
10422 0 : memset(p_struct, 0, sizeof(alglib_impl::eigsubspacereport));
10423 0 : alglib_impl::_eigsubspacereport_init_copy(p_struct, const_cast<alglib_impl::eigsubspacereport*>(rhs.p_struct), &_state, ae_false);
10424 0 : ae_state_clear(&_state);
10425 0 : return *this;
10426 : }
10427 :
10428 0 : _eigsubspacereport_owner::~_eigsubspacereport_owner()
10429 : {
10430 0 : if( p_struct!=NULL )
10431 : {
10432 0 : alglib_impl::_eigsubspacereport_destroy(p_struct);
10433 0 : ae_free(p_struct);
10434 : }
10435 0 : }
10436 :
10437 0 : alglib_impl::eigsubspacereport* _eigsubspacereport_owner::c_ptr()
10438 : {
10439 0 : return p_struct;
10440 : }
10441 :
10442 0 : alglib_impl::eigsubspacereport* _eigsubspacereport_owner::c_ptr() const
10443 : {
10444 0 : return const_cast<alglib_impl::eigsubspacereport*>(p_struct);
10445 : }
10446 0 : eigsubspacereport::eigsubspacereport() : _eigsubspacereport_owner() ,iterationscount(p_struct->iterationscount)
10447 : {
10448 0 : }
10449 :
10450 0 : eigsubspacereport::eigsubspacereport(const eigsubspacereport &rhs):_eigsubspacereport_owner(rhs) ,iterationscount(p_struct->iterationscount)
10451 : {
10452 0 : }
10453 :
10454 0 : eigsubspacereport& eigsubspacereport::operator=(const eigsubspacereport &rhs)
10455 : {
10456 0 : if( this==&rhs )
10457 0 : return *this;
10458 0 : _eigsubspacereport_owner::operator=(rhs);
10459 0 : return *this;
10460 : }
10461 :
10462 0 : eigsubspacereport::~eigsubspacereport()
10463 : {
10464 0 : }
10465 :
10466 : /*************************************************************************
10467 : This function initializes subspace iteration solver. This solver is used
10468 : to solve symmetric real eigenproblems where just a few (top K) eigenvalues
10469 : and corresponding eigenvectors is required.
10470 :
10471 : This solver can be significantly faster than complete EVD decomposition
10472 : in the following case:
10473 : * when only just a small fraction of top eigenpairs of dense matrix is
10474 : required. When K approaches N, this solver is slower than complete dense
10475 : EVD
10476 : * when problem matrix is sparse (and/or is not known explicitly, i.e. only
10477 : matrix-matrix product can be performed)
10478 :
10479 : USAGE (explicit dense/sparse matrix):
10480 : 1. User initializes algorithm state with eigsubspacecreate() call
10481 : 2. [optional] User tunes solver parameters by calling eigsubspacesetcond()
10482 : or other functions
10483 : 3. User calls eigsubspacesolvedense() or eigsubspacesolvesparse() methods,
10484 : which take algorithm state and 2D array or alglib.sparsematrix object.
10485 :
10486 : USAGE (out-of-core mode):
10487 : 1. User initializes algorithm state with eigsubspacecreate() call
10488 : 2. [optional] User tunes solver parameters by calling eigsubspacesetcond()
10489 : or other functions
10490 : 3. User activates out-of-core mode of the solver and repeatedly calls
10491 : communication functions in a loop like below:
10492 : > alglib.eigsubspaceoocstart(state)
10493 : > while alglib.eigsubspaceooccontinue(state) do
10494 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10495 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10496 : > [calculate Y=A*X, with X=R^NxM]
10497 : > alglib.eigsubspaceoocsendresult(state, in Y)
10498 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10499 :
10500 : INPUT PARAMETERS:
10501 : N - problem dimensionality, N>0
10502 : K - number of top eigenvector to calculate, 0<K<=N.
10503 :
10504 : OUTPUT PARAMETERS:
10505 : State - structure which stores algorithm state
10506 :
10507 : NOTE: if you solve many similar EVD problems you may find it useful to
10508 : reuse previous subspace as warm-start point for new EVD problem. It
10509 : can be done with eigsubspacesetwarmstart() function.
10510 :
10511 : -- ALGLIB --
10512 : Copyright 16.01.2017 by Bochkanov Sergey
10513 : *************************************************************************/
10514 0 : void eigsubspacecreate(const ae_int_t n, const ae_int_t k, eigsubspacestate &state, const xparams _xparams)
10515 : {
10516 : jmp_buf _break_jump;
10517 : alglib_impl::ae_state _alglib_env_state;
10518 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10519 0 : if( setjmp(_break_jump) )
10520 : {
10521 : #if !defined(AE_NO_EXCEPTIONS)
10522 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10523 : #else
10524 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10525 : return;
10526 : #endif
10527 : }
10528 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10529 0 : if( _xparams.flags!=0x0 )
10530 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10531 0 : alglib_impl::eigsubspacecreate(n, k, const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), &_alglib_env_state);
10532 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10533 0 : return;
10534 : }
10535 :
10536 : /*************************************************************************
10537 : Buffered version of constructor which aims to reuse previously allocated
10538 : memory as much as possible.
10539 :
10540 : -- ALGLIB --
10541 : Copyright 16.01.2017 by Bochkanov Sergey
10542 : *************************************************************************/
10543 0 : void eigsubspacecreatebuf(const ae_int_t n, const ae_int_t k, const eigsubspacestate &state, const xparams _xparams)
10544 : {
10545 : jmp_buf _break_jump;
10546 : alglib_impl::ae_state _alglib_env_state;
10547 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10548 0 : if( setjmp(_break_jump) )
10549 : {
10550 : #if !defined(AE_NO_EXCEPTIONS)
10551 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10552 : #else
10553 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10554 : return;
10555 : #endif
10556 : }
10557 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10558 0 : if( _xparams.flags!=0x0 )
10559 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10560 0 : alglib_impl::eigsubspacecreatebuf(n, k, const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), &_alglib_env_state);
10561 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10562 0 : return;
10563 : }
10564 :
10565 : /*************************************************************************
10566 : This function sets stopping critera for the solver:
10567 : * error in eigenvector/value allowed by solver
10568 : * maximum number of iterations to perform
10569 :
10570 : INPUT PARAMETERS:
10571 : State - solver structure
10572 : Eps - eps>=0, with non-zero value used to tell solver that
10573 : it can stop after all eigenvalues converged with
10574 : error roughly proportional to eps*MAX(LAMBDA_MAX),
10575 : where LAMBDA_MAX is a maximum eigenvalue.
10576 : Zero value means that no check for precision is
10577 : performed.
10578 : MaxIts - maxits>=0, with non-zero value used to tell solver
10579 : that it can stop after maxits steps (no matter how
10580 : precise current estimate is)
10581 :
10582 : NOTE: passing eps=0 and maxits=0 results in automatic selection of
10583 : moderate eps as stopping criteria (1.0E-6 in current implementation,
10584 : but it may change without notice).
10585 :
10586 : NOTE: very small values of eps are possible (say, 1.0E-12), although the
10587 : larger problem you solve (N and/or K), the harder it is to find
10588 : precise eigenvectors because rounding errors tend to accumulate.
10589 :
10590 : NOTE: passing non-zero eps results in some performance penalty, roughly
10591 : equal to 2N*(2K)^2 FLOPs per iteration. These additional computations
10592 : are required in order to estimate current error in eigenvalues via
10593 : Rayleigh-Ritz process.
10594 : Most of this additional time is spent in construction of ~2Kx2K
10595 : symmetric subproblem whose eigenvalues are checked with exact
10596 : eigensolver.
10597 : This additional time is negligible if you search for eigenvalues of
10598 : the large dense matrix, but may become noticeable on highly sparse
10599 : EVD problems, where cost of matrix-matrix product is low.
10600 : If you set eps to exactly zero, Rayleigh-Ritz phase is completely
10601 : turned off.
10602 :
10603 : -- ALGLIB --
10604 : Copyright 16.01.2017 by Bochkanov Sergey
10605 : *************************************************************************/
10606 0 : void eigsubspacesetcond(const eigsubspacestate &state, const double eps, const ae_int_t maxits, const xparams _xparams)
10607 : {
10608 : jmp_buf _break_jump;
10609 : alglib_impl::ae_state _alglib_env_state;
10610 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10611 0 : if( setjmp(_break_jump) )
10612 : {
10613 : #if !defined(AE_NO_EXCEPTIONS)
10614 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10615 : #else
10616 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10617 : return;
10618 : #endif
10619 : }
10620 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10621 0 : if( _xparams.flags!=0x0 )
10622 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10623 0 : alglib_impl::eigsubspacesetcond(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), eps, maxits, &_alglib_env_state);
10624 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10625 0 : return;
10626 : }
10627 :
10628 : /*************************************************************************
10629 : This function sets warm-start mode of the solver: next call to the solver
10630 : will reuse previous subspace as warm-start point. It can significantly
10631 : speed-up convergence when you solve many similar eigenproblems.
10632 :
10633 : INPUT PARAMETERS:
10634 : State - solver structure
10635 : UseWarmStart- either True or False
10636 :
10637 : -- ALGLIB --
10638 : Copyright 12.11.2017 by Bochkanov Sergey
10639 : *************************************************************************/
10640 0 : void eigsubspacesetwarmstart(const eigsubspacestate &state, const bool usewarmstart, const xparams _xparams)
10641 : {
10642 : jmp_buf _break_jump;
10643 : alglib_impl::ae_state _alglib_env_state;
10644 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10645 0 : if( setjmp(_break_jump) )
10646 : {
10647 : #if !defined(AE_NO_EXCEPTIONS)
10648 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10649 : #else
10650 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10651 : return;
10652 : #endif
10653 : }
10654 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10655 0 : if( _xparams.flags!=0x0 )
10656 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10657 0 : alglib_impl::eigsubspacesetwarmstart(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), usewarmstart, &_alglib_env_state);
10658 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10659 0 : return;
10660 : }
10661 :
10662 : /*************************************************************************
10663 : This function initiates out-of-core mode of subspace eigensolver. It
10664 : should be used in conjunction with other out-of-core-related functions of
10665 : this subspackage in a loop like below:
10666 :
10667 : > alglib.eigsubspaceoocstart(state)
10668 : > while alglib.eigsubspaceooccontinue(state) do
10669 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10670 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10671 : > [calculate Y=A*X, with X=R^NxM]
10672 : > alglib.eigsubspaceoocsendresult(state, in Y)
10673 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10674 :
10675 : INPUT PARAMETERS:
10676 : State - solver object
10677 : MType - matrix type:
10678 : * 0 for real symmetric matrix (solver assumes that
10679 : matrix being processed is symmetric; symmetric
10680 : direct eigensolver is used for smaller subproblems
10681 : arising during solution of larger "full" task)
10682 : Future versions of ALGLIB may introduce support for
10683 : other matrix types; for now, only symmetric
10684 : eigenproblems are supported.
10685 :
10686 :
10687 : -- ALGLIB --
10688 : Copyright 16.01.2017 by Bochkanov Sergey
10689 : *************************************************************************/
10690 0 : void eigsubspaceoocstart(const eigsubspacestate &state, const ae_int_t mtype, const xparams _xparams)
10691 : {
10692 : jmp_buf _break_jump;
10693 : alglib_impl::ae_state _alglib_env_state;
10694 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10695 0 : if( setjmp(_break_jump) )
10696 : {
10697 : #if !defined(AE_NO_EXCEPTIONS)
10698 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10699 : #else
10700 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10701 : return;
10702 : #endif
10703 : }
10704 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10705 0 : if( _xparams.flags!=0x0 )
10706 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10707 0 : alglib_impl::eigsubspaceoocstart(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), mtype, &_alglib_env_state);
10708 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10709 0 : return;
10710 : }
10711 :
10712 : /*************************************************************************
10713 : This function performs subspace iteration in the out-of-core mode. It
10714 : should be used in conjunction with other out-of-core-related functions of
10715 : this subspackage in a loop like below:
10716 :
10717 : > alglib.eigsubspaceoocstart(state)
10718 : > while alglib.eigsubspaceooccontinue(state) do
10719 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10720 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10721 : > [calculate Y=A*X, with X=R^NxM]
10722 : > alglib.eigsubspaceoocsendresult(state, in Y)
10723 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10724 :
10725 :
10726 : -- ALGLIB --
10727 : Copyright 16.01.2017 by Bochkanov Sergey
10728 : *************************************************************************/
10729 0 : bool eigsubspaceooccontinue(const eigsubspacestate &state, const xparams _xparams)
10730 : {
10731 : jmp_buf _break_jump;
10732 : alglib_impl::ae_state _alglib_env_state;
10733 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10734 0 : if( setjmp(_break_jump) )
10735 : {
10736 : #if !defined(AE_NO_EXCEPTIONS)
10737 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10738 : #else
10739 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10740 : return 0;
10741 : #endif
10742 : }
10743 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10744 0 : if( _xparams.flags!=0x0 )
10745 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10746 0 : ae_bool result = alglib_impl::eigsubspaceooccontinue(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), &_alglib_env_state);
10747 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10748 0 : return *(reinterpret_cast<bool*>(&result));
10749 : }
10750 :
10751 : /*************************************************************************
10752 : This function is used to retrieve information about out-of-core request
10753 : sent by solver to user code: request type (current version of the solver
10754 : sends only requests for matrix-matrix products) and request size (size of
10755 : the matrices being multiplied).
10756 :
10757 : This function returns just request metrics; in order to get contents of
10758 : the matrices being multiplied, use eigsubspaceoocgetrequestdata().
10759 :
10760 : It should be used in conjunction with other out-of-core-related functions
10761 : of this subspackage in a loop like below:
10762 :
10763 : > alglib.eigsubspaceoocstart(state)
10764 : > while alglib.eigsubspaceooccontinue(state) do
10765 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10766 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10767 : > [calculate Y=A*X, with X=R^NxM]
10768 : > alglib.eigsubspaceoocsendresult(state, in Y)
10769 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10770 :
10771 : INPUT PARAMETERS:
10772 : State - solver running in out-of-core mode
10773 :
10774 : OUTPUT PARAMETERS:
10775 : RequestType - type of the request to process:
10776 : * 0 - for matrix-matrix product A*X, with A being
10777 : NxN matrix whose eigenvalues/vectors are needed,
10778 : and X being NxREQUESTSIZE one which is returned
10779 : by the eigsubspaceoocgetrequestdata().
10780 : RequestSize - size of the X matrix (number of columns), usually
10781 : it is several times larger than number of vectors
10782 : K requested by user.
10783 :
10784 :
10785 : -- ALGLIB --
10786 : Copyright 16.01.2017 by Bochkanov Sergey
10787 : *************************************************************************/
10788 0 : void eigsubspaceoocgetrequestinfo(const eigsubspacestate &state, ae_int_t &requesttype, ae_int_t &requestsize, const xparams _xparams)
10789 : {
10790 : jmp_buf _break_jump;
10791 : alglib_impl::ae_state _alglib_env_state;
10792 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10793 0 : if( setjmp(_break_jump) )
10794 : {
10795 : #if !defined(AE_NO_EXCEPTIONS)
10796 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10797 : #else
10798 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10799 : return;
10800 : #endif
10801 : }
10802 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10803 0 : if( _xparams.flags!=0x0 )
10804 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10805 0 : alglib_impl::eigsubspaceoocgetrequestinfo(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), &requesttype, &requestsize, &_alglib_env_state);
10806 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10807 0 : return;
10808 : }
10809 :
10810 : /*************************************************************************
10811 : This function is used to retrieve information about out-of-core request
10812 : sent by solver to user code: matrix X (array[N,RequestSize) which have to
10813 : be multiplied by out-of-core matrix A in a product A*X.
10814 :
10815 : This function returns just request data; in order to get size of the data
10816 : prior to processing requestm, use eigsubspaceoocgetrequestinfo().
10817 :
10818 : It should be used in conjunction with other out-of-core-related functions
10819 : of this subspackage in a loop like below:
10820 :
10821 : > alglib.eigsubspaceoocstart(state)
10822 : > while alglib.eigsubspaceooccontinue(state) do
10823 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10824 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10825 : > [calculate Y=A*X, with X=R^NxM]
10826 : > alglib.eigsubspaceoocsendresult(state, in Y)
10827 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10828 :
10829 : INPUT PARAMETERS:
10830 : State - solver running in out-of-core mode
10831 : X - possibly preallocated storage; reallocated if
10832 : needed, left unchanged, if large enough to store
10833 : request data.
10834 :
10835 : OUTPUT PARAMETERS:
10836 : X - array[N,RequestSize] or larger, leading rectangle
10837 : is filled with dense matrix X.
10838 :
10839 :
10840 : -- ALGLIB --
10841 : Copyright 16.01.2017 by Bochkanov Sergey
10842 : *************************************************************************/
10843 0 : void eigsubspaceoocgetrequestdata(const eigsubspacestate &state, real_2d_array &x, const xparams _xparams)
10844 : {
10845 : jmp_buf _break_jump;
10846 : alglib_impl::ae_state _alglib_env_state;
10847 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10848 0 : if( setjmp(_break_jump) )
10849 : {
10850 : #if !defined(AE_NO_EXCEPTIONS)
10851 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10852 : #else
10853 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10854 : return;
10855 : #endif
10856 : }
10857 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10858 0 : if( _xparams.flags!=0x0 )
10859 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10860 0 : alglib_impl::eigsubspaceoocgetrequestdata(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), const_cast<alglib_impl::ae_matrix*>(x.c_ptr()), &_alglib_env_state);
10861 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10862 0 : return;
10863 : }
10864 :
10865 : /*************************************************************************
10866 : This function is used to send user reply to out-of-core request sent by
10867 : solver. Usually it is product A*X for returned by solver matrix X.
10868 :
10869 : It should be used in conjunction with other out-of-core-related functions
10870 : of this subspackage in a loop like below:
10871 :
10872 : > alglib.eigsubspaceoocstart(state)
10873 : > while alglib.eigsubspaceooccontinue(state) do
10874 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10875 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10876 : > [calculate Y=A*X, with X=R^NxM]
10877 : > alglib.eigsubspaceoocsendresult(state, in Y)
10878 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10879 :
10880 : INPUT PARAMETERS:
10881 : State - solver running in out-of-core mode
10882 : AX - array[N,RequestSize] or larger, leading rectangle
10883 : is filled with product A*X.
10884 :
10885 :
10886 : -- ALGLIB --
10887 : Copyright 16.01.2017 by Bochkanov Sergey
10888 : *************************************************************************/
10889 0 : void eigsubspaceoocsendresult(const eigsubspacestate &state, const real_2d_array &ax, const xparams _xparams)
10890 : {
10891 : jmp_buf _break_jump;
10892 : alglib_impl::ae_state _alglib_env_state;
10893 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10894 0 : if( setjmp(_break_jump) )
10895 : {
10896 : #if !defined(AE_NO_EXCEPTIONS)
10897 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10898 : #else
10899 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10900 : return;
10901 : #endif
10902 : }
10903 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10904 0 : if( _xparams.flags!=0x0 )
10905 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10906 0 : alglib_impl::eigsubspaceoocsendresult(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), const_cast<alglib_impl::ae_matrix*>(ax.c_ptr()), &_alglib_env_state);
10907 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10908 0 : return;
10909 : }
10910 :
10911 : /*************************************************************************
10912 : This function finalizes out-of-core mode of subspace eigensolver. It
10913 : should be used in conjunction with other out-of-core-related functions of
10914 : this subspackage in a loop like below:
10915 :
10916 : > alglib.eigsubspaceoocstart(state)
10917 : > while alglib.eigsubspaceooccontinue(state) do
10918 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
10919 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
10920 : > [calculate Y=A*X, with X=R^NxM]
10921 : > alglib.eigsubspaceoocsendresult(state, in Y)
10922 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
10923 :
10924 : INPUT PARAMETERS:
10925 : State - solver state
10926 :
10927 : OUTPUT PARAMETERS:
10928 : W - array[K], depending on solver settings:
10929 : * top K eigenvalues ordered by descending - if
10930 : eigenvectors are returned in Z
10931 : * zeros - if invariant subspace is returned in Z
10932 : Z - array[N,K], depending on solver settings either:
10933 : * matrix of eigenvectors found
10934 : * orthogonal basis of K-dimensional invariant subspace
10935 : Rep - report with additional parameters
10936 :
10937 : -- ALGLIB --
10938 : Copyright 16.01.2017 by Bochkanov Sergey
10939 : *************************************************************************/
10940 0 : void eigsubspaceoocstop(const eigsubspacestate &state, real_1d_array &w, real_2d_array &z, eigsubspacereport &rep, const xparams _xparams)
10941 : {
10942 : jmp_buf _break_jump;
10943 : alglib_impl::ae_state _alglib_env_state;
10944 0 : alglib_impl::ae_state_init(&_alglib_env_state);
10945 0 : if( setjmp(_break_jump) )
10946 : {
10947 : #if !defined(AE_NO_EXCEPTIONS)
10948 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
10949 : #else
10950 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
10951 : return;
10952 : #endif
10953 : }
10954 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
10955 0 : if( _xparams.flags!=0x0 )
10956 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
10957 0 : alglib_impl::eigsubspaceoocstop(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), const_cast<alglib_impl::eigsubspacereport*>(rep.c_ptr()), &_alglib_env_state);
10958 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
10959 0 : return;
10960 : }
10961 :
10962 : /*************************************************************************
10963 : This function runs eigensolver for dense NxN symmetric matrix A, given by
10964 : upper or lower triangle.
10965 :
10966 : This function can not process nonsymmetric matrices.
10967 :
10968 : ! COMMERCIAL EDITION OF ALGLIB:
10969 : !
10970 : ! Commercial Edition of ALGLIB includes following important improvements
10971 : ! of this function:
10972 : ! * high-performance native backend with same C# interface (C# version)
10973 : ! * multithreading support (C++ and C# versions)
10974 : ! * hardware vendor (Intel) implementations of linear algebra primitives
10975 : ! (C++ and C# versions, x86/x64 platform)
10976 : !
10977 : ! We recommend you to read 'Working with commercial version' section of
10978 : ! ALGLIB Reference Manual in order to find out how to use performance-
10979 : ! related features provided by commercial edition of ALGLIB.
10980 :
10981 : INPUT PARAMETERS:
10982 : State - solver state
10983 : A - array[N,N], symmetric NxN matrix given by one of its
10984 : triangles
10985 : IsUpper - whether upper or lower triangle of A is given (the
10986 : other one is not referenced at all).
10987 :
10988 : OUTPUT PARAMETERS:
10989 : W - array[K], top K eigenvalues ordered by descending
10990 : of their absolute values
10991 : Z - array[N,K], matrix of eigenvectors found
10992 : Rep - report with additional parameters
10993 :
10994 : NOTE: internally this function allocates a copy of NxN dense A. You should
10995 : take it into account when working with very large matrices occupying
10996 : almost all RAM.
10997 :
10998 : -- ALGLIB --
10999 : Copyright 16.01.2017 by Bochkanov Sergey
11000 : *************************************************************************/
11001 0 : void eigsubspacesolvedenses(const eigsubspacestate &state, const real_2d_array &a, const bool isupper, real_1d_array &w, real_2d_array &z, eigsubspacereport &rep, const xparams _xparams)
11002 : {
11003 : jmp_buf _break_jump;
11004 : alglib_impl::ae_state _alglib_env_state;
11005 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11006 0 : if( setjmp(_break_jump) )
11007 : {
11008 : #if !defined(AE_NO_EXCEPTIONS)
11009 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11010 : #else
11011 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11012 : return;
11013 : #endif
11014 : }
11015 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11016 0 : if( _xparams.flags!=0x0 )
11017 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11018 0 : alglib_impl::eigsubspacesolvedenses(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), const_cast<alglib_impl::eigsubspacereport*>(rep.c_ptr()), &_alglib_env_state);
11019 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11020 0 : return;
11021 : }
11022 :
11023 : /*************************************************************************
11024 : This function runs eigensolver for dense NxN symmetric matrix A, given by
11025 : upper or lower triangle.
11026 :
11027 : This function can not process nonsymmetric matrices.
11028 :
11029 : INPUT PARAMETERS:
11030 : State - solver state
11031 : A - NxN symmetric matrix given by one of its triangles
11032 : IsUpper - whether upper or lower triangle of A is given (the
11033 : other one is not referenced at all).
11034 :
11035 : OUTPUT PARAMETERS:
11036 : W - array[K], top K eigenvalues ordered by descending
11037 : of their absolute values
11038 : Z - array[N,K], matrix of eigenvectors found
11039 : Rep - report with additional parameters
11040 :
11041 : -- ALGLIB --
11042 : Copyright 16.01.2017 by Bochkanov Sergey
11043 : *************************************************************************/
11044 0 : void eigsubspacesolvesparses(const eigsubspacestate &state, const sparsematrix &a, const bool isupper, real_1d_array &w, real_2d_array &z, eigsubspacereport &rep, const xparams _xparams)
11045 : {
11046 : jmp_buf _break_jump;
11047 : alglib_impl::ae_state _alglib_env_state;
11048 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11049 0 : if( setjmp(_break_jump) )
11050 : {
11051 : #if !defined(AE_NO_EXCEPTIONS)
11052 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11053 : #else
11054 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11055 : return;
11056 : #endif
11057 : }
11058 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11059 0 : if( _xparams.flags!=0x0 )
11060 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11061 0 : alglib_impl::eigsubspacesolvesparses(const_cast<alglib_impl::eigsubspacestate*>(state.c_ptr()), const_cast<alglib_impl::sparsematrix*>(a.c_ptr()), isupper, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), const_cast<alglib_impl::eigsubspacereport*>(rep.c_ptr()), &_alglib_env_state);
11062 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11063 0 : return;
11064 : }
11065 :
11066 : /*************************************************************************
11067 : Finding the eigenvalues and eigenvectors of a symmetric matrix
11068 :
11069 : The algorithm finds eigen pairs of a symmetric matrix by reducing it to
11070 : tridiagonal form and using the QL/QR algorithm.
11071 :
11072 : ! COMMERCIAL EDITION OF ALGLIB:
11073 : !
11074 : ! Commercial Edition of ALGLIB includes following important improvements
11075 : ! of this function:
11076 : ! * high-performance native backend with same C# interface (C# version)
11077 : ! * hardware vendor (Intel) implementations of linear algebra primitives
11078 : ! (C++ and C# versions, x86/x64 platform)
11079 : !
11080 : ! We recommend you to read 'Working with commercial version' section of
11081 : ! ALGLIB Reference Manual in order to find out how to use performance-
11082 : ! related features provided by commercial edition of ALGLIB.
11083 :
11084 : Input parameters:
11085 : A - symmetric matrix which is given by its upper or lower
11086 : triangular part.
11087 : Array whose indexes range within [0..N-1, 0..N-1].
11088 : N - size of matrix A.
11089 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11090 : If ZNeeded is equal to:
11091 : * 0, the eigenvectors are not returned;
11092 : * 1, the eigenvectors are returned.
11093 : IsUpper - storage format.
11094 :
11095 : Output parameters:
11096 : D - eigenvalues in ascending order.
11097 : Array whose index ranges within [0..N-1].
11098 : Z - if ZNeeded is equal to:
11099 : * 0, Z hasn't changed;
11100 : * 1, Z contains the eigenvectors.
11101 : Array whose indexes range within [0..N-1, 0..N-1].
11102 : The eigenvectors are stored in the matrix columns.
11103 :
11104 : Result:
11105 : True, if the algorithm has converged.
11106 : False, if the algorithm hasn't converged (rare case).
11107 :
11108 : -- ALGLIB --
11109 : Copyright 2005-2008 by Bochkanov Sergey
11110 : *************************************************************************/
11111 0 : bool smatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, real_2d_array &z, const xparams _xparams)
11112 : {
11113 : jmp_buf _break_jump;
11114 : alglib_impl::ae_state _alglib_env_state;
11115 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11116 0 : if( setjmp(_break_jump) )
11117 : {
11118 : #if !defined(AE_NO_EXCEPTIONS)
11119 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11120 : #else
11121 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11122 : return 0;
11123 : #endif
11124 : }
11125 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11126 0 : if( _xparams.flags!=0x0 )
11127 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11128 0 : ae_bool result = alglib_impl::smatrixevd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11129 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11130 0 : return *(reinterpret_cast<bool*>(&result));
11131 : }
11132 :
11133 : /*************************************************************************
11134 : Subroutine for finding the eigenvalues (and eigenvectors) of a symmetric
11135 : matrix in a given half open interval (A, B] by using a bisection and
11136 : inverse iteration
11137 :
11138 : ! COMMERCIAL EDITION OF ALGLIB:
11139 : !
11140 : ! Commercial Edition of ALGLIB includes following important improvements
11141 : ! of this function:
11142 : ! * high-performance native backend with same C# interface (C# version)
11143 : ! * hardware vendor (Intel) implementations of linear algebra primitives
11144 : ! (C++ and C# versions, x86/x64 platform)
11145 : !
11146 : ! We recommend you to read 'Working with commercial version' section of
11147 : ! ALGLIB Reference Manual in order to find out how to use performance-
11148 : ! related features provided by commercial edition of ALGLIB.
11149 :
11150 : Input parameters:
11151 : A - symmetric matrix which is given by its upper or lower
11152 : triangular part. Array [0..N-1, 0..N-1].
11153 : N - size of matrix A.
11154 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11155 : If ZNeeded is equal to:
11156 : * 0, the eigenvectors are not returned;
11157 : * 1, the eigenvectors are returned.
11158 : IsUpperA - storage format of matrix A.
11159 : B1, B2 - half open interval (B1, B2] to search eigenvalues in.
11160 :
11161 : Output parameters:
11162 : M - number of eigenvalues found in a given half-interval (M>=0).
11163 : W - array of the eigenvalues found.
11164 : Array whose index ranges within [0..M-1].
11165 : Z - if ZNeeded is equal to:
11166 : * 0, Z hasn't changed;
11167 : * 1, Z contains eigenvectors.
11168 : Array whose indexes range within [0..N-1, 0..M-1].
11169 : The eigenvectors are stored in the matrix columns.
11170 :
11171 : Result:
11172 : True, if successful. M contains the number of eigenvalues in the given
11173 : half-interval (could be equal to 0), W contains the eigenvalues,
11174 : Z contains the eigenvectors (if needed).
11175 :
11176 : False, if the bisection method subroutine wasn't able to find the
11177 : eigenvalues in the given interval or if the inverse iteration subroutine
11178 : wasn't able to find all the corresponding eigenvectors.
11179 : In that case, the eigenvalues and eigenvectors are not returned,
11180 : M is equal to 0.
11181 :
11182 : -- ALGLIB --
11183 : Copyright 07.01.2006 by Bochkanov Sergey
11184 : *************************************************************************/
11185 0 : bool smatrixevdr(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, real_2d_array &z, const xparams _xparams)
11186 : {
11187 : jmp_buf _break_jump;
11188 : alglib_impl::ae_state _alglib_env_state;
11189 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11190 0 : if( setjmp(_break_jump) )
11191 : {
11192 : #if !defined(AE_NO_EXCEPTIONS)
11193 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11194 : #else
11195 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11196 : return 0;
11197 : #endif
11198 : }
11199 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11200 0 : if( _xparams.flags!=0x0 )
11201 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11202 0 : ae_bool result = alglib_impl::smatrixevdr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11203 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11204 0 : return *(reinterpret_cast<bool*>(&result));
11205 : }
11206 :
11207 : /*************************************************************************
11208 : Subroutine for finding the eigenvalues and eigenvectors of a symmetric
11209 : matrix with given indexes by using bisection and inverse iteration methods.
11210 :
11211 : Input parameters:
11212 : A - symmetric matrix which is given by its upper or lower
11213 : triangular part. Array whose indexes range within [0..N-1, 0..N-1].
11214 : N - size of matrix A.
11215 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11216 : If ZNeeded is equal to:
11217 : * 0, the eigenvectors are not returned;
11218 : * 1, the eigenvectors are returned.
11219 : IsUpperA - storage format of matrix A.
11220 : I1, I2 - index interval for searching (from I1 to I2).
11221 : 0 <= I1 <= I2 <= N-1.
11222 :
11223 : Output parameters:
11224 : W - array of the eigenvalues found.
11225 : Array whose index ranges within [0..I2-I1].
11226 : Z - if ZNeeded is equal to:
11227 : * 0, Z hasn't changed;
11228 : * 1, Z contains eigenvectors.
11229 : Array whose indexes range within [0..N-1, 0..I2-I1].
11230 : In that case, the eigenvectors are stored in the matrix columns.
11231 :
11232 : Result:
11233 : True, if successful. W contains the eigenvalues, Z contains the
11234 : eigenvectors (if needed).
11235 :
11236 : False, if the bisection method subroutine wasn't able to find the
11237 : eigenvalues in the given interval or if the inverse iteration subroutine
11238 : wasn't able to find all the corresponding eigenvectors.
11239 : In that case, the eigenvalues and eigenvectors are not returned.
11240 :
11241 : -- ALGLIB --
11242 : Copyright 07.01.2006 by Bochkanov Sergey
11243 : *************************************************************************/
11244 0 : bool smatrixevdi(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, real_2d_array &z, const xparams _xparams)
11245 : {
11246 : jmp_buf _break_jump;
11247 : alglib_impl::ae_state _alglib_env_state;
11248 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11249 0 : if( setjmp(_break_jump) )
11250 : {
11251 : #if !defined(AE_NO_EXCEPTIONS)
11252 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11253 : #else
11254 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11255 : return 0;
11256 : #endif
11257 : }
11258 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11259 0 : if( _xparams.flags!=0x0 )
11260 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11261 0 : ae_bool result = alglib_impl::smatrixevdi(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11262 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11263 0 : return *(reinterpret_cast<bool*>(&result));
11264 : }
11265 :
11266 : /*************************************************************************
11267 : Finding the eigenvalues and eigenvectors of a Hermitian matrix
11268 :
11269 : The algorithm finds eigen pairs of a Hermitian matrix by reducing it to
11270 : real tridiagonal form and using the QL/QR algorithm.
11271 :
11272 : ! COMMERCIAL EDITION OF ALGLIB:
11273 : !
11274 : ! Commercial Edition of ALGLIB includes following important improvements
11275 : ! of this function:
11276 : ! * high-performance native backend with same C# interface (C# version)
11277 : ! * hardware vendor (Intel) implementations of linear algebra primitives
11278 : ! (C++ and C# versions, x86/x64 platform)
11279 : !
11280 : ! We recommend you to read 'Working with commercial version' section of
11281 : ! ALGLIB Reference Manual in order to find out how to use performance-
11282 : ! related features provided by commercial edition of ALGLIB.
11283 :
11284 : Input parameters:
11285 : A - Hermitian matrix which is given by its upper or lower
11286 : triangular part.
11287 : Array whose indexes range within [0..N-1, 0..N-1].
11288 : N - size of matrix A.
11289 : IsUpper - storage format.
11290 : ZNeeded - flag controlling whether the eigenvectors are needed or
11291 : not. If ZNeeded is equal to:
11292 : * 0, the eigenvectors are not returned;
11293 : * 1, the eigenvectors are returned.
11294 :
11295 : Output parameters:
11296 : D - eigenvalues in ascending order.
11297 : Array whose index ranges within [0..N-1].
11298 : Z - if ZNeeded is equal to:
11299 : * 0, Z hasn't changed;
11300 : * 1, Z contains the eigenvectors.
11301 : Array whose indexes range within [0..N-1, 0..N-1].
11302 : The eigenvectors are stored in the matrix columns.
11303 :
11304 : Result:
11305 : True, if the algorithm has converged.
11306 : False, if the algorithm hasn't converged (rare case).
11307 :
11308 : Note:
11309 : eigenvectors of Hermitian matrix are defined up to multiplication by
11310 : a complex number L, such that |L|=1.
11311 :
11312 : -- ALGLIB --
11313 : Copyright 2005, 23 March 2007 by Bochkanov Sergey
11314 : *************************************************************************/
11315 0 : bool hmatrixevd(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, complex_2d_array &z, const xparams _xparams)
11316 : {
11317 : jmp_buf _break_jump;
11318 : alglib_impl::ae_state _alglib_env_state;
11319 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11320 0 : if( setjmp(_break_jump) )
11321 : {
11322 : #if !defined(AE_NO_EXCEPTIONS)
11323 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11324 : #else
11325 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11326 : return 0;
11327 : #endif
11328 : }
11329 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11330 0 : if( _xparams.flags!=0x0 )
11331 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11332 0 : ae_bool result = alglib_impl::hmatrixevd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11333 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11334 0 : return *(reinterpret_cast<bool*>(&result));
11335 : }
11336 :
11337 : /*************************************************************************
11338 : Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian
11339 : matrix in a given half-interval (A, B] by using a bisection and inverse
11340 : iteration
11341 :
11342 : Input parameters:
11343 : A - Hermitian matrix which is given by its upper or lower
11344 : triangular part. Array whose indexes range within
11345 : [0..N-1, 0..N-1].
11346 : N - size of matrix A.
11347 : ZNeeded - flag controlling whether the eigenvectors are needed or
11348 : not. If ZNeeded is equal to:
11349 : * 0, the eigenvectors are not returned;
11350 : * 1, the eigenvectors are returned.
11351 : IsUpperA - storage format of matrix A.
11352 : B1, B2 - half-interval (B1, B2] to search eigenvalues in.
11353 :
11354 : Output parameters:
11355 : M - number of eigenvalues found in a given half-interval, M>=0
11356 : W - array of the eigenvalues found.
11357 : Array whose index ranges within [0..M-1].
11358 : Z - if ZNeeded is equal to:
11359 : * 0, Z hasn't changed;
11360 : * 1, Z contains eigenvectors.
11361 : Array whose indexes range within [0..N-1, 0..M-1].
11362 : The eigenvectors are stored in the matrix columns.
11363 :
11364 : Result:
11365 : True, if successful. M contains the number of eigenvalues in the given
11366 : half-interval (could be equal to 0), W contains the eigenvalues,
11367 : Z contains the eigenvectors (if needed).
11368 :
11369 : False, if the bisection method subroutine wasn't able to find the
11370 : eigenvalues in the given interval or if the inverse iteration
11371 : subroutine wasn't able to find all the corresponding eigenvectors.
11372 : In that case, the eigenvalues and eigenvectors are not returned, M is
11373 : equal to 0.
11374 :
11375 : Note:
11376 : eigen vectors of Hermitian matrix are defined up to multiplication by
11377 : a complex number L, such as |L|=1.
11378 :
11379 : -- ALGLIB --
11380 : Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey.
11381 : *************************************************************************/
11382 0 : bool hmatrixevdr(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, complex_2d_array &z, const xparams _xparams)
11383 : {
11384 : jmp_buf _break_jump;
11385 : alglib_impl::ae_state _alglib_env_state;
11386 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11387 0 : if( setjmp(_break_jump) )
11388 : {
11389 : #if !defined(AE_NO_EXCEPTIONS)
11390 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11391 : #else
11392 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11393 : return 0;
11394 : #endif
11395 : }
11396 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11397 0 : if( _xparams.flags!=0x0 )
11398 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11399 0 : ae_bool result = alglib_impl::hmatrixevdr(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11400 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11401 0 : return *(reinterpret_cast<bool*>(&result));
11402 : }
11403 :
11404 : /*************************************************************************
11405 : Subroutine for finding the eigenvalues and eigenvectors of a Hermitian
11406 : matrix with given indexes by using bisection and inverse iteration methods
11407 :
11408 : Input parameters:
11409 : A - Hermitian matrix which is given by its upper or lower
11410 : triangular part.
11411 : Array whose indexes range within [0..N-1, 0..N-1].
11412 : N - size of matrix A.
11413 : ZNeeded - flag controlling whether the eigenvectors are needed or
11414 : not. If ZNeeded is equal to:
11415 : * 0, the eigenvectors are not returned;
11416 : * 1, the eigenvectors are returned.
11417 : IsUpperA - storage format of matrix A.
11418 : I1, I2 - index interval for searching (from I1 to I2).
11419 : 0 <= I1 <= I2 <= N-1.
11420 :
11421 : Output parameters:
11422 : W - array of the eigenvalues found.
11423 : Array whose index ranges within [0..I2-I1].
11424 : Z - if ZNeeded is equal to:
11425 : * 0, Z hasn't changed;
11426 : * 1, Z contains eigenvectors.
11427 : Array whose indexes range within [0..N-1, 0..I2-I1].
11428 : In that case, the eigenvectors are stored in the matrix
11429 : columns.
11430 :
11431 : Result:
11432 : True, if successful. W contains the eigenvalues, Z contains the
11433 : eigenvectors (if needed).
11434 :
11435 : False, if the bisection method subroutine wasn't able to find the
11436 : eigenvalues in the given interval or if the inverse iteration
11437 : subroutine wasn't able to find all the corresponding eigenvectors.
11438 : In that case, the eigenvalues and eigenvectors are not returned.
11439 :
11440 : Note:
11441 : eigen vectors of Hermitian matrix are defined up to multiplication by
11442 : a complex number L, such as |L|=1.
11443 :
11444 : -- ALGLIB --
11445 : Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey.
11446 : *************************************************************************/
11447 0 : bool hmatrixevdi(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, complex_2d_array &z, const xparams _xparams)
11448 : {
11449 : jmp_buf _break_jump;
11450 : alglib_impl::ae_state _alglib_env_state;
11451 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11452 0 : if( setjmp(_break_jump) )
11453 : {
11454 : #if !defined(AE_NO_EXCEPTIONS)
11455 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11456 : #else
11457 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11458 : return 0;
11459 : #endif
11460 : }
11461 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11462 0 : if( _xparams.flags!=0x0 )
11463 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11464 0 : ae_bool result = alglib_impl::hmatrixevdi(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast<alglib_impl::ae_vector*>(w.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11465 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11466 0 : return *(reinterpret_cast<bool*>(&result));
11467 : }
11468 :
11469 : /*************************************************************************
11470 : Finding the eigenvalues and eigenvectors of a tridiagonal symmetric matrix
11471 :
11472 : The algorithm finds the eigen pairs of a tridiagonal symmetric matrix by
11473 : using an QL/QR algorithm with implicit shifts.
11474 :
11475 : ! COMMERCIAL EDITION OF ALGLIB:
11476 : !
11477 : ! Commercial Edition of ALGLIB includes following important improvements
11478 : ! of this function:
11479 : ! * high-performance native backend with same C# interface (C# version)
11480 : ! * hardware vendor (Intel) implementations of linear algebra primitives
11481 : ! (C++ and C# versions, x86/x64 platform)
11482 : !
11483 : ! We recommend you to read 'Working with commercial version' section of
11484 : ! ALGLIB Reference Manual in order to find out how to use performance-
11485 : ! related features provided by commercial edition of ALGLIB.
11486 :
11487 : Input parameters:
11488 : D - the main diagonal of a tridiagonal matrix.
11489 : Array whose index ranges within [0..N-1].
11490 : E - the secondary diagonal of a tridiagonal matrix.
11491 : Array whose index ranges within [0..N-2].
11492 : N - size of matrix A.
11493 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11494 : If ZNeeded is equal to:
11495 : * 0, the eigenvectors are not needed;
11496 : * 1, the eigenvectors of a tridiagonal matrix
11497 : are multiplied by the square matrix Z. It is used if the
11498 : tridiagonal matrix is obtained by the similarity
11499 : transformation of a symmetric matrix;
11500 : * 2, the eigenvectors of a tridiagonal matrix replace the
11501 : square matrix Z;
11502 : * 3, matrix Z contains the first row of the eigenvectors
11503 : matrix.
11504 : Z - if ZNeeded=1, Z contains the square matrix by which the
11505 : eigenvectors are multiplied.
11506 : Array whose indexes range within [0..N-1, 0..N-1].
11507 :
11508 : Output parameters:
11509 : D - eigenvalues in ascending order.
11510 : Array whose index ranges within [0..N-1].
11511 : Z - if ZNeeded is equal to:
11512 : * 0, Z hasn't changed;
11513 : * 1, Z contains the product of a given matrix (from the left)
11514 : and the eigenvectors matrix (from the right);
11515 : * 2, Z contains the eigenvectors.
11516 : * 3, Z contains the first row of the eigenvectors matrix.
11517 : If ZNeeded<3, Z is the array whose indexes range within [0..N-1, 0..N-1].
11518 : In that case, the eigenvectors are stored in the matrix columns.
11519 : If ZNeeded=3, Z is the array whose indexes range within [0..0, 0..N-1].
11520 :
11521 : Result:
11522 : True, if the algorithm has converged.
11523 : False, if the algorithm hasn't converged.
11524 :
11525 : -- LAPACK routine (version 3.0) --
11526 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
11527 : Courant Institute, Argonne National Lab, and Rice University
11528 : September 30, 1994
11529 : *************************************************************************/
11530 0 : bool smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z, const xparams _xparams)
11531 : {
11532 : jmp_buf _break_jump;
11533 : alglib_impl::ae_state _alglib_env_state;
11534 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11535 0 : if( setjmp(_break_jump) )
11536 : {
11537 : #if !defined(AE_NO_EXCEPTIONS)
11538 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11539 : #else
11540 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11541 : return 0;
11542 : #endif
11543 : }
11544 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11545 0 : if( _xparams.flags!=0x0 )
11546 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11547 0 : ae_bool result = alglib_impl::smatrixtdevd(const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), n, zneeded, const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11548 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11549 0 : return *(reinterpret_cast<bool*>(&result));
11550 : }
11551 :
11552 : /*************************************************************************
11553 : Subroutine for finding the tridiagonal matrix eigenvalues/vectors in a
11554 : given half-interval (A, B] by using bisection and inverse iteration.
11555 :
11556 : Input parameters:
11557 : D - the main diagonal of a tridiagonal matrix.
11558 : Array whose index ranges within [0..N-1].
11559 : E - the secondary diagonal of a tridiagonal matrix.
11560 : Array whose index ranges within [0..N-2].
11561 : N - size of matrix, N>=0.
11562 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11563 : If ZNeeded is equal to:
11564 : * 0, the eigenvectors are not needed;
11565 : * 1, the eigenvectors of a tridiagonal matrix are multiplied
11566 : by the square matrix Z. It is used if the tridiagonal
11567 : matrix is obtained by the similarity transformation
11568 : of a symmetric matrix.
11569 : * 2, the eigenvectors of a tridiagonal matrix replace matrix Z.
11570 : A, B - half-interval (A, B] to search eigenvalues in.
11571 : Z - if ZNeeded is equal to:
11572 : * 0, Z isn't used and remains unchanged;
11573 : * 1, Z contains the square matrix (array whose indexes range
11574 : within [0..N-1, 0..N-1]) which reduces the given symmetric
11575 : matrix to tridiagonal form;
11576 : * 2, Z isn't used (but changed on the exit).
11577 :
11578 : Output parameters:
11579 : D - array of the eigenvalues found.
11580 : Array whose index ranges within [0..M-1].
11581 : M - number of eigenvalues found in the given half-interval (M>=0).
11582 : Z - if ZNeeded is equal to:
11583 : * 0, doesn't contain any information;
11584 : * 1, contains the product of a given NxN matrix Z (from the
11585 : left) and NxM matrix of the eigenvectors found (from the
11586 : right). Array whose indexes range within [0..N-1, 0..M-1].
11587 : * 2, contains the matrix of the eigenvectors found.
11588 : Array whose indexes range within [0..N-1, 0..M-1].
11589 :
11590 : Result:
11591 :
11592 : True, if successful. In that case, M contains the number of eigenvalues
11593 : in the given half-interval (could be equal to 0), D contains the eigenvalues,
11594 : Z contains the eigenvectors (if needed).
11595 : It should be noted that the subroutine changes the size of arrays D and Z.
11596 :
11597 : False, if the bisection method subroutine wasn't able to find the
11598 : eigenvalues in the given interval or if the inverse iteration subroutine
11599 : wasn't able to find all the corresponding eigenvectors. In that case,
11600 : the eigenvalues and eigenvectors are not returned, M is equal to 0.
11601 :
11602 : -- ALGLIB --
11603 : Copyright 31.03.2008 by Bochkanov Sergey
11604 : *************************************************************************/
11605 0 : bool smatrixtdevdr(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const double a, const double b, ae_int_t &m, real_2d_array &z, const xparams _xparams)
11606 : {
11607 : jmp_buf _break_jump;
11608 : alglib_impl::ae_state _alglib_env_state;
11609 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11610 0 : if( setjmp(_break_jump) )
11611 : {
11612 : #if !defined(AE_NO_EXCEPTIONS)
11613 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11614 : #else
11615 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11616 : return 0;
11617 : #endif
11618 : }
11619 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11620 0 : if( _xparams.flags!=0x0 )
11621 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11622 0 : ae_bool result = alglib_impl::smatrixtdevdr(const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), n, zneeded, a, b, &m, const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11623 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11624 0 : return *(reinterpret_cast<bool*>(&result));
11625 : }
11626 :
11627 : /*************************************************************************
11628 : Subroutine for finding tridiagonal matrix eigenvalues/vectors with given
11629 : indexes (in ascending order) by using the bisection and inverse iteraion.
11630 :
11631 : Input parameters:
11632 : D - the main diagonal of a tridiagonal matrix.
11633 : Array whose index ranges within [0..N-1].
11634 : E - the secondary diagonal of a tridiagonal matrix.
11635 : Array whose index ranges within [0..N-2].
11636 : N - size of matrix. N>=0.
11637 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
11638 : If ZNeeded is equal to:
11639 : * 0, the eigenvectors are not needed;
11640 : * 1, the eigenvectors of a tridiagonal matrix are multiplied
11641 : by the square matrix Z. It is used if the
11642 : tridiagonal matrix is obtained by the similarity transformation
11643 : of a symmetric matrix.
11644 : * 2, the eigenvectors of a tridiagonal matrix replace
11645 : matrix Z.
11646 : I1, I2 - index interval for searching (from I1 to I2).
11647 : 0 <= I1 <= I2 <= N-1.
11648 : Z - if ZNeeded is equal to:
11649 : * 0, Z isn't used and remains unchanged;
11650 : * 1, Z contains the square matrix (array whose indexes range within [0..N-1, 0..N-1])
11651 : which reduces the given symmetric matrix to tridiagonal form;
11652 : * 2, Z isn't used (but changed on the exit).
11653 :
11654 : Output parameters:
11655 : D - array of the eigenvalues found.
11656 : Array whose index ranges within [0..I2-I1].
11657 : Z - if ZNeeded is equal to:
11658 : * 0, doesn't contain any information;
11659 : * 1, contains the product of a given NxN matrix Z (from the left) and
11660 : Nx(I2-I1) matrix of the eigenvectors found (from the right).
11661 : Array whose indexes range within [0..N-1, 0..I2-I1].
11662 : * 2, contains the matrix of the eigenvalues found.
11663 : Array whose indexes range within [0..N-1, 0..I2-I1].
11664 :
11665 :
11666 : Result:
11667 :
11668 : True, if successful. In that case, D contains the eigenvalues,
11669 : Z contains the eigenvectors (if needed).
11670 : It should be noted that the subroutine changes the size of arrays D and Z.
11671 :
11672 : False, if the bisection method subroutine wasn't able to find the eigenvalues
11673 : in the given interval or if the inverse iteration subroutine wasn't able
11674 : to find all the corresponding eigenvectors. In that case, the eigenvalues
11675 : and eigenvectors are not returned.
11676 :
11677 : -- ALGLIB --
11678 : Copyright 25.12.2005 by Bochkanov Sergey
11679 : *************************************************************************/
11680 0 : bool smatrixtdevdi(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const ae_int_t i1, const ae_int_t i2, real_2d_array &z, const xparams _xparams)
11681 : {
11682 : jmp_buf _break_jump;
11683 : alglib_impl::ae_state _alglib_env_state;
11684 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11685 0 : if( setjmp(_break_jump) )
11686 : {
11687 : #if !defined(AE_NO_EXCEPTIONS)
11688 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11689 : #else
11690 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11691 : return 0;
11692 : #endif
11693 : }
11694 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11695 0 : if( _xparams.flags!=0x0 )
11696 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11697 0 : ae_bool result = alglib_impl::smatrixtdevdi(const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_vector*>(e.c_ptr()), n, zneeded, i1, i2, const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11698 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11699 0 : return *(reinterpret_cast<bool*>(&result));
11700 : }
11701 :
11702 : /*************************************************************************
11703 : Finding eigenvalues and eigenvectors of a general (unsymmetric) matrix
11704 :
11705 : ! COMMERCIAL EDITION OF ALGLIB:
11706 : !
11707 : ! Commercial Edition of ALGLIB includes following important improvements
11708 : ! of this function:
11709 : ! * high-performance native backend with same C# interface (C# version)
11710 : ! * hardware vendor (Intel) implementations of linear algebra primitives
11711 : ! (C++ and C# versions, x86/x64 platform)
11712 : !
11713 : ! We recommend you to read 'Working with commercial version' section of
11714 : ! ALGLIB Reference Manual in order to find out how to use performance-
11715 : ! related features provided by commercial edition of ALGLIB.
11716 :
11717 : The algorithm finds eigenvalues and eigenvectors of a general matrix by
11718 : using the QR algorithm with multiple shifts. The algorithm can find
11719 : eigenvalues and both left and right eigenvectors.
11720 :
11721 : The right eigenvector is a vector x such that A*x = w*x, and the left
11722 : eigenvector is a vector y such that y'*A = w*y' (here y' implies a complex
11723 : conjugate transposition of vector y).
11724 :
11725 : Input parameters:
11726 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
11727 : N - size of matrix A.
11728 : VNeeded - flag controlling whether eigenvectors are needed or not.
11729 : If VNeeded is equal to:
11730 : * 0, eigenvectors are not returned;
11731 : * 1, right eigenvectors are returned;
11732 : * 2, left eigenvectors are returned;
11733 : * 3, both left and right eigenvectors are returned.
11734 :
11735 : Output parameters:
11736 : WR - real parts of eigenvalues.
11737 : Array whose index ranges within [0..N-1].
11738 : WR - imaginary parts of eigenvalues.
11739 : Array whose index ranges within [0..N-1].
11740 : VL, VR - arrays of left and right eigenvectors (if they are needed).
11741 : If WI[i]=0, the respective eigenvalue is a real number,
11742 : and it corresponds to the column number I of matrices VL/VR.
11743 : If WI[i]>0, we have a pair of complex conjugate numbers with
11744 : positive and negative imaginary parts:
11745 : the first eigenvalue WR[i] + sqrt(-1)*WI[i];
11746 : the second eigenvalue WR[i+1] + sqrt(-1)*WI[i+1];
11747 : WI[i]>0
11748 : WI[i+1] = -WI[i] < 0
11749 : In that case, the eigenvector corresponding to the first
11750 : eigenvalue is located in i and i+1 columns of matrices
11751 : VL/VR (the column number i contains the real part, and the
11752 : column number i+1 contains the imaginary part), and the vector
11753 : corresponding to the second eigenvalue is a complex conjugate to
11754 : the first vector.
11755 : Arrays whose indexes range within [0..N-1, 0..N-1].
11756 :
11757 : Result:
11758 : True, if the algorithm has converged.
11759 : False, if the algorithm has not converged.
11760 :
11761 : Note 1:
11762 : Some users may ask the following question: what if WI[N-1]>0?
11763 : WI[N] must contain an eigenvalue which is complex conjugate to the
11764 : N-th eigenvalue, but the array has only size N?
11765 : The answer is as follows: such a situation cannot occur because the
11766 : algorithm finds a pairs of eigenvalues, therefore, if WI[i]>0, I is
11767 : strictly less than N-1.
11768 :
11769 : Note 2:
11770 : The algorithm performance depends on the value of the internal parameter
11771 : NS of the InternalSchurDecomposition subroutine which defines the number
11772 : of shifts in the QR algorithm (similarly to the block width in block-matrix
11773 : algorithms of linear algebra). If you require maximum performance
11774 : on your machine, it is recommended to adjust this parameter manually.
11775 :
11776 :
11777 : See also the InternalTREVC subroutine.
11778 :
11779 : The algorithm is based on the LAPACK 3.0 library.
11780 : *************************************************************************/
11781 0 : bool rmatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t vneeded, real_1d_array &wr, real_1d_array &wi, real_2d_array &vl, real_2d_array &vr, const xparams _xparams)
11782 : {
11783 : jmp_buf _break_jump;
11784 : alglib_impl::ae_state _alglib_env_state;
11785 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11786 0 : if( setjmp(_break_jump) )
11787 : {
11788 : #if !defined(AE_NO_EXCEPTIONS)
11789 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11790 : #else
11791 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11792 : return 0;
11793 : #endif
11794 : }
11795 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11796 0 : if( _xparams.flags!=0x0 )
11797 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11798 0 : ae_bool result = alglib_impl::rmatrixevd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, vneeded, const_cast<alglib_impl::ae_vector*>(wr.c_ptr()), const_cast<alglib_impl::ae_vector*>(wi.c_ptr()), const_cast<alglib_impl::ae_matrix*>(vl.c_ptr()), const_cast<alglib_impl::ae_matrix*>(vr.c_ptr()), &_alglib_env_state);
11799 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11800 0 : return *(reinterpret_cast<bool*>(&result));
11801 : }
11802 : #endif
11803 :
11804 : #if defined(AE_COMPILE_SCHUR) || !defined(AE_PARTIAL_BUILD)
11805 : /*************************************************************************
11806 : Subroutine performing the Schur decomposition of a general matrix by using
11807 : the QR algorithm with multiple shifts.
11808 :
11809 : COMMERCIAL EDITION OF ALGLIB:
11810 :
11811 : ! Commercial version of ALGLIB includes one important improvement of
11812 : ! this function, which can be used from C++ and C#:
11813 : ! * Intel MKL support (lightweight Intel MKL is shipped with ALGLIB)
11814 : !
11815 : ! Intel MKL gives approximately constant (with respect to number of
11816 : ! worker threads) acceleration factor which depends on CPU being used,
11817 : ! problem size and "baseline" ALGLIB edition which is used for
11818 : ! comparison.
11819 : !
11820 : ! Multithreaded acceleration is NOT supported for this function.
11821 : !
11822 : ! We recommend you to read 'Working with commercial version' section of
11823 : ! ALGLIB Reference Manual in order to find out how to use performance-
11824 : ! related features provided by commercial edition of ALGLIB.
11825 :
11826 : The source matrix A is represented as S'*A*S = T, where S is an orthogonal
11827 : matrix (Schur vectors), T - upper quasi-triangular matrix (with blocks of
11828 : sizes 1x1 and 2x2 on the main diagonal).
11829 :
11830 : Input parameters:
11831 : A - matrix to be decomposed.
11832 : Array whose indexes range within [0..N-1, 0..N-1].
11833 : N - size of A, N>=0.
11834 :
11835 :
11836 : Output parameters:
11837 : A - contains matrix T.
11838 : Array whose indexes range within [0..N-1, 0..N-1].
11839 : S - contains Schur vectors.
11840 : Array whose indexes range within [0..N-1, 0..N-1].
11841 :
11842 : Note 1:
11843 : The block structure of matrix T can be easily recognized: since all
11844 : the elements below the blocks are zeros, the elements a[i+1,i] which
11845 : are equal to 0 show the block border.
11846 :
11847 : Note 2:
11848 : The algorithm performance depends on the value of the internal parameter
11849 : NS of the InternalSchurDecomposition subroutine which defines the number
11850 : of shifts in the QR algorithm (similarly to the block width in block-matrix
11851 : algorithms in linear algebra). If you require maximum performance on
11852 : your machine, it is recommended to adjust this parameter manually.
11853 :
11854 : Result:
11855 : True,
11856 : if the algorithm has converged and parameters A and S contain the result.
11857 : False,
11858 : if the algorithm has not converged.
11859 :
11860 : Algorithm implemented on the basis of the DHSEQR subroutine (LAPACK 3.0 library).
11861 : *************************************************************************/
11862 0 : bool rmatrixschur(real_2d_array &a, const ae_int_t n, real_2d_array &s, const xparams _xparams)
11863 : {
11864 : jmp_buf _break_jump;
11865 : alglib_impl::ae_state _alglib_env_state;
11866 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11867 0 : if( setjmp(_break_jump) )
11868 : {
11869 : #if !defined(AE_NO_EXCEPTIONS)
11870 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11871 : #else
11872 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11873 : return 0;
11874 : #endif
11875 : }
11876 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11877 0 : if( _xparams.flags!=0x0 )
11878 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11879 0 : ae_bool result = alglib_impl::rmatrixschur(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, const_cast<alglib_impl::ae_matrix*>(s.c_ptr()), &_alglib_env_state);
11880 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11881 0 : return *(reinterpret_cast<bool*>(&result));
11882 : }
11883 : #endif
11884 :
11885 : #if defined(AE_COMPILE_SPDGEVD) || !defined(AE_PARTIAL_BUILD)
11886 : /*************************************************************************
11887 : Algorithm for solving the following generalized symmetric positive-definite
11888 : eigenproblem:
11889 : A*x = lambda*B*x (1) or
11890 : A*B*x = lambda*x (2) or
11891 : B*A*x = lambda*x (3).
11892 : where A is a symmetric matrix, B - symmetric positive-definite matrix.
11893 : The problem is solved by reducing it to an ordinary symmetric eigenvalue
11894 : problem.
11895 :
11896 : Input parameters:
11897 : A - symmetric matrix which is given by its upper or lower
11898 : triangular part.
11899 : Array whose indexes range within [0..N-1, 0..N-1].
11900 : N - size of matrices A and B.
11901 : IsUpperA - storage format of matrix A.
11902 : B - symmetric positive-definite matrix which is given by
11903 : its upper or lower triangular part.
11904 : Array whose indexes range within [0..N-1, 0..N-1].
11905 : IsUpperB - storage format of matrix B.
11906 : ZNeeded - if ZNeeded is equal to:
11907 : * 0, the eigenvectors are not returned;
11908 : * 1, the eigenvectors are returned.
11909 : ProblemType - if ProblemType is equal to:
11910 : * 1, the following problem is solved: A*x = lambda*B*x;
11911 : * 2, the following problem is solved: A*B*x = lambda*x;
11912 : * 3, the following problem is solved: B*A*x = lambda*x.
11913 :
11914 : Output parameters:
11915 : D - eigenvalues in ascending order.
11916 : Array whose index ranges within [0..N-1].
11917 : Z - if ZNeeded is equal to:
11918 : * 0, Z hasn't changed;
11919 : * 1, Z contains eigenvectors.
11920 : Array whose indexes range within [0..N-1, 0..N-1].
11921 : The eigenvectors are stored in matrix columns. It should
11922 : be noted that the eigenvectors in such problems do not
11923 : form an orthogonal system.
11924 :
11925 : Result:
11926 : True, if the problem was solved successfully.
11927 : False, if the error occurred during the Cholesky decomposition of matrix
11928 : B (the matrix isn't positive-definite) or during the work of the iterative
11929 : algorithm for solving the symmetric eigenproblem.
11930 :
11931 : See also the GeneralizedSymmetricDefiniteEVDReduce subroutine.
11932 :
11933 : -- ALGLIB --
11934 : Copyright 1.28.2006 by Bochkanov Sergey
11935 : *************************************************************************/
11936 0 : bool smatrixgevd(const real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t zneeded, const ae_int_t problemtype, real_1d_array &d, real_2d_array &z, const xparams _xparams)
11937 : {
11938 : jmp_buf _break_jump;
11939 : alglib_impl::ae_state _alglib_env_state;
11940 0 : alglib_impl::ae_state_init(&_alglib_env_state);
11941 0 : if( setjmp(_break_jump) )
11942 : {
11943 : #if !defined(AE_NO_EXCEPTIONS)
11944 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
11945 : #else
11946 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
11947 : return 0;
11948 : #endif
11949 : }
11950 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
11951 0 : if( _xparams.flags!=0x0 )
11952 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
11953 0 : ae_bool result = alglib_impl::smatrixgevd(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isuppera, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), isupperb, zneeded, problemtype, const_cast<alglib_impl::ae_vector*>(d.c_ptr()), const_cast<alglib_impl::ae_matrix*>(z.c_ptr()), &_alglib_env_state);
11954 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
11955 0 : return *(reinterpret_cast<bool*>(&result));
11956 : }
11957 :
11958 : /*************************************************************************
11959 : Algorithm for reduction of the following generalized symmetric positive-
11960 : definite eigenvalue problem:
11961 : A*x = lambda*B*x (1) or
11962 : A*B*x = lambda*x (2) or
11963 : B*A*x = lambda*x (3)
11964 : to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues of this and
11965 : the given problems are the same, and the eigenvectors of the given problem
11966 : could be obtained by multiplying the obtained eigenvectors by the
11967 : transformation matrix x = R*y).
11968 :
11969 : Here A is a symmetric matrix, B - symmetric positive-definite matrix.
11970 :
11971 : Input parameters:
11972 : A - symmetric matrix which is given by its upper or lower
11973 : triangular part.
11974 : Array whose indexes range within [0..N-1, 0..N-1].
11975 : N - size of matrices A and B.
11976 : IsUpperA - storage format of matrix A.
11977 : B - symmetric positive-definite matrix which is given by
11978 : its upper or lower triangular part.
11979 : Array whose indexes range within [0..N-1, 0..N-1].
11980 : IsUpperB - storage format of matrix B.
11981 : ProblemType - if ProblemType is equal to:
11982 : * 1, the following problem is solved: A*x = lambda*B*x;
11983 : * 2, the following problem is solved: A*B*x = lambda*x;
11984 : * 3, the following problem is solved: B*A*x = lambda*x.
11985 :
11986 : Output parameters:
11987 : A - symmetric matrix which is given by its upper or lower
11988 : triangle depending on IsUpperA. Contains matrix C.
11989 : Array whose indexes range within [0..N-1, 0..N-1].
11990 : R - upper triangular or low triangular transformation matrix
11991 : which is used to obtain the eigenvectors of a given problem
11992 : as the product of eigenvectors of C (from the right) and
11993 : matrix R (from the left). If the matrix is upper
11994 : triangular, the elements below the main diagonal
11995 : are equal to 0 (and vice versa). Thus, we can perform
11996 : the multiplication without taking into account the
11997 : internal structure (which is an easier though less
11998 : effective way).
11999 : Array whose indexes range within [0..N-1, 0..N-1].
12000 : IsUpperR - type of matrix R (upper or lower triangular).
12001 :
12002 : Result:
12003 : True, if the problem was reduced successfully.
12004 : False, if the error occurred during the Cholesky decomposition of
12005 : matrix B (the matrix is not positive-definite).
12006 :
12007 : -- ALGLIB --
12008 : Copyright 1.28.2006 by Bochkanov Sergey
12009 : *************************************************************************/
12010 0 : bool smatrixgevdreduce(real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t problemtype, real_2d_array &r, bool &isupperr, const xparams _xparams)
12011 : {
12012 : jmp_buf _break_jump;
12013 : alglib_impl::ae_state _alglib_env_state;
12014 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12015 0 : if( setjmp(_break_jump) )
12016 : {
12017 : #if !defined(AE_NO_EXCEPTIONS)
12018 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12019 : #else
12020 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12021 : return 0;
12022 : #endif
12023 : }
12024 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12025 0 : if( _xparams.flags!=0x0 )
12026 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12027 0 : ae_bool result = alglib_impl::smatrixgevdreduce(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isuppera, const_cast<alglib_impl::ae_matrix*>(b.c_ptr()), isupperb, problemtype, const_cast<alglib_impl::ae_matrix*>(r.c_ptr()), &isupperr, &_alglib_env_state);
12028 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12029 0 : return *(reinterpret_cast<bool*>(&result));
12030 : }
12031 : #endif
12032 :
12033 : #if defined(AE_COMPILE_INVERSEUPDATE) || !defined(AE_PARTIAL_BUILD)
12034 : /*************************************************************************
12035 : Inverse matrix update by the Sherman-Morrison formula
12036 :
12037 : The algorithm updates matrix A^-1 when adding a number to an element
12038 : of matrix A.
12039 :
12040 : Input parameters:
12041 : InvA - inverse of matrix A.
12042 : Array whose indexes range within [0..N-1, 0..N-1].
12043 : N - size of matrix A.
12044 : UpdRow - row where the element to be updated is stored.
12045 : UpdColumn - column where the element to be updated is stored.
12046 : UpdVal - a number to be added to the element.
12047 :
12048 :
12049 : Output parameters:
12050 : InvA - inverse of modified matrix A.
12051 :
12052 : -- ALGLIB --
12053 : Copyright 2005 by Bochkanov Sergey
12054 : *************************************************************************/
12055 0 : void rmatrixinvupdatesimple(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const ae_int_t updcolumn, const double updval, const xparams _xparams)
12056 : {
12057 : jmp_buf _break_jump;
12058 : alglib_impl::ae_state _alglib_env_state;
12059 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12060 0 : if( setjmp(_break_jump) )
12061 : {
12062 : #if !defined(AE_NO_EXCEPTIONS)
12063 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12064 : #else
12065 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12066 : return;
12067 : #endif
12068 : }
12069 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12070 0 : if( _xparams.flags!=0x0 )
12071 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12072 0 : alglib_impl::rmatrixinvupdatesimple(const_cast<alglib_impl::ae_matrix*>(inva.c_ptr()), n, updrow, updcolumn, updval, &_alglib_env_state);
12073 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12074 0 : return;
12075 : }
12076 :
12077 : /*************************************************************************
12078 : Inverse matrix update by the Sherman-Morrison formula
12079 :
12080 : The algorithm updates matrix A^-1 when adding a vector to a row
12081 : of matrix A.
12082 :
12083 : Input parameters:
12084 : InvA - inverse of matrix A.
12085 : Array whose indexes range within [0..N-1, 0..N-1].
12086 : N - size of matrix A.
12087 : UpdRow - the row of A whose vector V was added.
12088 : 0 <= Row <= N-1
12089 : V - the vector to be added to a row.
12090 : Array whose index ranges within [0..N-1].
12091 :
12092 : Output parameters:
12093 : InvA - inverse of modified matrix A.
12094 :
12095 : -- ALGLIB --
12096 : Copyright 2005 by Bochkanov Sergey
12097 : *************************************************************************/
12098 0 : void rmatrixinvupdaterow(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const real_1d_array &v, const xparams _xparams)
12099 : {
12100 : jmp_buf _break_jump;
12101 : alglib_impl::ae_state _alglib_env_state;
12102 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12103 0 : if( setjmp(_break_jump) )
12104 : {
12105 : #if !defined(AE_NO_EXCEPTIONS)
12106 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12107 : #else
12108 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12109 : return;
12110 : #endif
12111 : }
12112 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12113 0 : if( _xparams.flags!=0x0 )
12114 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12115 0 : alglib_impl::rmatrixinvupdaterow(const_cast<alglib_impl::ae_matrix*>(inva.c_ptr()), n, updrow, const_cast<alglib_impl::ae_vector*>(v.c_ptr()), &_alglib_env_state);
12116 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12117 0 : return;
12118 : }
12119 :
12120 : /*************************************************************************
12121 : Inverse matrix update by the Sherman-Morrison formula
12122 :
12123 : The algorithm updates matrix A^-1 when adding a vector to a column
12124 : of matrix A.
12125 :
12126 : Input parameters:
12127 : InvA - inverse of matrix A.
12128 : Array whose indexes range within [0..N-1, 0..N-1].
12129 : N - size of matrix A.
12130 : UpdColumn - the column of A whose vector U was added.
12131 : 0 <= UpdColumn <= N-1
12132 : U - the vector to be added to a column.
12133 : Array whose index ranges within [0..N-1].
12134 :
12135 : Output parameters:
12136 : InvA - inverse of modified matrix A.
12137 :
12138 : -- ALGLIB --
12139 : Copyright 2005 by Bochkanov Sergey
12140 : *************************************************************************/
12141 0 : void rmatrixinvupdatecolumn(real_2d_array &inva, const ae_int_t n, const ae_int_t updcolumn, const real_1d_array &u, const xparams _xparams)
12142 : {
12143 : jmp_buf _break_jump;
12144 : alglib_impl::ae_state _alglib_env_state;
12145 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12146 0 : if( setjmp(_break_jump) )
12147 : {
12148 : #if !defined(AE_NO_EXCEPTIONS)
12149 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12150 : #else
12151 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12152 : return;
12153 : #endif
12154 : }
12155 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12156 0 : if( _xparams.flags!=0x0 )
12157 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12158 0 : alglib_impl::rmatrixinvupdatecolumn(const_cast<alglib_impl::ae_matrix*>(inva.c_ptr()), n, updcolumn, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), &_alglib_env_state);
12159 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12160 0 : return;
12161 : }
12162 :
12163 : /*************************************************************************
12164 : Inverse matrix update by the Sherman-Morrison formula
12165 :
12166 : The algorithm computes the inverse of matrix A+u*v' by using the given matrix
12167 : A^-1 and the vectors u and v.
12168 :
12169 : Input parameters:
12170 : InvA - inverse of matrix A.
12171 : Array whose indexes range within [0..N-1, 0..N-1].
12172 : N - size of matrix A.
12173 : U - the vector modifying the matrix.
12174 : Array whose index ranges within [0..N-1].
12175 : V - the vector modifying the matrix.
12176 : Array whose index ranges within [0..N-1].
12177 :
12178 : Output parameters:
12179 : InvA - inverse of matrix A + u*v'.
12180 :
12181 : -- ALGLIB --
12182 : Copyright 2005 by Bochkanov Sergey
12183 : *************************************************************************/
12184 0 : void rmatrixinvupdateuv(real_2d_array &inva, const ae_int_t n, const real_1d_array &u, const real_1d_array &v, const xparams _xparams)
12185 : {
12186 : jmp_buf _break_jump;
12187 : alglib_impl::ae_state _alglib_env_state;
12188 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12189 0 : if( setjmp(_break_jump) )
12190 : {
12191 : #if !defined(AE_NO_EXCEPTIONS)
12192 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12193 : #else
12194 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12195 : return;
12196 : #endif
12197 : }
12198 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12199 0 : if( _xparams.flags!=0x0 )
12200 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12201 0 : alglib_impl::rmatrixinvupdateuv(const_cast<alglib_impl::ae_matrix*>(inva.c_ptr()), n, const_cast<alglib_impl::ae_vector*>(u.c_ptr()), const_cast<alglib_impl::ae_vector*>(v.c_ptr()), &_alglib_env_state);
12202 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12203 0 : return;
12204 : }
12205 : #endif
12206 :
12207 : #if defined(AE_COMPILE_MATDET) || !defined(AE_PARTIAL_BUILD)
12208 : /*************************************************************************
12209 : Determinant calculation of the matrix given by its LU decomposition.
12210 :
12211 : Input parameters:
12212 : A - LU decomposition of the matrix (output of
12213 : RMatrixLU subroutine).
12214 : Pivots - table of permutations which were made during
12215 : the LU decomposition.
12216 : Output of RMatrixLU subroutine.
12217 : N - (optional) size of matrix A:
12218 : * if given, only principal NxN submatrix is processed and
12219 : overwritten. other elements are unchanged.
12220 : * if not given, automatically determined from matrix size
12221 : (A must be square matrix)
12222 :
12223 : Result: matrix determinant.
12224 :
12225 : -- ALGLIB --
12226 : Copyright 2005 by Bochkanov Sergey
12227 : *************************************************************************/
12228 0 : double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, const xparams _xparams)
12229 : {
12230 : jmp_buf _break_jump;
12231 : alglib_impl::ae_state _alglib_env_state;
12232 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12233 0 : if( setjmp(_break_jump) )
12234 : {
12235 : #if !defined(AE_NO_EXCEPTIONS)
12236 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12237 : #else
12238 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12239 : return 0;
12240 : #endif
12241 : }
12242 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12243 0 : if( _xparams.flags!=0x0 )
12244 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12245 0 : double result = alglib_impl::rmatrixludet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &_alglib_env_state);
12246 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12247 0 : return *(reinterpret_cast<double*>(&result));
12248 : }
12249 :
12250 : /*************************************************************************
12251 : Determinant calculation of the matrix given by its LU decomposition.
12252 :
12253 : Input parameters:
12254 : A - LU decomposition of the matrix (output of
12255 : RMatrixLU subroutine).
12256 : Pivots - table of permutations which were made during
12257 : the LU decomposition.
12258 : Output of RMatrixLU subroutine.
12259 : N - (optional) size of matrix A:
12260 : * if given, only principal NxN submatrix is processed and
12261 : overwritten. other elements are unchanged.
12262 : * if not given, automatically determined from matrix size
12263 : (A must be square matrix)
12264 :
12265 : Result: matrix determinant.
12266 :
12267 : -- ALGLIB --
12268 : Copyright 2005 by Bochkanov Sergey
12269 : *************************************************************************/
12270 : #if !defined(AE_NO_EXCEPTIONS)
12271 0 : double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const xparams _xparams)
12272 : {
12273 : jmp_buf _break_jump;
12274 : alglib_impl::ae_state _alglib_env_state;
12275 : ae_int_t n;
12276 0 : if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length()))
12277 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'rmatrixludet': looks like one of arguments has wrong size");
12278 0 : n = a.rows();
12279 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12280 0 : if( setjmp(_break_jump) )
12281 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12282 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12283 0 : if( _xparams.flags!=0x0 )
12284 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12285 0 : double result = alglib_impl::rmatrixludet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &_alglib_env_state);
12286 :
12287 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12288 0 : return *(reinterpret_cast<double*>(&result));
12289 : }
12290 : #endif
12291 :
12292 : /*************************************************************************
12293 : Calculation of the determinant of a general matrix
12294 :
12295 : Input parameters:
12296 : A - matrix, array[0..N-1, 0..N-1]
12297 : N - (optional) size of matrix A:
12298 : * if given, only principal NxN submatrix is processed and
12299 : overwritten. other elements are unchanged.
12300 : * if not given, automatically determined from matrix size
12301 : (A must be square matrix)
12302 :
12303 : Result: determinant of matrix A.
12304 :
12305 : -- ALGLIB --
12306 : Copyright 2005 by Bochkanov Sergey
12307 : *************************************************************************/
12308 0 : double rmatrixdet(const real_2d_array &a, const ae_int_t n, const xparams _xparams)
12309 : {
12310 : jmp_buf _break_jump;
12311 : alglib_impl::ae_state _alglib_env_state;
12312 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12313 0 : if( setjmp(_break_jump) )
12314 : {
12315 : #if !defined(AE_NO_EXCEPTIONS)
12316 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12317 : #else
12318 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12319 : return 0;
12320 : #endif
12321 : }
12322 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12323 0 : if( _xparams.flags!=0x0 )
12324 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12325 0 : double result = alglib_impl::rmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12326 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12327 0 : return *(reinterpret_cast<double*>(&result));
12328 : }
12329 :
12330 : /*************************************************************************
12331 : Calculation of the determinant of a general matrix
12332 :
12333 : Input parameters:
12334 : A - matrix, array[0..N-1, 0..N-1]
12335 : N - (optional) size of matrix A:
12336 : * if given, only principal NxN submatrix is processed and
12337 : overwritten. other elements are unchanged.
12338 : * if not given, automatically determined from matrix size
12339 : (A must be square matrix)
12340 :
12341 : Result: determinant of matrix A.
12342 :
12343 : -- ALGLIB --
12344 : Copyright 2005 by Bochkanov Sergey
12345 : *************************************************************************/
12346 : #if !defined(AE_NO_EXCEPTIONS)
12347 0 : double rmatrixdet(const real_2d_array &a, const xparams _xparams)
12348 : {
12349 : jmp_buf _break_jump;
12350 : alglib_impl::ae_state _alglib_env_state;
12351 : ae_int_t n;
12352 0 : if( (a.rows()!=a.cols()))
12353 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'rmatrixdet': looks like one of arguments has wrong size");
12354 0 : n = a.rows();
12355 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12356 0 : if( setjmp(_break_jump) )
12357 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12358 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12359 0 : if( _xparams.flags!=0x0 )
12360 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12361 0 : double result = alglib_impl::rmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12362 :
12363 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12364 0 : return *(reinterpret_cast<double*>(&result));
12365 : }
12366 : #endif
12367 :
12368 : /*************************************************************************
12369 : Determinant calculation of the matrix given by its LU decomposition.
12370 :
12371 : Input parameters:
12372 : A - LU decomposition of the matrix (output of
12373 : RMatrixLU subroutine).
12374 : Pivots - table of permutations which were made during
12375 : the LU decomposition.
12376 : Output of RMatrixLU subroutine.
12377 : N - (optional) size of matrix A:
12378 : * if given, only principal NxN submatrix is processed and
12379 : overwritten. other elements are unchanged.
12380 : * if not given, automatically determined from matrix size
12381 : (A must be square matrix)
12382 :
12383 : Result: matrix determinant.
12384 :
12385 : -- ALGLIB --
12386 : Copyright 2005 by Bochkanov Sergey
12387 : *************************************************************************/
12388 0 : alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, const xparams _xparams)
12389 : {
12390 : jmp_buf _break_jump;
12391 : alglib_impl::ae_state _alglib_env_state;
12392 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12393 0 : if( setjmp(_break_jump) )
12394 : {
12395 : #if !defined(AE_NO_EXCEPTIONS)
12396 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12397 : #else
12398 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12399 : return 0;
12400 : #endif
12401 : }
12402 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12403 0 : if( _xparams.flags!=0x0 )
12404 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12405 0 : alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &_alglib_env_state);
12406 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12407 0 : return *(reinterpret_cast<alglib::complex*>(&result));
12408 : }
12409 :
12410 : /*************************************************************************
12411 : Determinant calculation of the matrix given by its LU decomposition.
12412 :
12413 : Input parameters:
12414 : A - LU decomposition of the matrix (output of
12415 : RMatrixLU subroutine).
12416 : Pivots - table of permutations which were made during
12417 : the LU decomposition.
12418 : Output of RMatrixLU subroutine.
12419 : N - (optional) size of matrix A:
12420 : * if given, only principal NxN submatrix is processed and
12421 : overwritten. other elements are unchanged.
12422 : * if not given, automatically determined from matrix size
12423 : (A must be square matrix)
12424 :
12425 : Result: matrix determinant.
12426 :
12427 : -- ALGLIB --
12428 : Copyright 2005 by Bochkanov Sergey
12429 : *************************************************************************/
12430 : #if !defined(AE_NO_EXCEPTIONS)
12431 0 : alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const xparams _xparams)
12432 : {
12433 : jmp_buf _break_jump;
12434 : alglib_impl::ae_state _alglib_env_state;
12435 : ae_int_t n;
12436 0 : if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length()))
12437 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'cmatrixludet': looks like one of arguments has wrong size");
12438 0 : n = a.rows();
12439 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12440 0 : if( setjmp(_break_jump) )
12441 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12442 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12443 0 : if( _xparams.flags!=0x0 )
12444 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12445 0 : alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), const_cast<alglib_impl::ae_vector*>(pivots.c_ptr()), n, &_alglib_env_state);
12446 :
12447 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12448 0 : return *(reinterpret_cast<alglib::complex*>(&result));
12449 : }
12450 : #endif
12451 :
12452 : /*************************************************************************
12453 : Calculation of the determinant of a general matrix
12454 :
12455 : Input parameters:
12456 : A - matrix, array[0..N-1, 0..N-1]
12457 : N - (optional) size of matrix A:
12458 : * if given, only principal NxN submatrix is processed and
12459 : overwritten. other elements are unchanged.
12460 : * if not given, automatically determined from matrix size
12461 : (A must be square matrix)
12462 :
12463 : Result: determinant of matrix A.
12464 :
12465 : -- ALGLIB --
12466 : Copyright 2005 by Bochkanov Sergey
12467 : *************************************************************************/
12468 0 : alglib::complex cmatrixdet(const complex_2d_array &a, const ae_int_t n, const xparams _xparams)
12469 : {
12470 : jmp_buf _break_jump;
12471 : alglib_impl::ae_state _alglib_env_state;
12472 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12473 0 : if( setjmp(_break_jump) )
12474 : {
12475 : #if !defined(AE_NO_EXCEPTIONS)
12476 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12477 : #else
12478 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12479 : return 0;
12480 : #endif
12481 : }
12482 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12483 0 : if( _xparams.flags!=0x0 )
12484 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12485 0 : alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12486 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12487 0 : return *(reinterpret_cast<alglib::complex*>(&result));
12488 : }
12489 :
12490 : /*************************************************************************
12491 : Calculation of the determinant of a general matrix
12492 :
12493 : Input parameters:
12494 : A - matrix, array[0..N-1, 0..N-1]
12495 : N - (optional) size of matrix A:
12496 : * if given, only principal NxN submatrix is processed and
12497 : overwritten. other elements are unchanged.
12498 : * if not given, automatically determined from matrix size
12499 : (A must be square matrix)
12500 :
12501 : Result: determinant of matrix A.
12502 :
12503 : -- ALGLIB --
12504 : Copyright 2005 by Bochkanov Sergey
12505 : *************************************************************************/
12506 : #if !defined(AE_NO_EXCEPTIONS)
12507 0 : alglib::complex cmatrixdet(const complex_2d_array &a, const xparams _xparams)
12508 : {
12509 : jmp_buf _break_jump;
12510 : alglib_impl::ae_state _alglib_env_state;
12511 : ae_int_t n;
12512 0 : if( (a.rows()!=a.cols()))
12513 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'cmatrixdet': looks like one of arguments has wrong size");
12514 0 : n = a.rows();
12515 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12516 0 : if( setjmp(_break_jump) )
12517 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12518 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12519 0 : if( _xparams.flags!=0x0 )
12520 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12521 0 : alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12522 :
12523 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12524 0 : return *(reinterpret_cast<alglib::complex*>(&result));
12525 : }
12526 : #endif
12527 :
12528 : /*************************************************************************
12529 : Determinant calculation of the matrix given by the Cholesky decomposition.
12530 :
12531 : Input parameters:
12532 : A - Cholesky decomposition,
12533 : output of SMatrixCholesky subroutine.
12534 : N - (optional) size of matrix A:
12535 : * if given, only principal NxN submatrix is processed and
12536 : overwritten. other elements are unchanged.
12537 : * if not given, automatically determined from matrix size
12538 : (A must be square matrix)
12539 :
12540 : As the determinant is equal to the product of squares of diagonal elements,
12541 : it's not necessary to specify which triangle - lower or upper - the matrix
12542 : is stored in.
12543 :
12544 : Result:
12545 : matrix determinant.
12546 :
12547 : -- ALGLIB --
12548 : Copyright 2005-2008 by Bochkanov Sergey
12549 : *************************************************************************/
12550 0 : double spdmatrixcholeskydet(const real_2d_array &a, const ae_int_t n, const xparams _xparams)
12551 : {
12552 : jmp_buf _break_jump;
12553 : alglib_impl::ae_state _alglib_env_state;
12554 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12555 0 : if( setjmp(_break_jump) )
12556 : {
12557 : #if !defined(AE_NO_EXCEPTIONS)
12558 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12559 : #else
12560 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12561 : return 0;
12562 : #endif
12563 : }
12564 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12565 0 : if( _xparams.flags!=0x0 )
12566 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12567 0 : double result = alglib_impl::spdmatrixcholeskydet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12568 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12569 0 : return *(reinterpret_cast<double*>(&result));
12570 : }
12571 :
12572 : /*************************************************************************
12573 : Determinant calculation of the matrix given by the Cholesky decomposition.
12574 :
12575 : Input parameters:
12576 : A - Cholesky decomposition,
12577 : output of SMatrixCholesky subroutine.
12578 : N - (optional) size of matrix A:
12579 : * if given, only principal NxN submatrix is processed and
12580 : overwritten. other elements are unchanged.
12581 : * if not given, automatically determined from matrix size
12582 : (A must be square matrix)
12583 :
12584 : As the determinant is equal to the product of squares of diagonal elements,
12585 : it's not necessary to specify which triangle - lower or upper - the matrix
12586 : is stored in.
12587 :
12588 : Result:
12589 : matrix determinant.
12590 :
12591 : -- ALGLIB --
12592 : Copyright 2005-2008 by Bochkanov Sergey
12593 : *************************************************************************/
12594 : #if !defined(AE_NO_EXCEPTIONS)
12595 0 : double spdmatrixcholeskydet(const real_2d_array &a, const xparams _xparams)
12596 : {
12597 : jmp_buf _break_jump;
12598 : alglib_impl::ae_state _alglib_env_state;
12599 : ae_int_t n;
12600 0 : if( (a.rows()!=a.cols()))
12601 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'spdmatrixcholeskydet': looks like one of arguments has wrong size");
12602 0 : n = a.rows();
12603 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12604 0 : if( setjmp(_break_jump) )
12605 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12606 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12607 0 : if( _xparams.flags!=0x0 )
12608 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12609 0 : double result = alglib_impl::spdmatrixcholeskydet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, &_alglib_env_state);
12610 :
12611 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12612 0 : return *(reinterpret_cast<double*>(&result));
12613 : }
12614 : #endif
12615 :
12616 : /*************************************************************************
12617 : Determinant calculation of the symmetric positive definite matrix.
12618 :
12619 : Input parameters:
12620 : A - matrix. Array with elements [0..N-1, 0..N-1].
12621 : N - (optional) size of matrix A:
12622 : * if given, only principal NxN submatrix is processed and
12623 : overwritten. other elements are unchanged.
12624 : * if not given, automatically determined from matrix size
12625 : (A must be square matrix)
12626 : IsUpper - (optional) storage type:
12627 : * if True, symmetric matrix A is given by its upper
12628 : triangle, and the lower triangle isn't used/changed by
12629 : function
12630 : * if False, symmetric matrix A is given by its lower
12631 : triangle, and the upper triangle isn't used/changed by
12632 : function
12633 : * if not given, both lower and upper triangles must be
12634 : filled.
12635 :
12636 : Result:
12637 : determinant of matrix A.
12638 : If matrix A is not positive definite, exception is thrown.
12639 :
12640 : -- ALGLIB --
12641 : Copyright 2005-2008 by Bochkanov Sergey
12642 : *************************************************************************/
12643 0 : double spdmatrixdet(const real_2d_array &a, const ae_int_t n, const bool isupper, const xparams _xparams)
12644 : {
12645 : jmp_buf _break_jump;
12646 : alglib_impl::ae_state _alglib_env_state;
12647 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12648 0 : if( setjmp(_break_jump) )
12649 : {
12650 : #if !defined(AE_NO_EXCEPTIONS)
12651 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12652 : #else
12653 : _ALGLIB_SET_ERROR_FLAG(_alglib_env_state.error_msg);
12654 : return 0;
12655 : #endif
12656 : }
12657 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12658 0 : if( _xparams.flags!=0x0 )
12659 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12660 0 : double result = alglib_impl::spdmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
12661 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12662 0 : return *(reinterpret_cast<double*>(&result));
12663 : }
12664 :
12665 : /*************************************************************************
12666 : Determinant calculation of the symmetric positive definite matrix.
12667 :
12668 : Input parameters:
12669 : A - matrix. Array with elements [0..N-1, 0..N-1].
12670 : N - (optional) size of matrix A:
12671 : * if given, only principal NxN submatrix is processed and
12672 : overwritten. other elements are unchanged.
12673 : * if not given, automatically determined from matrix size
12674 : (A must be square matrix)
12675 : IsUpper - (optional) storage type:
12676 : * if True, symmetric matrix A is given by its upper
12677 : triangle, and the lower triangle isn't used/changed by
12678 : function
12679 : * if False, symmetric matrix A is given by its lower
12680 : triangle, and the upper triangle isn't used/changed by
12681 : function
12682 : * if not given, both lower and upper triangles must be
12683 : filled.
12684 :
12685 : Result:
12686 : determinant of matrix A.
12687 : If matrix A is not positive definite, exception is thrown.
12688 :
12689 : -- ALGLIB --
12690 : Copyright 2005-2008 by Bochkanov Sergey
12691 : *************************************************************************/
12692 : #if !defined(AE_NO_EXCEPTIONS)
12693 0 : double spdmatrixdet(const real_2d_array &a, const xparams _xparams)
12694 : {
12695 : jmp_buf _break_jump;
12696 : alglib_impl::ae_state _alglib_env_state;
12697 : ae_int_t n;
12698 : bool isupper;
12699 0 : if( (a.rows()!=a.cols()))
12700 0 : _ALGLIB_CPP_EXCEPTION("Error while calling 'spdmatrixdet': looks like one of arguments has wrong size");
12701 0 : if( !alglib_impl::ae_is_symmetric(const_cast<alglib_impl::ae_matrix*>(a.c_ptr())) )
12702 0 : _ALGLIB_CPP_EXCEPTION("'a' parameter is not symmetric matrix");
12703 0 : n = a.rows();
12704 0 : isupper = false;
12705 0 : alglib_impl::ae_state_init(&_alglib_env_state);
12706 0 : if( setjmp(_break_jump) )
12707 0 : _ALGLIB_CPP_EXCEPTION(_alglib_env_state.error_msg);
12708 0 : ae_state_set_break_jump(&_alglib_env_state, &_break_jump);
12709 0 : if( _xparams.flags!=0x0 )
12710 0 : ae_state_set_flags(&_alglib_env_state, _xparams.flags);
12711 0 : double result = alglib_impl::spdmatrixdet(const_cast<alglib_impl::ae_matrix*>(a.c_ptr()), n, isupper, &_alglib_env_state);
12712 :
12713 0 : alglib_impl::ae_state_clear(&_alglib_env_state);
12714 0 : return *(reinterpret_cast<double*>(&result));
12715 : }
12716 : #endif
12717 : #endif
12718 : }
12719 :
12720 : /////////////////////////////////////////////////////////////////////////
12721 : //
12722 : // THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE
12723 : //
12724 : /////////////////////////////////////////////////////////////////////////
12725 : namespace alglib_impl
12726 : {
12727 : #if defined(AE_COMPILE_SPARSE) || !defined(AE_PARTIAL_BUILD)
12728 : static double sparse_desiredloadfactor = 0.66;
12729 : static double sparse_maxloadfactor = 0.75;
12730 : static double sparse_growfactor = 2.00;
12731 : static ae_int_t sparse_additional = 10;
12732 : static ae_int_t sparse_linalgswitch = 16;
12733 : static ae_int_t sparse_hash(ae_int_t i,
12734 : ae_int_t j,
12735 : ae_int_t tabsize,
12736 : ae_state *_state);
12737 :
12738 :
12739 : #endif
12740 : #if defined(AE_COMPILE_ABLAS) || !defined(AE_PARTIAL_BUILD)
12741 : static ae_int_t ablas_blas2minvendorkernelsize = 8;
12742 : static void ablas_ablasinternalsplitlength(ae_int_t n,
12743 : ae_int_t nb,
12744 : ae_int_t* n1,
12745 : ae_int_t* n2,
12746 : ae_state *_state);
12747 : static void ablas_cmatrixrighttrsm2(ae_int_t m,
12748 : ae_int_t n,
12749 : /* Complex */ ae_matrix* a,
12750 : ae_int_t i1,
12751 : ae_int_t j1,
12752 : ae_bool isupper,
12753 : ae_bool isunit,
12754 : ae_int_t optype,
12755 : /* Complex */ ae_matrix* x,
12756 : ae_int_t i2,
12757 : ae_int_t j2,
12758 : ae_state *_state);
12759 : static void ablas_cmatrixlefttrsm2(ae_int_t m,
12760 : ae_int_t n,
12761 : /* Complex */ ae_matrix* a,
12762 : ae_int_t i1,
12763 : ae_int_t j1,
12764 : ae_bool isupper,
12765 : ae_bool isunit,
12766 : ae_int_t optype,
12767 : /* Complex */ ae_matrix* x,
12768 : ae_int_t i2,
12769 : ae_int_t j2,
12770 : ae_state *_state);
12771 : static void ablas_rmatrixrighttrsm2(ae_int_t m,
12772 : ae_int_t n,
12773 : /* Real */ ae_matrix* a,
12774 : ae_int_t i1,
12775 : ae_int_t j1,
12776 : ae_bool isupper,
12777 : ae_bool isunit,
12778 : ae_int_t optype,
12779 : /* Real */ ae_matrix* x,
12780 : ae_int_t i2,
12781 : ae_int_t j2,
12782 : ae_state *_state);
12783 : static void ablas_rmatrixlefttrsm2(ae_int_t m,
12784 : ae_int_t n,
12785 : /* Real */ ae_matrix* a,
12786 : ae_int_t i1,
12787 : ae_int_t j1,
12788 : ae_bool isupper,
12789 : ae_bool isunit,
12790 : ae_int_t optype,
12791 : /* Real */ ae_matrix* x,
12792 : ae_int_t i2,
12793 : ae_int_t j2,
12794 : ae_state *_state);
12795 : static void ablas_cmatrixherk2(ae_int_t n,
12796 : ae_int_t k,
12797 : double alpha,
12798 : /* Complex */ ae_matrix* a,
12799 : ae_int_t ia,
12800 : ae_int_t ja,
12801 : ae_int_t optypea,
12802 : double beta,
12803 : /* Complex */ ae_matrix* c,
12804 : ae_int_t ic,
12805 : ae_int_t jc,
12806 : ae_bool isupper,
12807 : ae_state *_state);
12808 : static void ablas_rmatrixsyrk2(ae_int_t n,
12809 : ae_int_t k,
12810 : double alpha,
12811 : /* Real */ ae_matrix* a,
12812 : ae_int_t ia,
12813 : ae_int_t ja,
12814 : ae_int_t optypea,
12815 : double beta,
12816 : /* Real */ ae_matrix* c,
12817 : ae_int_t ic,
12818 : ae_int_t jc,
12819 : ae_bool isupper,
12820 : ae_state *_state);
12821 : static void ablas_cmatrixgemmrec(ae_int_t m,
12822 : ae_int_t n,
12823 : ae_int_t k,
12824 : ae_complex alpha,
12825 : /* Complex */ ae_matrix* a,
12826 : ae_int_t ia,
12827 : ae_int_t ja,
12828 : ae_int_t optypea,
12829 : /* Complex */ ae_matrix* b,
12830 : ae_int_t ib,
12831 : ae_int_t jb,
12832 : ae_int_t optypeb,
12833 : ae_complex beta,
12834 : /* Complex */ ae_matrix* c,
12835 : ae_int_t ic,
12836 : ae_int_t jc,
12837 : ae_state *_state);
12838 : ae_bool _trypexec_ablas_cmatrixgemmrec(ae_int_t m,
12839 : ae_int_t n,
12840 : ae_int_t k,
12841 : ae_complex alpha,
12842 : /* Complex */ ae_matrix* a,
12843 : ae_int_t ia,
12844 : ae_int_t ja,
12845 : ae_int_t optypea,
12846 : /* Complex */ ae_matrix* b,
12847 : ae_int_t ib,
12848 : ae_int_t jb,
12849 : ae_int_t optypeb,
12850 : ae_complex beta,
12851 : /* Complex */ ae_matrix* c,
12852 : ae_int_t ic,
12853 : ae_int_t jc, ae_state *_state);
12854 : static void ablas_rmatrixgemmrec(ae_int_t m,
12855 : ae_int_t n,
12856 : ae_int_t k,
12857 : double alpha,
12858 : /* Real */ ae_matrix* a,
12859 : ae_int_t ia,
12860 : ae_int_t ja,
12861 : ae_int_t optypea,
12862 : /* Real */ ae_matrix* b,
12863 : ae_int_t ib,
12864 : ae_int_t jb,
12865 : ae_int_t optypeb,
12866 : double beta,
12867 : /* Real */ ae_matrix* c,
12868 : ae_int_t ic,
12869 : ae_int_t jc,
12870 : ae_state *_state);
12871 : ae_bool _trypexec_ablas_rmatrixgemmrec(ae_int_t m,
12872 : ae_int_t n,
12873 : ae_int_t k,
12874 : double alpha,
12875 : /* Real */ ae_matrix* a,
12876 : ae_int_t ia,
12877 : ae_int_t ja,
12878 : ae_int_t optypea,
12879 : /* Real */ ae_matrix* b,
12880 : ae_int_t ib,
12881 : ae_int_t jb,
12882 : ae_int_t optypeb,
12883 : double beta,
12884 : /* Real */ ae_matrix* c,
12885 : ae_int_t ic,
12886 : ae_int_t jc, ae_state *_state);
12887 :
12888 :
12889 : #endif
12890 : #if defined(AE_COMPILE_DLU) || !defined(AE_PARTIAL_BUILD)
12891 : static void dlu_cmatrixlup2(/* Complex */ ae_matrix* a,
12892 : ae_int_t offs,
12893 : ae_int_t m,
12894 : ae_int_t n,
12895 : /* Integer */ ae_vector* pivots,
12896 : /* Complex */ ae_vector* tmp,
12897 : ae_state *_state);
12898 : static void dlu_rmatrixlup2(/* Real */ ae_matrix* a,
12899 : ae_int_t offs,
12900 : ae_int_t m,
12901 : ae_int_t n,
12902 : /* Integer */ ae_vector* pivots,
12903 : /* Real */ ae_vector* tmp,
12904 : ae_state *_state);
12905 : static void dlu_cmatrixplu2(/* Complex */ ae_matrix* a,
12906 : ae_int_t offs,
12907 : ae_int_t m,
12908 : ae_int_t n,
12909 : /* Integer */ ae_vector* pivots,
12910 : /* Complex */ ae_vector* tmp,
12911 : ae_state *_state);
12912 : static void dlu_rmatrixplu2(/* Real */ ae_matrix* a,
12913 : ae_int_t offs,
12914 : ae_int_t m,
12915 : ae_int_t n,
12916 : /* Integer */ ae_vector* pivots,
12917 : /* Real */ ae_vector* tmp,
12918 : ae_state *_state);
12919 :
12920 :
12921 : #endif
12922 : #if defined(AE_COMPILE_SPTRF) || !defined(AE_PARTIAL_BUILD)
12923 : static double sptrf_densebnd = 0.10;
12924 : static ae_int_t sptrf_slswidth = 8;
12925 : static void sptrf_sluv2list1init(ae_int_t n,
12926 : sluv2list1matrix* a,
12927 : ae_state *_state);
12928 : static void sptrf_sluv2list1swap(sluv2list1matrix* a,
12929 : ae_int_t i,
12930 : ae_int_t j,
12931 : ae_state *_state);
12932 : static void sptrf_sluv2list1dropsequence(sluv2list1matrix* a,
12933 : ae_int_t i,
12934 : ae_state *_state);
12935 : static void sptrf_sluv2list1appendsequencetomatrix(sluv2list1matrix* a,
12936 : ae_int_t src,
12937 : ae_bool hasdiagonal,
12938 : double d,
12939 : ae_int_t nzmax,
12940 : sparsematrix* s,
12941 : ae_int_t dst,
12942 : ae_state *_state);
12943 : static void sptrf_sluv2list1pushsparsevector(sluv2list1matrix* a,
12944 : /* Integer */ ae_vector* si,
12945 : /* Real */ ae_vector* sv,
12946 : ae_int_t nz,
12947 : ae_state *_state);
12948 : static void sptrf_densetrailinit(sluv2densetrail* d,
12949 : ae_int_t n,
12950 : ae_state *_state);
12951 : static void sptrf_densetrailappendcolumn(sluv2densetrail* d,
12952 : /* Real */ ae_vector* x,
12953 : ae_int_t id,
12954 : ae_state *_state);
12955 : static void sptrf_sparsetrailinit(sparsematrix* s,
12956 : sluv2sparsetrail* a,
12957 : ae_state *_state);
12958 : static ae_bool sptrf_sparsetrailfindpivot(sluv2sparsetrail* a,
12959 : ae_int_t pivottype,
12960 : ae_int_t* ipiv,
12961 : ae_int_t* jpiv,
12962 : ae_state *_state);
12963 : static void sptrf_sparsetrailpivotout(sluv2sparsetrail* a,
12964 : ae_int_t ipiv,
12965 : ae_int_t jpiv,
12966 : double* uu,
12967 : /* Integer */ ae_vector* v0i,
12968 : /* Real */ ae_vector* v0r,
12969 : ae_int_t* nz0,
12970 : /* Integer */ ae_vector* v1i,
12971 : /* Real */ ae_vector* v1r,
12972 : ae_int_t* nz1,
12973 : ae_state *_state);
12974 : static void sptrf_sparsetraildensify(sluv2sparsetrail* a,
12975 : ae_int_t i1,
12976 : sluv2list1matrix* bupper,
12977 : sluv2densetrail* dtrail,
12978 : ae_state *_state);
12979 : static void sptrf_sparsetrailupdate(sluv2sparsetrail* a,
12980 : /* Integer */ ae_vector* v0i,
12981 : /* Real */ ae_vector* v0r,
12982 : ae_int_t nz0,
12983 : /* Integer */ ae_vector* v1i,
12984 : /* Real */ ae_vector* v1r,
12985 : ae_int_t nz1,
12986 : sluv2list1matrix* bupper,
12987 : sluv2densetrail* dtrail,
12988 : ae_bool densificationsupported,
12989 : ae_state *_state);
12990 :
12991 :
12992 : #endif
12993 : #if defined(AE_COMPILE_AMDORDERING) || !defined(AE_PARTIAL_BUILD)
12994 : static ae_int_t amdordering_knsheadersize = 2;
12995 : static ae_int_t amdordering_llmentrysize = 6;
12996 : static void amdordering_nsinitemptyslow(ae_int_t n,
12997 : amdnset* sa,
12998 : ae_state *_state);
12999 : static void amdordering_nscopy(amdnset* ssrc,
13000 : amdnset* sdst,
13001 : ae_state *_state);
13002 : static void amdordering_nsaddelement(amdnset* sa,
13003 : ae_int_t k,
13004 : ae_state *_state);
13005 : static void amdordering_nsaddkth(amdnset* sa,
13006 : amdknset* src,
13007 : ae_int_t k,
13008 : ae_state *_state);
13009 : static void amdordering_nssubtractkth(amdnset* sa,
13010 : amdknset* src,
13011 : ae_int_t k,
13012 : ae_state *_state);
13013 : static void amdordering_nsclear(amdnset* sa, ae_state *_state);
13014 : static ae_int_t amdordering_nscount(amdnset* sa, ae_state *_state);
13015 : static ae_int_t amdordering_nscountnotkth(amdnset* sa,
13016 : amdknset* src,
13017 : ae_int_t k,
13018 : ae_state *_state);
13019 : static ae_int_t amdordering_nscountandkth(amdnset* sa,
13020 : amdknset* src,
13021 : ae_int_t k,
13022 : ae_state *_state);
13023 : static ae_bool amdordering_nsequal(amdnset* s0,
13024 : amdnset* s1,
13025 : ae_state *_state);
13026 : static void amdordering_nsstartenumeration(amdnset* sa, ae_state *_state);
13027 : static ae_bool amdordering_nsenumerate(amdnset* sa,
13028 : ae_int_t* i,
13029 : ae_state *_state);
13030 : static void amdordering_knscompressstorage(amdknset* sa, ae_state *_state);
13031 : static void amdordering_knsreallocate(amdknset* sa,
13032 : ae_int_t setidx,
13033 : ae_int_t newallocated,
13034 : ae_state *_state);
13035 : static void amdordering_knsinit(ae_int_t k,
13036 : ae_int_t n,
13037 : ae_int_t kprealloc,
13038 : amdknset* sa,
13039 : ae_state *_state);
13040 : static void amdordering_knsinitfroma(sparsematrix* a,
13041 : ae_int_t n,
13042 : amdknset* sa,
13043 : ae_state *_state);
13044 : static void amdordering_knsstartenumeration(amdknset* sa,
13045 : ae_int_t i,
13046 : ae_state *_state);
13047 : static ae_bool amdordering_knsenumerate(amdknset* sa,
13048 : ae_int_t* i,
13049 : ae_state *_state);
13050 : static void amdordering_knsdirectaccess(amdknset* sa,
13051 : ae_int_t k,
13052 : ae_int_t* idxbegin,
13053 : ae_int_t* idxend,
13054 : ae_state *_state);
13055 : static void amdordering_knsaddnewelement(amdknset* sa,
13056 : ae_int_t i,
13057 : ae_int_t k,
13058 : ae_state *_state);
13059 : static void amdordering_knssubtract1(amdknset* sa,
13060 : ae_int_t i,
13061 : amdnset* src,
13062 : ae_state *_state);
13063 : static void amdordering_knsaddkthdistinct(amdknset* sa,
13064 : ae_int_t i,
13065 : amdknset* src,
13066 : ae_int_t k,
13067 : ae_state *_state);
13068 : static ae_int_t amdordering_knscountkth(amdknset* s0,
13069 : ae_int_t k,
13070 : ae_state *_state);
13071 : static ae_int_t amdordering_knscountnotkth(amdknset* s0,
13072 : ae_int_t i,
13073 : amdknset* s1,
13074 : ae_int_t k,
13075 : ae_state *_state);
13076 : static ae_int_t amdordering_knscountandkth(amdknset* s0,
13077 : ae_int_t i,
13078 : amdknset* s1,
13079 : ae_int_t k,
13080 : ae_state *_state);
13081 : static ae_int_t amdordering_knssumkth(amdknset* s0,
13082 : ae_int_t i,
13083 : ae_state *_state);
13084 : static void amdordering_knsclearkthnoreclaim(amdknset* sa,
13085 : ae_int_t k,
13086 : ae_state *_state);
13087 : static void amdordering_knsclearkthreclaim(amdknset* sa,
13088 : ae_int_t k,
13089 : ae_state *_state);
13090 : static void amdordering_mtxinit(ae_int_t n,
13091 : amdllmatrix* a,
13092 : ae_state *_state);
13093 : static void amdordering_mtxaddcolumnto(amdllmatrix* a,
13094 : ae_int_t j,
13095 : amdnset* s,
13096 : ae_state *_state);
13097 : static void amdordering_mtxinsertnewelement(amdllmatrix* a,
13098 : ae_int_t i,
13099 : ae_int_t j,
13100 : ae_state *_state);
13101 : static ae_int_t amdordering_mtxcountcolumn(amdllmatrix* a,
13102 : ae_int_t j,
13103 : ae_state *_state);
13104 : static void amdordering_mtxclearx(amdllmatrix* a,
13105 : ae_int_t k,
13106 : ae_bool iscol,
13107 : ae_state *_state);
13108 : static void amdordering_mtxclearcolumn(amdllmatrix* a,
13109 : ae_int_t j,
13110 : ae_state *_state);
13111 : static void amdordering_mtxclearrow(amdllmatrix* a,
13112 : ae_int_t j,
13113 : ae_state *_state);
13114 : static void amdordering_vtxinit(sparsematrix* a,
13115 : ae_int_t n,
13116 : ae_bool checkexactdegrees,
13117 : amdvertexset* s,
13118 : ae_state *_state);
13119 : static void amdordering_vtxremovevertex(amdvertexset* s,
13120 : ae_int_t p,
13121 : ae_state *_state);
13122 : static ae_int_t amdordering_vtxgetapprox(amdvertexset* s,
13123 : ae_int_t p,
13124 : ae_state *_state);
13125 : static ae_int_t amdordering_vtxgetexact(amdvertexset* s,
13126 : ae_int_t p,
13127 : ae_state *_state);
13128 : static ae_int_t amdordering_vtxgetapproxmindegree(amdvertexset* s,
13129 : ae_state *_state);
13130 : static void amdordering_vtxupdateapproximatedegree(amdvertexset* s,
13131 : ae_int_t p,
13132 : ae_int_t dnew,
13133 : ae_state *_state);
13134 : static void amdordering_vtxupdateexactdegree(amdvertexset* s,
13135 : ae_int_t p,
13136 : ae_int_t d,
13137 : ae_state *_state);
13138 : static void amdordering_amdselectpivotelement(amdbuffer* buf,
13139 : ae_int_t k,
13140 : ae_int_t* p,
13141 : ae_int_t* nodesize,
13142 : ae_state *_state);
13143 : static void amdordering_amdcomputelp(amdbuffer* buf,
13144 : ae_int_t p,
13145 : ae_state *_state);
13146 : static void amdordering_amdmasselimination(amdbuffer* buf,
13147 : ae_int_t p,
13148 : ae_int_t k,
13149 : ae_state *_state);
13150 : static void amdordering_amddetectsupernodes(amdbuffer* buf,
13151 : ae_state *_state);
13152 :
13153 :
13154 : #endif
13155 : #if defined(AE_COMPILE_SPCHOL) || !defined(AE_PARTIAL_BUILD)
13156 : static ae_int_t spchol_maxsupernode = 4;
13157 : static double spchol_maxmergeinefficiency = 0.25;
13158 : static ae_int_t spchol_smallfakestolerance = 2;
13159 : static ae_int_t spchol_maxfastkernel = 4;
13160 : static ae_bool spchol_relaxedsupernodes = ae_true;
13161 : static void spchol_generatedbgpermutation(sparsematrix* a,
13162 : ae_int_t n,
13163 : /* Integer */ ae_vector* perm,
13164 : /* Integer */ ae_vector* invperm,
13165 : ae_state *_state);
13166 : static void spchol_buildetree(sparsematrix* a,
13167 : ae_int_t n,
13168 : /* Integer */ ae_vector* parent,
13169 : /* Integer */ ae_vector* supernodalpermutation,
13170 : /* Integer */ ae_vector* invsupernodalpermutation,
13171 : /* Integer */ ae_vector* trawparentofrawnode,
13172 : /* Integer */ ae_vector* trawparentofreorderednode,
13173 : /* Integer */ ae_vector* ttmp,
13174 : /* Boolean */ ae_vector* tflagarray,
13175 : ae_state *_state);
13176 : static void spchol_createsupernodalstructure(sparsematrix* at,
13177 : /* Integer */ ae_vector* parent,
13178 : ae_int_t n,
13179 : spcholanalysis* analysis,
13180 : /* Integer */ ae_vector* node2supernode,
13181 : /* Integer */ ae_vector* tchildrenr,
13182 : /* Integer */ ae_vector* tchildreni,
13183 : /* Integer */ ae_vector* tparentnodeofsupernode,
13184 : /* Integer */ ae_vector* tfakenonzeros,
13185 : /* Integer */ ae_vector* ttmp0,
13186 : /* Boolean */ ae_vector* tflagarray,
13187 : ae_state *_state);
13188 : static void spchol_analyzesupernodaldependencies(spcholanalysis* analysis,
13189 : sparsematrix* rawa,
13190 : /* Integer */ ae_vector* node2supernode,
13191 : ae_int_t n,
13192 : /* Integer */ ae_vector* ttmp0,
13193 : /* Integer */ ae_vector* ttmp1,
13194 : /* Boolean */ ae_vector* tflagarray,
13195 : ae_state *_state);
13196 : static void spchol_extractmatrix(spcholanalysis* analysis,
13197 : /* Integer */ ae_vector* offsets,
13198 : /* Integer */ ae_vector* strides,
13199 : /* Real */ ae_vector* rowstorage,
13200 : /* Real */ ae_vector* diagd,
13201 : ae_int_t n,
13202 : sparsematrix* a,
13203 : /* Real */ ae_vector* d,
13204 : /* Integer */ ae_vector* p,
13205 : /* Integer */ ae_vector* tmpp,
13206 : ae_state *_state);
13207 : static void spchol_topologicalpermutation(sparsematrix* a,
13208 : /* Integer */ ae_vector* p,
13209 : sparsematrix* b,
13210 : ae_state *_state);
13211 : static ae_int_t spchol_computenonzeropattern(sparsematrix* wrkat,
13212 : ae_int_t columnidx,
13213 : ae_int_t n,
13214 : /* Integer */ ae_vector* superrowridx,
13215 : /* Integer */ ae_vector* superrowidx,
13216 : ae_int_t nsuper,
13217 : /* Integer */ ae_vector* childrennodesr,
13218 : /* Integer */ ae_vector* childrennodesi,
13219 : /* Integer */ ae_vector* node2supernode,
13220 : /* Boolean */ ae_vector* truearray,
13221 : /* Integer */ ae_vector* tmp0,
13222 : ae_state *_state);
13223 : static ae_int_t spchol_updatesupernode(spcholanalysis* analysis,
13224 : ae_int_t sidx,
13225 : ae_int_t cols0,
13226 : ae_int_t cols1,
13227 : ae_int_t offss,
13228 : /* Integer */ ae_vector* raw2smap,
13229 : ae_int_t uidx,
13230 : ae_int_t wrkrow,
13231 : /* Real */ ae_vector* diagd,
13232 : ae_int_t offsd,
13233 : ae_state *_state);
13234 : static ae_bool spchol_factorizesupernode(spcholanalysis* analysis,
13235 : ae_int_t sidx,
13236 : ae_state *_state);
13237 : static ae_int_t spchol_recommendedstridefor(ae_int_t rowsize,
13238 : ae_state *_state);
13239 : static ae_int_t spchol_alignpositioninarray(ae_int_t offs,
13240 : ae_state *_state);
13241 : static ae_bool spchol_updatekernel4444(/* Real */ ae_vector* rowstorage,
13242 : ae_int_t offss,
13243 : ae_int_t offsu,
13244 : ae_int_t uheight,
13245 : /* Real */ ae_vector* diagd,
13246 : ae_int_t offsd,
13247 : /* Integer */ ae_vector* raw2smap,
13248 : /* Integer */ ae_vector* superrowidx,
13249 : ae_int_t urbase,
13250 : ae_state *_state);
13251 : static ae_bool spchol_updatekernelabc4(/* Real */ ae_vector* rowstorage,
13252 : ae_int_t offss,
13253 : ae_int_t twidth,
13254 : ae_int_t offsu,
13255 : ae_int_t uheight,
13256 : ae_int_t urank,
13257 : ae_int_t urowstride,
13258 : ae_int_t uwidth,
13259 : /* Real */ ae_vector* diagd,
13260 : ae_int_t offsd,
13261 : /* Integer */ ae_vector* raw2smap,
13262 : /* Integer */ ae_vector* superrowidx,
13263 : ae_int_t urbase,
13264 : ae_state *_state);
13265 : static ae_bool spchol_updatekernelrank1(/* Real */ ae_vector* rowstorage,
13266 : ae_int_t offss,
13267 : ae_int_t twidth,
13268 : ae_int_t trowstride,
13269 : ae_int_t offsu,
13270 : ae_int_t uheight,
13271 : ae_int_t uwidth,
13272 : /* Real */ ae_vector* diagd,
13273 : ae_int_t offsd,
13274 : /* Integer */ ae_vector* raw2smap,
13275 : /* Integer */ ae_vector* superrowidx,
13276 : ae_int_t urbase,
13277 : ae_state *_state);
13278 : static ae_bool spchol_updatekernelrank2(/* Real */ ae_vector* rowstorage,
13279 : ae_int_t offss,
13280 : ae_int_t twidth,
13281 : ae_int_t trowstride,
13282 : ae_int_t offsu,
13283 : ae_int_t uheight,
13284 : ae_int_t uwidth,
13285 : /* Real */ ae_vector* diagd,
13286 : ae_int_t offsd,
13287 : /* Integer */ ae_vector* raw2smap,
13288 : /* Integer */ ae_vector* superrowidx,
13289 : ae_int_t urbase,
13290 : ae_state *_state);
13291 :
13292 :
13293 : #endif
13294 : #if defined(AE_COMPILE_MATGEN) || !defined(AE_PARTIAL_BUILD)
13295 :
13296 :
13297 : #endif
13298 : #if defined(AE_COMPILE_TRFAC) || !defined(AE_PARTIAL_BUILD)
13299 : static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a,
13300 : ae_int_t offs,
13301 : ae_int_t n,
13302 : ae_bool isupper,
13303 : /* Complex */ ae_vector* tmp,
13304 : ae_state *_state);
13305 : static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa,
13306 : ae_int_t offs,
13307 : ae_int_t n,
13308 : ae_bool isupper,
13309 : /* Complex */ ae_vector* tmp,
13310 : ae_state *_state);
13311 : static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa,
13312 : ae_int_t offs,
13313 : ae_int_t n,
13314 : ae_bool isupper,
13315 : /* Real */ ae_vector* tmp,
13316 : ae_state *_state);
13317 :
13318 :
13319 : #endif
13320 : #if defined(AE_COMPILE_RCOND) || !defined(AE_PARTIAL_BUILD)
13321 : static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a,
13322 : ae_int_t n,
13323 : ae_bool isupper,
13324 : ae_bool isunit,
13325 : ae_bool onenorm,
13326 : double anorm,
13327 : double* rc,
13328 : ae_state *_state);
13329 : static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a,
13330 : ae_int_t n,
13331 : ae_bool isupper,
13332 : ae_bool isunit,
13333 : ae_bool onenorm,
13334 : double anorm,
13335 : double* rc,
13336 : ae_state *_state);
13337 : static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha,
13338 : ae_int_t n,
13339 : ae_bool isupper,
13340 : ae_bool isnormprovided,
13341 : double anorm,
13342 : double* rc,
13343 : ae_state *_state);
13344 : static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha,
13345 : ae_int_t n,
13346 : ae_bool isupper,
13347 : ae_bool isnormprovided,
13348 : double anorm,
13349 : double* rc,
13350 : ae_state *_state);
13351 : static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua,
13352 : ae_int_t n,
13353 : ae_bool onenorm,
13354 : ae_bool isanormprovided,
13355 : double anorm,
13356 : double* rc,
13357 : ae_state *_state);
13358 : static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua,
13359 : ae_int_t n,
13360 : ae_bool onenorm,
13361 : ae_bool isanormprovided,
13362 : double anorm,
13363 : double* rc,
13364 : ae_state *_state);
13365 : static void rcond_rmatrixestimatenorm(ae_int_t n,
13366 : /* Real */ ae_vector* v,
13367 : /* Real */ ae_vector* x,
13368 : /* Integer */ ae_vector* isgn,
13369 : double* est,
13370 : ae_int_t* kase,
13371 : ae_state *_state);
13372 : static void rcond_cmatrixestimatenorm(ae_int_t n,
13373 : /* Complex */ ae_vector* v,
13374 : /* Complex */ ae_vector* x,
13375 : double* est,
13376 : ae_int_t* kase,
13377 : /* Integer */ ae_vector* isave,
13378 : /* Real */ ae_vector* rsave,
13379 : ae_state *_state);
13380 : static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x,
13381 : ae_int_t n,
13382 : ae_state *_state);
13383 : static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x,
13384 : ae_int_t n,
13385 : ae_state *_state);
13386 : static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave,
13387 : /* Real */ ae_vector* rsave,
13388 : ae_int_t* i,
13389 : ae_int_t* iter,
13390 : ae_int_t* j,
13391 : ae_int_t* jlast,
13392 : ae_int_t* jump,
13393 : double* absxi,
13394 : double* altsgn,
13395 : double* estold,
13396 : double* temp,
13397 : ae_state *_state);
13398 : static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave,
13399 : /* Real */ ae_vector* rsave,
13400 : ae_int_t* i,
13401 : ae_int_t* iter,
13402 : ae_int_t* j,
13403 : ae_int_t* jlast,
13404 : ae_int_t* jump,
13405 : double* absxi,
13406 : double* altsgn,
13407 : double* estold,
13408 : double* temp,
13409 : ae_state *_state);
13410 :
13411 :
13412 : #endif
13413 : #if defined(AE_COMPILE_MATINV) || !defined(AE_PARTIAL_BUILD)
13414 : static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a,
13415 : ae_int_t offs,
13416 : ae_int_t n,
13417 : ae_bool isupper,
13418 : ae_bool isunit,
13419 : /* Real */ ae_vector* tmp,
13420 : sinteger* info,
13421 : ae_state *_state);
13422 : ae_bool _trypexec_matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a,
13423 : ae_int_t offs,
13424 : ae_int_t n,
13425 : ae_bool isupper,
13426 : ae_bool isunit,
13427 : /* Real */ ae_vector* tmp,
13428 : sinteger* info, ae_state *_state);
13429 : static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a,
13430 : ae_int_t offs,
13431 : ae_int_t n,
13432 : ae_bool isupper,
13433 : ae_bool isunit,
13434 : /* Complex */ ae_vector* tmp,
13435 : sinteger* info,
13436 : ae_state *_state);
13437 : ae_bool _trypexec_matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a,
13438 : ae_int_t offs,
13439 : ae_int_t n,
13440 : ae_bool isupper,
13441 : ae_bool isunit,
13442 : /* Complex */ ae_vector* tmp,
13443 : sinteger* info, ae_state *_state);
13444 : static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a,
13445 : ae_int_t offs,
13446 : ae_int_t n,
13447 : /* Real */ ae_vector* work,
13448 : sinteger* info,
13449 : matinvreport* rep,
13450 : ae_state *_state);
13451 : ae_bool _trypexec_matinv_rmatrixluinverserec(/* Real */ ae_matrix* a,
13452 : ae_int_t offs,
13453 : ae_int_t n,
13454 : /* Real */ ae_vector* work,
13455 : sinteger* info,
13456 : matinvreport* rep, ae_state *_state);
13457 : static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a,
13458 : ae_int_t offs,
13459 : ae_int_t n,
13460 : /* Complex */ ae_vector* work,
13461 : sinteger* ssinfo,
13462 : matinvreport* rep,
13463 : ae_state *_state);
13464 : ae_bool _trypexec_matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a,
13465 : ae_int_t offs,
13466 : ae_int_t n,
13467 : /* Complex */ ae_vector* work,
13468 : sinteger* ssinfo,
13469 : matinvreport* rep, ae_state *_state);
13470 : static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a,
13471 : ae_int_t offs,
13472 : ae_int_t n,
13473 : ae_bool isupper,
13474 : /* Complex */ ae_vector* tmp,
13475 : ae_state *_state);
13476 :
13477 :
13478 : #endif
13479 : #if defined(AE_COMPILE_ORTFAC) || !defined(AE_PARTIAL_BUILD)
13480 : static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a,
13481 : ae_int_t m,
13482 : ae_int_t n,
13483 : /* Complex */ ae_vector* work,
13484 : /* Complex */ ae_vector* t,
13485 : /* Complex */ ae_vector* tau,
13486 : ae_state *_state);
13487 : static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a,
13488 : ae_int_t m,
13489 : ae_int_t n,
13490 : /* Complex */ ae_vector* work,
13491 : /* Complex */ ae_vector* t,
13492 : /* Complex */ ae_vector* tau,
13493 : ae_state *_state);
13494 : static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a,
13495 : /* Real */ ae_vector* tau,
13496 : ae_bool columnwisea,
13497 : ae_int_t lengtha,
13498 : ae_int_t blocksize,
13499 : /* Real */ ae_matrix* t,
13500 : /* Real */ ae_vector* work,
13501 : ae_state *_state);
13502 : static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a,
13503 : /* Complex */ ae_vector* tau,
13504 : ae_bool columnwisea,
13505 : ae_int_t lengtha,
13506 : ae_int_t blocksize,
13507 : /* Complex */ ae_matrix* t,
13508 : /* Complex */ ae_vector* work,
13509 : ae_state *_state);
13510 :
13511 :
13512 : #endif
13513 : #if defined(AE_COMPILE_FBLS) || !defined(AE_PARTIAL_BUILD)
13514 :
13515 :
13516 : #endif
13517 : #if defined(AE_COMPILE_BDSVD) || !defined(AE_PARTIAL_BUILD)
13518 : static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d,
13519 : /* Real */ ae_vector* e,
13520 : ae_int_t n,
13521 : ae_bool isupper,
13522 : ae_bool isfractionalaccuracyrequired,
13523 : /* Real */ ae_matrix* uu,
13524 : ae_int_t ustart,
13525 : ae_int_t nru,
13526 : /* Real */ ae_matrix* c,
13527 : ae_int_t cstart,
13528 : ae_int_t ncc,
13529 : /* Real */ ae_matrix* vt,
13530 : ae_int_t vstart,
13531 : ae_int_t ncvt,
13532 : ae_state *_state);
13533 : static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state);
13534 : static void bdsvd_svd2x2(double f,
13535 : double g,
13536 : double h,
13537 : double* ssmin,
13538 : double* ssmax,
13539 : ae_state *_state);
13540 : static void bdsvd_svdv2x2(double f,
13541 : double g,
13542 : double h,
13543 : double* ssmin,
13544 : double* ssmax,
13545 : double* snr,
13546 : double* csr,
13547 : double* snl,
13548 : double* csl,
13549 : ae_state *_state);
13550 :
13551 :
13552 : #endif
13553 : #if defined(AE_COMPILE_SVD) || !defined(AE_PARTIAL_BUILD)
13554 :
13555 :
13556 : #endif
13557 : #if defined(AE_COMPILE_NORMESTIMATOR) || !defined(AE_PARTIAL_BUILD)
13558 :
13559 :
13560 : #endif
13561 : #if defined(AE_COMPILE_HSSCHUR) || !defined(AE_PARTIAL_BUILD)
13562 : static void hsschur_internalauxschur(ae_bool wantt,
13563 : ae_bool wantz,
13564 : ae_int_t n,
13565 : ae_int_t ilo,
13566 : ae_int_t ihi,
13567 : /* Real */ ae_matrix* h,
13568 : /* Real */ ae_vector* wr,
13569 : /* Real */ ae_vector* wi,
13570 : ae_int_t iloz,
13571 : ae_int_t ihiz,
13572 : /* Real */ ae_matrix* z,
13573 : /* Real */ ae_vector* work,
13574 : /* Real */ ae_vector* workv3,
13575 : /* Real */ ae_vector* workc1,
13576 : /* Real */ ae_vector* works1,
13577 : ae_int_t* info,
13578 : ae_state *_state);
13579 : static void hsschur_aux2x2schur(double* a,
13580 : double* b,
13581 : double* c,
13582 : double* d,
13583 : double* rt1r,
13584 : double* rt1i,
13585 : double* rt2r,
13586 : double* rt2i,
13587 : double* cs,
13588 : double* sn,
13589 : ae_state *_state);
13590 : static double hsschur_extschursign(double a, double b, ae_state *_state);
13591 : static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state);
13592 :
13593 :
13594 : #endif
13595 : #if defined(AE_COMPILE_EVD) || !defined(AE_PARTIAL_BUILD)
13596 : static ae_int_t evd_stepswithintol = 2;
13597 : static void evd_clearrfields(eigsubspacestate* state, ae_state *_state);
13598 : static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d,
13599 : /* Real */ ae_vector* e,
13600 : ae_int_t n,
13601 : ae_int_t zneeded,
13602 : /* Real */ ae_matrix* z,
13603 : ae_state *_state);
13604 : static void evd_tdevde2(double a,
13605 : double b,
13606 : double c,
13607 : double* rt1,
13608 : double* rt2,
13609 : ae_state *_state);
13610 : static void evd_tdevdev2(double a,
13611 : double b,
13612 : double c,
13613 : double* rt1,
13614 : double* rt2,
13615 : double* cs1,
13616 : double* sn1,
13617 : ae_state *_state);
13618 : static double evd_tdevdpythag(double a, double b, ae_state *_state);
13619 : static double evd_tdevdextsign(double a, double b, ae_state *_state);
13620 : static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d,
13621 : /* Real */ ae_vector* e,
13622 : ae_int_t n,
13623 : ae_int_t irange,
13624 : ae_int_t iorder,
13625 : double vl,
13626 : double vu,
13627 : ae_int_t il,
13628 : ae_int_t iu,
13629 : double abstol,
13630 : /* Real */ ae_vector* w,
13631 : ae_int_t* m,
13632 : ae_int_t* nsplit,
13633 : /* Integer */ ae_vector* iblock,
13634 : /* Integer */ ae_vector* isplit,
13635 : ae_int_t* errorcode,
13636 : ae_state *_state);
13637 : static void evd_internaldstein(ae_int_t n,
13638 : /* Real */ ae_vector* d,
13639 : /* Real */ ae_vector* e,
13640 : ae_int_t m,
13641 : /* Real */ ae_vector* w,
13642 : /* Integer */ ae_vector* iblock,
13643 : /* Integer */ ae_vector* isplit,
13644 : /* Real */ ae_matrix* z,
13645 : /* Integer */ ae_vector* ifail,
13646 : ae_int_t* info,
13647 : ae_state *_state);
13648 : static void evd_tdininternaldlagtf(ae_int_t n,
13649 : /* Real */ ae_vector* a,
13650 : double lambdav,
13651 : /* Real */ ae_vector* b,
13652 : /* Real */ ae_vector* c,
13653 : double tol,
13654 : /* Real */ ae_vector* d,
13655 : /* Integer */ ae_vector* iin,
13656 : ae_int_t* info,
13657 : ae_state *_state);
13658 : static void evd_tdininternaldlagts(ae_int_t n,
13659 : /* Real */ ae_vector* a,
13660 : /* Real */ ae_vector* b,
13661 : /* Real */ ae_vector* c,
13662 : /* Real */ ae_vector* d,
13663 : /* Integer */ ae_vector* iin,
13664 : /* Real */ ae_vector* y,
13665 : double* tol,
13666 : ae_int_t* info,
13667 : ae_state *_state);
13668 : static void evd_internaldlaebz(ae_int_t ijob,
13669 : ae_int_t nitmax,
13670 : ae_int_t n,
13671 : ae_int_t mmax,
13672 : ae_int_t minp,
13673 : double abstol,
13674 : double reltol,
13675 : double pivmin,
13676 : /* Real */ ae_vector* d,
13677 : /* Real */ ae_vector* e,
13678 : /* Real */ ae_vector* e2,
13679 : /* Integer */ ae_vector* nval,
13680 : /* Real */ ae_matrix* ab,
13681 : /* Real */ ae_vector* c,
13682 : ae_int_t* mout,
13683 : /* Integer */ ae_matrix* nab,
13684 : /* Real */ ae_vector* work,
13685 : /* Integer */ ae_vector* iwork,
13686 : ae_int_t* info,
13687 : ae_state *_state);
13688 : static void evd_rmatrixinternaltrevc(/* Real */ ae_matrix* t,
13689 : ae_int_t n,
13690 : ae_int_t side,
13691 : ae_int_t howmny,
13692 : /* Boolean */ ae_vector* vselect,
13693 : /* Real */ ae_matrix* vl,
13694 : /* Real */ ae_matrix* vr,
13695 : ae_int_t* m,
13696 : ae_int_t* info,
13697 : ae_state *_state);
13698 : static void evd_internaltrevc(/* Real */ ae_matrix* t,
13699 : ae_int_t n,
13700 : ae_int_t side,
13701 : ae_int_t howmny,
13702 : /* Boolean */ ae_vector* vselect,
13703 : /* Real */ ae_matrix* vl,
13704 : /* Real */ ae_matrix* vr,
13705 : ae_int_t* m,
13706 : ae_int_t* info,
13707 : ae_state *_state);
13708 : static void evd_internalhsevdlaln2(ae_bool ltrans,
13709 : ae_int_t na,
13710 : ae_int_t nw,
13711 : double smin,
13712 : double ca,
13713 : /* Real */ ae_matrix* a,
13714 : double d1,
13715 : double d2,
13716 : /* Real */ ae_matrix* b,
13717 : double wr,
13718 : double wi,
13719 : /* Boolean */ ae_vector* rswap4,
13720 : /* Boolean */ ae_vector* zswap4,
13721 : /* Integer */ ae_matrix* ipivot44,
13722 : /* Real */ ae_vector* civ4,
13723 : /* Real */ ae_vector* crv4,
13724 : /* Real */ ae_matrix* x,
13725 : double* scl,
13726 : double* xnorm,
13727 : ae_int_t* info,
13728 : ae_state *_state);
13729 : static void evd_internalhsevdladiv(double a,
13730 : double b,
13731 : double c,
13732 : double d,
13733 : double* p,
13734 : double* q,
13735 : ae_state *_state);
13736 :
13737 :
13738 : #endif
13739 : #if defined(AE_COMPILE_SCHUR) || !defined(AE_PARTIAL_BUILD)
13740 :
13741 :
13742 : #endif
13743 : #if defined(AE_COMPILE_SPDGEVD) || !defined(AE_PARTIAL_BUILD)
13744 :
13745 :
13746 : #endif
13747 : #if defined(AE_COMPILE_INVERSEUPDATE) || !defined(AE_PARTIAL_BUILD)
13748 :
13749 :
13750 : #endif
13751 : #if defined(AE_COMPILE_MATDET) || !defined(AE_PARTIAL_BUILD)
13752 :
13753 :
13754 : #endif
13755 :
13756 : #if defined(AE_COMPILE_SPARSE) || !defined(AE_PARTIAL_BUILD)
13757 :
13758 :
13759 : /*************************************************************************
13760 : This function creates sparse matrix in a Hash-Table format.
13761 :
13762 : This function creates Hast-Table matrix, which can be converted to CRS
13763 : format after its initialization is over. Typical usage scenario for a
13764 : sparse matrix is:
13765 : 1. creation in a Hash-Table format
13766 : 2. insertion of the matrix elements
13767 : 3. conversion to the CRS representation
13768 : 4. matrix is passed to some linear algebra algorithm
13769 :
13770 : Some information about different matrix formats can be found below, in
13771 : the "NOTES" section.
13772 :
13773 : INPUT PARAMETERS
13774 : M - number of rows in a matrix, M>=1
13775 : N - number of columns in a matrix, N>=1
13776 : K - K>=0, expected number of non-zero elements in a matrix.
13777 : K can be inexact approximation, can be less than actual
13778 : number of elements (table will grow when needed) or
13779 : even zero).
13780 : It is important to understand that although hash-table
13781 : may grow automatically, it is better to provide good
13782 : estimate of data size.
13783 :
13784 : OUTPUT PARAMETERS
13785 : S - sparse M*N matrix in Hash-Table representation.
13786 : All elements of the matrix are zero.
13787 :
13788 : NOTE 1
13789 :
13790 : Hash-tables use memory inefficiently, and they have to keep some amount
13791 : of the "spare memory" in order to have good performance. Hash table for
13792 : matrix with K non-zero elements will need C*K*(8+2*sizeof(int)) bytes,
13793 : where C is a small constant, about 1.5-2 in magnitude.
13794 :
13795 : CRS storage, from the other side, is more memory-efficient, and needs
13796 : just K*(8+sizeof(int))+M*sizeof(int) bytes, where M is a number of rows
13797 : in a matrix.
13798 :
13799 : When you convert from the Hash-Table to CRS representation, all unneeded
13800 : memory will be freed.
13801 :
13802 : NOTE 2
13803 :
13804 : Comments of SparseMatrix structure outline information about different
13805 : sparse storage formats. We recommend you to read them before starting to
13806 : use ALGLIB sparse matrices.
13807 :
13808 : NOTE 3
13809 :
13810 : This function completely overwrites S with new sparse matrix. Previously
13811 : allocated storage is NOT reused. If you want to reuse already allocated
13812 : memory, call SparseCreateBuf function.
13813 :
13814 : -- ALGLIB PROJECT --
13815 : Copyright 14.10.2011 by Bochkanov Sergey
13816 : *************************************************************************/
13817 0 : void sparsecreate(ae_int_t m,
13818 : ae_int_t n,
13819 : ae_int_t k,
13820 : sparsematrix* s,
13821 : ae_state *_state)
13822 : {
13823 :
13824 0 : _sparsematrix_clear(s);
13825 :
13826 0 : sparsecreatebuf(m, n, k, s, _state);
13827 0 : }
13828 :
13829 :
13830 : /*************************************************************************
13831 : This version of SparseCreate function creates sparse matrix in Hash-Table
13832 : format, reusing previously allocated storage as much as possible. Read
13833 : comments for SparseCreate() for more information.
13834 :
13835 : INPUT PARAMETERS
13836 : M - number of rows in a matrix, M>=1
13837 : N - number of columns in a matrix, N>=1
13838 : K - K>=0, expected number of non-zero elements in a matrix.
13839 : K can be inexact approximation, can be less than actual
13840 : number of elements (table will grow when needed) or
13841 : even zero).
13842 : It is important to understand that although hash-table
13843 : may grow automatically, it is better to provide good
13844 : estimate of data size.
13845 : S - SparseMatrix structure which MAY contain some already
13846 : allocated storage.
13847 :
13848 : OUTPUT PARAMETERS
13849 : S - sparse M*N matrix in Hash-Table representation.
13850 : All elements of the matrix are zero.
13851 : Previously allocated storage is reused, if its size
13852 : is compatible with expected number of non-zeros K.
13853 :
13854 : -- ALGLIB PROJECT --
13855 : Copyright 14.01.2014 by Bochkanov Sergey
13856 : *************************************************************************/
13857 0 : void sparsecreatebuf(ae_int_t m,
13858 : ae_int_t n,
13859 : ae_int_t k,
13860 : sparsematrix* s,
13861 : ae_state *_state)
13862 : {
13863 : ae_int_t i;
13864 :
13865 :
13866 0 : ae_assert(m>0, "SparseCreateBuf: M<=0", _state);
13867 0 : ae_assert(n>0, "SparseCreateBuf: N<=0", _state);
13868 0 : ae_assert(k>=0, "SparseCreateBuf: K<0", _state);
13869 :
13870 : /*
13871 : * Hash-table size is max(existing_size,requested_size)
13872 : *
13873 : * NOTE: it is important to use ALL available memory for hash table
13874 : * because it is impossible to efficiently reallocate table
13875 : * without temporary storage. So, if we want table with up to
13876 : * 1.000.000 elements, we have to create such table from the
13877 : * very beginning. Otherwise, the very idea of memory reuse
13878 : * will be compromised.
13879 : */
13880 0 : s->tablesize = ae_round(k/sparse_desiredloadfactor+sparse_additional, _state);
13881 0 : rvectorsetlengthatleast(&s->vals, s->tablesize, _state);
13882 0 : s->tablesize = s->vals.cnt;
13883 :
13884 : /*
13885 : * Initialize other fields
13886 : */
13887 0 : s->matrixtype = 0;
13888 0 : s->m = m;
13889 0 : s->n = n;
13890 0 : s->nfree = s->tablesize;
13891 0 : ivectorsetlengthatleast(&s->idx, 2*s->tablesize, _state);
13892 0 : for(i=0; i<=s->tablesize-1; i++)
13893 : {
13894 0 : s->idx.ptr.p_int[2*i] = -1;
13895 : }
13896 0 : }
13897 :
13898 :
13899 : /*************************************************************************
13900 : This function creates sparse matrix in a CRS format (expert function for
13901 : situations when you are running out of memory).
13902 :
13903 : This function creates CRS matrix. Typical usage scenario for a CRS matrix
13904 : is:
13905 : 1. creation (you have to tell number of non-zero elements at each row at
13906 : this moment)
13907 : 2. insertion of the matrix elements (row by row, from left to right)
13908 : 3. matrix is passed to some linear algebra algorithm
13909 :
13910 : This function is a memory-efficient alternative to SparseCreate(), but it
13911 : is more complex because it requires you to know in advance how large your
13912 : matrix is. Some information about different matrix formats can be found
13913 : in comments on SparseMatrix structure. We recommend you to read them
13914 : before starting to use ALGLIB sparse matrices..
13915 :
13916 : INPUT PARAMETERS
13917 : M - number of rows in a matrix, M>=1
13918 : N - number of columns in a matrix, N>=1
13919 : NER - number of elements at each row, array[M], NER[I]>=0
13920 :
13921 : OUTPUT PARAMETERS
13922 : S - sparse M*N matrix in CRS representation.
13923 : You have to fill ALL non-zero elements by calling
13924 : SparseSet() BEFORE you try to use this matrix.
13925 :
13926 : NOTE: this function completely overwrites S with new sparse matrix.
13927 : Previously allocated storage is NOT reused. If you want to reuse
13928 : already allocated memory, call SparseCreateCRSBuf function.
13929 :
13930 : -- ALGLIB PROJECT --
13931 : Copyright 14.10.2011 by Bochkanov Sergey
13932 : *************************************************************************/
13933 0 : void sparsecreatecrs(ae_int_t m,
13934 : ae_int_t n,
13935 : /* Integer */ ae_vector* ner,
13936 : sparsematrix* s,
13937 : ae_state *_state)
13938 : {
13939 : ae_int_t i;
13940 :
13941 0 : _sparsematrix_clear(s);
13942 :
13943 0 : ae_assert(m>0, "SparseCreateCRS: M<=0", _state);
13944 0 : ae_assert(n>0, "SparseCreateCRS: N<=0", _state);
13945 0 : ae_assert(ner->cnt>=m, "SparseCreateCRS: Length(NER)<M", _state);
13946 0 : for(i=0; i<=m-1; i++)
13947 : {
13948 0 : ae_assert(ner->ptr.p_int[i]>=0, "SparseCreateCRS: NER[] contains negative elements", _state);
13949 : }
13950 0 : sparsecreatecrsbuf(m, n, ner, s, _state);
13951 0 : }
13952 :
13953 :
13954 : /*************************************************************************
13955 : This function creates sparse matrix in a CRS format (expert function for
13956 : situations when you are running out of memory). This version of CRS
13957 : matrix creation function may reuse memory already allocated in S.
13958 :
13959 : This function creates CRS matrix. Typical usage scenario for a CRS matrix
13960 : is:
13961 : 1. creation (you have to tell number of non-zero elements at each row at
13962 : this moment)
13963 : 2. insertion of the matrix elements (row by row, from left to right)
13964 : 3. matrix is passed to some linear algebra algorithm
13965 :
13966 : This function is a memory-efficient alternative to SparseCreate(), but it
13967 : is more complex because it requires you to know in advance how large your
13968 : matrix is. Some information about different matrix formats can be found
13969 : in comments on SparseMatrix structure. We recommend you to read them
13970 : before starting to use ALGLIB sparse matrices..
13971 :
13972 : INPUT PARAMETERS
13973 : M - number of rows in a matrix, M>=1
13974 : N - number of columns in a matrix, N>=1
13975 : NER - number of elements at each row, array[M], NER[I]>=0
13976 : S - sparse matrix structure with possibly preallocated
13977 : memory.
13978 :
13979 : OUTPUT PARAMETERS
13980 : S - sparse M*N matrix in CRS representation.
13981 : You have to fill ALL non-zero elements by calling
13982 : SparseSet() BEFORE you try to use this matrix.
13983 :
13984 : -- ALGLIB PROJECT --
13985 : Copyright 14.10.2011 by Bochkanov Sergey
13986 : *************************************************************************/
13987 0 : void sparsecreatecrsbuf(ae_int_t m,
13988 : ae_int_t n,
13989 : /* Integer */ ae_vector* ner,
13990 : sparsematrix* s,
13991 : ae_state *_state)
13992 : {
13993 : ae_int_t i;
13994 : ae_int_t noe;
13995 :
13996 :
13997 0 : ae_assert(m>0, "SparseCreateCRSBuf: M<=0", _state);
13998 0 : ae_assert(n>0, "SparseCreateCRSBuf: N<=0", _state);
13999 0 : ae_assert(ner->cnt>=m, "SparseCreateCRSBuf: Length(NER)<M", _state);
14000 0 : noe = 0;
14001 0 : s->matrixtype = 1;
14002 0 : s->ninitialized = 0;
14003 0 : s->m = m;
14004 0 : s->n = n;
14005 0 : ivectorsetlengthatleast(&s->ridx, s->m+1, _state);
14006 0 : s->ridx.ptr.p_int[0] = 0;
14007 0 : for(i=0; i<=s->m-1; i++)
14008 : {
14009 0 : ae_assert(ner->ptr.p_int[i]>=0, "SparseCreateCRSBuf: NER[] contains negative elements", _state);
14010 0 : noe = noe+ner->ptr.p_int[i];
14011 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i]+ner->ptr.p_int[i];
14012 : }
14013 0 : rvectorsetlengthatleast(&s->vals, noe, _state);
14014 0 : ivectorsetlengthatleast(&s->idx, noe, _state);
14015 0 : if( noe==0 )
14016 : {
14017 0 : sparseinitduidx(s, _state);
14018 : }
14019 0 : }
14020 :
14021 :
14022 : /*************************************************************************
14023 : This function creates sparse matrix in a SKS format (skyline storage
14024 : format). In most cases you do not need this function - CRS format better
14025 : suits most use cases.
14026 :
14027 : INPUT PARAMETERS
14028 : M, N - number of rows(M) and columns (N) in a matrix:
14029 : * M=N (as for now, ALGLIB supports only square SKS)
14030 : * N>=1
14031 : * M>=1
14032 : D - "bottom" bandwidths, array[M], D[I]>=0.
14033 : I-th element stores number of non-zeros at I-th row,
14034 : below the diagonal (diagonal itself is not included)
14035 : U - "top" bandwidths, array[N], U[I]>=0.
14036 : I-th element stores number of non-zeros at I-th row,
14037 : above the diagonal (diagonal itself is not included)
14038 :
14039 : OUTPUT PARAMETERS
14040 : S - sparse M*N matrix in SKS representation.
14041 : All elements are filled by zeros.
14042 : You may use sparseset() to change their values.
14043 :
14044 : NOTE: this function completely overwrites S with new sparse matrix.
14045 : Previously allocated storage is NOT reused. If you want to reuse
14046 : already allocated memory, call SparseCreateSKSBuf function.
14047 :
14048 : -- ALGLIB PROJECT --
14049 : Copyright 13.01.2014 by Bochkanov Sergey
14050 : *************************************************************************/
14051 0 : void sparsecreatesks(ae_int_t m,
14052 : ae_int_t n,
14053 : /* Integer */ ae_vector* d,
14054 : /* Integer */ ae_vector* u,
14055 : sparsematrix* s,
14056 : ae_state *_state)
14057 : {
14058 : ae_int_t i;
14059 :
14060 0 : _sparsematrix_clear(s);
14061 :
14062 0 : ae_assert(m>0, "SparseCreateSKS: M<=0", _state);
14063 0 : ae_assert(n>0, "SparseCreateSKS: N<=0", _state);
14064 0 : ae_assert(m==n, "SparseCreateSKS: M<>N", _state);
14065 0 : ae_assert(d->cnt>=m, "SparseCreateSKS: Length(D)<M", _state);
14066 0 : ae_assert(u->cnt>=n, "SparseCreateSKS: Length(U)<N", _state);
14067 0 : for(i=0; i<=m-1; i++)
14068 : {
14069 0 : ae_assert(d->ptr.p_int[i]>=0, "SparseCreateSKS: D[] contains negative elements", _state);
14070 0 : ae_assert(d->ptr.p_int[i]<=i, "SparseCreateSKS: D[I]>I for some I", _state);
14071 : }
14072 0 : for(i=0; i<=n-1; i++)
14073 : {
14074 0 : ae_assert(u->ptr.p_int[i]>=0, "SparseCreateSKS: U[] contains negative elements", _state);
14075 0 : ae_assert(u->ptr.p_int[i]<=i, "SparseCreateSKS: U[I]>I for some I", _state);
14076 : }
14077 0 : sparsecreatesksbuf(m, n, d, u, s, _state);
14078 0 : }
14079 :
14080 :
14081 : /*************************************************************************
14082 : This is "buffered" version of SparseCreateSKS() which reuses memory
14083 : previously allocated in S (of course, memory is reallocated if needed).
14084 :
14085 : This function creates sparse matrix in a SKS format (skyline storage
14086 : format). In most cases you do not need this function - CRS format better
14087 : suits most use cases.
14088 :
14089 : INPUT PARAMETERS
14090 : M, N - number of rows(M) and columns (N) in a matrix:
14091 : * M=N (as for now, ALGLIB supports only square SKS)
14092 : * N>=1
14093 : * M>=1
14094 : D - "bottom" bandwidths, array[M], 0<=D[I]<=I.
14095 : I-th element stores number of non-zeros at I-th row,
14096 : below the diagonal (diagonal itself is not included)
14097 : U - "top" bandwidths, array[N], 0<=U[I]<=I.
14098 : I-th element stores number of non-zeros at I-th row,
14099 : above the diagonal (diagonal itself is not included)
14100 :
14101 : OUTPUT PARAMETERS
14102 : S - sparse M*N matrix in SKS representation.
14103 : All elements are filled by zeros.
14104 : You may use sparseset() to change their values.
14105 :
14106 : -- ALGLIB PROJECT --
14107 : Copyright 13.01.2014 by Bochkanov Sergey
14108 : *************************************************************************/
14109 0 : void sparsecreatesksbuf(ae_int_t m,
14110 : ae_int_t n,
14111 : /* Integer */ ae_vector* d,
14112 : /* Integer */ ae_vector* u,
14113 : sparsematrix* s,
14114 : ae_state *_state)
14115 : {
14116 : ae_int_t i;
14117 : ae_int_t minmn;
14118 : ae_int_t nz;
14119 : ae_int_t mxd;
14120 : ae_int_t mxu;
14121 :
14122 :
14123 0 : ae_assert(m>0, "SparseCreateSKSBuf: M<=0", _state);
14124 0 : ae_assert(n>0, "SparseCreateSKSBuf: N<=0", _state);
14125 0 : ae_assert(m==n, "SparseCreateSKSBuf: M<>N", _state);
14126 0 : ae_assert(d->cnt>=m, "SparseCreateSKSBuf: Length(D)<M", _state);
14127 0 : ae_assert(u->cnt>=n, "SparseCreateSKSBuf: Length(U)<N", _state);
14128 0 : for(i=0; i<=m-1; i++)
14129 : {
14130 0 : ae_assert(d->ptr.p_int[i]>=0, "SparseCreateSKSBuf: D[] contains negative elements", _state);
14131 0 : ae_assert(d->ptr.p_int[i]<=i, "SparseCreateSKSBuf: D[I]>I for some I", _state);
14132 : }
14133 0 : for(i=0; i<=n-1; i++)
14134 : {
14135 0 : ae_assert(u->ptr.p_int[i]>=0, "SparseCreateSKSBuf: U[] contains negative elements", _state);
14136 0 : ae_assert(u->ptr.p_int[i]<=i, "SparseCreateSKSBuf: U[I]>I for some I", _state);
14137 : }
14138 0 : minmn = ae_minint(m, n, _state);
14139 0 : s->matrixtype = 2;
14140 0 : s->ninitialized = 0;
14141 0 : s->m = m;
14142 0 : s->n = n;
14143 0 : ivectorsetlengthatleast(&s->ridx, minmn+1, _state);
14144 0 : s->ridx.ptr.p_int[0] = 0;
14145 0 : nz = 0;
14146 0 : for(i=0; i<=minmn-1; i++)
14147 : {
14148 0 : nz = nz+1+d->ptr.p_int[i]+u->ptr.p_int[i];
14149 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i]+1+d->ptr.p_int[i]+u->ptr.p_int[i];
14150 : }
14151 0 : rvectorsetlengthatleast(&s->vals, nz, _state);
14152 0 : for(i=0; i<=nz-1; i++)
14153 : {
14154 0 : s->vals.ptr.p_double[i] = 0.0;
14155 : }
14156 0 : ivectorsetlengthatleast(&s->didx, m+1, _state);
14157 0 : mxd = 0;
14158 0 : for(i=0; i<=m-1; i++)
14159 : {
14160 0 : s->didx.ptr.p_int[i] = d->ptr.p_int[i];
14161 0 : mxd = ae_maxint(mxd, d->ptr.p_int[i], _state);
14162 : }
14163 0 : s->didx.ptr.p_int[m] = mxd;
14164 0 : ivectorsetlengthatleast(&s->uidx, n+1, _state);
14165 0 : mxu = 0;
14166 0 : for(i=0; i<=n-1; i++)
14167 : {
14168 0 : s->uidx.ptr.p_int[i] = u->ptr.p_int[i];
14169 0 : mxu = ae_maxint(mxu, u->ptr.p_int[i], _state);
14170 : }
14171 0 : s->uidx.ptr.p_int[n] = mxu;
14172 0 : }
14173 :
14174 :
14175 : /*************************************************************************
14176 : This function creates sparse matrix in a SKS format (skyline storage
14177 : format). Unlike more general sparsecreatesks(), this function creates
14178 : sparse matrix with constant bandwidth.
14179 :
14180 : You may want to use this function instead of sparsecreatesks() when your
14181 : matrix has constant or nearly-constant bandwidth, and you want to
14182 : simplify source code.
14183 :
14184 : INPUT PARAMETERS
14185 : M, N - number of rows(M) and columns (N) in a matrix:
14186 : * M=N (as for now, ALGLIB supports only square SKS)
14187 : * N>=1
14188 : * M>=1
14189 : BW - matrix bandwidth, BW>=0
14190 :
14191 : OUTPUT PARAMETERS
14192 : S - sparse M*N matrix in SKS representation.
14193 : All elements are filled by zeros.
14194 : You may use sparseset() to change their values.
14195 :
14196 : NOTE: this function completely overwrites S with new sparse matrix.
14197 : Previously allocated storage is NOT reused. If you want to reuse
14198 : already allocated memory, call sparsecreatesksbandbuf function.
14199 :
14200 : -- ALGLIB PROJECT --
14201 : Copyright 25.12.2017 by Bochkanov Sergey
14202 : *************************************************************************/
14203 0 : void sparsecreatesksband(ae_int_t m,
14204 : ae_int_t n,
14205 : ae_int_t bw,
14206 : sparsematrix* s,
14207 : ae_state *_state)
14208 : {
14209 :
14210 0 : _sparsematrix_clear(s);
14211 :
14212 0 : ae_assert(m>0, "SparseCreateSKSBand: M<=0", _state);
14213 0 : ae_assert(n>0, "SparseCreateSKSBand: N<=0", _state);
14214 0 : ae_assert(bw>=0, "SparseCreateSKSBand: BW<0", _state);
14215 0 : ae_assert(m==n, "SparseCreateSKSBand: M!=N", _state);
14216 0 : sparsecreatesksbandbuf(m, n, bw, s, _state);
14217 0 : }
14218 :
14219 :
14220 : /*************************************************************************
14221 : This is "buffered" version of sparsecreatesksband() which reuses memory
14222 : previously allocated in S (of course, memory is reallocated if needed).
14223 :
14224 : You may want to use this function instead of sparsecreatesksbuf() when
14225 : your matrix has constant or nearly-constant bandwidth, and you want to
14226 : simplify source code.
14227 :
14228 : INPUT PARAMETERS
14229 : M, N - number of rows(M) and columns (N) in a matrix:
14230 : * M=N (as for now, ALGLIB supports only square SKS)
14231 : * N>=1
14232 : * M>=1
14233 : BW - bandwidth, BW>=0
14234 :
14235 : OUTPUT PARAMETERS
14236 : S - sparse M*N matrix in SKS representation.
14237 : All elements are filled by zeros.
14238 : You may use sparseset() to change their values.
14239 :
14240 : -- ALGLIB PROJECT --
14241 : Copyright 13.01.2014 by Bochkanov Sergey
14242 : *************************************************************************/
14243 0 : void sparsecreatesksbandbuf(ae_int_t m,
14244 : ae_int_t n,
14245 : ae_int_t bw,
14246 : sparsematrix* s,
14247 : ae_state *_state)
14248 : {
14249 : ae_int_t i;
14250 : ae_int_t minmn;
14251 : ae_int_t nz;
14252 : ae_int_t mxd;
14253 : ae_int_t mxu;
14254 : ae_int_t dui;
14255 :
14256 :
14257 0 : ae_assert(m>0, "SparseCreateSKSBandBuf: M<=0", _state);
14258 0 : ae_assert(n>0, "SparseCreateSKSBandBuf: N<=0", _state);
14259 0 : ae_assert(m==n, "SparseCreateSKSBandBuf: M!=N", _state);
14260 0 : ae_assert(bw>=0, "SparseCreateSKSBandBuf: BW<0", _state);
14261 0 : minmn = ae_minint(m, n, _state);
14262 0 : s->matrixtype = 2;
14263 0 : s->ninitialized = 0;
14264 0 : s->m = m;
14265 0 : s->n = n;
14266 0 : ivectorsetlengthatleast(&s->ridx, minmn+1, _state);
14267 0 : s->ridx.ptr.p_int[0] = 0;
14268 0 : nz = 0;
14269 0 : for(i=0; i<=minmn-1; i++)
14270 : {
14271 0 : dui = ae_minint(i, bw, _state);
14272 0 : nz = nz+1+2*dui;
14273 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i]+1+2*dui;
14274 : }
14275 0 : rvectorsetlengthatleast(&s->vals, nz, _state);
14276 0 : for(i=0; i<=nz-1; i++)
14277 : {
14278 0 : s->vals.ptr.p_double[i] = 0.0;
14279 : }
14280 0 : ivectorsetlengthatleast(&s->didx, m+1, _state);
14281 0 : mxd = 0;
14282 0 : for(i=0; i<=m-1; i++)
14283 : {
14284 0 : dui = ae_minint(i, bw, _state);
14285 0 : s->didx.ptr.p_int[i] = dui;
14286 0 : mxd = ae_maxint(mxd, dui, _state);
14287 : }
14288 0 : s->didx.ptr.p_int[m] = mxd;
14289 0 : ivectorsetlengthatleast(&s->uidx, n+1, _state);
14290 0 : mxu = 0;
14291 0 : for(i=0; i<=n-1; i++)
14292 : {
14293 0 : dui = ae_minint(i, bw, _state);
14294 0 : s->uidx.ptr.p_int[i] = dui;
14295 0 : mxu = ae_maxint(mxu, dui, _state);
14296 : }
14297 0 : s->uidx.ptr.p_int[n] = mxu;
14298 0 : }
14299 :
14300 :
14301 : /*************************************************************************
14302 : This function copies S0 to S1.
14303 : This function completely deallocates memory owned by S1 before creating a
14304 : copy of S0. If you want to reuse memory, use SparseCopyBuf.
14305 :
14306 : NOTE: this function does not verify its arguments, it just copies all
14307 : fields of the structure.
14308 :
14309 : -- ALGLIB PROJECT --
14310 : Copyright 14.10.2011 by Bochkanov Sergey
14311 : *************************************************************************/
14312 0 : void sparsecopy(sparsematrix* s0, sparsematrix* s1, ae_state *_state)
14313 : {
14314 :
14315 0 : _sparsematrix_clear(s1);
14316 :
14317 0 : sparsecopybuf(s0, s1, _state);
14318 0 : }
14319 :
14320 :
14321 : /*************************************************************************
14322 : This function copies S0 to S1.
14323 : Memory already allocated in S1 is reused as much as possible.
14324 :
14325 : NOTE: this function does not verify its arguments, it just copies all
14326 : fields of the structure.
14327 :
14328 : -- ALGLIB PROJECT --
14329 : Copyright 14.10.2011 by Bochkanov Sergey
14330 : *************************************************************************/
14331 0 : void sparsecopybuf(sparsematrix* s0, sparsematrix* s1, ae_state *_state)
14332 : {
14333 : ae_int_t l;
14334 : ae_int_t i;
14335 :
14336 :
14337 0 : s1->matrixtype = s0->matrixtype;
14338 0 : s1->m = s0->m;
14339 0 : s1->n = s0->n;
14340 0 : s1->nfree = s0->nfree;
14341 0 : s1->ninitialized = s0->ninitialized;
14342 0 : s1->tablesize = s0->tablesize;
14343 :
14344 : /*
14345 : * Initialization for arrays
14346 : */
14347 0 : l = s0->vals.cnt;
14348 0 : rvectorsetlengthatleast(&s1->vals, l, _state);
14349 0 : for(i=0; i<=l-1; i++)
14350 : {
14351 0 : s1->vals.ptr.p_double[i] = s0->vals.ptr.p_double[i];
14352 : }
14353 0 : l = s0->ridx.cnt;
14354 0 : ivectorsetlengthatleast(&s1->ridx, l, _state);
14355 0 : for(i=0; i<=l-1; i++)
14356 : {
14357 0 : s1->ridx.ptr.p_int[i] = s0->ridx.ptr.p_int[i];
14358 : }
14359 0 : l = s0->idx.cnt;
14360 0 : ivectorsetlengthatleast(&s1->idx, l, _state);
14361 0 : for(i=0; i<=l-1; i++)
14362 : {
14363 0 : s1->idx.ptr.p_int[i] = s0->idx.ptr.p_int[i];
14364 : }
14365 :
14366 : /*
14367 : * Initalization for CRS-parameters
14368 : */
14369 0 : l = s0->uidx.cnt;
14370 0 : ivectorsetlengthatleast(&s1->uidx, l, _state);
14371 0 : for(i=0; i<=l-1; i++)
14372 : {
14373 0 : s1->uidx.ptr.p_int[i] = s0->uidx.ptr.p_int[i];
14374 : }
14375 0 : l = s0->didx.cnt;
14376 0 : ivectorsetlengthatleast(&s1->didx, l, _state);
14377 0 : for(i=0; i<=l-1; i++)
14378 : {
14379 0 : s1->didx.ptr.p_int[i] = s0->didx.ptr.p_int[i];
14380 : }
14381 0 : }
14382 :
14383 :
14384 : /*************************************************************************
14385 : This function efficiently swaps contents of S0 and S1.
14386 :
14387 : -- ALGLIB PROJECT --
14388 : Copyright 16.01.2014 by Bochkanov Sergey
14389 : *************************************************************************/
14390 0 : void sparseswap(sparsematrix* s0, sparsematrix* s1, ae_state *_state)
14391 : {
14392 :
14393 :
14394 0 : swapi(&s1->matrixtype, &s0->matrixtype, _state);
14395 0 : swapi(&s1->m, &s0->m, _state);
14396 0 : swapi(&s1->n, &s0->n, _state);
14397 0 : swapi(&s1->nfree, &s0->nfree, _state);
14398 0 : swapi(&s1->ninitialized, &s0->ninitialized, _state);
14399 0 : swapi(&s1->tablesize, &s0->tablesize, _state);
14400 0 : ae_swap_vectors(&s1->vals, &s0->vals);
14401 0 : ae_swap_vectors(&s1->ridx, &s0->ridx);
14402 0 : ae_swap_vectors(&s1->idx, &s0->idx);
14403 0 : ae_swap_vectors(&s1->uidx, &s0->uidx);
14404 0 : ae_swap_vectors(&s1->didx, &s0->didx);
14405 0 : }
14406 :
14407 :
14408 : /*************************************************************************
14409 : This function adds value to S[i,j] - element of the sparse matrix. Matrix
14410 : must be in a Hash-Table mode.
14411 :
14412 : In case S[i,j] already exists in the table, V i added to its value. In
14413 : case S[i,j] is non-existent, it is inserted in the table. Table
14414 : automatically grows when necessary.
14415 :
14416 : INPUT PARAMETERS
14417 : S - sparse M*N matrix in Hash-Table representation.
14418 : Exception will be thrown for CRS matrix.
14419 : I - row index of the element to modify, 0<=I<M
14420 : J - column index of the element to modify, 0<=J<N
14421 : V - value to add, must be finite number
14422 :
14423 : OUTPUT PARAMETERS
14424 : S - modified matrix
14425 :
14426 : NOTE 1: when S[i,j] is exactly zero after modification, it is deleted
14427 : from the table.
14428 :
14429 : -- ALGLIB PROJECT --
14430 : Copyright 14.10.2011 by Bochkanov Sergey
14431 : *************************************************************************/
14432 0 : void sparseadd(sparsematrix* s,
14433 : ae_int_t i,
14434 : ae_int_t j,
14435 : double v,
14436 : ae_state *_state)
14437 : {
14438 : ae_int_t hashcode;
14439 : ae_int_t tcode;
14440 : ae_int_t k;
14441 :
14442 :
14443 0 : ae_assert(s->matrixtype==0, "SparseAdd: matrix must be in the Hash-Table mode to do this operation", _state);
14444 0 : ae_assert(i>=0, "SparseAdd: I<0", _state);
14445 0 : ae_assert(i<s->m, "SparseAdd: I>=M", _state);
14446 0 : ae_assert(j>=0, "SparseAdd: J<0", _state);
14447 0 : ae_assert(j<s->n, "SparseAdd: J>=N", _state);
14448 0 : ae_assert(ae_isfinite(v, _state), "SparseAdd: V is not finite number", _state);
14449 0 : if( ae_fp_eq(v,(double)(0)) )
14450 : {
14451 0 : return;
14452 : }
14453 0 : tcode = -1;
14454 0 : k = s->tablesize;
14455 0 : if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,(double)(s->nfree)) )
14456 : {
14457 0 : sparseresizematrix(s, _state);
14458 0 : k = s->tablesize;
14459 : }
14460 0 : hashcode = sparse_hash(i, j, k, _state);
14461 : for(;;)
14462 : {
14463 0 : if( s->idx.ptr.p_int[2*hashcode]==-1 )
14464 : {
14465 0 : if( tcode!=-1 )
14466 : {
14467 0 : hashcode = tcode;
14468 : }
14469 0 : s->vals.ptr.p_double[hashcode] = v;
14470 0 : s->idx.ptr.p_int[2*hashcode] = i;
14471 0 : s->idx.ptr.p_int[2*hashcode+1] = j;
14472 0 : if( tcode==-1 )
14473 : {
14474 0 : s->nfree = s->nfree-1;
14475 : }
14476 0 : return;
14477 : }
14478 : else
14479 : {
14480 0 : if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j )
14481 : {
14482 0 : s->vals.ptr.p_double[hashcode] = s->vals.ptr.p_double[hashcode]+v;
14483 0 : if( ae_fp_eq(s->vals.ptr.p_double[hashcode],(double)(0)) )
14484 : {
14485 0 : s->idx.ptr.p_int[2*hashcode] = -2;
14486 : }
14487 0 : return;
14488 : }
14489 :
14490 : /*
14491 : * Is it deleted element?
14492 : */
14493 0 : if( tcode==-1&&s->idx.ptr.p_int[2*hashcode]==-2 )
14494 : {
14495 0 : tcode = hashcode;
14496 : }
14497 :
14498 : /*
14499 : * Next step
14500 : */
14501 0 : hashcode = (hashcode+1)%k;
14502 : }
14503 : }
14504 : }
14505 :
14506 :
14507 : /*************************************************************************
14508 : This function modifies S[i,j] - element of the sparse matrix.
14509 :
14510 : For Hash-based storage format:
14511 : * this function can be called at any moment - during matrix initialization
14512 : or later
14513 : * new value can be zero or non-zero. In case new value of S[i,j] is zero,
14514 : this element is deleted from the table.
14515 : * this function has no effect when called with zero V for non-existent
14516 : element.
14517 :
14518 : For CRS-bases storage format:
14519 : * this function can be called ONLY DURING MATRIX INITIALIZATION
14520 : * zero values are stored in the matrix similarly to non-zero ones
14521 : * elements must be initialized in correct order - from top row to bottom,
14522 : within row - from left to right.
14523 :
14524 : For SKS storage:
14525 : * this function can be called at any moment - during matrix initialization
14526 : or later
14527 : * zero values are stored in the matrix similarly to non-zero ones
14528 : * this function CAN NOT be called for non-existent (outside of the band
14529 : specified during SKS matrix creation) elements. Say, if you created SKS
14530 : matrix with bandwidth=2 and tried to call sparseset(s,0,10,VAL), an
14531 : exception will be generated.
14532 :
14533 : INPUT PARAMETERS
14534 : S - sparse M*N matrix in Hash-Table, SKS or CRS format.
14535 : I - row index of the element to modify, 0<=I<M
14536 : J - column index of the element to modify, 0<=J<N
14537 : V - value to set, must be finite number, can be zero
14538 :
14539 : OUTPUT PARAMETERS
14540 : S - modified matrix
14541 :
14542 : -- ALGLIB PROJECT --
14543 : Copyright 14.10.2011 by Bochkanov Sergey
14544 : *************************************************************************/
14545 0 : void sparseset(sparsematrix* s,
14546 : ae_int_t i,
14547 : ae_int_t j,
14548 : double v,
14549 : ae_state *_state)
14550 : {
14551 : ae_int_t hashcode;
14552 : ae_int_t tcode;
14553 : ae_int_t k;
14554 : ae_bool b;
14555 :
14556 :
14557 0 : ae_assert((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2, "SparseSet: unsupported matrix storage format", _state);
14558 0 : ae_assert(i>=0, "SparseSet: I<0", _state);
14559 0 : ae_assert(i<s->m, "SparseSet: I>=M", _state);
14560 0 : ae_assert(j>=0, "SparseSet: J<0", _state);
14561 0 : ae_assert(j<s->n, "SparseSet: J>=N", _state);
14562 0 : ae_assert(ae_isfinite(v, _state), "SparseSet: V is not finite number", _state);
14563 :
14564 : /*
14565 : * Hash-table matrix
14566 : */
14567 0 : if( s->matrixtype==0 )
14568 : {
14569 0 : tcode = -1;
14570 0 : k = s->tablesize;
14571 0 : if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,(double)(s->nfree)) )
14572 : {
14573 0 : sparseresizematrix(s, _state);
14574 0 : k = s->tablesize;
14575 : }
14576 0 : hashcode = sparse_hash(i, j, k, _state);
14577 : for(;;)
14578 : {
14579 0 : if( s->idx.ptr.p_int[2*hashcode]==-1 )
14580 : {
14581 0 : if( ae_fp_neq(v,(double)(0)) )
14582 : {
14583 0 : if( tcode!=-1 )
14584 : {
14585 0 : hashcode = tcode;
14586 : }
14587 0 : s->vals.ptr.p_double[hashcode] = v;
14588 0 : s->idx.ptr.p_int[2*hashcode] = i;
14589 0 : s->idx.ptr.p_int[2*hashcode+1] = j;
14590 0 : if( tcode==-1 )
14591 : {
14592 0 : s->nfree = s->nfree-1;
14593 : }
14594 : }
14595 0 : return;
14596 : }
14597 : else
14598 : {
14599 0 : if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j )
14600 : {
14601 0 : if( ae_fp_eq(v,(double)(0)) )
14602 : {
14603 0 : s->idx.ptr.p_int[2*hashcode] = -2;
14604 : }
14605 : else
14606 : {
14607 0 : s->vals.ptr.p_double[hashcode] = v;
14608 : }
14609 0 : return;
14610 : }
14611 0 : if( tcode==-1&&s->idx.ptr.p_int[2*hashcode]==-2 )
14612 : {
14613 0 : tcode = hashcode;
14614 : }
14615 :
14616 : /*
14617 : * Next step
14618 : */
14619 0 : hashcode = (hashcode+1)%k;
14620 : }
14621 : }
14622 : }
14623 :
14624 : /*
14625 : * CRS matrix
14626 : */
14627 0 : if( s->matrixtype==1 )
14628 : {
14629 0 : ae_assert(s->ridx.ptr.p_int[i]<=s->ninitialized, "SparseSet: too few initialized elements at some row (you have promised more when called SparceCreateCRS)", _state);
14630 0 : ae_assert(s->ridx.ptr.p_int[i+1]>s->ninitialized, "SparseSet: too many initialized elements at some row (you have promised less when called SparceCreateCRS)", _state);
14631 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[i]||s->idx.ptr.p_int[s->ninitialized-1]<j, "SparseSet: incorrect column order (you must fill every row from left to right)", _state);
14632 0 : s->vals.ptr.p_double[s->ninitialized] = v;
14633 0 : s->idx.ptr.p_int[s->ninitialized] = j;
14634 0 : s->ninitialized = s->ninitialized+1;
14635 :
14636 : /*
14637 : * If matrix has been created then
14638 : * initiale 'S.UIdx' and 'S.DIdx'
14639 : */
14640 0 : if( s->ninitialized==s->ridx.ptr.p_int[s->m] )
14641 : {
14642 0 : sparseinitduidx(s, _state);
14643 : }
14644 0 : return;
14645 : }
14646 :
14647 : /*
14648 : * SKS matrix
14649 : */
14650 0 : if( s->matrixtype==2 )
14651 : {
14652 0 : b = sparserewriteexisting(s, i, j, v, _state);
14653 0 : ae_assert(b, "SparseSet: an attempt to initialize out-of-band element of the SKS matrix", _state);
14654 0 : return;
14655 : }
14656 : }
14657 :
14658 :
14659 : /*************************************************************************
14660 : This function returns S[i,j] - element of the sparse matrix. Matrix can
14661 : be in any mode (Hash-Table, CRS, SKS), but this function is less efficient
14662 : for CRS matrices. Hash-Table and SKS matrices can find element in O(1)
14663 : time, while CRS matrices need O(log(RS)) time, where RS is an number of
14664 : non-zero elements in a row.
14665 :
14666 : INPUT PARAMETERS
14667 : S - sparse M*N matrix
14668 : I - row index of the element to modify, 0<=I<M
14669 : J - column index of the element to modify, 0<=J<N
14670 :
14671 : RESULT
14672 : value of S[I,J] or zero (in case no element with such index is found)
14673 :
14674 : -- ALGLIB PROJECT --
14675 : Copyright 14.10.2011 by Bochkanov Sergey
14676 : *************************************************************************/
14677 0 : double sparseget(sparsematrix* s,
14678 : ae_int_t i,
14679 : ae_int_t j,
14680 : ae_state *_state)
14681 : {
14682 : ae_int_t hashcode;
14683 : ae_int_t k;
14684 : ae_int_t k0;
14685 : ae_int_t k1;
14686 : double result;
14687 :
14688 :
14689 0 : ae_assert(i>=0, "SparseGet: I<0", _state);
14690 0 : ae_assert(i<s->m, "SparseGet: I>=M", _state);
14691 0 : ae_assert(j>=0, "SparseGet: J<0", _state);
14692 0 : ae_assert(j<s->n, "SparseGet: J>=N", _state);
14693 0 : result = 0.0;
14694 0 : if( s->matrixtype==0 )
14695 : {
14696 :
14697 : /*
14698 : * Hash-based storage
14699 : */
14700 0 : result = (double)(0);
14701 0 : k = s->tablesize;
14702 0 : hashcode = sparse_hash(i, j, k, _state);
14703 : for(;;)
14704 : {
14705 0 : if( s->idx.ptr.p_int[2*hashcode]==-1 )
14706 : {
14707 0 : return result;
14708 : }
14709 0 : if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j )
14710 : {
14711 0 : result = s->vals.ptr.p_double[hashcode];
14712 0 : return result;
14713 : }
14714 0 : hashcode = (hashcode+1)%k;
14715 : }
14716 : }
14717 0 : if( s->matrixtype==1 )
14718 : {
14719 :
14720 : /*
14721 : * CRS
14722 : */
14723 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGet: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
14724 0 : k0 = s->ridx.ptr.p_int[i];
14725 0 : k1 = s->ridx.ptr.p_int[i+1]-1;
14726 0 : result = (double)(0);
14727 0 : while(k0<=k1)
14728 : {
14729 0 : k = (k0+k1)/2;
14730 0 : if( s->idx.ptr.p_int[k]==j )
14731 : {
14732 0 : result = s->vals.ptr.p_double[k];
14733 0 : return result;
14734 : }
14735 0 : if( s->idx.ptr.p_int[k]<j )
14736 : {
14737 0 : k0 = k+1;
14738 : }
14739 : else
14740 : {
14741 0 : k1 = k-1;
14742 : }
14743 : }
14744 0 : return result;
14745 : }
14746 0 : if( s->matrixtype==2 )
14747 : {
14748 :
14749 : /*
14750 : * SKS
14751 : */
14752 0 : ae_assert(s->m==s->n, "SparseGet: non-square SKS matrix not supported", _state);
14753 0 : result = (double)(0);
14754 0 : if( i==j )
14755 : {
14756 :
14757 : /*
14758 : * Return diagonal element
14759 : */
14760 0 : result = s->vals.ptr.p_double[s->ridx.ptr.p_int[i]+s->didx.ptr.p_int[i]];
14761 0 : return result;
14762 : }
14763 0 : if( j<i )
14764 : {
14765 :
14766 : /*
14767 : * Return subdiagonal element at I-th "skyline block"
14768 : */
14769 0 : k = s->didx.ptr.p_int[i];
14770 0 : if( i-j<=k )
14771 : {
14772 0 : result = s->vals.ptr.p_double[s->ridx.ptr.p_int[i]+k+j-i];
14773 : }
14774 : }
14775 : else
14776 : {
14777 :
14778 : /*
14779 : * Return superdiagonal element at J-th "skyline block"
14780 : */
14781 0 : k = s->uidx.ptr.p_int[j];
14782 0 : if( j-i<=k )
14783 : {
14784 0 : result = s->vals.ptr.p_double[s->ridx.ptr.p_int[j+1]-(j-i)];
14785 : }
14786 0 : return result;
14787 : }
14788 0 : return result;
14789 : }
14790 0 : ae_assert(ae_false, "SparseGet: unexpected matrix type", _state);
14791 0 : return result;
14792 : }
14793 :
14794 :
14795 : /*************************************************************************
14796 : This function checks whether S[i,j] is present in the sparse matrix. It
14797 : returns True even for elements that are numerically zero (but still
14798 : have place allocated for them).
14799 :
14800 : The matrix can be in any mode (Hash-Table, CRS, SKS), but this function
14801 : is less efficient for CRS matrices. Hash-Table and SKS matrices can find
14802 : element in O(1) time, while CRS matrices need O(log(RS)) time, where RS
14803 : is an number of non-zero elements in a row.
14804 :
14805 : INPUT PARAMETERS
14806 : S - sparse M*N matrix
14807 : I - row index of the element to modify, 0<=I<M
14808 : J - column index of the element to modify, 0<=J<N
14809 :
14810 : RESULT
14811 : whether S[I,J] is present in the data structure or not
14812 :
14813 : -- ALGLIB PROJECT --
14814 : Copyright 14.10.2020 by Bochkanov Sergey
14815 : *************************************************************************/
14816 0 : ae_bool sparseexists(sparsematrix* s,
14817 : ae_int_t i,
14818 : ae_int_t j,
14819 : ae_state *_state)
14820 : {
14821 : ae_int_t hashcode;
14822 : ae_int_t k;
14823 : ae_int_t k0;
14824 : ae_int_t k1;
14825 : ae_bool result;
14826 :
14827 :
14828 0 : ae_assert(i>=0, "SparseExists: I<0", _state);
14829 0 : ae_assert(i<s->m, "SparseExists: I>=M", _state);
14830 0 : ae_assert(j>=0, "SparseExists: J<0", _state);
14831 0 : ae_assert(j<s->n, "SparseExists: J>=N", _state);
14832 0 : result = ae_false;
14833 0 : if( s->matrixtype==0 )
14834 : {
14835 :
14836 : /*
14837 : * Hash-based storage
14838 : */
14839 0 : k = s->tablesize;
14840 0 : hashcode = sparse_hash(i, j, k, _state);
14841 : for(;;)
14842 : {
14843 0 : if( s->idx.ptr.p_int[2*hashcode]==-1 )
14844 : {
14845 0 : return result;
14846 : }
14847 0 : if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j )
14848 : {
14849 0 : result = ae_true;
14850 0 : return result;
14851 : }
14852 0 : hashcode = (hashcode+1)%k;
14853 : }
14854 : }
14855 0 : if( s->matrixtype==1 )
14856 : {
14857 :
14858 : /*
14859 : * CRS
14860 : */
14861 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseExists: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
14862 0 : k0 = s->ridx.ptr.p_int[i];
14863 0 : k1 = s->ridx.ptr.p_int[i+1]-1;
14864 0 : while(k0<=k1)
14865 : {
14866 0 : k = (k0+k1)/2;
14867 0 : if( s->idx.ptr.p_int[k]==j )
14868 : {
14869 0 : result = ae_true;
14870 0 : return result;
14871 : }
14872 0 : if( s->idx.ptr.p_int[k]<j )
14873 : {
14874 0 : k0 = k+1;
14875 : }
14876 : else
14877 : {
14878 0 : k1 = k-1;
14879 : }
14880 : }
14881 0 : return result;
14882 : }
14883 0 : if( s->matrixtype==2 )
14884 : {
14885 :
14886 : /*
14887 : * SKS
14888 : */
14889 0 : ae_assert(s->m==s->n, "SparseExists: non-square SKS matrix not supported", _state);
14890 0 : if( i==j )
14891 : {
14892 :
14893 : /*
14894 : * Return diagonal element
14895 : */
14896 0 : result = ae_true;
14897 0 : return result;
14898 : }
14899 0 : if( j<i )
14900 : {
14901 :
14902 : /*
14903 : * Return subdiagonal element at I-th "skyline block"
14904 : */
14905 0 : if( i-j<=s->didx.ptr.p_int[i] )
14906 : {
14907 0 : result = ae_true;
14908 : }
14909 : }
14910 : else
14911 : {
14912 :
14913 : /*
14914 : * Return superdiagonal element at J-th "skyline block"
14915 : */
14916 0 : if( j-i<=s->uidx.ptr.p_int[j] )
14917 : {
14918 0 : result = ae_true;
14919 : }
14920 0 : return result;
14921 : }
14922 0 : return result;
14923 : }
14924 0 : ae_assert(ae_false, "SparseExists: unexpected matrix type", _state);
14925 0 : return result;
14926 : }
14927 :
14928 :
14929 : /*************************************************************************
14930 : This function returns I-th diagonal element of the sparse matrix.
14931 :
14932 : Matrix can be in any mode (Hash-Table or CRS storage), but this function
14933 : is most efficient for CRS matrices - it requires less than 50 CPU cycles
14934 : to extract diagonal element. For Hash-Table matrices we still have O(1)
14935 : query time, but function is many times slower.
14936 :
14937 : INPUT PARAMETERS
14938 : S - sparse M*N matrix in Hash-Table representation.
14939 : Exception will be thrown for CRS matrix.
14940 : I - index of the element to modify, 0<=I<min(M,N)
14941 :
14942 : RESULT
14943 : value of S[I,I] or zero (in case no element with such index is found)
14944 :
14945 : -- ALGLIB PROJECT --
14946 : Copyright 14.10.2011 by Bochkanov Sergey
14947 : *************************************************************************/
14948 0 : double sparsegetdiagonal(sparsematrix* s, ae_int_t i, ae_state *_state)
14949 : {
14950 : double result;
14951 :
14952 :
14953 0 : ae_assert(i>=0, "SparseGetDiagonal: I<0", _state);
14954 0 : ae_assert(i<s->m, "SparseGetDiagonal: I>=M", _state);
14955 0 : ae_assert(i<s->n, "SparseGetDiagonal: I>=N", _state);
14956 0 : result = (double)(0);
14957 0 : if( s->matrixtype==0 )
14958 : {
14959 0 : result = sparseget(s, i, i, _state);
14960 0 : return result;
14961 : }
14962 0 : if( s->matrixtype==1 )
14963 : {
14964 0 : if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] )
14965 : {
14966 0 : result = s->vals.ptr.p_double[s->didx.ptr.p_int[i]];
14967 : }
14968 0 : return result;
14969 : }
14970 0 : if( s->matrixtype==2 )
14971 : {
14972 0 : ae_assert(s->m==s->n, "SparseGetDiagonal: non-square SKS matrix not supported", _state);
14973 0 : result = s->vals.ptr.p_double[s->ridx.ptr.p_int[i]+s->didx.ptr.p_int[i]];
14974 0 : return result;
14975 : }
14976 0 : ae_assert(ae_false, "SparseGetDiagonal: unexpected matrix type", _state);
14977 0 : return result;
14978 : }
14979 :
14980 :
14981 : /*************************************************************************
14982 : This function calculates matrix-vector product S*x. Matrix S must be
14983 : stored in CRS or SKS format (exception will be thrown otherwise).
14984 :
14985 : INPUT PARAMETERS
14986 : S - sparse M*N matrix in CRS or SKS format.
14987 : X - array[N], input vector. For performance reasons we
14988 : make only quick checks - we check that array size is
14989 : at least N, but we do not check for NAN's or INF's.
14990 : Y - output buffer, possibly preallocated. In case buffer
14991 : size is too small to store result, this buffer is
14992 : automatically resized.
14993 :
14994 : OUTPUT PARAMETERS
14995 : Y - array[M], S*x
14996 :
14997 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
14998 : You must convert your matrix with SparseConvertToCRS/SKS() before using
14999 : this function.
15000 :
15001 : -- ALGLIB PROJECT --
15002 : Copyright 14.10.2011 by Bochkanov Sergey
15003 : *************************************************************************/
15004 0 : void sparsemv(sparsematrix* s,
15005 : /* Real */ ae_vector* x,
15006 : /* Real */ ae_vector* y,
15007 : ae_state *_state)
15008 : {
15009 : double tval;
15010 : double v;
15011 : double vv;
15012 : ae_int_t i;
15013 : ae_int_t j;
15014 : ae_int_t lt;
15015 : ae_int_t rt;
15016 : ae_int_t lt1;
15017 : ae_int_t rt1;
15018 : ae_int_t n;
15019 : ae_int_t m;
15020 : ae_int_t d;
15021 : ae_int_t u;
15022 : ae_int_t ri;
15023 : ae_int_t ri1;
15024 :
15025 :
15026 0 : ae_assert(x->cnt>=s->n, "SparseMV: length(X)<N", _state);
15027 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15028 0 : rvectorsetlengthatleast(y, s->m, _state);
15029 0 : n = s->n;
15030 0 : m = s->m;
15031 0 : if( s->matrixtype==1 )
15032 : {
15033 :
15034 : /*
15035 : * CRS format.
15036 : * Perform integrity check.
15037 : */
15038 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15039 :
15040 : /*
15041 : * Try vendor kernels
15042 : */
15043 0 : if( sparsegemvcrsmkl(0, s->m, s->n, 1.0, &s->vals, &s->idx, &s->ridx, x, 0, 0.0, y, 0, _state) )
15044 : {
15045 0 : return;
15046 : }
15047 :
15048 : /*
15049 : * Our own implementation
15050 : */
15051 0 : for(i=0; i<=m-1; i++)
15052 : {
15053 0 : tval = (double)(0);
15054 0 : lt = s->ridx.ptr.p_int[i];
15055 0 : rt = s->ridx.ptr.p_int[i+1]-1;
15056 0 : for(j=lt; j<=rt; j++)
15057 : {
15058 0 : tval = tval+x->ptr.p_double[s->idx.ptr.p_int[j]]*s->vals.ptr.p_double[j];
15059 : }
15060 0 : y->ptr.p_double[i] = tval;
15061 : }
15062 0 : return;
15063 : }
15064 0 : if( s->matrixtype==2 )
15065 : {
15066 :
15067 : /*
15068 : * SKS format
15069 : */
15070 0 : ae_assert(s->m==s->n, "SparseMV: non-square SKS matrices are not supported", _state);
15071 0 : for(i=0; i<=n-1; i++)
15072 : {
15073 0 : ri = s->ridx.ptr.p_int[i];
15074 0 : ri1 = s->ridx.ptr.p_int[i+1];
15075 0 : d = s->didx.ptr.p_int[i];
15076 0 : u = s->uidx.ptr.p_int[i];
15077 0 : v = s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i];
15078 0 : if( d>0 )
15079 : {
15080 0 : lt = ri;
15081 0 : rt = ri+d-1;
15082 0 : lt1 = i-d;
15083 0 : rt1 = i-1;
15084 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15085 0 : v = v+vv;
15086 : }
15087 0 : y->ptr.p_double[i] = v;
15088 0 : if( u>0 )
15089 : {
15090 0 : lt = ri1-u;
15091 0 : rt = ri1-1;
15092 0 : lt1 = i-u;
15093 0 : rt1 = i-1;
15094 0 : v = x->ptr.p_double[i];
15095 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15096 : }
15097 : }
15098 0 : return;
15099 : }
15100 : }
15101 :
15102 :
15103 : /*************************************************************************
15104 : This function calculates matrix-vector product S^T*x. Matrix S must be
15105 : stored in CRS or SKS format (exception will be thrown otherwise).
15106 :
15107 : INPUT PARAMETERS
15108 : S - sparse M*N matrix in CRS or SKS format.
15109 : X - array[M], input vector. For performance reasons we
15110 : make only quick checks - we check that array size is
15111 : at least M, but we do not check for NAN's or INF's.
15112 : Y - output buffer, possibly preallocated. In case buffer
15113 : size is too small to store result, this buffer is
15114 : automatically resized.
15115 :
15116 : OUTPUT PARAMETERS
15117 : Y - array[N], S^T*x
15118 :
15119 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15120 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15121 : this function.
15122 :
15123 : -- ALGLIB PROJECT --
15124 : Copyright 14.10.2011 by Bochkanov Sergey
15125 : *************************************************************************/
15126 0 : void sparsemtv(sparsematrix* s,
15127 : /* Real */ ae_vector* x,
15128 : /* Real */ ae_vector* y,
15129 : ae_state *_state)
15130 : {
15131 : ae_int_t i;
15132 : ae_int_t j;
15133 : ae_int_t lt;
15134 : ae_int_t rt;
15135 : ae_int_t ct;
15136 : ae_int_t lt1;
15137 : ae_int_t rt1;
15138 : double v;
15139 : double vv;
15140 : ae_int_t n;
15141 : ae_int_t m;
15142 : ae_int_t ri;
15143 : ae_int_t ri1;
15144 : ae_int_t d;
15145 : ae_int_t u;
15146 :
15147 :
15148 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMTV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15149 0 : ae_assert(x->cnt>=s->m, "SparseMTV: Length(X)<M", _state);
15150 0 : n = s->n;
15151 0 : m = s->m;
15152 0 : rvectorsetlengthatleast(y, n, _state);
15153 0 : for(i=0; i<=n-1; i++)
15154 : {
15155 0 : y->ptr.p_double[i] = (double)(0);
15156 : }
15157 0 : if( s->matrixtype==1 )
15158 : {
15159 :
15160 : /*
15161 : * CRS format
15162 : * Perform integrity check.
15163 : */
15164 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[m], "SparseMTV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15165 :
15166 : /*
15167 : * Try vendor kernels
15168 : */
15169 0 : if( sparsegemvcrsmkl(1, s->m, s->n, 1.0, &s->vals, &s->idx, &s->ridx, x, 0, 0.0, y, 0, _state) )
15170 : {
15171 0 : return;
15172 : }
15173 :
15174 : /*
15175 : * Our own implementation
15176 : */
15177 0 : for(i=0; i<=m-1; i++)
15178 : {
15179 0 : lt = s->ridx.ptr.p_int[i];
15180 0 : rt = s->ridx.ptr.p_int[i+1];
15181 0 : v = x->ptr.p_double[i];
15182 0 : for(j=lt; j<=rt-1; j++)
15183 : {
15184 0 : ct = s->idx.ptr.p_int[j];
15185 0 : y->ptr.p_double[ct] = y->ptr.p_double[ct]+v*s->vals.ptr.p_double[j];
15186 : }
15187 : }
15188 0 : return;
15189 : }
15190 0 : if( s->matrixtype==2 )
15191 : {
15192 :
15193 : /*
15194 : * SKS format
15195 : */
15196 0 : ae_assert(s->m==s->n, "SparseMV: non-square SKS matrices are not supported", _state);
15197 0 : for(i=0; i<=n-1; i++)
15198 : {
15199 0 : ri = s->ridx.ptr.p_int[i];
15200 0 : ri1 = s->ridx.ptr.p_int[i+1];
15201 0 : d = s->didx.ptr.p_int[i];
15202 0 : u = s->uidx.ptr.p_int[i];
15203 0 : if( d>0 )
15204 : {
15205 0 : lt = ri;
15206 0 : rt = ri+d-1;
15207 0 : lt1 = i-d;
15208 0 : rt1 = i-1;
15209 0 : v = x->ptr.p_double[i];
15210 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15211 : }
15212 0 : v = s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i];
15213 0 : if( u>0 )
15214 : {
15215 0 : lt = ri1-u;
15216 0 : rt = ri1-1;
15217 0 : lt1 = i-u;
15218 0 : rt1 = i-1;
15219 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15220 0 : v = v+vv;
15221 : }
15222 0 : y->ptr.p_double[i] = v;
15223 : }
15224 0 : return;
15225 : }
15226 : }
15227 :
15228 :
15229 : /*************************************************************************
15230 : This function calculates generalized sparse matrix-vector product
15231 :
15232 : y := alpha*op(S)*x + beta*y
15233 :
15234 : Matrix S must be stored in CRS or SKS format (exception will be thrown
15235 : otherwise). op(S) can be either S or S^T.
15236 :
15237 : NOTE: this function expects Y to be large enough to store result. No
15238 : automatic preallocation happens for smaller arrays.
15239 :
15240 : INPUT PARAMETERS
15241 : S - sparse matrix in CRS or SKS format.
15242 : Alpha - source coefficient
15243 : OpS - operation type:
15244 : * OpS=0 => op(S) = S
15245 : * OpS=1 => op(S) = S^T
15246 : X - input vector, must have at least Cols(op(S))+IX elements
15247 : IX - subvector offset
15248 : Beta - destination coefficient
15249 : Y - preallocated output array, must have at least Rows(op(S))+IY elements
15250 : IY - subvector offset
15251 :
15252 : OUTPUT PARAMETERS
15253 : Y - elements [IY...IY+Rows(op(S))-1] are replaced by result,
15254 : other elements are not modified
15255 :
15256 : HANDLING OF SPECIAL CASES:
15257 : * below M=Rows(op(S)) and N=Cols(op(S)). Although current ALGLIB version
15258 : does not allow you to create zero-sized sparse matrices, internally
15259 : ALGLIB can deal with such matrices. So, comments for M or N equal to
15260 : zero are for internal use only.
15261 : * if M=0, then subroutine does nothing. It does not even touch arrays.
15262 : * if N=0 or Alpha=0.0, then:
15263 : * if Beta=0, then Y is filled by zeros. S and X are not referenced at
15264 : all. Initial values of Y are ignored (we do not multiply Y by zero,
15265 : we just rewrite it by zeros)
15266 : * if Beta<>0, then Y is replaced by Beta*Y
15267 : * if M>0, N>0, Alpha<>0, but Beta=0, then Y is replaced by alpha*op(S)*x
15268 : initial state of Y is ignored (rewritten without initial multiplication
15269 : by zeros).
15270 :
15271 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15272 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15273 : this function.
15274 :
15275 : -- ALGLIB PROJECT --
15276 : Copyright 10.12.2019 by Bochkanov Sergey
15277 : *************************************************************************/
15278 0 : void sparsegemv(sparsematrix* s,
15279 : double alpha,
15280 : ae_int_t ops,
15281 : /* Real */ ae_vector* x,
15282 : ae_int_t ix,
15283 : double beta,
15284 : /* Real */ ae_vector* y,
15285 : ae_int_t iy,
15286 : ae_state *_state)
15287 : {
15288 : ae_int_t opm;
15289 : ae_int_t opn;
15290 : ae_int_t rawm;
15291 : ae_int_t rawn;
15292 : ae_int_t i;
15293 : ae_int_t j;
15294 : double tval;
15295 : ae_int_t lt;
15296 : ae_int_t rt;
15297 : ae_int_t ct;
15298 : ae_int_t d;
15299 : ae_int_t u;
15300 : ae_int_t ri;
15301 : ae_int_t ri1;
15302 : double v;
15303 : double vv;
15304 : ae_int_t lt1;
15305 : ae_int_t rt1;
15306 :
15307 :
15308 0 : ae_assert(ops==0||ops==1, "SparseGEMV: incorrect OpS", _state);
15309 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseGEMV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15310 0 : if( ops==0 )
15311 : {
15312 0 : opm = s->m;
15313 0 : opn = s->n;
15314 : }
15315 : else
15316 : {
15317 0 : opm = s->n;
15318 0 : opn = s->m;
15319 : }
15320 0 : ae_assert(opm>=0&&opn>=0, "SparseGEMV: op(S) has negative size", _state);
15321 0 : ae_assert(opn==0||x->cnt+ix>=opn, "SparseGEMV: X is too short", _state);
15322 0 : ae_assert(opm==0||y->cnt+iy>=opm, "SparseGEMV: X is too short", _state);
15323 0 : rawm = s->m;
15324 0 : rawn = s->n;
15325 :
15326 : /*
15327 : * Quick exit strategies
15328 : */
15329 0 : if( opm==0 )
15330 : {
15331 0 : return;
15332 : }
15333 0 : if( ae_fp_neq(beta,(double)(0)) )
15334 : {
15335 0 : for(i=0; i<=opm-1; i++)
15336 : {
15337 0 : y->ptr.p_double[iy+i] = beta*y->ptr.p_double[iy+i];
15338 : }
15339 : }
15340 : else
15341 : {
15342 0 : for(i=0; i<=opm-1; i++)
15343 : {
15344 0 : y->ptr.p_double[iy+i] = 0.0;
15345 : }
15346 : }
15347 0 : if( opn==0||ae_fp_eq(alpha,(double)(0)) )
15348 : {
15349 0 : return;
15350 : }
15351 :
15352 : /*
15353 : * Now we have OpM>=1, OpN>=1, Alpha<>0
15354 : */
15355 0 : if( ops==0 )
15356 : {
15357 :
15358 : /*
15359 : * Compute generalized product y := alpha*S*x + beta*y
15360 : * (with "beta*y" part already computed).
15361 : */
15362 0 : if( s->matrixtype==1 )
15363 : {
15364 :
15365 : /*
15366 : * CRS format.
15367 : * Perform integrity check.
15368 : */
15369 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGEMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15370 :
15371 : /*
15372 : * Try vendor kernels
15373 : */
15374 0 : if( sparsegemvcrsmkl(0, s->m, s->n, alpha, &s->vals, &s->idx, &s->ridx, x, ix, 1.0, y, iy, _state) )
15375 : {
15376 0 : return;
15377 : }
15378 :
15379 : /*
15380 : * Our own implementation
15381 : */
15382 0 : for(i=0; i<=rawm-1; i++)
15383 : {
15384 0 : tval = (double)(0);
15385 0 : lt = s->ridx.ptr.p_int[i];
15386 0 : rt = s->ridx.ptr.p_int[i+1]-1;
15387 0 : for(j=lt; j<=rt; j++)
15388 : {
15389 0 : tval = tval+x->ptr.p_double[s->idx.ptr.p_int[j]+ix]*s->vals.ptr.p_double[j];
15390 : }
15391 0 : y->ptr.p_double[i+iy] = alpha*tval+y->ptr.p_double[i+iy];
15392 : }
15393 0 : return;
15394 : }
15395 0 : if( s->matrixtype==2 )
15396 : {
15397 :
15398 : /*
15399 : * SKS format
15400 : */
15401 0 : ae_assert(s->m==s->n, "SparseMV: non-square SKS matrices are not supported", _state);
15402 0 : for(i=0; i<=rawn-1; i++)
15403 : {
15404 0 : ri = s->ridx.ptr.p_int[i];
15405 0 : ri1 = s->ridx.ptr.p_int[i+1];
15406 0 : d = s->didx.ptr.p_int[i];
15407 0 : u = s->uidx.ptr.p_int[i];
15408 0 : v = s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i+ix];
15409 0 : if( d>0 )
15410 : {
15411 0 : lt = ri;
15412 0 : rt = ri+d-1;
15413 0 : lt1 = i-d+ix;
15414 0 : rt1 = i-1+ix;
15415 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15416 0 : v = v+vv;
15417 : }
15418 0 : y->ptr.p_double[i+iy] = alpha*v+y->ptr.p_double[i+iy];
15419 0 : if( u>0 )
15420 : {
15421 0 : lt = ri1-u;
15422 0 : rt = ri1-1;
15423 0 : lt1 = i-u+iy;
15424 0 : rt1 = i-1+iy;
15425 0 : v = alpha*x->ptr.p_double[i+ix];
15426 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15427 : }
15428 : }
15429 0 : return;
15430 : }
15431 : }
15432 : else
15433 : {
15434 :
15435 : /*
15436 : * Compute generalized product y := alpha*S^T*x + beta*y
15437 : * (with "beta*y" part already computed).
15438 : */
15439 0 : if( s->matrixtype==1 )
15440 : {
15441 :
15442 : /*
15443 : * CRS format
15444 : * Perform integrity check.
15445 : */
15446 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGEMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15447 :
15448 : /*
15449 : * Try vendor kernels
15450 : */
15451 0 : if( sparsegemvcrsmkl(1, s->m, s->n, alpha, &s->vals, &s->idx, &s->ridx, x, ix, 1.0, y, iy, _state) )
15452 : {
15453 0 : return;
15454 : }
15455 :
15456 : /*
15457 : * Our own implementation
15458 : */
15459 0 : for(i=0; i<=rawm-1; i++)
15460 : {
15461 0 : lt = s->ridx.ptr.p_int[i];
15462 0 : rt = s->ridx.ptr.p_int[i+1];
15463 0 : v = alpha*x->ptr.p_double[i+ix];
15464 0 : for(j=lt; j<=rt-1; j++)
15465 : {
15466 0 : ct = s->idx.ptr.p_int[j]+iy;
15467 0 : y->ptr.p_double[ct] = y->ptr.p_double[ct]+v*s->vals.ptr.p_double[j];
15468 : }
15469 : }
15470 0 : return;
15471 : }
15472 0 : if( s->matrixtype==2 )
15473 : {
15474 :
15475 : /*
15476 : * SKS format
15477 : */
15478 0 : ae_assert(s->m==s->n, "SparseGEMV: non-square SKS matrices are not supported", _state);
15479 0 : for(i=0; i<=rawn-1; i++)
15480 : {
15481 0 : ri = s->ridx.ptr.p_int[i];
15482 0 : ri1 = s->ridx.ptr.p_int[i+1];
15483 0 : d = s->didx.ptr.p_int[i];
15484 0 : u = s->uidx.ptr.p_int[i];
15485 0 : if( d>0 )
15486 : {
15487 0 : lt = ri;
15488 0 : rt = ri+d-1;
15489 0 : lt1 = i-d+iy;
15490 0 : rt1 = i-1+iy;
15491 0 : v = alpha*x->ptr.p_double[i+ix];
15492 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15493 : }
15494 0 : v = alpha*s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i+ix];
15495 0 : if( u>0 )
15496 : {
15497 0 : lt = ri1-u;
15498 0 : rt = ri1-1;
15499 0 : lt1 = i-u+ix;
15500 0 : rt1 = i-1+ix;
15501 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15502 0 : v = v+alpha*vv;
15503 : }
15504 0 : y->ptr.p_double[i+iy] = v+y->ptr.p_double[i+iy];
15505 : }
15506 0 : return;
15507 : }
15508 : }
15509 : }
15510 :
15511 :
15512 : /*************************************************************************
15513 : This function simultaneously calculates two matrix-vector products:
15514 : S*x and S^T*x.
15515 : S must be square (non-rectangular) matrix stored in CRS or SKS format
15516 : (exception will be thrown otherwise).
15517 :
15518 : INPUT PARAMETERS
15519 : S - sparse N*N matrix in CRS or SKS format.
15520 : X - array[N], input vector. For performance reasons we
15521 : make only quick checks - we check that array size is
15522 : at least N, but we do not check for NAN's or INF's.
15523 : Y0 - output buffer, possibly preallocated. In case buffer
15524 : size is too small to store result, this buffer is
15525 : automatically resized.
15526 : Y1 - output buffer, possibly preallocated. In case buffer
15527 : size is too small to store result, this buffer is
15528 : automatically resized.
15529 :
15530 : OUTPUT PARAMETERS
15531 : Y0 - array[N], S*x
15532 : Y1 - array[N], S^T*x
15533 :
15534 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15535 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15536 : this function.
15537 :
15538 : -- ALGLIB PROJECT --
15539 : Copyright 14.10.2011 by Bochkanov Sergey
15540 : *************************************************************************/
15541 0 : void sparsemv2(sparsematrix* s,
15542 : /* Real */ ae_vector* x,
15543 : /* Real */ ae_vector* y0,
15544 : /* Real */ ae_vector* y1,
15545 : ae_state *_state)
15546 : {
15547 : ae_int_t l;
15548 : double tval;
15549 : ae_int_t i;
15550 : ae_int_t j;
15551 : double vx;
15552 : double vs;
15553 : double v;
15554 : double vv;
15555 : double vd0;
15556 : double vd1;
15557 : ae_int_t vi;
15558 : ae_int_t j0;
15559 : ae_int_t j1;
15560 : ae_int_t n;
15561 : ae_int_t ri;
15562 : ae_int_t ri1;
15563 : ae_int_t d;
15564 : ae_int_t u;
15565 : ae_int_t lt;
15566 : ae_int_t rt;
15567 : ae_int_t lt1;
15568 : ae_int_t rt1;
15569 :
15570 :
15571 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMV2: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15572 0 : ae_assert(s->m==s->n, "SparseMV2: matrix is non-square", _state);
15573 0 : l = x->cnt;
15574 0 : ae_assert(l>=s->n, "SparseMV2: Length(X)<N", _state);
15575 0 : n = s->n;
15576 0 : rvectorsetlengthatleast(y0, l, _state);
15577 0 : rvectorsetlengthatleast(y1, l, _state);
15578 0 : for(i=0; i<=n-1; i++)
15579 : {
15580 0 : y0->ptr.p_double[i] = (double)(0);
15581 0 : y1->ptr.p_double[i] = (double)(0);
15582 : }
15583 0 : if( s->matrixtype==1 )
15584 : {
15585 :
15586 : /*
15587 : * CRS format
15588 : */
15589 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV2: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15590 0 : for(i=0; i<=s->m-1; i++)
15591 : {
15592 0 : tval = (double)(0);
15593 0 : vx = x->ptr.p_double[i];
15594 0 : j0 = s->ridx.ptr.p_int[i];
15595 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
15596 0 : for(j=j0; j<=j1; j++)
15597 : {
15598 0 : vi = s->idx.ptr.p_int[j];
15599 0 : vs = s->vals.ptr.p_double[j];
15600 0 : tval = tval+x->ptr.p_double[vi]*vs;
15601 0 : y1->ptr.p_double[vi] = y1->ptr.p_double[vi]+vx*vs;
15602 : }
15603 0 : y0->ptr.p_double[i] = tval;
15604 : }
15605 0 : return;
15606 : }
15607 0 : if( s->matrixtype==2 )
15608 : {
15609 :
15610 : /*
15611 : * SKS format
15612 : */
15613 0 : for(i=0; i<=n-1; i++)
15614 : {
15615 0 : ri = s->ridx.ptr.p_int[i];
15616 0 : ri1 = s->ridx.ptr.p_int[i+1];
15617 0 : d = s->didx.ptr.p_int[i];
15618 0 : u = s->uidx.ptr.p_int[i];
15619 0 : vd0 = s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i];
15620 0 : vd1 = vd0;
15621 0 : if( d>0 )
15622 : {
15623 0 : lt = ri;
15624 0 : rt = ri+d-1;
15625 0 : lt1 = i-d;
15626 0 : rt1 = i-1;
15627 0 : v = x->ptr.p_double[i];
15628 0 : ae_v_addd(&y1->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15629 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15630 0 : vd0 = vd0+vv;
15631 : }
15632 0 : if( u>0 )
15633 : {
15634 0 : lt = ri1-u;
15635 0 : rt = ri1-1;
15636 0 : lt1 = i-u;
15637 0 : rt1 = i-1;
15638 0 : v = x->ptr.p_double[i];
15639 0 : ae_v_addd(&y0->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15640 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15641 0 : vd1 = vd1+vv;
15642 : }
15643 0 : y0->ptr.p_double[i] = vd0;
15644 0 : y1->ptr.p_double[i] = vd1;
15645 : }
15646 0 : return;
15647 : }
15648 : }
15649 :
15650 :
15651 : /*************************************************************************
15652 : This function calculates matrix-vector product S*x, when S is symmetric
15653 : matrix. Matrix S must be stored in CRS or SKS format (exception will be
15654 : thrown otherwise).
15655 :
15656 : INPUT PARAMETERS
15657 : S - sparse M*M matrix in CRS or SKS format.
15658 : IsUpper - whether upper or lower triangle of S is given:
15659 : * if upper triangle is given, only S[i,j] for j>=i
15660 : are used, and lower triangle is ignored (it can be
15661 : empty - these elements are not referenced at all).
15662 : * if lower triangle is given, only S[i,j] for j<=i
15663 : are used, and upper triangle is ignored.
15664 : X - array[N], input vector. For performance reasons we
15665 : make only quick checks - we check that array size is
15666 : at least N, but we do not check for NAN's or INF's.
15667 : Y - output buffer, possibly preallocated. In case buffer
15668 : size is too small to store result, this buffer is
15669 : automatically resized.
15670 :
15671 : OUTPUT PARAMETERS
15672 : Y - array[M], S*x
15673 :
15674 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15675 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15676 : this function.
15677 :
15678 : -- ALGLIB PROJECT --
15679 : Copyright 14.10.2011 by Bochkanov Sergey
15680 : *************************************************************************/
15681 0 : void sparsesmv(sparsematrix* s,
15682 : ae_bool isupper,
15683 : /* Real */ ae_vector* x,
15684 : /* Real */ ae_vector* y,
15685 : ae_state *_state)
15686 : {
15687 : ae_int_t n;
15688 : ae_int_t i;
15689 : ae_int_t j;
15690 : ae_int_t id;
15691 : ae_int_t lt;
15692 : ae_int_t rt;
15693 : double v;
15694 : double vv;
15695 : double vy;
15696 : double vx;
15697 : double vd;
15698 : ae_int_t ri;
15699 : ae_int_t ri1;
15700 : ae_int_t d;
15701 : ae_int_t u;
15702 : ae_int_t lt1;
15703 : ae_int_t rt1;
15704 :
15705 :
15706 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseSMV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15707 0 : ae_assert(x->cnt>=s->n, "SparseSMV: length(X)<N", _state);
15708 0 : ae_assert(s->m==s->n, "SparseSMV: non-square matrix", _state);
15709 0 : n = s->n;
15710 0 : rvectorsetlengthatleast(y, n, _state);
15711 0 : for(i=0; i<=n-1; i++)
15712 : {
15713 0 : y->ptr.p_double[i] = (double)(0);
15714 : }
15715 0 : if( s->matrixtype==1 )
15716 : {
15717 :
15718 : /*
15719 : * CRS format
15720 : */
15721 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15722 0 : for(i=0; i<=n-1; i++)
15723 : {
15724 0 : if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] )
15725 : {
15726 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+s->vals.ptr.p_double[s->didx.ptr.p_int[i]]*x->ptr.p_double[s->idx.ptr.p_int[s->didx.ptr.p_int[i]]];
15727 : }
15728 0 : if( isupper )
15729 : {
15730 0 : lt = s->uidx.ptr.p_int[i];
15731 0 : rt = s->ridx.ptr.p_int[i+1];
15732 0 : vy = (double)(0);
15733 0 : vx = x->ptr.p_double[i];
15734 0 : for(j=lt; j<=rt-1; j++)
15735 : {
15736 0 : id = s->idx.ptr.p_int[j];
15737 0 : v = s->vals.ptr.p_double[j];
15738 0 : vy = vy+x->ptr.p_double[id]*v;
15739 0 : y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v;
15740 : }
15741 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+vy;
15742 : }
15743 : else
15744 : {
15745 0 : lt = s->ridx.ptr.p_int[i];
15746 0 : rt = s->didx.ptr.p_int[i];
15747 0 : vy = (double)(0);
15748 0 : vx = x->ptr.p_double[i];
15749 0 : for(j=lt; j<=rt-1; j++)
15750 : {
15751 0 : id = s->idx.ptr.p_int[j];
15752 0 : v = s->vals.ptr.p_double[j];
15753 0 : vy = vy+x->ptr.p_double[id]*v;
15754 0 : y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v;
15755 : }
15756 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+vy;
15757 : }
15758 : }
15759 0 : return;
15760 : }
15761 0 : if( s->matrixtype==2 )
15762 : {
15763 :
15764 : /*
15765 : * SKS format
15766 : */
15767 0 : for(i=0; i<=n-1; i++)
15768 : {
15769 0 : ri = s->ridx.ptr.p_int[i];
15770 0 : ri1 = s->ridx.ptr.p_int[i+1];
15771 0 : d = s->didx.ptr.p_int[i];
15772 0 : u = s->uidx.ptr.p_int[i];
15773 0 : vd = s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i];
15774 0 : if( d>0&&!isupper )
15775 : {
15776 0 : lt = ri;
15777 0 : rt = ri+d-1;
15778 0 : lt1 = i-d;
15779 0 : rt1 = i-1;
15780 0 : v = x->ptr.p_double[i];
15781 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15782 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15783 0 : vd = vd+vv;
15784 : }
15785 0 : if( u>0&&isupper )
15786 : {
15787 0 : lt = ri1-u;
15788 0 : rt = ri1-1;
15789 0 : lt1 = i-u;
15790 0 : rt1 = i-1;
15791 0 : v = x->ptr.p_double[i];
15792 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
15793 0 : vv = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
15794 0 : vd = vd+vv;
15795 : }
15796 0 : y->ptr.p_double[i] = vd;
15797 : }
15798 0 : return;
15799 : }
15800 : }
15801 :
15802 :
15803 : /*************************************************************************
15804 : This function calculates vector-matrix-vector product x'*S*x, where S is
15805 : symmetric matrix. Matrix S must be stored in CRS or SKS format (exception
15806 : will be thrown otherwise).
15807 :
15808 : INPUT PARAMETERS
15809 : S - sparse M*M matrix in CRS or SKS format.
15810 : IsUpper - whether upper or lower triangle of S is given:
15811 : * if upper triangle is given, only S[i,j] for j>=i
15812 : are used, and lower triangle is ignored (it can be
15813 : empty - these elements are not referenced at all).
15814 : * if lower triangle is given, only S[i,j] for j<=i
15815 : are used, and upper triangle is ignored.
15816 : X - array[N], input vector. For performance reasons we
15817 : make only quick checks - we check that array size is
15818 : at least N, but we do not check for NAN's or INF's.
15819 :
15820 : RESULT
15821 : x'*S*x
15822 :
15823 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15824 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15825 : this function.
15826 :
15827 : -- ALGLIB PROJECT --
15828 : Copyright 27.01.2014 by Bochkanov Sergey
15829 : *************************************************************************/
15830 0 : double sparsevsmv(sparsematrix* s,
15831 : ae_bool isupper,
15832 : /* Real */ ae_vector* x,
15833 : ae_state *_state)
15834 : {
15835 : ae_int_t n;
15836 : ae_int_t i;
15837 : ae_int_t j;
15838 : ae_int_t k;
15839 : ae_int_t id;
15840 : ae_int_t lt;
15841 : ae_int_t rt;
15842 : double v;
15843 : double v0;
15844 : double v1;
15845 : ae_int_t ri;
15846 : ae_int_t ri1;
15847 : ae_int_t d;
15848 : ae_int_t u;
15849 : ae_int_t lt1;
15850 : double result;
15851 :
15852 :
15853 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseVSMV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15854 0 : ae_assert(x->cnt>=s->n, "SparseVSMV: length(X)<N", _state);
15855 0 : ae_assert(s->m==s->n, "SparseVSMV: non-square matrix", _state);
15856 0 : n = s->n;
15857 0 : result = 0.0;
15858 0 : if( s->matrixtype==1 )
15859 : {
15860 :
15861 : /*
15862 : * CRS format
15863 : */
15864 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseVSMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
15865 0 : for(i=0; i<=n-1; i++)
15866 : {
15867 0 : if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] )
15868 : {
15869 0 : v = x->ptr.p_double[s->idx.ptr.p_int[s->didx.ptr.p_int[i]]];
15870 0 : result = result+v*s->vals.ptr.p_double[s->didx.ptr.p_int[i]]*v;
15871 : }
15872 0 : if( isupper )
15873 : {
15874 0 : lt = s->uidx.ptr.p_int[i];
15875 0 : rt = s->ridx.ptr.p_int[i+1];
15876 : }
15877 : else
15878 : {
15879 0 : lt = s->ridx.ptr.p_int[i];
15880 0 : rt = s->didx.ptr.p_int[i];
15881 : }
15882 0 : v0 = x->ptr.p_double[i];
15883 0 : for(j=lt; j<=rt-1; j++)
15884 : {
15885 0 : id = s->idx.ptr.p_int[j];
15886 0 : v1 = x->ptr.p_double[id];
15887 0 : v = s->vals.ptr.p_double[j];
15888 0 : result = result+2*v0*v1*v;
15889 : }
15890 : }
15891 0 : return result;
15892 : }
15893 0 : if( s->matrixtype==2 )
15894 : {
15895 :
15896 : /*
15897 : * SKS format
15898 : */
15899 0 : for(i=0; i<=n-1; i++)
15900 : {
15901 0 : ri = s->ridx.ptr.p_int[i];
15902 0 : ri1 = s->ridx.ptr.p_int[i+1];
15903 0 : d = s->didx.ptr.p_int[i];
15904 0 : u = s->uidx.ptr.p_int[i];
15905 0 : v = x->ptr.p_double[i];
15906 0 : result = result+v*s->vals.ptr.p_double[ri+d]*v;
15907 0 : if( d>0&&!isupper )
15908 : {
15909 0 : lt = ri;
15910 0 : rt = ri+d-1;
15911 0 : lt1 = i-d;
15912 0 : k = d-1;
15913 0 : v0 = x->ptr.p_double[i];
15914 0 : v = 0.0;
15915 0 : for(j=0; j<=k; j++)
15916 : {
15917 0 : v = v+x->ptr.p_double[lt1+j]*s->vals.ptr.p_double[lt+j];
15918 : }
15919 0 : result = result+2*v0*v;
15920 : }
15921 0 : if( u>0&&isupper )
15922 : {
15923 0 : lt = ri1-u;
15924 0 : rt = ri1-1;
15925 0 : lt1 = i-u;
15926 0 : k = u-1;
15927 0 : v0 = x->ptr.p_double[i];
15928 0 : v = 0.0;
15929 0 : for(j=0; j<=k; j++)
15930 : {
15931 0 : v = v+x->ptr.p_double[lt1+j]*s->vals.ptr.p_double[lt+j];
15932 : }
15933 0 : result = result+2*v0*v;
15934 : }
15935 : }
15936 0 : return result;
15937 : }
15938 0 : return result;
15939 : }
15940 :
15941 :
15942 : /*************************************************************************
15943 : This function calculates matrix-matrix product S*A. Matrix S must be
15944 : stored in CRS or SKS format (exception will be thrown otherwise).
15945 :
15946 : INPUT PARAMETERS
15947 : S - sparse M*N matrix in CRS or SKS format.
15948 : A - array[N][K], input dense matrix. For performance reasons
15949 : we make only quick checks - we check that array size
15950 : is at least N, but we do not check for NAN's or INF's.
15951 : K - number of columns of matrix (A).
15952 : B - output buffer, possibly preallocated. In case buffer
15953 : size is too small to store result, this buffer is
15954 : automatically resized.
15955 :
15956 : OUTPUT PARAMETERS
15957 : B - array[M][K], S*A
15958 :
15959 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
15960 : You must convert your matrix with SparseConvertToCRS/SKS() before using
15961 : this function.
15962 :
15963 : -- ALGLIB PROJECT --
15964 : Copyright 14.10.2011 by Bochkanov Sergey
15965 : *************************************************************************/
15966 0 : void sparsemm(sparsematrix* s,
15967 : /* Real */ ae_matrix* a,
15968 : ae_int_t k,
15969 : /* Real */ ae_matrix* b,
15970 : ae_state *_state)
15971 : {
15972 : double tval;
15973 : double v;
15974 : ae_int_t id;
15975 : ae_int_t i;
15976 : ae_int_t j;
15977 : ae_int_t k0;
15978 : ae_int_t k1;
15979 : ae_int_t lt;
15980 : ae_int_t rt;
15981 : ae_int_t m;
15982 : ae_int_t n;
15983 : ae_int_t ri;
15984 : ae_int_t ri1;
15985 : ae_int_t lt1;
15986 : ae_int_t rt1;
15987 : ae_int_t d;
15988 : ae_int_t u;
15989 : double vd;
15990 :
15991 :
15992 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMM: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
15993 0 : ae_assert(a->rows>=s->n, "SparseMM: Rows(A)<N", _state);
15994 0 : ae_assert(k>0, "SparseMM: K<=0", _state);
15995 0 : m = s->m;
15996 0 : n = s->n;
15997 0 : k1 = k-1;
15998 0 : rmatrixsetlengthatleast(b, m, k, _state);
15999 0 : for(i=0; i<=m-1; i++)
16000 : {
16001 0 : for(j=0; j<=k-1; j++)
16002 : {
16003 0 : b->ptr.pp_double[i][j] = (double)(0);
16004 : }
16005 : }
16006 0 : if( s->matrixtype==1 )
16007 : {
16008 :
16009 : /*
16010 : * CRS format
16011 : */
16012 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[m], "SparseMM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
16013 0 : if( k<sparse_linalgswitch )
16014 : {
16015 0 : for(i=0; i<=m-1; i++)
16016 : {
16017 0 : for(j=0; j<=k-1; j++)
16018 : {
16019 0 : tval = (double)(0);
16020 0 : lt = s->ridx.ptr.p_int[i];
16021 0 : rt = s->ridx.ptr.p_int[i+1];
16022 0 : for(k0=lt; k0<=rt-1; k0++)
16023 : {
16024 0 : tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[s->idx.ptr.p_int[k0]][j];
16025 : }
16026 0 : b->ptr.pp_double[i][j] = tval;
16027 : }
16028 : }
16029 : }
16030 : else
16031 : {
16032 0 : for(i=0; i<=m-1; i++)
16033 : {
16034 0 : lt = s->ridx.ptr.p_int[i];
16035 0 : rt = s->ridx.ptr.p_int[i+1];
16036 0 : for(j=lt; j<=rt-1; j++)
16037 : {
16038 0 : id = s->idx.ptr.p_int[j];
16039 0 : v = s->vals.ptr.p_double[j];
16040 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v);
16041 : }
16042 : }
16043 : }
16044 0 : return;
16045 : }
16046 0 : if( s->matrixtype==2 )
16047 : {
16048 :
16049 : /*
16050 : * SKS format
16051 : */
16052 0 : ae_assert(m==n, "SparseMM: non-square SKS matrices are not supported", _state);
16053 0 : for(i=0; i<=n-1; i++)
16054 : {
16055 0 : ri = s->ridx.ptr.p_int[i];
16056 0 : ri1 = s->ridx.ptr.p_int[i+1];
16057 0 : d = s->didx.ptr.p_int[i];
16058 0 : u = s->uidx.ptr.p_int[i];
16059 0 : if( d>0 )
16060 : {
16061 0 : lt = ri;
16062 0 : rt = ri+d-1;
16063 0 : lt1 = i-d;
16064 0 : rt1 = i-1;
16065 0 : for(j=lt1; j<=rt1; j++)
16066 : {
16067 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16068 0 : if( k<sparse_linalgswitch )
16069 : {
16070 :
16071 : /*
16072 : * Use loop
16073 : */
16074 0 : for(k0=0; k0<=k1; k0++)
16075 : {
16076 0 : b->ptr.pp_double[i][k0] = b->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16077 : }
16078 : }
16079 : else
16080 : {
16081 :
16082 : /*
16083 : * Use vector operation
16084 : */
16085 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16086 : }
16087 : }
16088 : }
16089 0 : if( u>0 )
16090 : {
16091 0 : lt = ri1-u;
16092 0 : rt = ri1-1;
16093 0 : lt1 = i-u;
16094 0 : rt1 = i-1;
16095 0 : for(j=lt1; j<=rt1; j++)
16096 : {
16097 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16098 0 : if( k<sparse_linalgswitch )
16099 : {
16100 :
16101 : /*
16102 : * Use loop
16103 : */
16104 0 : for(k0=0; k0<=k1; k0++)
16105 : {
16106 0 : b->ptr.pp_double[j][k0] = b->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16107 : }
16108 : }
16109 : else
16110 : {
16111 :
16112 : /*
16113 : * Use vector operation
16114 : */
16115 0 : ae_v_addd(&b->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16116 : }
16117 : }
16118 : }
16119 0 : vd = s->vals.ptr.p_double[ri+d];
16120 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), vd);
16121 : }
16122 0 : return;
16123 : }
16124 : }
16125 :
16126 :
16127 : /*************************************************************************
16128 : This function calculates matrix-matrix product S^T*A. Matrix S must be
16129 : stored in CRS or SKS format (exception will be thrown otherwise).
16130 :
16131 : INPUT PARAMETERS
16132 : S - sparse M*N matrix in CRS or SKS format.
16133 : A - array[M][K], input dense matrix. For performance reasons
16134 : we make only quick checks - we check that array size is
16135 : at least M, but we do not check for NAN's or INF's.
16136 : K - number of columns of matrix (A).
16137 : B - output buffer, possibly preallocated. In case buffer
16138 : size is too small to store result, this buffer is
16139 : automatically resized.
16140 :
16141 : OUTPUT PARAMETERS
16142 : B - array[N][K], S^T*A
16143 :
16144 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
16145 : You must convert your matrix with SparseConvertToCRS/SKS() before using
16146 : this function.
16147 :
16148 : -- ALGLIB PROJECT --
16149 : Copyright 14.10.2011 by Bochkanov Sergey
16150 : *************************************************************************/
16151 0 : void sparsemtm(sparsematrix* s,
16152 : /* Real */ ae_matrix* a,
16153 : ae_int_t k,
16154 : /* Real */ ae_matrix* b,
16155 : ae_state *_state)
16156 : {
16157 : ae_int_t i;
16158 : ae_int_t j;
16159 : ae_int_t k0;
16160 : ae_int_t k1;
16161 : ae_int_t lt;
16162 : ae_int_t rt;
16163 : ae_int_t ct;
16164 : double v;
16165 : ae_int_t m;
16166 : ae_int_t n;
16167 : ae_int_t ri;
16168 : ae_int_t ri1;
16169 : ae_int_t lt1;
16170 : ae_int_t rt1;
16171 : ae_int_t d;
16172 : ae_int_t u;
16173 :
16174 :
16175 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMTM: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
16176 0 : ae_assert(a->rows>=s->m, "SparseMTM: Rows(A)<M", _state);
16177 0 : ae_assert(k>0, "SparseMTM: K<=0", _state);
16178 0 : m = s->m;
16179 0 : n = s->n;
16180 0 : k1 = k-1;
16181 0 : rmatrixsetlengthatleast(b, n, k, _state);
16182 0 : for(i=0; i<=n-1; i++)
16183 : {
16184 0 : for(j=0; j<=k-1; j++)
16185 : {
16186 0 : b->ptr.pp_double[i][j] = (double)(0);
16187 : }
16188 : }
16189 0 : if( s->matrixtype==1 )
16190 : {
16191 :
16192 : /*
16193 : * CRS format
16194 : */
16195 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[m], "SparseMTM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
16196 0 : if( k<sparse_linalgswitch )
16197 : {
16198 0 : for(i=0; i<=m-1; i++)
16199 : {
16200 0 : lt = s->ridx.ptr.p_int[i];
16201 0 : rt = s->ridx.ptr.p_int[i+1];
16202 0 : for(k0=lt; k0<=rt-1; k0++)
16203 : {
16204 0 : v = s->vals.ptr.p_double[k0];
16205 0 : ct = s->idx.ptr.p_int[k0];
16206 0 : for(j=0; j<=k-1; j++)
16207 : {
16208 0 : b->ptr.pp_double[ct][j] = b->ptr.pp_double[ct][j]+v*a->ptr.pp_double[i][j];
16209 : }
16210 : }
16211 : }
16212 : }
16213 : else
16214 : {
16215 0 : for(i=0; i<=m-1; i++)
16216 : {
16217 0 : lt = s->ridx.ptr.p_int[i];
16218 0 : rt = s->ridx.ptr.p_int[i+1];
16219 0 : for(j=lt; j<=rt-1; j++)
16220 : {
16221 0 : v = s->vals.ptr.p_double[j];
16222 0 : ct = s->idx.ptr.p_int[j];
16223 0 : ae_v_addd(&b->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16224 : }
16225 : }
16226 : }
16227 0 : return;
16228 : }
16229 0 : if( s->matrixtype==2 )
16230 : {
16231 :
16232 : /*
16233 : * SKS format
16234 : */
16235 0 : ae_assert(m==n, "SparseMTM: non-square SKS matrices are not supported", _state);
16236 0 : for(i=0; i<=n-1; i++)
16237 : {
16238 0 : ri = s->ridx.ptr.p_int[i];
16239 0 : ri1 = s->ridx.ptr.p_int[i+1];
16240 0 : d = s->didx.ptr.p_int[i];
16241 0 : u = s->uidx.ptr.p_int[i];
16242 0 : if( d>0 )
16243 : {
16244 0 : lt = ri;
16245 0 : rt = ri+d-1;
16246 0 : lt1 = i-d;
16247 0 : rt1 = i-1;
16248 0 : for(j=lt1; j<=rt1; j++)
16249 : {
16250 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16251 0 : if( k<sparse_linalgswitch )
16252 : {
16253 :
16254 : /*
16255 : * Use loop
16256 : */
16257 0 : for(k0=0; k0<=k1; k0++)
16258 : {
16259 0 : b->ptr.pp_double[j][k0] = b->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16260 : }
16261 : }
16262 : else
16263 : {
16264 :
16265 : /*
16266 : * Use vector operation
16267 : */
16268 0 : ae_v_addd(&b->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16269 : }
16270 : }
16271 : }
16272 0 : if( u>0 )
16273 : {
16274 0 : lt = ri1-u;
16275 0 : rt = ri1-1;
16276 0 : lt1 = i-u;
16277 0 : rt1 = i-1;
16278 0 : for(j=lt1; j<=rt1; j++)
16279 : {
16280 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16281 0 : if( k<sparse_linalgswitch )
16282 : {
16283 :
16284 : /*
16285 : * Use loop
16286 : */
16287 0 : for(k0=0; k0<=k1; k0++)
16288 : {
16289 0 : b->ptr.pp_double[i][k0] = b->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16290 : }
16291 : }
16292 : else
16293 : {
16294 :
16295 : /*
16296 : * Use vector operation
16297 : */
16298 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16299 : }
16300 : }
16301 : }
16302 0 : v = s->vals.ptr.p_double[ri+d];
16303 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16304 : }
16305 0 : return;
16306 : }
16307 : }
16308 :
16309 :
16310 : /*************************************************************************
16311 : This function simultaneously calculates two matrix-matrix products:
16312 : S*A and S^T*A.
16313 : S must be square (non-rectangular) matrix stored in CRS or SKS format
16314 : (exception will be thrown otherwise).
16315 :
16316 : INPUT PARAMETERS
16317 : S - sparse N*N matrix in CRS or SKS format.
16318 : A - array[N][K], input dense matrix. For performance reasons
16319 : we make only quick checks - we check that array size is
16320 : at least N, but we do not check for NAN's or INF's.
16321 : K - number of columns of matrix (A).
16322 : B0 - output buffer, possibly preallocated. In case buffer
16323 : size is too small to store result, this buffer is
16324 : automatically resized.
16325 : B1 - output buffer, possibly preallocated. In case buffer
16326 : size is too small to store result, this buffer is
16327 : automatically resized.
16328 :
16329 : OUTPUT PARAMETERS
16330 : B0 - array[N][K], S*A
16331 : B1 - array[N][K], S^T*A
16332 :
16333 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
16334 : You must convert your matrix with SparseConvertToCRS/SKS() before using
16335 : this function.
16336 :
16337 : -- ALGLIB PROJECT --
16338 : Copyright 14.10.2011 by Bochkanov Sergey
16339 : *************************************************************************/
16340 0 : void sparsemm2(sparsematrix* s,
16341 : /* Real */ ae_matrix* a,
16342 : ae_int_t k,
16343 : /* Real */ ae_matrix* b0,
16344 : /* Real */ ae_matrix* b1,
16345 : ae_state *_state)
16346 : {
16347 : ae_int_t i;
16348 : ae_int_t j;
16349 : ae_int_t k0;
16350 : ae_int_t lt;
16351 : ae_int_t rt;
16352 : ae_int_t ct;
16353 : double v;
16354 : double tval;
16355 : ae_int_t n;
16356 : ae_int_t k1;
16357 : ae_int_t ri;
16358 : ae_int_t ri1;
16359 : ae_int_t lt1;
16360 : ae_int_t rt1;
16361 : ae_int_t d;
16362 : ae_int_t u;
16363 :
16364 :
16365 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseMM2: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
16366 0 : ae_assert(s->m==s->n, "SparseMM2: matrix is non-square", _state);
16367 0 : ae_assert(a->rows>=s->n, "SparseMM2: Rows(A)<N", _state);
16368 0 : ae_assert(k>0, "SparseMM2: K<=0", _state);
16369 0 : n = s->n;
16370 0 : k1 = k-1;
16371 0 : rmatrixsetlengthatleast(b0, n, k, _state);
16372 0 : rmatrixsetlengthatleast(b1, n, k, _state);
16373 0 : for(i=0; i<=n-1; i++)
16374 : {
16375 0 : for(j=0; j<=k-1; j++)
16376 : {
16377 0 : b1->ptr.pp_double[i][j] = (double)(0);
16378 0 : b0->ptr.pp_double[i][j] = (double)(0);
16379 : }
16380 : }
16381 0 : if( s->matrixtype==1 )
16382 : {
16383 :
16384 : /*
16385 : * CRS format
16386 : */
16387 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMM2: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
16388 0 : if( k<sparse_linalgswitch )
16389 : {
16390 0 : for(i=0; i<=n-1; i++)
16391 : {
16392 0 : for(j=0; j<=k-1; j++)
16393 : {
16394 0 : tval = (double)(0);
16395 0 : lt = s->ridx.ptr.p_int[i];
16396 0 : rt = s->ridx.ptr.p_int[i+1];
16397 0 : v = a->ptr.pp_double[i][j];
16398 0 : for(k0=lt; k0<=rt-1; k0++)
16399 : {
16400 0 : ct = s->idx.ptr.p_int[k0];
16401 0 : b1->ptr.pp_double[ct][j] = b1->ptr.pp_double[ct][j]+s->vals.ptr.p_double[k0]*v;
16402 0 : tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[ct][j];
16403 : }
16404 0 : b0->ptr.pp_double[i][j] = tval;
16405 : }
16406 : }
16407 : }
16408 : else
16409 : {
16410 0 : for(i=0; i<=n-1; i++)
16411 : {
16412 0 : lt = s->ridx.ptr.p_int[i];
16413 0 : rt = s->ridx.ptr.p_int[i+1];
16414 0 : for(j=lt; j<=rt-1; j++)
16415 : {
16416 0 : v = s->vals.ptr.p_double[j];
16417 0 : ct = s->idx.ptr.p_int[j];
16418 0 : ae_v_addd(&b0->ptr.pp_double[i][0], 1, &a->ptr.pp_double[ct][0], 1, ae_v_len(0,k-1), v);
16419 0 : ae_v_addd(&b1->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16420 : }
16421 : }
16422 : }
16423 0 : return;
16424 : }
16425 0 : if( s->matrixtype==2 )
16426 : {
16427 :
16428 : /*
16429 : * SKS format
16430 : */
16431 0 : ae_assert(s->m==s->n, "SparseMM2: non-square SKS matrices are not supported", _state);
16432 0 : for(i=0; i<=n-1; i++)
16433 : {
16434 0 : ri = s->ridx.ptr.p_int[i];
16435 0 : ri1 = s->ridx.ptr.p_int[i+1];
16436 0 : d = s->didx.ptr.p_int[i];
16437 0 : u = s->uidx.ptr.p_int[i];
16438 0 : if( d>0 )
16439 : {
16440 0 : lt = ri;
16441 0 : rt = ri+d-1;
16442 0 : lt1 = i-d;
16443 0 : rt1 = i-1;
16444 0 : for(j=lt1; j<=rt1; j++)
16445 : {
16446 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16447 0 : if( k<sparse_linalgswitch )
16448 : {
16449 :
16450 : /*
16451 : * Use loop
16452 : */
16453 0 : for(k0=0; k0<=k1; k0++)
16454 : {
16455 0 : b0->ptr.pp_double[i][k0] = b0->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16456 0 : b1->ptr.pp_double[j][k0] = b1->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16457 : }
16458 : }
16459 : else
16460 : {
16461 :
16462 : /*
16463 : * Use vector operation
16464 : */
16465 0 : ae_v_addd(&b0->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16466 0 : ae_v_addd(&b1->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16467 : }
16468 : }
16469 : }
16470 0 : if( u>0 )
16471 : {
16472 0 : lt = ri1-u;
16473 0 : rt = ri1-1;
16474 0 : lt1 = i-u;
16475 0 : rt1 = i-1;
16476 0 : for(j=lt1; j<=rt1; j++)
16477 : {
16478 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16479 0 : if( k<sparse_linalgswitch )
16480 : {
16481 :
16482 : /*
16483 : * Use loop
16484 : */
16485 0 : for(k0=0; k0<=k1; k0++)
16486 : {
16487 0 : b0->ptr.pp_double[j][k0] = b0->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16488 0 : b1->ptr.pp_double[i][k0] = b1->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16489 : }
16490 : }
16491 : else
16492 : {
16493 :
16494 : /*
16495 : * Use vector operation
16496 : */
16497 0 : ae_v_addd(&b0->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16498 0 : ae_v_addd(&b1->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16499 : }
16500 : }
16501 : }
16502 0 : v = s->vals.ptr.p_double[ri+d];
16503 0 : ae_v_addd(&b0->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16504 0 : ae_v_addd(&b1->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16505 : }
16506 0 : return;
16507 : }
16508 : }
16509 :
16510 :
16511 : /*************************************************************************
16512 : This function calculates matrix-matrix product S*A, when S is symmetric
16513 : matrix. Matrix S must be stored in CRS or SKS format (exception will be
16514 : thrown otherwise).
16515 :
16516 : INPUT PARAMETERS
16517 : S - sparse M*M matrix in CRS or SKS format.
16518 : IsUpper - whether upper or lower triangle of S is given:
16519 : * if upper triangle is given, only S[i,j] for j>=i
16520 : are used, and lower triangle is ignored (it can be
16521 : empty - these elements are not referenced at all).
16522 : * if lower triangle is given, only S[i,j] for j<=i
16523 : are used, and upper triangle is ignored.
16524 : A - array[N][K], input dense matrix. For performance reasons
16525 : we make only quick checks - we check that array size is
16526 : at least N, but we do not check for NAN's or INF's.
16527 : K - number of columns of matrix (A).
16528 : B - output buffer, possibly preallocated. In case buffer
16529 : size is too small to store result, this buffer is
16530 : automatically resized.
16531 :
16532 : OUTPUT PARAMETERS
16533 : B - array[M][K], S*A
16534 :
16535 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
16536 : You must convert your matrix with SparseConvertToCRS/SKS() before using
16537 : this function.
16538 :
16539 : -- ALGLIB PROJECT --
16540 : Copyright 14.10.2011 by Bochkanov Sergey
16541 : *************************************************************************/
16542 0 : void sparsesmm(sparsematrix* s,
16543 : ae_bool isupper,
16544 : /* Real */ ae_matrix* a,
16545 : ae_int_t k,
16546 : /* Real */ ae_matrix* b,
16547 : ae_state *_state)
16548 : {
16549 : ae_int_t i;
16550 : ae_int_t j;
16551 : ae_int_t k0;
16552 : ae_int_t id;
16553 : ae_int_t k1;
16554 : ae_int_t lt;
16555 : ae_int_t rt;
16556 : double v;
16557 : double vb;
16558 : double va;
16559 : ae_int_t n;
16560 : ae_int_t ri;
16561 : ae_int_t ri1;
16562 : ae_int_t lt1;
16563 : ae_int_t rt1;
16564 : ae_int_t d;
16565 : ae_int_t u;
16566 :
16567 :
16568 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseSMM: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
16569 0 : ae_assert(a->rows>=s->n, "SparseSMM: Rows(X)<N", _state);
16570 0 : ae_assert(s->m==s->n, "SparseSMM: matrix is non-square", _state);
16571 0 : n = s->n;
16572 0 : k1 = k-1;
16573 0 : rmatrixsetlengthatleast(b, n, k, _state);
16574 0 : for(i=0; i<=n-1; i++)
16575 : {
16576 0 : for(j=0; j<=k-1; j++)
16577 : {
16578 0 : b->ptr.pp_double[i][j] = (double)(0);
16579 : }
16580 : }
16581 0 : if( s->matrixtype==1 )
16582 : {
16583 :
16584 : /*
16585 : * CRS format
16586 : */
16587 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
16588 0 : if( k>sparse_linalgswitch )
16589 : {
16590 0 : for(i=0; i<=n-1; i++)
16591 : {
16592 0 : for(j=0; j<=k-1; j++)
16593 : {
16594 0 : if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] )
16595 : {
16596 0 : id = s->didx.ptr.p_int[i];
16597 0 : b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+s->vals.ptr.p_double[id]*a->ptr.pp_double[s->idx.ptr.p_int[id]][j];
16598 : }
16599 0 : if( isupper )
16600 : {
16601 0 : lt = s->uidx.ptr.p_int[i];
16602 0 : rt = s->ridx.ptr.p_int[i+1];
16603 0 : vb = (double)(0);
16604 0 : va = a->ptr.pp_double[i][j];
16605 0 : for(k0=lt; k0<=rt-1; k0++)
16606 : {
16607 0 : id = s->idx.ptr.p_int[k0];
16608 0 : v = s->vals.ptr.p_double[k0];
16609 0 : vb = vb+a->ptr.pp_double[id][j]*v;
16610 0 : b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v;
16611 : }
16612 0 : b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb;
16613 : }
16614 : else
16615 : {
16616 0 : lt = s->ridx.ptr.p_int[i];
16617 0 : rt = s->didx.ptr.p_int[i];
16618 0 : vb = (double)(0);
16619 0 : va = a->ptr.pp_double[i][j];
16620 0 : for(k0=lt; k0<=rt-1; k0++)
16621 : {
16622 0 : id = s->idx.ptr.p_int[k0];
16623 0 : v = s->vals.ptr.p_double[k0];
16624 0 : vb = vb+a->ptr.pp_double[id][j]*v;
16625 0 : b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v;
16626 : }
16627 0 : b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb;
16628 : }
16629 : }
16630 : }
16631 : }
16632 : else
16633 : {
16634 0 : for(i=0; i<=n-1; i++)
16635 : {
16636 0 : if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] )
16637 : {
16638 0 : id = s->didx.ptr.p_int[i];
16639 0 : v = s->vals.ptr.p_double[id];
16640 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[s->idx.ptr.p_int[id]][0], 1, ae_v_len(0,k-1), v);
16641 : }
16642 0 : if( isupper )
16643 : {
16644 0 : lt = s->uidx.ptr.p_int[i];
16645 0 : rt = s->ridx.ptr.p_int[i+1];
16646 0 : for(j=lt; j<=rt-1; j++)
16647 : {
16648 0 : id = s->idx.ptr.p_int[j];
16649 0 : v = s->vals.ptr.p_double[j];
16650 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v);
16651 0 : ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16652 : }
16653 : }
16654 : else
16655 : {
16656 0 : lt = s->ridx.ptr.p_int[i];
16657 0 : rt = s->didx.ptr.p_int[i];
16658 0 : for(j=lt; j<=rt-1; j++)
16659 : {
16660 0 : id = s->idx.ptr.p_int[j];
16661 0 : v = s->vals.ptr.p_double[j];
16662 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v);
16663 0 : ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16664 : }
16665 : }
16666 : }
16667 : }
16668 0 : return;
16669 : }
16670 0 : if( s->matrixtype==2 )
16671 : {
16672 :
16673 : /*
16674 : * SKS format
16675 : */
16676 0 : ae_assert(s->m==s->n, "SparseMM2: non-square SKS matrices are not supported", _state);
16677 0 : for(i=0; i<=n-1; i++)
16678 : {
16679 0 : ri = s->ridx.ptr.p_int[i];
16680 0 : ri1 = s->ridx.ptr.p_int[i+1];
16681 0 : d = s->didx.ptr.p_int[i];
16682 0 : u = s->uidx.ptr.p_int[i];
16683 0 : if( d>0&&!isupper )
16684 : {
16685 0 : lt = ri;
16686 0 : rt = ri+d-1;
16687 0 : lt1 = i-d;
16688 0 : rt1 = i-1;
16689 0 : for(j=lt1; j<=rt1; j++)
16690 : {
16691 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16692 0 : if( k<sparse_linalgswitch )
16693 : {
16694 :
16695 : /*
16696 : * Use loop
16697 : */
16698 0 : for(k0=0; k0<=k1; k0++)
16699 : {
16700 0 : b->ptr.pp_double[i][k0] = b->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16701 0 : b->ptr.pp_double[j][k0] = b->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16702 : }
16703 : }
16704 : else
16705 : {
16706 :
16707 : /*
16708 : * Use vector operation
16709 : */
16710 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16711 0 : ae_v_addd(&b->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16712 : }
16713 : }
16714 : }
16715 0 : if( u>0&&isupper )
16716 : {
16717 0 : lt = ri1-u;
16718 0 : rt = ri1-1;
16719 0 : lt1 = i-u;
16720 0 : rt1 = i-1;
16721 0 : for(j=lt1; j<=rt1; j++)
16722 : {
16723 0 : v = s->vals.ptr.p_double[lt+(j-lt1)];
16724 0 : if( k<sparse_linalgswitch )
16725 : {
16726 :
16727 : /*
16728 : * Use loop
16729 : */
16730 0 : for(k0=0; k0<=k1; k0++)
16731 : {
16732 0 : b->ptr.pp_double[j][k0] = b->ptr.pp_double[j][k0]+v*a->ptr.pp_double[i][k0];
16733 0 : b->ptr.pp_double[i][k0] = b->ptr.pp_double[i][k0]+v*a->ptr.pp_double[j][k0];
16734 : }
16735 : }
16736 : else
16737 : {
16738 :
16739 : /*
16740 : * Use vector operation
16741 : */
16742 0 : ae_v_addd(&b->ptr.pp_double[j][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16743 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v);
16744 : }
16745 : }
16746 : }
16747 0 : v = s->vals.ptr.p_double[ri+d];
16748 0 : ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v);
16749 : }
16750 0 : return;
16751 : }
16752 : }
16753 :
16754 :
16755 : /*************************************************************************
16756 : This function calculates matrix-vector product op(S)*x, when x is vector,
16757 : S is symmetric triangular matrix, op(S) is transposition or no operation.
16758 : Matrix S must be stored in CRS or SKS format (exception will be thrown
16759 : otherwise).
16760 :
16761 : INPUT PARAMETERS
16762 : S - sparse square matrix in CRS or SKS format.
16763 : IsUpper - whether upper or lower triangle of S is used:
16764 : * if upper triangle is given, only S[i,j] for j>=i
16765 : are used, and lower triangle is ignored (it can be
16766 : empty - these elements are not referenced at all).
16767 : * if lower triangle is given, only S[i,j] for j<=i
16768 : are used, and upper triangle is ignored.
16769 : IsUnit - unit or non-unit diagonal:
16770 : * if True, diagonal elements of triangular matrix are
16771 : considered equal to 1.0. Actual elements stored in
16772 : S are not referenced at all.
16773 : * if False, diagonal stored in S is used
16774 : OpType - operation type:
16775 : * if 0, S*x is calculated
16776 : * if 1, (S^T)*x is calculated (transposition)
16777 : X - array[N] which stores input vector. For performance
16778 : reasons we make only quick checks - we check that
16779 : array size is at least N, but we do not check for
16780 : NAN's or INF's.
16781 : Y - possibly preallocated input buffer. Automatically
16782 : resized if its size is too small.
16783 :
16784 : OUTPUT PARAMETERS
16785 : Y - array[N], op(S)*x
16786 :
16787 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
16788 : You must convert your matrix with SparseConvertToCRS/SKS() before using
16789 : this function.
16790 :
16791 : -- ALGLIB PROJECT --
16792 : Copyright 20.01.2014 by Bochkanov Sergey
16793 : *************************************************************************/
16794 0 : void sparsetrmv(sparsematrix* s,
16795 : ae_bool isupper,
16796 : ae_bool isunit,
16797 : ae_int_t optype,
16798 : /* Real */ ae_vector* x,
16799 : /* Real */ ae_vector* y,
16800 : ae_state *_state)
16801 : {
16802 : ae_int_t n;
16803 : ae_int_t i;
16804 : ae_int_t j;
16805 : ae_int_t k;
16806 : ae_int_t j0;
16807 : ae_int_t j1;
16808 : double v;
16809 : ae_int_t ri;
16810 : ae_int_t ri1;
16811 : ae_int_t d;
16812 : ae_int_t u;
16813 : ae_int_t lt;
16814 : ae_int_t rt;
16815 : ae_int_t lt1;
16816 : ae_int_t rt1;
16817 :
16818 :
16819 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseTRMV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
16820 0 : ae_assert(optype==0||optype==1, "SparseTRMV: incorrect operation type (must be 0 or 1)", _state);
16821 0 : ae_assert(x->cnt>=s->n, "SparseTRMV: Length(X)<N", _state);
16822 0 : ae_assert(s->m==s->n, "SparseTRMV: matrix is non-square", _state);
16823 0 : n = s->n;
16824 0 : rvectorsetlengthatleast(y, n, _state);
16825 0 : if( isunit )
16826 : {
16827 :
16828 : /*
16829 : * Set initial value of y to x
16830 : */
16831 0 : for(i=0; i<=n-1; i++)
16832 : {
16833 0 : y->ptr.p_double[i] = x->ptr.p_double[i];
16834 : }
16835 : }
16836 : else
16837 : {
16838 :
16839 : /*
16840 : * Set initial value of y to 0
16841 : */
16842 0 : for(i=0; i<=n-1; i++)
16843 : {
16844 0 : y->ptr.p_double[i] = (double)(0);
16845 : }
16846 : }
16847 0 : if( s->matrixtype==1 )
16848 : {
16849 :
16850 : /*
16851 : * CRS format
16852 : */
16853 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseTRMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
16854 0 : for(i=0; i<=n-1; i++)
16855 : {
16856 :
16857 : /*
16858 : * Depending on IsUpper/IsUnit, select range of indexes to process
16859 : */
16860 0 : if( isupper )
16861 : {
16862 0 : if( isunit||s->didx.ptr.p_int[i]==s->uidx.ptr.p_int[i] )
16863 : {
16864 0 : j0 = s->uidx.ptr.p_int[i];
16865 : }
16866 : else
16867 : {
16868 0 : j0 = s->didx.ptr.p_int[i];
16869 : }
16870 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
16871 : }
16872 : else
16873 : {
16874 0 : j0 = s->ridx.ptr.p_int[i];
16875 0 : if( isunit||s->didx.ptr.p_int[i]==s->uidx.ptr.p_int[i] )
16876 : {
16877 0 : j1 = s->didx.ptr.p_int[i]-1;
16878 : }
16879 : else
16880 : {
16881 0 : j1 = s->didx.ptr.p_int[i];
16882 : }
16883 : }
16884 :
16885 : /*
16886 : * Depending on OpType, process subset of I-th row of input matrix
16887 : */
16888 0 : if( optype==0 )
16889 : {
16890 0 : v = 0.0;
16891 0 : for(j=j0; j<=j1; j++)
16892 : {
16893 0 : v = v+s->vals.ptr.p_double[j]*x->ptr.p_double[s->idx.ptr.p_int[j]];
16894 : }
16895 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+v;
16896 : }
16897 : else
16898 : {
16899 0 : v = x->ptr.p_double[i];
16900 0 : for(j=j0; j<=j1; j++)
16901 : {
16902 0 : k = s->idx.ptr.p_int[j];
16903 0 : y->ptr.p_double[k] = y->ptr.p_double[k]+v*s->vals.ptr.p_double[j];
16904 : }
16905 : }
16906 : }
16907 0 : return;
16908 : }
16909 0 : if( s->matrixtype==2 )
16910 : {
16911 :
16912 : /*
16913 : * SKS format
16914 : */
16915 0 : ae_assert(s->m==s->n, "SparseTRMV: non-square SKS matrices are not supported", _state);
16916 0 : for(i=0; i<=n-1; i++)
16917 : {
16918 0 : ri = s->ridx.ptr.p_int[i];
16919 0 : ri1 = s->ridx.ptr.p_int[i+1];
16920 0 : d = s->didx.ptr.p_int[i];
16921 0 : u = s->uidx.ptr.p_int[i];
16922 0 : if( !isunit )
16923 : {
16924 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+s->vals.ptr.p_double[ri+d]*x->ptr.p_double[i];
16925 : }
16926 0 : if( d>0&&!isupper )
16927 : {
16928 0 : lt = ri;
16929 0 : rt = ri+d-1;
16930 0 : lt1 = i-d;
16931 0 : rt1 = i-1;
16932 0 : if( optype==0 )
16933 : {
16934 0 : v = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
16935 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+v;
16936 : }
16937 : else
16938 : {
16939 0 : v = x->ptr.p_double[i];
16940 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
16941 : }
16942 : }
16943 0 : if( u>0&&isupper )
16944 : {
16945 0 : lt = ri1-u;
16946 0 : rt = ri1-1;
16947 0 : lt1 = i-u;
16948 0 : rt1 = i-1;
16949 0 : if( optype==0 )
16950 : {
16951 0 : v = x->ptr.p_double[i];
16952 0 : ae_v_addd(&y->ptr.p_double[lt1], 1, &s->vals.ptr.p_double[lt], 1, ae_v_len(lt1,rt1), v);
16953 : }
16954 : else
16955 : {
16956 0 : v = ae_v_dotproduct(&s->vals.ptr.p_double[lt], 1, &x->ptr.p_double[lt1], 1, ae_v_len(lt,rt));
16957 0 : y->ptr.p_double[i] = y->ptr.p_double[i]+v;
16958 : }
16959 : }
16960 : }
16961 0 : return;
16962 : }
16963 : }
16964 :
16965 :
16966 : /*************************************************************************
16967 : This function solves linear system op(S)*y=x where x is vector, S is
16968 : symmetric triangular matrix, op(S) is transposition or no operation.
16969 : Matrix S must be stored in CRS or SKS format (exception will be thrown
16970 : otherwise).
16971 :
16972 : INPUT PARAMETERS
16973 : S - sparse square matrix in CRS or SKS format.
16974 : IsUpper - whether upper or lower triangle of S is used:
16975 : * if upper triangle is given, only S[i,j] for j>=i
16976 : are used, and lower triangle is ignored (it can be
16977 : empty - these elements are not referenced at all).
16978 : * if lower triangle is given, only S[i,j] for j<=i
16979 : are used, and upper triangle is ignored.
16980 : IsUnit - unit or non-unit diagonal:
16981 : * if True, diagonal elements of triangular matrix are
16982 : considered equal to 1.0. Actual elements stored in
16983 : S are not referenced at all.
16984 : * if False, diagonal stored in S is used. It is your
16985 : responsibility to make sure that diagonal is
16986 : non-zero.
16987 : OpType - operation type:
16988 : * if 0, S*x is calculated
16989 : * if 1, (S^T)*x is calculated (transposition)
16990 : X - array[N] which stores input vector. For performance
16991 : reasons we make only quick checks - we check that
16992 : array size is at least N, but we do not check for
16993 : NAN's or INF's.
16994 :
16995 : OUTPUT PARAMETERS
16996 : X - array[N], inv(op(S))*x
16997 :
16998 : NOTE: this function throws exception when called for non-CRS/SKS matrix.
16999 : You must convert your matrix with SparseConvertToCRS/SKS() before
17000 : using this function.
17001 :
17002 : NOTE: no assertion or tests are done during algorithm operation. It is
17003 : your responsibility to provide invertible matrix to algorithm.
17004 :
17005 : -- ALGLIB PROJECT --
17006 : Copyright 20.01.2014 by Bochkanov Sergey
17007 : *************************************************************************/
17008 0 : void sparsetrsv(sparsematrix* s,
17009 : ae_bool isupper,
17010 : ae_bool isunit,
17011 : ae_int_t optype,
17012 : /* Real */ ae_vector* x,
17013 : ae_state *_state)
17014 : {
17015 : ae_int_t n;
17016 : ae_int_t fst;
17017 : ae_int_t lst;
17018 : ae_int_t stp;
17019 : ae_int_t i;
17020 : ae_int_t j;
17021 : ae_int_t k;
17022 : double v;
17023 : double vd;
17024 : double v0;
17025 : ae_int_t j0;
17026 : ae_int_t j1;
17027 : ae_int_t ri;
17028 : ae_int_t ri1;
17029 : ae_int_t d;
17030 : ae_int_t u;
17031 : ae_int_t lt;
17032 : ae_int_t lt1;
17033 :
17034 :
17035 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseTRSV: incorrect matrix type (convert your matrix to CRS/SKS)", _state);
17036 0 : ae_assert(optype==0||optype==1, "SparseTRSV: incorrect operation type (must be 0 or 1)", _state);
17037 0 : ae_assert(x->cnt>=s->n, "SparseTRSV: Length(X)<N", _state);
17038 0 : ae_assert(s->m==s->n, "SparseTRSV: matrix is non-square", _state);
17039 0 : n = s->n;
17040 0 : if( s->matrixtype==1 )
17041 : {
17042 :
17043 : /*
17044 : * CRS format.
17045 : *
17046 : * Several branches for different combinations of IsUpper and OpType
17047 : */
17048 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseTRSV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
17049 0 : if( optype==0 )
17050 : {
17051 :
17052 : /*
17053 : * No transposition.
17054 : *
17055 : * S*x=y with upper or lower triangular S.
17056 : */
17057 0 : v0 = (double)(0);
17058 0 : if( isupper )
17059 : {
17060 0 : fst = n-1;
17061 0 : lst = 0;
17062 0 : stp = -1;
17063 : }
17064 : else
17065 : {
17066 0 : fst = 0;
17067 0 : lst = n-1;
17068 0 : stp = 1;
17069 : }
17070 0 : i = fst;
17071 0 : while((stp>0&&i<=lst)||(stp<0&&i>=lst))
17072 : {
17073 :
17074 : /*
17075 : * Select range of indexes to process
17076 : */
17077 0 : if( isupper )
17078 : {
17079 0 : j0 = s->uidx.ptr.p_int[i];
17080 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
17081 : }
17082 : else
17083 : {
17084 0 : j0 = s->ridx.ptr.p_int[i];
17085 0 : j1 = s->didx.ptr.p_int[i]-1;
17086 : }
17087 :
17088 : /*
17089 : * Calculate X[I]
17090 : */
17091 0 : v = 0.0;
17092 0 : for(j=j0; j<=j1; j++)
17093 : {
17094 0 : v = v+s->vals.ptr.p_double[j]*x->ptr.p_double[s->idx.ptr.p_int[j]];
17095 : }
17096 0 : if( !isunit )
17097 : {
17098 0 : if( s->didx.ptr.p_int[i]==s->uidx.ptr.p_int[i] )
17099 : {
17100 0 : vd = (double)(0);
17101 : }
17102 : else
17103 : {
17104 0 : vd = s->vals.ptr.p_double[s->didx.ptr.p_int[i]];
17105 : }
17106 : }
17107 : else
17108 : {
17109 0 : vd = 1.0;
17110 : }
17111 0 : v = (x->ptr.p_double[i]-v)/vd;
17112 0 : x->ptr.p_double[i] = v;
17113 0 : v0 = 0.25*v0+v;
17114 :
17115 : /*
17116 : * Next I
17117 : */
17118 0 : i = i+stp;
17119 : }
17120 0 : ae_assert(ae_isfinite(v0, _state), "SparseTRSV: overflow or division by exact zero", _state);
17121 0 : return;
17122 : }
17123 0 : if( optype==1 )
17124 : {
17125 :
17126 : /*
17127 : * Transposition.
17128 : *
17129 : * (S^T)*x=y with upper or lower triangular S.
17130 : */
17131 0 : if( isupper )
17132 : {
17133 0 : fst = 0;
17134 0 : lst = n-1;
17135 0 : stp = 1;
17136 : }
17137 : else
17138 : {
17139 0 : fst = n-1;
17140 0 : lst = 0;
17141 0 : stp = -1;
17142 : }
17143 0 : i = fst;
17144 0 : v0 = (double)(0);
17145 0 : while((stp>0&&i<=lst)||(stp<0&&i>=lst))
17146 : {
17147 0 : v = x->ptr.p_double[i];
17148 0 : if( v!=0.0 )
17149 : {
17150 :
17151 : /*
17152 : * X[i] already stores A[i,i]*Y[i], the only thing left
17153 : * is to divide by diagonal element.
17154 : */
17155 0 : if( !isunit )
17156 : {
17157 0 : if( s->didx.ptr.p_int[i]==s->uidx.ptr.p_int[i] )
17158 : {
17159 0 : vd = (double)(0);
17160 : }
17161 : else
17162 : {
17163 0 : vd = s->vals.ptr.p_double[s->didx.ptr.p_int[i]];
17164 : }
17165 : }
17166 : else
17167 : {
17168 0 : vd = 1.0;
17169 : }
17170 0 : v = v/vd;
17171 0 : x->ptr.p_double[i] = v;
17172 0 : v0 = 0.25*v0+v;
17173 :
17174 : /*
17175 : * For upper triangular case:
17176 : * subtract X[i]*Ai from X[i+1:N-1]
17177 : *
17178 : * For lower triangular case:
17179 : * subtract X[i]*Ai from X[0:i-1]
17180 : *
17181 : * (here Ai is I-th row of original, untransposed A).
17182 : */
17183 0 : if( isupper )
17184 : {
17185 0 : j0 = s->uidx.ptr.p_int[i];
17186 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
17187 : }
17188 : else
17189 : {
17190 0 : j0 = s->ridx.ptr.p_int[i];
17191 0 : j1 = s->didx.ptr.p_int[i]-1;
17192 : }
17193 0 : for(j=j0; j<=j1; j++)
17194 : {
17195 0 : k = s->idx.ptr.p_int[j];
17196 0 : x->ptr.p_double[k] = x->ptr.p_double[k]-s->vals.ptr.p_double[j]*v;
17197 : }
17198 : }
17199 :
17200 : /*
17201 : * Next I
17202 : */
17203 0 : i = i+stp;
17204 : }
17205 0 : ae_assert(ae_isfinite(v0, _state), "SparseTRSV: overflow or division by exact zero", _state);
17206 0 : return;
17207 : }
17208 0 : ae_assert(ae_false, "SparseTRSV: internal error", _state);
17209 : }
17210 0 : if( s->matrixtype==2 )
17211 : {
17212 :
17213 : /*
17214 : * SKS format
17215 : */
17216 0 : ae_assert(s->m==s->n, "SparseTRSV: non-square SKS matrices are not supported", _state);
17217 0 : if( (optype==0&&!isupper)||(optype==1&&isupper) )
17218 : {
17219 :
17220 : /*
17221 : * Lower triangular op(S) (matrix itself can be upper triangular).
17222 : */
17223 0 : v0 = (double)(0);
17224 0 : for(i=0; i<=n-1; i++)
17225 : {
17226 :
17227 : /*
17228 : * Select range of indexes to process
17229 : */
17230 0 : ri = s->ridx.ptr.p_int[i];
17231 0 : ri1 = s->ridx.ptr.p_int[i+1];
17232 0 : d = s->didx.ptr.p_int[i];
17233 0 : u = s->uidx.ptr.p_int[i];
17234 0 : if( isupper )
17235 : {
17236 0 : lt = i-u;
17237 0 : lt1 = ri1-u;
17238 0 : k = u-1;
17239 : }
17240 : else
17241 : {
17242 0 : lt = i-d;
17243 0 : lt1 = ri;
17244 0 : k = d-1;
17245 : }
17246 :
17247 : /*
17248 : * Calculate X[I]
17249 : */
17250 0 : v = 0.0;
17251 0 : for(j=0; j<=k; j++)
17252 : {
17253 0 : v = v+s->vals.ptr.p_double[lt1+j]*x->ptr.p_double[lt+j];
17254 : }
17255 0 : if( isunit )
17256 : {
17257 0 : vd = (double)(1);
17258 : }
17259 : else
17260 : {
17261 0 : vd = s->vals.ptr.p_double[ri+d];
17262 : }
17263 0 : v = (x->ptr.p_double[i]-v)/vd;
17264 0 : x->ptr.p_double[i] = v;
17265 0 : v0 = 0.25*v0+v;
17266 : }
17267 0 : ae_assert(ae_isfinite(v0, _state), "SparseTRSV: overflow or division by exact zero", _state);
17268 0 : return;
17269 : }
17270 0 : if( (optype==1&&!isupper)||(optype==0&&isupper) )
17271 : {
17272 :
17273 : /*
17274 : * Upper triangular op(S) (matrix itself can be lower triangular).
17275 : */
17276 0 : v0 = (double)(0);
17277 0 : for(i=n-1; i>=0; i--)
17278 : {
17279 0 : ri = s->ridx.ptr.p_int[i];
17280 0 : ri1 = s->ridx.ptr.p_int[i+1];
17281 0 : d = s->didx.ptr.p_int[i];
17282 0 : u = s->uidx.ptr.p_int[i];
17283 :
17284 : /*
17285 : * X[i] already stores A[i,i]*Y[i], the only thing left
17286 : * is to divide by diagonal element.
17287 : */
17288 0 : if( isunit )
17289 : {
17290 0 : vd = (double)(1);
17291 : }
17292 : else
17293 : {
17294 0 : vd = s->vals.ptr.p_double[ri+d];
17295 : }
17296 0 : v = x->ptr.p_double[i]/vd;
17297 0 : x->ptr.p_double[i] = v;
17298 0 : v0 = 0.25*v0+v;
17299 :
17300 : /*
17301 : * Subtract product of X[i] and I-th column of "effective" A from
17302 : * unprocessed variables.
17303 : */
17304 0 : v = x->ptr.p_double[i];
17305 0 : if( isupper )
17306 : {
17307 0 : lt = i-u;
17308 0 : lt1 = ri1-u;
17309 0 : k = u-1;
17310 : }
17311 : else
17312 : {
17313 0 : lt = i-d;
17314 0 : lt1 = ri;
17315 0 : k = d-1;
17316 : }
17317 0 : for(j=0; j<=k; j++)
17318 : {
17319 0 : x->ptr.p_double[lt+j] = x->ptr.p_double[lt+j]-v*s->vals.ptr.p_double[lt1+j];
17320 : }
17321 : }
17322 0 : ae_assert(ae_isfinite(v0, _state), "SparseTRSV: overflow or division by exact zero", _state);
17323 0 : return;
17324 : }
17325 0 : ae_assert(ae_false, "SparseTRSV: internal error", _state);
17326 : }
17327 0 : ae_assert(ae_false, "SparseTRSV: internal error", _state);
17328 : }
17329 :
17330 :
17331 : /*************************************************************************
17332 : This function applies permutation given by permutation table P (as opposed
17333 : to product form of permutation) to sparse symmetric matrix A, given by
17334 : either upper or lower triangle: B := P*A*P'.
17335 :
17336 : This function allocates completely new instance of B. Use buffered version
17337 : SparseSymmPermTblBuf() if you want to reuse already allocated structure.
17338 :
17339 : INPUT PARAMETERS
17340 : A - sparse square matrix in CRS format.
17341 : IsUpper - whether upper or lower triangle of A is used:
17342 : * if upper triangle is given, only A[i,j] for j>=i
17343 : are used, and lower triangle is ignored (it can be
17344 : empty - these elements are not referenced at all).
17345 : * if lower triangle is given, only A[i,j] for j<=i
17346 : are used, and upper triangle is ignored.
17347 : P - array[N] which stores permutation table; P[I]=J means
17348 : that I-th row/column of matrix A is moved to J-th
17349 : position. For performance reasons we do NOT check that
17350 : P[] is a correct permutation (that there is no
17351 : repetitions, just that all its elements are in [0,N)
17352 : range.
17353 :
17354 : OUTPUT PARAMETERS
17355 : B - permuted matrix. Permutation is applied to A from
17356 : the both sides, only upper or lower triangle (depending
17357 : on IsUpper) is stored.
17358 :
17359 : NOTE: this function throws exception when called for non-CRS matrix. You
17360 : must convert your matrix with SparseConvertToCRS() before using this
17361 : function.
17362 :
17363 : -- ALGLIB PROJECT --
17364 : Copyright 05.10.2020 by Bochkanov Sergey.
17365 : *************************************************************************/
17366 0 : void sparsesymmpermtbl(sparsematrix* a,
17367 : ae_bool isupper,
17368 : /* Integer */ ae_vector* p,
17369 : sparsematrix* b,
17370 : ae_state *_state)
17371 : {
17372 :
17373 0 : _sparsematrix_clear(b);
17374 :
17375 0 : sparsesymmpermtblbuf(a, isupper, p, b, _state);
17376 0 : }
17377 :
17378 :
17379 : /*************************************************************************
17380 : This function is a buffered version of SparseSymmPermTbl() that reuses
17381 : previously allocated storage in B as much as possible.
17382 :
17383 : This function applies permutation given by permutation table P (as opposed
17384 : to product form of permutation) to sparse symmetric matrix A, given by
17385 : either upper or lower triangle: B := P*A*P'.
17386 :
17387 : INPUT PARAMETERS
17388 : A - sparse square matrix in CRS format.
17389 : IsUpper - whether upper or lower triangle of A is used:
17390 : * if upper triangle is given, only A[i,j] for j>=i
17391 : are used, and lower triangle is ignored (it can be
17392 : empty - these elements are not referenced at all).
17393 : * if lower triangle is given, only A[i,j] for j<=i
17394 : are used, and upper triangle is ignored.
17395 : P - array[N] which stores permutation table; P[I]=J means
17396 : that I-th row/column of matrix A is moved to J-th
17397 : position. For performance reasons we do NOT check that
17398 : P[] is a correct permutation (that there is no
17399 : repetitions, just that all its elements are in [0,N)
17400 : range.
17401 : B - sparse matrix object that will hold output.
17402 : Previously allocated memory will be reused as much as
17403 : possible.
17404 :
17405 : OUTPUT PARAMETERS
17406 : B - permuted matrix. Permutation is applied to A from
17407 : the both sides, only upper or lower triangle (depending
17408 : on IsUpper) is stored.
17409 :
17410 : NOTE: this function throws exception when called for non-CRS matrix. You
17411 : must convert your matrix with SparseConvertToCRS() before using this
17412 : function.
17413 :
17414 : -- ALGLIB PROJECT --
17415 : Copyright 05.10.2020 by Bochkanov Sergey.
17416 : *************************************************************************/
17417 0 : void sparsesymmpermtblbuf(sparsematrix* a,
17418 : ae_bool isupper,
17419 : /* Integer */ ae_vector* p,
17420 : sparsematrix* b,
17421 : ae_state *_state)
17422 : {
17423 : ae_int_t i;
17424 : ae_int_t j;
17425 : ae_int_t jj;
17426 : ae_int_t j0;
17427 : ae_int_t j1;
17428 : ae_int_t k0;
17429 : ae_int_t k1;
17430 : ae_int_t kk;
17431 : ae_int_t n;
17432 : ae_int_t dst;
17433 : ae_bool bflag;
17434 :
17435 :
17436 0 : ae_assert(a->matrixtype==1, "SparseSymmPermTblBuf: incorrect matrix type (convert your matrix to CRS)", _state);
17437 0 : ae_assert(p->cnt>=a->n, "SparseSymmPermTblBuf: Length(P)<N", _state);
17438 0 : ae_assert(a->m==a->n, "SparseSymmPermTblBuf: matrix is non-square", _state);
17439 0 : bflag = ae_true;
17440 0 : for(i=0; i<=a->n-1; i++)
17441 : {
17442 0 : bflag = (bflag&&p->ptr.p_int[i]>=0)&&p->ptr.p_int[i]<a->n;
17443 : }
17444 0 : ae_assert(bflag, "SparseSymmPermTblBuf: P[] contains values outside of [0,N) range", _state);
17445 0 : n = a->n;
17446 :
17447 : /*
17448 : * Prepare output
17449 : */
17450 0 : ae_assert(a->ninitialized==a->ridx.ptr.p_int[n], "SparseSymmPermTblBuf: integrity check failed", _state);
17451 0 : b->matrixtype = 1;
17452 0 : b->n = n;
17453 0 : b->m = n;
17454 0 : ivectorsetlengthatleast(&b->didx, n, _state);
17455 0 : ivectorsetlengthatleast(&b->uidx, n, _state);
17456 :
17457 : /*
17458 : * Determine row sizes (temporary stored in DIdx) and ranges
17459 : */
17460 0 : isetv(n, 0, &b->didx, _state);
17461 0 : for(i=0; i<=n-1; i++)
17462 : {
17463 0 : if( isupper )
17464 : {
17465 0 : j0 = a->didx.ptr.p_int[i];
17466 0 : j1 = a->ridx.ptr.p_int[i+1]-1;
17467 0 : k0 = p->ptr.p_int[i];
17468 0 : for(jj=j0; jj<=j1; jj++)
17469 : {
17470 0 : k1 = p->ptr.p_int[a->idx.ptr.p_int[jj]];
17471 0 : if( k1<k0 )
17472 : {
17473 0 : b->didx.ptr.p_int[k1] = b->didx.ptr.p_int[k1]+1;
17474 : }
17475 : else
17476 : {
17477 0 : b->didx.ptr.p_int[k0] = b->didx.ptr.p_int[k0]+1;
17478 : }
17479 : }
17480 : }
17481 : else
17482 : {
17483 0 : j0 = a->ridx.ptr.p_int[i];
17484 0 : j1 = a->uidx.ptr.p_int[i]-1;
17485 0 : k0 = p->ptr.p_int[i];
17486 0 : for(jj=j0; jj<=j1; jj++)
17487 : {
17488 0 : k1 = p->ptr.p_int[a->idx.ptr.p_int[jj]];
17489 0 : if( k1>k0 )
17490 : {
17491 0 : b->didx.ptr.p_int[k1] = b->didx.ptr.p_int[k1]+1;
17492 : }
17493 : else
17494 : {
17495 0 : b->didx.ptr.p_int[k0] = b->didx.ptr.p_int[k0]+1;
17496 : }
17497 : }
17498 : }
17499 : }
17500 0 : ivectorsetlengthatleast(&b->ridx, n+1, _state);
17501 0 : b->ridx.ptr.p_int[0] = 0;
17502 0 : for(i=0; i<=n-1; i++)
17503 : {
17504 0 : b->ridx.ptr.p_int[i+1] = b->ridx.ptr.p_int[i]+b->didx.ptr.p_int[i];
17505 : }
17506 0 : b->ninitialized = b->ridx.ptr.p_int[n];
17507 0 : ivectorsetlengthatleast(&b->idx, b->ninitialized, _state);
17508 0 : rvectorsetlengthatleast(&b->vals, b->ninitialized, _state);
17509 :
17510 : /*
17511 : * Process matrix
17512 : */
17513 0 : for(i=0; i<=n-1; i++)
17514 : {
17515 0 : b->uidx.ptr.p_int[i] = b->ridx.ptr.p_int[i];
17516 : }
17517 0 : for(i=0; i<=n-1; i++)
17518 : {
17519 0 : if( isupper )
17520 : {
17521 0 : j0 = a->didx.ptr.p_int[i];
17522 0 : j1 = a->ridx.ptr.p_int[i+1]-1;
17523 0 : for(jj=j0; jj<=j1; jj++)
17524 : {
17525 0 : j = a->idx.ptr.p_int[jj];
17526 0 : k0 = p->ptr.p_int[i];
17527 0 : k1 = p->ptr.p_int[j];
17528 0 : if( k1<k0 )
17529 : {
17530 0 : kk = k0;
17531 0 : k0 = k1;
17532 0 : k1 = kk;
17533 : }
17534 0 : dst = b->uidx.ptr.p_int[k0];
17535 0 : b->idx.ptr.p_int[dst] = k1;
17536 0 : b->vals.ptr.p_double[dst] = a->vals.ptr.p_double[jj];
17537 0 : b->uidx.ptr.p_int[k0] = dst+1;
17538 : }
17539 : }
17540 : else
17541 : {
17542 0 : j0 = a->ridx.ptr.p_int[i];
17543 0 : j1 = a->uidx.ptr.p_int[i]-1;
17544 0 : for(jj=j0; jj<=j1; jj++)
17545 : {
17546 0 : j = a->idx.ptr.p_int[jj];
17547 0 : k0 = p->ptr.p_int[i];
17548 0 : k1 = p->ptr.p_int[j];
17549 0 : if( k1>k0 )
17550 : {
17551 0 : kk = k0;
17552 0 : k0 = k1;
17553 0 : k1 = kk;
17554 : }
17555 0 : dst = b->uidx.ptr.p_int[k0];
17556 0 : b->idx.ptr.p_int[dst] = k1;
17557 0 : b->vals.ptr.p_double[dst] = a->vals.ptr.p_double[jj];
17558 0 : b->uidx.ptr.p_int[k0] = dst+1;
17559 : }
17560 : }
17561 : }
17562 :
17563 : /*
17564 : * Finalize matrix
17565 : */
17566 0 : for(i=0; i<=n-1; i++)
17567 : {
17568 0 : tagsortmiddleir(&b->idx, &b->vals, b->ridx.ptr.p_int[i], b->ridx.ptr.p_int[i+1]-b->ridx.ptr.p_int[i], _state);
17569 : }
17570 0 : sparseinitduidx(b, _state);
17571 0 : }
17572 :
17573 :
17574 : /*************************************************************************
17575 : This procedure resizes Hash-Table matrix. It can be called when you have
17576 : deleted too many elements from the matrix, and you want to free unneeded
17577 : memory.
17578 :
17579 : -- ALGLIB PROJECT --
17580 : Copyright 14.10.2011 by Bochkanov Sergey
17581 : *************************************************************************/
17582 0 : void sparseresizematrix(sparsematrix* s, ae_state *_state)
17583 : {
17584 : ae_frame _frame_block;
17585 : ae_int_t k;
17586 : ae_int_t k1;
17587 : ae_int_t i;
17588 : ae_vector tvals;
17589 : ae_vector tidx;
17590 :
17591 0 : ae_frame_make(_state, &_frame_block);
17592 0 : memset(&tvals, 0, sizeof(tvals));
17593 0 : memset(&tidx, 0, sizeof(tidx));
17594 0 : ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true);
17595 0 : ae_vector_init(&tidx, 0, DT_INT, _state, ae_true);
17596 :
17597 0 : ae_assert(s->matrixtype==0, "SparseResizeMatrix: incorrect matrix type", _state);
17598 :
17599 : /*
17600 : * Initialization for length and number of non-null elementd
17601 : */
17602 0 : k = s->tablesize;
17603 0 : k1 = 0;
17604 :
17605 : /*
17606 : * Calculating number of non-null elements
17607 : */
17608 0 : for(i=0; i<=k-1; i++)
17609 : {
17610 0 : if( s->idx.ptr.p_int[2*i]>=0 )
17611 : {
17612 0 : k1 = k1+1;
17613 : }
17614 : }
17615 :
17616 : /*
17617 : * Initialization value for free space
17618 : */
17619 0 : s->tablesize = ae_round(k1/sparse_desiredloadfactor*sparse_growfactor+sparse_additional, _state);
17620 0 : s->nfree = s->tablesize-k1;
17621 0 : ae_vector_set_length(&tvals, s->tablesize, _state);
17622 0 : ae_vector_set_length(&tidx, 2*s->tablesize, _state);
17623 0 : ae_swap_vectors(&s->vals, &tvals);
17624 0 : ae_swap_vectors(&s->idx, &tidx);
17625 0 : for(i=0; i<=s->tablesize-1; i++)
17626 : {
17627 0 : s->idx.ptr.p_int[2*i] = -1;
17628 : }
17629 0 : for(i=0; i<=k-1; i++)
17630 : {
17631 0 : if( tidx.ptr.p_int[2*i]>=0 )
17632 : {
17633 0 : sparseset(s, tidx.ptr.p_int[2*i], tidx.ptr.p_int[2*i+1], tvals.ptr.p_double[i], _state);
17634 : }
17635 : }
17636 0 : ae_frame_leave(_state);
17637 0 : }
17638 :
17639 :
17640 : /*************************************************************************
17641 : Procedure for initialization 'S.DIdx' and 'S.UIdx'
17642 :
17643 :
17644 : -- ALGLIB PROJECT --
17645 : Copyright 14.10.2011 by Bochkanov Sergey
17646 : *************************************************************************/
17647 0 : void sparseinitduidx(sparsematrix* s, ae_state *_state)
17648 : {
17649 : ae_int_t i;
17650 : ae_int_t j;
17651 : ae_int_t k;
17652 : ae_int_t lt;
17653 : ae_int_t rt;
17654 :
17655 :
17656 0 : ae_assert(s->matrixtype==1, "SparseInitDUIdx: internal error, incorrect matrix type", _state);
17657 0 : ivectorsetlengthatleast(&s->didx, s->m, _state);
17658 0 : ivectorsetlengthatleast(&s->uidx, s->m, _state);
17659 0 : for(i=0; i<=s->m-1; i++)
17660 : {
17661 0 : s->uidx.ptr.p_int[i] = -1;
17662 0 : s->didx.ptr.p_int[i] = -1;
17663 0 : lt = s->ridx.ptr.p_int[i];
17664 0 : rt = s->ridx.ptr.p_int[i+1];
17665 0 : for(j=lt; j<=rt-1; j++)
17666 : {
17667 0 : k = s->idx.ptr.p_int[j];
17668 0 : if( k==i )
17669 : {
17670 0 : s->didx.ptr.p_int[i] = j;
17671 : }
17672 : else
17673 : {
17674 0 : if( k>i&&s->uidx.ptr.p_int[i]==-1 )
17675 : {
17676 0 : s->uidx.ptr.p_int[i] = j;
17677 0 : break;
17678 : }
17679 : }
17680 : }
17681 0 : if( s->uidx.ptr.p_int[i]==-1 )
17682 : {
17683 0 : s->uidx.ptr.p_int[i] = s->ridx.ptr.p_int[i+1];
17684 : }
17685 0 : if( s->didx.ptr.p_int[i]==-1 )
17686 : {
17687 0 : s->didx.ptr.p_int[i] = s->uidx.ptr.p_int[i];
17688 : }
17689 : }
17690 0 : }
17691 :
17692 :
17693 : /*************************************************************************
17694 : This function return average length of chain at hash-table.
17695 :
17696 : -- ALGLIB PROJECT --
17697 : Copyright 14.10.2011 by Bochkanov Sergey
17698 : *************************************************************************/
17699 0 : double sparsegetaveragelengthofchain(sparsematrix* s, ae_state *_state)
17700 : {
17701 : ae_int_t nchains;
17702 : ae_int_t talc;
17703 : ae_int_t l;
17704 : ae_int_t i;
17705 : ae_int_t ind0;
17706 : ae_int_t ind1;
17707 : ae_int_t hashcode;
17708 : double result;
17709 :
17710 :
17711 :
17712 : /*
17713 : * If matrix represent in CRS then return zero and exit
17714 : */
17715 0 : if( s->matrixtype!=0 )
17716 : {
17717 0 : result = (double)(0);
17718 0 : return result;
17719 : }
17720 0 : nchains = 0;
17721 0 : talc = 0;
17722 0 : l = s->tablesize;
17723 0 : for(i=0; i<=l-1; i++)
17724 : {
17725 0 : ind0 = 2*i;
17726 0 : if( s->idx.ptr.p_int[ind0]!=-1 )
17727 : {
17728 0 : nchains = nchains+1;
17729 0 : hashcode = sparse_hash(s->idx.ptr.p_int[ind0], s->idx.ptr.p_int[ind0+1], l, _state);
17730 : for(;;)
17731 : {
17732 0 : talc = talc+1;
17733 0 : ind1 = 2*hashcode;
17734 0 : if( s->idx.ptr.p_int[ind0]==s->idx.ptr.p_int[ind1]&&s->idx.ptr.p_int[ind0+1]==s->idx.ptr.p_int[ind1+1] )
17735 : {
17736 0 : break;
17737 : }
17738 0 : hashcode = (hashcode+1)%l;
17739 : }
17740 : }
17741 : }
17742 0 : if( nchains==0 )
17743 : {
17744 0 : result = (double)(0);
17745 : }
17746 : else
17747 : {
17748 0 : result = (double)talc/(double)nchains;
17749 : }
17750 0 : return result;
17751 : }
17752 :
17753 :
17754 : /*************************************************************************
17755 : This function is used to enumerate all elements of the sparse matrix.
17756 : Before first call user initializes T0 and T1 counters by zero. These
17757 : counters are used to remember current position in a matrix; after each
17758 : call they are updated by the function.
17759 :
17760 : Subsequent calls to this function return non-zero elements of the sparse
17761 : matrix, one by one. If you enumerate CRS matrix, matrix is traversed from
17762 : left to right, from top to bottom. In case you enumerate matrix stored as
17763 : Hash table, elements are returned in random order.
17764 :
17765 : EXAMPLE
17766 : > T0=0
17767 : > T1=0
17768 : > while SparseEnumerate(S,T0,T1,I,J,V) do
17769 : > ....do something with I,J,V
17770 :
17771 : INPUT PARAMETERS
17772 : S - sparse M*N matrix in Hash-Table or CRS representation.
17773 : T0 - internal counter
17774 : T1 - internal counter
17775 :
17776 : OUTPUT PARAMETERS
17777 : T0 - new value of the internal counter
17778 : T1 - new value of the internal counter
17779 : I - row index of non-zero element, 0<=I<M.
17780 : J - column index of non-zero element, 0<=J<N
17781 : V - value of the T-th element
17782 :
17783 : RESULT
17784 : True in case of success (next non-zero element was retrieved)
17785 : False in case all non-zero elements were enumerated
17786 :
17787 : NOTE: you may call SparseRewriteExisting() during enumeration, but it is
17788 : THE ONLY matrix modification function you can call!!! Other
17789 : matrix modification functions should not be called during enumeration!
17790 :
17791 : -- ALGLIB PROJECT --
17792 : Copyright 14.03.2012 by Bochkanov Sergey
17793 : *************************************************************************/
17794 0 : ae_bool sparseenumerate(sparsematrix* s,
17795 : ae_int_t* t0,
17796 : ae_int_t* t1,
17797 : ae_int_t* i,
17798 : ae_int_t* j,
17799 : double* v,
17800 : ae_state *_state)
17801 : {
17802 : ae_int_t sz;
17803 : ae_int_t i0;
17804 : ae_bool result;
17805 :
17806 0 : *i = 0;
17807 0 : *j = 0;
17808 0 : *v = 0;
17809 :
17810 0 : result = ae_false;
17811 0 : if( *t0<0||(s->matrixtype!=0&&*t1<0) )
17812 : {
17813 :
17814 : /*
17815 : * Incorrect T0/T1, terminate enumeration
17816 : */
17817 0 : result = ae_false;
17818 0 : return result;
17819 : }
17820 0 : if( s->matrixtype==0 )
17821 : {
17822 :
17823 : /*
17824 : * Hash-table matrix
17825 : */
17826 0 : sz = s->tablesize;
17827 0 : for(i0=*t0; i0<=sz-1; i0++)
17828 : {
17829 0 : if( s->idx.ptr.p_int[2*i0]==-1||s->idx.ptr.p_int[2*i0]==-2 )
17830 : {
17831 0 : continue;
17832 : }
17833 : else
17834 : {
17835 0 : *i = s->idx.ptr.p_int[2*i0];
17836 0 : *j = s->idx.ptr.p_int[2*i0+1];
17837 0 : *v = s->vals.ptr.p_double[i0];
17838 0 : *t0 = i0+1;
17839 0 : result = ae_true;
17840 0 : return result;
17841 : }
17842 : }
17843 0 : *t0 = 0;
17844 0 : *t1 = 0;
17845 0 : result = ae_false;
17846 0 : return result;
17847 : }
17848 0 : if( s->matrixtype==1 )
17849 : {
17850 :
17851 : /*
17852 : * CRS matrix
17853 : */
17854 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseEnumerate: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
17855 0 : if( *t0>=s->ninitialized )
17856 : {
17857 0 : *t0 = 0;
17858 0 : *t1 = 0;
17859 0 : result = ae_false;
17860 0 : return result;
17861 : }
17862 0 : while(*t0>s->ridx.ptr.p_int[*t1+1]-1&&*t1<s->m)
17863 : {
17864 0 : *t1 = *t1+1;
17865 : }
17866 0 : *i = *t1;
17867 0 : *j = s->idx.ptr.p_int[*t0];
17868 0 : *v = s->vals.ptr.p_double[*t0];
17869 0 : *t0 = *t0+1;
17870 0 : result = ae_true;
17871 0 : return result;
17872 : }
17873 0 : if( s->matrixtype==2 )
17874 : {
17875 :
17876 : /*
17877 : * SKS matrix:
17878 : * * T0 stores current offset in Vals[] array
17879 : * * T1 stores index of the diagonal block
17880 : */
17881 0 : ae_assert(s->m==s->n, "SparseEnumerate: non-square SKS matrices are not supported", _state);
17882 0 : if( *t0>=s->ridx.ptr.p_int[s->m] )
17883 : {
17884 0 : *t0 = 0;
17885 0 : *t1 = 0;
17886 0 : result = ae_false;
17887 0 : return result;
17888 : }
17889 0 : while(*t0>s->ridx.ptr.p_int[*t1+1]-1&&*t1<s->m)
17890 : {
17891 0 : *t1 = *t1+1;
17892 : }
17893 0 : i0 = *t0-s->ridx.ptr.p_int[*t1];
17894 0 : if( i0<s->didx.ptr.p_int[*t1]+1 )
17895 : {
17896 :
17897 : /*
17898 : * subdiagonal or diagonal element, row index is T1.
17899 : */
17900 0 : *i = *t1;
17901 0 : *j = *t1-s->didx.ptr.p_int[*t1]+i0;
17902 : }
17903 : else
17904 : {
17905 :
17906 : /*
17907 : * superdiagonal element, column index is T1.
17908 : */
17909 0 : *i = *t1-(s->ridx.ptr.p_int[*t1+1]-(*t0));
17910 0 : *j = *t1;
17911 : }
17912 0 : *v = s->vals.ptr.p_double[*t0];
17913 0 : *t0 = *t0+1;
17914 0 : result = ae_true;
17915 0 : return result;
17916 : }
17917 0 : ae_assert(ae_false, "SparseEnumerate: unexpected matrix type", _state);
17918 0 : return result;
17919 : }
17920 :
17921 :
17922 : /*************************************************************************
17923 : This function rewrites existing (non-zero) element. It returns True if
17924 : element exists or False, when it is called for non-existing (zero)
17925 : element.
17926 :
17927 : This function works with any kind of the matrix.
17928 :
17929 : The purpose of this function is to provide convenient thread-safe way to
17930 : modify sparse matrix. Such modification (already existing element is
17931 : rewritten) is guaranteed to be thread-safe without any synchronization, as
17932 : long as different threads modify different elements.
17933 :
17934 : INPUT PARAMETERS
17935 : S - sparse M*N matrix in any kind of representation
17936 : (Hash, SKS, CRS).
17937 : I - row index of non-zero element to modify, 0<=I<M
17938 : J - column index of non-zero element to modify, 0<=J<N
17939 : V - value to rewrite, must be finite number
17940 :
17941 : OUTPUT PARAMETERS
17942 : S - modified matrix
17943 : RESULT
17944 : True in case when element exists
17945 : False in case when element doesn't exist or it is zero
17946 :
17947 : -- ALGLIB PROJECT --
17948 : Copyright 14.03.2012 by Bochkanov Sergey
17949 : *************************************************************************/
17950 0 : ae_bool sparserewriteexisting(sparsematrix* s,
17951 : ae_int_t i,
17952 : ae_int_t j,
17953 : double v,
17954 : ae_state *_state)
17955 : {
17956 : ae_int_t hashcode;
17957 : ae_int_t k;
17958 : ae_int_t k0;
17959 : ae_int_t k1;
17960 : ae_bool result;
17961 :
17962 :
17963 0 : ae_assert(0<=i&&i<s->m, "SparseRewriteExisting: invalid argument I(either I<0 or I>=S.M)", _state);
17964 0 : ae_assert(0<=j&&j<s->n, "SparseRewriteExisting: invalid argument J(either J<0 or J>=S.N)", _state);
17965 0 : ae_assert(ae_isfinite(v, _state), "SparseRewriteExisting: invalid argument V(either V is infinite or V is NaN)", _state);
17966 0 : result = ae_false;
17967 :
17968 : /*
17969 : * Hash-table matrix
17970 : */
17971 0 : if( s->matrixtype==0 )
17972 : {
17973 0 : k = s->tablesize;
17974 0 : hashcode = sparse_hash(i, j, k, _state);
17975 : for(;;)
17976 : {
17977 0 : if( s->idx.ptr.p_int[2*hashcode]==-1 )
17978 : {
17979 0 : return result;
17980 : }
17981 0 : if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j )
17982 : {
17983 0 : s->vals.ptr.p_double[hashcode] = v;
17984 0 : result = ae_true;
17985 0 : return result;
17986 : }
17987 0 : hashcode = (hashcode+1)%k;
17988 : }
17989 : }
17990 :
17991 : /*
17992 : * CRS matrix
17993 : */
17994 0 : if( s->matrixtype==1 )
17995 : {
17996 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseRewriteExisting: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
17997 0 : k0 = s->ridx.ptr.p_int[i];
17998 0 : k1 = s->ridx.ptr.p_int[i+1]-1;
17999 0 : while(k0<=k1)
18000 : {
18001 0 : k = (k0+k1)/2;
18002 0 : if( s->idx.ptr.p_int[k]==j )
18003 : {
18004 0 : s->vals.ptr.p_double[k] = v;
18005 0 : result = ae_true;
18006 0 : return result;
18007 : }
18008 0 : if( s->idx.ptr.p_int[k]<j )
18009 : {
18010 0 : k0 = k+1;
18011 : }
18012 : else
18013 : {
18014 0 : k1 = k-1;
18015 : }
18016 : }
18017 : }
18018 :
18019 : /*
18020 : * SKS
18021 : */
18022 0 : if( s->matrixtype==2 )
18023 : {
18024 0 : ae_assert(s->m==s->n, "SparseRewriteExisting: non-square SKS matrix not supported", _state);
18025 0 : if( i==j )
18026 : {
18027 :
18028 : /*
18029 : * Rewrite diagonal element
18030 : */
18031 0 : result = ae_true;
18032 0 : s->vals.ptr.p_double[s->ridx.ptr.p_int[i]+s->didx.ptr.p_int[i]] = v;
18033 0 : return result;
18034 : }
18035 0 : if( j<i )
18036 : {
18037 :
18038 : /*
18039 : * Return subdiagonal element at I-th "skyline block"
18040 : */
18041 0 : k = s->didx.ptr.p_int[i];
18042 0 : if( i-j<=k )
18043 : {
18044 0 : s->vals.ptr.p_double[s->ridx.ptr.p_int[i]+k+j-i] = v;
18045 0 : result = ae_true;
18046 : }
18047 : }
18048 : else
18049 : {
18050 :
18051 : /*
18052 : * Return superdiagonal element at J-th "skyline block"
18053 : */
18054 0 : k = s->uidx.ptr.p_int[j];
18055 0 : if( j-i<=k )
18056 : {
18057 0 : s->vals.ptr.p_double[s->ridx.ptr.p_int[j+1]-(j-i)] = v;
18058 0 : result = ae_true;
18059 : }
18060 : }
18061 0 : return result;
18062 : }
18063 0 : return result;
18064 : }
18065 :
18066 :
18067 : /*************************************************************************
18068 : This function returns I-th row of the sparse matrix. Matrix must be stored
18069 : in CRS or SKS format.
18070 :
18071 : INPUT PARAMETERS:
18072 : S - sparse M*N matrix in CRS format
18073 : I - row index, 0<=I<M
18074 : IRow - output buffer, can be preallocated. In case buffer
18075 : size is too small to store I-th row, it is
18076 : automatically reallocated.
18077 :
18078 : OUTPUT PARAMETERS:
18079 : IRow - array[M], I-th row.
18080 :
18081 : NOTE: this function has O(N) running time, where N is a column count. It
18082 : allocates and fills N-element array, even although most of its
18083 : elemets are zero.
18084 :
18085 : NOTE: If you have O(non-zeros-per-row) time and memory requirements, use
18086 : SparseGetCompressedRow() function. It returns data in compressed
18087 : format.
18088 :
18089 : NOTE: when incorrect I (outside of [0,M-1]) or matrix (non CRS/SKS)
18090 : is passed, this function throws exception.
18091 :
18092 : -- ALGLIB PROJECT --
18093 : Copyright 10.12.2014 by Bochkanov Sergey
18094 : *************************************************************************/
18095 0 : void sparsegetrow(sparsematrix* s,
18096 : ae_int_t i,
18097 : /* Real */ ae_vector* irow,
18098 : ae_state *_state)
18099 : {
18100 : ae_int_t i0;
18101 : ae_int_t j0;
18102 : ae_int_t j1;
18103 : ae_int_t j;
18104 : ae_int_t upperprofile;
18105 :
18106 :
18107 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseGetRow: S must be CRS/SKS-based matrix", _state);
18108 0 : ae_assert(i>=0&&i<s->m, "SparseGetRow: I<0 or I>=M", _state);
18109 :
18110 : /*
18111 : * Prepare output buffer
18112 : */
18113 0 : rvectorsetlengthatleast(irow, s->n, _state);
18114 0 : for(i0=0; i0<=s->n-1; i0++)
18115 : {
18116 0 : irow->ptr.p_double[i0] = (double)(0);
18117 : }
18118 :
18119 : /*
18120 : * Output
18121 : */
18122 0 : if( s->matrixtype==1 )
18123 : {
18124 0 : for(i0=s->ridx.ptr.p_int[i]; i0<=s->ridx.ptr.p_int[i+1]-1; i0++)
18125 : {
18126 0 : irow->ptr.p_double[s->idx.ptr.p_int[i0]] = s->vals.ptr.p_double[i0];
18127 : }
18128 0 : return;
18129 : }
18130 0 : if( s->matrixtype==2 )
18131 : {
18132 :
18133 : /*
18134 : * Copy subdiagonal and diagonal parts
18135 : */
18136 0 : ae_assert(s->n==s->m, "SparseGetRow: non-square SKS matrices are not supported", _state);
18137 0 : j0 = i-s->didx.ptr.p_int[i];
18138 0 : i0 = -j0+s->ridx.ptr.p_int[i];
18139 0 : for(j=j0; j<=i; j++)
18140 : {
18141 0 : irow->ptr.p_double[j] = s->vals.ptr.p_double[j+i0];
18142 : }
18143 :
18144 : /*
18145 : * Copy superdiagonal part
18146 : */
18147 0 : upperprofile = s->uidx.ptr.p_int[s->n];
18148 0 : j0 = i+1;
18149 0 : j1 = ae_minint(s->n-1, i+upperprofile, _state);
18150 0 : for(j=j0; j<=j1; j++)
18151 : {
18152 0 : if( j-i<=s->uidx.ptr.p_int[j] )
18153 : {
18154 0 : irow->ptr.p_double[j] = s->vals.ptr.p_double[s->ridx.ptr.p_int[j+1]-(j-i)];
18155 : }
18156 : }
18157 0 : return;
18158 : }
18159 : }
18160 :
18161 :
18162 : /*************************************************************************
18163 : This function returns I-th row of the sparse matrix IN COMPRESSED FORMAT -
18164 : only non-zero elements are returned (with their indexes). Matrix must be
18165 : stored in CRS or SKS format.
18166 :
18167 : INPUT PARAMETERS:
18168 : S - sparse M*N matrix in CRS format
18169 : I - row index, 0<=I<M
18170 : ColIdx - output buffer for column indexes, can be preallocated.
18171 : In case buffer size is too small to store I-th row, it
18172 : is automatically reallocated.
18173 : Vals - output buffer for values, can be preallocated. In case
18174 : buffer size is too small to store I-th row, it is
18175 : automatically reallocated.
18176 :
18177 : OUTPUT PARAMETERS:
18178 : ColIdx - column indexes of non-zero elements, sorted by
18179 : ascending. Symbolically non-zero elements are counted
18180 : (i.e. if you allocated place for element, but it has
18181 : zero numerical value - it is counted).
18182 : Vals - values. Vals[K] stores value of matrix element with
18183 : indexes (I,ColIdx[K]). Symbolically non-zero elements
18184 : are counted (i.e. if you allocated place for element,
18185 : but it has zero numerical value - it is counted).
18186 : NZCnt - number of symbolically non-zero elements per row.
18187 :
18188 : NOTE: when incorrect I (outside of [0,M-1]) or matrix (non CRS/SKS)
18189 : is passed, this function throws exception.
18190 :
18191 : NOTE: this function may allocate additional, unnecessary place for ColIdx
18192 : and Vals arrays. It is dictated by performance reasons - on SKS
18193 : matrices it is faster to allocate space at the beginning with
18194 : some "extra"-space, than performing two passes over matrix - first
18195 : time to calculate exact space required for data, second time - to
18196 : store data itself.
18197 :
18198 : -- ALGLIB PROJECT --
18199 : Copyright 10.12.2014 by Bochkanov Sergey
18200 : *************************************************************************/
18201 0 : void sparsegetcompressedrow(sparsematrix* s,
18202 : ae_int_t i,
18203 : /* Integer */ ae_vector* colidx,
18204 : /* Real */ ae_vector* vals,
18205 : ae_int_t* nzcnt,
18206 : ae_state *_state)
18207 : {
18208 : ae_int_t k;
18209 : ae_int_t k0;
18210 : ae_int_t j;
18211 : ae_int_t j0;
18212 : ae_int_t j1;
18213 : ae_int_t i0;
18214 : ae_int_t upperprofile;
18215 :
18216 0 : *nzcnt = 0;
18217 :
18218 0 : ae_assert(s->matrixtype==1||s->matrixtype==2, "SparseGetRow: S must be CRS/SKS-based matrix", _state);
18219 0 : ae_assert(i>=0&&i<s->m, "SparseGetRow: I<0 or I>=M", _state);
18220 :
18221 : /*
18222 : * Initialize NZCnt
18223 : */
18224 0 : *nzcnt = 0;
18225 :
18226 : /*
18227 : * CRS matrix - just copy data
18228 : */
18229 0 : if( s->matrixtype==1 )
18230 : {
18231 0 : *nzcnt = s->ridx.ptr.p_int[i+1]-s->ridx.ptr.p_int[i];
18232 0 : ivectorsetlengthatleast(colidx, *nzcnt, _state);
18233 0 : rvectorsetlengthatleast(vals, *nzcnt, _state);
18234 0 : k0 = s->ridx.ptr.p_int[i];
18235 0 : for(k=0; k<=*nzcnt-1; k++)
18236 : {
18237 0 : colidx->ptr.p_int[k] = s->idx.ptr.p_int[k0+k];
18238 0 : vals->ptr.p_double[k] = s->vals.ptr.p_double[k0+k];
18239 : }
18240 0 : return;
18241 : }
18242 :
18243 : /*
18244 : * SKS matrix - a bit more complex sequence
18245 : */
18246 0 : if( s->matrixtype==2 )
18247 : {
18248 0 : ae_assert(s->n==s->m, "SparseGetCompressedRow: non-square SKS matrices are not supported", _state);
18249 :
18250 : /*
18251 : * Allocate enough place for storage
18252 : */
18253 0 : upperprofile = s->uidx.ptr.p_int[s->n];
18254 0 : ivectorsetlengthatleast(colidx, s->didx.ptr.p_int[i]+1+upperprofile, _state);
18255 0 : rvectorsetlengthatleast(vals, s->didx.ptr.p_int[i]+1+upperprofile, _state);
18256 :
18257 : /*
18258 : * Copy subdiagonal and diagonal parts
18259 : */
18260 0 : j0 = i-s->didx.ptr.p_int[i];
18261 0 : i0 = -j0+s->ridx.ptr.p_int[i];
18262 0 : for(j=j0; j<=i; j++)
18263 : {
18264 0 : colidx->ptr.p_int[*nzcnt] = j;
18265 0 : vals->ptr.p_double[*nzcnt] = s->vals.ptr.p_double[j+i0];
18266 0 : *nzcnt = *nzcnt+1;
18267 : }
18268 :
18269 : /*
18270 : * Copy superdiagonal part
18271 : */
18272 0 : j0 = i+1;
18273 0 : j1 = ae_minint(s->n-1, i+upperprofile, _state);
18274 0 : for(j=j0; j<=j1; j++)
18275 : {
18276 0 : if( j-i<=s->uidx.ptr.p_int[j] )
18277 : {
18278 0 : colidx->ptr.p_int[*nzcnt] = j;
18279 0 : vals->ptr.p_double[*nzcnt] = s->vals.ptr.p_double[s->ridx.ptr.p_int[j+1]-(j-i)];
18280 0 : *nzcnt = *nzcnt+1;
18281 : }
18282 : }
18283 0 : return;
18284 : }
18285 : }
18286 :
18287 :
18288 : /*************************************************************************
18289 : This function performs efficient in-place transpose of SKS matrix. No
18290 : additional memory is allocated during transposition.
18291 :
18292 : This function supports only skyline storage format (SKS).
18293 :
18294 : INPUT PARAMETERS
18295 : S - sparse matrix in SKS format.
18296 :
18297 : OUTPUT PARAMETERS
18298 : S - sparse matrix, transposed.
18299 :
18300 : -- ALGLIB PROJECT --
18301 : Copyright 16.01.2014 by Bochkanov Sergey
18302 : *************************************************************************/
18303 0 : void sparsetransposesks(sparsematrix* s, ae_state *_state)
18304 : {
18305 : ae_int_t n;
18306 : ae_int_t d;
18307 : ae_int_t u;
18308 : ae_int_t i;
18309 : ae_int_t k;
18310 : ae_int_t t0;
18311 : ae_int_t t1;
18312 : double v;
18313 :
18314 :
18315 0 : ae_assert(s->matrixtype==2, "SparseTransposeSKS: only SKS matrices are supported", _state);
18316 0 : ae_assert(s->m==s->n, "SparseTransposeSKS: non-square SKS matrices are not supported", _state);
18317 0 : n = s->n;
18318 0 : for(i=1; i<=n-1; i++)
18319 : {
18320 0 : d = s->didx.ptr.p_int[i];
18321 0 : u = s->uidx.ptr.p_int[i];
18322 0 : k = s->uidx.ptr.p_int[i];
18323 0 : s->uidx.ptr.p_int[i] = s->didx.ptr.p_int[i];
18324 0 : s->didx.ptr.p_int[i] = k;
18325 0 : if( d==u )
18326 : {
18327 :
18328 : /*
18329 : * Upper skyline height equal to lower skyline height,
18330 : * simple exchange is needed for transposition
18331 : */
18332 0 : t0 = s->ridx.ptr.p_int[i];
18333 0 : for(k=0; k<=d-1; k++)
18334 : {
18335 0 : v = s->vals.ptr.p_double[t0+k];
18336 0 : s->vals.ptr.p_double[t0+k] = s->vals.ptr.p_double[t0+d+1+k];
18337 0 : s->vals.ptr.p_double[t0+d+1+k] = v;
18338 : }
18339 : }
18340 0 : if( d>u )
18341 : {
18342 :
18343 : /*
18344 : * Upper skyline height is less than lower skyline height.
18345 : *
18346 : * Transposition becomes a bit tricky: we have to rearrange
18347 : * "L0 L1 D U" to "U D L0 L1", where |L0|=|U|=u, |L1|=d-u.
18348 : *
18349 : * In order to do this we perform a sequence of swaps and
18350 : * in-place reversals:
18351 : * * swap(L0,U) => "U L1 D L0"
18352 : * * reverse("L1 D L0") => "U L0~ D L1~" (where X~ is a reverse of X)
18353 : * * reverse("L0~ D") => "U D L0 L1~"
18354 : * * reverse("L1") => "U D L0 L1"
18355 : */
18356 0 : t0 = s->ridx.ptr.p_int[i];
18357 0 : t1 = s->ridx.ptr.p_int[i]+d+1;
18358 0 : for(k=0; k<=u-1; k++)
18359 : {
18360 0 : v = s->vals.ptr.p_double[t0+k];
18361 0 : s->vals.ptr.p_double[t0+k] = s->vals.ptr.p_double[t1+k];
18362 0 : s->vals.ptr.p_double[t1+k] = v;
18363 : }
18364 0 : t0 = s->ridx.ptr.p_int[i]+u;
18365 0 : t1 = s->ridx.ptr.p_int[i+1]-1;
18366 0 : while(t1>t0)
18367 : {
18368 0 : v = s->vals.ptr.p_double[t0];
18369 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18370 0 : s->vals.ptr.p_double[t1] = v;
18371 0 : t0 = t0+1;
18372 0 : t1 = t1-1;
18373 : }
18374 0 : t0 = s->ridx.ptr.p_int[i]+u;
18375 0 : t1 = s->ridx.ptr.p_int[i]+u+u;
18376 0 : while(t1>t0)
18377 : {
18378 0 : v = s->vals.ptr.p_double[t0];
18379 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18380 0 : s->vals.ptr.p_double[t1] = v;
18381 0 : t0 = t0+1;
18382 0 : t1 = t1-1;
18383 : }
18384 0 : t0 = s->ridx.ptr.p_int[i+1]-(d-u);
18385 0 : t1 = s->ridx.ptr.p_int[i+1]-1;
18386 0 : while(t1>t0)
18387 : {
18388 0 : v = s->vals.ptr.p_double[t0];
18389 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18390 0 : s->vals.ptr.p_double[t1] = v;
18391 0 : t0 = t0+1;
18392 0 : t1 = t1-1;
18393 : }
18394 : }
18395 0 : if( d<u )
18396 : {
18397 :
18398 : /*
18399 : * Upper skyline height is greater than lower skyline height.
18400 : *
18401 : * Transposition becomes a bit tricky: we have to rearrange
18402 : * "L D U0 U1" to "U0 U1 D L", where |U1|=|L|=d, |U0|=u-d.
18403 : *
18404 : * In order to do this we perform a sequence of swaps and
18405 : * in-place reversals:
18406 : * * swap(L,U1) => "U1 D U0 L"
18407 : * * reverse("U1 D U0") => "U0~ D U1~ L" (where X~ is a reverse of X)
18408 : * * reverse("U0~") => "U0 D U1~ L"
18409 : * * reverse("D U1~") => "U0 U1 D L"
18410 : */
18411 0 : t0 = s->ridx.ptr.p_int[i];
18412 0 : t1 = s->ridx.ptr.p_int[i+1]-d;
18413 0 : for(k=0; k<=d-1; k++)
18414 : {
18415 0 : v = s->vals.ptr.p_double[t0+k];
18416 0 : s->vals.ptr.p_double[t0+k] = s->vals.ptr.p_double[t1+k];
18417 0 : s->vals.ptr.p_double[t1+k] = v;
18418 : }
18419 0 : t0 = s->ridx.ptr.p_int[i];
18420 0 : t1 = s->ridx.ptr.p_int[i]+u;
18421 0 : while(t1>t0)
18422 : {
18423 0 : v = s->vals.ptr.p_double[t0];
18424 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18425 0 : s->vals.ptr.p_double[t1] = v;
18426 0 : t0 = t0+1;
18427 0 : t1 = t1-1;
18428 : }
18429 0 : t0 = s->ridx.ptr.p_int[i];
18430 0 : t1 = s->ridx.ptr.p_int[i]+u-d-1;
18431 0 : while(t1>t0)
18432 : {
18433 0 : v = s->vals.ptr.p_double[t0];
18434 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18435 0 : s->vals.ptr.p_double[t1] = v;
18436 0 : t0 = t0+1;
18437 0 : t1 = t1-1;
18438 : }
18439 0 : t0 = s->ridx.ptr.p_int[i]+u-d;
18440 0 : t1 = s->ridx.ptr.p_int[i+1]-d-1;
18441 0 : while(t1>t0)
18442 : {
18443 0 : v = s->vals.ptr.p_double[t0];
18444 0 : s->vals.ptr.p_double[t0] = s->vals.ptr.p_double[t1];
18445 0 : s->vals.ptr.p_double[t1] = v;
18446 0 : t0 = t0+1;
18447 0 : t1 = t1-1;
18448 : }
18449 : }
18450 : }
18451 0 : k = s->uidx.ptr.p_int[n];
18452 0 : s->uidx.ptr.p_int[n] = s->didx.ptr.p_int[n];
18453 0 : s->didx.ptr.p_int[n] = k;
18454 0 : }
18455 :
18456 :
18457 : /*************************************************************************
18458 : This function performs transpose of CRS matrix.
18459 :
18460 : INPUT PARAMETERS
18461 : S - sparse matrix in CRS format.
18462 :
18463 : OUTPUT PARAMETERS
18464 : S - sparse matrix, transposed.
18465 :
18466 : NOTE: internal temporary copy is allocated for the purposes of
18467 : transposition. It is deallocated after transposition.
18468 :
18469 : -- ALGLIB PROJECT --
18470 : Copyright 30.01.2018 by Bochkanov Sergey
18471 : *************************************************************************/
18472 0 : void sparsetransposecrs(sparsematrix* s, ae_state *_state)
18473 : {
18474 : ae_frame _frame_block;
18475 : ae_vector oldvals;
18476 : ae_vector oldidx;
18477 : ae_vector oldridx;
18478 : ae_int_t oldn;
18479 : ae_int_t oldm;
18480 : ae_int_t newn;
18481 : ae_int_t newm;
18482 : ae_int_t i;
18483 : ae_int_t j;
18484 : ae_int_t k;
18485 : ae_int_t nonne;
18486 : ae_vector counts;
18487 :
18488 0 : ae_frame_make(_state, &_frame_block);
18489 0 : memset(&oldvals, 0, sizeof(oldvals));
18490 0 : memset(&oldidx, 0, sizeof(oldidx));
18491 0 : memset(&oldridx, 0, sizeof(oldridx));
18492 0 : memset(&counts, 0, sizeof(counts));
18493 0 : ae_vector_init(&oldvals, 0, DT_REAL, _state, ae_true);
18494 0 : ae_vector_init(&oldidx, 0, DT_INT, _state, ae_true);
18495 0 : ae_vector_init(&oldridx, 0, DT_INT, _state, ae_true);
18496 0 : ae_vector_init(&counts, 0, DT_INT, _state, ae_true);
18497 :
18498 0 : ae_assert(s->matrixtype==1, "SparseTransposeCRS: only CRS matrices are supported", _state);
18499 0 : ae_swap_vectors(&s->vals, &oldvals);
18500 0 : ae_swap_vectors(&s->idx, &oldidx);
18501 0 : ae_swap_vectors(&s->ridx, &oldridx);
18502 0 : oldn = s->n;
18503 0 : oldm = s->m;
18504 0 : newn = oldm;
18505 0 : newm = oldn;
18506 :
18507 : /*
18508 : * Update matrix size
18509 : */
18510 0 : s->n = newn;
18511 0 : s->m = newm;
18512 :
18513 : /*
18514 : * Fill RIdx by number of elements per row:
18515 : * RIdx[I+1] stores number of elements in I-th row.
18516 : *
18517 : * Convert RIdx from row sizes to row offsets.
18518 : * Set NInitialized
18519 : */
18520 0 : nonne = 0;
18521 0 : ivectorsetlengthatleast(&s->ridx, newm+1, _state);
18522 0 : for(i=0; i<=newm; i++)
18523 : {
18524 0 : s->ridx.ptr.p_int[i] = 0;
18525 : }
18526 0 : for(i=0; i<=oldm-1; i++)
18527 : {
18528 0 : for(j=oldridx.ptr.p_int[i]; j<=oldridx.ptr.p_int[i+1]-1; j++)
18529 : {
18530 0 : k = oldidx.ptr.p_int[j]+1;
18531 0 : s->ridx.ptr.p_int[k] = s->ridx.ptr.p_int[k]+1;
18532 0 : nonne = nonne+1;
18533 : }
18534 : }
18535 0 : for(i=0; i<=newm-1; i++)
18536 : {
18537 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i+1]+s->ridx.ptr.p_int[i];
18538 : }
18539 0 : s->ninitialized = s->ridx.ptr.p_int[newm];
18540 :
18541 : /*
18542 : * Allocate memory and move elements to Vals/Idx.
18543 : */
18544 0 : ae_vector_set_length(&counts, newm, _state);
18545 0 : for(i=0; i<=newm-1; i++)
18546 : {
18547 0 : counts.ptr.p_int[i] = 0;
18548 : }
18549 0 : rvectorsetlengthatleast(&s->vals, nonne, _state);
18550 0 : ivectorsetlengthatleast(&s->idx, nonne, _state);
18551 0 : for(i=0; i<=oldm-1; i++)
18552 : {
18553 0 : for(j=oldridx.ptr.p_int[i]; j<=oldridx.ptr.p_int[i+1]-1; j++)
18554 : {
18555 0 : k = oldidx.ptr.p_int[j];
18556 0 : k = s->ridx.ptr.p_int[k]+counts.ptr.p_int[k];
18557 0 : s->idx.ptr.p_int[k] = i;
18558 0 : s->vals.ptr.p_double[k] = oldvals.ptr.p_double[j];
18559 0 : k = oldidx.ptr.p_int[j];
18560 0 : counts.ptr.p_int[k] = counts.ptr.p_int[k]+1;
18561 : }
18562 : }
18563 :
18564 : /*
18565 : * Initialization 'S.UIdx' and 'S.DIdx'
18566 : */
18567 0 : sparseinitduidx(s, _state);
18568 0 : ae_frame_leave(_state);
18569 0 : }
18570 :
18571 :
18572 : /*************************************************************************
18573 : This function performs copying with transposition of CRS matrix.
18574 :
18575 : INPUT PARAMETERS
18576 : S0 - sparse matrix in CRS format.
18577 :
18578 : OUTPUT PARAMETERS
18579 : S1 - sparse matrix, transposed
18580 :
18581 : -- ALGLIB PROJECT --
18582 : Copyright 23.07.2018 by Bochkanov Sergey
18583 : *************************************************************************/
18584 0 : void sparsecopytransposecrs(sparsematrix* s0,
18585 : sparsematrix* s1,
18586 : ae_state *_state)
18587 : {
18588 :
18589 0 : _sparsematrix_clear(s1);
18590 :
18591 0 : sparsecopytransposecrsbuf(s0, s1, _state);
18592 0 : }
18593 :
18594 :
18595 : /*************************************************************************
18596 : This function performs copying with transposition of CRS matrix (buffered
18597 : version which reuses memory already allocated by the target as much as
18598 : possible).
18599 :
18600 : INPUT PARAMETERS
18601 : S0 - sparse matrix in CRS format.
18602 :
18603 : OUTPUT PARAMETERS
18604 : S1 - sparse matrix, transposed; previously allocated memory is
18605 : reused if possible.
18606 :
18607 : -- ALGLIB PROJECT --
18608 : Copyright 23.07.2018 by Bochkanov Sergey
18609 : *************************************************************************/
18610 0 : void sparsecopytransposecrsbuf(sparsematrix* s0,
18611 : sparsematrix* s1,
18612 : ae_state *_state)
18613 : {
18614 : ae_int_t oldn;
18615 : ae_int_t oldm;
18616 : ae_int_t newn;
18617 : ae_int_t newm;
18618 : ae_int_t i;
18619 : ae_int_t j;
18620 : ae_int_t k;
18621 : ae_int_t kk;
18622 : ae_int_t j0;
18623 : ae_int_t j1;
18624 :
18625 :
18626 0 : ae_assert(s0->matrixtype==1, "SparseCopyTransposeCRSBuf: only CRS matrices are supported", _state);
18627 0 : oldn = s0->n;
18628 0 : oldm = s0->m;
18629 0 : newn = oldm;
18630 0 : newm = oldn;
18631 :
18632 : /*
18633 : * Update matrix size
18634 : */
18635 0 : s1->matrixtype = 1;
18636 0 : s1->n = newn;
18637 0 : s1->m = newm;
18638 :
18639 : /*
18640 : * Fill RIdx by number of elements per row:
18641 : * RIdx[I+1] stores number of elements in I-th row.
18642 : *
18643 : * Convert RIdx from row sizes to row offsets.
18644 : * Set NInitialized
18645 : */
18646 0 : isetallocv(newm+1, 0, &s1->ridx, _state);
18647 0 : for(i=0; i<=oldm-1; i++)
18648 : {
18649 0 : j0 = s0->ridx.ptr.p_int[i];
18650 0 : j1 = s0->ridx.ptr.p_int[i+1]-1;
18651 0 : for(j=j0; j<=j1; j++)
18652 : {
18653 0 : k = s0->idx.ptr.p_int[j]+1;
18654 0 : s1->ridx.ptr.p_int[k] = s1->ridx.ptr.p_int[k]+1;
18655 : }
18656 : }
18657 0 : for(i=0; i<=newm-1; i++)
18658 : {
18659 0 : s1->ridx.ptr.p_int[i+1] = s1->ridx.ptr.p_int[i+1]+s1->ridx.ptr.p_int[i];
18660 : }
18661 0 : s1->ninitialized = s1->ridx.ptr.p_int[newm];
18662 :
18663 : /*
18664 : * Allocate memory and move elements to Vals/Idx.
18665 : */
18666 0 : ivectorsetlengthatleast(&s1->didx, newm, _state);
18667 0 : for(i=0; i<=newm-1; i++)
18668 : {
18669 0 : s1->didx.ptr.p_int[i] = s1->ridx.ptr.p_int[i];
18670 : }
18671 0 : rvectorsetlengthatleast(&s1->vals, s1->ninitialized, _state);
18672 0 : ivectorsetlengthatleast(&s1->idx, s1->ninitialized, _state);
18673 0 : for(i=0; i<=oldm-1; i++)
18674 : {
18675 0 : j0 = s0->ridx.ptr.p_int[i];
18676 0 : j1 = s0->ridx.ptr.p_int[i+1]-1;
18677 0 : for(j=j0; j<=j1; j++)
18678 : {
18679 0 : kk = s0->idx.ptr.p_int[j];
18680 0 : k = s1->didx.ptr.p_int[kk];
18681 0 : s1->idx.ptr.p_int[k] = i;
18682 0 : s1->vals.ptr.p_double[k] = s0->vals.ptr.p_double[j];
18683 0 : s1->didx.ptr.p_int[kk] = k+1;
18684 : }
18685 : }
18686 :
18687 : /*
18688 : * Initialization 'S.UIdx' and 'S.DIdx'
18689 : */
18690 0 : sparseinitduidx(s1, _state);
18691 0 : }
18692 :
18693 :
18694 : /*************************************************************************
18695 : This function performs in-place conversion to desired sparse storage
18696 : format.
18697 :
18698 : INPUT PARAMETERS
18699 : S0 - sparse matrix in any format.
18700 : Fmt - desired storage format of the output, as returned by
18701 : SparseGetMatrixType() function:
18702 : * 0 for hash-based storage
18703 : * 1 for CRS
18704 : * 2 for SKS
18705 :
18706 : OUTPUT PARAMETERS
18707 : S0 - sparse matrix in requested format.
18708 :
18709 : NOTE: in-place conversion wastes a lot of memory which is used to store
18710 : temporaries. If you perform a lot of repeated conversions, we
18711 : recommend to use out-of-place buffered conversion functions, like
18712 : SparseCopyToBuf(), which can reuse already allocated memory.
18713 :
18714 : -- ALGLIB PROJECT --
18715 : Copyright 16.01.2014 by Bochkanov Sergey
18716 : *************************************************************************/
18717 0 : void sparseconvertto(sparsematrix* s0, ae_int_t fmt, ae_state *_state)
18718 : {
18719 :
18720 :
18721 0 : ae_assert((fmt==0||fmt==1)||fmt==2, "SparseConvertTo: invalid fmt parameter", _state);
18722 0 : if( fmt==0 )
18723 : {
18724 0 : sparseconverttohash(s0, _state);
18725 0 : return;
18726 : }
18727 0 : if( fmt==1 )
18728 : {
18729 0 : sparseconverttocrs(s0, _state);
18730 0 : return;
18731 : }
18732 0 : if( fmt==2 )
18733 : {
18734 0 : sparseconverttosks(s0, _state);
18735 0 : return;
18736 : }
18737 0 : ae_assert(ae_false, "SparseConvertTo: invalid matrix type", _state);
18738 : }
18739 :
18740 :
18741 : /*************************************************************************
18742 : This function performs out-of-place conversion to desired sparse storage
18743 : format. S0 is copied to S1 and converted on-the-fly. Memory allocated in
18744 : S1 is reused to maximum extent possible.
18745 :
18746 : INPUT PARAMETERS
18747 : S0 - sparse matrix in any format.
18748 : Fmt - desired storage format of the output, as returned by
18749 : SparseGetMatrixType() function:
18750 : * 0 for hash-based storage
18751 : * 1 for CRS
18752 : * 2 for SKS
18753 :
18754 : OUTPUT PARAMETERS
18755 : S1 - sparse matrix in requested format.
18756 :
18757 : -- ALGLIB PROJECT --
18758 : Copyright 16.01.2014 by Bochkanov Sergey
18759 : *************************************************************************/
18760 0 : void sparsecopytobuf(sparsematrix* s0,
18761 : ae_int_t fmt,
18762 : sparsematrix* s1,
18763 : ae_state *_state)
18764 : {
18765 :
18766 :
18767 0 : ae_assert((fmt==0||fmt==1)||fmt==2, "SparseCopyToBuf: invalid fmt parameter", _state);
18768 0 : if( fmt==0 )
18769 : {
18770 0 : sparsecopytohashbuf(s0, s1, _state);
18771 0 : return;
18772 : }
18773 0 : if( fmt==1 )
18774 : {
18775 0 : sparsecopytocrsbuf(s0, s1, _state);
18776 0 : return;
18777 : }
18778 0 : if( fmt==2 )
18779 : {
18780 0 : sparsecopytosksbuf(s0, s1, _state);
18781 0 : return;
18782 : }
18783 0 : ae_assert(ae_false, "SparseCopyToBuf: invalid matrix type", _state);
18784 : }
18785 :
18786 :
18787 : /*************************************************************************
18788 : This function performs in-place conversion to Hash table storage.
18789 :
18790 : INPUT PARAMETERS
18791 : S - sparse matrix in CRS format.
18792 :
18793 : OUTPUT PARAMETERS
18794 : S - sparse matrix in Hash table format.
18795 :
18796 : NOTE: this function has no effect when called with matrix which is
18797 : already in Hash table mode.
18798 :
18799 : NOTE: in-place conversion involves allocation of temporary arrays. If you
18800 : perform a lot of repeated in- place conversions, it may lead to
18801 : memory fragmentation. Consider using out-of-place SparseCopyToHashBuf()
18802 : function in this case.
18803 :
18804 : -- ALGLIB PROJECT --
18805 : Copyright 20.07.2012 by Bochkanov Sergey
18806 : *************************************************************************/
18807 0 : void sparseconverttohash(sparsematrix* s, ae_state *_state)
18808 : {
18809 : ae_frame _frame_block;
18810 : ae_vector tidx;
18811 : ae_vector tridx;
18812 : ae_vector tdidx;
18813 : ae_vector tuidx;
18814 : ae_vector tvals;
18815 : ae_int_t n;
18816 : ae_int_t m;
18817 : ae_int_t offs0;
18818 : ae_int_t i;
18819 : ae_int_t j;
18820 : ae_int_t k;
18821 :
18822 0 : ae_frame_make(_state, &_frame_block);
18823 0 : memset(&tidx, 0, sizeof(tidx));
18824 0 : memset(&tridx, 0, sizeof(tridx));
18825 0 : memset(&tdidx, 0, sizeof(tdidx));
18826 0 : memset(&tuidx, 0, sizeof(tuidx));
18827 0 : memset(&tvals, 0, sizeof(tvals));
18828 0 : ae_vector_init(&tidx, 0, DT_INT, _state, ae_true);
18829 0 : ae_vector_init(&tridx, 0, DT_INT, _state, ae_true);
18830 0 : ae_vector_init(&tdidx, 0, DT_INT, _state, ae_true);
18831 0 : ae_vector_init(&tuidx, 0, DT_INT, _state, ae_true);
18832 0 : ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true);
18833 :
18834 0 : ae_assert((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2, "SparseConvertToHash: invalid matrix type", _state);
18835 0 : if( s->matrixtype==0 )
18836 : {
18837 :
18838 : /*
18839 : * Already in Hash mode
18840 : */
18841 0 : ae_frame_leave(_state);
18842 0 : return;
18843 : }
18844 0 : if( s->matrixtype==1 )
18845 : {
18846 :
18847 : /*
18848 : * From CRS to Hash
18849 : */
18850 0 : s->matrixtype = 0;
18851 0 : m = s->m;
18852 0 : n = s->n;
18853 0 : ae_swap_vectors(&s->idx, &tidx);
18854 0 : ae_swap_vectors(&s->ridx, &tridx);
18855 0 : ae_swap_vectors(&s->vals, &tvals);
18856 0 : sparsecreatebuf(m, n, tridx.ptr.p_int[m], s, _state);
18857 0 : for(i=0; i<=m-1; i++)
18858 : {
18859 0 : for(j=tridx.ptr.p_int[i]; j<=tridx.ptr.p_int[i+1]-1; j++)
18860 : {
18861 0 : sparseset(s, i, tidx.ptr.p_int[j], tvals.ptr.p_double[j], _state);
18862 : }
18863 : }
18864 0 : ae_frame_leave(_state);
18865 0 : return;
18866 : }
18867 0 : if( s->matrixtype==2 )
18868 : {
18869 :
18870 : /*
18871 : * From SKS to Hash
18872 : */
18873 0 : s->matrixtype = 0;
18874 0 : m = s->m;
18875 0 : n = s->n;
18876 0 : ae_swap_vectors(&s->ridx, &tridx);
18877 0 : ae_swap_vectors(&s->didx, &tdidx);
18878 0 : ae_swap_vectors(&s->uidx, &tuidx);
18879 0 : ae_swap_vectors(&s->vals, &tvals);
18880 0 : sparsecreatebuf(m, n, tridx.ptr.p_int[m], s, _state);
18881 0 : for(i=0; i<=m-1; i++)
18882 : {
18883 :
18884 : /*
18885 : * copy subdiagonal and diagonal parts of I-th block
18886 : */
18887 0 : offs0 = tridx.ptr.p_int[i];
18888 0 : k = tdidx.ptr.p_int[i]+1;
18889 0 : for(j=0; j<=k-1; j++)
18890 : {
18891 0 : sparseset(s, i, i-tdidx.ptr.p_int[i]+j, tvals.ptr.p_double[offs0+j], _state);
18892 : }
18893 :
18894 : /*
18895 : * Copy superdiagonal part of I-th block
18896 : */
18897 0 : offs0 = tridx.ptr.p_int[i]+tdidx.ptr.p_int[i]+1;
18898 0 : k = tuidx.ptr.p_int[i];
18899 0 : for(j=0; j<=k-1; j++)
18900 : {
18901 0 : sparseset(s, i-k+j, i, tvals.ptr.p_double[offs0+j], _state);
18902 : }
18903 : }
18904 0 : ae_frame_leave(_state);
18905 0 : return;
18906 : }
18907 0 : ae_assert(ae_false, "SparseConvertToHash: invalid matrix type", _state);
18908 0 : ae_frame_leave(_state);
18909 : }
18910 :
18911 :
18912 : /*************************************************************************
18913 : This function performs out-of-place conversion to Hash table storage
18914 : format. S0 is copied to S1 and converted on-the-fly.
18915 :
18916 : INPUT PARAMETERS
18917 : S0 - sparse matrix in any format.
18918 :
18919 : OUTPUT PARAMETERS
18920 : S1 - sparse matrix in Hash table format.
18921 :
18922 : NOTE: if S0 is stored as Hash-table, it is just copied without conversion.
18923 :
18924 : NOTE: this function de-allocates memory occupied by S1 before starting
18925 : conversion. If you perform a lot of repeated conversions, it may
18926 : lead to memory fragmentation. In this case we recommend you to use
18927 : SparseCopyToHashBuf() function which re-uses memory in S1 as much as
18928 : possible.
18929 :
18930 : -- ALGLIB PROJECT --
18931 : Copyright 20.07.2012 by Bochkanov Sergey
18932 : *************************************************************************/
18933 0 : void sparsecopytohash(sparsematrix* s0,
18934 : sparsematrix* s1,
18935 : ae_state *_state)
18936 : {
18937 :
18938 0 : _sparsematrix_clear(s1);
18939 :
18940 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToHash: invalid matrix type", _state);
18941 0 : sparsecopytohashbuf(s0, s1, _state);
18942 0 : }
18943 :
18944 :
18945 : /*************************************************************************
18946 : This function performs out-of-place conversion to Hash table storage
18947 : format. S0 is copied to S1 and converted on-the-fly. Memory allocated in
18948 : S1 is reused to maximum extent possible.
18949 :
18950 : INPUT PARAMETERS
18951 : S0 - sparse matrix in any format.
18952 :
18953 : OUTPUT PARAMETERS
18954 : S1 - sparse matrix in Hash table format.
18955 :
18956 : NOTE: if S0 is stored as Hash-table, it is just copied without conversion.
18957 :
18958 : -- ALGLIB PROJECT --
18959 : Copyright 20.07.2012 by Bochkanov Sergey
18960 : *************************************************************************/
18961 0 : void sparsecopytohashbuf(sparsematrix* s0,
18962 : sparsematrix* s1,
18963 : ae_state *_state)
18964 : {
18965 : double val;
18966 : ae_int_t t0;
18967 : ae_int_t t1;
18968 : ae_int_t i;
18969 : ae_int_t j;
18970 :
18971 :
18972 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToHashBuf: invalid matrix type", _state);
18973 0 : if( s0->matrixtype==0 )
18974 : {
18975 :
18976 : /*
18977 : * Already hash, just copy
18978 : */
18979 0 : sparsecopybuf(s0, s1, _state);
18980 0 : return;
18981 : }
18982 0 : if( s0->matrixtype==1 )
18983 : {
18984 :
18985 : /*
18986 : * CRS storage
18987 : */
18988 0 : t0 = 0;
18989 0 : t1 = 0;
18990 0 : sparsecreatebuf(s0->m, s0->n, s0->ridx.ptr.p_int[s0->m], s1, _state);
18991 0 : while(sparseenumerate(s0, &t0, &t1, &i, &j, &val, _state))
18992 : {
18993 0 : sparseset(s1, i, j, val, _state);
18994 : }
18995 0 : return;
18996 : }
18997 0 : if( s0->matrixtype==2 )
18998 : {
18999 :
19000 : /*
19001 : * SKS storage
19002 : */
19003 0 : t0 = 0;
19004 0 : t1 = 0;
19005 0 : sparsecreatebuf(s0->m, s0->n, s0->ridx.ptr.p_int[s0->m], s1, _state);
19006 0 : while(sparseenumerate(s0, &t0, &t1, &i, &j, &val, _state))
19007 : {
19008 0 : sparseset(s1, i, j, val, _state);
19009 : }
19010 0 : return;
19011 : }
19012 0 : ae_assert(ae_false, "SparseCopyToHashBuf: invalid matrix type", _state);
19013 : }
19014 :
19015 :
19016 : /*************************************************************************
19017 : This function converts matrix to CRS format.
19018 :
19019 : Some algorithms (linear algebra ones, for example) require matrices in
19020 : CRS format. This function allows to perform in-place conversion.
19021 :
19022 : INPUT PARAMETERS
19023 : S - sparse M*N matrix in any format
19024 :
19025 : OUTPUT PARAMETERS
19026 : S - matrix in CRS format
19027 :
19028 : NOTE: this function has no effect when called with matrix which is
19029 : already in CRS mode.
19030 :
19031 : NOTE: this function allocates temporary memory to store a copy of the
19032 : matrix. If you perform a lot of repeated conversions, we recommend
19033 : you to use SparseCopyToCRSBuf() function, which can reuse
19034 : previously allocated memory.
19035 :
19036 : -- ALGLIB PROJECT --
19037 : Copyright 14.10.2011 by Bochkanov Sergey
19038 : *************************************************************************/
19039 0 : void sparseconverttocrs(sparsematrix* s, ae_state *_state)
19040 : {
19041 : ae_frame _frame_block;
19042 : ae_int_t m;
19043 : ae_int_t i;
19044 : ae_int_t j;
19045 : ae_vector tvals;
19046 : ae_vector tidx;
19047 : ae_vector temp;
19048 : ae_vector tridx;
19049 : ae_int_t nonne;
19050 : ae_int_t k;
19051 : ae_int_t offs0;
19052 : ae_int_t offs1;
19053 :
19054 0 : ae_frame_make(_state, &_frame_block);
19055 0 : memset(&tvals, 0, sizeof(tvals));
19056 0 : memset(&tidx, 0, sizeof(tidx));
19057 0 : memset(&temp, 0, sizeof(temp));
19058 0 : memset(&tridx, 0, sizeof(tridx));
19059 0 : ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true);
19060 0 : ae_vector_init(&tidx, 0, DT_INT, _state, ae_true);
19061 0 : ae_vector_init(&temp, 0, DT_INT, _state, ae_true);
19062 0 : ae_vector_init(&tridx, 0, DT_INT, _state, ae_true);
19063 :
19064 0 : m = s->m;
19065 0 : if( s->matrixtype==0 )
19066 : {
19067 :
19068 : /*
19069 : * From Hash-table to CRS.
19070 : * First, create local copy of the hash table.
19071 : */
19072 0 : s->matrixtype = 1;
19073 0 : k = s->tablesize;
19074 0 : ae_swap_vectors(&s->vals, &tvals);
19075 0 : ae_swap_vectors(&s->idx, &tidx);
19076 :
19077 : /*
19078 : * Fill RIdx by number of elements per row:
19079 : * RIdx[I+1] stores number of elements in I-th row.
19080 : *
19081 : * Convert RIdx from row sizes to row offsets.
19082 : * Set NInitialized
19083 : */
19084 0 : nonne = 0;
19085 0 : ivectorsetlengthatleast(&s->ridx, s->m+1, _state);
19086 0 : for(i=0; i<=s->m; i++)
19087 : {
19088 0 : s->ridx.ptr.p_int[i] = 0;
19089 : }
19090 0 : for(i=0; i<=k-1; i++)
19091 : {
19092 0 : if( tidx.ptr.p_int[2*i]>=0 )
19093 : {
19094 0 : s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1] = s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1]+1;
19095 0 : nonne = nonne+1;
19096 : }
19097 : }
19098 0 : for(i=0; i<=s->m-1; i++)
19099 : {
19100 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i+1]+s->ridx.ptr.p_int[i];
19101 : }
19102 0 : s->ninitialized = s->ridx.ptr.p_int[s->m];
19103 :
19104 : /*
19105 : * Allocate memory and move elements to Vals/Idx.
19106 : * Initially, elements are sorted by rows, but unsorted within row.
19107 : * After initial insertion we sort elements within row.
19108 : */
19109 0 : ae_vector_set_length(&temp, s->m, _state);
19110 0 : for(i=0; i<=s->m-1; i++)
19111 : {
19112 0 : temp.ptr.p_int[i] = 0;
19113 : }
19114 0 : rvectorsetlengthatleast(&s->vals, nonne, _state);
19115 0 : ivectorsetlengthatleast(&s->idx, nonne, _state);
19116 0 : for(i=0; i<=k-1; i++)
19117 : {
19118 0 : if( tidx.ptr.p_int[2*i]>=0 )
19119 : {
19120 0 : s->vals.ptr.p_double[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tvals.ptr.p_double[i];
19121 0 : s->idx.ptr.p_int[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tidx.ptr.p_int[2*i+1];
19122 0 : temp.ptr.p_int[tidx.ptr.p_int[2*i]] = temp.ptr.p_int[tidx.ptr.p_int[2*i]]+1;
19123 : }
19124 : }
19125 0 : for(i=0; i<=s->m-1; i++)
19126 : {
19127 0 : tagsortmiddleir(&s->idx, &s->vals, s->ridx.ptr.p_int[i], s->ridx.ptr.p_int[i+1]-s->ridx.ptr.p_int[i], _state);
19128 : }
19129 :
19130 : /*
19131 : * Initialization 'S.UIdx' and 'S.DIdx'
19132 : */
19133 0 : sparseinitduidx(s, _state);
19134 0 : ae_frame_leave(_state);
19135 0 : return;
19136 : }
19137 0 : if( s->matrixtype==1 )
19138 : {
19139 :
19140 : /*
19141 : * Already CRS
19142 : */
19143 0 : ae_frame_leave(_state);
19144 0 : return;
19145 : }
19146 0 : if( s->matrixtype==2 )
19147 : {
19148 0 : ae_assert(s->m==s->n, "SparseConvertToCRS: non-square SKS matrices are not supported", _state);
19149 :
19150 : /*
19151 : * From SKS to CRS.
19152 : *
19153 : * First, create local copy of the SKS matrix (Vals,
19154 : * Idx, RIdx are stored; DIdx/UIdx for some time are
19155 : * left in the SparseMatrix structure).
19156 : */
19157 0 : s->matrixtype = 1;
19158 0 : ae_swap_vectors(&s->vals, &tvals);
19159 0 : ae_swap_vectors(&s->idx, &tidx);
19160 0 : ae_swap_vectors(&s->ridx, &tridx);
19161 :
19162 : /*
19163 : * Fill RIdx by number of elements per row:
19164 : * RIdx[I+1] stores number of elements in I-th row.
19165 : *
19166 : * Convert RIdx from row sizes to row offsets.
19167 : * Set NInitialized
19168 : */
19169 0 : ivectorsetlengthatleast(&s->ridx, m+1, _state);
19170 0 : s->ridx.ptr.p_int[0] = 0;
19171 0 : for(i=1; i<=m; i++)
19172 : {
19173 0 : s->ridx.ptr.p_int[i] = 1;
19174 : }
19175 0 : nonne = 0;
19176 0 : for(i=0; i<=m-1; i++)
19177 : {
19178 0 : s->ridx.ptr.p_int[i+1] = s->didx.ptr.p_int[i]+s->ridx.ptr.p_int[i+1];
19179 0 : for(j=i-s->uidx.ptr.p_int[i]; j<=i-1; j++)
19180 : {
19181 0 : s->ridx.ptr.p_int[j+1] = s->ridx.ptr.p_int[j+1]+1;
19182 : }
19183 0 : nonne = nonne+s->didx.ptr.p_int[i]+1+s->uidx.ptr.p_int[i];
19184 : }
19185 0 : for(i=0; i<=s->m-1; i++)
19186 : {
19187 0 : s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i+1]+s->ridx.ptr.p_int[i];
19188 : }
19189 0 : s->ninitialized = s->ridx.ptr.p_int[s->m];
19190 :
19191 : /*
19192 : * Allocate memory and move elements to Vals/Idx.
19193 : * Initially, elements are sorted by rows, and are sorted within row too.
19194 : * No additional post-sorting is required.
19195 : */
19196 0 : ae_vector_set_length(&temp, m, _state);
19197 0 : for(i=0; i<=m-1; i++)
19198 : {
19199 0 : temp.ptr.p_int[i] = 0;
19200 : }
19201 0 : rvectorsetlengthatleast(&s->vals, nonne, _state);
19202 0 : ivectorsetlengthatleast(&s->idx, nonne, _state);
19203 0 : for(i=0; i<=m-1; i++)
19204 : {
19205 :
19206 : /*
19207 : * copy subdiagonal and diagonal parts of I-th block
19208 : */
19209 0 : offs0 = tridx.ptr.p_int[i];
19210 0 : offs1 = s->ridx.ptr.p_int[i]+temp.ptr.p_int[i];
19211 0 : k = s->didx.ptr.p_int[i]+1;
19212 0 : for(j=0; j<=k-1; j++)
19213 : {
19214 0 : s->vals.ptr.p_double[offs1+j] = tvals.ptr.p_double[offs0+j];
19215 0 : s->idx.ptr.p_int[offs1+j] = i-s->didx.ptr.p_int[i]+j;
19216 : }
19217 0 : temp.ptr.p_int[i] = temp.ptr.p_int[i]+s->didx.ptr.p_int[i]+1;
19218 :
19219 : /*
19220 : * Copy superdiagonal part of I-th block
19221 : */
19222 0 : offs0 = tridx.ptr.p_int[i]+s->didx.ptr.p_int[i]+1;
19223 0 : k = s->uidx.ptr.p_int[i];
19224 0 : for(j=0; j<=k-1; j++)
19225 : {
19226 0 : offs1 = s->ridx.ptr.p_int[i-k+j]+temp.ptr.p_int[i-k+j];
19227 0 : s->vals.ptr.p_double[offs1] = tvals.ptr.p_double[offs0+j];
19228 0 : s->idx.ptr.p_int[offs1] = i;
19229 0 : temp.ptr.p_int[i-k+j] = temp.ptr.p_int[i-k+j]+1;
19230 : }
19231 : }
19232 :
19233 : /*
19234 : * Initialization 'S.UIdx' and 'S.DIdx'
19235 : */
19236 0 : sparseinitduidx(s, _state);
19237 0 : ae_frame_leave(_state);
19238 0 : return;
19239 : }
19240 0 : ae_assert(ae_false, "SparseConvertToCRS: invalid matrix type", _state);
19241 0 : ae_frame_leave(_state);
19242 : }
19243 :
19244 :
19245 : /*************************************************************************
19246 : This function performs out-of-place conversion to CRS format. S0 is
19247 : copied to S1 and converted on-the-fly.
19248 :
19249 : INPUT PARAMETERS
19250 : S0 - sparse matrix in any format.
19251 :
19252 : OUTPUT PARAMETERS
19253 : S1 - sparse matrix in CRS format.
19254 :
19255 : NOTE: if S0 is stored as CRS, it is just copied without conversion.
19256 :
19257 : NOTE: this function de-allocates memory occupied by S1 before starting CRS
19258 : conversion. If you perform a lot of repeated CRS conversions, it may
19259 : lead to memory fragmentation. In this case we recommend you to use
19260 : SparseCopyToCRSBuf() function which re-uses memory in S1 as much as
19261 : possible.
19262 :
19263 : -- ALGLIB PROJECT --
19264 : Copyright 20.07.2012 by Bochkanov Sergey
19265 : *************************************************************************/
19266 0 : void sparsecopytocrs(sparsematrix* s0, sparsematrix* s1, ae_state *_state)
19267 : {
19268 :
19269 0 : _sparsematrix_clear(s1);
19270 :
19271 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToCRS: invalid matrix type", _state);
19272 0 : sparsecopytocrsbuf(s0, s1, _state);
19273 0 : }
19274 :
19275 :
19276 : /*************************************************************************
19277 : This function performs out-of-place conversion to CRS format. S0 is
19278 : copied to S1 and converted on-the-fly. Memory allocated in S1 is reused to
19279 : maximum extent possible.
19280 :
19281 : INPUT PARAMETERS
19282 : S0 - sparse matrix in any format.
19283 : S1 - matrix which may contain some pre-allocated memory, or
19284 : can be just uninitialized structure.
19285 :
19286 : OUTPUT PARAMETERS
19287 : S1 - sparse matrix in CRS format.
19288 :
19289 : NOTE: if S0 is stored as CRS, it is just copied without conversion.
19290 :
19291 : -- ALGLIB PROJECT --
19292 : Copyright 20.07.2012 by Bochkanov Sergey
19293 : *************************************************************************/
19294 0 : void sparsecopytocrsbuf(sparsematrix* s0,
19295 : sparsematrix* s1,
19296 : ae_state *_state)
19297 : {
19298 : ae_frame _frame_block;
19299 : ae_vector temp;
19300 : ae_int_t nonne;
19301 : ae_int_t i;
19302 : ae_int_t j;
19303 : ae_int_t k;
19304 : ae_int_t offs0;
19305 : ae_int_t offs1;
19306 : ae_int_t m;
19307 :
19308 0 : ae_frame_make(_state, &_frame_block);
19309 0 : memset(&temp, 0, sizeof(temp));
19310 0 : ae_vector_init(&temp, 0, DT_INT, _state, ae_true);
19311 :
19312 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToCRSBuf: invalid matrix type", _state);
19313 0 : m = s0->m;
19314 0 : if( s0->matrixtype==0 )
19315 : {
19316 :
19317 : /*
19318 : * Convert from hash-table to CRS
19319 : * Done like ConvertToCRS function
19320 : */
19321 0 : s1->matrixtype = 1;
19322 0 : s1->m = s0->m;
19323 0 : s1->n = s0->n;
19324 0 : s1->nfree = s0->nfree;
19325 0 : nonne = 0;
19326 0 : k = s0->tablesize;
19327 0 : ivectorsetlengthatleast(&s1->ridx, s1->m+1, _state);
19328 0 : for(i=0; i<=s1->m; i++)
19329 : {
19330 0 : s1->ridx.ptr.p_int[i] = 0;
19331 : }
19332 0 : ae_vector_set_length(&temp, s1->m, _state);
19333 0 : for(i=0; i<=s1->m-1; i++)
19334 : {
19335 0 : temp.ptr.p_int[i] = 0;
19336 : }
19337 :
19338 : /*
19339 : * Number of elements per row
19340 : */
19341 0 : for(i=0; i<=k-1; i++)
19342 : {
19343 0 : if( s0->idx.ptr.p_int[2*i]>=0 )
19344 : {
19345 0 : s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1] = s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1]+1;
19346 0 : nonne = nonne+1;
19347 : }
19348 : }
19349 :
19350 : /*
19351 : * Fill RIdx (offsets of rows)
19352 : */
19353 0 : for(i=0; i<=s1->m-1; i++)
19354 : {
19355 0 : s1->ridx.ptr.p_int[i+1] = s1->ridx.ptr.p_int[i+1]+s1->ridx.ptr.p_int[i];
19356 : }
19357 :
19358 : /*
19359 : * Allocate memory
19360 : */
19361 0 : rvectorsetlengthatleast(&s1->vals, nonne, _state);
19362 0 : ivectorsetlengthatleast(&s1->idx, nonne, _state);
19363 0 : for(i=0; i<=k-1; i++)
19364 : {
19365 0 : if( s0->idx.ptr.p_int[2*i]>=0 )
19366 : {
19367 0 : s1->vals.ptr.p_double[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->vals.ptr.p_double[i];
19368 0 : s1->idx.ptr.p_int[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->idx.ptr.p_int[2*i+1];
19369 0 : temp.ptr.p_int[s0->idx.ptr.p_int[2*i]] = temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]+1;
19370 : }
19371 : }
19372 :
19373 : /*
19374 : * Set NInitialized
19375 : */
19376 0 : s1->ninitialized = s1->ridx.ptr.p_int[s1->m];
19377 :
19378 : /*
19379 : * Sorting of elements
19380 : */
19381 0 : for(i=0; i<=s1->m-1; i++)
19382 : {
19383 0 : tagsortmiddleir(&s1->idx, &s1->vals, s1->ridx.ptr.p_int[i], s1->ridx.ptr.p_int[i+1]-s1->ridx.ptr.p_int[i], _state);
19384 : }
19385 :
19386 : /*
19387 : * Initialization 'S.UIdx' and 'S.DIdx'
19388 : */
19389 0 : sparseinitduidx(s1, _state);
19390 0 : ae_frame_leave(_state);
19391 0 : return;
19392 : }
19393 0 : if( s0->matrixtype==1 )
19394 : {
19395 :
19396 : /*
19397 : * Already CRS, just copy
19398 : */
19399 0 : sparsecopybuf(s0, s1, _state);
19400 0 : ae_frame_leave(_state);
19401 0 : return;
19402 : }
19403 0 : if( s0->matrixtype==2 )
19404 : {
19405 0 : ae_assert(s0->m==s0->n, "SparseCopyToCRS: non-square SKS matrices are not supported", _state);
19406 :
19407 : /*
19408 : * From SKS to CRS.
19409 : */
19410 0 : s1->m = s0->m;
19411 0 : s1->n = s0->n;
19412 0 : s1->matrixtype = 1;
19413 :
19414 : /*
19415 : * Fill RIdx by number of elements per row:
19416 : * RIdx[I+1] stores number of elements in I-th row.
19417 : *
19418 : * Convert RIdx from row sizes to row offsets.
19419 : * Set NInitialized
19420 : */
19421 0 : ivectorsetlengthatleast(&s1->ridx, m+1, _state);
19422 0 : s1->ridx.ptr.p_int[0] = 0;
19423 0 : for(i=1; i<=m; i++)
19424 : {
19425 0 : s1->ridx.ptr.p_int[i] = 1;
19426 : }
19427 0 : nonne = 0;
19428 0 : for(i=0; i<=m-1; i++)
19429 : {
19430 0 : s1->ridx.ptr.p_int[i+1] = s0->didx.ptr.p_int[i]+s1->ridx.ptr.p_int[i+1];
19431 0 : for(j=i-s0->uidx.ptr.p_int[i]; j<=i-1; j++)
19432 : {
19433 0 : s1->ridx.ptr.p_int[j+1] = s1->ridx.ptr.p_int[j+1]+1;
19434 : }
19435 0 : nonne = nonne+s0->didx.ptr.p_int[i]+1+s0->uidx.ptr.p_int[i];
19436 : }
19437 0 : for(i=0; i<=m-1; i++)
19438 : {
19439 0 : s1->ridx.ptr.p_int[i+1] = s1->ridx.ptr.p_int[i+1]+s1->ridx.ptr.p_int[i];
19440 : }
19441 0 : s1->ninitialized = s1->ridx.ptr.p_int[m];
19442 :
19443 : /*
19444 : * Allocate memory and move elements to Vals/Idx.
19445 : * Initially, elements are sorted by rows, and are sorted within row too.
19446 : * No additional post-sorting is required.
19447 : */
19448 0 : ae_vector_set_length(&temp, m, _state);
19449 0 : for(i=0; i<=m-1; i++)
19450 : {
19451 0 : temp.ptr.p_int[i] = 0;
19452 : }
19453 0 : rvectorsetlengthatleast(&s1->vals, nonne, _state);
19454 0 : ivectorsetlengthatleast(&s1->idx, nonne, _state);
19455 0 : for(i=0; i<=m-1; i++)
19456 : {
19457 :
19458 : /*
19459 : * copy subdiagonal and diagonal parts of I-th block
19460 : */
19461 0 : offs0 = s0->ridx.ptr.p_int[i];
19462 0 : offs1 = s1->ridx.ptr.p_int[i]+temp.ptr.p_int[i];
19463 0 : k = s0->didx.ptr.p_int[i]+1;
19464 0 : for(j=0; j<=k-1; j++)
19465 : {
19466 0 : s1->vals.ptr.p_double[offs1+j] = s0->vals.ptr.p_double[offs0+j];
19467 0 : s1->idx.ptr.p_int[offs1+j] = i-s0->didx.ptr.p_int[i]+j;
19468 : }
19469 0 : temp.ptr.p_int[i] = temp.ptr.p_int[i]+s0->didx.ptr.p_int[i]+1;
19470 :
19471 : /*
19472 : * Copy superdiagonal part of I-th block
19473 : */
19474 0 : offs0 = s0->ridx.ptr.p_int[i]+s0->didx.ptr.p_int[i]+1;
19475 0 : k = s0->uidx.ptr.p_int[i];
19476 0 : for(j=0; j<=k-1; j++)
19477 : {
19478 0 : offs1 = s1->ridx.ptr.p_int[i-k+j]+temp.ptr.p_int[i-k+j];
19479 0 : s1->vals.ptr.p_double[offs1] = s0->vals.ptr.p_double[offs0+j];
19480 0 : s1->idx.ptr.p_int[offs1] = i;
19481 0 : temp.ptr.p_int[i-k+j] = temp.ptr.p_int[i-k+j]+1;
19482 : }
19483 : }
19484 :
19485 : /*
19486 : * Initialization 'S.UIdx' and 'S.DIdx'
19487 : */
19488 0 : sparseinitduidx(s1, _state);
19489 0 : ae_frame_leave(_state);
19490 0 : return;
19491 : }
19492 0 : ae_assert(ae_false, "SparseCopyToCRSBuf: unexpected matrix type", _state);
19493 0 : ae_frame_leave(_state);
19494 : }
19495 :
19496 :
19497 : /*************************************************************************
19498 : This function performs in-place conversion to SKS format.
19499 :
19500 : INPUT PARAMETERS
19501 : S - sparse matrix in any format.
19502 :
19503 : OUTPUT PARAMETERS
19504 : S - sparse matrix in SKS format.
19505 :
19506 : NOTE: this function has no effect when called with matrix which is
19507 : already in SKS mode.
19508 :
19509 : NOTE: in-place conversion involves allocation of temporary arrays. If you
19510 : perform a lot of repeated in- place conversions, it may lead to
19511 : memory fragmentation. Consider using out-of-place SparseCopyToSKSBuf()
19512 : function in this case.
19513 :
19514 : -- ALGLIB PROJECT --
19515 : Copyright 15.01.2014 by Bochkanov Sergey
19516 : *************************************************************************/
19517 0 : void sparseconverttosks(sparsematrix* s, ae_state *_state)
19518 : {
19519 : ae_frame _frame_block;
19520 : ae_vector tridx;
19521 : ae_vector tdidx;
19522 : ae_vector tuidx;
19523 : ae_vector tvals;
19524 : ae_int_t n;
19525 : ae_int_t t0;
19526 : ae_int_t t1;
19527 : ae_int_t i;
19528 : ae_int_t j;
19529 : ae_int_t k;
19530 : double v;
19531 :
19532 0 : ae_frame_make(_state, &_frame_block);
19533 0 : memset(&tridx, 0, sizeof(tridx));
19534 0 : memset(&tdidx, 0, sizeof(tdidx));
19535 0 : memset(&tuidx, 0, sizeof(tuidx));
19536 0 : memset(&tvals, 0, sizeof(tvals));
19537 0 : ae_vector_init(&tridx, 0, DT_INT, _state, ae_true);
19538 0 : ae_vector_init(&tdidx, 0, DT_INT, _state, ae_true);
19539 0 : ae_vector_init(&tuidx, 0, DT_INT, _state, ae_true);
19540 0 : ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true);
19541 :
19542 0 : ae_assert((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2, "SparseConvertToSKS: invalid matrix type", _state);
19543 0 : ae_assert(s->m==s->n, "SparseConvertToSKS: rectangular matrices are not supported", _state);
19544 0 : n = s->n;
19545 0 : if( s->matrixtype==2 )
19546 : {
19547 :
19548 : /*
19549 : * Already in SKS mode
19550 : */
19551 0 : ae_frame_leave(_state);
19552 0 : return;
19553 : }
19554 :
19555 : /*
19556 : * Generate internal copy of SKS matrix
19557 : */
19558 0 : ivectorsetlengthatleast(&tdidx, n+1, _state);
19559 0 : ivectorsetlengthatleast(&tuidx, n+1, _state);
19560 0 : for(i=0; i<=n; i++)
19561 : {
19562 0 : tdidx.ptr.p_int[i] = 0;
19563 0 : tuidx.ptr.p_int[i] = 0;
19564 : }
19565 0 : t0 = 0;
19566 0 : t1 = 0;
19567 0 : while(sparseenumerate(s, &t0, &t1, &i, &j, &v, _state))
19568 : {
19569 0 : if( j<i )
19570 : {
19571 0 : tdidx.ptr.p_int[i] = ae_maxint(tdidx.ptr.p_int[i], i-j, _state);
19572 : }
19573 : else
19574 : {
19575 0 : tuidx.ptr.p_int[j] = ae_maxint(tuidx.ptr.p_int[j], j-i, _state);
19576 : }
19577 : }
19578 0 : ivectorsetlengthatleast(&tridx, n+1, _state);
19579 0 : tridx.ptr.p_int[0] = 0;
19580 0 : for(i=1; i<=n; i++)
19581 : {
19582 0 : tridx.ptr.p_int[i] = tridx.ptr.p_int[i-1]+tdidx.ptr.p_int[i-1]+1+tuidx.ptr.p_int[i-1];
19583 : }
19584 0 : rvectorsetlengthatleast(&tvals, tridx.ptr.p_int[n], _state);
19585 0 : k = tridx.ptr.p_int[n];
19586 0 : for(i=0; i<=k-1; i++)
19587 : {
19588 0 : tvals.ptr.p_double[i] = 0.0;
19589 : }
19590 0 : t0 = 0;
19591 0 : t1 = 0;
19592 0 : while(sparseenumerate(s, &t0, &t1, &i, &j, &v, _state))
19593 : {
19594 0 : if( j<=i )
19595 : {
19596 0 : tvals.ptr.p_double[tridx.ptr.p_int[i]+tdidx.ptr.p_int[i]-(i-j)] = v;
19597 : }
19598 : else
19599 : {
19600 0 : tvals.ptr.p_double[tridx.ptr.p_int[j+1]-(j-i)] = v;
19601 : }
19602 : }
19603 0 : for(i=0; i<=n-1; i++)
19604 : {
19605 0 : tdidx.ptr.p_int[n] = ae_maxint(tdidx.ptr.p_int[n], tdidx.ptr.p_int[i], _state);
19606 0 : tuidx.ptr.p_int[n] = ae_maxint(tuidx.ptr.p_int[n], tuidx.ptr.p_int[i], _state);
19607 : }
19608 0 : s->matrixtype = 2;
19609 0 : s->ninitialized = 0;
19610 0 : s->nfree = 0;
19611 0 : s->m = n;
19612 0 : s->n = n;
19613 0 : ae_swap_vectors(&s->didx, &tdidx);
19614 0 : ae_swap_vectors(&s->uidx, &tuidx);
19615 0 : ae_swap_vectors(&s->ridx, &tridx);
19616 0 : ae_swap_vectors(&s->vals, &tvals);
19617 0 : ae_frame_leave(_state);
19618 : }
19619 :
19620 :
19621 : /*************************************************************************
19622 : This function performs out-of-place conversion to SKS storage format.
19623 : S0 is copied to S1 and converted on-the-fly.
19624 :
19625 : INPUT PARAMETERS
19626 : S0 - sparse matrix in any format.
19627 :
19628 : OUTPUT PARAMETERS
19629 : S1 - sparse matrix in SKS format.
19630 :
19631 : NOTE: if S0 is stored as SKS, it is just copied without conversion.
19632 :
19633 : NOTE: this function de-allocates memory occupied by S1 before starting
19634 : conversion. If you perform a lot of repeated conversions, it may
19635 : lead to memory fragmentation. In this case we recommend you to use
19636 : SparseCopyToSKSBuf() function which re-uses memory in S1 as much as
19637 : possible.
19638 :
19639 : -- ALGLIB PROJECT --
19640 : Copyright 20.07.2012 by Bochkanov Sergey
19641 : *************************************************************************/
19642 0 : void sparsecopytosks(sparsematrix* s0, sparsematrix* s1, ae_state *_state)
19643 : {
19644 :
19645 0 : _sparsematrix_clear(s1);
19646 :
19647 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToSKS: invalid matrix type", _state);
19648 0 : sparsecopytosksbuf(s0, s1, _state);
19649 0 : }
19650 :
19651 :
19652 : /*************************************************************************
19653 : This function performs out-of-place conversion to SKS format. S0 is
19654 : copied to S1 and converted on-the-fly. Memory allocated in S1 is reused
19655 : to maximum extent possible.
19656 :
19657 : INPUT PARAMETERS
19658 : S0 - sparse matrix in any format.
19659 :
19660 : OUTPUT PARAMETERS
19661 : S1 - sparse matrix in SKS format.
19662 :
19663 : NOTE: if S0 is stored as SKS, it is just copied without conversion.
19664 :
19665 : -- ALGLIB PROJECT --
19666 : Copyright 20.07.2012 by Bochkanov Sergey
19667 : *************************************************************************/
19668 0 : void sparsecopytosksbuf(sparsematrix* s0,
19669 : sparsematrix* s1,
19670 : ae_state *_state)
19671 : {
19672 : double v;
19673 : ae_int_t n;
19674 : ae_int_t t0;
19675 : ae_int_t t1;
19676 : ae_int_t i;
19677 : ae_int_t j;
19678 : ae_int_t k;
19679 :
19680 :
19681 0 : ae_assert((s0->matrixtype==0||s0->matrixtype==1)||s0->matrixtype==2, "SparseCopyToSKSBuf: invalid matrix type", _state);
19682 0 : ae_assert(s0->m==s0->n, "SparseCopyToSKSBuf: rectangular matrices are not supported", _state);
19683 0 : n = s0->n;
19684 0 : if( s0->matrixtype==2 )
19685 : {
19686 :
19687 : /*
19688 : * Already SKS, just copy
19689 : */
19690 0 : sparsecopybuf(s0, s1, _state);
19691 0 : return;
19692 : }
19693 :
19694 : /*
19695 : * Generate copy of matrix in the SKS format
19696 : */
19697 0 : ivectorsetlengthatleast(&s1->didx, n+1, _state);
19698 0 : ivectorsetlengthatleast(&s1->uidx, n+1, _state);
19699 0 : for(i=0; i<=n; i++)
19700 : {
19701 0 : s1->didx.ptr.p_int[i] = 0;
19702 0 : s1->uidx.ptr.p_int[i] = 0;
19703 : }
19704 0 : t0 = 0;
19705 0 : t1 = 0;
19706 0 : while(sparseenumerate(s0, &t0, &t1, &i, &j, &v, _state))
19707 : {
19708 0 : if( j<i )
19709 : {
19710 0 : s1->didx.ptr.p_int[i] = ae_maxint(s1->didx.ptr.p_int[i], i-j, _state);
19711 : }
19712 : else
19713 : {
19714 0 : s1->uidx.ptr.p_int[j] = ae_maxint(s1->uidx.ptr.p_int[j], j-i, _state);
19715 : }
19716 : }
19717 0 : ivectorsetlengthatleast(&s1->ridx, n+1, _state);
19718 0 : s1->ridx.ptr.p_int[0] = 0;
19719 0 : for(i=1; i<=n; i++)
19720 : {
19721 0 : s1->ridx.ptr.p_int[i] = s1->ridx.ptr.p_int[i-1]+s1->didx.ptr.p_int[i-1]+1+s1->uidx.ptr.p_int[i-1];
19722 : }
19723 0 : rvectorsetlengthatleast(&s1->vals, s1->ridx.ptr.p_int[n], _state);
19724 0 : k = s1->ridx.ptr.p_int[n];
19725 0 : for(i=0; i<=k-1; i++)
19726 : {
19727 0 : s1->vals.ptr.p_double[i] = 0.0;
19728 : }
19729 0 : t0 = 0;
19730 0 : t1 = 0;
19731 0 : while(sparseenumerate(s0, &t0, &t1, &i, &j, &v, _state))
19732 : {
19733 0 : if( j<=i )
19734 : {
19735 0 : s1->vals.ptr.p_double[s1->ridx.ptr.p_int[i]+s1->didx.ptr.p_int[i]-(i-j)] = v;
19736 : }
19737 : else
19738 : {
19739 0 : s1->vals.ptr.p_double[s1->ridx.ptr.p_int[j+1]-(j-i)] = v;
19740 : }
19741 : }
19742 0 : for(i=0; i<=n-1; i++)
19743 : {
19744 0 : s1->didx.ptr.p_int[n] = ae_maxint(s1->didx.ptr.p_int[n], s1->didx.ptr.p_int[i], _state);
19745 0 : s1->uidx.ptr.p_int[n] = ae_maxint(s1->uidx.ptr.p_int[n], s1->uidx.ptr.p_int[i], _state);
19746 : }
19747 0 : s1->matrixtype = 2;
19748 0 : s1->ninitialized = 0;
19749 0 : s1->nfree = 0;
19750 0 : s1->m = n;
19751 0 : s1->n = n;
19752 : }
19753 :
19754 :
19755 : /*************************************************************************
19756 : This non-accessible to user function performs in-place creation of CRS
19757 : matrix. It is expected that:
19758 : * S.M and S.N are initialized
19759 : * S.RIdx, S.Idx and S.Vals are loaded with values in CRS format used by
19760 : ALGLIB, with elements of S.Idx/S.Vals possibly being unsorted within
19761 : each row (this constructor function may post-sort matrix, assuming that
19762 : it is sorted by rows).
19763 :
19764 : Only 5 fields should be set by caller. Other fields will be rewritten by
19765 : this constructor function.
19766 :
19767 : This function performs integrity check on user-specified values, with the
19768 : only exception being Vals[] array:
19769 : * it does not require values to be non-zero
19770 : * it does not checks for element of Vals[] being finite IEEE-754 values
19771 :
19772 : INPUT PARAMETERS
19773 : S - sparse matrix with corresponding fields set by caller
19774 :
19775 : OUTPUT PARAMETERS
19776 : S - sparse matrix in CRS format.
19777 :
19778 : -- ALGLIB PROJECT --
19779 : Copyright 20.08.2016 by Bochkanov Sergey
19780 : *************************************************************************/
19781 0 : void sparsecreatecrsinplace(sparsematrix* s, ae_state *_state)
19782 : {
19783 : ae_int_t m;
19784 : ae_int_t n;
19785 : ae_int_t i;
19786 : ae_int_t j;
19787 : ae_int_t j0;
19788 : ae_int_t j1;
19789 :
19790 :
19791 0 : m = s->m;
19792 0 : n = s->n;
19793 :
19794 : /*
19795 : * Quick exit for M=0 or N=0
19796 : */
19797 0 : ae_assert(s->m>=0, "SparseCreateCRSInplace: integrity check failed", _state);
19798 0 : ae_assert(s->n>=0, "SparseCreateCRSInplace: integrity check failed", _state);
19799 0 : if( m==0||n==0 )
19800 : {
19801 0 : s->matrixtype = 1;
19802 0 : s->ninitialized = 0;
19803 0 : ivectorsetlengthatleast(&s->ridx, s->m+1, _state);
19804 0 : ivectorsetlengthatleast(&s->didx, s->m, _state);
19805 0 : ivectorsetlengthatleast(&s->uidx, s->m, _state);
19806 0 : for(i=0; i<=s->m-1; i++)
19807 : {
19808 0 : s->ridx.ptr.p_int[i] = 0;
19809 0 : s->uidx.ptr.p_int[i] = 0;
19810 0 : s->didx.ptr.p_int[i] = 0;
19811 : }
19812 0 : s->ridx.ptr.p_int[s->m] = 0;
19813 0 : return;
19814 : }
19815 :
19816 : /*
19817 : * Perform integrity check
19818 : */
19819 0 : ae_assert(s->m>0, "SparseCreateCRSInplace: integrity check failed", _state);
19820 0 : ae_assert(s->n>0, "SparseCreateCRSInplace: integrity check failed", _state);
19821 0 : ae_assert(s->ridx.cnt>=m+1, "SparseCreateCRSInplace: integrity check failed", _state);
19822 0 : for(i=0; i<=m-1; i++)
19823 : {
19824 0 : ae_assert(s->ridx.ptr.p_int[i]>=0&&s->ridx.ptr.p_int[i]<=s->ridx.ptr.p_int[i+1], "SparseCreateCRSInplace: integrity check failed", _state);
19825 : }
19826 0 : ae_assert(s->ridx.ptr.p_int[m]<=s->idx.cnt, "SparseCreateCRSInplace: integrity check failed", _state);
19827 0 : ae_assert(s->ridx.ptr.p_int[m]<=s->vals.cnt, "SparseCreateCRSInplace: integrity check failed", _state);
19828 0 : for(i=0; i<=m-1; i++)
19829 : {
19830 0 : j0 = s->ridx.ptr.p_int[i];
19831 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
19832 0 : for(j=j0; j<=j1; j++)
19833 : {
19834 0 : ae_assert(s->idx.ptr.p_int[j]>=0&&s->idx.ptr.p_int[j]<n, "SparseCreateCRSInplace: integrity check failed", _state);
19835 : }
19836 : }
19837 :
19838 : /*
19839 : * Initialize
19840 : */
19841 0 : s->matrixtype = 1;
19842 0 : s->ninitialized = s->ridx.ptr.p_int[m];
19843 0 : for(i=0; i<=m-1; i++)
19844 : {
19845 0 : tagsortmiddleir(&s->idx, &s->vals, s->ridx.ptr.p_int[i], s->ridx.ptr.p_int[i+1]-s->ridx.ptr.p_int[i], _state);
19846 : }
19847 0 : sparseinitduidx(s, _state);
19848 : }
19849 :
19850 :
19851 : /*************************************************************************
19852 : This function returns type of the matrix storage format.
19853 :
19854 : INPUT PARAMETERS:
19855 : S - sparse matrix.
19856 :
19857 : RESULT:
19858 : sparse storage format used by matrix:
19859 : 0 - Hash-table
19860 : 1 - CRS (compressed row storage)
19861 : 2 - SKS (skyline)
19862 :
19863 : NOTE: future versions of ALGLIB may include additional sparse storage
19864 : formats.
19865 :
19866 :
19867 : -- ALGLIB PROJECT --
19868 : Copyright 20.07.2012 by Bochkanov Sergey
19869 : *************************************************************************/
19870 0 : ae_int_t sparsegetmatrixtype(sparsematrix* s, ae_state *_state)
19871 : {
19872 : ae_int_t result;
19873 :
19874 :
19875 0 : ae_assert((((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2)||s->matrixtype==-10081)||s->matrixtype==-10082, "SparseGetMatrixType: invalid matrix type", _state);
19876 0 : result = s->matrixtype;
19877 0 : return result;
19878 : }
19879 :
19880 :
19881 : /*************************************************************************
19882 : This function checks matrix storage format and returns True when matrix is
19883 : stored using Hash table representation.
19884 :
19885 : INPUT PARAMETERS:
19886 : S - sparse matrix.
19887 :
19888 : RESULT:
19889 : True if matrix type is Hash table
19890 : False if matrix type is not Hash table
19891 :
19892 : -- ALGLIB PROJECT --
19893 : Copyright 20.07.2012 by Bochkanov Sergey
19894 : *************************************************************************/
19895 0 : ae_bool sparseishash(sparsematrix* s, ae_state *_state)
19896 : {
19897 : ae_bool result;
19898 :
19899 :
19900 0 : ae_assert((((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2)||s->matrixtype==-10081)||s->matrixtype==-10082, "SparseIsHash: invalid matrix type", _state);
19901 0 : result = s->matrixtype==0;
19902 0 : return result;
19903 : }
19904 :
19905 :
19906 : /*************************************************************************
19907 : This function checks matrix storage format and returns True when matrix is
19908 : stored using CRS representation.
19909 :
19910 : INPUT PARAMETERS:
19911 : S - sparse matrix.
19912 :
19913 : RESULT:
19914 : True if matrix type is CRS
19915 : False if matrix type is not CRS
19916 :
19917 : -- ALGLIB PROJECT --
19918 : Copyright 20.07.2012 by Bochkanov Sergey
19919 : *************************************************************************/
19920 0 : ae_bool sparseiscrs(sparsematrix* s, ae_state *_state)
19921 : {
19922 : ae_bool result;
19923 :
19924 :
19925 0 : ae_assert((((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2)||s->matrixtype==-10081)||s->matrixtype==-10082, "SparseIsCRS: invalid matrix type", _state);
19926 0 : result = s->matrixtype==1;
19927 0 : return result;
19928 : }
19929 :
19930 :
19931 : /*************************************************************************
19932 : This function checks matrix storage format and returns True when matrix is
19933 : stored using SKS representation.
19934 :
19935 : INPUT PARAMETERS:
19936 : S - sparse matrix.
19937 :
19938 : RESULT:
19939 : True if matrix type is SKS
19940 : False if matrix type is not SKS
19941 :
19942 : -- ALGLIB PROJECT --
19943 : Copyright 20.07.2012 by Bochkanov Sergey
19944 : *************************************************************************/
19945 0 : ae_bool sparseissks(sparsematrix* s, ae_state *_state)
19946 : {
19947 : ae_bool result;
19948 :
19949 :
19950 0 : ae_assert((((s->matrixtype==0||s->matrixtype==1)||s->matrixtype==2)||s->matrixtype==-10081)||s->matrixtype==-10082, "SparseIsSKS: invalid matrix type", _state);
19951 0 : result = s->matrixtype==2;
19952 0 : return result;
19953 : }
19954 :
19955 :
19956 : /*************************************************************************
19957 : The function frees all memory occupied by sparse matrix. Sparse matrix
19958 : structure becomes unusable after this call.
19959 :
19960 : OUTPUT PARAMETERS
19961 : S - sparse matrix to delete
19962 :
19963 : -- ALGLIB PROJECT --
19964 : Copyright 24.07.2012 by Bochkanov Sergey
19965 : *************************************************************************/
19966 0 : void sparsefree(sparsematrix* s, ae_state *_state)
19967 : {
19968 :
19969 0 : _sparsematrix_clear(s);
19970 :
19971 0 : s->matrixtype = -1;
19972 0 : s->m = 0;
19973 0 : s->n = 0;
19974 0 : s->nfree = 0;
19975 0 : s->ninitialized = 0;
19976 0 : s->tablesize = 0;
19977 0 : }
19978 :
19979 :
19980 : /*************************************************************************
19981 : The function returns number of rows of a sparse matrix.
19982 :
19983 : RESULT: number of rows of a sparse matrix.
19984 :
19985 : -- ALGLIB PROJECT --
19986 : Copyright 23.08.2012 by Bochkanov Sergey
19987 : *************************************************************************/
19988 0 : ae_int_t sparsegetnrows(sparsematrix* s, ae_state *_state)
19989 : {
19990 : ae_int_t result;
19991 :
19992 :
19993 0 : result = s->m;
19994 0 : return result;
19995 : }
19996 :
19997 :
19998 : /*************************************************************************
19999 : The function returns number of columns of a sparse matrix.
20000 :
20001 : RESULT: number of columns of a sparse matrix.
20002 :
20003 : -- ALGLIB PROJECT --
20004 : Copyright 23.08.2012 by Bochkanov Sergey
20005 : *************************************************************************/
20006 0 : ae_int_t sparsegetncols(sparsematrix* s, ae_state *_state)
20007 : {
20008 : ae_int_t result;
20009 :
20010 :
20011 0 : result = s->n;
20012 0 : return result;
20013 : }
20014 :
20015 :
20016 : /*************************************************************************
20017 : The function returns number of strictly upper triangular non-zero elements
20018 : in the matrix. It counts SYMBOLICALLY non-zero elements, i.e. entries
20019 : in the sparse matrix data structure. If some element has zero numerical
20020 : value, it is still counted.
20021 :
20022 : This function has different cost for different types of matrices:
20023 : * for hash-based matrices it involves complete pass over entire hash-table
20024 : with O(NNZ) cost, where NNZ is number of non-zero elements
20025 : * for CRS and SKS matrix types cost of counting is O(N) (N - matrix size).
20026 :
20027 : RESULT: number of non-zero elements strictly above main diagonal
20028 :
20029 : -- ALGLIB PROJECT --
20030 : Copyright 12.02.2014 by Bochkanov Sergey
20031 : *************************************************************************/
20032 0 : ae_int_t sparsegetuppercount(sparsematrix* s, ae_state *_state)
20033 : {
20034 : ae_int_t sz;
20035 : ae_int_t i0;
20036 : ae_int_t i;
20037 : ae_int_t result;
20038 :
20039 :
20040 0 : result = -1;
20041 0 : if( s->matrixtype==0 )
20042 : {
20043 :
20044 : /*
20045 : * Hash-table matrix
20046 : */
20047 0 : result = 0;
20048 0 : sz = s->tablesize;
20049 0 : for(i0=0; i0<=sz-1; i0++)
20050 : {
20051 0 : i = s->idx.ptr.p_int[2*i0];
20052 0 : if( i>=0&&s->idx.ptr.p_int[2*i0+1]>i )
20053 : {
20054 0 : result = result+1;
20055 : }
20056 : }
20057 0 : return result;
20058 : }
20059 0 : if( s->matrixtype==1 )
20060 : {
20061 :
20062 : /*
20063 : * CRS matrix
20064 : */
20065 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGetUpperCount: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
20066 0 : result = 0;
20067 0 : sz = s->m;
20068 0 : for(i=0; i<=sz-1; i++)
20069 : {
20070 0 : result = result+(s->ridx.ptr.p_int[i+1]-s->uidx.ptr.p_int[i]);
20071 : }
20072 0 : return result;
20073 : }
20074 0 : if( s->matrixtype==2 )
20075 : {
20076 :
20077 : /*
20078 : * SKS matrix
20079 : */
20080 0 : ae_assert(s->m==s->n, "SparseGetUpperCount: non-square SKS matrices are not supported", _state);
20081 0 : result = 0;
20082 0 : sz = s->m;
20083 0 : for(i=0; i<=sz-1; i++)
20084 : {
20085 0 : result = result+s->uidx.ptr.p_int[i];
20086 : }
20087 0 : return result;
20088 : }
20089 0 : ae_assert(ae_false, "SparseGetUpperCount: internal error", _state);
20090 0 : return result;
20091 : }
20092 :
20093 :
20094 : /*************************************************************************
20095 : The function returns number of strictly lower triangular non-zero elements
20096 : in the matrix. It counts SYMBOLICALLY non-zero elements, i.e. entries
20097 : in the sparse matrix data structure. If some element has zero numerical
20098 : value, it is still counted.
20099 :
20100 : This function has different cost for different types of matrices:
20101 : * for hash-based matrices it involves complete pass over entire hash-table
20102 : with O(NNZ) cost, where NNZ is number of non-zero elements
20103 : * for CRS and SKS matrix types cost of counting is O(N) (N - matrix size).
20104 :
20105 : RESULT: number of non-zero elements strictly below main diagonal
20106 :
20107 : -- ALGLIB PROJECT --
20108 : Copyright 12.02.2014 by Bochkanov Sergey
20109 : *************************************************************************/
20110 0 : ae_int_t sparsegetlowercount(sparsematrix* s, ae_state *_state)
20111 : {
20112 : ae_int_t sz;
20113 : ae_int_t i0;
20114 : ae_int_t i;
20115 : ae_int_t result;
20116 :
20117 :
20118 0 : result = -1;
20119 0 : if( s->matrixtype==0 )
20120 : {
20121 :
20122 : /*
20123 : * Hash-table matrix
20124 : */
20125 0 : result = 0;
20126 0 : sz = s->tablesize;
20127 0 : for(i0=0; i0<=sz-1; i0++)
20128 : {
20129 0 : i = s->idx.ptr.p_int[2*i0];
20130 0 : if( i>=0&&s->idx.ptr.p_int[2*i0+1]<i )
20131 : {
20132 0 : result = result+1;
20133 : }
20134 : }
20135 0 : return result;
20136 : }
20137 0 : if( s->matrixtype==1 )
20138 : {
20139 :
20140 : /*
20141 : * CRS matrix
20142 : */
20143 0 : ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGetUpperCount: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state);
20144 0 : result = 0;
20145 0 : sz = s->m;
20146 0 : for(i=0; i<=sz-1; i++)
20147 : {
20148 0 : result = result+(s->didx.ptr.p_int[i]-s->ridx.ptr.p_int[i]);
20149 : }
20150 0 : return result;
20151 : }
20152 0 : if( s->matrixtype==2 )
20153 : {
20154 :
20155 : /*
20156 : * SKS matrix
20157 : */
20158 0 : ae_assert(s->m==s->n, "SparseGetUpperCount: non-square SKS matrices are not supported", _state);
20159 0 : result = 0;
20160 0 : sz = s->m;
20161 0 : for(i=0; i<=sz-1; i++)
20162 : {
20163 0 : result = result+s->didx.ptr.p_int[i];
20164 : }
20165 0 : return result;
20166 : }
20167 0 : ae_assert(ae_false, "SparseGetUpperCount: internal error", _state);
20168 0 : return result;
20169 : }
20170 :
20171 :
20172 : /*************************************************************************
20173 : This is hash function.
20174 :
20175 : -- ALGLIB PROJECT --
20176 : Copyright 14.10.2011 by Bochkanov Sergey
20177 : *************************************************************************/
20178 0 : static ae_int_t sparse_hash(ae_int_t i,
20179 : ae_int_t j,
20180 : ae_int_t tabsize,
20181 : ae_state *_state)
20182 : {
20183 : ae_frame _frame_block;
20184 : hqrndstate r;
20185 : ae_int_t result;
20186 :
20187 0 : ae_frame_make(_state, &_frame_block);
20188 0 : memset(&r, 0, sizeof(r));
20189 0 : _hqrndstate_init(&r, _state, ae_true);
20190 :
20191 0 : hqrndseed(i, j, &r, _state);
20192 0 : result = hqrnduniformi(&r, tabsize, _state);
20193 0 : ae_frame_leave(_state);
20194 0 : return result;
20195 : }
20196 :
20197 :
20198 0 : void _sparsematrix_init(void* _p, ae_state *_state, ae_bool make_automatic)
20199 : {
20200 0 : sparsematrix *p = (sparsematrix*)_p;
20201 0 : ae_touch_ptr((void*)p);
20202 0 : ae_vector_init(&p->vals, 0, DT_REAL, _state, make_automatic);
20203 0 : ae_vector_init(&p->idx, 0, DT_INT, _state, make_automatic);
20204 0 : ae_vector_init(&p->ridx, 0, DT_INT, _state, make_automatic);
20205 0 : ae_vector_init(&p->didx, 0, DT_INT, _state, make_automatic);
20206 0 : ae_vector_init(&p->uidx, 0, DT_INT, _state, make_automatic);
20207 0 : }
20208 :
20209 :
20210 0 : void _sparsematrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
20211 : {
20212 0 : sparsematrix *dst = (sparsematrix*)_dst;
20213 0 : sparsematrix *src = (sparsematrix*)_src;
20214 0 : ae_vector_init_copy(&dst->vals, &src->vals, _state, make_automatic);
20215 0 : ae_vector_init_copy(&dst->idx, &src->idx, _state, make_automatic);
20216 0 : ae_vector_init_copy(&dst->ridx, &src->ridx, _state, make_automatic);
20217 0 : ae_vector_init_copy(&dst->didx, &src->didx, _state, make_automatic);
20218 0 : ae_vector_init_copy(&dst->uidx, &src->uidx, _state, make_automatic);
20219 0 : dst->matrixtype = src->matrixtype;
20220 0 : dst->m = src->m;
20221 0 : dst->n = src->n;
20222 0 : dst->nfree = src->nfree;
20223 0 : dst->ninitialized = src->ninitialized;
20224 0 : dst->tablesize = src->tablesize;
20225 0 : }
20226 :
20227 :
20228 0 : void _sparsematrix_clear(void* _p)
20229 : {
20230 0 : sparsematrix *p = (sparsematrix*)_p;
20231 0 : ae_touch_ptr((void*)p);
20232 0 : ae_vector_clear(&p->vals);
20233 0 : ae_vector_clear(&p->idx);
20234 0 : ae_vector_clear(&p->ridx);
20235 0 : ae_vector_clear(&p->didx);
20236 0 : ae_vector_clear(&p->uidx);
20237 0 : }
20238 :
20239 :
20240 0 : void _sparsematrix_destroy(void* _p)
20241 : {
20242 0 : sparsematrix *p = (sparsematrix*)_p;
20243 0 : ae_touch_ptr((void*)p);
20244 0 : ae_vector_destroy(&p->vals);
20245 0 : ae_vector_destroy(&p->idx);
20246 0 : ae_vector_destroy(&p->ridx);
20247 0 : ae_vector_destroy(&p->didx);
20248 0 : ae_vector_destroy(&p->uidx);
20249 0 : }
20250 :
20251 :
20252 0 : void _sparsebuffers_init(void* _p, ae_state *_state, ae_bool make_automatic)
20253 : {
20254 0 : sparsebuffers *p = (sparsebuffers*)_p;
20255 0 : ae_touch_ptr((void*)p);
20256 0 : ae_vector_init(&p->d, 0, DT_INT, _state, make_automatic);
20257 0 : ae_vector_init(&p->u, 0, DT_INT, _state, make_automatic);
20258 0 : _sparsematrix_init(&p->s, _state, make_automatic);
20259 0 : }
20260 :
20261 :
20262 0 : void _sparsebuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
20263 : {
20264 0 : sparsebuffers *dst = (sparsebuffers*)_dst;
20265 0 : sparsebuffers *src = (sparsebuffers*)_src;
20266 0 : ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic);
20267 0 : ae_vector_init_copy(&dst->u, &src->u, _state, make_automatic);
20268 0 : _sparsematrix_init_copy(&dst->s, &src->s, _state, make_automatic);
20269 0 : }
20270 :
20271 :
20272 0 : void _sparsebuffers_clear(void* _p)
20273 : {
20274 0 : sparsebuffers *p = (sparsebuffers*)_p;
20275 0 : ae_touch_ptr((void*)p);
20276 0 : ae_vector_clear(&p->d);
20277 0 : ae_vector_clear(&p->u);
20278 0 : _sparsematrix_clear(&p->s);
20279 0 : }
20280 :
20281 :
20282 0 : void _sparsebuffers_destroy(void* _p)
20283 : {
20284 0 : sparsebuffers *p = (sparsebuffers*)_p;
20285 0 : ae_touch_ptr((void*)p);
20286 0 : ae_vector_destroy(&p->d);
20287 0 : ae_vector_destroy(&p->u);
20288 0 : _sparsematrix_destroy(&p->s);
20289 0 : }
20290 :
20291 :
20292 : #endif
20293 : #if defined(AE_COMPILE_ABLAS) || !defined(AE_PARTIAL_BUILD)
20294 :
20295 :
20296 : /*************************************************************************
20297 : Splits matrix length in two parts, left part should match ABLAS block size
20298 :
20299 : INPUT PARAMETERS
20300 : A - real matrix, is passed to ensure that we didn't split
20301 : complex matrix using real splitting subroutine.
20302 : matrix itself is not changed.
20303 : N - length, N>0
20304 :
20305 : OUTPUT PARAMETERS
20306 : N1 - length
20307 : N2 - length
20308 :
20309 : N1+N2=N, N1>=N2, N2 may be zero
20310 :
20311 : -- ALGLIB routine --
20312 : 15.12.2009
20313 : Bochkanov Sergey
20314 : *************************************************************************/
20315 0 : void ablassplitlength(/* Real */ ae_matrix* a,
20316 : ae_int_t n,
20317 : ae_int_t* n1,
20318 : ae_int_t* n2,
20319 : ae_state *_state)
20320 : {
20321 :
20322 0 : *n1 = 0;
20323 0 : *n2 = 0;
20324 :
20325 0 : if( n>ablasblocksize(a, _state) )
20326 : {
20327 0 : ablas_ablasinternalsplitlength(n, ablasblocksize(a, _state), n1, n2, _state);
20328 : }
20329 : else
20330 : {
20331 0 : ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state);
20332 : }
20333 0 : }
20334 :
20335 :
20336 : /*************************************************************************
20337 : Complex ABLASSplitLength
20338 :
20339 : -- ALGLIB routine --
20340 : 15.12.2009
20341 : Bochkanov Sergey
20342 : *************************************************************************/
20343 0 : void ablascomplexsplitlength(/* Complex */ ae_matrix* a,
20344 : ae_int_t n,
20345 : ae_int_t* n1,
20346 : ae_int_t* n2,
20347 : ae_state *_state)
20348 : {
20349 :
20350 0 : *n1 = 0;
20351 0 : *n2 = 0;
20352 :
20353 0 : if( n>ablascomplexblocksize(a, _state) )
20354 : {
20355 0 : ablas_ablasinternalsplitlength(n, ablascomplexblocksize(a, _state), n1, n2, _state);
20356 : }
20357 : else
20358 : {
20359 0 : ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state);
20360 : }
20361 0 : }
20362 :
20363 :
20364 : /*************************************************************************
20365 : Returns switch point for parallelism.
20366 :
20367 : -- ALGLIB routine --
20368 : 15.12.2009
20369 : Bochkanov Sergey
20370 : *************************************************************************/
20371 0 : ae_int_t gemmparallelsize(ae_state *_state)
20372 : {
20373 : ae_int_t result;
20374 :
20375 :
20376 0 : result = 64;
20377 0 : return result;
20378 : }
20379 :
20380 :
20381 : /*************************************************************************
20382 : Returns block size - subdivision size where cache-oblivious soubroutines
20383 : switch to the optimized kernel.
20384 :
20385 : INPUT PARAMETERS
20386 : A - real matrix, is passed to ensure that we didn't split
20387 : complex matrix using real splitting subroutine.
20388 : matrix itself is not changed.
20389 :
20390 : -- ALGLIB routine --
20391 : 15.12.2009
20392 : Bochkanov Sergey
20393 : *************************************************************************/
20394 0 : ae_int_t ablasblocksize(/* Real */ ae_matrix* a, ae_state *_state)
20395 : {
20396 : ae_int_t result;
20397 :
20398 :
20399 0 : result = 32;
20400 0 : return result;
20401 : }
20402 :
20403 :
20404 : /*************************************************************************
20405 : Block size for complex subroutines.
20406 :
20407 : -- ALGLIB routine --
20408 : 15.12.2009
20409 : Bochkanov Sergey
20410 : *************************************************************************/
20411 0 : ae_int_t ablascomplexblocksize(/* Complex */ ae_matrix* a,
20412 : ae_state *_state)
20413 : {
20414 : ae_int_t result;
20415 :
20416 :
20417 0 : result = 24;
20418 0 : return result;
20419 : }
20420 :
20421 :
20422 : /*************************************************************************
20423 : Microblock size
20424 :
20425 : -- ALGLIB routine --
20426 : 15.12.2009
20427 : Bochkanov Sergey
20428 : *************************************************************************/
20429 0 : ae_int_t ablasmicroblocksize(ae_state *_state)
20430 : {
20431 : ae_int_t result;
20432 :
20433 :
20434 0 : result = 8;
20435 0 : return result;
20436 : }
20437 :
20438 :
20439 : /*************************************************************************
20440 : Generation of an elementary reflection transformation
20441 :
20442 : The subroutine generates elementary reflection H of order N, so that, for
20443 : a given X, the following equality holds true:
20444 :
20445 : ( X(1) ) ( Beta )
20446 : H * ( .. ) = ( 0 )
20447 : ( X(n) ) ( 0 )
20448 :
20449 : where
20450 : ( V(1) )
20451 : H = 1 - Tau * ( .. ) * ( V(1), ..., V(n) )
20452 : ( V(n) )
20453 :
20454 : where the first component of vector V equals 1.
20455 :
20456 : Input parameters:
20457 : X - vector. Array whose index ranges within [1..N].
20458 : N - reflection order.
20459 :
20460 : Output parameters:
20461 : X - components from 2 to N are replaced with vector V.
20462 : The first component is replaced with parameter Beta.
20463 : Tau - scalar value Tau. If X is a null vector, Tau equals 0,
20464 : otherwise 1 <= Tau <= 2.
20465 :
20466 : This subroutine is the modification of the DLARFG subroutines from
20467 : the LAPACK library.
20468 :
20469 : MODIFICATIONS:
20470 : 24.12.2005 sign(Alpha) was replaced with an analogous to the Fortran SIGN code.
20471 :
20472 : -- LAPACK auxiliary routine (version 3.0) --
20473 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
20474 : Courant Institute, Argonne National Lab, and Rice University
20475 : September 30, 1994
20476 : *************************************************************************/
20477 0 : void generatereflection(/* Real */ ae_vector* x,
20478 : ae_int_t n,
20479 : double* tau,
20480 : ae_state *_state)
20481 : {
20482 : ae_int_t j;
20483 : double alpha;
20484 : double xnorm;
20485 : double v;
20486 : double beta;
20487 : double mx;
20488 : double s;
20489 :
20490 0 : *tau = 0;
20491 :
20492 0 : if( n<=1 )
20493 : {
20494 0 : *tau = (double)(0);
20495 0 : return;
20496 : }
20497 :
20498 : /*
20499 : * Scale if needed (to avoid overflow/underflow during intermediate
20500 : * calculations).
20501 : */
20502 0 : mx = (double)(0);
20503 0 : for(j=1; j<=n; j++)
20504 : {
20505 0 : mx = ae_maxreal(ae_fabs(x->ptr.p_double[j], _state), mx, _state);
20506 : }
20507 0 : s = (double)(1);
20508 0 : if( ae_fp_neq(mx,(double)(0)) )
20509 : {
20510 0 : if( ae_fp_less_eq(mx,ae_minrealnumber/ae_machineepsilon) )
20511 : {
20512 0 : s = ae_minrealnumber/ae_machineepsilon;
20513 0 : v = 1/s;
20514 0 : ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v);
20515 0 : mx = mx*v;
20516 : }
20517 : else
20518 : {
20519 0 : if( ae_fp_greater_eq(mx,ae_maxrealnumber*ae_machineepsilon) )
20520 : {
20521 0 : s = ae_maxrealnumber*ae_machineepsilon;
20522 0 : v = 1/s;
20523 0 : ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v);
20524 0 : mx = mx*v;
20525 : }
20526 : }
20527 : }
20528 :
20529 : /*
20530 : * XNORM = DNRM2( N-1, X, INCX )
20531 : */
20532 0 : alpha = x->ptr.p_double[1];
20533 0 : xnorm = (double)(0);
20534 0 : if( ae_fp_neq(mx,(double)(0)) )
20535 : {
20536 0 : for(j=2; j<=n; j++)
20537 : {
20538 0 : xnorm = xnorm+ae_sqr(x->ptr.p_double[j]/mx, _state);
20539 : }
20540 0 : xnorm = ae_sqrt(xnorm, _state)*mx;
20541 : }
20542 0 : if( ae_fp_eq(xnorm,(double)(0)) )
20543 : {
20544 :
20545 : /*
20546 : * H = I
20547 : */
20548 0 : *tau = (double)(0);
20549 0 : x->ptr.p_double[1] = x->ptr.p_double[1]*s;
20550 0 : return;
20551 : }
20552 :
20553 : /*
20554 : * general case
20555 : */
20556 0 : mx = ae_maxreal(ae_fabs(alpha, _state), ae_fabs(xnorm, _state), _state);
20557 0 : beta = -mx*ae_sqrt(ae_sqr(alpha/mx, _state)+ae_sqr(xnorm/mx, _state), _state);
20558 0 : if( ae_fp_less(alpha,(double)(0)) )
20559 : {
20560 0 : beta = -beta;
20561 : }
20562 0 : *tau = (beta-alpha)/beta;
20563 0 : v = 1/(alpha-beta);
20564 0 : ae_v_muld(&x->ptr.p_double[2], 1, ae_v_len(2,n), v);
20565 0 : x->ptr.p_double[1] = beta;
20566 :
20567 : /*
20568 : * Scale back outputs
20569 : */
20570 0 : x->ptr.p_double[1] = x->ptr.p_double[1]*s;
20571 : }
20572 :
20573 :
20574 : /*************************************************************************
20575 : Application of an elementary reflection to a rectangular matrix of size MxN
20576 :
20577 : The algorithm pre-multiplies the matrix by an elementary reflection transformation
20578 : which is given by column V and scalar Tau (see the description of the
20579 : GenerateReflection procedure). Not the whole matrix but only a part of it
20580 : is transformed (rows from M1 to M2, columns from N1 to N2). Only the elements
20581 : of this submatrix are changed.
20582 :
20583 : Input parameters:
20584 : C - matrix to be transformed.
20585 : Tau - scalar defining the transformation.
20586 : V - column defining the transformation.
20587 : Array whose index ranges within [1..M2-M1+1].
20588 : M1, M2 - range of rows to be transformed.
20589 : N1, N2 - range of columns to be transformed.
20590 : WORK - working array whose indexes goes from N1 to N2.
20591 :
20592 : Output parameters:
20593 : C - the result of multiplying the input matrix C by the
20594 : transformation matrix which is given by Tau and V.
20595 : If N1>N2 or M1>M2, C is not modified.
20596 :
20597 : -- LAPACK auxiliary routine (version 3.0) --
20598 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
20599 : Courant Institute, Argonne National Lab, and Rice University
20600 : September 30, 1994
20601 : *************************************************************************/
20602 0 : void applyreflectionfromtheleft(/* Real */ ae_matrix* c,
20603 : double tau,
20604 : /* Real */ ae_vector* v,
20605 : ae_int_t m1,
20606 : ae_int_t m2,
20607 : ae_int_t n1,
20608 : ae_int_t n2,
20609 : /* Real */ ae_vector* work,
20610 : ae_state *_state)
20611 : {
20612 :
20613 :
20614 0 : if( (ae_fp_eq(tau,(double)(0))||n1>n2)||m1>m2 )
20615 : {
20616 0 : return;
20617 : }
20618 0 : rvectorsetlengthatleast(work, n2-n1+1, _state);
20619 0 : rmatrixgemv(n2-n1+1, m2-m1+1, 1.0, c, m1, n1, 1, v, 1, 0.0, work, 0, _state);
20620 0 : rmatrixger(m2-m1+1, n2-n1+1, c, m1, n1, -tau, v, 1, work, 0, _state);
20621 : }
20622 :
20623 :
20624 : /*************************************************************************
20625 : Application of an elementary reflection to a rectangular matrix of size MxN
20626 :
20627 : The algorithm post-multiplies the matrix by an elementary reflection transformation
20628 : which is given by column V and scalar Tau (see the description of the
20629 : GenerateReflection procedure). Not the whole matrix but only a part of it
20630 : is transformed (rows from M1 to M2, columns from N1 to N2). Only the
20631 : elements of this submatrix are changed.
20632 :
20633 : Input parameters:
20634 : C - matrix to be transformed.
20635 : Tau - scalar defining the transformation.
20636 : V - column defining the transformation.
20637 : Array whose index ranges within [1..N2-N1+1].
20638 : M1, M2 - range of rows to be transformed.
20639 : N1, N2 - range of columns to be transformed.
20640 : WORK - working array whose indexes goes from M1 to M2.
20641 :
20642 : Output parameters:
20643 : C - the result of multiplying the input matrix C by the
20644 : transformation matrix which is given by Tau and V.
20645 : If N1>N2 or M1>M2, C is not modified.
20646 :
20647 : -- LAPACK auxiliary routine (version 3.0) --
20648 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
20649 : Courant Institute, Argonne National Lab, and Rice University
20650 : September 30, 1994
20651 : *************************************************************************/
20652 0 : void applyreflectionfromtheright(/* Real */ ae_matrix* c,
20653 : double tau,
20654 : /* Real */ ae_vector* v,
20655 : ae_int_t m1,
20656 : ae_int_t m2,
20657 : ae_int_t n1,
20658 : ae_int_t n2,
20659 : /* Real */ ae_vector* work,
20660 : ae_state *_state)
20661 : {
20662 :
20663 :
20664 0 : if( (ae_fp_eq(tau,(double)(0))||n1>n2)||m1>m2 )
20665 : {
20666 0 : return;
20667 : }
20668 0 : rvectorsetlengthatleast(work, m2-m1+1, _state);
20669 0 : rmatrixgemv(m2-m1+1, n2-n1+1, 1.0, c, m1, n1, 0, v, 1, 0.0, work, 0, _state);
20670 0 : rmatrixger(m2-m1+1, n2-n1+1, c, m1, n1, -tau, work, 0, v, 1, _state);
20671 : }
20672 :
20673 :
20674 : /*************************************************************************
20675 : Cache-oblivous complex "copy-and-transpose"
20676 :
20677 : Input parameters:
20678 : M - number of rows
20679 : N - number of columns
20680 : A - source matrix, MxN submatrix is copied and transposed
20681 : IA - submatrix offset (row index)
20682 : JA - submatrix offset (column index)
20683 : B - destination matrix, must be large enough to store result
20684 : IB - submatrix offset (row index)
20685 : JB - submatrix offset (column index)
20686 : *************************************************************************/
20687 0 : void cmatrixtranspose(ae_int_t m,
20688 : ae_int_t n,
20689 : /* Complex */ ae_matrix* a,
20690 : ae_int_t ia,
20691 : ae_int_t ja,
20692 : /* Complex */ ae_matrix* b,
20693 : ae_int_t ib,
20694 : ae_int_t jb,
20695 : ae_state *_state)
20696 : {
20697 : ae_int_t i;
20698 : ae_int_t s1;
20699 : ae_int_t s2;
20700 :
20701 :
20702 0 : if( m<=2*ablascomplexblocksize(a, _state)&&n<=2*ablascomplexblocksize(a, _state) )
20703 : {
20704 :
20705 : /*
20706 : * base case
20707 : */
20708 0 : for(i=0; i<=m-1; i++)
20709 : {
20710 0 : ae_v_cmove(&b->ptr.pp_complex[ib][jb+i], b->stride, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(ib,ib+n-1));
20711 : }
20712 : }
20713 : else
20714 : {
20715 :
20716 : /*
20717 : * Cache-oblivious recursion
20718 : */
20719 0 : if( m>n )
20720 : {
20721 0 : ablascomplexsplitlength(a, m, &s1, &s2, _state);
20722 0 : cmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state);
20723 0 : cmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state);
20724 : }
20725 : else
20726 : {
20727 0 : ablascomplexsplitlength(a, n, &s1, &s2, _state);
20728 0 : cmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state);
20729 0 : cmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state);
20730 : }
20731 : }
20732 0 : }
20733 :
20734 :
20735 : /*************************************************************************
20736 : Cache-oblivous real "copy-and-transpose"
20737 :
20738 : Input parameters:
20739 : M - number of rows
20740 : N - number of columns
20741 : A - source matrix, MxN submatrix is copied and transposed
20742 : IA - submatrix offset (row index)
20743 : JA - submatrix offset (column index)
20744 : B - destination matrix, must be large enough to store result
20745 : IB - submatrix offset (row index)
20746 : JB - submatrix offset (column index)
20747 : *************************************************************************/
20748 0 : void rmatrixtranspose(ae_int_t m,
20749 : ae_int_t n,
20750 : /* Real */ ae_matrix* a,
20751 : ae_int_t ia,
20752 : ae_int_t ja,
20753 : /* Real */ ae_matrix* b,
20754 : ae_int_t ib,
20755 : ae_int_t jb,
20756 : ae_state *_state)
20757 : {
20758 : ae_int_t i;
20759 : ae_int_t s1;
20760 : ae_int_t s2;
20761 :
20762 :
20763 0 : if( m<=2*ablasblocksize(a, _state)&&n<=2*ablasblocksize(a, _state) )
20764 : {
20765 :
20766 : /*
20767 : * base case
20768 : */
20769 0 : for(i=0; i<=m-1; i++)
20770 : {
20771 0 : ae_v_move(&b->ptr.pp_double[ib][jb+i], b->stride, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(ib,ib+n-1));
20772 : }
20773 : }
20774 : else
20775 : {
20776 :
20777 : /*
20778 : * Cache-oblivious recursion
20779 : */
20780 0 : if( m>n )
20781 : {
20782 0 : ablassplitlength(a, m, &s1, &s2, _state);
20783 0 : rmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state);
20784 0 : rmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state);
20785 : }
20786 : else
20787 : {
20788 0 : ablassplitlength(a, n, &s1, &s2, _state);
20789 0 : rmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state);
20790 0 : rmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state);
20791 : }
20792 : }
20793 0 : }
20794 :
20795 :
20796 : /*************************************************************************
20797 : This code enforces symmetricy of the matrix by copying Upper part to lower
20798 : one (or vice versa).
20799 :
20800 : INPUT PARAMETERS:
20801 : A - matrix
20802 : N - number of rows/columns
20803 : IsUpper - whether we want to copy upper triangle to lower one (True)
20804 : or vice versa (False).
20805 : *************************************************************************/
20806 0 : void rmatrixenforcesymmetricity(/* Real */ ae_matrix* a,
20807 : ae_int_t n,
20808 : ae_bool isupper,
20809 : ae_state *_state)
20810 : {
20811 : ae_int_t i;
20812 : ae_int_t j;
20813 :
20814 :
20815 0 : if( isupper )
20816 : {
20817 0 : for(i=0; i<=n-1; i++)
20818 : {
20819 0 : for(j=i+1; j<=n-1; j++)
20820 : {
20821 0 : a->ptr.pp_double[j][i] = a->ptr.pp_double[i][j];
20822 : }
20823 : }
20824 : }
20825 : else
20826 : {
20827 0 : for(i=0; i<=n-1; i++)
20828 : {
20829 0 : for(j=i+1; j<=n-1; j++)
20830 : {
20831 0 : a->ptr.pp_double[i][j] = a->ptr.pp_double[j][i];
20832 : }
20833 : }
20834 : }
20835 0 : }
20836 :
20837 :
20838 : /*************************************************************************
20839 : Copy
20840 :
20841 : Input parameters:
20842 : M - number of rows
20843 : N - number of columns
20844 : A - source matrix, MxN submatrix is copied and transposed
20845 : IA - submatrix offset (row index)
20846 : JA - submatrix offset (column index)
20847 : B - destination matrix, must be large enough to store result
20848 : IB - submatrix offset (row index)
20849 : JB - submatrix offset (column index)
20850 : *************************************************************************/
20851 0 : void cmatrixcopy(ae_int_t m,
20852 : ae_int_t n,
20853 : /* Complex */ ae_matrix* a,
20854 : ae_int_t ia,
20855 : ae_int_t ja,
20856 : /* Complex */ ae_matrix* b,
20857 : ae_int_t ib,
20858 : ae_int_t jb,
20859 : ae_state *_state)
20860 : {
20861 : ae_int_t i;
20862 :
20863 :
20864 0 : if( m==0||n==0 )
20865 : {
20866 0 : return;
20867 : }
20868 0 : for(i=0; i<=m-1; i++)
20869 : {
20870 0 : ae_v_cmove(&b->ptr.pp_complex[ib+i][jb], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(jb,jb+n-1));
20871 : }
20872 : }
20873 :
20874 :
20875 : /*************************************************************************
20876 : Copy
20877 :
20878 : Input parameters:
20879 : N - subvector size
20880 : A - source vector, N elements are copied
20881 : IA - source offset (first element index)
20882 : B - destination vector, must be large enough to store result
20883 : IB - destination offset (first element index)
20884 : *************************************************************************/
20885 0 : void rvectorcopy(ae_int_t n,
20886 : /* Real */ ae_vector* a,
20887 : ae_int_t ia,
20888 : /* Real */ ae_vector* b,
20889 : ae_int_t ib,
20890 : ae_state *_state)
20891 : {
20892 : ae_int_t i;
20893 :
20894 :
20895 0 : if( n==0 )
20896 : {
20897 0 : return;
20898 : }
20899 0 : for(i=0; i<=n-1; i++)
20900 : {
20901 0 : b->ptr.p_double[ib+i] = a->ptr.p_double[ia+i];
20902 : }
20903 : }
20904 :
20905 :
20906 : /*************************************************************************
20907 : Copy
20908 :
20909 : Input parameters:
20910 : M - number of rows
20911 : N - number of columns
20912 : A - source matrix, MxN submatrix is copied and transposed
20913 : IA - submatrix offset (row index)
20914 : JA - submatrix offset (column index)
20915 : B - destination matrix, must be large enough to store result
20916 : IB - submatrix offset (row index)
20917 : JB - submatrix offset (column index)
20918 : *************************************************************************/
20919 0 : void rmatrixcopy(ae_int_t m,
20920 : ae_int_t n,
20921 : /* Real */ ae_matrix* a,
20922 : ae_int_t ia,
20923 : ae_int_t ja,
20924 : /* Real */ ae_matrix* b,
20925 : ae_int_t ib,
20926 : ae_int_t jb,
20927 : ae_state *_state)
20928 : {
20929 : ae_int_t i;
20930 :
20931 :
20932 0 : if( m==0||n==0 )
20933 : {
20934 0 : return;
20935 : }
20936 0 : for(i=0; i<=m-1; i++)
20937 : {
20938 0 : ae_v_move(&b->ptr.pp_double[ib+i][jb], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(jb,jb+n-1));
20939 : }
20940 : }
20941 :
20942 :
20943 : /*************************************************************************
20944 : Performs generalized copy: B := Beta*B + Alpha*A.
20945 :
20946 : If Beta=0, then previous contents of B is simply ignored. If Alpha=0, then
20947 : A is ignored and not referenced. If both Alpha and Beta are zero, B is
20948 : filled by zeros.
20949 :
20950 : Input parameters:
20951 : M - number of rows
20952 : N - number of columns
20953 : Alpha- coefficient
20954 : A - source matrix, MxN submatrix is copied and transposed
20955 : IA - submatrix offset (row index)
20956 : JA - submatrix offset (column index)
20957 : Beta- coefficient
20958 : B - destination matrix, must be large enough to store result
20959 : IB - submatrix offset (row index)
20960 : JB - submatrix offset (column index)
20961 : *************************************************************************/
20962 0 : void rmatrixgencopy(ae_int_t m,
20963 : ae_int_t n,
20964 : double alpha,
20965 : /* Real */ ae_matrix* a,
20966 : ae_int_t ia,
20967 : ae_int_t ja,
20968 : double beta,
20969 : /* Real */ ae_matrix* b,
20970 : ae_int_t ib,
20971 : ae_int_t jb,
20972 : ae_state *_state)
20973 : {
20974 : ae_int_t i;
20975 : ae_int_t j;
20976 :
20977 :
20978 0 : if( m==0||n==0 )
20979 : {
20980 0 : return;
20981 : }
20982 :
20983 : /*
20984 : * Zero-fill
20985 : */
20986 0 : if( ae_fp_eq(alpha,(double)(0))&&ae_fp_eq(beta,(double)(0)) )
20987 : {
20988 0 : for(i=0; i<=m-1; i++)
20989 : {
20990 0 : for(j=0; j<=n-1; j++)
20991 : {
20992 0 : b->ptr.pp_double[ib+i][jb+j] = (double)(0);
20993 : }
20994 : }
20995 0 : return;
20996 : }
20997 :
20998 : /*
20999 : * Inplace multiply
21000 : */
21001 0 : if( ae_fp_eq(alpha,(double)(0)) )
21002 : {
21003 0 : for(i=0; i<=m-1; i++)
21004 : {
21005 0 : for(j=0; j<=n-1; j++)
21006 : {
21007 0 : b->ptr.pp_double[ib+i][jb+j] = beta*b->ptr.pp_double[ib+i][jb+j];
21008 : }
21009 : }
21010 0 : return;
21011 : }
21012 :
21013 : /*
21014 : * Multiply and copy
21015 : */
21016 0 : if( ae_fp_eq(beta,(double)(0)) )
21017 : {
21018 0 : for(i=0; i<=m-1; i++)
21019 : {
21020 0 : for(j=0; j<=n-1; j++)
21021 : {
21022 0 : b->ptr.pp_double[ib+i][jb+j] = alpha*a->ptr.pp_double[ia+i][ja+j];
21023 : }
21024 : }
21025 0 : return;
21026 : }
21027 :
21028 : /*
21029 : * Generic
21030 : */
21031 0 : for(i=0; i<=m-1; i++)
21032 : {
21033 0 : for(j=0; j<=n-1; j++)
21034 : {
21035 0 : b->ptr.pp_double[ib+i][jb+j] = alpha*a->ptr.pp_double[ia+i][ja+j]+beta*b->ptr.pp_double[ib+i][jb+j];
21036 : }
21037 : }
21038 : }
21039 :
21040 :
21041 : /*************************************************************************
21042 : Rank-1 correction: A := A + alpha*u*v'
21043 :
21044 : NOTE: this function expects A to be large enough to store result. No
21045 : automatic preallocation happens for smaller arrays. No integrity
21046 : checks is performed for sizes of A, u, v.
21047 :
21048 : INPUT PARAMETERS:
21049 : M - number of rows
21050 : N - number of columns
21051 : A - target matrix, MxN submatrix is updated
21052 : IA - submatrix offset (row index)
21053 : JA - submatrix offset (column index)
21054 : Alpha- coefficient
21055 : U - vector #1
21056 : IU - subvector offset
21057 : V - vector #2
21058 : IV - subvector offset
21059 :
21060 :
21061 : -- ALGLIB routine --
21062 :
21063 : 16.10.2017
21064 : Bochkanov Sergey
21065 : *************************************************************************/
21066 0 : void rmatrixger(ae_int_t m,
21067 : ae_int_t n,
21068 : /* Real */ ae_matrix* a,
21069 : ae_int_t ia,
21070 : ae_int_t ja,
21071 : double alpha,
21072 : /* Real */ ae_vector* u,
21073 : ae_int_t iu,
21074 : /* Real */ ae_vector* v,
21075 : ae_int_t iv,
21076 : ae_state *_state)
21077 : {
21078 : ae_int_t i;
21079 : double s;
21080 :
21081 :
21082 :
21083 : /*
21084 : * Quick exit
21085 : */
21086 0 : if( m<=0||n<=0 )
21087 : {
21088 0 : return;
21089 : }
21090 :
21091 : /*
21092 : * Try fast kernels:
21093 : * * vendor kernel
21094 : * * internal kernel
21095 : */
21096 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21097 : {
21098 :
21099 : /*
21100 : * Try MKL kernel first
21101 : */
21102 0 : if( rmatrixgermkl(m, n, a, ia, ja, alpha, u, iu, v, iv, _state) )
21103 : {
21104 0 : return;
21105 : }
21106 : }
21107 0 : if( rmatrixgerf(m, n, a, ia, ja, alpha, u, iu, v, iv, _state) )
21108 : {
21109 0 : return;
21110 : }
21111 :
21112 : /*
21113 : * Generic code
21114 : */
21115 0 : for(i=0; i<=m-1; i++)
21116 : {
21117 0 : s = alpha*u->ptr.p_double[iu+i];
21118 0 : ae_v_addd(&a->ptr.pp_double[ia+i][ja], 1, &v->ptr.p_double[iv], 1, ae_v_len(ja,ja+n-1), s);
21119 : }
21120 : }
21121 :
21122 :
21123 : /*************************************************************************
21124 : Rank-1 correction: A := A + u*v'
21125 :
21126 : INPUT PARAMETERS:
21127 : M - number of rows
21128 : N - number of columns
21129 : A - target matrix, MxN submatrix is updated
21130 : IA - submatrix offset (row index)
21131 : JA - submatrix offset (column index)
21132 : U - vector #1
21133 : IU - subvector offset
21134 : V - vector #2
21135 : IV - subvector offset
21136 : *************************************************************************/
21137 0 : void cmatrixrank1(ae_int_t m,
21138 : ae_int_t n,
21139 : /* Complex */ ae_matrix* a,
21140 : ae_int_t ia,
21141 : ae_int_t ja,
21142 : /* Complex */ ae_vector* u,
21143 : ae_int_t iu,
21144 : /* Complex */ ae_vector* v,
21145 : ae_int_t iv,
21146 : ae_state *_state)
21147 : {
21148 : ae_int_t i;
21149 : ae_complex s;
21150 :
21151 :
21152 :
21153 : /*
21154 : * Quick exit
21155 : */
21156 0 : if( m<=0||n<=0 )
21157 : {
21158 0 : return;
21159 : }
21160 :
21161 : /*
21162 : * Try fast kernels:
21163 : * * vendor kernel
21164 : * * internal kernel
21165 : */
21166 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21167 : {
21168 :
21169 : /*
21170 : * Try MKL kernel first
21171 : */
21172 0 : if( cmatrixrank1mkl(m, n, a, ia, ja, u, iu, v, iv, _state) )
21173 : {
21174 0 : return;
21175 : }
21176 : }
21177 0 : if( cmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) )
21178 : {
21179 0 : return;
21180 : }
21181 :
21182 : /*
21183 : * Generic code
21184 : */
21185 0 : for(i=0; i<=m-1; i++)
21186 : {
21187 0 : s = u->ptr.p_complex[iu+i];
21188 0 : ae_v_caddc(&a->ptr.pp_complex[ia+i][ja], 1, &v->ptr.p_complex[iv], 1, "N", ae_v_len(ja,ja+n-1), s);
21189 : }
21190 : }
21191 :
21192 :
21193 : /*************************************************************************
21194 : IMPORTANT: this function is deprecated since ALGLIB 3.13. Use RMatrixGER()
21195 : which is more generic version of this function.
21196 :
21197 : Rank-1 correction: A := A + u*v'
21198 :
21199 : INPUT PARAMETERS:
21200 : M - number of rows
21201 : N - number of columns
21202 : A - target matrix, MxN submatrix is updated
21203 : IA - submatrix offset (row index)
21204 : JA - submatrix offset (column index)
21205 : U - vector #1
21206 : IU - subvector offset
21207 : V - vector #2
21208 : IV - subvector offset
21209 : *************************************************************************/
21210 0 : void rmatrixrank1(ae_int_t m,
21211 : ae_int_t n,
21212 : /* Real */ ae_matrix* a,
21213 : ae_int_t ia,
21214 : ae_int_t ja,
21215 : /* Real */ ae_vector* u,
21216 : ae_int_t iu,
21217 : /* Real */ ae_vector* v,
21218 : ae_int_t iv,
21219 : ae_state *_state)
21220 : {
21221 : ae_int_t i;
21222 : double s;
21223 :
21224 :
21225 :
21226 : /*
21227 : * Quick exit
21228 : */
21229 0 : if( m<=0||n<=0 )
21230 : {
21231 0 : return;
21232 : }
21233 :
21234 : /*
21235 : * Try fast kernels:
21236 : * * vendor kernel
21237 : * * internal kernel
21238 : */
21239 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21240 : {
21241 :
21242 : /*
21243 : * Try MKL kernel first
21244 : */
21245 0 : if( rmatrixrank1mkl(m, n, a, ia, ja, u, iu, v, iv, _state) )
21246 : {
21247 0 : return;
21248 : }
21249 : }
21250 0 : if( rmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) )
21251 : {
21252 0 : return;
21253 : }
21254 :
21255 : /*
21256 : * Generic code
21257 : */
21258 0 : for(i=0; i<=m-1; i++)
21259 : {
21260 0 : s = u->ptr.p_double[iu+i];
21261 0 : ae_v_addd(&a->ptr.pp_double[ia+i][ja], 1, &v->ptr.p_double[iv], 1, ae_v_len(ja,ja+n-1), s);
21262 : }
21263 : }
21264 :
21265 :
21266 0 : void rmatrixgemv(ae_int_t m,
21267 : ae_int_t n,
21268 : double alpha,
21269 : /* Real */ ae_matrix* a,
21270 : ae_int_t ia,
21271 : ae_int_t ja,
21272 : ae_int_t opa,
21273 : /* Real */ ae_vector* x,
21274 : ae_int_t ix,
21275 : double beta,
21276 : /* Real */ ae_vector* y,
21277 : ae_int_t iy,
21278 : ae_state *_state)
21279 : {
21280 : ae_int_t i;
21281 : double v;
21282 :
21283 :
21284 :
21285 : /*
21286 : * Quick exit for M=0, N=0 or Alpha=0.
21287 : *
21288 : * After this block we have M>0, N>0, Alpha<>0.
21289 : */
21290 0 : if( m<=0 )
21291 : {
21292 0 : return;
21293 : }
21294 0 : if( n<=0||ae_fp_eq(alpha,0.0) )
21295 : {
21296 0 : if( ae_fp_neq(beta,(double)(0)) )
21297 : {
21298 0 : for(i=0; i<=m-1; i++)
21299 : {
21300 0 : y->ptr.p_double[iy+i] = beta*y->ptr.p_double[iy+i];
21301 : }
21302 : }
21303 : else
21304 : {
21305 0 : for(i=0; i<=m-1; i++)
21306 : {
21307 0 : y->ptr.p_double[iy+i] = 0.0;
21308 : }
21309 : }
21310 0 : return;
21311 : }
21312 :
21313 : /*
21314 : * Try fast kernels
21315 : */
21316 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21317 : {
21318 :
21319 : /*
21320 : * Try MKL kernel
21321 : */
21322 0 : if( rmatrixgemvmkl(m, n, alpha, a, ia, ja, opa, x, ix, beta, y, iy, _state) )
21323 : {
21324 0 : return;
21325 : }
21326 : }
21327 :
21328 : /*
21329 : * Generic code
21330 : */
21331 0 : if( opa==0 )
21332 : {
21333 :
21334 : /*
21335 : * y = A*x
21336 : */
21337 0 : for(i=0; i<=m-1; i++)
21338 : {
21339 0 : v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &x->ptr.p_double[ix], 1, ae_v_len(ja,ja+n-1));
21340 0 : if( ae_fp_eq(beta,0.0) )
21341 : {
21342 0 : y->ptr.p_double[iy+i] = alpha*v;
21343 : }
21344 : else
21345 : {
21346 0 : y->ptr.p_double[iy+i] = alpha*v+beta*y->ptr.p_double[iy+i];
21347 : }
21348 : }
21349 0 : return;
21350 : }
21351 0 : if( opa==1 )
21352 : {
21353 :
21354 : /*
21355 : * Prepare output array
21356 : */
21357 0 : if( ae_fp_eq(beta,0.0) )
21358 : {
21359 0 : for(i=0; i<=m-1; i++)
21360 : {
21361 0 : y->ptr.p_double[iy+i] = (double)(0);
21362 : }
21363 : }
21364 : else
21365 : {
21366 0 : for(i=0; i<=m-1; i++)
21367 : {
21368 0 : y->ptr.p_double[iy+i] = beta*y->ptr.p_double[iy+i];
21369 : }
21370 : }
21371 :
21372 : /*
21373 : * y += A^T*x
21374 : */
21375 0 : for(i=0; i<=n-1; i++)
21376 : {
21377 0 : v = alpha*x->ptr.p_double[ix+i];
21378 0 : ae_v_addd(&y->ptr.p_double[iy], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(iy,iy+m-1), v);
21379 : }
21380 0 : return;
21381 : }
21382 : }
21383 :
21384 :
21385 : /*************************************************************************
21386 : Matrix-vector product: y := op(A)*x
21387 :
21388 : INPUT PARAMETERS:
21389 : M - number of rows of op(A)
21390 : M>=0
21391 : N - number of columns of op(A)
21392 : N>=0
21393 : A - target matrix
21394 : IA - submatrix offset (row index)
21395 : JA - submatrix offset (column index)
21396 : OpA - operation type:
21397 : * OpA=0 => op(A) = A
21398 : * OpA=1 => op(A) = A^T
21399 : * OpA=2 => op(A) = A^H
21400 : X - input vector
21401 : IX - subvector offset
21402 : IY - subvector offset
21403 : Y - preallocated matrix, must be large enough to store result
21404 :
21405 : OUTPUT PARAMETERS:
21406 : Y - vector which stores result
21407 :
21408 : if M=0, then subroutine does nothing.
21409 : if N=0, Y is filled by zeros.
21410 :
21411 :
21412 : -- ALGLIB routine --
21413 :
21414 : 28.01.2010
21415 : Bochkanov Sergey
21416 : *************************************************************************/
21417 0 : void cmatrixmv(ae_int_t m,
21418 : ae_int_t n,
21419 : /* Complex */ ae_matrix* a,
21420 : ae_int_t ia,
21421 : ae_int_t ja,
21422 : ae_int_t opa,
21423 : /* Complex */ ae_vector* x,
21424 : ae_int_t ix,
21425 : /* Complex */ ae_vector* y,
21426 : ae_int_t iy,
21427 : ae_state *_state)
21428 : {
21429 : ae_int_t i;
21430 : ae_complex v;
21431 :
21432 :
21433 :
21434 : /*
21435 : * Quick exit
21436 : */
21437 0 : if( m==0 )
21438 : {
21439 0 : return;
21440 : }
21441 0 : if( n==0 )
21442 : {
21443 0 : for(i=0; i<=m-1; i++)
21444 : {
21445 0 : y->ptr.p_complex[iy+i] = ae_complex_from_i(0);
21446 : }
21447 0 : return;
21448 : }
21449 :
21450 : /*
21451 : * Try fast kernels
21452 : */
21453 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21454 : {
21455 :
21456 : /*
21457 : * Try MKL kernel
21458 : */
21459 0 : if( cmatrixmvmkl(m, n, a, ia, ja, opa, x, ix, y, iy, _state) )
21460 : {
21461 0 : return;
21462 : }
21463 : }
21464 :
21465 : /*
21466 : * Generic code
21467 : */
21468 0 : if( opa==0 )
21469 : {
21470 :
21471 : /*
21472 : * y = A*x
21473 : */
21474 0 : for(i=0; i<=m-1; i++)
21475 : {
21476 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &x->ptr.p_complex[ix], 1, "N", ae_v_len(ja,ja+n-1));
21477 0 : y->ptr.p_complex[iy+i] = v;
21478 : }
21479 0 : return;
21480 : }
21481 0 : if( opa==1 )
21482 : {
21483 :
21484 : /*
21485 : * y = A^T*x
21486 : */
21487 0 : for(i=0; i<=m-1; i++)
21488 : {
21489 0 : y->ptr.p_complex[iy+i] = ae_complex_from_i(0);
21490 : }
21491 0 : for(i=0; i<=n-1; i++)
21492 : {
21493 0 : v = x->ptr.p_complex[ix+i];
21494 0 : ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(iy,iy+m-1), v);
21495 : }
21496 0 : return;
21497 : }
21498 0 : if( opa==2 )
21499 : {
21500 :
21501 : /*
21502 : * y = A^H*x
21503 : */
21504 0 : for(i=0; i<=m-1; i++)
21505 : {
21506 0 : y->ptr.p_complex[iy+i] = ae_complex_from_i(0);
21507 : }
21508 0 : for(i=0; i<=n-1; i++)
21509 : {
21510 0 : v = x->ptr.p_complex[ix+i];
21511 0 : ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "Conj", ae_v_len(iy,iy+m-1), v);
21512 : }
21513 0 : return;
21514 : }
21515 : }
21516 :
21517 :
21518 : /*************************************************************************
21519 : IMPORTANT: this function is deprecated since ALGLIB 3.13. Use RMatrixGEMV()
21520 : which is more generic version of this function.
21521 :
21522 : Matrix-vector product: y := op(A)*x
21523 :
21524 : INPUT PARAMETERS:
21525 : M - number of rows of op(A)
21526 : N - number of columns of op(A)
21527 : A - target matrix
21528 : IA - submatrix offset (row index)
21529 : JA - submatrix offset (column index)
21530 : OpA - operation type:
21531 : * OpA=0 => op(A) = A
21532 : * OpA=1 => op(A) = A^T
21533 : X - input vector
21534 : IX - subvector offset
21535 : IY - subvector offset
21536 : Y - preallocated matrix, must be large enough to store result
21537 :
21538 : OUTPUT PARAMETERS:
21539 : Y - vector which stores result
21540 :
21541 : if M=0, then subroutine does nothing.
21542 : if N=0, Y is filled by zeros.
21543 :
21544 :
21545 : -- ALGLIB routine --
21546 :
21547 : 28.01.2010
21548 : Bochkanov Sergey
21549 : *************************************************************************/
21550 0 : void rmatrixmv(ae_int_t m,
21551 : ae_int_t n,
21552 : /* Real */ ae_matrix* a,
21553 : ae_int_t ia,
21554 : ae_int_t ja,
21555 : ae_int_t opa,
21556 : /* Real */ ae_vector* x,
21557 : ae_int_t ix,
21558 : /* Real */ ae_vector* y,
21559 : ae_int_t iy,
21560 : ae_state *_state)
21561 : {
21562 : ae_int_t i;
21563 : double v;
21564 :
21565 :
21566 :
21567 : /*
21568 : * Quick exit
21569 : */
21570 0 : if( m==0 )
21571 : {
21572 0 : return;
21573 : }
21574 0 : if( n==0 )
21575 : {
21576 0 : for(i=0; i<=m-1; i++)
21577 : {
21578 0 : y->ptr.p_double[iy+i] = (double)(0);
21579 : }
21580 0 : return;
21581 : }
21582 :
21583 : /*
21584 : * Try fast kernels
21585 : */
21586 0 : if( m>ablas_blas2minvendorkernelsize&&n>ablas_blas2minvendorkernelsize )
21587 : {
21588 :
21589 : /*
21590 : * Try MKL kernel
21591 : */
21592 0 : if( rmatrixmvmkl(m, n, a, ia, ja, opa, x, ix, y, iy, _state) )
21593 : {
21594 0 : return;
21595 : }
21596 : }
21597 :
21598 : /*
21599 : * Generic code
21600 : */
21601 0 : if( opa==0 )
21602 : {
21603 :
21604 : /*
21605 : * y = A*x
21606 : */
21607 0 : for(i=0; i<=m-1; i++)
21608 : {
21609 0 : v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &x->ptr.p_double[ix], 1, ae_v_len(ja,ja+n-1));
21610 0 : y->ptr.p_double[iy+i] = v;
21611 : }
21612 0 : return;
21613 : }
21614 0 : if( opa==1 )
21615 : {
21616 :
21617 : /*
21618 : * y = A^T*x
21619 : */
21620 0 : for(i=0; i<=m-1; i++)
21621 : {
21622 0 : y->ptr.p_double[iy+i] = (double)(0);
21623 : }
21624 0 : for(i=0; i<=n-1; i++)
21625 : {
21626 0 : v = x->ptr.p_double[ix+i];
21627 0 : ae_v_addd(&y->ptr.p_double[iy], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(iy,iy+m-1), v);
21628 : }
21629 0 : return;
21630 : }
21631 : }
21632 :
21633 :
21634 0 : void rmatrixsymv(ae_int_t n,
21635 : double alpha,
21636 : /* Real */ ae_matrix* a,
21637 : ae_int_t ia,
21638 : ae_int_t ja,
21639 : ae_bool isupper,
21640 : /* Real */ ae_vector* x,
21641 : ae_int_t ix,
21642 : double beta,
21643 : /* Real */ ae_vector* y,
21644 : ae_int_t iy,
21645 : ae_state *_state)
21646 : {
21647 : ae_int_t i;
21648 : ae_int_t j;
21649 : double v;
21650 : double vr;
21651 : double vx;
21652 :
21653 :
21654 :
21655 : /*
21656 : * Quick exit for M=0, N=0 or Alpha=0.
21657 : *
21658 : * After this block we have M>0, N>0, Alpha<>0.
21659 : */
21660 0 : if( n<=0 )
21661 : {
21662 0 : return;
21663 : }
21664 0 : if( ae_fp_eq(alpha,0.0) )
21665 : {
21666 0 : if( ae_fp_neq(beta,(double)(0)) )
21667 : {
21668 0 : for(i=0; i<=n-1; i++)
21669 : {
21670 0 : y->ptr.p_double[iy+i] = beta*y->ptr.p_double[iy+i];
21671 : }
21672 : }
21673 : else
21674 : {
21675 0 : for(i=0; i<=n-1; i++)
21676 : {
21677 0 : y->ptr.p_double[iy+i] = 0.0;
21678 : }
21679 : }
21680 0 : return;
21681 : }
21682 :
21683 : /*
21684 : * Try fast kernels
21685 : */
21686 0 : if( n>ablas_blas2minvendorkernelsize )
21687 : {
21688 :
21689 : /*
21690 : * Try MKL kernel
21691 : */
21692 0 : if( rmatrixsymvmkl(n, alpha, a, ia, ja, isupper, x, ix, beta, y, iy, _state) )
21693 : {
21694 0 : return;
21695 : }
21696 : }
21697 :
21698 : /*
21699 : * Generic code
21700 : */
21701 0 : if( ae_fp_neq(beta,(double)(0)) )
21702 : {
21703 0 : for(i=0; i<=n-1; i++)
21704 : {
21705 0 : y->ptr.p_double[iy+i] = beta*y->ptr.p_double[iy+i];
21706 : }
21707 : }
21708 : else
21709 : {
21710 0 : for(i=0; i<=n-1; i++)
21711 : {
21712 0 : y->ptr.p_double[iy+i] = 0.0;
21713 : }
21714 : }
21715 0 : if( isupper )
21716 : {
21717 :
21718 : /*
21719 : * Upper triangle of A is stored
21720 : */
21721 0 : for(i=0; i<=n-1; i++)
21722 : {
21723 :
21724 : /*
21725 : * Process diagonal element
21726 : */
21727 0 : v = alpha*a->ptr.pp_double[ia+i][ja+i];
21728 0 : y->ptr.p_double[iy+i] = y->ptr.p_double[iy+i]+v*x->ptr.p_double[ix+i];
21729 :
21730 : /*
21731 : * Process off-diagonal elements
21732 : */
21733 0 : vr = 0.0;
21734 0 : vx = x->ptr.p_double[ix+i];
21735 0 : for(j=i+1; j<=n-1; j++)
21736 : {
21737 0 : v = alpha*a->ptr.pp_double[ia+i][ja+j];
21738 0 : y->ptr.p_double[iy+j] = y->ptr.p_double[iy+j]+v*vx;
21739 0 : vr = vr+v*x->ptr.p_double[ix+j];
21740 : }
21741 0 : y->ptr.p_double[iy+i] = y->ptr.p_double[iy+i]+vr;
21742 : }
21743 : }
21744 : else
21745 : {
21746 :
21747 : /*
21748 : * Lower triangle of A is stored
21749 : */
21750 0 : for(i=0; i<=n-1; i++)
21751 : {
21752 :
21753 : /*
21754 : * Process diagonal element
21755 : */
21756 0 : v = alpha*a->ptr.pp_double[ia+i][ja+i];
21757 0 : y->ptr.p_double[iy+i] = y->ptr.p_double[iy+i]+v*x->ptr.p_double[ix+i];
21758 :
21759 : /*
21760 : * Process off-diagonal elements
21761 : */
21762 0 : vr = 0.0;
21763 0 : vx = x->ptr.p_double[ix+i];
21764 0 : for(j=0; j<=i-1; j++)
21765 : {
21766 0 : v = alpha*a->ptr.pp_double[ia+i][ja+j];
21767 0 : y->ptr.p_double[iy+j] = y->ptr.p_double[iy+j]+v*vx;
21768 0 : vr = vr+v*x->ptr.p_double[ix+j];
21769 : }
21770 0 : y->ptr.p_double[iy+i] = y->ptr.p_double[iy+i]+vr;
21771 : }
21772 : }
21773 : }
21774 :
21775 :
21776 0 : double rmatrixsyvmv(ae_int_t n,
21777 : /* Real */ ae_matrix* a,
21778 : ae_int_t ia,
21779 : ae_int_t ja,
21780 : ae_bool isupper,
21781 : /* Real */ ae_vector* x,
21782 : ae_int_t ix,
21783 : /* Real */ ae_vector* tmp,
21784 : ae_state *_state)
21785 : {
21786 : ae_int_t i;
21787 : double result;
21788 :
21789 :
21790 :
21791 : /*
21792 : * Quick exit for N=0
21793 : */
21794 0 : if( n<=0 )
21795 : {
21796 0 : result = (double)(0);
21797 0 : return result;
21798 : }
21799 :
21800 : /*
21801 : * Generic code
21802 : */
21803 0 : rmatrixsymv(n, 1.0, a, ia, ja, isupper, x, ix, 0.0, tmp, 0, _state);
21804 0 : result = (double)(0);
21805 0 : for(i=0; i<=n-1; i++)
21806 : {
21807 0 : result = result+x->ptr.p_double[ix+i]*tmp->ptr.p_double[i];
21808 : }
21809 0 : return result;
21810 : }
21811 :
21812 :
21813 : /*************************************************************************
21814 : This subroutine solves linear system op(A)*x=b where:
21815 : * A is NxN upper/lower triangular/unitriangular matrix
21816 : * X and B are Nx1 vectors
21817 : * "op" may be identity transformation, transposition, conjugate transposition
21818 :
21819 : Solution replaces X.
21820 :
21821 : IMPORTANT: * no overflow/underflow/denegeracy tests is performed.
21822 : * no integrity checks for operand sizes, out-of-bounds accesses
21823 : and so on is performed
21824 :
21825 : INPUT PARAMETERS
21826 : N - matrix size, N>=0
21827 : A - matrix, actial matrix is stored in A[IA:IA+N-1,JA:JA+N-1]
21828 : IA - submatrix offset
21829 : JA - submatrix offset
21830 : IsUpper - whether matrix is upper triangular
21831 : IsUnit - whether matrix is unitriangular
21832 : OpType - transformation type:
21833 : * 0 - no transformation
21834 : * 1 - transposition
21835 : X - right part, actual vector is stored in X[IX:IX+N-1]
21836 : IX - offset
21837 :
21838 : OUTPUT PARAMETERS
21839 : X - solution replaces elements X[IX:IX+N-1]
21840 :
21841 : -- ALGLIB routine / remastering of LAPACK's DTRSV --
21842 : (c) 2017 Bochkanov Sergey - converted to ALGLIB
21843 : (c) 2016 Reference BLAS level1 routine (LAPACK version 3.7.0)
21844 : Reference BLAS is a software package provided by Univ. of Tennessee,
21845 : Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.
21846 : *************************************************************************/
21847 0 : void rmatrixtrsv(ae_int_t n,
21848 : /* Real */ ae_matrix* a,
21849 : ae_int_t ia,
21850 : ae_int_t ja,
21851 : ae_bool isupper,
21852 : ae_bool isunit,
21853 : ae_int_t optype,
21854 : /* Real */ ae_vector* x,
21855 : ae_int_t ix,
21856 : ae_state *_state)
21857 : {
21858 : ae_int_t i;
21859 : ae_int_t j;
21860 : double v;
21861 :
21862 :
21863 :
21864 : /*
21865 : * Quick exit
21866 : */
21867 0 : if( n<=0 )
21868 : {
21869 0 : return;
21870 : }
21871 :
21872 : /*
21873 : * Try fast kernels
21874 : */
21875 0 : if( n>ablas_blas2minvendorkernelsize )
21876 : {
21877 :
21878 : /*
21879 : * Try MKL kernel
21880 : */
21881 0 : if( rmatrixtrsvmkl(n, a, ia, ja, isupper, isunit, optype, x, ix, _state) )
21882 : {
21883 0 : return;
21884 : }
21885 : }
21886 :
21887 : /*
21888 : * Generic code
21889 : */
21890 0 : if( optype==0&&isupper )
21891 : {
21892 0 : for(i=n-1; i>=0; i--)
21893 : {
21894 0 : v = x->ptr.p_double[ix+i];
21895 0 : for(j=i+1; j<=n-1; j++)
21896 : {
21897 0 : v = v-a->ptr.pp_double[ia+i][ja+j]*x->ptr.p_double[ix+j];
21898 : }
21899 0 : if( !isunit )
21900 : {
21901 0 : v = v/a->ptr.pp_double[ia+i][ja+i];
21902 : }
21903 0 : x->ptr.p_double[ix+i] = v;
21904 : }
21905 0 : return;
21906 : }
21907 0 : if( optype==0&&!isupper )
21908 : {
21909 0 : for(i=0; i<=n-1; i++)
21910 : {
21911 0 : v = x->ptr.p_double[ix+i];
21912 0 : for(j=0; j<=i-1; j++)
21913 : {
21914 0 : v = v-a->ptr.pp_double[ia+i][ja+j]*x->ptr.p_double[ix+j];
21915 : }
21916 0 : if( !isunit )
21917 : {
21918 0 : v = v/a->ptr.pp_double[ia+i][ja+i];
21919 : }
21920 0 : x->ptr.p_double[ix+i] = v;
21921 : }
21922 0 : return;
21923 : }
21924 0 : if( optype==1&&isupper )
21925 : {
21926 0 : for(i=0; i<=n-1; i++)
21927 : {
21928 0 : v = x->ptr.p_double[ix+i];
21929 0 : if( !isunit )
21930 : {
21931 0 : v = v/a->ptr.pp_double[ia+i][ja+i];
21932 : }
21933 0 : x->ptr.p_double[ix+i] = v;
21934 0 : if( v==0 )
21935 : {
21936 0 : continue;
21937 : }
21938 0 : for(j=i+1; j<=n-1; j++)
21939 : {
21940 0 : x->ptr.p_double[ix+j] = x->ptr.p_double[ix+j]-v*a->ptr.pp_double[ia+i][ja+j];
21941 : }
21942 : }
21943 0 : return;
21944 : }
21945 0 : if( optype==1&&!isupper )
21946 : {
21947 0 : for(i=n-1; i>=0; i--)
21948 : {
21949 0 : v = x->ptr.p_double[ix+i];
21950 0 : if( !isunit )
21951 : {
21952 0 : v = v/a->ptr.pp_double[ia+i][ja+i];
21953 : }
21954 0 : x->ptr.p_double[ix+i] = v;
21955 0 : if( v==0 )
21956 : {
21957 0 : continue;
21958 : }
21959 0 : for(j=0; j<=i-1; j++)
21960 : {
21961 0 : x->ptr.p_double[ix+j] = x->ptr.p_double[ix+j]-v*a->ptr.pp_double[ia+i][ja+j];
21962 : }
21963 : }
21964 0 : return;
21965 : }
21966 0 : ae_assert(ae_false, "RMatrixTRSV: unexpected operation type", _state);
21967 : }
21968 :
21969 :
21970 : /*************************************************************************
21971 : This subroutine calculates X*op(A^-1) where:
21972 : * X is MxN general matrix
21973 : * A is NxN upper/lower triangular/unitriangular matrix
21974 : * "op" may be identity transformation, transposition, conjugate transposition
21975 : Multiplication result replaces X.
21976 :
21977 : ! COMMERCIAL EDITION OF ALGLIB:
21978 : !
21979 : ! Commercial Edition of ALGLIB includes following important improvements
21980 : ! of this function:
21981 : ! * high-performance native backend with same C# interface (C# version)
21982 : ! * multithreading support (C++ and C# versions)
21983 : ! * hardware vendor (Intel) implementations of linear algebra primitives
21984 : ! (C++ and C# versions, x86/x64 platform)
21985 : !
21986 : ! We recommend you to read 'Working with commercial version' section of
21987 : ! ALGLIB Reference Manual in order to find out how to use performance-
21988 : ! related features provided by commercial edition of ALGLIB.
21989 :
21990 : INPUT PARAMETERS
21991 : N - matrix size, N>=0
21992 : M - matrix size, N>=0
21993 : A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1]
21994 : I1 - submatrix offset
21995 : J1 - submatrix offset
21996 : IsUpper - whether matrix is upper triangular
21997 : IsUnit - whether matrix is unitriangular
21998 : OpType - transformation type:
21999 : * 0 - no transformation
22000 : * 1 - transposition
22001 : * 2 - conjugate transposition
22002 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
22003 : I2 - submatrix offset
22004 : J2 - submatrix offset
22005 :
22006 : -- ALGLIB routine --
22007 : 20.01.2018
22008 : Bochkanov Sergey
22009 : *************************************************************************/
22010 0 : void cmatrixrighttrsm(ae_int_t m,
22011 : ae_int_t n,
22012 : /* Complex */ ae_matrix* a,
22013 : ae_int_t i1,
22014 : ae_int_t j1,
22015 : ae_bool isupper,
22016 : ae_bool isunit,
22017 : ae_int_t optype,
22018 : /* Complex */ ae_matrix* x,
22019 : ae_int_t i2,
22020 : ae_int_t j2,
22021 : ae_state *_state)
22022 : {
22023 : ae_int_t s1;
22024 : ae_int_t s2;
22025 : ae_int_t tsa;
22026 : ae_int_t tsb;
22027 : ae_int_t tscur;
22028 :
22029 :
22030 0 : tsa = matrixtilesizea(_state)/2;
22031 0 : tsb = matrixtilesizeb(_state);
22032 0 : tscur = tsb;
22033 0 : if( imax2(m, n, _state)<=tsb )
22034 : {
22035 0 : tscur = tsa;
22036 : }
22037 0 : ae_assert(tscur>=1, "CMatrixRightTRSM: integrity check failed", _state);
22038 :
22039 : /*
22040 : * Upper level parallelization:
22041 : * * decide whether it is feasible to activate multithreading
22042 : * * perform optionally parallelized splits on M
22043 : */
22044 0 : if( m>=2*tsb&&ae_fp_greater_eq(4*rmul3((double)(m), (double)(n), (double)(n), _state),smpactivationlevel(_state)) )
22045 : {
22046 0 : if( _trypexec_cmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state) )
22047 : {
22048 0 : return;
22049 : }
22050 : }
22051 0 : if( m>=2*tsb )
22052 : {
22053 :
22054 : /*
22055 : * Split X: X*A = (X1 X2)^T*A
22056 : */
22057 0 : tiledsplit(m, tsb, &s1, &s2, _state);
22058 0 : cmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22059 0 : cmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state);
22060 0 : return;
22061 : }
22062 :
22063 : /*
22064 : * Basecase: either MKL-supported code or ALGLIB basecase code
22065 : */
22066 0 : if( imax2(m, n, _state)<=tsb )
22067 : {
22068 0 : if( cmatrixrighttrsmmkl(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
22069 : {
22070 0 : return;
22071 : }
22072 : }
22073 0 : if( imax2(m, n, _state)<=tsa )
22074 : {
22075 0 : ablas_cmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22076 0 : return;
22077 : }
22078 :
22079 : /*
22080 : * Recursive subdivision
22081 : */
22082 0 : if( m>=n )
22083 : {
22084 :
22085 : /*
22086 : * Split X: X*A = (X1 X2)^T*A
22087 : */
22088 0 : tiledsplit(m, tscur, &s1, &s2, _state);
22089 0 : cmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22090 0 : cmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state);
22091 : }
22092 : else
22093 : {
22094 :
22095 : /*
22096 : * Split A:
22097 : * (A1 A12)
22098 : * X*op(A) = X*op( )
22099 : * ( A2)
22100 : *
22101 : * Different variants depending on
22102 : * IsUpper/OpType combinations
22103 : */
22104 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22105 0 : if( isupper&&optype==0 )
22106 : {
22107 :
22108 : /*
22109 : * (A1 A12)-1
22110 : * X*A^-1 = (X1 X2)*( )
22111 : * ( A2)
22112 : */
22113 0 : cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22114 0 : cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1, j1+s1, 0, ae_complex_from_d(1.0), x, i2, j2+s1, _state);
22115 0 : cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22116 : }
22117 0 : if( isupper&&optype!=0 )
22118 : {
22119 :
22120 : /*
22121 : * (A1' )-1
22122 : * X*A^-1 = (X1 X2)*( )
22123 : * (A12' A2')
22124 : */
22125 0 : cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22126 0 : cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1, j1+s1, optype, ae_complex_from_d(1.0), x, i2, j2, _state);
22127 0 : cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22128 : }
22129 0 : if( !isupper&&optype==0 )
22130 : {
22131 :
22132 : /*
22133 : * (A1 )-1
22134 : * X*A^-1 = (X1 X2)*( )
22135 : * (A21 A2)
22136 : */
22137 0 : cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22138 0 : cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1+s1, j1, 0, ae_complex_from_d(1.0), x, i2, j2, _state);
22139 0 : cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22140 : }
22141 0 : if( !isupper&&optype!=0 )
22142 : {
22143 :
22144 : /*
22145 : * (A1' A21')-1
22146 : * X*A^-1 = (X1 X2)*( )
22147 : * ( A2')
22148 : */
22149 0 : cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22150 0 : cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1+s1, j1, optype, ae_complex_from_d(1.0), x, i2, j2+s1, _state);
22151 0 : cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22152 : }
22153 : }
22154 : }
22155 :
22156 :
22157 : /*************************************************************************
22158 : Serial stub for GPL edition.
22159 : *************************************************************************/
22160 0 : ae_bool _trypexec_cmatrixrighttrsm(ae_int_t m,
22161 : ae_int_t n,
22162 : /* Complex */ ae_matrix* a,
22163 : ae_int_t i1,
22164 : ae_int_t j1,
22165 : ae_bool isupper,
22166 : ae_bool isunit,
22167 : ae_int_t optype,
22168 : /* Complex */ ae_matrix* x,
22169 : ae_int_t i2,
22170 : ae_int_t j2,
22171 : ae_state *_state)
22172 : {
22173 0 : return ae_false;
22174 : }
22175 :
22176 :
22177 : /*************************************************************************
22178 : This subroutine calculates op(A^-1)*X where:
22179 : * X is MxN general matrix
22180 : * A is MxM upper/lower triangular/unitriangular matrix
22181 : * "op" may be identity transformation, transposition, conjugate transposition
22182 : Multiplication result replaces X.
22183 :
22184 : ! COMMERCIAL EDITION OF ALGLIB:
22185 : !
22186 : ! Commercial Edition of ALGLIB includes following important improvements
22187 : ! of this function:
22188 : ! * high-performance native backend with same C# interface (C# version)
22189 : ! * multithreading support (C++ and C# versions)
22190 : ! * hardware vendor (Intel) implementations of linear algebra primitives
22191 : ! (C++ and C# versions, x86/x64 platform)
22192 : !
22193 : ! We recommend you to read 'Working with commercial version' section of
22194 : ! ALGLIB Reference Manual in order to find out how to use performance-
22195 : ! related features provided by commercial edition of ALGLIB.
22196 :
22197 : INPUT PARAMETERS
22198 : N - matrix size, N>=0
22199 : M - matrix size, N>=0
22200 : A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1]
22201 : I1 - submatrix offset
22202 : J1 - submatrix offset
22203 : IsUpper - whether matrix is upper triangular
22204 : IsUnit - whether matrix is unitriangular
22205 : OpType - transformation type:
22206 : * 0 - no transformation
22207 : * 1 - transposition
22208 : * 2 - conjugate transposition
22209 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
22210 : I2 - submatrix offset
22211 : J2 - submatrix offset
22212 :
22213 : -- ALGLIB routine --
22214 : 15.12.2009-22.01.2018
22215 : Bochkanov Sergey
22216 : *************************************************************************/
22217 0 : void cmatrixlefttrsm(ae_int_t m,
22218 : ae_int_t n,
22219 : /* Complex */ ae_matrix* a,
22220 : ae_int_t i1,
22221 : ae_int_t j1,
22222 : ae_bool isupper,
22223 : ae_bool isunit,
22224 : ae_int_t optype,
22225 : /* Complex */ ae_matrix* x,
22226 : ae_int_t i2,
22227 : ae_int_t j2,
22228 : ae_state *_state)
22229 : {
22230 : ae_int_t s1;
22231 : ae_int_t s2;
22232 : ae_int_t tsa;
22233 : ae_int_t tsb;
22234 : ae_int_t tscur;
22235 :
22236 :
22237 0 : tsa = matrixtilesizea(_state)/2;
22238 0 : tsb = matrixtilesizeb(_state);
22239 0 : tscur = tsb;
22240 0 : if( imax2(m, n, _state)<=tsb )
22241 : {
22242 0 : tscur = tsa;
22243 : }
22244 0 : ae_assert(tscur>=1, "CMatrixLeftTRSM: integrity check failed", _state);
22245 :
22246 : /*
22247 : * Upper level parallelization:
22248 : * * decide whether it is feasible to activate multithreading
22249 : * * perform optionally parallelized splits on N
22250 : */
22251 0 : if( n>=2*tsb&&ae_fp_greater_eq(4*rmul3((double)(n), (double)(m), (double)(m), _state),smpactivationlevel(_state)) )
22252 : {
22253 0 : if( _trypexec_cmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state) )
22254 : {
22255 0 : return;
22256 : }
22257 : }
22258 0 : if( n>=2*tsb )
22259 : {
22260 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22261 0 : cmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state);
22262 0 : cmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22263 0 : return;
22264 : }
22265 :
22266 : /*
22267 : * Basecase: either MKL-supported code or ALGLIB basecase code
22268 : */
22269 0 : if( imax2(m, n, _state)<=tsb )
22270 : {
22271 0 : if( cmatrixlefttrsmmkl(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
22272 : {
22273 0 : return;
22274 : }
22275 : }
22276 0 : if( imax2(m, n, _state)<=tsa )
22277 : {
22278 0 : ablas_cmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22279 0 : return;
22280 : }
22281 :
22282 : /*
22283 : * Recursive subdivision
22284 : */
22285 0 : if( n>=m )
22286 : {
22287 :
22288 : /*
22289 : * Split X: op(A)^-1*X = op(A)^-1*(X1 X2)
22290 : */
22291 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22292 0 : cmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22293 0 : cmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state);
22294 : }
22295 : else
22296 : {
22297 :
22298 : /*
22299 : * Split A
22300 : */
22301 0 : tiledsplit(m, tscur, &s1, &s2, _state);
22302 0 : if( isupper&&optype==0 )
22303 : {
22304 :
22305 : /*
22306 : * (A1 A12)-1 ( X1 )
22307 : * A^-1*X* = ( ) *( )
22308 : * ( A2) ( X2 )
22309 : */
22310 0 : cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22311 0 : cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1, j1+s1, 0, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state);
22312 0 : cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22313 : }
22314 0 : if( isupper&&optype!=0 )
22315 : {
22316 :
22317 : /*
22318 : * (A1' )-1 ( X1 )
22319 : * A^-1*X = ( ) *( )
22320 : * (A12' A2') ( X2 )
22321 : */
22322 0 : cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22323 0 : cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1, j1+s1, optype, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state);
22324 0 : cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22325 : }
22326 0 : if( !isupper&&optype==0 )
22327 : {
22328 :
22329 : /*
22330 : * (A1 )-1 ( X1 )
22331 : * A^-1*X = ( ) *( )
22332 : * (A21 A2) ( X2 )
22333 : */
22334 0 : cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22335 0 : cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1+s1, j1, 0, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state);
22336 0 : cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22337 : }
22338 0 : if( !isupper&&optype!=0 )
22339 : {
22340 :
22341 : /*
22342 : * (A1' A21')-1 ( X1 )
22343 : * A^-1*X = ( ) *( )
22344 : * ( A2') ( X2 )
22345 : */
22346 0 : cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22347 0 : cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1+s1, j1, optype, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state);
22348 0 : cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22349 : }
22350 : }
22351 : }
22352 :
22353 :
22354 : /*************************************************************************
22355 : Serial stub for GPL edition.
22356 : *************************************************************************/
22357 0 : ae_bool _trypexec_cmatrixlefttrsm(ae_int_t m,
22358 : ae_int_t n,
22359 : /* Complex */ ae_matrix* a,
22360 : ae_int_t i1,
22361 : ae_int_t j1,
22362 : ae_bool isupper,
22363 : ae_bool isunit,
22364 : ae_int_t optype,
22365 : /* Complex */ ae_matrix* x,
22366 : ae_int_t i2,
22367 : ae_int_t j2,
22368 : ae_state *_state)
22369 : {
22370 0 : return ae_false;
22371 : }
22372 :
22373 :
22374 : /*************************************************************************
22375 : This subroutine calculates X*op(A^-1) where:
22376 : * X is MxN general matrix
22377 : * A is NxN upper/lower triangular/unitriangular matrix
22378 : * "op" may be identity transformation, transposition
22379 : Multiplication result replaces X.
22380 :
22381 : ! COMMERCIAL EDITION OF ALGLIB:
22382 : !
22383 : ! Commercial Edition of ALGLIB includes following important improvements
22384 : ! of this function:
22385 : ! * high-performance native backend with same C# interface (C# version)
22386 : ! * multithreading support (C++ and C# versions)
22387 : ! * hardware vendor (Intel) implementations of linear algebra primitives
22388 : ! (C++ and C# versions, x86/x64 platform)
22389 : !
22390 : ! We recommend you to read 'Working with commercial version' section of
22391 : ! ALGLIB Reference Manual in order to find out how to use performance-
22392 : ! related features provided by commercial edition of ALGLIB.
22393 :
22394 : INPUT PARAMETERS
22395 : N - matrix size, N>=0
22396 : M - matrix size, N>=0
22397 : A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1]
22398 : I1 - submatrix offset
22399 : J1 - submatrix offset
22400 : IsUpper - whether matrix is upper triangular
22401 : IsUnit - whether matrix is unitriangular
22402 : OpType - transformation type:
22403 : * 0 - no transformation
22404 : * 1 - transposition
22405 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
22406 : I2 - submatrix offset
22407 : J2 - submatrix offset
22408 :
22409 : -- ALGLIB routine --
22410 : 15.12.2009-22.01.2018
22411 : Bochkanov Sergey
22412 : *************************************************************************/
22413 0 : void rmatrixrighttrsm(ae_int_t m,
22414 : ae_int_t n,
22415 : /* Real */ ae_matrix* a,
22416 : ae_int_t i1,
22417 : ae_int_t j1,
22418 : ae_bool isupper,
22419 : ae_bool isunit,
22420 : ae_int_t optype,
22421 : /* Real */ ae_matrix* x,
22422 : ae_int_t i2,
22423 : ae_int_t j2,
22424 : ae_state *_state)
22425 : {
22426 : ae_int_t s1;
22427 : ae_int_t s2;
22428 : ae_int_t tsa;
22429 : ae_int_t tsb;
22430 : ae_int_t tscur;
22431 :
22432 :
22433 0 : tsa = matrixtilesizea(_state);
22434 0 : tsb = matrixtilesizeb(_state);
22435 0 : tscur = tsb;
22436 0 : if( imax2(m, n, _state)<=tsb )
22437 : {
22438 0 : tscur = tsa;
22439 : }
22440 0 : ae_assert(tscur>=1, "RMatrixRightTRSM: integrity check failed", _state);
22441 :
22442 : /*
22443 : * Upper level parallelization:
22444 : * * decide whether it is feasible to activate multithreading
22445 : * * perform optionally parallelized splits on M
22446 : */
22447 0 : if( m>=2*tsb&&ae_fp_greater_eq(rmul3((double)(m), (double)(n), (double)(n), _state),smpactivationlevel(_state)) )
22448 : {
22449 0 : if( _trypexec_rmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state) )
22450 : {
22451 0 : return;
22452 : }
22453 : }
22454 0 : if( m>=2*tsb )
22455 : {
22456 :
22457 : /*
22458 : * Split X: X*A = (X1 X2)^T*A
22459 : */
22460 0 : tiledsplit(m, tsb, &s1, &s2, _state);
22461 0 : rmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22462 0 : rmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state);
22463 0 : return;
22464 : }
22465 :
22466 : /*
22467 : * Basecase: MKL or ALGLIB code
22468 : */
22469 0 : if( imax2(m, n, _state)<=tsb )
22470 : {
22471 0 : if( rmatrixrighttrsmmkl(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
22472 : {
22473 0 : return;
22474 : }
22475 : }
22476 0 : if( imax2(m, n, _state)<=tsa )
22477 : {
22478 0 : ablas_rmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22479 0 : return;
22480 : }
22481 :
22482 : /*
22483 : * Recursive subdivision
22484 : */
22485 0 : if( m>=n )
22486 : {
22487 :
22488 : /*
22489 : * Split X: X*A = (X1 X2)^T*A
22490 : */
22491 0 : tiledsplit(m, tscur, &s1, &s2, _state);
22492 0 : rmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22493 0 : rmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state);
22494 : }
22495 : else
22496 : {
22497 :
22498 : /*
22499 : * Split A:
22500 : * (A1 A12)
22501 : * X*op(A) = X*op( )
22502 : * ( A2)
22503 : *
22504 : * Different variants depending on
22505 : * IsUpper/OpType combinations
22506 : */
22507 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22508 0 : if( isupper&&optype==0 )
22509 : {
22510 :
22511 : /*
22512 : * (A1 A12)-1
22513 : * X*A^-1 = (X1 X2)*( )
22514 : * ( A2)
22515 : */
22516 0 : rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22517 0 : rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1, j1+s1, 0, 1.0, x, i2, j2+s1, _state);
22518 0 : rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22519 : }
22520 0 : if( isupper&&optype!=0 )
22521 : {
22522 :
22523 : /*
22524 : * (A1' )-1
22525 : * X*A^-1 = (X1 X2)*( )
22526 : * (A12' A2')
22527 : */
22528 0 : rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22529 0 : rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1, j1+s1, optype, 1.0, x, i2, j2, _state);
22530 0 : rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22531 : }
22532 0 : if( !isupper&&optype==0 )
22533 : {
22534 :
22535 : /*
22536 : * (A1 )-1
22537 : * X*A^-1 = (X1 X2)*( )
22538 : * (A21 A2)
22539 : */
22540 0 : rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22541 0 : rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1+s1, j1, 0, 1.0, x, i2, j2, _state);
22542 0 : rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22543 : }
22544 0 : if( !isupper&&optype!=0 )
22545 : {
22546 :
22547 : /*
22548 : * (A1' A21')-1
22549 : * X*A^-1 = (X1 X2)*( )
22550 : * ( A2')
22551 : */
22552 0 : rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22553 0 : rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1+s1, j1, optype, 1.0, x, i2, j2+s1, _state);
22554 0 : rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state);
22555 : }
22556 : }
22557 : }
22558 :
22559 :
22560 : /*************************************************************************
22561 : Serial stub for GPL edition.
22562 : *************************************************************************/
22563 0 : ae_bool _trypexec_rmatrixrighttrsm(ae_int_t m,
22564 : ae_int_t n,
22565 : /* Real */ ae_matrix* a,
22566 : ae_int_t i1,
22567 : ae_int_t j1,
22568 : ae_bool isupper,
22569 : ae_bool isunit,
22570 : ae_int_t optype,
22571 : /* Real */ ae_matrix* x,
22572 : ae_int_t i2,
22573 : ae_int_t j2,
22574 : ae_state *_state)
22575 : {
22576 0 : return ae_false;
22577 : }
22578 :
22579 :
22580 : /*************************************************************************
22581 : This subroutine calculates op(A^-1)*X where:
22582 : * X is MxN general matrix
22583 : * A is MxM upper/lower triangular/unitriangular matrix
22584 : * "op" may be identity transformation, transposition
22585 : Multiplication result replaces X.
22586 :
22587 : ! COMMERCIAL EDITION OF ALGLIB:
22588 : !
22589 : ! Commercial Edition of ALGLIB includes following important improvements
22590 : ! of this function:
22591 : ! * high-performance native backend with same C# interface (C# version)
22592 : ! * multithreading support (C++ and C# versions)
22593 : ! * hardware vendor (Intel) implementations of linear algebra primitives
22594 : ! (C++ and C# versions, x86/x64 platform)
22595 : !
22596 : ! We recommend you to read 'Working with commercial version' section of
22597 : ! ALGLIB Reference Manual in order to find out how to use performance-
22598 : ! related features provided by commercial edition of ALGLIB.
22599 :
22600 : INPUT PARAMETERS
22601 : N - matrix size, N>=0
22602 : M - matrix size, N>=0
22603 : A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1]
22604 : I1 - submatrix offset
22605 : J1 - submatrix offset
22606 : IsUpper - whether matrix is upper triangular
22607 : IsUnit - whether matrix is unitriangular
22608 : OpType - transformation type:
22609 : * 0 - no transformation
22610 : * 1 - transposition
22611 : X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1]
22612 : I2 - submatrix offset
22613 : J2 - submatrix offset
22614 :
22615 : -- ALGLIB routine --
22616 : 15.12.2009-22.01.2018
22617 : Bochkanov Sergey
22618 : *************************************************************************/
22619 0 : void rmatrixlefttrsm(ae_int_t m,
22620 : ae_int_t n,
22621 : /* Real */ ae_matrix* a,
22622 : ae_int_t i1,
22623 : ae_int_t j1,
22624 : ae_bool isupper,
22625 : ae_bool isunit,
22626 : ae_int_t optype,
22627 : /* Real */ ae_matrix* x,
22628 : ae_int_t i2,
22629 : ae_int_t j2,
22630 : ae_state *_state)
22631 : {
22632 : ae_int_t s1;
22633 : ae_int_t s2;
22634 : ae_int_t tsa;
22635 : ae_int_t tsb;
22636 : ae_int_t tscur;
22637 :
22638 :
22639 0 : tsa = matrixtilesizea(_state);
22640 0 : tsb = matrixtilesizeb(_state);
22641 0 : tscur = tsb;
22642 0 : if( imax2(m, n, _state)<=tsb )
22643 : {
22644 0 : tscur = tsa;
22645 : }
22646 0 : ae_assert(tscur>=1, "RMatrixLeftTRSMRec: integrity check failed", _state);
22647 :
22648 : /*
22649 : * Upper level parallelization:
22650 : * * decide whether it is feasible to activate multithreading
22651 : * * perform optionally parallelized splits on N
22652 : */
22653 0 : if( n>=2*tsb&&ae_fp_greater_eq(rmul3((double)(n), (double)(m), (double)(m), _state),smpactivationlevel(_state)) )
22654 : {
22655 0 : if( _trypexec_rmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state) )
22656 : {
22657 0 : return;
22658 : }
22659 : }
22660 0 : if( n>=2*tsb )
22661 : {
22662 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22663 0 : rmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state);
22664 0 : rmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22665 0 : return;
22666 : }
22667 :
22668 : /*
22669 : * Basecase: MKL or ALGLIB code
22670 : */
22671 0 : if( imax2(m, n, _state)<=tsb )
22672 : {
22673 0 : if( rmatrixlefttrsmmkl(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
22674 : {
22675 0 : return;
22676 : }
22677 : }
22678 0 : if( imax2(m, n, _state)<=tsa )
22679 : {
22680 0 : ablas_rmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22681 0 : return;
22682 : }
22683 :
22684 : /*
22685 : * Recursive subdivision
22686 : */
22687 0 : if( n>=m )
22688 : {
22689 :
22690 : /*
22691 : * Split X: op(A)^-1*X = op(A)^-1*(X1 X2)
22692 : */
22693 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22694 0 : rmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22695 0 : rmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state);
22696 : }
22697 : else
22698 : {
22699 :
22700 : /*
22701 : * Split A
22702 : */
22703 0 : tiledsplit(m, tscur, &s1, &s2, _state);
22704 0 : if( isupper&&optype==0 )
22705 : {
22706 :
22707 : /*
22708 : * (A1 A12)-1 ( X1 )
22709 : * A^-1*X* = ( ) *( )
22710 : * ( A2) ( X2 )
22711 : */
22712 0 : rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22713 0 : rmatrixgemm(s1, n, s2, -1.0, a, i1, j1+s1, 0, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state);
22714 0 : rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22715 : }
22716 0 : if( isupper&&optype!=0 )
22717 : {
22718 :
22719 : /*
22720 : * (A1' )-1 ( X1 )
22721 : * A^-1*X = ( ) *( )
22722 : * (A12' A2') ( X2 )
22723 : */
22724 0 : rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22725 0 : rmatrixgemm(s2, n, s1, -1.0, a, i1, j1+s1, optype, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state);
22726 0 : rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22727 : }
22728 0 : if( !isupper&&optype==0 )
22729 : {
22730 :
22731 : /*
22732 : * (A1 )-1 ( X1 )
22733 : * A^-1*X = ( ) *( )
22734 : * (A21 A2) ( X2 )
22735 : */
22736 0 : rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22737 0 : rmatrixgemm(s2, n, s1, -1.0, a, i1+s1, j1, 0, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state);
22738 0 : rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22739 : }
22740 0 : if( !isupper&&optype!=0 )
22741 : {
22742 :
22743 : /*
22744 : * (A1' A21')-1 ( X1 )
22745 : * A^-1*X = ( ) *( )
22746 : * ( A2') ( X2 )
22747 : */
22748 0 : rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state);
22749 0 : rmatrixgemm(s1, n, s2, -1.0, a, i1+s1, j1, optype, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state);
22750 0 : rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state);
22751 : }
22752 : }
22753 : }
22754 :
22755 :
22756 : /*************************************************************************
22757 : Serial stub for GPL edition.
22758 : *************************************************************************/
22759 0 : ae_bool _trypexec_rmatrixlefttrsm(ae_int_t m,
22760 : ae_int_t n,
22761 : /* Real */ ae_matrix* a,
22762 : ae_int_t i1,
22763 : ae_int_t j1,
22764 : ae_bool isupper,
22765 : ae_bool isunit,
22766 : ae_int_t optype,
22767 : /* Real */ ae_matrix* x,
22768 : ae_int_t i2,
22769 : ae_int_t j2,
22770 : ae_state *_state)
22771 : {
22772 0 : return ae_false;
22773 : }
22774 :
22775 :
22776 : /*************************************************************************
22777 : This subroutine calculates C=alpha*A*A^H+beta*C or C=alpha*A^H*A+beta*C
22778 : where:
22779 : * C is NxN Hermitian matrix given by its upper/lower triangle
22780 : * A is NxK matrix when A*A^H is calculated, KxN matrix otherwise
22781 :
22782 : Additional info:
22783 : * multiplication result replaces C. If Beta=0, C elements are not used in
22784 : calculations (not multiplied by zero - just not referenced)
22785 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
22786 : * if both Beta and Alpha are zero, C is filled by zeros.
22787 :
22788 : ! COMMERCIAL EDITION OF ALGLIB:
22789 : !
22790 : ! Commercial Edition of ALGLIB includes following important improvements
22791 : ! of this function:
22792 : ! * high-performance native backend with same C# interface (C# version)
22793 : ! * multithreading support (C++ and C# versions)
22794 : ! * hardware vendor (Intel) implementations of linear algebra primitives
22795 : ! (C++ and C# versions, x86/x64 platform)
22796 : !
22797 : ! We recommend you to read 'Working with commercial version' section of
22798 : ! ALGLIB Reference Manual in order to find out how to use performance-
22799 : ! related features provided by commercial edition of ALGLIB.
22800 :
22801 : INPUT PARAMETERS
22802 : N - matrix size, N>=0
22803 : K - matrix size, K>=0
22804 : Alpha - coefficient
22805 : A - matrix
22806 : IA - submatrix offset (row index)
22807 : JA - submatrix offset (column index)
22808 : OpTypeA - multiplication type:
22809 : * 0 - A*A^H is calculated
22810 : * 2 - A^H*A is calculated
22811 : Beta - coefficient
22812 : C - preallocated input/output matrix
22813 : IC - submatrix offset (row index)
22814 : JC - submatrix offset (column index)
22815 : IsUpper - whether upper or lower triangle of C is updated;
22816 : this function updates only one half of C, leaving
22817 : other half unchanged (not referenced at all).
22818 :
22819 : -- ALGLIB routine --
22820 : 16.12.2009-22.01.2018
22821 : Bochkanov Sergey
22822 : *************************************************************************/
22823 0 : void cmatrixherk(ae_int_t n,
22824 : ae_int_t k,
22825 : double alpha,
22826 : /* Complex */ ae_matrix* a,
22827 : ae_int_t ia,
22828 : ae_int_t ja,
22829 : ae_int_t optypea,
22830 : double beta,
22831 : /* Complex */ ae_matrix* c,
22832 : ae_int_t ic,
22833 : ae_int_t jc,
22834 : ae_bool isupper,
22835 : ae_state *_state)
22836 : {
22837 : ae_int_t s1;
22838 : ae_int_t s2;
22839 : ae_int_t tsa;
22840 : ae_int_t tsb;
22841 : ae_int_t tscur;
22842 :
22843 :
22844 0 : tsa = matrixtilesizea(_state)/2;
22845 0 : tsb = matrixtilesizeb(_state);
22846 0 : tscur = tsb;
22847 0 : if( imax2(n, k, _state)<=tsb )
22848 : {
22849 0 : tscur = tsa;
22850 : }
22851 0 : ae_assert(tscur>=1, "CMatrixHERK: integrity check failed", _state);
22852 :
22853 : /*
22854 : * Decide whether it is feasible to activate multithreading
22855 : */
22856 0 : if( n>=2*tsb&&ae_fp_greater_eq(8*rmul3((double)(k), (double)(n), (double)(n), _state)/2,smpactivationlevel(_state)) )
22857 : {
22858 0 : if( _trypexec_cmatrixherk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state) )
22859 : {
22860 0 : return;
22861 : }
22862 : }
22863 :
22864 : /*
22865 : * Use MKL or ALGLIB basecase code
22866 : */
22867 0 : if( imax2(n, k, _state)<=tsb )
22868 : {
22869 0 : if( cmatrixherkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) )
22870 : {
22871 0 : return;
22872 : }
22873 : }
22874 0 : if( imax2(n, k, _state)<=tsa )
22875 : {
22876 0 : ablas_cmatrixherk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22877 0 : return;
22878 : }
22879 :
22880 : /*
22881 : * Recursive division of the problem
22882 : */
22883 0 : if( k>=n )
22884 : {
22885 :
22886 : /*
22887 : * Split K
22888 : */
22889 0 : tiledsplit(k, tscur, &s1, &s2, _state);
22890 0 : if( optypea==0 )
22891 : {
22892 0 : cmatrixherk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22893 0 : cmatrixherk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state);
22894 : }
22895 : else
22896 : {
22897 0 : cmatrixherk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22898 0 : cmatrixherk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state);
22899 : }
22900 : }
22901 : else
22902 : {
22903 :
22904 : /*
22905 : * Split N
22906 : */
22907 0 : tiledsplit(n, tscur, &s1, &s2, _state);
22908 0 : if( optypea==0&&isupper )
22909 : {
22910 0 : cmatrixherk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22911 0 : cmatrixherk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
22912 0 : cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 0, a, ia+s1, ja, 2, ae_complex_from_d(beta), c, ic, jc+s1, _state);
22913 : }
22914 0 : if( optypea==0&&!isupper )
22915 : {
22916 0 : cmatrixherk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22917 0 : cmatrixherk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
22918 0 : cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia+s1, ja, 0, a, ia, ja, 2, ae_complex_from_d(beta), c, ic+s1, jc, _state);
22919 : }
22920 0 : if( optypea!=0&&isupper )
22921 : {
22922 0 : cmatrixherk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22923 0 : cmatrixherk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
22924 0 : cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 2, a, ia, ja+s1, 0, ae_complex_from_d(beta), c, ic, jc+s1, _state);
22925 : }
22926 0 : if( optypea!=0&&!isupper )
22927 : {
22928 0 : cmatrixherk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
22929 0 : cmatrixherk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
22930 0 : cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia, ja+s1, 2, a, ia, ja, 0, ae_complex_from_d(beta), c, ic+s1, jc, _state);
22931 : }
22932 : }
22933 : }
22934 :
22935 :
22936 : /*************************************************************************
22937 : Serial stub for GPL edition.
22938 : *************************************************************************/
22939 0 : ae_bool _trypexec_cmatrixherk(ae_int_t n,
22940 : ae_int_t k,
22941 : double alpha,
22942 : /* Complex */ ae_matrix* a,
22943 : ae_int_t ia,
22944 : ae_int_t ja,
22945 : ae_int_t optypea,
22946 : double beta,
22947 : /* Complex */ ae_matrix* c,
22948 : ae_int_t ic,
22949 : ae_int_t jc,
22950 : ae_bool isupper,
22951 : ae_state *_state)
22952 : {
22953 0 : return ae_false;
22954 : }
22955 :
22956 :
22957 : /*************************************************************************
22958 : This subroutine calculates C=alpha*A*A^T+beta*C or C=alpha*A^T*A+beta*C
22959 : where:
22960 : * C is NxN symmetric matrix given by its upper/lower triangle
22961 : * A is NxK matrix when A*A^T is calculated, KxN matrix otherwise
22962 :
22963 : Additional info:
22964 : * multiplication result replaces C. If Beta=0, C elements are not used in
22965 : calculations (not multiplied by zero - just not referenced)
22966 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
22967 : * if both Beta and Alpha are zero, C is filled by zeros.
22968 :
22969 : ! COMMERCIAL EDITION OF ALGLIB:
22970 : !
22971 : ! Commercial Edition of ALGLIB includes following important improvements
22972 : ! of this function:
22973 : ! * high-performance native backend with same C# interface (C# version)
22974 : ! * multithreading support (C++ and C# versions)
22975 : ! * hardware vendor (Intel) implementations of linear algebra primitives
22976 : ! (C++ and C# versions, x86/x64 platform)
22977 : !
22978 : ! We recommend you to read 'Working with commercial version' section of
22979 : ! ALGLIB Reference Manual in order to find out how to use performance-
22980 : ! related features provided by commercial edition of ALGLIB.
22981 :
22982 : INPUT PARAMETERS
22983 : N - matrix size, N>=0
22984 : K - matrix size, K>=0
22985 : Alpha - coefficient
22986 : A - matrix
22987 : IA - submatrix offset (row index)
22988 : JA - submatrix offset (column index)
22989 : OpTypeA - multiplication type:
22990 : * 0 - A*A^T is calculated
22991 : * 2 - A^T*A is calculated
22992 : Beta - coefficient
22993 : C - preallocated input/output matrix
22994 : IC - submatrix offset (row index)
22995 : JC - submatrix offset (column index)
22996 : IsUpper - whether C is upper triangular or lower triangular
22997 :
22998 : -- ALGLIB routine --
22999 : 16.12.2009-22.01.2018
23000 : Bochkanov Sergey
23001 : *************************************************************************/
23002 0 : void rmatrixsyrk(ae_int_t n,
23003 : ae_int_t k,
23004 : double alpha,
23005 : /* Real */ ae_matrix* a,
23006 : ae_int_t ia,
23007 : ae_int_t ja,
23008 : ae_int_t optypea,
23009 : double beta,
23010 : /* Real */ ae_matrix* c,
23011 : ae_int_t ic,
23012 : ae_int_t jc,
23013 : ae_bool isupper,
23014 : ae_state *_state)
23015 : {
23016 : ae_int_t s1;
23017 : ae_int_t s2;
23018 : ae_int_t tsa;
23019 : ae_int_t tsb;
23020 : ae_int_t tscur;
23021 :
23022 :
23023 0 : tsa = matrixtilesizea(_state);
23024 0 : tsb = matrixtilesizeb(_state);
23025 0 : tscur = tsb;
23026 0 : if( imax2(n, k, _state)<=tsb )
23027 : {
23028 0 : tscur = tsa;
23029 : }
23030 0 : ae_assert(tscur>=1, "RMatrixSYRK: integrity check failed", _state);
23031 :
23032 : /*
23033 : * Decide whether it is feasible to activate multithreading
23034 : */
23035 0 : if( n>=2*tsb&&ae_fp_greater_eq(2*rmul3((double)(k), (double)(n), (double)(n), _state)/2,smpactivationlevel(_state)) )
23036 : {
23037 0 : if( _trypexec_rmatrixsyrk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state) )
23038 : {
23039 0 : return;
23040 : }
23041 : }
23042 :
23043 : /*
23044 : * Use MKL or generic basecase code
23045 : */
23046 0 : if( imax2(n, k, _state)<=tsb )
23047 : {
23048 0 : if( rmatrixsyrkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) )
23049 : {
23050 0 : return;
23051 : }
23052 : }
23053 0 : if( imax2(n, k, _state)<=tsa )
23054 : {
23055 0 : ablas_rmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23056 0 : return;
23057 : }
23058 :
23059 : /*
23060 : * Recursive subdivision of the problem
23061 : */
23062 0 : if( k>=n )
23063 : {
23064 :
23065 : /*
23066 : * Split K
23067 : */
23068 0 : tiledsplit(k, tscur, &s1, &s2, _state);
23069 0 : if( optypea==0 )
23070 : {
23071 0 : rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23072 0 : rmatrixsyrk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state);
23073 : }
23074 : else
23075 : {
23076 0 : rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23077 0 : rmatrixsyrk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state);
23078 : }
23079 : }
23080 : else
23081 : {
23082 :
23083 : /*
23084 : * Split N
23085 : */
23086 0 : tiledsplit(n, tscur, &s1, &s2, _state);
23087 0 : if( optypea==0&&isupper )
23088 : {
23089 0 : rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23090 0 : rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
23091 0 : rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 0, a, ia+s1, ja, 1, beta, c, ic, jc+s1, _state);
23092 : }
23093 0 : if( optypea==0&&!isupper )
23094 : {
23095 0 : rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23096 0 : rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
23097 0 : rmatrixgemm(s2, s1, k, alpha, a, ia+s1, ja, 0, a, ia, ja, 1, beta, c, ic+s1, jc, _state);
23098 : }
23099 0 : if( optypea!=0&&isupper )
23100 : {
23101 0 : rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23102 0 : rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
23103 0 : rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 1, a, ia, ja+s1, 0, beta, c, ic, jc+s1, _state);
23104 : }
23105 0 : if( optypea!=0&&!isupper )
23106 : {
23107 0 : rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23108 0 : rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state);
23109 0 : rmatrixgemm(s2, s1, k, alpha, a, ia, ja+s1, 1, a, ia, ja, 0, beta, c, ic+s1, jc, _state);
23110 : }
23111 : }
23112 : }
23113 :
23114 :
23115 : /*************************************************************************
23116 : Serial stub for GPL edition.
23117 : *************************************************************************/
23118 0 : ae_bool _trypexec_rmatrixsyrk(ae_int_t n,
23119 : ae_int_t k,
23120 : double alpha,
23121 : /* Real */ ae_matrix* a,
23122 : ae_int_t ia,
23123 : ae_int_t ja,
23124 : ae_int_t optypea,
23125 : double beta,
23126 : /* Real */ ae_matrix* c,
23127 : ae_int_t ic,
23128 : ae_int_t jc,
23129 : ae_bool isupper,
23130 : ae_state *_state)
23131 : {
23132 0 : return ae_false;
23133 : }
23134 :
23135 :
23136 : /*************************************************************************
23137 : This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:
23138 : * C is MxN general matrix
23139 : * op1(A) is MxK matrix
23140 : * op2(B) is KxN matrix
23141 : * "op" may be identity transformation, transposition, conjugate transposition
23142 :
23143 : Additional info:
23144 : * cache-oblivious algorithm is used.
23145 : * multiplication result replaces C. If Beta=0, C elements are not used in
23146 : calculations (not multiplied by zero - just not referenced)
23147 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
23148 : * if both Beta and Alpha are zero, C is filled by zeros.
23149 :
23150 : ! COMMERCIAL EDITION OF ALGLIB:
23151 : !
23152 : ! Commercial Edition of ALGLIB includes following important improvements
23153 : ! of this function:
23154 : ! * high-performance native backend with same C# interface (C# version)
23155 : ! * multithreading support (C++ and C# versions)
23156 : ! * hardware vendor (Intel) implementations of linear algebra primitives
23157 : ! (C++ and C# versions, x86/x64 platform)
23158 : !
23159 : ! We recommend you to read 'Working with commercial version' section of
23160 : ! ALGLIB Reference Manual in order to find out how to use performance-
23161 : ! related features provided by commercial edition of ALGLIB.
23162 :
23163 : IMPORTANT:
23164 :
23165 : This function does NOT preallocate output matrix C, it MUST be preallocated
23166 : by caller prior to calling this function. In case C does not have enough
23167 : space to store result, exception will be generated.
23168 :
23169 : INPUT PARAMETERS
23170 : M - matrix size, M>0
23171 : N - matrix size, N>0
23172 : K - matrix size, K>0
23173 : Alpha - coefficient
23174 : A - matrix
23175 : IA - submatrix offset
23176 : JA - submatrix offset
23177 : OpTypeA - transformation type:
23178 : * 0 - no transformation
23179 : * 1 - transposition
23180 : * 2 - conjugate transposition
23181 : B - matrix
23182 : IB - submatrix offset
23183 : JB - submatrix offset
23184 : OpTypeB - transformation type:
23185 : * 0 - no transformation
23186 : * 1 - transposition
23187 : * 2 - conjugate transposition
23188 : Beta - coefficient
23189 : C - matrix (PREALLOCATED, large enough to store result)
23190 : IC - submatrix offset
23191 : JC - submatrix offset
23192 :
23193 : -- ALGLIB routine --
23194 : 2009-2019
23195 : Bochkanov Sergey
23196 : *************************************************************************/
23197 0 : void cmatrixgemm(ae_int_t m,
23198 : ae_int_t n,
23199 : ae_int_t k,
23200 : ae_complex alpha,
23201 : /* Complex */ ae_matrix* a,
23202 : ae_int_t ia,
23203 : ae_int_t ja,
23204 : ae_int_t optypea,
23205 : /* Complex */ ae_matrix* b,
23206 : ae_int_t ib,
23207 : ae_int_t jb,
23208 : ae_int_t optypeb,
23209 : ae_complex beta,
23210 : /* Complex */ ae_matrix* c,
23211 : ae_int_t ic,
23212 : ae_int_t jc,
23213 : ae_state *_state)
23214 : {
23215 : ae_int_t ts;
23216 :
23217 :
23218 0 : ts = matrixtilesizeb(_state);
23219 :
23220 : /*
23221 : * Check input sizes for correctness
23222 : */
23223 0 : ae_assert((optypea==0||optypea==1)||optypea==2, "CMatrixGEMM: incorrect OpTypeA (must be 0 or 1 or 2)", _state);
23224 0 : ae_assert((optypeb==0||optypeb==1)||optypeb==2, "CMatrixGEMM: incorrect OpTypeB (must be 0 or 1 or 2)", _state);
23225 0 : ae_assert(ic+m<=c->rows, "CMatrixGEMM: incorect size of output matrix C", _state);
23226 0 : ae_assert(jc+n<=c->cols, "CMatrixGEMM: incorect size of output matrix C", _state);
23227 :
23228 : /*
23229 : * Decide whether it is feasible to activate multithreading
23230 : */
23231 0 : if( (m>=2*ts||n>=2*ts)&&ae_fp_greater_eq(8*rmul3((double)(m), (double)(n), (double)(k), _state),smpactivationlevel(_state)) )
23232 : {
23233 0 : if( _trypexec_cmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state) )
23234 : {
23235 0 : return;
23236 : }
23237 : }
23238 :
23239 : /*
23240 : * Start actual work
23241 : */
23242 0 : ablas_cmatrixgemmrec(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
23243 : }
23244 :
23245 :
23246 : /*************************************************************************
23247 : Serial stub for GPL edition.
23248 : *************************************************************************/
23249 0 : ae_bool _trypexec_cmatrixgemm(ae_int_t m,
23250 : ae_int_t n,
23251 : ae_int_t k,
23252 : ae_complex alpha,
23253 : /* Complex */ ae_matrix* a,
23254 : ae_int_t ia,
23255 : ae_int_t ja,
23256 : ae_int_t optypea,
23257 : /* Complex */ ae_matrix* b,
23258 : ae_int_t ib,
23259 : ae_int_t jb,
23260 : ae_int_t optypeb,
23261 : ae_complex beta,
23262 : /* Complex */ ae_matrix* c,
23263 : ae_int_t ic,
23264 : ae_int_t jc,
23265 : ae_state *_state)
23266 : {
23267 0 : return ae_false;
23268 : }
23269 :
23270 :
23271 : /*************************************************************************
23272 : This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where:
23273 : * C is MxN general matrix
23274 : * op1(A) is MxK matrix
23275 : * op2(B) is KxN matrix
23276 : * "op" may be identity transformation, transposition
23277 :
23278 : Additional info:
23279 : * cache-oblivious algorithm is used.
23280 : * multiplication result replaces C. If Beta=0, C elements are not used in
23281 : calculations (not multiplied by zero - just not referenced)
23282 : * if Alpha=0, A is not used (not multiplied by zero - just not referenced)
23283 : * if both Beta and Alpha are zero, C is filled by zeros.
23284 :
23285 : ! COMMERCIAL EDITION OF ALGLIB:
23286 : !
23287 : ! Commercial Edition of ALGLIB includes following important improvements
23288 : ! of this function:
23289 : ! * high-performance native backend with same C# interface (C# version)
23290 : ! * multithreading support (C++ and C# versions)
23291 : ! * hardware vendor (Intel) implementations of linear algebra primitives
23292 : ! (C++ and C# versions, x86/x64 platform)
23293 : !
23294 : ! We recommend you to read 'Working with commercial version' section of
23295 : ! ALGLIB Reference Manual in order to find out how to use performance-
23296 : ! related features provided by commercial edition of ALGLIB.
23297 :
23298 : IMPORTANT:
23299 :
23300 : This function does NOT preallocate output matrix C, it MUST be preallocated
23301 : by caller prior to calling this function. In case C does not have enough
23302 : space to store result, exception will be generated.
23303 :
23304 : INPUT PARAMETERS
23305 : M - matrix size, M>0
23306 : N - matrix size, N>0
23307 : K - matrix size, K>0
23308 : Alpha - coefficient
23309 : A - matrix
23310 : IA - submatrix offset
23311 : JA - submatrix offset
23312 : OpTypeA - transformation type:
23313 : * 0 - no transformation
23314 : * 1 - transposition
23315 : B - matrix
23316 : IB - submatrix offset
23317 : JB - submatrix offset
23318 : OpTypeB - transformation type:
23319 : * 0 - no transformation
23320 : * 1 - transposition
23321 : Beta - coefficient
23322 : C - PREALLOCATED output matrix, large enough to store result
23323 : IC - submatrix offset
23324 : JC - submatrix offset
23325 :
23326 : -- ALGLIB routine --
23327 : 2009-2019
23328 : Bochkanov Sergey
23329 : *************************************************************************/
23330 0 : void rmatrixgemm(ae_int_t m,
23331 : ae_int_t n,
23332 : ae_int_t k,
23333 : double alpha,
23334 : /* Real */ ae_matrix* a,
23335 : ae_int_t ia,
23336 : ae_int_t ja,
23337 : ae_int_t optypea,
23338 : /* Real */ ae_matrix* b,
23339 : ae_int_t ib,
23340 : ae_int_t jb,
23341 : ae_int_t optypeb,
23342 : double beta,
23343 : /* Real */ ae_matrix* c,
23344 : ae_int_t ic,
23345 : ae_int_t jc,
23346 : ae_state *_state)
23347 : {
23348 : ae_int_t ts;
23349 :
23350 :
23351 0 : ts = matrixtilesizeb(_state);
23352 :
23353 : /*
23354 : * Check input sizes for correctness
23355 : */
23356 0 : ae_assert(optypea==0||optypea==1, "RMatrixGEMM: incorrect OpTypeA (must be 0 or 1)", _state);
23357 0 : ae_assert(optypeb==0||optypeb==1, "RMatrixGEMM: incorrect OpTypeB (must be 0 or 1)", _state);
23358 0 : ae_assert(ic+m<=c->rows, "RMatrixGEMM: incorect size of output matrix C", _state);
23359 0 : ae_assert(jc+n<=c->cols, "RMatrixGEMM: incorect size of output matrix C", _state);
23360 :
23361 : /*
23362 : * Decide whether it is feasible to activate multithreading
23363 : */
23364 0 : if( (m>=2*ts||n>=2*ts)&&ae_fp_greater_eq(2*rmul3((double)(m), (double)(n), (double)(k), _state),smpactivationlevel(_state)) )
23365 : {
23366 0 : if( _trypexec_rmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state) )
23367 : {
23368 0 : return;
23369 : }
23370 : }
23371 :
23372 : /*
23373 : * Start actual work
23374 : */
23375 0 : ablas_rmatrixgemmrec(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
23376 : }
23377 :
23378 :
23379 : /*************************************************************************
23380 : Serial stub for GPL edition.
23381 : *************************************************************************/
23382 0 : ae_bool _trypexec_rmatrixgemm(ae_int_t m,
23383 : ae_int_t n,
23384 : ae_int_t k,
23385 : double alpha,
23386 : /* Real */ ae_matrix* a,
23387 : ae_int_t ia,
23388 : ae_int_t ja,
23389 : ae_int_t optypea,
23390 : /* Real */ ae_matrix* b,
23391 : ae_int_t ib,
23392 : ae_int_t jb,
23393 : ae_int_t optypeb,
23394 : double beta,
23395 : /* Real */ ae_matrix* c,
23396 : ae_int_t ic,
23397 : ae_int_t jc,
23398 : ae_state *_state)
23399 : {
23400 0 : return ae_false;
23401 : }
23402 :
23403 :
23404 : /*************************************************************************
23405 : This subroutine is an older version of CMatrixHERK(), one with wrong name
23406 : (it is HErmitian update, not SYmmetric). It is left here for backward
23407 : compatibility.
23408 :
23409 : -- ALGLIB routine --
23410 : 16.12.2009
23411 : Bochkanov Sergey
23412 : *************************************************************************/
23413 0 : void cmatrixsyrk(ae_int_t n,
23414 : ae_int_t k,
23415 : double alpha,
23416 : /* Complex */ ae_matrix* a,
23417 : ae_int_t ia,
23418 : ae_int_t ja,
23419 : ae_int_t optypea,
23420 : double beta,
23421 : /* Complex */ ae_matrix* c,
23422 : ae_int_t ic,
23423 : ae_int_t jc,
23424 : ae_bool isupper,
23425 : ae_state *_state)
23426 : {
23427 :
23428 :
23429 0 : cmatrixherk(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state);
23430 0 : }
23431 :
23432 :
23433 : /*************************************************************************
23434 : Performs one step of stable Gram-Schmidt process on vector X[] using
23435 : set of orthonormal rows Q[].
23436 :
23437 : INPUT PARAMETERS:
23438 : Q - array[M,N], matrix with orthonormal rows
23439 : M, N - rows/cols
23440 : X - array[N], vector to process
23441 : NeedQX - whether we need QX or not
23442 :
23443 : OUTPUT PARAMETERS:
23444 : X - stores X - Q'*(Q*X)
23445 : QX - if NeedQX is True, array[M] filled with elements of Q*X,
23446 : reallocated if length is less than M.
23447 : Ignored otherwise.
23448 :
23449 : -- ALGLIB --
23450 : Copyright 20.01.2020 by Bochkanov Sergey
23451 : *************************************************************************/
23452 0 : void rowwisegramschmidt(/* Real */ ae_matrix* q,
23453 : ae_int_t m,
23454 : ae_int_t n,
23455 : /* Real */ ae_vector* x,
23456 : /* Real */ ae_vector* qx,
23457 : ae_bool needqx,
23458 : ae_state *_state)
23459 : {
23460 : ae_int_t i;
23461 : double v;
23462 :
23463 :
23464 0 : if( needqx )
23465 : {
23466 0 : rvectorsetlengthatleast(qx, m, _state);
23467 : }
23468 0 : for(i=0; i<=m-1; i++)
23469 : {
23470 0 : v = rdotvr(n, x, q, i, _state);
23471 0 : raddrv(n, -v, q, i, x, _state);
23472 0 : if( needqx )
23473 : {
23474 0 : qx->ptr.p_double[i] = v;
23475 : }
23476 : }
23477 0 : }
23478 :
23479 :
23480 : /*************************************************************************
23481 : Complex ABLASSplitLength
23482 :
23483 : -- ALGLIB routine --
23484 : 15.12.2009
23485 : Bochkanov Sergey
23486 : *************************************************************************/
23487 0 : static void ablas_ablasinternalsplitlength(ae_int_t n,
23488 : ae_int_t nb,
23489 : ae_int_t* n1,
23490 : ae_int_t* n2,
23491 : ae_state *_state)
23492 : {
23493 : ae_int_t r;
23494 :
23495 0 : *n1 = 0;
23496 0 : *n2 = 0;
23497 :
23498 0 : if( n<=nb )
23499 : {
23500 :
23501 : /*
23502 : * Block size, no further splitting
23503 : */
23504 0 : *n1 = n;
23505 0 : *n2 = 0;
23506 : }
23507 : else
23508 : {
23509 :
23510 : /*
23511 : * Greater than block size
23512 : */
23513 0 : if( n%nb!=0 )
23514 : {
23515 :
23516 : /*
23517 : * Split remainder
23518 : */
23519 0 : *n2 = n%nb;
23520 0 : *n1 = n-(*n2);
23521 : }
23522 : else
23523 : {
23524 :
23525 : /*
23526 : * Split on block boundaries
23527 : */
23528 0 : *n2 = n/2;
23529 0 : *n1 = n-(*n2);
23530 0 : if( *n1%nb==0 )
23531 : {
23532 0 : return;
23533 : }
23534 0 : r = nb-*n1%nb;
23535 0 : *n1 = *n1+r;
23536 0 : *n2 = *n2-r;
23537 : }
23538 : }
23539 : }
23540 :
23541 :
23542 : /*************************************************************************
23543 : Level 2 variant of CMatrixRightTRSM
23544 : *************************************************************************/
23545 0 : static void ablas_cmatrixrighttrsm2(ae_int_t m,
23546 : ae_int_t n,
23547 : /* Complex */ ae_matrix* a,
23548 : ae_int_t i1,
23549 : ae_int_t j1,
23550 : ae_bool isupper,
23551 : ae_bool isunit,
23552 : ae_int_t optype,
23553 : /* Complex */ ae_matrix* x,
23554 : ae_int_t i2,
23555 : ae_int_t j2,
23556 : ae_state *_state)
23557 : {
23558 : ae_int_t i;
23559 : ae_int_t j;
23560 : ae_complex vc;
23561 : ae_complex vd;
23562 :
23563 :
23564 :
23565 : /*
23566 : * Special case
23567 : */
23568 0 : if( n*m==0 )
23569 : {
23570 0 : return;
23571 : }
23572 :
23573 : /*
23574 : * Try to call fast TRSM
23575 : */
23576 0 : if( cmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
23577 : {
23578 0 : return;
23579 : }
23580 :
23581 : /*
23582 : * General case
23583 : */
23584 0 : if( isupper )
23585 : {
23586 :
23587 : /*
23588 : * Upper triangular matrix
23589 : */
23590 0 : if( optype==0 )
23591 : {
23592 :
23593 : /*
23594 : * X*A^(-1)
23595 : */
23596 0 : for(i=0; i<=m-1; i++)
23597 : {
23598 0 : for(j=0; j<=n-1; j++)
23599 : {
23600 0 : if( isunit )
23601 : {
23602 0 : vd = ae_complex_from_i(1);
23603 : }
23604 : else
23605 : {
23606 0 : vd = a->ptr.pp_complex[i1+j][j1+j];
23607 : }
23608 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd);
23609 0 : if( j<n-1 )
23610 : {
23611 0 : vc = x->ptr.pp_complex[i2+i][j2+j];
23612 0 : ae_v_csubc(&x->ptr.pp_complex[i2+i][j2+j+1], 1, &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1), vc);
23613 : }
23614 : }
23615 : }
23616 0 : return;
23617 : }
23618 0 : if( optype==1 )
23619 : {
23620 :
23621 : /*
23622 : * X*A^(-T)
23623 : */
23624 0 : for(i=0; i<=m-1; i++)
23625 : {
23626 0 : for(j=n-1; j>=0; j--)
23627 : {
23628 0 : vc = ae_complex_from_i(0);
23629 0 : vd = ae_complex_from_i(1);
23630 0 : if( j<n-1 )
23631 : {
23632 0 : vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1));
23633 : }
23634 0 : if( !isunit )
23635 : {
23636 0 : vd = a->ptr.pp_complex[i1+j][j1+j];
23637 : }
23638 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd);
23639 : }
23640 : }
23641 0 : return;
23642 : }
23643 0 : if( optype==2 )
23644 : {
23645 :
23646 : /*
23647 : * X*A^(-H)
23648 : */
23649 0 : for(i=0; i<=m-1; i++)
23650 : {
23651 0 : for(j=n-1; j>=0; j--)
23652 : {
23653 0 : vc = ae_complex_from_i(0);
23654 0 : vd = ae_complex_from_i(1);
23655 0 : if( j<n-1 )
23656 : {
23657 0 : vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "Conj", ae_v_len(j2+j+1,j2+n-1));
23658 : }
23659 0 : if( !isunit )
23660 : {
23661 0 : vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state);
23662 : }
23663 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd);
23664 : }
23665 : }
23666 0 : return;
23667 : }
23668 : }
23669 : else
23670 : {
23671 :
23672 : /*
23673 : * Lower triangular matrix
23674 : */
23675 0 : if( optype==0 )
23676 : {
23677 :
23678 : /*
23679 : * X*A^(-1)
23680 : */
23681 0 : for(i=0; i<=m-1; i++)
23682 : {
23683 0 : for(j=n-1; j>=0; j--)
23684 : {
23685 0 : if( isunit )
23686 : {
23687 0 : vd = ae_complex_from_i(1);
23688 : }
23689 : else
23690 : {
23691 0 : vd = a->ptr.pp_complex[i1+j][j1+j];
23692 : }
23693 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd);
23694 0 : if( j>0 )
23695 : {
23696 0 : vc = x->ptr.pp_complex[i2+i][j2+j];
23697 0 : ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1), vc);
23698 : }
23699 : }
23700 : }
23701 0 : return;
23702 : }
23703 0 : if( optype==1 )
23704 : {
23705 :
23706 : /*
23707 : * X*A^(-T)
23708 : */
23709 0 : for(i=0; i<=m-1; i++)
23710 : {
23711 0 : for(j=0; j<=n-1; j++)
23712 : {
23713 0 : vc = ae_complex_from_i(0);
23714 0 : vd = ae_complex_from_i(1);
23715 0 : if( j>0 )
23716 : {
23717 0 : vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1));
23718 : }
23719 0 : if( !isunit )
23720 : {
23721 0 : vd = a->ptr.pp_complex[i1+j][j1+j];
23722 : }
23723 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd);
23724 : }
23725 : }
23726 0 : return;
23727 : }
23728 0 : if( optype==2 )
23729 : {
23730 :
23731 : /*
23732 : * X*A^(-H)
23733 : */
23734 0 : for(i=0; i<=m-1; i++)
23735 : {
23736 0 : for(j=0; j<=n-1; j++)
23737 : {
23738 0 : vc = ae_complex_from_i(0);
23739 0 : vd = ae_complex_from_i(1);
23740 0 : if( j>0 )
23741 : {
23742 0 : vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "Conj", ae_v_len(j2,j2+j-1));
23743 : }
23744 0 : if( !isunit )
23745 : {
23746 0 : vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state);
23747 : }
23748 0 : x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd);
23749 : }
23750 : }
23751 0 : return;
23752 : }
23753 : }
23754 : }
23755 :
23756 :
23757 : /*************************************************************************
23758 : Level-2 subroutine
23759 : *************************************************************************/
23760 0 : static void ablas_cmatrixlefttrsm2(ae_int_t m,
23761 : ae_int_t n,
23762 : /* Complex */ ae_matrix* a,
23763 : ae_int_t i1,
23764 : ae_int_t j1,
23765 : ae_bool isupper,
23766 : ae_bool isunit,
23767 : ae_int_t optype,
23768 : /* Complex */ ae_matrix* x,
23769 : ae_int_t i2,
23770 : ae_int_t j2,
23771 : ae_state *_state)
23772 : {
23773 : ae_int_t i;
23774 : ae_int_t j;
23775 : ae_complex vc;
23776 : ae_complex vd;
23777 :
23778 :
23779 :
23780 : /*
23781 : * Special case
23782 : */
23783 0 : if( n*m==0 )
23784 : {
23785 0 : return;
23786 : }
23787 :
23788 : /*
23789 : * Try to call fast TRSM
23790 : */
23791 0 : if( cmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
23792 : {
23793 0 : return;
23794 : }
23795 :
23796 : /*
23797 : * General case
23798 : */
23799 0 : if( isupper )
23800 : {
23801 :
23802 : /*
23803 : * Upper triangular matrix
23804 : */
23805 0 : if( optype==0 )
23806 : {
23807 :
23808 : /*
23809 : * A^(-1)*X
23810 : */
23811 0 : for(i=m-1; i>=0; i--)
23812 : {
23813 0 : for(j=i+1; j<=m-1; j++)
23814 : {
23815 0 : vc = a->ptr.pp_complex[i1+i][j1+j];
23816 0 : ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23817 : }
23818 0 : if( !isunit )
23819 : {
23820 0 : vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]);
23821 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23822 : }
23823 : }
23824 0 : return;
23825 : }
23826 0 : if( optype==1 )
23827 : {
23828 :
23829 : /*
23830 : * A^(-T)*X
23831 : */
23832 0 : for(i=0; i<=m-1; i++)
23833 : {
23834 0 : if( isunit )
23835 : {
23836 0 : vd = ae_complex_from_i(1);
23837 : }
23838 : else
23839 : {
23840 0 : vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]);
23841 : }
23842 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23843 0 : for(j=i+1; j<=m-1; j++)
23844 : {
23845 0 : vc = a->ptr.pp_complex[i1+i][j1+j];
23846 0 : ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23847 : }
23848 : }
23849 0 : return;
23850 : }
23851 0 : if( optype==2 )
23852 : {
23853 :
23854 : /*
23855 : * A^(-H)*X
23856 : */
23857 0 : for(i=0; i<=m-1; i++)
23858 : {
23859 0 : if( isunit )
23860 : {
23861 0 : vd = ae_complex_from_i(1);
23862 : }
23863 : else
23864 : {
23865 0 : vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state));
23866 : }
23867 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23868 0 : for(j=i+1; j<=m-1; j++)
23869 : {
23870 0 : vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state);
23871 0 : ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23872 : }
23873 : }
23874 0 : return;
23875 : }
23876 : }
23877 : else
23878 : {
23879 :
23880 : /*
23881 : * Lower triangular matrix
23882 : */
23883 0 : if( optype==0 )
23884 : {
23885 :
23886 : /*
23887 : * A^(-1)*X
23888 : */
23889 0 : for(i=0; i<=m-1; i++)
23890 : {
23891 0 : for(j=0; j<=i-1; j++)
23892 : {
23893 0 : vc = a->ptr.pp_complex[i1+i][j1+j];
23894 0 : ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23895 : }
23896 0 : if( isunit )
23897 : {
23898 0 : vd = ae_complex_from_i(1);
23899 : }
23900 : else
23901 : {
23902 0 : vd = ae_c_d_div(1,a->ptr.pp_complex[i1+j][j1+j]);
23903 : }
23904 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23905 : }
23906 0 : return;
23907 : }
23908 0 : if( optype==1 )
23909 : {
23910 :
23911 : /*
23912 : * A^(-T)*X
23913 : */
23914 0 : for(i=m-1; i>=0; i--)
23915 : {
23916 0 : if( isunit )
23917 : {
23918 0 : vd = ae_complex_from_i(1);
23919 : }
23920 : else
23921 : {
23922 0 : vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]);
23923 : }
23924 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23925 0 : for(j=i-1; j>=0; j--)
23926 : {
23927 0 : vc = a->ptr.pp_complex[i1+i][j1+j];
23928 0 : ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23929 : }
23930 : }
23931 0 : return;
23932 : }
23933 0 : if( optype==2 )
23934 : {
23935 :
23936 : /*
23937 : * A^(-H)*X
23938 : */
23939 0 : for(i=m-1; i>=0; i--)
23940 : {
23941 0 : if( isunit )
23942 : {
23943 0 : vd = ae_complex_from_i(1);
23944 : }
23945 : else
23946 : {
23947 0 : vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state));
23948 : }
23949 0 : ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
23950 0 : for(j=i-1; j>=0; j--)
23951 : {
23952 0 : vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state);
23953 0 : ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc);
23954 : }
23955 : }
23956 0 : return;
23957 : }
23958 : }
23959 : }
23960 :
23961 :
23962 : /*************************************************************************
23963 : Level 2 subroutine
23964 :
23965 : -- ALGLIB routine --
23966 : 15.12.2009
23967 : Bochkanov Sergey
23968 : *************************************************************************/
23969 0 : static void ablas_rmatrixrighttrsm2(ae_int_t m,
23970 : ae_int_t n,
23971 : /* Real */ ae_matrix* a,
23972 : ae_int_t i1,
23973 : ae_int_t j1,
23974 : ae_bool isupper,
23975 : ae_bool isunit,
23976 : ae_int_t optype,
23977 : /* Real */ ae_matrix* x,
23978 : ae_int_t i2,
23979 : ae_int_t j2,
23980 : ae_state *_state)
23981 : {
23982 : ae_int_t i;
23983 : ae_int_t j;
23984 : double vr;
23985 : double vd;
23986 :
23987 :
23988 :
23989 : /*
23990 : * Special case
23991 : */
23992 0 : if( n*m==0 )
23993 : {
23994 0 : return;
23995 : }
23996 :
23997 : /*
23998 : * Try to use "fast" code
23999 : */
24000 0 : if( rmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
24001 : {
24002 0 : return;
24003 : }
24004 :
24005 : /*
24006 : * General case
24007 : */
24008 0 : if( isupper )
24009 : {
24010 :
24011 : /*
24012 : * Upper triangular matrix
24013 : */
24014 0 : if( optype==0 )
24015 : {
24016 :
24017 : /*
24018 : * X*A^(-1)
24019 : */
24020 0 : for(i=0; i<=m-1; i++)
24021 : {
24022 0 : for(j=0; j<=n-1; j++)
24023 : {
24024 0 : if( isunit )
24025 : {
24026 0 : vd = (double)(1);
24027 : }
24028 : else
24029 : {
24030 0 : vd = a->ptr.pp_double[i1+j][j1+j];
24031 : }
24032 0 : x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd;
24033 0 : if( j<n-1 )
24034 : {
24035 0 : vr = x->ptr.pp_double[i2+i][j2+j];
24036 0 : ae_v_subd(&x->ptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1), vr);
24037 : }
24038 : }
24039 : }
24040 0 : return;
24041 : }
24042 0 : if( optype==1 )
24043 : {
24044 :
24045 : /*
24046 : * X*A^(-T)
24047 : */
24048 0 : for(i=0; i<=m-1; i++)
24049 : {
24050 0 : for(j=n-1; j>=0; j--)
24051 : {
24052 0 : vr = (double)(0);
24053 0 : vd = (double)(1);
24054 0 : if( j<n-1 )
24055 : {
24056 0 : vr = ae_v_dotproduct(&x->ptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1));
24057 : }
24058 0 : if( !isunit )
24059 : {
24060 0 : vd = a->ptr.pp_double[i1+j][j1+j];
24061 : }
24062 0 : x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd;
24063 : }
24064 : }
24065 0 : return;
24066 : }
24067 : }
24068 : else
24069 : {
24070 :
24071 : /*
24072 : * Lower triangular matrix
24073 : */
24074 0 : if( optype==0 )
24075 : {
24076 :
24077 : /*
24078 : * X*A^(-1)
24079 : */
24080 0 : for(i=0; i<=m-1; i++)
24081 : {
24082 0 : for(j=n-1; j>=0; j--)
24083 : {
24084 0 : if( isunit )
24085 : {
24086 0 : vd = (double)(1);
24087 : }
24088 : else
24089 : {
24090 0 : vd = a->ptr.pp_double[i1+j][j1+j];
24091 : }
24092 0 : x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd;
24093 0 : if( j>0 )
24094 : {
24095 0 : vr = x->ptr.pp_double[i2+i][j2+j];
24096 0 : ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1), vr);
24097 : }
24098 : }
24099 : }
24100 0 : return;
24101 : }
24102 0 : if( optype==1 )
24103 : {
24104 :
24105 : /*
24106 : * X*A^(-T)
24107 : */
24108 0 : for(i=0; i<=m-1; i++)
24109 : {
24110 0 : for(j=0; j<=n-1; j++)
24111 : {
24112 0 : vr = (double)(0);
24113 0 : vd = (double)(1);
24114 0 : if( j>0 )
24115 : {
24116 0 : vr = ae_v_dotproduct(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1));
24117 : }
24118 0 : if( !isunit )
24119 : {
24120 0 : vd = a->ptr.pp_double[i1+j][j1+j];
24121 : }
24122 0 : x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd;
24123 : }
24124 : }
24125 0 : return;
24126 : }
24127 : }
24128 : }
24129 :
24130 :
24131 : /*************************************************************************
24132 : Level 2 subroutine
24133 : *************************************************************************/
24134 0 : static void ablas_rmatrixlefttrsm2(ae_int_t m,
24135 : ae_int_t n,
24136 : /* Real */ ae_matrix* a,
24137 : ae_int_t i1,
24138 : ae_int_t j1,
24139 : ae_bool isupper,
24140 : ae_bool isunit,
24141 : ae_int_t optype,
24142 : /* Real */ ae_matrix* x,
24143 : ae_int_t i2,
24144 : ae_int_t j2,
24145 : ae_state *_state)
24146 : {
24147 : ae_int_t i;
24148 : ae_int_t j;
24149 : double vr;
24150 : double vd;
24151 :
24152 :
24153 :
24154 : /*
24155 : * Special case
24156 : */
24157 0 : if( n==0||m==0 )
24158 : {
24159 0 : return;
24160 : }
24161 :
24162 : /*
24163 : * Try fast code
24164 : */
24165 0 : if( rmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) )
24166 : {
24167 0 : return;
24168 : }
24169 :
24170 : /*
24171 : * General case
24172 : */
24173 0 : if( isupper )
24174 : {
24175 :
24176 : /*
24177 : * Upper triangular matrix
24178 : */
24179 0 : if( optype==0 )
24180 : {
24181 :
24182 : /*
24183 : * A^(-1)*X
24184 : */
24185 0 : for(i=m-1; i>=0; i--)
24186 : {
24187 0 : for(j=i+1; j<=m-1; j++)
24188 : {
24189 0 : vr = a->ptr.pp_double[i1+i][j1+j];
24190 0 : ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr);
24191 : }
24192 0 : if( !isunit )
24193 : {
24194 0 : vd = 1/a->ptr.pp_double[i1+i][j1+i];
24195 0 : ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
24196 : }
24197 : }
24198 0 : return;
24199 : }
24200 0 : if( optype==1 )
24201 : {
24202 :
24203 : /*
24204 : * A^(-T)*X
24205 : */
24206 0 : for(i=0; i<=m-1; i++)
24207 : {
24208 0 : if( isunit )
24209 : {
24210 0 : vd = (double)(1);
24211 : }
24212 : else
24213 : {
24214 0 : vd = 1/a->ptr.pp_double[i1+i][j1+i];
24215 : }
24216 0 : ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
24217 0 : for(j=i+1; j<=m-1; j++)
24218 : {
24219 0 : vr = a->ptr.pp_double[i1+i][j1+j];
24220 0 : ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr);
24221 : }
24222 : }
24223 0 : return;
24224 : }
24225 : }
24226 : else
24227 : {
24228 :
24229 : /*
24230 : * Lower triangular matrix
24231 : */
24232 0 : if( optype==0 )
24233 : {
24234 :
24235 : /*
24236 : * A^(-1)*X
24237 : */
24238 0 : for(i=0; i<=m-1; i++)
24239 : {
24240 0 : for(j=0; j<=i-1; j++)
24241 : {
24242 0 : vr = a->ptr.pp_double[i1+i][j1+j];
24243 0 : ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr);
24244 : }
24245 0 : if( isunit )
24246 : {
24247 0 : vd = (double)(1);
24248 : }
24249 : else
24250 : {
24251 0 : vd = 1/a->ptr.pp_double[i1+j][j1+j];
24252 : }
24253 0 : ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
24254 : }
24255 0 : return;
24256 : }
24257 0 : if( optype==1 )
24258 : {
24259 :
24260 : /*
24261 : * A^(-T)*X
24262 : */
24263 0 : for(i=m-1; i>=0; i--)
24264 : {
24265 0 : if( isunit )
24266 : {
24267 0 : vd = (double)(1);
24268 : }
24269 : else
24270 : {
24271 0 : vd = 1/a->ptr.pp_double[i1+i][j1+i];
24272 : }
24273 0 : ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd);
24274 0 : for(j=i-1; j>=0; j--)
24275 : {
24276 0 : vr = a->ptr.pp_double[i1+i][j1+j];
24277 0 : ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr);
24278 : }
24279 : }
24280 0 : return;
24281 : }
24282 : }
24283 : }
24284 :
24285 :
24286 : /*************************************************************************
24287 : Level 2 subroutine
24288 : *************************************************************************/
24289 0 : static void ablas_cmatrixherk2(ae_int_t n,
24290 : ae_int_t k,
24291 : double alpha,
24292 : /* Complex */ ae_matrix* a,
24293 : ae_int_t ia,
24294 : ae_int_t ja,
24295 : ae_int_t optypea,
24296 : double beta,
24297 : /* Complex */ ae_matrix* c,
24298 : ae_int_t ic,
24299 : ae_int_t jc,
24300 : ae_bool isupper,
24301 : ae_state *_state)
24302 : {
24303 : ae_int_t i;
24304 : ae_int_t j;
24305 : ae_int_t j1;
24306 : ae_int_t j2;
24307 : ae_complex v;
24308 :
24309 :
24310 :
24311 : /*
24312 : * Fast exit (nothing to be done)
24313 : */
24314 0 : if( (ae_fp_eq(alpha,(double)(0))||k==0)&&ae_fp_eq(beta,(double)(1)) )
24315 : {
24316 0 : return;
24317 : }
24318 :
24319 : /*
24320 : * Try to call fast SYRK
24321 : */
24322 0 : if( cmatrixherkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) )
24323 : {
24324 0 : return;
24325 : }
24326 :
24327 : /*
24328 : * SYRK
24329 : */
24330 0 : if( optypea==0 )
24331 : {
24332 :
24333 : /*
24334 : * C=alpha*A*A^H+beta*C
24335 : */
24336 0 : for(i=0; i<=n-1; i++)
24337 : {
24338 0 : if( isupper )
24339 : {
24340 0 : j1 = i;
24341 0 : j2 = n-1;
24342 : }
24343 : else
24344 : {
24345 0 : j1 = 0;
24346 0 : j2 = i;
24347 : }
24348 0 : for(j=j1; j<=j2; j++)
24349 : {
24350 0 : if( ae_fp_neq(alpha,(double)(0))&&k>0 )
24351 : {
24352 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &a->ptr.pp_complex[ia+j][ja], 1, "Conj", ae_v_len(ja,ja+k-1));
24353 : }
24354 : else
24355 : {
24356 0 : v = ae_complex_from_i(0);
24357 : }
24358 0 : if( ae_fp_eq(beta,(double)(0)) )
24359 : {
24360 0 : c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul_d(v,alpha);
24361 : }
24362 : else
24363 : {
24364 0 : c->ptr.pp_complex[ic+i][jc+j] = ae_c_add(ae_c_mul_d(c->ptr.pp_complex[ic+i][jc+j],beta),ae_c_mul_d(v,alpha));
24365 : }
24366 : }
24367 : }
24368 0 : return;
24369 : }
24370 : else
24371 : {
24372 :
24373 : /*
24374 : * C=alpha*A^H*A+beta*C
24375 : */
24376 0 : for(i=0; i<=n-1; i++)
24377 : {
24378 0 : if( isupper )
24379 : {
24380 0 : j1 = i;
24381 0 : j2 = n-1;
24382 : }
24383 : else
24384 : {
24385 0 : j1 = 0;
24386 0 : j2 = i;
24387 : }
24388 0 : if( ae_fp_eq(beta,(double)(0)) )
24389 : {
24390 0 : for(j=j1; j<=j2; j++)
24391 : {
24392 0 : c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_i(0);
24393 : }
24394 : }
24395 : else
24396 : {
24397 0 : ae_v_cmuld(&c->ptr.pp_complex[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta);
24398 : }
24399 : }
24400 0 : if( ae_fp_neq(alpha,(double)(0))&&k>0 )
24401 : {
24402 0 : for(i=0; i<=k-1; i++)
24403 : {
24404 0 : for(j=0; j<=n-1; j++)
24405 : {
24406 0 : if( isupper )
24407 : {
24408 0 : j1 = j;
24409 0 : j2 = n-1;
24410 : }
24411 : else
24412 : {
24413 0 : j1 = 0;
24414 0 : j2 = j;
24415 : }
24416 0 : v = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[ia+i][ja+j], _state),alpha);
24417 0 : ae_v_caddc(&c->ptr.pp_complex[ic+j][jc+j1], 1, &a->ptr.pp_complex[ia+i][ja+j1], 1, "N", ae_v_len(jc+j1,jc+j2), v);
24418 : }
24419 : }
24420 : }
24421 0 : return;
24422 : }
24423 : }
24424 :
24425 :
24426 : /*************************************************************************
24427 : Level 2 subrotuine
24428 : *************************************************************************/
24429 0 : static void ablas_rmatrixsyrk2(ae_int_t n,
24430 : ae_int_t k,
24431 : double alpha,
24432 : /* Real */ ae_matrix* a,
24433 : ae_int_t ia,
24434 : ae_int_t ja,
24435 : ae_int_t optypea,
24436 : double beta,
24437 : /* Real */ ae_matrix* c,
24438 : ae_int_t ic,
24439 : ae_int_t jc,
24440 : ae_bool isupper,
24441 : ae_state *_state)
24442 : {
24443 : ae_int_t i;
24444 : ae_int_t j;
24445 : ae_int_t j1;
24446 : ae_int_t j2;
24447 : double v;
24448 :
24449 :
24450 :
24451 : /*
24452 : * Fast exit (nothing to be done)
24453 : */
24454 0 : if( (ae_fp_eq(alpha,(double)(0))||k==0)&&ae_fp_eq(beta,(double)(1)) )
24455 : {
24456 0 : return;
24457 : }
24458 :
24459 : /*
24460 : * Try to call fast SYRK
24461 : */
24462 0 : if( rmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) )
24463 : {
24464 0 : return;
24465 : }
24466 :
24467 : /*
24468 : * SYRK
24469 : */
24470 0 : if( optypea==0 )
24471 : {
24472 :
24473 : /*
24474 : * C=alpha*A*A^H+beta*C
24475 : */
24476 0 : for(i=0; i<=n-1; i++)
24477 : {
24478 0 : if( isupper )
24479 : {
24480 0 : j1 = i;
24481 0 : j2 = n-1;
24482 : }
24483 : else
24484 : {
24485 0 : j1 = 0;
24486 0 : j2 = i;
24487 : }
24488 0 : for(j=j1; j<=j2; j++)
24489 : {
24490 0 : if( ae_fp_neq(alpha,(double)(0))&&k>0 )
24491 : {
24492 0 : v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &a->ptr.pp_double[ia+j][ja], 1, ae_v_len(ja,ja+k-1));
24493 : }
24494 : else
24495 : {
24496 0 : v = (double)(0);
24497 : }
24498 0 : if( ae_fp_eq(beta,(double)(0)) )
24499 : {
24500 0 : c->ptr.pp_double[ic+i][jc+j] = alpha*v;
24501 : }
24502 : else
24503 : {
24504 0 : c->ptr.pp_double[ic+i][jc+j] = beta*c->ptr.pp_double[ic+i][jc+j]+alpha*v;
24505 : }
24506 : }
24507 : }
24508 0 : return;
24509 : }
24510 : else
24511 : {
24512 :
24513 : /*
24514 : * C=alpha*A^H*A+beta*C
24515 : */
24516 0 : for(i=0; i<=n-1; i++)
24517 : {
24518 0 : if( isupper )
24519 : {
24520 0 : j1 = i;
24521 0 : j2 = n-1;
24522 : }
24523 : else
24524 : {
24525 0 : j1 = 0;
24526 0 : j2 = i;
24527 : }
24528 0 : if( ae_fp_eq(beta,(double)(0)) )
24529 : {
24530 0 : for(j=j1; j<=j2; j++)
24531 : {
24532 0 : c->ptr.pp_double[ic+i][jc+j] = (double)(0);
24533 : }
24534 : }
24535 : else
24536 : {
24537 0 : ae_v_muld(&c->ptr.pp_double[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta);
24538 : }
24539 : }
24540 0 : if( ae_fp_neq(alpha,(double)(0))&&k>0 )
24541 : {
24542 0 : for(i=0; i<=k-1; i++)
24543 : {
24544 0 : for(j=0; j<=n-1; j++)
24545 : {
24546 0 : if( isupper )
24547 : {
24548 0 : j1 = j;
24549 0 : j2 = n-1;
24550 : }
24551 : else
24552 : {
24553 0 : j1 = 0;
24554 0 : j2 = j;
24555 : }
24556 0 : v = alpha*a->ptr.pp_double[ia+i][ja+j];
24557 0 : ae_v_addd(&c->ptr.pp_double[ic+j][jc+j1], 1, &a->ptr.pp_double[ia+i][ja+j1], 1, ae_v_len(jc+j1,jc+j2), v);
24558 : }
24559 : }
24560 : }
24561 0 : return;
24562 : }
24563 : }
24564 :
24565 :
24566 : /*************************************************************************
24567 : This subroutine is an actual implementation of CMatrixGEMM. It does not
24568 : perform some integrity checks performed in the driver function, and it
24569 : does not activate multithreading framework (driver decides whether to
24570 : activate workers or not).
24571 :
24572 : -- ALGLIB routine --
24573 : 10.01.2019
24574 : Bochkanov Sergey
24575 : *************************************************************************/
24576 0 : static void ablas_cmatrixgemmrec(ae_int_t m,
24577 : ae_int_t n,
24578 : ae_int_t k,
24579 : ae_complex alpha,
24580 : /* Complex */ ae_matrix* a,
24581 : ae_int_t ia,
24582 : ae_int_t ja,
24583 : ae_int_t optypea,
24584 : /* Complex */ ae_matrix* b,
24585 : ae_int_t ib,
24586 : ae_int_t jb,
24587 : ae_int_t optypeb,
24588 : ae_complex beta,
24589 : /* Complex */ ae_matrix* c,
24590 : ae_int_t ic,
24591 : ae_int_t jc,
24592 : ae_state *_state)
24593 : {
24594 : ae_int_t s1;
24595 : ae_int_t s2;
24596 : ae_int_t tsa;
24597 : ae_int_t tsb;
24598 : ae_int_t tscur;
24599 :
24600 :
24601 :
24602 : /*
24603 : * Tile hierarchy: B -> A -> A/2
24604 : */
24605 0 : tsa = matrixtilesizea(_state)/2;
24606 0 : tsb = matrixtilesizeb(_state);
24607 0 : tscur = tsb;
24608 0 : if( imax3(m, n, k, _state)<=tsb )
24609 : {
24610 0 : tscur = tsa;
24611 : }
24612 0 : ae_assert(tscur>=1, "CMatrixGEMMRec: integrity check failed", _state);
24613 :
24614 : /*
24615 : * Use MKL or ALGLIB basecase code
24616 : */
24617 0 : if( imax3(m, n, k, _state)<=tsb )
24618 : {
24619 0 : if( cmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) )
24620 : {
24621 0 : return;
24622 : }
24623 : }
24624 0 : if( imax3(m, n, k, _state)<=tsa )
24625 : {
24626 0 : cmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24627 0 : return;
24628 : }
24629 :
24630 : /*
24631 : * Recursive algorithm: parallel splitting on M/N
24632 : */
24633 0 : if( m>=n&&m>=k )
24634 : {
24635 :
24636 : /*
24637 : * A*B = (A1 A2)^T*B
24638 : */
24639 0 : tiledsplit(m, tscur, &s1, &s2, _state);
24640 0 : ablas_cmatrixgemmrec(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24641 0 : if( optypea==0 )
24642 : {
24643 0 : ablas_cmatrixgemmrec(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state);
24644 : }
24645 : else
24646 : {
24647 0 : ablas_cmatrixgemmrec(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state);
24648 : }
24649 0 : return;
24650 : }
24651 0 : if( n>=m&&n>=k )
24652 : {
24653 :
24654 : /*
24655 : * A*B = A*(B1 B2)
24656 : */
24657 0 : tiledsplit(n, tscur, &s1, &s2, _state);
24658 0 : if( optypeb==0 )
24659 : {
24660 0 : ablas_cmatrixgemmrec(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24661 0 : ablas_cmatrixgemmrec(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state);
24662 : }
24663 : else
24664 : {
24665 0 : ablas_cmatrixgemmrec(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24666 0 : ablas_cmatrixgemmrec(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state);
24667 : }
24668 0 : return;
24669 : }
24670 :
24671 : /*
24672 : * Recursive algorithm: serial splitting on K
24673 : */
24674 :
24675 : /*
24676 : * A*B = (A1 A2)*(B1 B2)^T
24677 : */
24678 0 : tiledsplit(k, tscur, &s1, &s2, _state);
24679 0 : if( optypea==0&&optypeb==0 )
24680 : {
24681 0 : ablas_cmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24682 0 : ablas_cmatrixgemmrec(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state);
24683 : }
24684 0 : if( optypea==0&&optypeb!=0 )
24685 : {
24686 0 : ablas_cmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24687 0 : ablas_cmatrixgemmrec(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state);
24688 : }
24689 0 : if( optypea!=0&&optypeb==0 )
24690 : {
24691 0 : ablas_cmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24692 0 : ablas_cmatrixgemmrec(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state);
24693 : }
24694 0 : if( optypea!=0&&optypeb!=0 )
24695 : {
24696 0 : ablas_cmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24697 0 : ablas_cmatrixgemmrec(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state);
24698 : }
24699 : }
24700 :
24701 :
24702 : /*************************************************************************
24703 : Serial stub for GPL edition.
24704 : *************************************************************************/
24705 0 : ae_bool _trypexec_ablas_cmatrixgemmrec(ae_int_t m,
24706 : ae_int_t n,
24707 : ae_int_t k,
24708 : ae_complex alpha,
24709 : /* Complex */ ae_matrix* a,
24710 : ae_int_t ia,
24711 : ae_int_t ja,
24712 : ae_int_t optypea,
24713 : /* Complex */ ae_matrix* b,
24714 : ae_int_t ib,
24715 : ae_int_t jb,
24716 : ae_int_t optypeb,
24717 : ae_complex beta,
24718 : /* Complex */ ae_matrix* c,
24719 : ae_int_t ic,
24720 : ae_int_t jc,
24721 : ae_state *_state)
24722 : {
24723 0 : return ae_false;
24724 : }
24725 :
24726 :
24727 : /*************************************************************************
24728 : This subroutine is an actual implementation of RMatrixGEMM. It does not
24729 : perform some integrity checks performed in the driver function, and it
24730 : does not activate multithreading framework (driver decides whether to
24731 : activate workers or not).
24732 :
24733 : -- ALGLIB routine --
24734 : 10.01.2019
24735 : Bochkanov Sergey
24736 : *************************************************************************/
24737 0 : static void ablas_rmatrixgemmrec(ae_int_t m,
24738 : ae_int_t n,
24739 : ae_int_t k,
24740 : double alpha,
24741 : /* Real */ ae_matrix* a,
24742 : ae_int_t ia,
24743 : ae_int_t ja,
24744 : ae_int_t optypea,
24745 : /* Real */ ae_matrix* b,
24746 : ae_int_t ib,
24747 : ae_int_t jb,
24748 : ae_int_t optypeb,
24749 : double beta,
24750 : /* Real */ ae_matrix* c,
24751 : ae_int_t ic,
24752 : ae_int_t jc,
24753 : ae_state *_state)
24754 : {
24755 : ae_int_t s1;
24756 : ae_int_t s2;
24757 : ae_int_t tsa;
24758 : ae_int_t tsb;
24759 : ae_int_t tscur;
24760 :
24761 :
24762 0 : tsa = matrixtilesizea(_state);
24763 0 : tsb = matrixtilesizeb(_state);
24764 0 : tscur = tsb;
24765 0 : if( imax3(m, n, k, _state)<=tsb )
24766 : {
24767 0 : tscur = tsa;
24768 : }
24769 0 : ae_assert(tscur>=1, "RMatrixGEMMRec: integrity check failed", _state);
24770 :
24771 : /*
24772 : * Use MKL or ALGLIB basecase code
24773 : */
24774 0 : if( (m<=tsb&&n<=tsb)&&k<=tsb )
24775 : {
24776 0 : if( rmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) )
24777 : {
24778 0 : return;
24779 : }
24780 : }
24781 0 : if( (m<=tsa&&n<=tsa)&&k<=tsa )
24782 : {
24783 0 : rmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24784 0 : return;
24785 : }
24786 :
24787 : /*
24788 : * Recursive algorithm: split on M or N
24789 : */
24790 0 : if( m>=n&&m>=k )
24791 : {
24792 :
24793 : /*
24794 : * A*B = (A1 A2)^T*B
24795 : */
24796 0 : tiledsplit(m, tscur, &s1, &s2, _state);
24797 0 : if( optypea==0 )
24798 : {
24799 0 : ablas_rmatrixgemmrec(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state);
24800 0 : ablas_rmatrixgemmrec(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24801 : }
24802 : else
24803 : {
24804 0 : ablas_rmatrixgemmrec(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state);
24805 0 : ablas_rmatrixgemmrec(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24806 : }
24807 0 : return;
24808 : }
24809 0 : if( n>=m&&n>=k )
24810 : {
24811 :
24812 : /*
24813 : * A*B = A*(B1 B2)
24814 : */
24815 0 : tiledsplit(n, tscur, &s1, &s2, _state);
24816 0 : if( optypeb==0 )
24817 : {
24818 0 : ablas_rmatrixgemmrec(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state);
24819 0 : ablas_rmatrixgemmrec(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24820 : }
24821 : else
24822 : {
24823 0 : ablas_rmatrixgemmrec(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state);
24824 0 : ablas_rmatrixgemmrec(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24825 : }
24826 0 : return;
24827 : }
24828 :
24829 : /*
24830 : * Recursive algorithm: split on K
24831 : */
24832 :
24833 : /*
24834 : * A*B = (A1 A2)*(B1 B2)^T
24835 : */
24836 0 : tiledsplit(k, tscur, &s1, &s2, _state);
24837 0 : if( optypea==0&&optypeb==0 )
24838 : {
24839 0 : ablas_rmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24840 0 : ablas_rmatrixgemmrec(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state);
24841 : }
24842 0 : if( optypea==0&&optypeb!=0 )
24843 : {
24844 0 : ablas_rmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24845 0 : ablas_rmatrixgemmrec(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state);
24846 : }
24847 0 : if( optypea!=0&&optypeb==0 )
24848 : {
24849 0 : ablas_rmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24850 0 : ablas_rmatrixgemmrec(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state);
24851 : }
24852 0 : if( optypea!=0&&optypeb!=0 )
24853 : {
24854 0 : ablas_rmatrixgemmrec(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state);
24855 0 : ablas_rmatrixgemmrec(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state);
24856 : }
24857 : }
24858 :
24859 :
24860 : /*************************************************************************
24861 : Serial stub for GPL edition.
24862 : *************************************************************************/
24863 0 : ae_bool _trypexec_ablas_rmatrixgemmrec(ae_int_t m,
24864 : ae_int_t n,
24865 : ae_int_t k,
24866 : double alpha,
24867 : /* Real */ ae_matrix* a,
24868 : ae_int_t ia,
24869 : ae_int_t ja,
24870 : ae_int_t optypea,
24871 : /* Real */ ae_matrix* b,
24872 : ae_int_t ib,
24873 : ae_int_t jb,
24874 : ae_int_t optypeb,
24875 : double beta,
24876 : /* Real */ ae_matrix* c,
24877 : ae_int_t ic,
24878 : ae_int_t jc,
24879 : ae_state *_state)
24880 : {
24881 0 : return ae_false;
24882 : }
24883 :
24884 :
24885 : #endif
24886 : #if defined(AE_COMPILE_DLU) || !defined(AE_PARTIAL_BUILD)
24887 :
24888 :
24889 : /*************************************************************************
24890 : Recurrent complex LU subroutine.
24891 : Never call it directly.
24892 :
24893 : -- ALGLIB routine --
24894 : 04.01.2010
24895 : Bochkanov Sergey
24896 : *************************************************************************/
24897 0 : void cmatrixluprec(/* Complex */ ae_matrix* a,
24898 : ae_int_t offs,
24899 : ae_int_t m,
24900 : ae_int_t n,
24901 : /* Integer */ ae_vector* pivots,
24902 : /* Complex */ ae_vector* tmp,
24903 : ae_state *_state)
24904 : {
24905 : ae_int_t i;
24906 : ae_int_t m1;
24907 : ae_int_t m2;
24908 :
24909 :
24910 0 : if( ae_minint(m, n, _state)<=ablascomplexblocksize(a, _state) )
24911 : {
24912 0 : dlu_cmatrixlup2(a, offs, m, n, pivots, tmp, _state);
24913 0 : return;
24914 : }
24915 0 : if( m>n )
24916 : {
24917 0 : cmatrixluprec(a, offs, n, n, pivots, tmp, _state);
24918 0 : for(i=0; i<=n-1; i++)
24919 : {
24920 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n][offs+i], a->stride, "N", ae_v_len(0,m-n-1));
24921 0 : ae_v_cmove(&a->ptr.pp_complex[offs+n][offs+i], a->stride, &a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+n,offs+m-1));
24922 0 : ae_v_cmove(&a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n,offs+m-1));
24923 : }
24924 0 : cmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state);
24925 0 : return;
24926 : }
24927 0 : ablascomplexsplitlength(a, m, &m1, &m2, _state);
24928 0 : cmatrixluprec(a, offs, m1, n, pivots, tmp, _state);
24929 0 : if( m2>0 )
24930 : {
24931 0 : for(i=0; i<=m1-1; i++)
24932 : {
24933 0 : if( offs+i!=pivots->ptr.p_int[offs+i] )
24934 : {
24935 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+m1][offs+i], a->stride, "N", ae_v_len(0,m2-1));
24936 0 : ae_v_cmove(&a->ptr.pp_complex[offs+m1][offs+i], a->stride, &a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+m1,offs+m-1));
24937 0 : ae_v_cmove(&a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m1,offs+m-1));
24938 : }
24939 : }
24940 0 : cmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state);
24941 0 : cmatrixgemm(m-m1, n-m1, m1, ae_complex_from_d(-1.0), a, offs+m1, offs, 0, a, offs, offs+m1, 0, ae_complex_from_d(1.0), a, offs+m1, offs+m1, _state);
24942 0 : cmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state);
24943 0 : for(i=0; i<=m2-1; i++)
24944 : {
24945 0 : if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] )
24946 : {
24947 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+m1+i], a->stride, "N", ae_v_len(0,m1-1));
24948 0 : ae_v_cmove(&a->ptr.pp_complex[offs][offs+m1+i], a->stride, &a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, "N", ae_v_len(offs,offs+m1-1));
24949 0 : ae_v_cmove(&a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m1-1));
24950 : }
24951 : }
24952 : }
24953 : }
24954 :
24955 :
24956 : /*************************************************************************
24957 : Recurrent real LU subroutine.
24958 : Never call it directly.
24959 :
24960 : -- ALGLIB routine --
24961 : 04.01.2010
24962 : Bochkanov Sergey
24963 : *************************************************************************/
24964 0 : void rmatrixluprec(/* Real */ ae_matrix* a,
24965 : ae_int_t offs,
24966 : ae_int_t m,
24967 : ae_int_t n,
24968 : /* Integer */ ae_vector* pivots,
24969 : /* Real */ ae_vector* tmp,
24970 : ae_state *_state)
24971 : {
24972 : ae_int_t i;
24973 : ae_int_t m1;
24974 : ae_int_t m2;
24975 :
24976 :
24977 0 : if( ae_minint(m, n, _state)<=ablasblocksize(a, _state) )
24978 : {
24979 0 : dlu_rmatrixlup2(a, offs, m, n, pivots, tmp, _state);
24980 0 : return;
24981 : }
24982 0 : if( m>n )
24983 : {
24984 0 : rmatrixluprec(a, offs, n, n, pivots, tmp, _state);
24985 0 : for(i=0; i<=n-1; i++)
24986 : {
24987 0 : if( offs+i!=pivots->ptr.p_int[offs+i] )
24988 : {
24989 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n][offs+i], a->stride, ae_v_len(0,m-n-1));
24990 0 : ae_v_move(&a->ptr.pp_double[offs+n][offs+i], a->stride, &a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+n,offs+m-1));
24991 0 : ae_v_move(&a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n,offs+m-1));
24992 : }
24993 : }
24994 0 : rmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state);
24995 0 : return;
24996 : }
24997 0 : ablassplitlength(a, m, &m1, &m2, _state);
24998 0 : rmatrixluprec(a, offs, m1, n, pivots, tmp, _state);
24999 0 : if( m2>0 )
25000 : {
25001 0 : for(i=0; i<=m1-1; i++)
25002 : {
25003 0 : if( offs+i!=pivots->ptr.p_int[offs+i] )
25004 : {
25005 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+m1][offs+i], a->stride, ae_v_len(0,m2-1));
25006 0 : ae_v_move(&a->ptr.pp_double[offs+m1][offs+i], a->stride, &a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+m1,offs+m-1));
25007 0 : ae_v_move(&a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m1,offs+m-1));
25008 : }
25009 : }
25010 0 : rmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state);
25011 0 : rmatrixgemm(m-m1, n-m1, m1, -1.0, a, offs+m1, offs, 0, a, offs, offs+m1, 0, 1.0, a, offs+m1, offs+m1, _state);
25012 0 : rmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state);
25013 0 : for(i=0; i<=m2-1; i++)
25014 : {
25015 0 : if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] )
25016 : {
25017 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+m1+i], a->stride, ae_v_len(0,m1-1));
25018 0 : ae_v_move(&a->ptr.pp_double[offs][offs+m1+i], a->stride, &a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, ae_v_len(offs,offs+m1-1));
25019 0 : ae_v_move(&a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m1-1));
25020 : }
25021 : }
25022 : }
25023 : }
25024 :
25025 :
25026 : /*************************************************************************
25027 : Recurrent complex LU subroutine.
25028 : Never call it directly.
25029 :
25030 : -- ALGLIB routine --
25031 : 04.01.2010
25032 : Bochkanov Sergey
25033 : *************************************************************************/
25034 0 : void cmatrixplurec(/* Complex */ ae_matrix* a,
25035 : ae_int_t offs,
25036 : ae_int_t m,
25037 : ae_int_t n,
25038 : /* Integer */ ae_vector* pivots,
25039 : /* Complex */ ae_vector* tmp,
25040 : ae_state *_state)
25041 : {
25042 : ae_int_t i;
25043 : ae_int_t n1;
25044 : ae_int_t n2;
25045 : ae_int_t tsa;
25046 : ae_int_t tsb;
25047 :
25048 :
25049 0 : tsa = matrixtilesizea(_state)/2;
25050 0 : tsb = matrixtilesizeb(_state);
25051 0 : if( n<=tsa )
25052 : {
25053 0 : dlu_cmatrixplu2(a, offs, m, n, pivots, tmp, _state);
25054 0 : return;
25055 : }
25056 0 : if( n>m )
25057 : {
25058 0 : cmatrixplurec(a, offs, m, m, pivots, tmp, _state);
25059 0 : for(i=0; i<=m-1; i++)
25060 : {
25061 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+m], 1, "N", ae_v_len(0,n-m-1));
25062 0 : ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+m], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, "N", ae_v_len(offs+m,offs+n-1));
25063 0 : ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m,offs+n-1));
25064 : }
25065 0 : cmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state);
25066 0 : return;
25067 : }
25068 0 : if( n>tsb )
25069 : {
25070 0 : n1 = tsb;
25071 0 : n2 = n-n1;
25072 : }
25073 : else
25074 : {
25075 0 : tiledsplit(n, tsa, &n1, &n2, _state);
25076 : }
25077 0 : cmatrixplurec(a, offs, m, n1, pivots, tmp, _state);
25078 0 : if( n2>0 )
25079 : {
25080 0 : for(i=0; i<=n1-1; i++)
25081 : {
25082 0 : if( offs+i!=pivots->ptr.p_int[offs+i] )
25083 : {
25084 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+n1], 1, "N", ae_v_len(0,n2-1));
25085 0 : ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+n1], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, "N", ae_v_len(offs+n1,offs+n-1));
25086 0 : ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n1,offs+n-1));
25087 : }
25088 : }
25089 0 : cmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state);
25090 0 : cmatrixgemm(m-n1, n-n1, n1, ae_complex_from_d(-1.0), a, offs+n1, offs, 0, a, offs, offs+n1, 0, ae_complex_from_d(1.0), a, offs+n1, offs+n1, _state);
25091 0 : cmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state);
25092 0 : for(i=0; i<=n2-1; i++)
25093 : {
25094 0 : if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] )
25095 : {
25096 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n1+i][offs], 1, "N", ae_v_len(0,n1-1));
25097 0 : ae_v_cmove(&a->ptr.pp_complex[offs+n1+i][offs], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, "N", ae_v_len(offs,offs+n1-1));
25098 0 : ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+n1-1));
25099 : }
25100 : }
25101 : }
25102 : }
25103 :
25104 :
25105 : /*************************************************************************
25106 : Recurrent real LU subroutine.
25107 : Never call it directly.
25108 :
25109 : -- ALGLIB routine --
25110 : 04.01.2010
25111 : Bochkanov Sergey
25112 : *************************************************************************/
25113 0 : void rmatrixplurec(/* Real */ ae_matrix* a,
25114 : ae_int_t offs,
25115 : ae_int_t m,
25116 : ae_int_t n,
25117 : /* Integer */ ae_vector* pivots,
25118 : /* Real */ ae_vector* tmp,
25119 : ae_state *_state)
25120 : {
25121 : ae_int_t i;
25122 : ae_int_t n1;
25123 : ae_int_t n2;
25124 : ae_int_t tsa;
25125 : ae_int_t tsb;
25126 :
25127 :
25128 0 : tsa = matrixtilesizea(_state);
25129 0 : tsb = matrixtilesizeb(_state);
25130 0 : if( n<=tsb )
25131 : {
25132 0 : if( rmatrixplumkl(a, offs, m, n, pivots, _state) )
25133 : {
25134 0 : return;
25135 : }
25136 : }
25137 0 : if( n<=tsa )
25138 : {
25139 0 : dlu_rmatrixplu2(a, offs, m, n, pivots, tmp, _state);
25140 0 : return;
25141 : }
25142 0 : if( n>m )
25143 : {
25144 0 : rmatrixplurec(a, offs, m, m, pivots, tmp, _state);
25145 0 : for(i=0; i<=m-1; i++)
25146 : {
25147 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+m], 1, ae_v_len(0,n-m-1));
25148 0 : ae_v_move(&a->ptr.pp_double[offs+i][offs+m], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, ae_v_len(offs+m,offs+n-1));
25149 0 : ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m,offs+n-1));
25150 : }
25151 0 : rmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state);
25152 0 : return;
25153 : }
25154 0 : if( n>tsb )
25155 : {
25156 0 : n1 = tsb;
25157 0 : n2 = n-n1;
25158 : }
25159 : else
25160 : {
25161 0 : tiledsplit(n, tsa, &n1, &n2, _state);
25162 : }
25163 0 : rmatrixplurec(a, offs, m, n1, pivots, tmp, _state);
25164 0 : if( n2>0 )
25165 : {
25166 0 : for(i=0; i<=n1-1; i++)
25167 : {
25168 0 : if( offs+i!=pivots->ptr.p_int[offs+i] )
25169 : {
25170 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(0,n2-1));
25171 0 : ae_v_move(&a->ptr.pp_double[offs+i][offs+n1], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, ae_v_len(offs+n1,offs+n-1));
25172 0 : ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n1,offs+n-1));
25173 : }
25174 : }
25175 0 : rmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state);
25176 0 : rmatrixgemm(m-n1, n-n1, n1, -1.0, a, offs+n1, offs, 0, a, offs, offs+n1, 0, 1.0, a, offs+n1, offs+n1, _state);
25177 0 : rmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state);
25178 0 : for(i=0; i<=n2-1; i++)
25179 : {
25180 0 : if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] )
25181 : {
25182 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(0,n1-1));
25183 0 : ae_v_move(&a->ptr.pp_double[offs+n1+i][offs], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, ae_v_len(offs,offs+n1-1));
25184 0 : ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+n1-1));
25185 : }
25186 : }
25187 : }
25188 : }
25189 :
25190 :
25191 : /*************************************************************************
25192 : Complex LUP kernel
25193 :
25194 : -- ALGLIB routine --
25195 : 10.01.2010
25196 : Bochkanov Sergey
25197 : *************************************************************************/
25198 0 : static void dlu_cmatrixlup2(/* Complex */ ae_matrix* a,
25199 : ae_int_t offs,
25200 : ae_int_t m,
25201 : ae_int_t n,
25202 : /* Integer */ ae_vector* pivots,
25203 : /* Complex */ ae_vector* tmp,
25204 : ae_state *_state)
25205 : {
25206 : ae_int_t i;
25207 : ae_int_t j;
25208 : ae_int_t jp;
25209 : ae_complex s;
25210 :
25211 :
25212 0 : if( m==0||n==0 )
25213 : {
25214 0 : return;
25215 : }
25216 0 : for(j=0; j<=ae_minint(m-1, n-1, _state); j++)
25217 : {
25218 0 : jp = j;
25219 0 : for(i=j+1; i<=n-1; i++)
25220 : {
25221 0 : if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+j][offs+i], _state),ae_c_abs(a->ptr.pp_complex[offs+j][offs+jp], _state)) )
25222 : {
25223 0 : jp = i;
25224 : }
25225 : }
25226 0 : pivots->ptr.p_int[offs+j] = offs+jp;
25227 0 : if( jp!=j )
25228 : {
25229 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+j], a->stride, "N", ae_v_len(0,m-1));
25230 0 : ae_v_cmove(&a->ptr.pp_complex[offs][offs+j], a->stride, &a->ptr.pp_complex[offs][offs+jp], a->stride, "N", ae_v_len(offs,offs+m-1));
25231 0 : ae_v_cmove(&a->ptr.pp_complex[offs][offs+jp], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m-1));
25232 : }
25233 0 : if( ae_c_neq_d(a->ptr.pp_complex[offs+j][offs+j],(double)(0))&&j+1<=n-1 )
25234 : {
25235 0 : s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]);
25236 0 : ae_v_cmulc(&a->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s);
25237 : }
25238 0 : if( j<ae_minint(m-1, n-1, _state) )
25239 : {
25240 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2));
25241 0 : ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2));
25242 0 : cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state);
25243 : }
25244 : }
25245 : }
25246 :
25247 :
25248 : /*************************************************************************
25249 : Real LUP kernel
25250 :
25251 : -- ALGLIB routine --
25252 : 10.01.2010
25253 : Bochkanov Sergey
25254 : *************************************************************************/
25255 0 : static void dlu_rmatrixlup2(/* Real */ ae_matrix* a,
25256 : ae_int_t offs,
25257 : ae_int_t m,
25258 : ae_int_t n,
25259 : /* Integer */ ae_vector* pivots,
25260 : /* Real */ ae_vector* tmp,
25261 : ae_state *_state)
25262 : {
25263 : ae_int_t i;
25264 : ae_int_t j;
25265 : ae_int_t jp;
25266 : double s;
25267 :
25268 :
25269 0 : if( m==0||n==0 )
25270 : {
25271 0 : return;
25272 : }
25273 0 : for(j=0; j<=ae_minint(m-1, n-1, _state); j++)
25274 : {
25275 0 : jp = j;
25276 0 : for(i=j+1; i<=n-1; i++)
25277 : {
25278 0 : if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+j][offs+i], _state),ae_fabs(a->ptr.pp_double[offs+j][offs+jp], _state)) )
25279 : {
25280 0 : jp = i;
25281 : }
25282 : }
25283 0 : pivots->ptr.p_int[offs+j] = offs+jp;
25284 0 : if( jp!=j )
25285 : {
25286 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+j], a->stride, ae_v_len(0,m-1));
25287 0 : ae_v_move(&a->ptr.pp_double[offs][offs+j], a->stride, &a->ptr.pp_double[offs][offs+jp], a->stride, ae_v_len(offs,offs+m-1));
25288 0 : ae_v_move(&a->ptr.pp_double[offs][offs+jp], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m-1));
25289 : }
25290 0 : if( ae_fp_neq(a->ptr.pp_double[offs+j][offs+j],(double)(0))&&j+1<=n-1 )
25291 : {
25292 0 : s = 1/a->ptr.pp_double[offs+j][offs+j];
25293 0 : ae_v_muld(&a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s);
25294 : }
25295 0 : if( j<ae_minint(m-1, n-1, _state) )
25296 : {
25297 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2));
25298 0 : ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2));
25299 0 : rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state);
25300 : }
25301 : }
25302 : }
25303 :
25304 :
25305 : /*************************************************************************
25306 : Complex PLU kernel
25307 :
25308 : -- LAPACK routine (version 3.0) --
25309 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
25310 : Courant Institute, Argonne National Lab, and Rice University
25311 : June 30, 1992
25312 : *************************************************************************/
25313 0 : static void dlu_cmatrixplu2(/* Complex */ ae_matrix* a,
25314 : ae_int_t offs,
25315 : ae_int_t m,
25316 : ae_int_t n,
25317 : /* Integer */ ae_vector* pivots,
25318 : /* Complex */ ae_vector* tmp,
25319 : ae_state *_state)
25320 : {
25321 : ae_int_t i;
25322 : ae_int_t j;
25323 : ae_int_t jp;
25324 : ae_complex s;
25325 :
25326 :
25327 0 : if( m==0||n==0 )
25328 : {
25329 0 : return;
25330 : }
25331 0 : for(j=0; j<=ae_minint(m-1, n-1, _state); j++)
25332 : {
25333 0 : jp = j;
25334 0 : for(i=j+1; i<=m-1; i++)
25335 : {
25336 0 : if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+i][offs+j], _state),ae_c_abs(a->ptr.pp_complex[offs+jp][offs+j], _state)) )
25337 : {
25338 0 : jp = i;
25339 : }
25340 : }
25341 0 : pivots->ptr.p_int[offs+j] = offs+jp;
25342 0 : if( ae_c_neq_d(a->ptr.pp_complex[offs+jp][offs+j],(double)(0)) )
25343 : {
25344 0 : if( jp!=j )
25345 : {
25346 0 : for(i=0; i<=n-1; i++)
25347 : {
25348 0 : s = a->ptr.pp_complex[offs+j][offs+i];
25349 0 : a->ptr.pp_complex[offs+j][offs+i] = a->ptr.pp_complex[offs+jp][offs+i];
25350 0 : a->ptr.pp_complex[offs+jp][offs+i] = s;
25351 : }
25352 : }
25353 0 : if( j+1<=m-1 )
25354 : {
25355 0 : s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]);
25356 0 : ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s);
25357 : }
25358 : }
25359 0 : if( j<ae_minint(m, n, _state)-1 )
25360 : {
25361 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2));
25362 0 : ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2));
25363 0 : cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state);
25364 : }
25365 : }
25366 : }
25367 :
25368 :
25369 : /*************************************************************************
25370 : Real PLU kernel
25371 :
25372 : -- LAPACK routine (version 3.0) --
25373 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
25374 : Courant Institute, Argonne National Lab, and Rice University
25375 : June 30, 1992
25376 : *************************************************************************/
25377 0 : static void dlu_rmatrixplu2(/* Real */ ae_matrix* a,
25378 : ae_int_t offs,
25379 : ae_int_t m,
25380 : ae_int_t n,
25381 : /* Integer */ ae_vector* pivots,
25382 : /* Real */ ae_vector* tmp,
25383 : ae_state *_state)
25384 : {
25385 : ae_int_t i;
25386 : ae_int_t j;
25387 : ae_int_t jp;
25388 : double s;
25389 :
25390 :
25391 0 : if( m==0||n==0 )
25392 : {
25393 0 : return;
25394 : }
25395 0 : for(j=0; j<=ae_minint(m-1, n-1, _state); j++)
25396 : {
25397 0 : jp = j;
25398 0 : for(i=j+1; i<=m-1; i++)
25399 : {
25400 0 : if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+i][offs+j], _state),ae_fabs(a->ptr.pp_double[offs+jp][offs+j], _state)) )
25401 : {
25402 0 : jp = i;
25403 : }
25404 : }
25405 0 : pivots->ptr.p_int[offs+j] = offs+jp;
25406 0 : if( ae_fp_neq(a->ptr.pp_double[offs+jp][offs+j],(double)(0)) )
25407 : {
25408 0 : if( jp!=j )
25409 : {
25410 0 : for(i=0; i<=n-1; i++)
25411 : {
25412 0 : s = a->ptr.pp_double[offs+j][offs+i];
25413 0 : a->ptr.pp_double[offs+j][offs+i] = a->ptr.pp_double[offs+jp][offs+i];
25414 0 : a->ptr.pp_double[offs+jp][offs+i] = s;
25415 : }
25416 : }
25417 0 : if( j+1<=m-1 )
25418 : {
25419 0 : s = 1/a->ptr.pp_double[offs+j][offs+j];
25420 0 : ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s);
25421 : }
25422 : }
25423 0 : if( j<ae_minint(m, n, _state)-1 )
25424 : {
25425 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2));
25426 0 : ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2));
25427 0 : rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state);
25428 : }
25429 : }
25430 : }
25431 :
25432 :
25433 : #endif
25434 : #if defined(AE_COMPILE_SPTRF) || !defined(AE_PARTIAL_BUILD)
25435 :
25436 :
25437 : /*************************************************************************
25438 : Sparse LU for square NxN CRS matrix with both row and column permutations.
25439 :
25440 : Represents A as Pr*L*U*Pc, where:
25441 : * Pr is a product of row permutations Pr=Pr(0)*Pr(1)*...*Pr(n-2)*Pr(n-1)
25442 : * Pc is a product of col permutations Pc=Pc(n-1)*Pc(n-2)*...*Pc(1)*Pc(0)
25443 : * L is lower unitriangular
25444 : * U is upper triangular
25445 :
25446 : INPUT PARAMETERS:
25447 : A - sparse square matrix in CRS format
25448 : PivotType - pivot type:
25449 : * 0 - for best pivoting available
25450 : * 1 - row-only pivoting
25451 : * 2 - row and column greedy pivoting algorithm (most
25452 : sparse pivot column is selected from the trailing
25453 : matrix at each step)
25454 : Buf - temporary buffer, previously allocated memory is
25455 : reused as much as possible
25456 :
25457 : OUTPUT PARAMETERS:
25458 : A - LU decomposition of A
25459 : PR - array[N], row pivots
25460 : PC - array[N], column pivots
25461 : Buf - following fields of Buf are set:
25462 : * Buf.RowPermRawIdx[] - contains row permutation, with
25463 : RawIdx[I]=J meaning that J-th row of the original
25464 : input matrix was moved to Ith position of the output
25465 : factorization
25466 :
25467 : This function always succeeds i.e. it ALWAYS returns valid factorization,
25468 : but for your convenience it also returns boolean value which helps to
25469 : detect symbolically degenerate matrix:
25470 : * function returns TRUE if the matrix was factorized AND symbolically
25471 : non-degenerate
25472 : * function returns FALSE if the matrix was factorized but U has strictly
25473 : zero elements at the diagonal (the factorization is returned anyway).
25474 :
25475 : -- ALGLIB routine --
25476 : 15.01.2019
25477 : Bochkanov Sergey
25478 : *************************************************************************/
25479 0 : ae_bool sptrflu(sparsematrix* a,
25480 : ae_int_t pivottype,
25481 : /* Integer */ ae_vector* pr,
25482 : /* Integer */ ae_vector* pc,
25483 : sluv2buffer* buf,
25484 : ae_state *_state)
25485 : {
25486 : ae_int_t n;
25487 : ae_int_t k;
25488 : ae_int_t i;
25489 : ae_int_t j;
25490 : ae_int_t jp;
25491 : ae_int_t i0;
25492 : ae_int_t i1;
25493 : ae_int_t ibest;
25494 : ae_int_t jbest;
25495 : double v;
25496 : double v0;
25497 : ae_int_t nz0;
25498 : ae_int_t nz1;
25499 : double uu;
25500 : ae_int_t offs;
25501 : ae_int_t tmpndense;
25502 : ae_bool densificationsupported;
25503 : ae_int_t densifyabove;
25504 : ae_bool result;
25505 :
25506 :
25507 0 : ae_assert(sparseiscrs(a, _state), "SparseLU: A is not stored in CRS format", _state);
25508 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseLU: non-square A", _state);
25509 0 : ae_assert((pivottype==0||pivottype==1)||pivottype==2, "SparseLU: unexpected pivot type", _state);
25510 0 : result = ae_true;
25511 0 : n = sparsegetnrows(a, _state);
25512 0 : if( pivottype==0 )
25513 : {
25514 0 : pivottype = 2;
25515 : }
25516 0 : densificationsupported = pivottype==2;
25517 :
25518 : /*
25519 : *
25520 : */
25521 0 : buf->n = n;
25522 0 : ivectorsetlengthatleast(&buf->rowpermrawidx, n, _state);
25523 0 : for(i=0; i<=n-1; i++)
25524 : {
25525 0 : buf->rowpermrawidx.ptr.p_int[i] = i;
25526 : }
25527 :
25528 : /*
25529 : * Allocate storage for sparse L and U factors
25530 : *
25531 : * NOTE: SparseMatrix structure for these factors is only
25532 : * partially initialized; we use it just as a temporary
25533 : * storage and do not intend to use facilities of the
25534 : * 'sparse' subpackage to work with these objects.
25535 : */
25536 0 : buf->sparsel.matrixtype = 1;
25537 0 : buf->sparsel.m = n;
25538 0 : buf->sparsel.n = n;
25539 0 : ivectorsetlengthatleast(&buf->sparsel.ridx, n+1, _state);
25540 0 : buf->sparsel.ridx.ptr.p_int[0] = 0;
25541 0 : buf->sparseut.matrixtype = 1;
25542 0 : buf->sparseut.m = n;
25543 0 : buf->sparseut.n = n;
25544 0 : ivectorsetlengthatleast(&buf->sparseut.ridx, n+1, _state);
25545 0 : buf->sparseut.ridx.ptr.p_int[0] = 0;
25546 :
25547 : /*
25548 : * Allocate unprocessed yet part of the matrix,
25549 : * two submatrices:
25550 : * * BU, upper J rows of columns [J,N), upper submatrix
25551 : * * BL, left J cols of rows [J,N), left submatrix
25552 : * * B1, (N-J)*(N-J) square submatrix
25553 : */
25554 0 : sptrf_sluv2list1init(n, &buf->bleft, _state);
25555 0 : sptrf_sluv2list1init(n, &buf->bupper, _state);
25556 0 : ivectorsetlengthatleast(pr, n, _state);
25557 0 : ivectorsetlengthatleast(pc, n, _state);
25558 0 : ivectorsetlengthatleast(&buf->v0i, n, _state);
25559 0 : ivectorsetlengthatleast(&buf->v1i, n, _state);
25560 0 : rvectorsetlengthatleast(&buf->v0r, n, _state);
25561 0 : rvectorsetlengthatleast(&buf->v1r, n, _state);
25562 0 : sptrf_sparsetrailinit(a, &buf->strail, _state);
25563 :
25564 : /*
25565 : * Prepare dense trail, initial densification
25566 : */
25567 0 : sptrf_densetrailinit(&buf->dtrail, n, _state);
25568 0 : densifyabove = ae_round(sptrf_densebnd*n, _state)+1;
25569 0 : if( densificationsupported )
25570 : {
25571 0 : for(i=0; i<=n-1; i++)
25572 : {
25573 0 : if( buf->strail.nzc.ptr.p_int[i]>densifyabove )
25574 : {
25575 0 : sptrf_sparsetraildensify(&buf->strail, i, &buf->bupper, &buf->dtrail, _state);
25576 : }
25577 : }
25578 : }
25579 :
25580 : /*
25581 : * Process sparse part
25582 : */
25583 0 : for(k=0; k<=n-1; k++)
25584 : {
25585 :
25586 : /*
25587 : * Find pivot column and pivot row
25588 : */
25589 0 : if( !sptrf_sparsetrailfindpivot(&buf->strail, pivottype, &ibest, &jbest, _state) )
25590 : {
25591 :
25592 : /*
25593 : * Only densified columns are left, break sparse iteration
25594 : */
25595 0 : ae_assert(buf->dtrail.ndense+k==n, "SPTRF: integrity check failed (35741)", _state);
25596 0 : break;
25597 : }
25598 0 : pc->ptr.p_int[k] = jbest;
25599 0 : pr->ptr.p_int[k] = ibest;
25600 0 : j = buf->rowpermrawidx.ptr.p_int[k];
25601 0 : buf->rowpermrawidx.ptr.p_int[k] = buf->rowpermrawidx.ptr.p_int[ibest];
25602 0 : buf->rowpermrawidx.ptr.p_int[ibest] = j;
25603 :
25604 : /*
25605 : * Apply pivoting to BL and BU
25606 : */
25607 0 : sptrf_sluv2list1swap(&buf->bleft, k, ibest, _state);
25608 0 : sptrf_sluv2list1swap(&buf->bupper, k, jbest, _state);
25609 :
25610 : /*
25611 : * Apply pivoting to sparse trail, pivot out
25612 : */
25613 0 : sptrf_sparsetrailpivotout(&buf->strail, ibest, jbest, &uu, &buf->v0i, &buf->v0r, &nz0, &buf->v1i, &buf->v1r, &nz1, _state);
25614 0 : result = result&&uu!=0;
25615 :
25616 : /*
25617 : * Pivot dense trail
25618 : */
25619 0 : tmpndense = buf->dtrail.ndense;
25620 0 : for(i=0; i<=tmpndense-1; i++)
25621 : {
25622 0 : v = buf->dtrail.d.ptr.pp_double[k][i];
25623 0 : buf->dtrail.d.ptr.pp_double[k][i] = buf->dtrail.d.ptr.pp_double[ibest][i];
25624 0 : buf->dtrail.d.ptr.pp_double[ibest][i] = v;
25625 : }
25626 :
25627 : /*
25628 : * Output to LU matrix
25629 : */
25630 0 : sptrf_sluv2list1appendsequencetomatrix(&buf->bupper, k, ae_true, uu, n, &buf->sparseut, k, _state);
25631 0 : sptrf_sluv2list1appendsequencetomatrix(&buf->bleft, k, ae_false, 0.0, n, &buf->sparsel, k, _state);
25632 :
25633 : /*
25634 : * Extract K-th col/row of B1, generate K-th col/row of BL/BU, update NZC
25635 : */
25636 0 : sptrf_sluv2list1pushsparsevector(&buf->bleft, &buf->v0i, &buf->v0r, nz0, _state);
25637 0 : sptrf_sluv2list1pushsparsevector(&buf->bupper, &buf->v1i, &buf->v1r, nz1, _state);
25638 :
25639 : /*
25640 : * Update the rest of the matrix
25641 : */
25642 0 : if( nz0*(nz1+buf->dtrail.ndense)>0 )
25643 : {
25644 :
25645 : /*
25646 : * Update dense trail
25647 : *
25648 : * NOTE: this update MUST be performed before we update sparse trail,
25649 : * because sparse update may move columns to dense storage after
25650 : * update is performed on them. Thus, we have to avoid applying
25651 : * same update twice.
25652 : */
25653 0 : if( buf->dtrail.ndense>0 )
25654 : {
25655 0 : tmpndense = buf->dtrail.ndense;
25656 0 : for(i=0; i<=nz0-1; i++)
25657 : {
25658 0 : i0 = buf->v0i.ptr.p_int[i];
25659 0 : v0 = buf->v0r.ptr.p_double[i];
25660 0 : for(j=0; j<=tmpndense-1; j++)
25661 : {
25662 0 : buf->dtrail.d.ptr.pp_double[i0][j] = buf->dtrail.d.ptr.pp_double[i0][j]-v0*buf->dtrail.d.ptr.pp_double[k][j];
25663 : }
25664 : }
25665 : }
25666 :
25667 : /*
25668 : * Update sparse trail
25669 : */
25670 0 : sptrf_sparsetrailupdate(&buf->strail, &buf->v0i, &buf->v0r, nz0, &buf->v1i, &buf->v1r, nz1, &buf->bupper, &buf->dtrail, densificationsupported, _state);
25671 : }
25672 : }
25673 :
25674 : /*
25675 : * Process densified trail
25676 : */
25677 0 : if( buf->dtrail.ndense>0 )
25678 : {
25679 0 : tmpndense = buf->dtrail.ndense;
25680 :
25681 : /*
25682 : * Generate column pivots to bring actual order of columns in the
25683 : * working part of the matrix to one used for dense storage
25684 : */
25685 0 : for(i=n-tmpndense; i<=n-1; i++)
25686 : {
25687 0 : k = buf->dtrail.did.ptr.p_int[i-(n-tmpndense)];
25688 0 : jp = -1;
25689 0 : for(j=i; j<=n-1; j++)
25690 : {
25691 0 : if( buf->strail.colid.ptr.p_int[j]==k )
25692 : {
25693 0 : jp = j;
25694 0 : break;
25695 : }
25696 : }
25697 0 : ae_assert(jp>=0, "SPTRF: integrity check failed during reordering", _state);
25698 0 : k = buf->strail.colid.ptr.p_int[i];
25699 0 : buf->strail.colid.ptr.p_int[i] = buf->strail.colid.ptr.p_int[jp];
25700 0 : buf->strail.colid.ptr.p_int[jp] = k;
25701 0 : pc->ptr.p_int[i] = jp;
25702 : }
25703 :
25704 : /*
25705 : * Perform dense LU decomposition on dense trail
25706 : */
25707 0 : rmatrixsetlengthatleast(&buf->dbuf, buf->dtrail.ndense, buf->dtrail.ndense, _state);
25708 0 : for(i=0; i<=tmpndense-1; i++)
25709 : {
25710 0 : for(j=0; j<=tmpndense-1; j++)
25711 : {
25712 0 : buf->dbuf.ptr.pp_double[i][j] = buf->dtrail.d.ptr.pp_double[i+(n-tmpndense)][j];
25713 : }
25714 : }
25715 0 : rvectorsetlengthatleast(&buf->tmp0, 2*n, _state);
25716 0 : ivectorsetlengthatleast(&buf->tmpp, n, _state);
25717 0 : rmatrixplurec(&buf->dbuf, 0, tmpndense, tmpndense, &buf->tmpp, &buf->tmp0, _state);
25718 :
25719 : /*
25720 : * Convert indexes of rows pivots, swap elements of BLeft
25721 : */
25722 0 : for(i=0; i<=tmpndense-1; i++)
25723 : {
25724 0 : pr->ptr.p_int[i+(n-tmpndense)] = buf->tmpp.ptr.p_int[i]+(n-tmpndense);
25725 0 : sptrf_sluv2list1swap(&buf->bleft, i+(n-tmpndense), pr->ptr.p_int[i+(n-tmpndense)], _state);
25726 0 : j = buf->rowpermrawidx.ptr.p_int[i+(n-tmpndense)];
25727 0 : buf->rowpermrawidx.ptr.p_int[i+(n-tmpndense)] = buf->rowpermrawidx.ptr.p_int[pr->ptr.p_int[i+(n-tmpndense)]];
25728 0 : buf->rowpermrawidx.ptr.p_int[pr->ptr.p_int[i+(n-tmpndense)]] = j;
25729 : }
25730 :
25731 : /*
25732 : * Convert U-factor
25733 : */
25734 0 : ivectorgrowto(&buf->sparseut.idx, buf->sparseut.ridx.ptr.p_int[n-tmpndense]+n*tmpndense, _state);
25735 0 : rvectorgrowto(&buf->sparseut.vals, buf->sparseut.ridx.ptr.p_int[n-tmpndense]+n*tmpndense, _state);
25736 0 : for(j=0; j<=tmpndense-1; j++)
25737 : {
25738 0 : offs = buf->sparseut.ridx.ptr.p_int[j+(n-tmpndense)];
25739 0 : k = n-tmpndense;
25740 :
25741 : /*
25742 : * Convert leading N-NDense columns
25743 : */
25744 0 : for(i=0; i<=k-1; i++)
25745 : {
25746 0 : v = buf->dtrail.d.ptr.pp_double[i][j];
25747 0 : if( v!=0 )
25748 : {
25749 0 : buf->sparseut.idx.ptr.p_int[offs] = i;
25750 0 : buf->sparseut.vals.ptr.p_double[offs] = v;
25751 0 : offs = offs+1;
25752 : }
25753 : }
25754 :
25755 : /*
25756 : * Convert upper diagonal elements
25757 : */
25758 0 : for(i=0; i<=j-1; i++)
25759 : {
25760 0 : v = buf->dbuf.ptr.pp_double[i][j];
25761 0 : if( v!=0 )
25762 : {
25763 0 : buf->sparseut.idx.ptr.p_int[offs] = i+(n-tmpndense);
25764 0 : buf->sparseut.vals.ptr.p_double[offs] = v;
25765 0 : offs = offs+1;
25766 : }
25767 : }
25768 :
25769 : /*
25770 : * Convert diagonal element (always stored)
25771 : */
25772 0 : v = buf->dbuf.ptr.pp_double[j][j];
25773 0 : buf->sparseut.idx.ptr.p_int[offs] = j+(n-tmpndense);
25774 0 : buf->sparseut.vals.ptr.p_double[offs] = v;
25775 0 : offs = offs+1;
25776 0 : result = result&&v!=0;
25777 :
25778 : /*
25779 : * Column is done
25780 : */
25781 0 : buf->sparseut.ridx.ptr.p_int[j+(n-tmpndense)+1] = offs;
25782 : }
25783 :
25784 : /*
25785 : * Convert L-factor
25786 : */
25787 0 : ivectorgrowto(&buf->sparsel.idx, buf->sparsel.ridx.ptr.p_int[n-tmpndense]+n*tmpndense, _state);
25788 0 : rvectorgrowto(&buf->sparsel.vals, buf->sparsel.ridx.ptr.p_int[n-tmpndense]+n*tmpndense, _state);
25789 0 : for(i=0; i<=tmpndense-1; i++)
25790 : {
25791 0 : sptrf_sluv2list1appendsequencetomatrix(&buf->bleft, i+(n-tmpndense), ae_false, 0.0, n, &buf->sparsel, i+(n-tmpndense), _state);
25792 0 : offs = buf->sparsel.ridx.ptr.p_int[i+(n-tmpndense)+1];
25793 0 : for(j=0; j<=i-1; j++)
25794 : {
25795 0 : v = buf->dbuf.ptr.pp_double[i][j];
25796 0 : if( v!=0 )
25797 : {
25798 0 : buf->sparsel.idx.ptr.p_int[offs] = j+(n-tmpndense);
25799 0 : buf->sparsel.vals.ptr.p_double[offs] = v;
25800 0 : offs = offs+1;
25801 : }
25802 : }
25803 0 : buf->sparsel.ridx.ptr.p_int[i+(n-tmpndense)+1] = offs;
25804 : }
25805 : }
25806 :
25807 : /*
25808 : * Allocate output
25809 : */
25810 0 : ivectorsetlengthatleast(&buf->tmpi, n, _state);
25811 0 : for(i=0; i<=n-1; i++)
25812 : {
25813 0 : buf->tmpi.ptr.p_int[i] = buf->sparsel.ridx.ptr.p_int[i+1]-buf->sparsel.ridx.ptr.p_int[i];
25814 : }
25815 0 : for(i=0; i<=n-1; i++)
25816 : {
25817 0 : i0 = buf->sparseut.ridx.ptr.p_int[i];
25818 0 : i1 = buf->sparseut.ridx.ptr.p_int[i+1]-1;
25819 0 : for(j=i0; j<=i1; j++)
25820 : {
25821 0 : k = buf->sparseut.idx.ptr.p_int[j];
25822 0 : buf->tmpi.ptr.p_int[k] = buf->tmpi.ptr.p_int[k]+1;
25823 : }
25824 : }
25825 0 : a->matrixtype = 1;
25826 0 : a->ninitialized = buf->sparsel.ridx.ptr.p_int[n]+buf->sparseut.ridx.ptr.p_int[n];
25827 0 : a->m = n;
25828 0 : a->n = n;
25829 0 : ivectorsetlengthatleast(&a->ridx, n+1, _state);
25830 0 : ivectorsetlengthatleast(&a->idx, a->ninitialized, _state);
25831 0 : rvectorsetlengthatleast(&a->vals, a->ninitialized, _state);
25832 0 : a->ridx.ptr.p_int[0] = 0;
25833 0 : for(i=0; i<=n-1; i++)
25834 : {
25835 0 : a->ridx.ptr.p_int[i+1] = a->ridx.ptr.p_int[i]+buf->tmpi.ptr.p_int[i];
25836 : }
25837 0 : for(i=0; i<=n-1; i++)
25838 : {
25839 0 : i0 = buf->sparsel.ridx.ptr.p_int[i];
25840 0 : i1 = buf->sparsel.ridx.ptr.p_int[i+1]-1;
25841 0 : jp = a->ridx.ptr.p_int[i];
25842 0 : for(j=i0; j<=i1; j++)
25843 : {
25844 0 : a->idx.ptr.p_int[jp+(j-i0)] = buf->sparsel.idx.ptr.p_int[j];
25845 0 : a->vals.ptr.p_double[jp+(j-i0)] = buf->sparsel.vals.ptr.p_double[j];
25846 : }
25847 0 : buf->tmpi.ptr.p_int[i] = buf->sparsel.ridx.ptr.p_int[i+1]-buf->sparsel.ridx.ptr.p_int[i];
25848 : }
25849 0 : ivectorsetlengthatleast(&a->didx, n, _state);
25850 0 : ivectorsetlengthatleast(&a->uidx, n, _state);
25851 0 : for(i=0; i<=n-1; i++)
25852 : {
25853 0 : a->didx.ptr.p_int[i] = a->ridx.ptr.p_int[i]+buf->tmpi.ptr.p_int[i];
25854 0 : a->uidx.ptr.p_int[i] = a->didx.ptr.p_int[i]+1;
25855 0 : buf->tmpi.ptr.p_int[i] = a->didx.ptr.p_int[i];
25856 : }
25857 0 : for(i=0; i<=n-1; i++)
25858 : {
25859 0 : i0 = buf->sparseut.ridx.ptr.p_int[i];
25860 0 : i1 = buf->sparseut.ridx.ptr.p_int[i+1]-1;
25861 0 : for(j=i0; j<=i1; j++)
25862 : {
25863 0 : k = buf->sparseut.idx.ptr.p_int[j];
25864 0 : offs = buf->tmpi.ptr.p_int[k];
25865 0 : a->idx.ptr.p_int[offs] = i;
25866 0 : a->vals.ptr.p_double[offs] = buf->sparseut.vals.ptr.p_double[j];
25867 0 : buf->tmpi.ptr.p_int[k] = offs+1;
25868 : }
25869 : }
25870 0 : return result;
25871 : }
25872 :
25873 :
25874 : /*************************************************************************
25875 : This function initialized rectangular submatrix structure.
25876 :
25877 : After initialization this structure stores matrix[N,0], which contains N
25878 : rows (sequences), stored as single-linked lists.
25879 :
25880 : -- ALGLIB routine --
25881 : 15.01.2019
25882 : Bochkanov Sergey
25883 : *************************************************************************/
25884 0 : static void sptrf_sluv2list1init(ae_int_t n,
25885 : sluv2list1matrix* a,
25886 : ae_state *_state)
25887 : {
25888 : ae_int_t i;
25889 :
25890 :
25891 0 : ae_assert(n>=1, "SLUV2List1Init: N<1", _state);
25892 0 : a->nfixed = n;
25893 0 : a->ndynamic = 0;
25894 0 : a->nallocated = n;
25895 0 : a->nused = 0;
25896 0 : ivectorgrowto(&a->idxfirst, n, _state);
25897 0 : ivectorgrowto(&a->strgidx, 2*a->nallocated, _state);
25898 0 : rvectorgrowto(&a->strgval, a->nallocated, _state);
25899 0 : for(i=0; i<=n-1; i++)
25900 : {
25901 0 : a->idxfirst.ptr.p_int[i] = -1;
25902 : }
25903 0 : }
25904 :
25905 :
25906 : /*************************************************************************
25907 : This function swaps sequences #I and #J stored by the structure
25908 :
25909 : -- ALGLIB routine --
25910 : 15.01.2019
25911 : Bochkanov Sergey
25912 : *************************************************************************/
25913 0 : static void sptrf_sluv2list1swap(sluv2list1matrix* a,
25914 : ae_int_t i,
25915 : ae_int_t j,
25916 : ae_state *_state)
25917 : {
25918 : ae_int_t k;
25919 :
25920 :
25921 0 : k = a->idxfirst.ptr.p_int[i];
25922 0 : a->idxfirst.ptr.p_int[i] = a->idxfirst.ptr.p_int[j];
25923 0 : a->idxfirst.ptr.p_int[j] = k;
25924 0 : }
25925 :
25926 :
25927 : /*************************************************************************
25928 : This function drops sequence #I from the structure
25929 :
25930 : -- ALGLIB routine --
25931 : 15.01.2019
25932 : Bochkanov Sergey
25933 : *************************************************************************/
25934 0 : static void sptrf_sluv2list1dropsequence(sluv2list1matrix* a,
25935 : ae_int_t i,
25936 : ae_state *_state)
25937 : {
25938 :
25939 :
25940 0 : a->idxfirst.ptr.p_int[i] = -1;
25941 0 : }
25942 :
25943 :
25944 : /*************************************************************************
25945 : This function appends sequence from the structure to the sparse matrix.
25946 :
25947 : It is assumed that S is a lower triangular matrix, and A stores strictly
25948 : lower triangular elements (no diagonal ones!). You can explicitly control
25949 : whether you want to add diagonal elements or not.
25950 :
25951 : Output matrix is assumed to be stored in CRS format and to be partially
25952 : initialized (up to, but not including, Dst-th row). DIdx and UIdx are NOT
25953 : updated by this function as well as NInitialized.
25954 :
25955 : INPUT PARAMETERS:
25956 : A - rectangular matrix structure
25957 : Src - sequence (row or column) index in the structure
25958 : HasDiagonal - whether we want to add diagonal element
25959 : D - diagonal element, if HasDiagonal=True
25960 : NZMAX - maximum estimated number of non-zeros in the row,
25961 : this function will preallocate storage in the output
25962 : matrix.
25963 : S - destination matrix in CRS format, partially initialized
25964 : Dst - destination row index
25965 :
25966 :
25967 : -- ALGLIB routine --
25968 : 15.01.2019
25969 : Bochkanov Sergey
25970 : *************************************************************************/
25971 0 : static void sptrf_sluv2list1appendsequencetomatrix(sluv2list1matrix* a,
25972 : ae_int_t src,
25973 : ae_bool hasdiagonal,
25974 : double d,
25975 : ae_int_t nzmax,
25976 : sparsematrix* s,
25977 : ae_int_t dst,
25978 : ae_state *_state)
25979 : {
25980 : ae_int_t i;
25981 : ae_int_t i0;
25982 : ae_int_t i1;
25983 : ae_int_t jp;
25984 : ae_int_t nnz;
25985 :
25986 :
25987 0 : i0 = s->ridx.ptr.p_int[dst];
25988 0 : ivectorgrowto(&s->idx, i0+nzmax, _state);
25989 0 : rvectorgrowto(&s->vals, i0+nzmax, _state);
25990 0 : if( hasdiagonal )
25991 : {
25992 0 : i1 = i0+nzmax-1;
25993 0 : s->idx.ptr.p_int[i1] = dst;
25994 0 : s->vals.ptr.p_double[i1] = d;
25995 0 : nnz = 1;
25996 : }
25997 : else
25998 : {
25999 0 : i1 = i0+nzmax;
26000 0 : nnz = 0;
26001 : }
26002 0 : jp = a->idxfirst.ptr.p_int[src];
26003 0 : while(jp>=0)
26004 : {
26005 0 : i1 = i1-1;
26006 0 : s->idx.ptr.p_int[i1] = a->strgidx.ptr.p_int[2*jp+1];
26007 0 : s->vals.ptr.p_double[i1] = a->strgval.ptr.p_double[jp];
26008 0 : nnz = nnz+1;
26009 0 : jp = a->strgidx.ptr.p_int[2*jp+0];
26010 : }
26011 0 : for(i=0; i<=nnz-1; i++)
26012 : {
26013 0 : s->idx.ptr.p_int[i0+i] = s->idx.ptr.p_int[i1+i];
26014 0 : s->vals.ptr.p_double[i0+i] = s->vals.ptr.p_double[i1+i];
26015 : }
26016 0 : s->ridx.ptr.p_int[dst+1] = s->ridx.ptr.p_int[dst]+nnz;
26017 0 : }
26018 :
26019 :
26020 : /*************************************************************************
26021 : This function appends sparse column to the matrix, increasing its size
26022 : from [N,K] to [N,K+1]
26023 :
26024 : -- ALGLIB routine --
26025 : 15.01.2019
26026 : Bochkanov Sergey
26027 : *************************************************************************/
26028 0 : static void sptrf_sluv2list1pushsparsevector(sluv2list1matrix* a,
26029 : /* Integer */ ae_vector* si,
26030 : /* Real */ ae_vector* sv,
26031 : ae_int_t nz,
26032 : ae_state *_state)
26033 : {
26034 : ae_int_t idx;
26035 : ae_int_t i;
26036 : ae_int_t k;
26037 : ae_int_t nused;
26038 : double v;
26039 :
26040 :
26041 :
26042 : /*
26043 : * Fetch matrix size, increase
26044 : */
26045 0 : k = a->ndynamic;
26046 0 : ae_assert(k<a->nfixed, "Assertion failed", _state);
26047 0 : a->ndynamic = k+1;
26048 :
26049 : /*
26050 : * Allocate new storage if needed
26051 : */
26052 0 : nused = a->nused;
26053 0 : a->nallocated = ae_maxint(a->nallocated, nused+nz, _state);
26054 0 : ivectorgrowto(&a->strgidx, 2*a->nallocated, _state);
26055 0 : rvectorgrowto(&a->strgval, a->nallocated, _state);
26056 :
26057 : /*
26058 : * Append to list
26059 : */
26060 0 : for(idx=0; idx<=nz-1; idx++)
26061 : {
26062 0 : i = si->ptr.p_int[idx];
26063 0 : v = sv->ptr.p_double[idx];
26064 0 : a->strgidx.ptr.p_int[2*nused+0] = a->idxfirst.ptr.p_int[i];
26065 0 : a->strgidx.ptr.p_int[2*nused+1] = k;
26066 0 : a->strgval.ptr.p_double[nused] = v;
26067 0 : a->idxfirst.ptr.p_int[i] = nused;
26068 0 : nused = nused+1;
26069 : }
26070 0 : a->nused = nused;
26071 0 : }
26072 :
26073 :
26074 : /*************************************************************************
26075 : This function initializes dense trail, by default it is matrix[N,0]
26076 :
26077 : -- ALGLIB routine --
26078 : 15.01.2019
26079 : Bochkanov Sergey
26080 : *************************************************************************/
26081 0 : static void sptrf_densetrailinit(sluv2densetrail* d,
26082 : ae_int_t n,
26083 : ae_state *_state)
26084 : {
26085 : ae_int_t excessivesize;
26086 :
26087 :
26088 :
26089 : /*
26090 : * Note: excessive rows are allocated to accomodate for situation when
26091 : * this buffer is used to solve successive problems with increasing
26092 : * sizes.
26093 : */
26094 0 : excessivesize = ae_maxint(ae_round(1.333*n, _state), n, _state);
26095 0 : d->n = n;
26096 0 : d->ndense = 0;
26097 0 : ivectorsetlengthatleast(&d->did, n, _state);
26098 0 : if( d->d.rows<=excessivesize )
26099 : {
26100 0 : rmatrixsetlengthatleast(&d->d, n, 1, _state);
26101 : }
26102 : else
26103 : {
26104 0 : ae_matrix_set_length(&d->d, excessivesize, 1, _state);
26105 : }
26106 0 : }
26107 :
26108 :
26109 : /*************************************************************************
26110 : This function appends column with id=ID to the dense trail (column IDs are
26111 : integer numbers in [0,N) which can be used to track column permutations).
26112 :
26113 : -- ALGLIB routine --
26114 : 15.01.2019
26115 : Bochkanov Sergey
26116 : *************************************************************************/
26117 0 : static void sptrf_densetrailappendcolumn(sluv2densetrail* d,
26118 : /* Real */ ae_vector* x,
26119 : ae_int_t id,
26120 : ae_state *_state)
26121 : {
26122 : ae_int_t n;
26123 : ae_int_t i;
26124 : ae_int_t targetidx;
26125 :
26126 :
26127 0 : n = d->n;
26128 :
26129 : /*
26130 : * Reallocate storage
26131 : */
26132 0 : rmatrixgrowcolsto(&d->d, d->ndense+1, n, _state);
26133 :
26134 : /*
26135 : * Copy to dense storage:
26136 : * * BUpper
26137 : * * BTrail
26138 : * Remove from sparse storage
26139 : */
26140 0 : targetidx = d->ndense;
26141 0 : for(i=0; i<=n-1; i++)
26142 : {
26143 0 : d->d.ptr.pp_double[i][targetidx] = x->ptr.p_double[i];
26144 : }
26145 0 : d->did.ptr.p_int[targetidx] = id;
26146 0 : d->ndense = targetidx+1;
26147 0 : }
26148 :
26149 :
26150 : /*************************************************************************
26151 : This function initializes sparse trail from the sparse matrix. By default,
26152 : sparse trail spans columns and rows in [0,N) range. Subsequent pivoting
26153 : out of rows/columns changes its range to [K,N), [K+1,N) and so on.
26154 :
26155 : -- ALGLIB routine --
26156 : 15.01.2019
26157 : Bochkanov Sergey
26158 : *************************************************************************/
26159 0 : static void sptrf_sparsetrailinit(sparsematrix* s,
26160 : sluv2sparsetrail* a,
26161 : ae_state *_state)
26162 : {
26163 : ae_int_t i;
26164 : ae_int_t j;
26165 : ae_int_t n;
26166 : ae_int_t j0;
26167 : ae_int_t j1;
26168 : ae_int_t jj;
26169 : ae_int_t p;
26170 : ae_int_t slsused;
26171 :
26172 :
26173 0 : ae_assert(s->m==s->n, "SparseTrailInit: M<>N", _state);
26174 0 : ae_assert(s->matrixtype==1, "SparseTrailInit: non-CRS input", _state);
26175 0 : n = s->n;
26176 0 : a->n = s->n;
26177 0 : a->k = 0;
26178 0 : ivectorsetlengthatleast(&a->nzc, n, _state);
26179 0 : ivectorsetlengthatleast(&a->colid, n, _state);
26180 0 : rvectorsetlengthatleast(&a->tmp0, n, _state);
26181 0 : for(i=0; i<=n-1; i++)
26182 : {
26183 0 : a->colid.ptr.p_int[i] = i;
26184 : }
26185 0 : bvectorsetlengthatleast(&a->isdensified, n, _state);
26186 0 : for(i=0; i<=n-1; i++)
26187 : {
26188 0 : a->isdensified.ptr.p_bool[i] = ae_false;
26189 : }
26190 :
26191 : /*
26192 : * Working set of columns
26193 : */
26194 0 : a->maxwrkcnt = iboundval(ae_round(1+(double)n/(double)3, _state), 1, ae_minint(n, 50, _state), _state);
26195 0 : a->wrkcnt = 0;
26196 0 : ivectorsetlengthatleast(&a->wrkset, a->maxwrkcnt, _state);
26197 :
26198 : /*
26199 : * Sparse linked storage (SLS). Store CRS matrix to SLS format,
26200 : * row by row, starting from the last one.
26201 : */
26202 0 : ivectorsetlengthatleast(&a->slscolptr, n, _state);
26203 0 : ivectorsetlengthatleast(&a->slsrowptr, n, _state);
26204 0 : ivectorsetlengthatleast(&a->slsidx, s->ridx.ptr.p_int[n]*sptrf_slswidth, _state);
26205 0 : rvectorsetlengthatleast(&a->slsval, s->ridx.ptr.p_int[n], _state);
26206 0 : for(i=0; i<=n-1; i++)
26207 : {
26208 0 : a->nzc.ptr.p_int[i] = 0;
26209 : }
26210 0 : for(i=0; i<=n-1; i++)
26211 : {
26212 0 : a->slscolptr.ptr.p_int[i] = -1;
26213 0 : a->slsrowptr.ptr.p_int[i] = -1;
26214 : }
26215 0 : slsused = 0;
26216 0 : for(i=n-1; i>=0; i--)
26217 : {
26218 0 : j0 = s->ridx.ptr.p_int[i];
26219 0 : j1 = s->ridx.ptr.p_int[i+1]-1;
26220 0 : for(jj=j1; jj>=j0; jj--)
26221 : {
26222 0 : j = s->idx.ptr.p_int[jj];
26223 :
26224 : /*
26225 : * Update non-zero counts for columns
26226 : */
26227 0 : a->nzc.ptr.p_int[j] = a->nzc.ptr.p_int[j]+1;
26228 :
26229 : /*
26230 : * Insert into column list
26231 : */
26232 0 : p = a->slscolptr.ptr.p_int[j];
26233 0 : if( p>=0 )
26234 : {
26235 0 : a->slsidx.ptr.p_int[p*sptrf_slswidth+0] = slsused;
26236 : }
26237 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+0] = -1;
26238 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+1] = p;
26239 0 : a->slscolptr.ptr.p_int[j] = slsused;
26240 :
26241 : /*
26242 : * Insert into row list
26243 : */
26244 0 : p = a->slsrowptr.ptr.p_int[i];
26245 0 : if( p>=0 )
26246 : {
26247 0 : a->slsidx.ptr.p_int[p*sptrf_slswidth+2] = slsused;
26248 : }
26249 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+2] = -1;
26250 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+3] = p;
26251 0 : a->slsrowptr.ptr.p_int[i] = slsused;
26252 :
26253 : /*
26254 : * Store index and value
26255 : */
26256 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+4] = i;
26257 0 : a->slsidx.ptr.p_int[slsused*sptrf_slswidth+5] = j;
26258 0 : a->slsval.ptr.p_double[slsused] = s->vals.ptr.p_double[jj];
26259 0 : slsused = slsused+1;
26260 : }
26261 : }
26262 0 : a->slsused = slsused;
26263 0 : }
26264 :
26265 :
26266 : /*************************************************************************
26267 : This function searches for a appropriate pivot column/row.
26268 :
26269 : If there exists non-densified column, it returns indexes of pivot column
26270 : and row, with most sparse column selected for column pivoting, and largest
26271 : element selected for row pivoting. Function result is True.
26272 :
26273 : PivotType=1 means that no column pivoting is performed
26274 : PivotType=2 means that both column and row pivoting are supported
26275 :
26276 : If all columns were densified, False is returned.
26277 :
26278 : -- ALGLIB routine --
26279 : 15.01.2019
26280 : Bochkanov Sergey
26281 : *************************************************************************/
26282 0 : static ae_bool sptrf_sparsetrailfindpivot(sluv2sparsetrail* a,
26283 : ae_int_t pivottype,
26284 : ae_int_t* ipiv,
26285 : ae_int_t* jpiv,
26286 : ae_state *_state)
26287 : {
26288 : ae_int_t n;
26289 : ae_int_t k;
26290 : ae_int_t j;
26291 : ae_int_t jp;
26292 : ae_int_t entry;
26293 : ae_int_t nz;
26294 : ae_int_t maxwrknz;
26295 : ae_int_t nnzbest;
26296 : double s;
26297 : double bbest;
26298 : ae_int_t wrk0;
26299 : ae_int_t wrk1;
26300 : ae_bool result;
26301 :
26302 0 : *ipiv = 0;
26303 0 : *jpiv = 0;
26304 :
26305 0 : n = a->n;
26306 0 : k = a->k;
26307 0 : nnzbest = n+1;
26308 0 : *jpiv = -1;
26309 0 : *ipiv = -1;
26310 0 : result = ae_true;
26311 :
26312 : /*
26313 : * Select pivot column
26314 : */
26315 0 : if( pivottype==1 )
26316 : {
26317 :
26318 : /*
26319 : * No column pivoting
26320 : */
26321 0 : ae_assert(!a->isdensified.ptr.p_bool[k], "SparseTrailFindPivot: integrity check failed", _state);
26322 0 : *jpiv = k;
26323 : }
26324 : else
26325 : {
26326 :
26327 : /*
26328 : * Find pivot column
26329 : */
26330 : for(;;)
26331 : {
26332 :
26333 : /*
26334 : * Scan working set (if non-empty) for good columns
26335 : */
26336 0 : maxwrknz = a->maxwrknz;
26337 0 : for(j=0; j<=a->wrkcnt-1; j++)
26338 : {
26339 0 : jp = a->wrkset.ptr.p_int[j];
26340 0 : if( jp<k )
26341 : {
26342 0 : continue;
26343 : }
26344 0 : if( a->isdensified.ptr.p_bool[jp] )
26345 : {
26346 0 : continue;
26347 : }
26348 0 : nz = a->nzc.ptr.p_int[jp];
26349 0 : if( nz>maxwrknz )
26350 : {
26351 0 : continue;
26352 : }
26353 0 : if( *jpiv<0||nz<nnzbest )
26354 : {
26355 0 : nnzbest = nz;
26356 0 : *jpiv = jp;
26357 : }
26358 : }
26359 0 : if( *jpiv>=0 )
26360 : {
26361 0 : break;
26362 : }
26363 :
26364 : /*
26365 : * Well, nothing found. Recompute working set:
26366 : * * determine most sparse unprocessed yet column
26367 : * * gather all columns with density in [Wrk0,Wrk1) range,
26368 : * increase range, repeat, until working set is full
26369 : */
26370 0 : a->wrkcnt = 0;
26371 0 : a->maxwrknz = 0;
26372 0 : wrk0 = n+1;
26373 0 : for(jp=k; jp<=n-1; jp++)
26374 : {
26375 0 : if( !a->isdensified.ptr.p_bool[jp]&&a->nzc.ptr.p_int[jp]<wrk0 )
26376 : {
26377 0 : wrk0 = a->nzc.ptr.p_int[jp];
26378 : }
26379 : }
26380 0 : if( wrk0>n )
26381 : {
26382 :
26383 : /*
26384 : * Only densified columns are present, exit.
26385 : */
26386 0 : result = ae_false;
26387 0 : return result;
26388 : }
26389 0 : wrk1 = wrk0+1;
26390 0 : while(a->wrkcnt<a->maxwrkcnt&&wrk0<=n)
26391 : {
26392 :
26393 : /*
26394 : * Find columns with non-zero count in [Wrk0,Wrk1) range
26395 : */
26396 0 : for(jp=k; jp<=n-1; jp++)
26397 : {
26398 0 : if( a->wrkcnt==a->maxwrkcnt )
26399 : {
26400 0 : break;
26401 : }
26402 0 : if( a->isdensified.ptr.p_bool[jp] )
26403 : {
26404 0 : continue;
26405 : }
26406 0 : if( a->nzc.ptr.p_int[jp]>=wrk0&&a->nzc.ptr.p_int[jp]<wrk1 )
26407 : {
26408 0 : a->wrkset.ptr.p_int[a->wrkcnt] = jp;
26409 0 : a->wrkcnt = a->wrkcnt+1;
26410 0 : a->maxwrknz = ae_maxint(a->maxwrknz, a->nzc.ptr.p_int[jp], _state);
26411 : }
26412 : }
26413 :
26414 : /*
26415 : * Advance scan range
26416 : */
26417 0 : jp = ae_round(1.41*(wrk1-wrk0), _state)+1;
26418 0 : wrk0 = wrk1;
26419 0 : wrk1 = wrk0+jp;
26420 : }
26421 : }
26422 : }
26423 :
26424 : /*
26425 : * Select pivot row
26426 : */
26427 0 : bbest = (double)(0);
26428 0 : entry = a->slscolptr.ptr.p_int[*jpiv];
26429 0 : while(entry>=0)
26430 : {
26431 0 : s = ae_fabs(a->slsval.ptr.p_double[entry], _state);
26432 0 : if( *ipiv<0||ae_fp_greater(s,bbest) )
26433 : {
26434 0 : bbest = s;
26435 0 : *ipiv = a->slsidx.ptr.p_int[entry*sptrf_slswidth+4];
26436 : }
26437 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26438 : }
26439 0 : if( *ipiv<0 )
26440 : {
26441 0 : *ipiv = k;
26442 : }
26443 0 : return result;
26444 : }
26445 :
26446 :
26447 : /*************************************************************************
26448 : This function pivots out specified row and column.
26449 :
26450 : Sparse trail range changes from [K,N) to [K+1,N).
26451 :
26452 : V0I, V0R, V1I, V1R must be preallocated arrays[N].
26453 :
26454 : Following data are returned:
26455 : * UU - diagonal element (pivoted out), can be zero
26456 : * V0I, V0R, NZ0 - sparse column pivoted out to the left (after permutation
26457 : is applied to its elements) and divided by UU.
26458 : V0I is array[NZ0] which stores row indexes in [K+1,N) range, V0R stores
26459 : values.
26460 : * V1I, V1R, NZ1 - sparse row pivoted out to the top.
26461 :
26462 : -- ALGLIB routine --
26463 : 15.01.2019
26464 : Bochkanov Sergey
26465 : *************************************************************************/
26466 0 : static void sptrf_sparsetrailpivotout(sluv2sparsetrail* a,
26467 : ae_int_t ipiv,
26468 : ae_int_t jpiv,
26469 : double* uu,
26470 : /* Integer */ ae_vector* v0i,
26471 : /* Real */ ae_vector* v0r,
26472 : ae_int_t* nz0,
26473 : /* Integer */ ae_vector* v1i,
26474 : /* Real */ ae_vector* v1r,
26475 : ae_int_t* nz1,
26476 : ae_state *_state)
26477 : {
26478 : ae_int_t n;
26479 : ae_int_t k;
26480 : ae_int_t i;
26481 : ae_int_t j;
26482 : ae_int_t entry;
26483 : double v;
26484 : double s;
26485 : ae_bool vb;
26486 : ae_int_t pos0k;
26487 : ae_int_t pos0piv;
26488 : ae_int_t pprev;
26489 : ae_int_t pnext;
26490 : ae_int_t pnextnext;
26491 :
26492 0 : *uu = 0;
26493 0 : *nz0 = 0;
26494 0 : *nz1 = 0;
26495 :
26496 0 : n = a->n;
26497 0 : k = a->k;
26498 0 : ae_assert(k<n, "SparseTrailPivotOut: integrity check failed", _state);
26499 :
26500 : /*
26501 : * Pivot out column JPiv from the sparse linked storage:
26502 : * * remove column JPiv from the matrix
26503 : * * update column K:
26504 : * * change element indexes after it is permuted to JPiv
26505 : * * resort rows affected by move K->JPiv
26506 : *
26507 : * NOTE: this code leaves V0I/V0R/NZ0 in the unfinalized state,
26508 : * i.e. these arrays do not account for pivoting performed
26509 : * on rows. They will be post-processed later.
26510 : */
26511 0 : *nz0 = 0;
26512 0 : pos0k = -1;
26513 0 : pos0piv = -1;
26514 0 : entry = a->slscolptr.ptr.p_int[jpiv];
26515 0 : while(entry>=0)
26516 : {
26517 :
26518 : /*
26519 : * Offload element
26520 : */
26521 0 : i = a->slsidx.ptr.p_int[entry*sptrf_slswidth+4];
26522 0 : v0i->ptr.p_int[*nz0] = i;
26523 0 : v0r->ptr.p_double[*nz0] = a->slsval.ptr.p_double[entry];
26524 0 : if( i==k )
26525 : {
26526 0 : pos0k = *nz0;
26527 : }
26528 0 : if( i==ipiv )
26529 : {
26530 0 : pos0piv = *nz0;
26531 : }
26532 0 : *nz0 = *nz0+1;
26533 :
26534 : /*
26535 : * Remove element from the row list
26536 : */
26537 0 : pprev = a->slsidx.ptr.p_int[entry*sptrf_slswidth+2];
26538 0 : pnext = a->slsidx.ptr.p_int[entry*sptrf_slswidth+3];
26539 0 : if( pprev>=0 )
26540 : {
26541 0 : a->slsidx.ptr.p_int[pprev*sptrf_slswidth+3] = pnext;
26542 : }
26543 : else
26544 : {
26545 0 : a->slsrowptr.ptr.p_int[i] = pnext;
26546 : }
26547 0 : if( pnext>=0 )
26548 : {
26549 0 : a->slsidx.ptr.p_int[pnext*sptrf_slswidth+2] = pprev;
26550 : }
26551 :
26552 : /*
26553 : * Select next entry
26554 : */
26555 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26556 : }
26557 0 : entry = a->slscolptr.ptr.p_int[k];
26558 0 : a->slscolptr.ptr.p_int[jpiv] = entry;
26559 0 : while(entry>=0)
26560 : {
26561 :
26562 : /*
26563 : * Change column index
26564 : */
26565 0 : a->slsidx.ptr.p_int[entry*sptrf_slswidth+5] = jpiv;
26566 :
26567 : /*
26568 : * Next entry
26569 : */
26570 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26571 : }
26572 :
26573 : /*
26574 : * Post-process V0, account for pivoting.
26575 : * Compute diagonal element UU.
26576 : */
26577 0 : *uu = (double)(0);
26578 0 : if( pos0k>=0||pos0piv>=0 )
26579 : {
26580 :
26581 : /*
26582 : * Apply permutation to rows of pivoted out column, specific
26583 : * implementation depends on the sparsity at locations #Pos0K
26584 : * and #Pos0Piv of the V0 array.
26585 : */
26586 0 : if( pos0k>=0&&pos0piv>=0 )
26587 : {
26588 :
26589 : /*
26590 : * Obtain diagonal element
26591 : */
26592 0 : *uu = v0r->ptr.p_double[pos0piv];
26593 0 : if( *uu!=0 )
26594 : {
26595 0 : s = 1/(*uu);
26596 : }
26597 : else
26598 : {
26599 0 : s = (double)(1);
26600 : }
26601 :
26602 : /*
26603 : * Move pivoted out element, shift array by one in order
26604 : * to remove heading diagonal element (not needed here
26605 : * anymore).
26606 : */
26607 0 : v0r->ptr.p_double[pos0piv] = v0r->ptr.p_double[pos0k];
26608 0 : for(i=0; i<=*nz0-2; i++)
26609 : {
26610 0 : v0i->ptr.p_int[i] = v0i->ptr.p_int[i+1];
26611 0 : v0r->ptr.p_double[i] = v0r->ptr.p_double[i+1]*s;
26612 : }
26613 0 : *nz0 = *nz0-1;
26614 : }
26615 0 : if( pos0k>=0&&pos0piv<0 )
26616 : {
26617 :
26618 : /*
26619 : * Diagonal element is zero
26620 : */
26621 0 : *uu = (double)(0);
26622 :
26623 : /*
26624 : * Pivot out element, reorder array
26625 : */
26626 0 : v0i->ptr.p_int[pos0k] = ipiv;
26627 0 : for(i=pos0k; i<=*nz0-2; i++)
26628 : {
26629 0 : if( v0i->ptr.p_int[i]<v0i->ptr.p_int[i+1] )
26630 : {
26631 0 : break;
26632 : }
26633 0 : j = v0i->ptr.p_int[i];
26634 0 : v0i->ptr.p_int[i] = v0i->ptr.p_int[i+1];
26635 0 : v0i->ptr.p_int[i+1] = j;
26636 0 : v = v0r->ptr.p_double[i];
26637 0 : v0r->ptr.p_double[i] = v0r->ptr.p_double[i+1];
26638 0 : v0r->ptr.p_double[i+1] = v;
26639 : }
26640 : }
26641 0 : if( pos0k<0&&pos0piv>=0 )
26642 : {
26643 :
26644 : /*
26645 : * Get diagonal element
26646 : */
26647 0 : *uu = v0r->ptr.p_double[pos0piv];
26648 0 : if( *uu!=0 )
26649 : {
26650 0 : s = 1/(*uu);
26651 : }
26652 : else
26653 : {
26654 0 : s = (double)(1);
26655 : }
26656 :
26657 : /*
26658 : * Shift array past the pivoted in element by one
26659 : * in order to remove pivot
26660 : */
26661 0 : for(i=0; i<=pos0piv-1; i++)
26662 : {
26663 0 : v0r->ptr.p_double[i] = v0r->ptr.p_double[i]*s;
26664 : }
26665 0 : for(i=pos0piv; i<=*nz0-2; i++)
26666 : {
26667 0 : v0i->ptr.p_int[i] = v0i->ptr.p_int[i+1];
26668 0 : v0r->ptr.p_double[i] = v0r->ptr.p_double[i+1]*s;
26669 : }
26670 0 : *nz0 = *nz0-1;
26671 : }
26672 : }
26673 :
26674 : /*
26675 : * Pivot out row IPiv from the sparse linked storage:
26676 : * * remove row IPiv from the matrix
26677 : * * reindex elements of row K after it is permuted to IPiv
26678 : * * apply permutation to the cols of the pivoted out row,
26679 : * resort columns
26680 : */
26681 0 : *nz1 = 0;
26682 0 : entry = a->slsrowptr.ptr.p_int[ipiv];
26683 0 : while(entry>=0)
26684 : {
26685 :
26686 : /*
26687 : * Offload element
26688 : */
26689 0 : j = a->slsidx.ptr.p_int[entry*sptrf_slswidth+5];
26690 0 : v1i->ptr.p_int[*nz1] = j;
26691 0 : v1r->ptr.p_double[*nz1] = a->slsval.ptr.p_double[entry];
26692 0 : *nz1 = *nz1+1;
26693 :
26694 : /*
26695 : * Remove element from the column list
26696 : */
26697 0 : pprev = a->slsidx.ptr.p_int[entry*sptrf_slswidth+0];
26698 0 : pnext = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26699 0 : if( pprev>=0 )
26700 : {
26701 0 : a->slsidx.ptr.p_int[pprev*sptrf_slswidth+1] = pnext;
26702 : }
26703 : else
26704 : {
26705 0 : a->slscolptr.ptr.p_int[j] = pnext;
26706 : }
26707 0 : if( pnext>=0 )
26708 : {
26709 0 : a->slsidx.ptr.p_int[pnext*sptrf_slswidth+0] = pprev;
26710 : }
26711 :
26712 : /*
26713 : * Select next entry
26714 : */
26715 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+3];
26716 : }
26717 0 : a->slsrowptr.ptr.p_int[ipiv] = a->slsrowptr.ptr.p_int[k];
26718 0 : entry = a->slsrowptr.ptr.p_int[ipiv];
26719 0 : while(entry>=0)
26720 : {
26721 :
26722 : /*
26723 : * Change row index
26724 : */
26725 0 : a->slsidx.ptr.p_int[entry*sptrf_slswidth+4] = ipiv;
26726 :
26727 : /*
26728 : * Resort column affected by row pivoting
26729 : */
26730 0 : j = a->slsidx.ptr.p_int[entry*sptrf_slswidth+5];
26731 0 : pprev = a->slsidx.ptr.p_int[entry*sptrf_slswidth+0];
26732 0 : pnext = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26733 0 : while(pnext>=0&&a->slsidx.ptr.p_int[pnext*sptrf_slswidth+4]<ipiv)
26734 : {
26735 0 : pnextnext = a->slsidx.ptr.p_int[pnext*sptrf_slswidth+1];
26736 :
26737 : /*
26738 : * prev->next
26739 : */
26740 0 : if( pprev>=0 )
26741 : {
26742 0 : a->slsidx.ptr.p_int[pprev*sptrf_slswidth+1] = pnext;
26743 : }
26744 : else
26745 : {
26746 0 : a->slscolptr.ptr.p_int[j] = pnext;
26747 : }
26748 :
26749 : /*
26750 : * entry->prev, entry->next
26751 : */
26752 0 : a->slsidx.ptr.p_int[entry*sptrf_slswidth+0] = pnext;
26753 0 : a->slsidx.ptr.p_int[entry*sptrf_slswidth+1] = pnextnext;
26754 :
26755 : /*
26756 : * next->prev, next->next
26757 : */
26758 0 : a->slsidx.ptr.p_int[pnext*sptrf_slswidth+0] = pprev;
26759 0 : a->slsidx.ptr.p_int[pnext*sptrf_slswidth+1] = entry;
26760 :
26761 : /*
26762 : * nextnext->prev
26763 : */
26764 0 : if( pnextnext>=0 )
26765 : {
26766 0 : a->slsidx.ptr.p_int[pnextnext*sptrf_slswidth+0] = entry;
26767 : }
26768 :
26769 : /*
26770 : * PPrev, Item, PNext
26771 : */
26772 0 : pprev = pnext;
26773 0 : pnext = pnextnext;
26774 : }
26775 :
26776 : /*
26777 : * Next entry
26778 : */
26779 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+3];
26780 : }
26781 :
26782 : /*
26783 : * Reorder other structures
26784 : */
26785 0 : i = a->nzc.ptr.p_int[k];
26786 0 : a->nzc.ptr.p_int[k] = a->nzc.ptr.p_int[jpiv];
26787 0 : a->nzc.ptr.p_int[jpiv] = i;
26788 0 : i = a->colid.ptr.p_int[k];
26789 0 : a->colid.ptr.p_int[k] = a->colid.ptr.p_int[jpiv];
26790 0 : a->colid.ptr.p_int[jpiv] = i;
26791 0 : vb = a->isdensified.ptr.p_bool[k];
26792 0 : a->isdensified.ptr.p_bool[k] = a->isdensified.ptr.p_bool[jpiv];
26793 0 : a->isdensified.ptr.p_bool[jpiv] = vb;
26794 :
26795 : /*
26796 : * Handle removal of col/row #K
26797 : */
26798 0 : for(i=0; i<=*nz1-1; i++)
26799 : {
26800 0 : j = v1i->ptr.p_int[i];
26801 0 : a->nzc.ptr.p_int[j] = a->nzc.ptr.p_int[j]-1;
26802 : }
26803 0 : a->k = a->k+1;
26804 0 : }
26805 :
26806 :
26807 : /*************************************************************************
26808 : This function densifies I1-th column of the sparse trail.
26809 :
26810 : PARAMETERS:
26811 : A - sparse trail
26812 : I1 - column index
26813 : BUpper - upper rectangular submatrix, updated during densification
26814 : of the columns (densified columns are removed)
26815 : DTrail - dense trail, receives densified columns from sparse
26816 : trail and BUpper
26817 :
26818 : -- ALGLIB routine --
26819 : 15.01.2019
26820 : Bochkanov Sergey
26821 : *************************************************************************/
26822 0 : static void sptrf_sparsetraildensify(sluv2sparsetrail* a,
26823 : ae_int_t i1,
26824 : sluv2list1matrix* bupper,
26825 : sluv2densetrail* dtrail,
26826 : ae_state *_state)
26827 : {
26828 : ae_int_t n;
26829 : ae_int_t k;
26830 : ae_int_t i;
26831 : ae_int_t jp;
26832 : ae_int_t entry;
26833 : ae_int_t pprev;
26834 : ae_int_t pnext;
26835 :
26836 :
26837 0 : n = a->n;
26838 0 : k = a->k;
26839 0 : ae_assert(k<n, "SparseTrailDensify: integrity check failed", _state);
26840 0 : ae_assert(k<=i1, "SparseTrailDensify: integrity check failed", _state);
26841 0 : ae_assert(!a->isdensified.ptr.p_bool[i1], "SparseTrailDensify: integrity check failed", _state);
26842 :
26843 : /*
26844 : * Offload items [0,K) of densified column from BUpper
26845 : */
26846 0 : for(i=0; i<=n-1; i++)
26847 : {
26848 0 : a->tmp0.ptr.p_double[i] = (double)(0);
26849 : }
26850 0 : jp = bupper->idxfirst.ptr.p_int[i1];
26851 0 : while(jp>=0)
26852 : {
26853 0 : a->tmp0.ptr.p_double[bupper->strgidx.ptr.p_int[2*jp+1]] = bupper->strgval.ptr.p_double[jp];
26854 0 : jp = bupper->strgidx.ptr.p_int[2*jp+0];
26855 : }
26856 0 : sptrf_sluv2list1dropsequence(bupper, i1, _state);
26857 :
26858 : /*
26859 : * Offload items [K,N) of densified column from BLeft
26860 : */
26861 0 : entry = a->slscolptr.ptr.p_int[i1];
26862 0 : while(entry>=0)
26863 : {
26864 :
26865 : /*
26866 : * Offload element
26867 : */
26868 0 : i = a->slsidx.ptr.p_int[entry*sptrf_slswidth+4];
26869 0 : a->tmp0.ptr.p_double[i] = a->slsval.ptr.p_double[entry];
26870 :
26871 : /*
26872 : * Remove element from the row list
26873 : */
26874 0 : pprev = a->slsidx.ptr.p_int[entry*sptrf_slswidth+2];
26875 0 : pnext = a->slsidx.ptr.p_int[entry*sptrf_slswidth+3];
26876 0 : if( pprev>=0 )
26877 : {
26878 0 : a->slsidx.ptr.p_int[pprev*sptrf_slswidth+3] = pnext;
26879 : }
26880 : else
26881 : {
26882 0 : a->slsrowptr.ptr.p_int[i] = pnext;
26883 : }
26884 0 : if( pnext>=0 )
26885 : {
26886 0 : a->slsidx.ptr.p_int[pnext*sptrf_slswidth+2] = pprev;
26887 : }
26888 :
26889 : /*
26890 : * Select next entry
26891 : */
26892 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
26893 : }
26894 :
26895 : /*
26896 : * Densify
26897 : */
26898 0 : a->nzc.ptr.p_int[i1] = 0;
26899 0 : a->isdensified.ptr.p_bool[i1] = ae_true;
26900 0 : a->slscolptr.ptr.p_int[i1] = -1;
26901 0 : sptrf_densetrailappendcolumn(dtrail, &a->tmp0, a->colid.ptr.p_int[i1], _state);
26902 0 : }
26903 :
26904 :
26905 : /*************************************************************************
26906 : This function appends rank-1 update to the sparse trail. Dense trail is
26907 : not updated here, but we may move some columns to dense trail during
26908 : update (i.e. densify them). Thus, you have to update dense trail BEFORE
26909 : you start updating sparse one (otherwise, recently densified columns will
26910 : be updated twice).
26911 :
26912 : PARAMETERS:
26913 : A - sparse trail
26914 : V0I, V0R - update column returned by SparseTrailPivotOut (MUST be
26915 : array[N] independently of the NZ0).
26916 : NZ0 - non-zero count for update column
26917 : V1I, V1R - update row returned by SparseTrailPivotOut
26918 : NZ1 - non-zero count for update row
26919 : BUpper - upper rectangular submatrix, updated during densification
26920 : of the columns (densified columns are removed)
26921 : DTrail - dense trail, receives densified columns from sparse
26922 : trail and BUpper
26923 : DensificationSupported- if False, no densification is performed
26924 :
26925 : -- ALGLIB routine --
26926 : 15.01.2019
26927 : Bochkanov Sergey
26928 : *************************************************************************/
26929 0 : static void sptrf_sparsetrailupdate(sluv2sparsetrail* a,
26930 : /* Integer */ ae_vector* v0i,
26931 : /* Real */ ae_vector* v0r,
26932 : ae_int_t nz0,
26933 : /* Integer */ ae_vector* v1i,
26934 : /* Real */ ae_vector* v1r,
26935 : ae_int_t nz1,
26936 : sluv2list1matrix* bupper,
26937 : sluv2densetrail* dtrail,
26938 : ae_bool densificationsupported,
26939 : ae_state *_state)
26940 : {
26941 : ae_int_t n;
26942 : ae_int_t k;
26943 : ae_int_t i;
26944 : ae_int_t j;
26945 : ae_int_t i0;
26946 : ae_int_t i1;
26947 : double v1;
26948 : ae_int_t densifyabove;
26949 : ae_int_t nnz;
26950 : ae_int_t entry;
26951 : ae_int_t newentry;
26952 : ae_int_t pprev;
26953 : ae_int_t pnext;
26954 : ae_int_t p;
26955 : ae_int_t nexti;
26956 : ae_int_t newoffs;
26957 :
26958 :
26959 0 : n = a->n;
26960 0 : k = a->k;
26961 0 : ae_assert(k<n, "SparseTrailPivotOut: integrity check failed", _state);
26962 0 : densifyabove = ae_round(sptrf_densebnd*(n-k), _state)+1;
26963 0 : ae_assert(v0i->cnt>=nz0+1, "SparseTrailUpdate: integrity check failed", _state);
26964 0 : ae_assert(v0r->cnt>=nz0+1, "SparseTrailUpdate: integrity check failed", _state);
26965 0 : v0i->ptr.p_int[nz0] = -1;
26966 0 : v0r->ptr.p_double[nz0] = (double)(0);
26967 :
26968 : /*
26969 : * Update sparse representation
26970 : */
26971 0 : ivectorgrowto(&a->slsidx, (a->slsused+nz0*nz1)*sptrf_slswidth, _state);
26972 0 : rvectorgrowto(&a->slsval, a->slsused+nz0*nz1, _state);
26973 0 : for(j=0; j<=nz1-1; j++)
26974 : {
26975 0 : if( nz0==0 )
26976 : {
26977 0 : continue;
26978 : }
26979 0 : i1 = v1i->ptr.p_int[j];
26980 0 : v1 = v1r->ptr.p_double[j];
26981 :
26982 : /*
26983 : * Update column #I1
26984 : */
26985 0 : nnz = a->nzc.ptr.p_int[i1];
26986 0 : i = 0;
26987 0 : i0 = v0i->ptr.p_int[i];
26988 0 : entry = a->slscolptr.ptr.p_int[i1];
26989 0 : pprev = -1;
26990 0 : while(i<nz0)
26991 : {
26992 :
26993 : /*
26994 : * Handle possible fill-in happening BEFORE already existing
26995 : * entry of the column list (or simply fill-in, if no entry
26996 : * is present).
26997 : */
26998 0 : pnext = entry;
26999 0 : if( entry>=0 )
27000 : {
27001 0 : nexti = a->slsidx.ptr.p_int[entry*sptrf_slswidth+4];
27002 : }
27003 : else
27004 : {
27005 0 : nexti = n+1;
27006 : }
27007 0 : while(i<nz0)
27008 : {
27009 0 : if( i0>=nexti )
27010 : {
27011 0 : break;
27012 : }
27013 :
27014 : /*
27015 : * Allocate new entry, store column/row/value
27016 : */
27017 0 : newentry = a->slsused;
27018 0 : a->slsused = newentry+1;
27019 0 : nnz = nnz+1;
27020 0 : newoffs = newentry*sptrf_slswidth;
27021 0 : a->slsidx.ptr.p_int[newoffs+4] = i0;
27022 0 : a->slsidx.ptr.p_int[newoffs+5] = i1;
27023 0 : a->slsval.ptr.p_double[newentry] = -v1*v0r->ptr.p_double[i];
27024 :
27025 : /*
27026 : * Insert entry into column list
27027 : */
27028 0 : a->slsidx.ptr.p_int[newoffs+0] = pprev;
27029 0 : a->slsidx.ptr.p_int[newoffs+1] = pnext;
27030 0 : if( pprev>=0 )
27031 : {
27032 0 : a->slsidx.ptr.p_int[pprev*sptrf_slswidth+1] = newentry;
27033 : }
27034 : else
27035 : {
27036 0 : a->slscolptr.ptr.p_int[i1] = newentry;
27037 : }
27038 0 : if( entry>=0 )
27039 : {
27040 0 : a->slsidx.ptr.p_int[entry*sptrf_slswidth+0] = newentry;
27041 : }
27042 :
27043 : /*
27044 : * Insert entry into row list
27045 : */
27046 0 : p = a->slsrowptr.ptr.p_int[i0];
27047 0 : a->slsidx.ptr.p_int[newoffs+2] = -1;
27048 0 : a->slsidx.ptr.p_int[newoffs+3] = p;
27049 0 : if( p>=0 )
27050 : {
27051 0 : a->slsidx.ptr.p_int[p*sptrf_slswidth+2] = newentry;
27052 : }
27053 0 : a->slsrowptr.ptr.p_int[i0] = newentry;
27054 :
27055 : /*
27056 : * Advance pointers
27057 : */
27058 0 : pprev = newentry;
27059 0 : i = i+1;
27060 0 : i0 = v0i->ptr.p_int[i];
27061 : }
27062 0 : if( i>=nz0 )
27063 : {
27064 0 : break;
27065 : }
27066 :
27067 : /*
27068 : * Update already existing entry of the column list, if needed
27069 : */
27070 0 : if( entry>=0 )
27071 : {
27072 0 : if( i0==nexti )
27073 : {
27074 0 : a->slsval.ptr.p_double[entry] = a->slsval.ptr.p_double[entry]-v1*v0r->ptr.p_double[i];
27075 0 : i = i+1;
27076 0 : i0 = v0i->ptr.p_int[i];
27077 : }
27078 0 : pprev = entry;
27079 : }
27080 :
27081 : /*
27082 : * Advance to the next pre-existing entry (if present)
27083 : */
27084 0 : if( entry>=0 )
27085 : {
27086 0 : entry = a->slsidx.ptr.p_int[entry*sptrf_slswidth+1];
27087 : }
27088 : }
27089 0 : a->nzc.ptr.p_int[i1] = nnz;
27090 :
27091 : /*
27092 : * Densify column if needed
27093 : */
27094 0 : if( (densificationsupported&&nnz>densifyabove)&&!a->isdensified.ptr.p_bool[i1] )
27095 : {
27096 0 : sptrf_sparsetraildensify(a, i1, bupper, dtrail, _state);
27097 : }
27098 : }
27099 0 : }
27100 :
27101 :
27102 0 : void _sluv2list1matrix_init(void* _p, ae_state *_state, ae_bool make_automatic)
27103 : {
27104 0 : sluv2list1matrix *p = (sluv2list1matrix*)_p;
27105 0 : ae_touch_ptr((void*)p);
27106 0 : ae_vector_init(&p->idxfirst, 0, DT_INT, _state, make_automatic);
27107 0 : ae_vector_init(&p->strgidx, 0, DT_INT, _state, make_automatic);
27108 0 : ae_vector_init(&p->strgval, 0, DT_REAL, _state, make_automatic);
27109 0 : }
27110 :
27111 :
27112 0 : void _sluv2list1matrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
27113 : {
27114 0 : sluv2list1matrix *dst = (sluv2list1matrix*)_dst;
27115 0 : sluv2list1matrix *src = (sluv2list1matrix*)_src;
27116 0 : dst->nfixed = src->nfixed;
27117 0 : dst->ndynamic = src->ndynamic;
27118 0 : ae_vector_init_copy(&dst->idxfirst, &src->idxfirst, _state, make_automatic);
27119 0 : ae_vector_init_copy(&dst->strgidx, &src->strgidx, _state, make_automatic);
27120 0 : ae_vector_init_copy(&dst->strgval, &src->strgval, _state, make_automatic);
27121 0 : dst->nallocated = src->nallocated;
27122 0 : dst->nused = src->nused;
27123 0 : }
27124 :
27125 :
27126 0 : void _sluv2list1matrix_clear(void* _p)
27127 : {
27128 0 : sluv2list1matrix *p = (sluv2list1matrix*)_p;
27129 0 : ae_touch_ptr((void*)p);
27130 0 : ae_vector_clear(&p->idxfirst);
27131 0 : ae_vector_clear(&p->strgidx);
27132 0 : ae_vector_clear(&p->strgval);
27133 0 : }
27134 :
27135 :
27136 0 : void _sluv2list1matrix_destroy(void* _p)
27137 : {
27138 0 : sluv2list1matrix *p = (sluv2list1matrix*)_p;
27139 0 : ae_touch_ptr((void*)p);
27140 0 : ae_vector_destroy(&p->idxfirst);
27141 0 : ae_vector_destroy(&p->strgidx);
27142 0 : ae_vector_destroy(&p->strgval);
27143 0 : }
27144 :
27145 :
27146 0 : void _sluv2sparsetrail_init(void* _p, ae_state *_state, ae_bool make_automatic)
27147 : {
27148 0 : sluv2sparsetrail *p = (sluv2sparsetrail*)_p;
27149 0 : ae_touch_ptr((void*)p);
27150 0 : ae_vector_init(&p->nzc, 0, DT_INT, _state, make_automatic);
27151 0 : ae_vector_init(&p->wrkset, 0, DT_INT, _state, make_automatic);
27152 0 : ae_vector_init(&p->colid, 0, DT_INT, _state, make_automatic);
27153 0 : ae_vector_init(&p->isdensified, 0, DT_BOOL, _state, make_automatic);
27154 0 : ae_vector_init(&p->slscolptr, 0, DT_INT, _state, make_automatic);
27155 0 : ae_vector_init(&p->slsrowptr, 0, DT_INT, _state, make_automatic);
27156 0 : ae_vector_init(&p->slsidx, 0, DT_INT, _state, make_automatic);
27157 0 : ae_vector_init(&p->slsval, 0, DT_REAL, _state, make_automatic);
27158 0 : ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic);
27159 0 : }
27160 :
27161 :
27162 0 : void _sluv2sparsetrail_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
27163 : {
27164 0 : sluv2sparsetrail *dst = (sluv2sparsetrail*)_dst;
27165 0 : sluv2sparsetrail *src = (sluv2sparsetrail*)_src;
27166 0 : dst->n = src->n;
27167 0 : dst->k = src->k;
27168 0 : ae_vector_init_copy(&dst->nzc, &src->nzc, _state, make_automatic);
27169 0 : dst->maxwrkcnt = src->maxwrkcnt;
27170 0 : dst->maxwrknz = src->maxwrknz;
27171 0 : dst->wrkcnt = src->wrkcnt;
27172 0 : ae_vector_init_copy(&dst->wrkset, &src->wrkset, _state, make_automatic);
27173 0 : ae_vector_init_copy(&dst->colid, &src->colid, _state, make_automatic);
27174 0 : ae_vector_init_copy(&dst->isdensified, &src->isdensified, _state, make_automatic);
27175 0 : ae_vector_init_copy(&dst->slscolptr, &src->slscolptr, _state, make_automatic);
27176 0 : ae_vector_init_copy(&dst->slsrowptr, &src->slsrowptr, _state, make_automatic);
27177 0 : ae_vector_init_copy(&dst->slsidx, &src->slsidx, _state, make_automatic);
27178 0 : ae_vector_init_copy(&dst->slsval, &src->slsval, _state, make_automatic);
27179 0 : dst->slsused = src->slsused;
27180 0 : ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic);
27181 0 : }
27182 :
27183 :
27184 0 : void _sluv2sparsetrail_clear(void* _p)
27185 : {
27186 0 : sluv2sparsetrail *p = (sluv2sparsetrail*)_p;
27187 0 : ae_touch_ptr((void*)p);
27188 0 : ae_vector_clear(&p->nzc);
27189 0 : ae_vector_clear(&p->wrkset);
27190 0 : ae_vector_clear(&p->colid);
27191 0 : ae_vector_clear(&p->isdensified);
27192 0 : ae_vector_clear(&p->slscolptr);
27193 0 : ae_vector_clear(&p->slsrowptr);
27194 0 : ae_vector_clear(&p->slsidx);
27195 0 : ae_vector_clear(&p->slsval);
27196 0 : ae_vector_clear(&p->tmp0);
27197 0 : }
27198 :
27199 :
27200 0 : void _sluv2sparsetrail_destroy(void* _p)
27201 : {
27202 0 : sluv2sparsetrail *p = (sluv2sparsetrail*)_p;
27203 0 : ae_touch_ptr((void*)p);
27204 0 : ae_vector_destroy(&p->nzc);
27205 0 : ae_vector_destroy(&p->wrkset);
27206 0 : ae_vector_destroy(&p->colid);
27207 0 : ae_vector_destroy(&p->isdensified);
27208 0 : ae_vector_destroy(&p->slscolptr);
27209 0 : ae_vector_destroy(&p->slsrowptr);
27210 0 : ae_vector_destroy(&p->slsidx);
27211 0 : ae_vector_destroy(&p->slsval);
27212 0 : ae_vector_destroy(&p->tmp0);
27213 0 : }
27214 :
27215 :
27216 0 : void _sluv2densetrail_init(void* _p, ae_state *_state, ae_bool make_automatic)
27217 : {
27218 0 : sluv2densetrail *p = (sluv2densetrail*)_p;
27219 0 : ae_touch_ptr((void*)p);
27220 0 : ae_matrix_init(&p->d, 0, 0, DT_REAL, _state, make_automatic);
27221 0 : ae_vector_init(&p->did, 0, DT_INT, _state, make_automatic);
27222 0 : }
27223 :
27224 :
27225 0 : void _sluv2densetrail_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
27226 : {
27227 0 : sluv2densetrail *dst = (sluv2densetrail*)_dst;
27228 0 : sluv2densetrail *src = (sluv2densetrail*)_src;
27229 0 : dst->n = src->n;
27230 0 : dst->ndense = src->ndense;
27231 0 : ae_matrix_init_copy(&dst->d, &src->d, _state, make_automatic);
27232 0 : ae_vector_init_copy(&dst->did, &src->did, _state, make_automatic);
27233 0 : }
27234 :
27235 :
27236 0 : void _sluv2densetrail_clear(void* _p)
27237 : {
27238 0 : sluv2densetrail *p = (sluv2densetrail*)_p;
27239 0 : ae_touch_ptr((void*)p);
27240 0 : ae_matrix_clear(&p->d);
27241 0 : ae_vector_clear(&p->did);
27242 0 : }
27243 :
27244 :
27245 0 : void _sluv2densetrail_destroy(void* _p)
27246 : {
27247 0 : sluv2densetrail *p = (sluv2densetrail*)_p;
27248 0 : ae_touch_ptr((void*)p);
27249 0 : ae_matrix_destroy(&p->d);
27250 0 : ae_vector_destroy(&p->did);
27251 0 : }
27252 :
27253 :
27254 0 : void _sluv2buffer_init(void* _p, ae_state *_state, ae_bool make_automatic)
27255 : {
27256 0 : sluv2buffer *p = (sluv2buffer*)_p;
27257 0 : ae_touch_ptr((void*)p);
27258 0 : _sparsematrix_init(&p->sparsel, _state, make_automatic);
27259 0 : _sparsematrix_init(&p->sparseut, _state, make_automatic);
27260 0 : _sluv2list1matrix_init(&p->bleft, _state, make_automatic);
27261 0 : _sluv2list1matrix_init(&p->bupper, _state, make_automatic);
27262 0 : _sluv2sparsetrail_init(&p->strail, _state, make_automatic);
27263 0 : _sluv2densetrail_init(&p->dtrail, _state, make_automatic);
27264 0 : ae_vector_init(&p->rowpermrawidx, 0, DT_INT, _state, make_automatic);
27265 0 : ae_matrix_init(&p->dbuf, 0, 0, DT_REAL, _state, make_automatic);
27266 0 : ae_vector_init(&p->v0i, 0, DT_INT, _state, make_automatic);
27267 0 : ae_vector_init(&p->v1i, 0, DT_INT, _state, make_automatic);
27268 0 : ae_vector_init(&p->v0r, 0, DT_REAL, _state, make_automatic);
27269 0 : ae_vector_init(&p->v1r, 0, DT_REAL, _state, make_automatic);
27270 0 : ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic);
27271 0 : ae_vector_init(&p->tmpi, 0, DT_INT, _state, make_automatic);
27272 0 : ae_vector_init(&p->tmpp, 0, DT_INT, _state, make_automatic);
27273 0 : }
27274 :
27275 :
27276 0 : void _sluv2buffer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
27277 : {
27278 0 : sluv2buffer *dst = (sluv2buffer*)_dst;
27279 0 : sluv2buffer *src = (sluv2buffer*)_src;
27280 0 : dst->n = src->n;
27281 0 : _sparsematrix_init_copy(&dst->sparsel, &src->sparsel, _state, make_automatic);
27282 0 : _sparsematrix_init_copy(&dst->sparseut, &src->sparseut, _state, make_automatic);
27283 0 : _sluv2list1matrix_init_copy(&dst->bleft, &src->bleft, _state, make_automatic);
27284 0 : _sluv2list1matrix_init_copy(&dst->bupper, &src->bupper, _state, make_automatic);
27285 0 : _sluv2sparsetrail_init_copy(&dst->strail, &src->strail, _state, make_automatic);
27286 0 : _sluv2densetrail_init_copy(&dst->dtrail, &src->dtrail, _state, make_automatic);
27287 0 : ae_vector_init_copy(&dst->rowpermrawidx, &src->rowpermrawidx, _state, make_automatic);
27288 0 : ae_matrix_init_copy(&dst->dbuf, &src->dbuf, _state, make_automatic);
27289 0 : ae_vector_init_copy(&dst->v0i, &src->v0i, _state, make_automatic);
27290 0 : ae_vector_init_copy(&dst->v1i, &src->v1i, _state, make_automatic);
27291 0 : ae_vector_init_copy(&dst->v0r, &src->v0r, _state, make_automatic);
27292 0 : ae_vector_init_copy(&dst->v1r, &src->v1r, _state, make_automatic);
27293 0 : ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic);
27294 0 : ae_vector_init_copy(&dst->tmpi, &src->tmpi, _state, make_automatic);
27295 0 : ae_vector_init_copy(&dst->tmpp, &src->tmpp, _state, make_automatic);
27296 0 : }
27297 :
27298 :
27299 0 : void _sluv2buffer_clear(void* _p)
27300 : {
27301 0 : sluv2buffer *p = (sluv2buffer*)_p;
27302 0 : ae_touch_ptr((void*)p);
27303 0 : _sparsematrix_clear(&p->sparsel);
27304 0 : _sparsematrix_clear(&p->sparseut);
27305 0 : _sluv2list1matrix_clear(&p->bleft);
27306 0 : _sluv2list1matrix_clear(&p->bupper);
27307 0 : _sluv2sparsetrail_clear(&p->strail);
27308 0 : _sluv2densetrail_clear(&p->dtrail);
27309 0 : ae_vector_clear(&p->rowpermrawidx);
27310 0 : ae_matrix_clear(&p->dbuf);
27311 0 : ae_vector_clear(&p->v0i);
27312 0 : ae_vector_clear(&p->v1i);
27313 0 : ae_vector_clear(&p->v0r);
27314 0 : ae_vector_clear(&p->v1r);
27315 0 : ae_vector_clear(&p->tmp0);
27316 0 : ae_vector_clear(&p->tmpi);
27317 0 : ae_vector_clear(&p->tmpp);
27318 0 : }
27319 :
27320 :
27321 0 : void _sluv2buffer_destroy(void* _p)
27322 : {
27323 0 : sluv2buffer *p = (sluv2buffer*)_p;
27324 0 : ae_touch_ptr((void*)p);
27325 0 : _sparsematrix_destroy(&p->sparsel);
27326 0 : _sparsematrix_destroy(&p->sparseut);
27327 0 : _sluv2list1matrix_destroy(&p->bleft);
27328 0 : _sluv2list1matrix_destroy(&p->bupper);
27329 0 : _sluv2sparsetrail_destroy(&p->strail);
27330 0 : _sluv2densetrail_destroy(&p->dtrail);
27331 0 : ae_vector_destroy(&p->rowpermrawidx);
27332 0 : ae_matrix_destroy(&p->dbuf);
27333 0 : ae_vector_destroy(&p->v0i);
27334 0 : ae_vector_destroy(&p->v1i);
27335 0 : ae_vector_destroy(&p->v0r);
27336 0 : ae_vector_destroy(&p->v1r);
27337 0 : ae_vector_destroy(&p->tmp0);
27338 0 : ae_vector_destroy(&p->tmpi);
27339 0 : ae_vector_destroy(&p->tmpp);
27340 0 : }
27341 :
27342 :
27343 : #endif
27344 : #if defined(AE_COMPILE_AMDORDERING) || !defined(AE_PARTIAL_BUILD)
27345 :
27346 :
27347 : /*************************************************************************
27348 : This function generates approximate minimum degree ordering
27349 :
27350 : INPUT PARAMETERS
27351 : A - lower triangular sparse matrix in CRS format
27352 : N - problem size
27353 : Buf - reusable buffer object, does not need special initialization
27354 :
27355 : OUTPUT PARAMETERS
27356 : Perm - array[N], maps original indexes I to permuted indexes
27357 : InvPerm - array[N], maps permuted indexes I to original indexes
27358 :
27359 : NOTE: definite 'DEBUG.SLOW' trace tag will activate extra-slow (roughly
27360 : N^3 ops) integrity checks, in addition to cheap O(1) ones.
27361 :
27362 : -- ALGLIB PROJECT --
27363 : Copyright 05.10.2020 by Bochkanov Sergey.
27364 : *************************************************************************/
27365 0 : void generateamdpermutation(sparsematrix* a,
27366 : ae_int_t n,
27367 : /* Integer */ ae_vector* perm,
27368 : /* Integer */ ae_vector* invperm,
27369 : amdbuffer* buf,
27370 : ae_state *_state)
27371 : {
27372 : ae_int_t i;
27373 : ae_int_t j;
27374 : ae_int_t k;
27375 : ae_int_t p;
27376 : ae_int_t setprealloc;
27377 : ae_int_t inithashbucketsize;
27378 : ae_bool extendeddebug;
27379 : ae_int_t nodesize;
27380 : ae_int_t cnt0;
27381 : ae_int_t cnt1;
27382 :
27383 :
27384 0 : setprealloc = 3;
27385 0 : inithashbucketsize = 16;
27386 0 : extendeddebug = ae_is_trace_enabled("DEBUG.SLOW");
27387 0 : buf->n = n;
27388 0 : buf->checkexactdegrees = extendeddebug;
27389 0 : buf->extendeddebug = extendeddebug;
27390 0 : amdordering_mtxinit(n, &buf->mtxl, _state);
27391 0 : amdordering_knsinitfroma(a, n, &buf->seta, _state);
27392 0 : amdordering_knsinit(n, n, setprealloc, &buf->setsuper, _state);
27393 0 : for(i=0; i<=n-1; i++)
27394 : {
27395 0 : amdordering_knsaddnewelement(&buf->setsuper, i, i, _state);
27396 : }
27397 0 : amdordering_knsinit(n, n, setprealloc, &buf->sete, _state);
27398 0 : amdordering_knsinit(n, n, inithashbucketsize, &buf->hashbuckets, _state);
27399 0 : amdordering_nsinitemptyslow(n, &buf->nonemptybuckets, _state);
27400 0 : ivectorsetlengthatleast(&buf->perm, n, _state);
27401 0 : ivectorsetlengthatleast(&buf->invperm, n, _state);
27402 0 : ivectorsetlengthatleast(&buf->columnswaps, n, _state);
27403 0 : for(i=0; i<=n-1; i++)
27404 : {
27405 0 : buf->perm.ptr.p_int[i] = i;
27406 0 : buf->invperm.ptr.p_int[i] = i;
27407 : }
27408 0 : amdordering_vtxinit(a, n, buf->checkexactdegrees, &buf->vertexdegrees, _state);
27409 0 : bsetallocv(n, ae_true, &buf->issupernode, _state);
27410 0 : bsetallocv(n, ae_false, &buf->iseliminated, _state);
27411 0 : isetallocv(n, -1, &buf->arrwe, _state);
27412 0 : if( extendeddebug )
27413 : {
27414 0 : ae_matrix_set_length(&buf->dbga, n, n, _state);
27415 0 : for(i=0; i<=n-1; i++)
27416 : {
27417 0 : for(j=0; j<=n-1; j++)
27418 : {
27419 0 : if( (j<=i&&sparseexists(a, i, j, _state))||(j>=i&&sparseexists(a, j, i, _state)) )
27420 : {
27421 0 : buf->dbga.ptr.pp_double[i][j] = 0.1/n*(ae_sin(i+0.17, _state)+ae_cos(ae_sqrt(j+0.65, _state), _state));
27422 : }
27423 : else
27424 : {
27425 0 : buf->dbga.ptr.pp_double[i][j] = (double)(0);
27426 : }
27427 : }
27428 : }
27429 0 : for(i=0; i<=n-1; i++)
27430 : {
27431 0 : buf->dbga.ptr.pp_double[i][i] = (double)(1);
27432 : }
27433 : }
27434 0 : ivectorsetlengthatleast(&buf->ls, n, _state);
27435 0 : amdordering_nsinitemptyslow(n, &buf->lp, _state);
27436 0 : amdordering_nsinitemptyslow(n, &buf->plp, _state);
27437 0 : amdordering_nsinitemptyslow(n, &buf->ep, _state);
27438 0 : amdordering_nsinitemptyslow(n, &buf->exactdegreetmp0, _state);
27439 0 : amdordering_nsinitemptyslow(n, &buf->adji, _state);
27440 0 : amdordering_nsinitemptyslow(n, &buf->adjj, _state);
27441 0 : k = 0;
27442 0 : while(k<n)
27443 : {
27444 0 : amdordering_amdselectpivotelement(buf, k, &p, &nodesize, _state);
27445 0 : amdordering_amdcomputelp(buf, p, _state);
27446 0 : amdordering_amdmasselimination(buf, p, k, _state);
27447 0 : amdordering_amddetectsupernodes(buf, _state);
27448 0 : if( extendeddebug )
27449 : {
27450 0 : ae_assert(buf->checkexactdegrees, "AMD: extended debug needs exact degrees", _state);
27451 0 : for(i=k; i<=k+nodesize-1; i++)
27452 : {
27453 0 : if( buf->columnswaps.ptr.p_int[i]!=i )
27454 : {
27455 0 : swaprows(&buf->dbga, i, buf->columnswaps.ptr.p_int[i], n, _state);
27456 0 : swapcols(&buf->dbga, i, buf->columnswaps.ptr.p_int[i], n, _state);
27457 : }
27458 : }
27459 0 : for(i=0; i<=nodesize-1; i++)
27460 : {
27461 0 : rmatrixgemm(n-k-i, n-k-i, k+i, -1.0, &buf->dbga, k+i, 0, 0, &buf->dbga, 0, k+i, 0, 1.0, &buf->dbga, k+i, k+i, _state);
27462 : }
27463 0 : cnt0 = amdordering_nscount(&buf->lp, _state);
27464 0 : cnt1 = 0;
27465 0 : for(i=k+1; i<=n-1; i++)
27466 : {
27467 0 : if( ae_fp_neq(buf->dbga.ptr.pp_double[i][k],(double)(0)) )
27468 : {
27469 0 : inc(&cnt1, _state);
27470 : }
27471 : }
27472 0 : ae_assert(cnt0+nodesize-1==cnt1, "AMD: integrity check 7344 failed", _state);
27473 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, p, _state)>=amdordering_vtxgetexact(&buf->vertexdegrees, p, _state), "AMD: integrity check for ApproxD failed", _state);
27474 0 : ae_assert(amdordering_vtxgetexact(&buf->vertexdegrees, p, _state)==cnt0, "AMD: integrity check for ExactD failed", _state);
27475 : }
27476 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, p, _state)>=amdordering_nscount(&buf->lp, _state), "AMD: integrity check 7956 failed", _state);
27477 0 : ae_assert(amdordering_knscountkth(&buf->sete, p, _state)>2||amdordering_vtxgetapprox(&buf->vertexdegrees, p, _state)==amdordering_nscount(&buf->lp, _state), "AMD: integrity check 7295 failed", _state);
27478 0 : amdordering_knsstartenumeration(&buf->sete, p, _state);
27479 0 : while(amdordering_knsenumerate(&buf->sete, &j, _state))
27480 : {
27481 0 : amdordering_mtxclearcolumn(&buf->mtxl, j, _state);
27482 : }
27483 0 : amdordering_knsstartenumeration(&buf->setsuper, p, _state);
27484 0 : while(amdordering_knsenumerate(&buf->setsuper, &j, _state))
27485 : {
27486 0 : buf->iseliminated.ptr.p_bool[j] = ae_true;
27487 0 : amdordering_mtxclearrow(&buf->mtxl, j, _state);
27488 : }
27489 0 : amdordering_knsclearkthreclaim(&buf->seta, p, _state);
27490 0 : amdordering_knsclearkthreclaim(&buf->sete, p, _state);
27491 0 : buf->issupernode.ptr.p_bool[p] = ae_false;
27492 0 : amdordering_vtxremovevertex(&buf->vertexdegrees, p, _state);
27493 0 : k = k+nodesize;
27494 : }
27495 0 : ivectorsetlengthatleast(perm, n, _state);
27496 0 : ivectorsetlengthatleast(invperm, n, _state);
27497 0 : for(i=0; i<=n-1; i++)
27498 : {
27499 0 : perm->ptr.p_int[i] = buf->perm.ptr.p_int[i];
27500 0 : invperm->ptr.p_int[i] = buf->invperm.ptr.p_int[i];
27501 : }
27502 0 : }
27503 :
27504 :
27505 : /*************************************************************************
27506 : Initializes n-set by empty structure.
27507 :
27508 : IMPORTANT: this function need O(N) time for initialization. It is recommended
27509 : to reduce its usage as much as possible, and use nsClear()
27510 : where possible.
27511 :
27512 : INPUT PARAMETERS
27513 : N - possible set size
27514 :
27515 : OUTPUT PARAMETERS
27516 : SA - empty N-set
27517 :
27518 : -- ALGLIB PROJECT --
27519 : Copyright 05.10.2020 by Bochkanov Sergey.
27520 : *************************************************************************/
27521 0 : static void amdordering_nsinitemptyslow(ae_int_t n,
27522 : amdnset* sa,
27523 : ae_state *_state)
27524 : {
27525 :
27526 :
27527 0 : sa->n = n;
27528 0 : sa->nstored = 0;
27529 0 : isetallocv(n, -999999999, &sa->locationof, _state);
27530 0 : isetallocv(n, -999999999, &sa->items, _state);
27531 0 : }
27532 :
27533 :
27534 : /*************************************************************************
27535 : Copies n-set to properly initialized target set. The target set has to be
27536 : properly initialized, and it can be non-empty. If it is non-empty, its
27537 : contents is quickly erased before copying.
27538 :
27539 : The cost of this function is O(max(SrcSize,DstSize))
27540 :
27541 : INPUT PARAMETERS
27542 : SSrc - source N-set
27543 : SDst - destination N-set (has same size as SSrc)
27544 :
27545 : OUTPUT PARAMETERS
27546 : SDst - copy of SSrc
27547 :
27548 : -- ALGLIB PROJECT --
27549 : Copyright 05.10.2020 by Bochkanov Sergey.
27550 : *************************************************************************/
27551 0 : static void amdordering_nscopy(amdnset* ssrc,
27552 : amdnset* sdst,
27553 : ae_state *_state)
27554 : {
27555 : ae_int_t ns;
27556 : ae_int_t i;
27557 : ae_int_t k;
27558 :
27559 :
27560 0 : amdordering_nsclear(sdst, _state);
27561 0 : ns = ssrc->nstored;
27562 0 : for(i=0; i<=ns-1; i++)
27563 : {
27564 0 : k = ssrc->items.ptr.p_int[i];
27565 0 : sdst->items.ptr.p_int[i] = k;
27566 0 : sdst->locationof.ptr.p_int[k] = i;
27567 : }
27568 0 : sdst->nstored = ns;
27569 0 : }
27570 :
27571 :
27572 : /*************************************************************************
27573 : Add K-th element to the set. The element may already exist in the set.
27574 :
27575 : INPUT PARAMETERS
27576 : SA - set
27577 : K - element to add, 0<=K<N.
27578 :
27579 : OUTPUT PARAMETERS
27580 : SA - modified SA
27581 :
27582 : -- ALGLIB PROJECT --
27583 : Copyright 05.10.2020 by Bochkanov Sergey.
27584 : *************************************************************************/
27585 0 : static void amdordering_nsaddelement(amdnset* sa,
27586 : ae_int_t k,
27587 : ae_state *_state)
27588 : {
27589 : ae_int_t ns;
27590 :
27591 :
27592 0 : if( sa->locationof.ptr.p_int[k]>=0 )
27593 : {
27594 0 : return;
27595 : }
27596 0 : ns = sa->nstored;
27597 0 : sa->locationof.ptr.p_int[k] = ns;
27598 0 : sa->items.ptr.p_int[ns] = k;
27599 0 : sa->nstored = ns+1;
27600 : }
27601 :
27602 :
27603 : /*************************************************************************
27604 : Add K-th set from the source kn-set
27605 :
27606 : INPUT PARAMETERS
27607 : SA - set
27608 : Src, K - source kn-set and set index K
27609 :
27610 : OUTPUT PARAMETERS
27611 : SA - modified SA
27612 :
27613 : -- ALGLIB PROJECT --
27614 : Copyright 05.10.2020 by Bochkanov Sergey.
27615 : *************************************************************************/
27616 0 : static void amdordering_nsaddkth(amdnset* sa,
27617 : amdknset* src,
27618 : ae_int_t k,
27619 : ae_state *_state)
27620 : {
27621 : ae_int_t idxbegin;
27622 : ae_int_t idxend;
27623 : ae_int_t j;
27624 : ae_int_t ns;
27625 :
27626 :
27627 0 : idxbegin = src->vbegin.ptr.p_int[k];
27628 0 : idxend = idxbegin+src->vcnt.ptr.p_int[k];
27629 0 : ns = sa->nstored;
27630 0 : while(idxbegin<idxend)
27631 : {
27632 0 : j = src->data.ptr.p_int[idxbegin];
27633 0 : if( sa->locationof.ptr.p_int[j]<0 )
27634 : {
27635 0 : sa->locationof.ptr.p_int[j] = ns;
27636 0 : sa->items.ptr.p_int[ns] = j;
27637 0 : ns = ns+1;
27638 : }
27639 0 : idxbegin = idxbegin+1;
27640 : }
27641 0 : sa->nstored = ns;
27642 0 : }
27643 :
27644 :
27645 : /*************************************************************************
27646 : Subtracts K-th set from the source structure
27647 :
27648 : INPUT PARAMETERS
27649 : SA - set
27650 : Src, K - source kn-set and set index K
27651 :
27652 : OUTPUT PARAMETERS
27653 : SA - modified SA
27654 :
27655 : -- ALGLIB PROJECT --
27656 : Copyright 05.10.2020 by Bochkanov Sergey.
27657 : *************************************************************************/
27658 0 : static void amdordering_nssubtractkth(amdnset* sa,
27659 : amdknset* src,
27660 : ae_int_t k,
27661 : ae_state *_state)
27662 : {
27663 : ae_int_t idxbegin;
27664 : ae_int_t idxend;
27665 : ae_int_t j;
27666 : ae_int_t loc;
27667 : ae_int_t ns;
27668 : ae_int_t item;
27669 :
27670 :
27671 0 : idxbegin = src->vbegin.ptr.p_int[k];
27672 0 : idxend = idxbegin+src->vcnt.ptr.p_int[k];
27673 0 : ns = sa->nstored;
27674 0 : while(idxbegin<idxend)
27675 : {
27676 0 : j = src->data.ptr.p_int[idxbegin];
27677 0 : loc = sa->locationof.ptr.p_int[j];
27678 0 : if( loc>=0 )
27679 : {
27680 0 : item = sa->items.ptr.p_int[ns-1];
27681 0 : sa->items.ptr.p_int[loc] = item;
27682 0 : sa->locationof.ptr.p_int[item] = loc;
27683 0 : sa->locationof.ptr.p_int[j] = -1;
27684 0 : ns = ns-1;
27685 : }
27686 0 : idxbegin = idxbegin+1;
27687 : }
27688 0 : sa->nstored = ns;
27689 0 : }
27690 :
27691 :
27692 : /*************************************************************************
27693 : Clears set
27694 :
27695 : INPUT PARAMETERS
27696 : SA - set to be cleared
27697 :
27698 :
27699 : -- ALGLIB PROJECT --
27700 : Copyright 05.10.2020 by Bochkanov Sergey.
27701 : *************************************************************************/
27702 0 : static void amdordering_nsclear(amdnset* sa, ae_state *_state)
27703 : {
27704 : ae_int_t i;
27705 : ae_int_t ns;
27706 :
27707 :
27708 0 : ns = sa->nstored;
27709 0 : for(i=0; i<=ns-1; i++)
27710 : {
27711 0 : sa->locationof.ptr.p_int[sa->items.ptr.p_int[i]] = -1;
27712 : }
27713 0 : sa->nstored = 0;
27714 0 : }
27715 :
27716 :
27717 : /*************************************************************************
27718 : Counts set elements
27719 :
27720 : INPUT PARAMETERS
27721 : SA - set
27722 :
27723 : RESULT
27724 : number of elements in SA
27725 :
27726 : -- ALGLIB PROJECT --
27727 : Copyright 05.10.2020 by Bochkanov Sergey.
27728 : *************************************************************************/
27729 0 : static ae_int_t amdordering_nscount(amdnset* sa, ae_state *_state)
27730 : {
27731 : ae_int_t result;
27732 :
27733 :
27734 0 : result = sa->nstored;
27735 0 : return result;
27736 : }
27737 :
27738 :
27739 : /*************************************************************************
27740 : Counts set elements not present in the K-th set of the source structure
27741 :
27742 : INPUT PARAMETERS
27743 : SA - set
27744 : Src, K - source kn-set and set index K
27745 :
27746 : RESULT
27747 : number of elements in SA not present in Src[K]
27748 :
27749 : -- ALGLIB PROJECT --
27750 : Copyright 05.10.2020 by Bochkanov Sergey.
27751 : *************************************************************************/
27752 0 : static ae_int_t amdordering_nscountnotkth(amdnset* sa,
27753 : amdknset* src,
27754 : ae_int_t k,
27755 : ae_state *_state)
27756 : {
27757 : ae_int_t idxbegin;
27758 : ae_int_t idxend;
27759 : ae_int_t intersectcnt;
27760 : ae_int_t result;
27761 :
27762 :
27763 0 : idxbegin = src->vbegin.ptr.p_int[k];
27764 0 : idxend = idxbegin+src->vcnt.ptr.p_int[k];
27765 0 : intersectcnt = 0;
27766 0 : while(idxbegin<idxend)
27767 : {
27768 0 : if( sa->locationof.ptr.p_int[src->data.ptr.p_int[idxbegin]]>=0 )
27769 : {
27770 0 : intersectcnt = intersectcnt+1;
27771 : }
27772 0 : idxbegin = idxbegin+1;
27773 : }
27774 0 : result = sa->nstored-intersectcnt;
27775 0 : return result;
27776 : }
27777 :
27778 :
27779 : /*************************************************************************
27780 : Counts set elements also present in the K-th set of the source structure
27781 :
27782 : INPUT PARAMETERS
27783 : SA - set
27784 : Src, K - source kn-set and set index K
27785 :
27786 : RESULT
27787 : number of elements in SA also present in Src[K]
27788 :
27789 : -- ALGLIB PROJECT --
27790 : Copyright 05.10.2020 by Bochkanov Sergey.
27791 : *************************************************************************/
27792 0 : static ae_int_t amdordering_nscountandkth(amdnset* sa,
27793 : amdknset* src,
27794 : ae_int_t k,
27795 : ae_state *_state)
27796 : {
27797 : ae_int_t idxbegin;
27798 : ae_int_t idxend;
27799 : ae_int_t result;
27800 :
27801 :
27802 0 : idxbegin = src->vbegin.ptr.p_int[k];
27803 0 : idxend = idxbegin+src->vcnt.ptr.p_int[k];
27804 0 : result = 0;
27805 0 : while(idxbegin<idxend)
27806 : {
27807 0 : if( sa->locationof.ptr.p_int[src->data.ptr.p_int[idxbegin]]>=0 )
27808 : {
27809 0 : result = result+1;
27810 : }
27811 0 : idxbegin = idxbegin+1;
27812 : }
27813 0 : return result;
27814 : }
27815 :
27816 :
27817 : /*************************************************************************
27818 : Compare two sets, returns True for equal sets
27819 :
27820 : INPUT PARAMETERS
27821 : S0 - set 0
27822 : S1 - set 1, must have same parameter N as set 0
27823 :
27824 : RESULT
27825 : True, if sets are equal
27826 :
27827 : -- ALGLIB PROJECT --
27828 : Copyright 05.10.2020 by Bochkanov Sergey.
27829 : *************************************************************************/
27830 0 : static ae_bool amdordering_nsequal(amdnset* s0,
27831 : amdnset* s1,
27832 : ae_state *_state)
27833 : {
27834 : ae_int_t i;
27835 : ae_int_t ns0;
27836 : ae_int_t ns1;
27837 : ae_bool result;
27838 :
27839 :
27840 0 : result = ae_false;
27841 0 : if( s0->n!=s1->n )
27842 : {
27843 0 : return result;
27844 : }
27845 0 : if( s0->nstored!=s1->nstored )
27846 : {
27847 0 : return result;
27848 : }
27849 0 : ns0 = s0->nstored;
27850 0 : ns1 = s1->nstored;
27851 0 : for(i=0; i<=ns0-1; i++)
27852 : {
27853 0 : if( s1->locationof.ptr.p_int[s0->items.ptr.p_int[i]]<0 )
27854 : {
27855 0 : return result;
27856 : }
27857 : }
27858 0 : for(i=0; i<=ns1-1; i++)
27859 : {
27860 0 : if( s0->locationof.ptr.p_int[s1->items.ptr.p_int[i]]<0 )
27861 : {
27862 0 : return result;
27863 : }
27864 : }
27865 0 : result = ae_true;
27866 0 : return result;
27867 : }
27868 :
27869 :
27870 : /*************************************************************************
27871 : Prepares iteration over set
27872 :
27873 : INPUT PARAMETERS
27874 : SA - set
27875 :
27876 : OUTPUT PARAMETERS
27877 : SA - SA ready for repeated calls of nsEnumerate()
27878 :
27879 : -- ALGLIB PROJECT --
27880 : Copyright 05.10.2020 by Bochkanov Sergey.
27881 : *************************************************************************/
27882 0 : static void amdordering_nsstartenumeration(amdnset* sa, ae_state *_state)
27883 : {
27884 :
27885 :
27886 0 : sa->iteridx = 0;
27887 0 : }
27888 :
27889 :
27890 : /*************************************************************************
27891 : Iterates over the set. Subsequent calls return True and set J to new set
27892 : item until iteration stops and False is returned.
27893 :
27894 : INPUT PARAMETERS
27895 : SA - n-set
27896 :
27897 : OUTPUT PARAMETERS
27898 : J - if:
27899 : * Result=True - index of element in the set
27900 : * Result=False - not set
27901 :
27902 :
27903 : -- ALGLIB PROJECT --
27904 : Copyright 05.10.2020 by Bochkanov Sergey.
27905 : *************************************************************************/
27906 0 : static ae_bool amdordering_nsenumerate(amdnset* sa,
27907 : ae_int_t* i,
27908 : ae_state *_state)
27909 : {
27910 : ae_int_t k;
27911 : ae_bool result;
27912 :
27913 0 : *i = 0;
27914 :
27915 0 : k = sa->iteridx;
27916 0 : if( k>=sa->nstored )
27917 : {
27918 0 : result = ae_false;
27919 0 : return result;
27920 : }
27921 0 : *i = sa->items.ptr.p_int[k];
27922 0 : sa->iteridx = k+1;
27923 0 : result = ae_true;
27924 0 : return result;
27925 : }
27926 :
27927 :
27928 : /*************************************************************************
27929 : Compresses internal storage, reclaiming previously dropped blocks. To be
27930 : used internally by kn-set modification functions.
27931 :
27932 : INPUT PARAMETERS
27933 : SA - kn-set to compress
27934 :
27935 : -- ALGLIB PROJECT --
27936 : Copyright 05.10.2020 by Bochkanov Sergey.
27937 : *************************************************************************/
27938 0 : static void amdordering_knscompressstorage(amdknset* sa, ae_state *_state)
27939 : {
27940 : ae_int_t i;
27941 : ae_int_t blocklen;
27942 : ae_int_t setidx;
27943 : ae_int_t srcoffs;
27944 : ae_int_t dstoffs;
27945 :
27946 :
27947 0 : srcoffs = 0;
27948 0 : dstoffs = 0;
27949 0 : while(srcoffs<sa->dataused)
27950 : {
27951 0 : blocklen = sa->data.ptr.p_int[srcoffs+0];
27952 0 : setidx = sa->data.ptr.p_int[srcoffs+1];
27953 0 : ae_assert(blocklen>=amdordering_knsheadersize, "knsCompressStorage: integrity check 6385 failed", _state);
27954 0 : if( setidx<0 )
27955 : {
27956 0 : srcoffs = srcoffs+blocklen;
27957 0 : continue;
27958 : }
27959 0 : if( srcoffs!=dstoffs )
27960 : {
27961 0 : for(i=0; i<=blocklen-1; i++)
27962 : {
27963 0 : sa->data.ptr.p_int[dstoffs+i] = sa->data.ptr.p_int[srcoffs+i];
27964 : }
27965 0 : sa->vbegin.ptr.p_int[setidx] = dstoffs+amdordering_knsheadersize;
27966 : }
27967 0 : dstoffs = dstoffs+blocklen;
27968 0 : srcoffs = srcoffs+blocklen;
27969 : }
27970 0 : ae_assert(srcoffs==sa->dataused, "knsCompressStorage: integrity check 9464 failed", _state);
27971 0 : sa->dataused = dstoffs;
27972 0 : }
27973 :
27974 :
27975 : /*************************************************************************
27976 : Reallocates internal storage for set #SetIdx, increasing its capacity to
27977 : NewAllocated exactly. This function may invalidate internal pointers for
27978 : ALL sets in the kn-set structure because it may perform storage
27979 : compression in order to reclaim previously freed space.
27980 :
27981 : INPUT PARAMETERS
27982 : SA - kn-set structure
27983 : SetIdx - set to reallocate
27984 : NewAllocated - new size for the set, must be at least equal to already
27985 : allocated
27986 :
27987 : -- ALGLIB PROJECT --
27988 : Copyright 05.10.2020 by Bochkanov Sergey.
27989 : *************************************************************************/
27990 0 : static void amdordering_knsreallocate(amdknset* sa,
27991 : ae_int_t setidx,
27992 : ae_int_t newallocated,
27993 : ae_state *_state)
27994 : {
27995 : ae_int_t oldbegin;
27996 : ae_int_t oldcnt;
27997 : ae_int_t newbegin;
27998 : ae_int_t j;
27999 :
28000 :
28001 0 : if( sa->data.cnt<sa->dataused+amdordering_knsheadersize+newallocated )
28002 : {
28003 0 : amdordering_knscompressstorage(sa, _state);
28004 0 : if( sa->data.cnt<sa->dataused+amdordering_knsheadersize+newallocated )
28005 : {
28006 0 : ivectorgrowto(&sa->data, sa->dataused+amdordering_knsheadersize+newallocated, _state);
28007 : }
28008 : }
28009 0 : oldbegin = sa->vbegin.ptr.p_int[setidx];
28010 0 : oldcnt = sa->vcnt.ptr.p_int[setidx];
28011 0 : newbegin = sa->dataused+amdordering_knsheadersize;
28012 0 : sa->vbegin.ptr.p_int[setidx] = newbegin;
28013 0 : sa->vallocated.ptr.p_int[setidx] = newallocated;
28014 0 : sa->data.ptr.p_int[oldbegin-1] = -1;
28015 0 : sa->data.ptr.p_int[newbegin-2] = amdordering_knsheadersize+newallocated;
28016 0 : sa->data.ptr.p_int[newbegin-1] = setidx;
28017 0 : sa->dataused = sa->dataused+sa->data.ptr.p_int[newbegin-2];
28018 0 : for(j=0; j<=oldcnt-1; j++)
28019 : {
28020 0 : sa->data.ptr.p_int[newbegin+j] = sa->data.ptr.p_int[oldbegin+j];
28021 : }
28022 0 : }
28023 :
28024 :
28025 : /*************************************************************************
28026 : Initialize kn-set
28027 :
28028 : INPUT PARAMETERS
28029 : K - sets count
28030 : N - set size
28031 : kPrealloc - preallocate place per set (can be zero)
28032 :
28033 : OUTPUT PARAMETERS
28034 : SA - K sets of N elements, initially empty
28035 :
28036 : -- ALGLIB PROJECT --
28037 : Copyright 05.10.2020 by Bochkanov Sergey.
28038 : *************************************************************************/
28039 0 : static void amdordering_knsinit(ae_int_t k,
28040 : ae_int_t n,
28041 : ae_int_t kprealloc,
28042 : amdknset* sa,
28043 : ae_state *_state)
28044 : {
28045 : ae_int_t i;
28046 :
28047 :
28048 0 : sa->k = n;
28049 0 : sa->n = n;
28050 0 : isetallocv(n, -1, &sa->flagarray, _state);
28051 0 : isetallocv(n, kprealloc, &sa->vallocated, _state);
28052 0 : ivectorsetlengthatleast(&sa->vbegin, n, _state);
28053 0 : sa->vbegin.ptr.p_int[0] = amdordering_knsheadersize;
28054 0 : for(i=1; i<=n-1; i++)
28055 : {
28056 0 : sa->vbegin.ptr.p_int[i] = sa->vbegin.ptr.p_int[i-1]+sa->vallocated.ptr.p_int[i-1]+amdordering_knsheadersize;
28057 : }
28058 0 : sa->dataused = sa->vbegin.ptr.p_int[n-1]+sa->vallocated.ptr.p_int[n-1];
28059 0 : ivectorsetlengthatleast(&sa->data, sa->dataused, _state);
28060 0 : for(i=0; i<=n-1; i++)
28061 : {
28062 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]-2] = amdordering_knsheadersize+sa->vallocated.ptr.p_int[i];
28063 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]-1] = i;
28064 : }
28065 0 : isetallocv(n, 0, &sa->vcnt, _state);
28066 0 : }
28067 :
28068 :
28069 : /*************************************************************************
28070 : Initialize kn-set from lower triangle of symmetric A
28071 :
28072 : INPUT PARAMETERS
28073 : A - lower triangular sparse matrix in CRS format
28074 : N - problem size
28075 :
28076 : OUTPUT PARAMETERS
28077 : SA - N sets of N elements, reproducing both lower and upper
28078 : triangles of A
28079 :
28080 : -- ALGLIB PROJECT --
28081 : Copyright 05.10.2020 by Bochkanov Sergey.
28082 : *************************************************************************/
28083 0 : static void amdordering_knsinitfroma(sparsematrix* a,
28084 : ae_int_t n,
28085 : amdknset* sa,
28086 : ae_state *_state)
28087 : {
28088 : ae_int_t i;
28089 : ae_int_t j;
28090 : ae_int_t jj;
28091 : ae_int_t j0;
28092 : ae_int_t j1;
28093 :
28094 :
28095 0 : sa->k = n;
28096 0 : sa->n = n;
28097 0 : isetallocv(n, -1, &sa->flagarray, _state);
28098 0 : ivectorsetlengthatleast(&sa->vallocated, n, _state);
28099 0 : for(i=0; i<=n-1; i++)
28100 : {
28101 0 : ae_assert(a->didx.ptr.p_int[i]<a->uidx.ptr.p_int[i], "knsInitFromA: integrity check for diagonal of A failed", _state);
28102 0 : j0 = a->ridx.ptr.p_int[i];
28103 0 : j1 = a->didx.ptr.p_int[i]-1;
28104 0 : sa->vallocated.ptr.p_int[i] = 1+(j1-j0+1);
28105 0 : for(jj=j0; jj<=j1; jj++)
28106 : {
28107 0 : j = a->idx.ptr.p_int[jj];
28108 0 : sa->vallocated.ptr.p_int[j] = sa->vallocated.ptr.p_int[j]+1;
28109 : }
28110 : }
28111 0 : ivectorsetlengthatleast(&sa->vbegin, n, _state);
28112 0 : sa->vbegin.ptr.p_int[0] = amdordering_knsheadersize;
28113 0 : for(i=1; i<=n-1; i++)
28114 : {
28115 0 : sa->vbegin.ptr.p_int[i] = sa->vbegin.ptr.p_int[i-1]+sa->vallocated.ptr.p_int[i-1]+amdordering_knsheadersize;
28116 : }
28117 0 : sa->dataused = sa->vbegin.ptr.p_int[n-1]+sa->vallocated.ptr.p_int[n-1];
28118 0 : ivectorsetlengthatleast(&sa->data, sa->dataused, _state);
28119 0 : for(i=0; i<=n-1; i++)
28120 : {
28121 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]-2] = amdordering_knsheadersize+sa->vallocated.ptr.p_int[i];
28122 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]-1] = i;
28123 : }
28124 0 : isetallocv(n, 0, &sa->vcnt, _state);
28125 0 : for(i=0; i<=n-1; i++)
28126 : {
28127 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]+sa->vcnt.ptr.p_int[i]] = i;
28128 0 : sa->vcnt.ptr.p_int[i] = sa->vcnt.ptr.p_int[i]+1;
28129 0 : j0 = a->ridx.ptr.p_int[i];
28130 0 : j1 = a->didx.ptr.p_int[i]-1;
28131 0 : for(jj=j0; jj<=j1; jj++)
28132 : {
28133 0 : j = a->idx.ptr.p_int[jj];
28134 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]+sa->vcnt.ptr.p_int[i]] = j;
28135 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[j]+sa->vcnt.ptr.p_int[j]] = i;
28136 0 : sa->vcnt.ptr.p_int[i] = sa->vcnt.ptr.p_int[i]+1;
28137 0 : sa->vcnt.ptr.p_int[j] = sa->vcnt.ptr.p_int[j]+1;
28138 : }
28139 : }
28140 0 : }
28141 :
28142 :
28143 : /*************************************************************************
28144 : Prepares iteration over I-th set
28145 :
28146 : INPUT PARAMETERS
28147 : SA - kn-set
28148 : I - set index
28149 :
28150 : OUTPUT PARAMETERS
28151 : SA - SA ready for repeated calls of knsEnumerate()
28152 :
28153 : -- ALGLIB PROJECT --
28154 : Copyright 05.10.2020 by Bochkanov Sergey.
28155 : *************************************************************************/
28156 0 : static void amdordering_knsstartenumeration(amdknset* sa,
28157 : ae_int_t i,
28158 : ae_state *_state)
28159 : {
28160 :
28161 :
28162 0 : sa->iterrow = i;
28163 0 : sa->iteridx = 0;
28164 0 : }
28165 :
28166 :
28167 : /*************************************************************************
28168 : Iterates over I-th set (as specified during recent knsStartEnumeration call).
28169 : Subsequent calls return True and set J to new set item until iteration
28170 : stops and False is returned.
28171 :
28172 : INPUT PARAMETERS
28173 : SA - kn-set
28174 :
28175 : OUTPUT PARAMETERS
28176 : J - if:
28177 : * Result=True - index of element in the set
28178 : * Result=False - not set
28179 :
28180 :
28181 : -- ALGLIB PROJECT --
28182 : Copyright 05.10.2020 by Bochkanov Sergey.
28183 : *************************************************************************/
28184 0 : static ae_bool amdordering_knsenumerate(amdknset* sa,
28185 : ae_int_t* i,
28186 : ae_state *_state)
28187 : {
28188 : ae_bool result;
28189 :
28190 0 : *i = 0;
28191 :
28192 0 : if( sa->iteridx<sa->vcnt.ptr.p_int[sa->iterrow] )
28193 : {
28194 0 : *i = sa->data.ptr.p_int[sa->vbegin.ptr.p_int[sa->iterrow]+sa->iteridx];
28195 0 : sa->iteridx = sa->iteridx+1;
28196 0 : result = ae_true;
28197 : }
28198 : else
28199 : {
28200 0 : result = ae_false;
28201 : }
28202 0 : return result;
28203 : }
28204 :
28205 :
28206 : /*************************************************************************
28207 : Allows direct access to internal storage of kn-set structure - returns
28208 : range of elements SA.Data[idxBegin...idxEnd-1] used to store K-th set
28209 :
28210 : INPUT PARAMETERS
28211 : SA - kn-set
28212 : K - set index
28213 :
28214 : OUTPUT PARAMETERS
28215 : idxBegin,
28216 : idxEnd - half-range [idxBegin,idxEnd) of SA.Data that stores
28217 : K-th set
28218 :
28219 :
28220 : -- ALGLIB PROJECT --
28221 : Copyright 05.10.2020 by Bochkanov Sergey.
28222 : *************************************************************************/
28223 0 : static void amdordering_knsdirectaccess(amdknset* sa,
28224 : ae_int_t k,
28225 : ae_int_t* idxbegin,
28226 : ae_int_t* idxend,
28227 : ae_state *_state)
28228 : {
28229 :
28230 0 : *idxbegin = 0;
28231 0 : *idxend = 0;
28232 :
28233 0 : *idxbegin = sa->vbegin.ptr.p_int[k];
28234 0 : *idxend = *idxbegin+sa->vcnt.ptr.p_int[k];
28235 0 : }
28236 :
28237 :
28238 : /*************************************************************************
28239 : Add K-th element to I-th set. The caller guarantees that the element is
28240 : not present in the target set.
28241 :
28242 : INPUT PARAMETERS
28243 : SA - kn-set
28244 : I - set index
28245 : K - element to add
28246 :
28247 : OUTPUT PARAMETERS
28248 : SA - modified SA
28249 :
28250 : -- ALGLIB PROJECT --
28251 : Copyright 05.10.2020 by Bochkanov Sergey.
28252 : *************************************************************************/
28253 0 : static void amdordering_knsaddnewelement(amdknset* sa,
28254 : ae_int_t i,
28255 : ae_int_t k,
28256 : ae_state *_state)
28257 : {
28258 : ae_int_t cnt;
28259 :
28260 :
28261 0 : cnt = sa->vcnt.ptr.p_int[i];
28262 0 : if( cnt==sa->vallocated.ptr.p_int[i] )
28263 : {
28264 0 : amdordering_knsreallocate(sa, i, 2*sa->vallocated.ptr.p_int[i]+1, _state);
28265 : }
28266 0 : sa->data.ptr.p_int[sa->vbegin.ptr.p_int[i]+cnt] = k;
28267 0 : sa->vcnt.ptr.p_int[i] = cnt+1;
28268 0 : }
28269 :
28270 :
28271 : /*************************************************************************
28272 : Subtracts source n-set from the I-th set of the destination kn-set.
28273 :
28274 : INPUT PARAMETERS
28275 : SA - destination kn-set structure
28276 : I - set index in the structure
28277 : Src - source n-set
28278 :
28279 : OUTPUT PARAMETERS
28280 : SA - I-th set except for elements in Src
28281 :
28282 : -- ALGLIB PROJECT --
28283 : Copyright 05.10.2020 by Bochkanov Sergey.
28284 : *************************************************************************/
28285 0 : static void amdordering_knssubtract1(amdknset* sa,
28286 : ae_int_t i,
28287 : amdnset* src,
28288 : ae_state *_state)
28289 : {
28290 : ae_int_t j;
28291 : ae_int_t idxbegin;
28292 : ae_int_t idxend;
28293 : ae_int_t cnt;
28294 :
28295 :
28296 0 : cnt = sa->vcnt.ptr.p_int[i];
28297 0 : idxbegin = sa->vbegin.ptr.p_int[i];
28298 0 : idxend = idxbegin+cnt;
28299 0 : while(idxbegin<idxend)
28300 : {
28301 0 : j = sa->data.ptr.p_int[idxbegin];
28302 0 : if( src->locationof.ptr.p_int[j]>=0 )
28303 : {
28304 0 : sa->data.ptr.p_int[idxbegin] = sa->data.ptr.p_int[idxend-1];
28305 0 : idxend = idxend-1;
28306 0 : cnt = cnt-1;
28307 : }
28308 : else
28309 : {
28310 0 : idxbegin = idxbegin+1;
28311 : }
28312 : }
28313 0 : sa->vcnt.ptr.p_int[i] = cnt;
28314 0 : }
28315 :
28316 :
28317 : /*************************************************************************
28318 : Adds Kth set of the source kn-set to the I-th destination set. The caller
28319 : guarantees that SA[I] and Src[J] do NOT intersect, i.e. do not have shared
28320 : elements - it allows to use faster algorithms.
28321 :
28322 : INPUT PARAMETERS
28323 : SA - destination kn-set structure
28324 : I - set index in the structure
28325 : Src - source kn-set
28326 : K - set index
28327 :
28328 : OUTPUT PARAMETERS
28329 : SA - I-th set plus for elements in K-th set of Src
28330 :
28331 : -- ALGLIB PROJECT --
28332 : Copyright 05.10.2020 by Bochkanov Sergey.
28333 : *************************************************************************/
28334 0 : static void amdordering_knsaddkthdistinct(amdknset* sa,
28335 : ae_int_t i,
28336 : amdknset* src,
28337 : ae_int_t k,
28338 : ae_state *_state)
28339 : {
28340 : ae_int_t idxdst;
28341 : ae_int_t idxsrcbegin;
28342 : ae_int_t cnt;
28343 : ae_int_t srccnt;
28344 : ae_int_t j;
28345 :
28346 :
28347 0 : cnt = sa->vcnt.ptr.p_int[i];
28348 0 : srccnt = src->vcnt.ptr.p_int[k];
28349 0 : if( cnt+srccnt>sa->vallocated.ptr.p_int[i] )
28350 : {
28351 0 : amdordering_knsreallocate(sa, i, 2*(cnt+srccnt)+1, _state);
28352 : }
28353 0 : idxsrcbegin = src->vbegin.ptr.p_int[k];
28354 0 : idxdst = sa->vbegin.ptr.p_int[i]+cnt;
28355 0 : for(j=0; j<=srccnt-1; j++)
28356 : {
28357 0 : sa->data.ptr.p_int[idxdst] = src->data.ptr.p_int[idxsrcbegin+j];
28358 0 : idxdst = idxdst+1;
28359 : }
28360 0 : sa->vcnt.ptr.p_int[i] = cnt+srccnt;
28361 0 : }
28362 :
28363 :
28364 : /*************************************************************************
28365 : Counts elements of K-th set of S0
28366 :
28367 : INPUT PARAMETERS
28368 : S0 - kn-set structure
28369 : K - set index in the structure S0
28370 :
28371 : RESULT
28372 : K-th set element count
28373 :
28374 : -- ALGLIB PROJECT --
28375 : Copyright 05.10.2020 by Bochkanov Sergey.
28376 : *************************************************************************/
28377 0 : static ae_int_t amdordering_knscountkth(amdknset* s0,
28378 : ae_int_t k,
28379 : ae_state *_state)
28380 : {
28381 : ae_int_t result;
28382 :
28383 :
28384 0 : result = s0->vcnt.ptr.p_int[k];
28385 0 : return result;
28386 : }
28387 :
28388 :
28389 : /*************************************************************************
28390 : Counts elements of I-th set of S0 not present in K-th set of S1
28391 :
28392 : INPUT PARAMETERS
28393 : S0 - kn-set structure
28394 : I - set index in the structure S0
28395 : S1 - kn-set to compare against
28396 : K - set index in the structure S1
28397 :
28398 : RESULT
28399 : count
28400 :
28401 : -- ALGLIB PROJECT --
28402 : Copyright 05.10.2020 by Bochkanov Sergey.
28403 : *************************************************************************/
28404 0 : static ae_int_t amdordering_knscountnotkth(amdknset* s0,
28405 : ae_int_t i,
28406 : amdknset* s1,
28407 : ae_int_t k,
28408 : ae_state *_state)
28409 : {
28410 : ae_int_t idxbegin0;
28411 : ae_int_t idxbegin1;
28412 : ae_int_t cnt0;
28413 : ae_int_t cnt1;
28414 : ae_int_t j;
28415 : ae_int_t result;
28416 :
28417 :
28418 0 : cnt0 = s0->vcnt.ptr.p_int[i];
28419 0 : cnt1 = s1->vcnt.ptr.p_int[k];
28420 0 : idxbegin0 = s0->vbegin.ptr.p_int[i];
28421 0 : idxbegin1 = s1->vbegin.ptr.p_int[k];
28422 0 : for(j=0; j<=cnt1-1; j++)
28423 : {
28424 0 : s0->flagarray.ptr.p_int[s1->data.ptr.p_int[idxbegin1+j]] = 1;
28425 : }
28426 0 : result = 0;
28427 0 : for(j=0; j<=cnt0-1; j++)
28428 : {
28429 0 : if( s0->flagarray.ptr.p_int[s0->data.ptr.p_int[idxbegin0+j]]<0 )
28430 : {
28431 0 : result = result+1;
28432 : }
28433 : }
28434 0 : for(j=0; j<=cnt1-1; j++)
28435 : {
28436 0 : s0->flagarray.ptr.p_int[s1->data.ptr.p_int[idxbegin1+j]] = -1;
28437 : }
28438 0 : return result;
28439 : }
28440 :
28441 :
28442 : /*************************************************************************
28443 : Counts elements of I-th set of S0 that are also present in K-th set of S1
28444 :
28445 : INPUT PARAMETERS
28446 : S0 - kn-set structure
28447 : I - set index in the structure S0
28448 : S1 - kn-set to compare against
28449 : K - set index in the structure S1
28450 :
28451 : RESULT
28452 : count
28453 :
28454 : -- ALGLIB PROJECT --
28455 : Copyright 05.10.2020 by Bochkanov Sergey.
28456 : *************************************************************************/
28457 0 : static ae_int_t amdordering_knscountandkth(amdknset* s0,
28458 : ae_int_t i,
28459 : amdknset* s1,
28460 : ae_int_t k,
28461 : ae_state *_state)
28462 : {
28463 : ae_int_t idxbegin0;
28464 : ae_int_t idxbegin1;
28465 : ae_int_t cnt0;
28466 : ae_int_t cnt1;
28467 : ae_int_t j;
28468 : ae_int_t result;
28469 :
28470 :
28471 0 : cnt0 = s0->vcnt.ptr.p_int[i];
28472 0 : cnt1 = s1->vcnt.ptr.p_int[k];
28473 0 : idxbegin0 = s0->vbegin.ptr.p_int[i];
28474 0 : idxbegin1 = s1->vbegin.ptr.p_int[k];
28475 0 : for(j=0; j<=cnt1-1; j++)
28476 : {
28477 0 : s0->flagarray.ptr.p_int[s1->data.ptr.p_int[idxbegin1+j]] = 1;
28478 : }
28479 0 : result = 0;
28480 0 : for(j=0; j<=cnt0-1; j++)
28481 : {
28482 0 : if( s0->flagarray.ptr.p_int[s0->data.ptr.p_int[idxbegin0+j]]>0 )
28483 : {
28484 0 : result = result+1;
28485 : }
28486 : }
28487 0 : for(j=0; j<=cnt1-1; j++)
28488 : {
28489 0 : s0->flagarray.ptr.p_int[s1->data.ptr.p_int[idxbegin1+j]] = -1;
28490 : }
28491 0 : return result;
28492 : }
28493 :
28494 :
28495 : /*************************************************************************
28496 : Sums elements in I-th set of S0, returns sum.
28497 :
28498 : INPUT PARAMETERS
28499 : S0 - kn-set structure
28500 : I - set index in the structure S0
28501 :
28502 : RESULT
28503 : sum
28504 :
28505 : -- ALGLIB PROJECT --
28506 : Copyright 05.10.2020 by Bochkanov Sergey.
28507 : *************************************************************************/
28508 0 : static ae_int_t amdordering_knssumkth(amdknset* s0,
28509 : ae_int_t i,
28510 : ae_state *_state)
28511 : {
28512 : ae_int_t idxbegin0;
28513 : ae_int_t cnt0;
28514 : ae_int_t j;
28515 : ae_int_t result;
28516 :
28517 :
28518 0 : cnt0 = s0->vcnt.ptr.p_int[i];
28519 0 : idxbegin0 = s0->vbegin.ptr.p_int[i];
28520 0 : result = 0;
28521 0 : for(j=0; j<=cnt0-1; j++)
28522 : {
28523 0 : result = result+s0->data.ptr.p_int[idxbegin0+j];
28524 : }
28525 0 : return result;
28526 : }
28527 :
28528 :
28529 : /*************************************************************************
28530 : Clear k-th kn-set in collection.
28531 :
28532 : Freed memory is NOT reclaimed for future garbage collection.
28533 :
28534 : INPUT PARAMETERS
28535 : SA - kn-set structure
28536 : K - set index
28537 :
28538 : OUTPUT PARAMETERS
28539 : SA - K-th set was cleared
28540 :
28541 : -- ALGLIB PROJECT --
28542 : Copyright 05.10.2020 by Bochkanov Sergey.
28543 : *************************************************************************/
28544 0 : static void amdordering_knsclearkthnoreclaim(amdknset* sa,
28545 : ae_int_t k,
28546 : ae_state *_state)
28547 : {
28548 :
28549 :
28550 0 : sa->vcnt.ptr.p_int[k] = 0;
28551 0 : }
28552 :
28553 :
28554 : /*************************************************************************
28555 : Clear k-th kn-set in collection.
28556 :
28557 : Freed memory is reclaimed for future garbage collection. This function is
28558 : NOT recommended if you intend to add elements to this set in some future,
28559 : because every addition will result in reallocation of previously freed
28560 : memory. Use knsClearKthNoReclaim().
28561 :
28562 : INPUT PARAMETERS
28563 : SA - kn-set structure
28564 : K - set index
28565 :
28566 : OUTPUT PARAMETERS
28567 : SA - K-th set was cleared
28568 :
28569 : -- ALGLIB PROJECT --
28570 : Copyright 05.10.2020 by Bochkanov Sergey.
28571 : *************************************************************************/
28572 0 : static void amdordering_knsclearkthreclaim(amdknset* sa,
28573 : ae_int_t k,
28574 : ae_state *_state)
28575 : {
28576 : ae_int_t idxbegin;
28577 : ae_int_t allocated;
28578 :
28579 :
28580 0 : idxbegin = sa->vbegin.ptr.p_int[k];
28581 0 : allocated = sa->vallocated.ptr.p_int[k];
28582 0 : sa->vcnt.ptr.p_int[k] = 0;
28583 0 : if( allocated>=amdordering_knsheadersize )
28584 : {
28585 0 : sa->data.ptr.p_int[idxbegin-2] = 2;
28586 0 : sa->data.ptr.p_int[idxbegin+0] = allocated;
28587 0 : sa->data.ptr.p_int[idxbegin+1] = -1;
28588 0 : sa->vallocated.ptr.p_int[k] = 0;
28589 : }
28590 0 : }
28591 :
28592 :
28593 : /*************************************************************************
28594 : Initialize linked list matrix
28595 :
28596 : INPUT PARAMETERS
28597 : N - matrix size
28598 :
28599 : OUTPUT PARAMETERS
28600 : A - NxN linked list matrix
28601 :
28602 : -- ALGLIB PROJECT --
28603 : Copyright 05.10.2020 by Bochkanov Sergey.
28604 : *************************************************************************/
28605 0 : static void amdordering_mtxinit(ae_int_t n,
28606 : amdllmatrix* a,
28607 : ae_state *_state)
28608 : {
28609 :
28610 :
28611 0 : a->n = n;
28612 0 : isetallocv(2*n+1, -1, &a->vbegin, _state);
28613 0 : isetallocv(n, 0, &a->vcolcnt, _state);
28614 0 : a->entriesinitialized = 0;
28615 0 : }
28616 :
28617 :
28618 : /*************************************************************************
28619 : Adds column from matrix to n-set
28620 :
28621 : INPUT PARAMETERS
28622 : A - NxN linked list matrix
28623 : J - column index to add
28624 : S - target n-set
28625 :
28626 : OUTPUT PARAMETERS
28627 : S - elements from J-th column are added to S
28628 :
28629 :
28630 : -- ALGLIB PROJECT --
28631 : Copyright 05.10.2020 by Bochkanov Sergey.
28632 : *************************************************************************/
28633 0 : static void amdordering_mtxaddcolumnto(amdllmatrix* a,
28634 : ae_int_t j,
28635 : amdnset* s,
28636 : ae_state *_state)
28637 : {
28638 : ae_int_t n;
28639 : ae_int_t eidx;
28640 :
28641 :
28642 0 : n = a->n;
28643 0 : eidx = a->vbegin.ptr.p_int[n+j];
28644 0 : while(eidx>=0)
28645 : {
28646 0 : amdordering_nsaddelement(s, a->entries.ptr.p_int[eidx*amdordering_llmentrysize+4], _state);
28647 0 : eidx = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+3];
28648 : }
28649 0 : }
28650 :
28651 :
28652 : /*************************************************************************
28653 : Inserts new element into column J, row I. The caller guarantees that the
28654 : element being inserted is NOT already present in the matrix.
28655 :
28656 : INPUT PARAMETERS
28657 : A - NxN linked list matrix
28658 : I - row index
28659 : J - column index
28660 :
28661 : OUTPUT PARAMETERS
28662 : A - element (I,J) added to the list.
28663 :
28664 :
28665 : -- ALGLIB PROJECT --
28666 : Copyright 05.10.2020 by Bochkanov Sergey.
28667 : *************************************************************************/
28668 0 : static void amdordering_mtxinsertnewelement(amdllmatrix* a,
28669 : ae_int_t i,
28670 : ae_int_t j,
28671 : ae_state *_state)
28672 : {
28673 : ae_int_t n;
28674 : ae_int_t k;
28675 : ae_int_t newsize;
28676 : ae_int_t eidx;
28677 : ae_int_t offs;
28678 :
28679 :
28680 0 : n = a->n;
28681 0 : if( a->vbegin.ptr.p_int[2*n]<0 )
28682 : {
28683 0 : newsize = 2*a->entriesinitialized+1;
28684 0 : ivectorresize(&a->entries, newsize*amdordering_llmentrysize, _state);
28685 0 : for(k=a->entriesinitialized; k<=newsize-2; k++)
28686 : {
28687 0 : a->entries.ptr.p_int[k*amdordering_llmentrysize+0] = k+1;
28688 : }
28689 0 : a->entries.ptr.p_int[(newsize-1)*amdordering_llmentrysize+0] = a->vbegin.ptr.p_int[2*n];
28690 0 : a->vbegin.ptr.p_int[2*n] = a->entriesinitialized;
28691 0 : a->entriesinitialized = newsize;
28692 : }
28693 0 : eidx = a->vbegin.ptr.p_int[2*n];
28694 0 : offs = eidx*amdordering_llmentrysize;
28695 0 : a->vbegin.ptr.p_int[2*n] = a->entries.ptr.p_int[offs+0];
28696 0 : a->entries.ptr.p_int[offs+0] = -1;
28697 0 : a->entries.ptr.p_int[offs+1] = a->vbegin.ptr.p_int[i];
28698 0 : if( a->vbegin.ptr.p_int[i]>=0 )
28699 : {
28700 0 : a->entries.ptr.p_int[a->vbegin.ptr.p_int[i]*amdordering_llmentrysize+0] = eidx;
28701 : }
28702 0 : a->entries.ptr.p_int[offs+2] = -1;
28703 0 : a->entries.ptr.p_int[offs+3] = a->vbegin.ptr.p_int[j+n];
28704 0 : if( a->vbegin.ptr.p_int[j+n]>=0 )
28705 : {
28706 0 : a->entries.ptr.p_int[a->vbegin.ptr.p_int[j+n]*amdordering_llmentrysize+2] = eidx;
28707 : }
28708 0 : a->entries.ptr.p_int[offs+4] = i;
28709 0 : a->entries.ptr.p_int[offs+5] = j;
28710 0 : a->vbegin.ptr.p_int[i] = eidx;
28711 0 : a->vbegin.ptr.p_int[j+n] = eidx;
28712 0 : a->vcolcnt.ptr.p_int[j] = a->vcolcnt.ptr.p_int[j]+1;
28713 0 : }
28714 :
28715 :
28716 : /*************************************************************************
28717 : Counts elements in J-th column
28718 :
28719 : INPUT PARAMETERS
28720 : A - NxN linked list matrix
28721 : J - column index
28722 :
28723 : RESULT
28724 : element count
28725 :
28726 :
28727 : -- ALGLIB PROJECT --
28728 : Copyright 05.10.2020 by Bochkanov Sergey.
28729 : *************************************************************************/
28730 0 : static ae_int_t amdordering_mtxcountcolumn(amdllmatrix* a,
28731 : ae_int_t j,
28732 : ae_state *_state)
28733 : {
28734 : ae_int_t result;
28735 :
28736 :
28737 0 : result = a->vcolcnt.ptr.p_int[j];
28738 0 : return result;
28739 : }
28740 :
28741 :
28742 : /*************************************************************************
28743 : Clears K-th column or row
28744 :
28745 : INPUT PARAMETERS
28746 : A - NxN linked list matrix
28747 : K - column/row index to clear
28748 : IsCol - whether we want to clear row or column
28749 :
28750 : OUTPUT PARAMETERS
28751 : A - K-th column or row is empty
28752 :
28753 :
28754 : -- ALGLIB PROJECT --
28755 : Copyright 05.10.2020 by Bochkanov Sergey.
28756 : *************************************************************************/
28757 0 : static void amdordering_mtxclearx(amdllmatrix* a,
28758 : ae_int_t k,
28759 : ae_bool iscol,
28760 : ae_state *_state)
28761 : {
28762 : ae_int_t n;
28763 : ae_int_t eidx;
28764 : ae_int_t enext;
28765 : ae_int_t idxprev;
28766 : ae_int_t idxnext;
28767 : ae_int_t idxr;
28768 : ae_int_t idxc;
28769 :
28770 :
28771 0 : n = a->n;
28772 0 : if( iscol )
28773 : {
28774 0 : eidx = a->vbegin.ptr.p_int[n+k];
28775 : }
28776 : else
28777 : {
28778 0 : eidx = a->vbegin.ptr.p_int[k];
28779 : }
28780 0 : while(eidx>=0)
28781 : {
28782 0 : idxr = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+4];
28783 0 : idxc = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+5];
28784 0 : if( iscol )
28785 : {
28786 0 : enext = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+3];
28787 : }
28788 : else
28789 : {
28790 0 : enext = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+1];
28791 : }
28792 0 : idxprev = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+0];
28793 0 : idxnext = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+1];
28794 0 : if( idxprev>=0 )
28795 : {
28796 0 : a->entries.ptr.p_int[idxprev*amdordering_llmentrysize+1] = idxnext;
28797 : }
28798 : else
28799 : {
28800 0 : a->vbegin.ptr.p_int[idxr] = idxnext;
28801 : }
28802 0 : if( idxnext>=0 )
28803 : {
28804 0 : a->entries.ptr.p_int[idxnext*amdordering_llmentrysize+0] = idxprev;
28805 : }
28806 0 : idxprev = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+2];
28807 0 : idxnext = a->entries.ptr.p_int[eidx*amdordering_llmentrysize+3];
28808 0 : if( idxprev>=0 )
28809 : {
28810 0 : a->entries.ptr.p_int[idxprev*amdordering_llmentrysize+3] = idxnext;
28811 : }
28812 : else
28813 : {
28814 0 : a->vbegin.ptr.p_int[idxc+n] = idxnext;
28815 : }
28816 0 : if( idxnext>=0 )
28817 : {
28818 0 : a->entries.ptr.p_int[idxnext*amdordering_llmentrysize+2] = idxprev;
28819 : }
28820 0 : a->entries.ptr.p_int[eidx*amdordering_llmentrysize+0] = a->vbegin.ptr.p_int[2*n];
28821 0 : a->vbegin.ptr.p_int[2*n] = eidx;
28822 0 : eidx = enext;
28823 0 : if( !iscol )
28824 : {
28825 0 : a->vcolcnt.ptr.p_int[idxc] = a->vcolcnt.ptr.p_int[idxc]-1;
28826 : }
28827 : }
28828 0 : if( iscol )
28829 : {
28830 0 : a->vcolcnt.ptr.p_int[k] = 0;
28831 : }
28832 0 : }
28833 :
28834 :
28835 : /*************************************************************************
28836 : Clears J-th column
28837 :
28838 : INPUT PARAMETERS
28839 : A - NxN linked list matrix
28840 : J - column index to clear
28841 :
28842 : OUTPUT PARAMETERS
28843 : A - J-th column is empty
28844 :
28845 :
28846 : -- ALGLIB PROJECT --
28847 : Copyright 05.10.2020 by Bochkanov Sergey.
28848 : *************************************************************************/
28849 0 : static void amdordering_mtxclearcolumn(amdllmatrix* a,
28850 : ae_int_t j,
28851 : ae_state *_state)
28852 : {
28853 :
28854 :
28855 0 : amdordering_mtxclearx(a, j, ae_true, _state);
28856 0 : }
28857 :
28858 :
28859 : /*************************************************************************
28860 : Clears J-th row
28861 :
28862 : INPUT PARAMETERS
28863 : A - NxN linked list matrix
28864 : J - row index to clear
28865 :
28866 : OUTPUT PARAMETERS
28867 : A - J-th row is empty
28868 :
28869 :
28870 : -- ALGLIB PROJECT --
28871 : Copyright 05.10.2020 by Bochkanov Sergey.
28872 : *************************************************************************/
28873 0 : static void amdordering_mtxclearrow(amdllmatrix* a,
28874 : ae_int_t j,
28875 : ae_state *_state)
28876 : {
28877 :
28878 :
28879 0 : amdordering_mtxclearx(a, j, ae_false, _state);
28880 0 : }
28881 :
28882 :
28883 : /*************************************************************************
28884 : Initialize vertex storage using A to estimate initial degrees
28885 :
28886 : INPUT PARAMETERS
28887 : A - NxN lower triangular sparse CRS matrix
28888 : N - problem size
28889 : CheckExactDegrees-
28890 : whether we want to maintain additional exact degress
28891 : (the search is still done using approximate ones)
28892 :
28893 : OUTPUT PARAMETERS
28894 : S - vertex set
28895 :
28896 :
28897 : -- ALGLIB PROJECT --
28898 : Copyright 05.10.2020 by Bochkanov Sergey.
28899 : *************************************************************************/
28900 0 : static void amdordering_vtxinit(sparsematrix* a,
28901 : ae_int_t n,
28902 : ae_bool checkexactdegrees,
28903 : amdvertexset* s,
28904 : ae_state *_state)
28905 : {
28906 : ae_int_t i;
28907 : ae_int_t j;
28908 : ae_int_t jj;
28909 : ae_int_t j0;
28910 : ae_int_t j1;
28911 :
28912 0 : _amdvertexset_clear(s);
28913 :
28914 0 : s->n = n;
28915 0 : s->checkexactdegrees = checkexactdegrees;
28916 0 : s->smallestdegree = 0;
28917 0 : bsetallocv(n, ae_true, &s->isvertex, _state);
28918 0 : isetallocv(n, 0, &s->approxd, _state);
28919 0 : for(i=0; i<=n-1; i++)
28920 : {
28921 0 : j0 = a->ridx.ptr.p_int[i];
28922 0 : j1 = a->didx.ptr.p_int[i]-1;
28923 0 : s->approxd.ptr.p_int[i] = j1-j0+1;
28924 0 : for(jj=j0; jj<=j1; jj++)
28925 : {
28926 0 : j = a->idx.ptr.p_int[jj];
28927 0 : s->approxd.ptr.p_int[j] = s->approxd.ptr.p_int[j]+1;
28928 : }
28929 : }
28930 0 : if( checkexactdegrees )
28931 : {
28932 0 : icopyallocv(n, &s->approxd, &s->optionalexactd, _state);
28933 : }
28934 0 : isetallocv(n, -1, &s->vbegin, _state);
28935 0 : isetallocv(n, -1, &s->vprev, _state);
28936 0 : isetallocv(n, -1, &s->vnext, _state);
28937 0 : for(i=0; i<=n-1; i++)
28938 : {
28939 0 : j = s->approxd.ptr.p_int[i];
28940 0 : j0 = s->vbegin.ptr.p_int[j];
28941 0 : s->vbegin.ptr.p_int[j] = i;
28942 0 : s->vnext.ptr.p_int[i] = j0;
28943 0 : s->vprev.ptr.p_int[i] = -1;
28944 0 : if( j0>=0 )
28945 : {
28946 0 : s->vprev.ptr.p_int[j0] = i;
28947 : }
28948 : }
28949 0 : }
28950 :
28951 :
28952 : /*************************************************************************
28953 : Removes vertex from the storage
28954 :
28955 : INPUT PARAMETERS
28956 : S - vertex set
28957 : P - vertex to be removed
28958 :
28959 : OUTPUT PARAMETERS
28960 : S - modified
28961 :
28962 :
28963 : -- ALGLIB PROJECT --
28964 : Copyright 05.10.2020 by Bochkanov Sergey.
28965 : *************************************************************************/
28966 0 : static void amdordering_vtxremovevertex(amdvertexset* s,
28967 : ae_int_t p,
28968 : ae_state *_state)
28969 : {
28970 : ae_int_t d;
28971 : ae_int_t idxprev;
28972 : ae_int_t idxnext;
28973 :
28974 :
28975 0 : d = s->approxd.ptr.p_int[p];
28976 0 : idxprev = s->vprev.ptr.p_int[p];
28977 0 : idxnext = s->vnext.ptr.p_int[p];
28978 0 : if( idxprev>=0 )
28979 : {
28980 0 : s->vnext.ptr.p_int[idxprev] = idxnext;
28981 : }
28982 : else
28983 : {
28984 0 : s->vbegin.ptr.p_int[d] = idxnext;
28985 : }
28986 0 : if( idxnext>=0 )
28987 : {
28988 0 : s->vprev.ptr.p_int[idxnext] = idxprev;
28989 : }
28990 0 : s->isvertex.ptr.p_bool[p] = ae_false;
28991 0 : s->approxd.ptr.p_int[p] = -9999999;
28992 0 : if( s->checkexactdegrees )
28993 : {
28994 0 : s->optionalexactd.ptr.p_int[p] = -9999999;
28995 : }
28996 0 : }
28997 :
28998 :
28999 : /*************************************************************************
29000 : Get approximate degree. Result is undefined for removed vertexes.
29001 :
29002 : INPUT PARAMETERS
29003 : S - vertex set
29004 : P - vertex index
29005 :
29006 : RESULT
29007 : vertex degree
29008 :
29009 :
29010 : -- ALGLIB PROJECT --
29011 : Copyright 05.10.2020 by Bochkanov Sergey.
29012 : *************************************************************************/
29013 0 : static ae_int_t amdordering_vtxgetapprox(amdvertexset* s,
29014 : ae_int_t p,
29015 : ae_state *_state)
29016 : {
29017 : ae_int_t result;
29018 :
29019 :
29020 0 : result = s->approxd.ptr.p_int[p];
29021 0 : return result;
29022 : }
29023 :
29024 :
29025 : /*************************************************************************
29026 : Get exact degree (or 0, if not supported). Result is undefined for
29027 : removed vertexes.
29028 :
29029 : INPUT PARAMETERS
29030 : S - vertex set
29031 : P - vertex index
29032 :
29033 : RESULT
29034 : vertex degree
29035 :
29036 :
29037 : -- ALGLIB PROJECT --
29038 : Copyright 05.10.2020 by Bochkanov Sergey.
29039 : *************************************************************************/
29040 0 : static ae_int_t amdordering_vtxgetexact(amdvertexset* s,
29041 : ae_int_t p,
29042 : ae_state *_state)
29043 : {
29044 : ae_int_t result;
29045 :
29046 :
29047 0 : if( s->checkexactdegrees )
29048 : {
29049 0 : result = s->optionalexactd.ptr.p_int[p];
29050 : }
29051 : else
29052 : {
29053 0 : result = 0;
29054 : }
29055 0 : return result;
29056 : }
29057 :
29058 :
29059 : /*************************************************************************
29060 : Returns index of vertex with minimum approximate degree, or -1 when there
29061 : is no vertex.
29062 :
29063 : INPUT PARAMETERS
29064 : S - vertex set
29065 :
29066 : RESULT
29067 : vertex index, or -1
29068 :
29069 :
29070 : -- ALGLIB PROJECT --
29071 : Copyright 05.10.2020 by Bochkanov Sergey.
29072 : *************************************************************************/
29073 0 : static ae_int_t amdordering_vtxgetapproxmindegree(amdvertexset* s,
29074 : ae_state *_state)
29075 : {
29076 : ae_int_t i;
29077 : ae_int_t n;
29078 : ae_int_t result;
29079 :
29080 :
29081 0 : n = s->n;
29082 0 : result = -1;
29083 0 : for(i=s->smallestdegree; i<=n-1; i++)
29084 : {
29085 0 : if( s->vbegin.ptr.p_int[i]>=0 )
29086 : {
29087 0 : s->smallestdegree = i;
29088 0 : result = s->vbegin.ptr.p_int[i];
29089 0 : return result;
29090 : }
29091 : }
29092 0 : return result;
29093 : }
29094 :
29095 :
29096 : /*************************************************************************
29097 : Update approximate degree
29098 :
29099 : INPUT PARAMETERS
29100 : S - vertex set
29101 : P - vertex to be updated
29102 : DNew - new degree
29103 :
29104 : OUTPUT PARAMETERS
29105 : S - modified
29106 :
29107 :
29108 : -- ALGLIB PROJECT --
29109 : Copyright 05.10.2020 by Bochkanov Sergey.
29110 : *************************************************************************/
29111 0 : static void amdordering_vtxupdateapproximatedegree(amdvertexset* s,
29112 : ae_int_t p,
29113 : ae_int_t dnew,
29114 : ae_state *_state)
29115 : {
29116 : ae_int_t dold;
29117 : ae_int_t idxprev;
29118 : ae_int_t idxnext;
29119 : ae_int_t oldbegin;
29120 :
29121 :
29122 0 : dold = s->approxd.ptr.p_int[p];
29123 0 : if( dold==dnew )
29124 : {
29125 0 : return;
29126 : }
29127 0 : idxprev = s->vprev.ptr.p_int[p];
29128 0 : idxnext = s->vnext.ptr.p_int[p];
29129 0 : if( idxprev>=0 )
29130 : {
29131 0 : s->vnext.ptr.p_int[idxprev] = idxnext;
29132 : }
29133 : else
29134 : {
29135 0 : s->vbegin.ptr.p_int[dold] = idxnext;
29136 : }
29137 0 : if( idxnext>=0 )
29138 : {
29139 0 : s->vprev.ptr.p_int[idxnext] = idxprev;
29140 : }
29141 0 : oldbegin = s->vbegin.ptr.p_int[dnew];
29142 0 : s->vbegin.ptr.p_int[dnew] = p;
29143 0 : s->vnext.ptr.p_int[p] = oldbegin;
29144 0 : s->vprev.ptr.p_int[p] = -1;
29145 0 : if( oldbegin>=0 )
29146 : {
29147 0 : s->vprev.ptr.p_int[oldbegin] = p;
29148 : }
29149 0 : s->approxd.ptr.p_int[p] = dnew;
29150 0 : if( dnew<s->smallestdegree )
29151 : {
29152 0 : s->smallestdegree = dnew;
29153 : }
29154 : }
29155 :
29156 :
29157 : /*************************************************************************
29158 : Update optional exact degree. Silently returns if vertex set does not store
29159 : exact degrees.
29160 :
29161 : INPUT PARAMETERS
29162 : S - vertex set
29163 : P - vertex to be updated
29164 : D - new degree
29165 :
29166 : OUTPUT PARAMETERS
29167 : S - modified
29168 :
29169 :
29170 : -- ALGLIB PROJECT --
29171 : Copyright 05.10.2020 by Bochkanov Sergey.
29172 : *************************************************************************/
29173 0 : static void amdordering_vtxupdateexactdegree(amdvertexset* s,
29174 : ae_int_t p,
29175 : ae_int_t d,
29176 : ae_state *_state)
29177 : {
29178 :
29179 :
29180 0 : if( !s->checkexactdegrees )
29181 : {
29182 0 : return;
29183 : }
29184 0 : s->optionalexactd.ptr.p_int[p] = d;
29185 : }
29186 :
29187 :
29188 : /*************************************************************************
29189 : This function selects K-th pivot with minimum approximate degree and
29190 : generates permutation that reorders variable to the K-th position in the
29191 : matrix.
29192 :
29193 : Due to supernodal structure of the matrix more than one pivot variable can
29194 : be selected and moved to the beginning. The actual count of pivots selected
29195 : is returned in NodeSize.
29196 :
29197 : INPUT PARAMETERS
29198 : Buf - properly initialized buffer object
29199 : K - pivot index
29200 :
29201 : OUTPUT PARAMETERS
29202 : Buf.Perm - entries [K,K+NodeSize) are initialized by permutation
29203 : Buf.InvPerm - entries [K,K+NodeSize) are initialized by permutation
29204 : Buf.ColumnSwaps-entries [K,K+NodeSize) are initialized by permutation
29205 : P - pivot supervariable
29206 : NodeSize - supernode size
29207 :
29208 : -- ALGLIB PROJECT --
29209 : Copyright 05.10.2020 by Bochkanov Sergey.
29210 : *************************************************************************/
29211 0 : static void amdordering_amdselectpivotelement(amdbuffer* buf,
29212 : ae_int_t k,
29213 : ae_int_t* p,
29214 : ae_int_t* nodesize,
29215 : ae_state *_state)
29216 : {
29217 : ae_int_t i;
29218 : ae_int_t j;
29219 :
29220 0 : *p = 0;
29221 0 : *nodesize = 0;
29222 :
29223 0 : *p = amdordering_vtxgetapproxmindegree(&buf->vertexdegrees, _state);
29224 0 : ae_assert(*p>=0, "GenerateAMDPermutation: integrity check 3634 failed", _state);
29225 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, *p, _state)>=0, "integrity check RDFD2 failed", _state);
29226 0 : *nodesize = 0;
29227 0 : amdordering_knsstartenumeration(&buf->setsuper, *p, _state);
29228 0 : while(amdordering_knsenumerate(&buf->setsuper, &j, _state))
29229 : {
29230 0 : i = buf->perm.ptr.p_int[j];
29231 0 : buf->columnswaps.ptr.p_int[k+(*nodesize)] = i;
29232 0 : buf->invperm.ptr.p_int[i] = buf->invperm.ptr.p_int[k+(*nodesize)];
29233 0 : buf->invperm.ptr.p_int[k+(*nodesize)] = j;
29234 0 : buf->perm.ptr.p_int[buf->invperm.ptr.p_int[i]] = i;
29235 0 : buf->perm.ptr.p_int[buf->invperm.ptr.p_int[k+(*nodesize)]] = k+(*nodesize);
29236 0 : inc(nodesize, _state);
29237 : }
29238 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, *p, _state)>=0&&(!buf->checkexactdegrees||amdordering_vtxgetexact(&buf->vertexdegrees, *p, _state)>=0), "AMD: integrity check RDFD failed", _state);
29239 0 : }
29240 :
29241 :
29242 : /*************************************************************************
29243 : This function computes nonzero pattern of Lp, the column that is added to
29244 : the lower triangular Cholesky factor.
29245 :
29246 : INPUT PARAMETERS
29247 : Buf - properly initialized buffer object
29248 : P - pivot column
29249 :
29250 : OUTPUT PARAMETERS
29251 : Buf.Lp - initialized with Lp
29252 : Buf.PLp - initialized with setSuper[P]+Lp
29253 : Buf.Ep - initialized with setE[P]
29254 : Buf.mtxL - L := L+Lp
29255 : Buf.Ls - first Buf.LSCnt elements contain subset of Lp elements
29256 : that are principal nodes in supervariables.
29257 :
29258 : -- ALGLIB PROJECT --
29259 : Copyright 05.10.2020 by Bochkanov Sergey.
29260 : *************************************************************************/
29261 0 : static void amdordering_amdcomputelp(amdbuffer* buf,
29262 : ae_int_t p,
29263 : ae_state *_state)
29264 : {
29265 : ae_int_t i;
29266 :
29267 :
29268 0 : amdordering_nsclear(&buf->lp, _state);
29269 0 : amdordering_nsaddkth(&buf->lp, &buf->seta, p, _state);
29270 0 : amdordering_knsstartenumeration(&buf->sete, p, _state);
29271 0 : while(amdordering_knsenumerate(&buf->sete, &i, _state))
29272 : {
29273 0 : amdordering_mtxaddcolumnto(&buf->mtxl, i, &buf->lp, _state);
29274 : }
29275 0 : amdordering_nssubtractkth(&buf->lp, &buf->setsuper, p, _state);
29276 0 : buf->lscnt = 0;
29277 0 : amdordering_nsstartenumeration(&buf->lp, _state);
29278 0 : while(amdordering_nsenumerate(&buf->lp, &i, _state))
29279 : {
29280 0 : ae_assert(!buf->iseliminated.ptr.p_bool[i], "AMD: integrity check 0740 failed", _state);
29281 0 : amdordering_mtxinsertnewelement(&buf->mtxl, i, p, _state);
29282 0 : if( buf->issupernode.ptr.p_bool[i] )
29283 : {
29284 0 : buf->ls.ptr.p_int[buf->lscnt] = i;
29285 0 : buf->lscnt = buf->lscnt+1;
29286 : }
29287 : }
29288 0 : amdordering_nscopy(&buf->lp, &buf->plp, _state);
29289 0 : amdordering_nsaddkth(&buf->plp, &buf->setsuper, p, _state);
29290 0 : amdordering_nsclear(&buf->ep, _state);
29291 0 : amdordering_nsaddkth(&buf->ep, &buf->sete, p, _state);
29292 0 : }
29293 :
29294 :
29295 : /*************************************************************************
29296 : Having output of AMDComputeLp() in the Buf object, this function performs
29297 : mass elimination in the quotient graph.
29298 :
29299 : INPUT PARAMETERS
29300 : Buf - properly initialized buffer object
29301 : P - pivot column
29302 : K - number of already eliminated columns (P-th is not counted)
29303 :
29304 : OUTPUT PARAMETERS
29305 : Buf.setA - Lp is eliminated from setA
29306 : Buf.setE - Ep is eliminated from setE, P is added
29307 : approxD - updated
29308 :
29309 : -- ALGLIB PROJECT --
29310 : Copyright 05.10.2020 by Bochkanov Sergey.
29311 : *************************************************************************/
29312 0 : static void amdordering_amdmasselimination(amdbuffer* buf,
29313 : ae_int_t p,
29314 : ae_int_t k,
29315 : ae_state *_state)
29316 : {
29317 : ae_int_t n;
29318 : ae_int_t lidx;
29319 : ae_int_t lpi;
29320 : ae_int_t cntsuperi;
29321 : ae_int_t cntainoti;
29322 : ae_int_t cntlpnoti;
29323 : ae_int_t cc;
29324 : ae_int_t j;
29325 : ae_int_t e;
29326 : ae_int_t we;
29327 : ae_int_t cnttoclean;
29328 : ae_int_t idxbegin;
29329 : ae_int_t idxend;
29330 : ae_int_t jj;
29331 :
29332 :
29333 0 : n = buf->n;
29334 0 : ivectorsetlengthatleast(&buf->tmp0, n, _state);
29335 0 : cnttoclean = 0;
29336 0 : for(lidx=0; lidx<=buf->lscnt-1; lidx++)
29337 : {
29338 0 : lpi = buf->ls.ptr.p_int[lidx];
29339 0 : cntsuperi = amdordering_knscountkth(&buf->setsuper, lpi, _state);
29340 0 : amdordering_knsdirectaccess(&buf->sete, lpi, &idxbegin, &idxend, _state);
29341 0 : for(jj=idxbegin; jj<=idxend-1; jj++)
29342 : {
29343 0 : e = buf->sete.data.ptr.p_int[jj];
29344 0 : we = buf->arrwe.ptr.p_int[e];
29345 0 : if( we<0 )
29346 : {
29347 0 : we = amdordering_mtxcountcolumn(&buf->mtxl, e, _state);
29348 0 : buf->tmp0.ptr.p_int[cnttoclean] = e;
29349 0 : cnttoclean = cnttoclean+1;
29350 : }
29351 0 : buf->arrwe.ptr.p_int[e] = we-cntsuperi;
29352 : }
29353 : }
29354 0 : for(lidx=0; lidx<=buf->lscnt-1; lidx++)
29355 : {
29356 0 : lpi = buf->ls.ptr.p_int[lidx];
29357 0 : amdordering_knssubtract1(&buf->seta, lpi, &buf->plp, _state);
29358 0 : amdordering_knssubtract1(&buf->sete, lpi, &buf->ep, _state);
29359 0 : amdordering_knsaddnewelement(&buf->sete, lpi, p, _state);
29360 0 : if( buf->extendeddebug )
29361 : {
29362 0 : ae_assert(amdordering_knscountnotkth(&buf->seta, lpi, &buf->setsuper, lpi, _state)==amdordering_knscountkth(&buf->seta, lpi, _state), "AMD: integrity check 454F failed", _state);
29363 0 : ae_assert(amdordering_knscountandkth(&buf->seta, lpi, &buf->setsuper, lpi, _state)==0, "AMD: integrity check kl5nv failed", _state);
29364 0 : ae_assert(amdordering_nscountandkth(&buf->lp, &buf->setsuper, lpi, _state)==amdordering_knscountkth(&buf->setsuper, lpi, _state), "AMD: integrity check 8463 failed", _state);
29365 : }
29366 0 : cntainoti = amdordering_knscountkth(&buf->seta, lpi, _state);
29367 0 : cntlpnoti = amdordering_nscount(&buf->lp, _state)-amdordering_knscountkth(&buf->setsuper, lpi, _state);
29368 0 : cc = 0;
29369 0 : amdordering_knsdirectaccess(&buf->sete, lpi, &idxbegin, &idxend, _state);
29370 0 : for(jj=idxbegin; jj<=idxend-1; jj++)
29371 : {
29372 0 : j = buf->sete.data.ptr.p_int[jj];
29373 0 : if( j==p )
29374 : {
29375 0 : continue;
29376 : }
29377 0 : e = buf->arrwe.ptr.p_int[j];
29378 0 : if( e<0 )
29379 : {
29380 0 : e = amdordering_mtxcountcolumn(&buf->mtxl, j, _state);
29381 : }
29382 0 : cc = cc+e;
29383 : }
29384 0 : amdordering_vtxupdateapproximatedegree(&buf->vertexdegrees, lpi, imin3(n-k, amdordering_vtxgetapprox(&buf->vertexdegrees, lpi, _state)+cntlpnoti, cntainoti+cntlpnoti+cc, _state), _state);
29385 0 : if( buf->checkexactdegrees )
29386 : {
29387 0 : amdordering_nsclear(&buf->exactdegreetmp0, _state);
29388 0 : amdordering_knsstartenumeration(&buf->sete, lpi, _state);
29389 0 : while(amdordering_knsenumerate(&buf->sete, &j, _state))
29390 : {
29391 0 : amdordering_mtxaddcolumnto(&buf->mtxl, j, &buf->exactdegreetmp0, _state);
29392 : }
29393 0 : amdordering_vtxupdateexactdegree(&buf->vertexdegrees, lpi, cntainoti+amdordering_nscountnotkth(&buf->exactdegreetmp0, &buf->setsuper, lpi, _state), _state);
29394 0 : ae_assert(amdordering_knscountkth(&buf->sete, lpi, _state)>2||amdordering_vtxgetapprox(&buf->vertexdegrees, lpi, _state)==amdordering_vtxgetexact(&buf->vertexdegrees, lpi, _state), "AMD: integrity check 7206 failed", _state);
29395 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, lpi, _state)>=amdordering_vtxgetexact(&buf->vertexdegrees, lpi, _state), "AMD: integrity check 8206 failed", _state);
29396 : }
29397 : }
29398 0 : for(j=0; j<=cnttoclean-1; j++)
29399 : {
29400 0 : buf->arrwe.ptr.p_int[buf->tmp0.ptr.p_int[j]] = -1;
29401 : }
29402 0 : }
29403 :
29404 :
29405 : /*************************************************************************
29406 : After mass elimination, but before removal of vertex P, we may perform
29407 : supernode detection. Only variables/supernodes in Lp (P itself is NOT
29408 : included) can be merged into larger supernodes.
29409 :
29410 : INPUT PARAMETERS
29411 : Buf - properly initialized buffer object
29412 :
29413 : OUTPUT PARAMETERS
29414 : Buf - following fields of Buf may be modified:
29415 : * Buf.setSuper
29416 : * Buf.setA
29417 : * Buf.setE
29418 : * Buf.IsSupernode
29419 : * ApproxD and ExactD
29420 :
29421 : -- ALGLIB PROJECT --
29422 : Copyright 05.10.2020 by Bochkanov Sergey.
29423 : *************************************************************************/
29424 0 : static void amdordering_amddetectsupernodes(amdbuffer* buf,
29425 : ae_state *_state)
29426 : {
29427 : ae_int_t n;
29428 : ae_int_t i;
29429 : ae_int_t j;
29430 : ae_int_t cnt;
29431 : ae_int_t lpi;
29432 : ae_int_t lpj;
29433 : ae_int_t nj;
29434 : ae_int_t hashi;
29435 :
29436 :
29437 0 : n = buf->n;
29438 0 : ivectorsetlengthatleast(&buf->sncandidates, n, _state);
29439 0 : if( buf->lscnt<2 )
29440 : {
29441 0 : return;
29442 : }
29443 0 : for(i=0; i<=buf->lscnt-1; i++)
29444 : {
29445 0 : lpi = buf->ls.ptr.p_int[i];
29446 0 : hashi = (amdordering_knssumkth(&buf->seta, lpi, _state)+amdordering_knssumkth(&buf->sete, lpi, _state))%n;
29447 0 : amdordering_nsaddelement(&buf->nonemptybuckets, hashi, _state);
29448 0 : amdordering_knsaddnewelement(&buf->hashbuckets, hashi, lpi, _state);
29449 : }
29450 0 : amdordering_nsstartenumeration(&buf->nonemptybuckets, _state);
29451 0 : while(amdordering_nsenumerate(&buf->nonemptybuckets, &hashi, _state))
29452 : {
29453 0 : if( amdordering_knscountkth(&buf->hashbuckets, hashi, _state)>=2 )
29454 : {
29455 0 : cnt = 0;
29456 0 : amdordering_knsstartenumeration(&buf->hashbuckets, hashi, _state);
29457 0 : while(amdordering_knsenumerate(&buf->hashbuckets, &i, _state))
29458 : {
29459 0 : buf->sncandidates.ptr.p_int[cnt] = i;
29460 0 : cnt = cnt+1;
29461 : }
29462 0 : for(i=cnt-1; i>=0; i--)
29463 : {
29464 0 : for(j=cnt-1; j>=i+1; j--)
29465 : {
29466 0 : if( buf->issupernode.ptr.p_bool[buf->sncandidates.ptr.p_int[i]]&&buf->issupernode.ptr.p_bool[buf->sncandidates.ptr.p_int[j]] )
29467 : {
29468 0 : lpi = buf->sncandidates.ptr.p_int[i];
29469 0 : lpj = buf->sncandidates.ptr.p_int[j];
29470 0 : amdordering_nsclear(&buf->adji, _state);
29471 0 : amdordering_nsclear(&buf->adjj, _state);
29472 0 : amdordering_nsaddkth(&buf->adji, &buf->seta, lpi, _state);
29473 0 : amdordering_nsaddkth(&buf->adjj, &buf->seta, lpj, _state);
29474 0 : amdordering_nsaddkth(&buf->adji, &buf->sete, lpi, _state);
29475 0 : amdordering_nsaddkth(&buf->adjj, &buf->sete, lpj, _state);
29476 0 : amdordering_nsaddelement(&buf->adji, lpi, _state);
29477 0 : amdordering_nsaddelement(&buf->adji, lpj, _state);
29478 0 : amdordering_nsaddelement(&buf->adjj, lpi, _state);
29479 0 : amdordering_nsaddelement(&buf->adjj, lpj, _state);
29480 0 : if( !amdordering_nsequal(&buf->adji, &buf->adjj, _state) )
29481 : {
29482 0 : continue;
29483 : }
29484 0 : if( buf->extendeddebug )
29485 : {
29486 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, lpi, _state)>=1&&(!buf->checkexactdegrees||amdordering_vtxgetexact(&buf->vertexdegrees, lpi, _state)>=1), "AMD: integrity check &GBFF1 failed", _state);
29487 0 : ae_assert(amdordering_vtxgetapprox(&buf->vertexdegrees, lpj, _state)>=1&&(!buf->checkexactdegrees||amdordering_vtxgetexact(&buf->vertexdegrees, lpj, _state)>=1), "AMD: integrity check &GBFF2 failed", _state);
29488 0 : ae_assert(amdordering_knscountandkth(&buf->setsuper, lpi, &buf->setsuper, lpj, _state)==0, "AMD: integrity check &GBFF3 failed", _state);
29489 : }
29490 0 : nj = amdordering_knscountkth(&buf->setsuper, lpj, _state);
29491 0 : amdordering_knsaddkthdistinct(&buf->setsuper, lpi, &buf->setsuper, lpj, _state);
29492 0 : amdordering_knsclearkthreclaim(&buf->setsuper, lpj, _state);
29493 0 : amdordering_knsclearkthreclaim(&buf->seta, lpj, _state);
29494 0 : amdordering_knsclearkthreclaim(&buf->sete, lpj, _state);
29495 0 : buf->issupernode.ptr.p_bool[lpj] = ae_false;
29496 0 : amdordering_vtxremovevertex(&buf->vertexdegrees, lpj, _state);
29497 0 : amdordering_vtxupdateapproximatedegree(&buf->vertexdegrees, lpi, amdordering_vtxgetapprox(&buf->vertexdegrees, lpi, _state)-nj, _state);
29498 0 : if( buf->checkexactdegrees )
29499 : {
29500 0 : amdordering_vtxupdateexactdegree(&buf->vertexdegrees, lpi, amdordering_vtxgetexact(&buf->vertexdegrees, lpi, _state)-nj, _state);
29501 : }
29502 : }
29503 : }
29504 : }
29505 : }
29506 0 : amdordering_knsclearkthnoreclaim(&buf->hashbuckets, hashi, _state);
29507 : }
29508 0 : amdordering_nsclear(&buf->nonemptybuckets, _state);
29509 : }
29510 :
29511 :
29512 0 : void _amdnset_init(void* _p, ae_state *_state, ae_bool make_automatic)
29513 : {
29514 0 : amdnset *p = (amdnset*)_p;
29515 0 : ae_touch_ptr((void*)p);
29516 0 : ae_vector_init(&p->items, 0, DT_INT, _state, make_automatic);
29517 0 : ae_vector_init(&p->locationof, 0, DT_INT, _state, make_automatic);
29518 0 : }
29519 :
29520 :
29521 0 : void _amdnset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
29522 : {
29523 0 : amdnset *dst = (amdnset*)_dst;
29524 0 : amdnset *src = (amdnset*)_src;
29525 0 : dst->n = src->n;
29526 0 : dst->nstored = src->nstored;
29527 0 : ae_vector_init_copy(&dst->items, &src->items, _state, make_automatic);
29528 0 : ae_vector_init_copy(&dst->locationof, &src->locationof, _state, make_automatic);
29529 0 : dst->iteridx = src->iteridx;
29530 0 : }
29531 :
29532 :
29533 0 : void _amdnset_clear(void* _p)
29534 : {
29535 0 : amdnset *p = (amdnset*)_p;
29536 0 : ae_touch_ptr((void*)p);
29537 0 : ae_vector_clear(&p->items);
29538 0 : ae_vector_clear(&p->locationof);
29539 0 : }
29540 :
29541 :
29542 0 : void _amdnset_destroy(void* _p)
29543 : {
29544 0 : amdnset *p = (amdnset*)_p;
29545 0 : ae_touch_ptr((void*)p);
29546 0 : ae_vector_destroy(&p->items);
29547 0 : ae_vector_destroy(&p->locationof);
29548 0 : }
29549 :
29550 :
29551 0 : void _amdknset_init(void* _p, ae_state *_state, ae_bool make_automatic)
29552 : {
29553 0 : amdknset *p = (amdknset*)_p;
29554 0 : ae_touch_ptr((void*)p);
29555 0 : ae_vector_init(&p->flagarray, 0, DT_INT, _state, make_automatic);
29556 0 : ae_vector_init(&p->vbegin, 0, DT_INT, _state, make_automatic);
29557 0 : ae_vector_init(&p->vallocated, 0, DT_INT, _state, make_automatic);
29558 0 : ae_vector_init(&p->vcnt, 0, DT_INT, _state, make_automatic);
29559 0 : ae_vector_init(&p->data, 0, DT_INT, _state, make_automatic);
29560 0 : }
29561 :
29562 :
29563 0 : void _amdknset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
29564 : {
29565 0 : amdknset *dst = (amdknset*)_dst;
29566 0 : amdknset *src = (amdknset*)_src;
29567 0 : dst->k = src->k;
29568 0 : dst->n = src->n;
29569 0 : ae_vector_init_copy(&dst->flagarray, &src->flagarray, _state, make_automatic);
29570 0 : ae_vector_init_copy(&dst->vbegin, &src->vbegin, _state, make_automatic);
29571 0 : ae_vector_init_copy(&dst->vallocated, &src->vallocated, _state, make_automatic);
29572 0 : ae_vector_init_copy(&dst->vcnt, &src->vcnt, _state, make_automatic);
29573 0 : ae_vector_init_copy(&dst->data, &src->data, _state, make_automatic);
29574 0 : dst->dataused = src->dataused;
29575 0 : dst->iterrow = src->iterrow;
29576 0 : dst->iteridx = src->iteridx;
29577 0 : }
29578 :
29579 :
29580 0 : void _amdknset_clear(void* _p)
29581 : {
29582 0 : amdknset *p = (amdknset*)_p;
29583 0 : ae_touch_ptr((void*)p);
29584 0 : ae_vector_clear(&p->flagarray);
29585 0 : ae_vector_clear(&p->vbegin);
29586 0 : ae_vector_clear(&p->vallocated);
29587 0 : ae_vector_clear(&p->vcnt);
29588 0 : ae_vector_clear(&p->data);
29589 0 : }
29590 :
29591 :
29592 0 : void _amdknset_destroy(void* _p)
29593 : {
29594 0 : amdknset *p = (amdknset*)_p;
29595 0 : ae_touch_ptr((void*)p);
29596 0 : ae_vector_destroy(&p->flagarray);
29597 0 : ae_vector_destroy(&p->vbegin);
29598 0 : ae_vector_destroy(&p->vallocated);
29599 0 : ae_vector_destroy(&p->vcnt);
29600 0 : ae_vector_destroy(&p->data);
29601 0 : }
29602 :
29603 :
29604 0 : void _amdvertexset_init(void* _p, ae_state *_state, ae_bool make_automatic)
29605 : {
29606 0 : amdvertexset *p = (amdvertexset*)_p;
29607 0 : ae_touch_ptr((void*)p);
29608 0 : ae_vector_init(&p->approxd, 0, DT_INT, _state, make_automatic);
29609 0 : ae_vector_init(&p->optionalexactd, 0, DT_INT, _state, make_automatic);
29610 0 : ae_vector_init(&p->isvertex, 0, DT_BOOL, _state, make_automatic);
29611 0 : ae_vector_init(&p->vbegin, 0, DT_INT, _state, make_automatic);
29612 0 : ae_vector_init(&p->vprev, 0, DT_INT, _state, make_automatic);
29613 0 : ae_vector_init(&p->vnext, 0, DT_INT, _state, make_automatic);
29614 0 : }
29615 :
29616 :
29617 0 : void _amdvertexset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
29618 : {
29619 0 : amdvertexset *dst = (amdvertexset*)_dst;
29620 0 : amdvertexset *src = (amdvertexset*)_src;
29621 0 : dst->n = src->n;
29622 0 : dst->checkexactdegrees = src->checkexactdegrees;
29623 0 : dst->smallestdegree = src->smallestdegree;
29624 0 : ae_vector_init_copy(&dst->approxd, &src->approxd, _state, make_automatic);
29625 0 : ae_vector_init_copy(&dst->optionalexactd, &src->optionalexactd, _state, make_automatic);
29626 0 : ae_vector_init_copy(&dst->isvertex, &src->isvertex, _state, make_automatic);
29627 0 : ae_vector_init_copy(&dst->vbegin, &src->vbegin, _state, make_automatic);
29628 0 : ae_vector_init_copy(&dst->vprev, &src->vprev, _state, make_automatic);
29629 0 : ae_vector_init_copy(&dst->vnext, &src->vnext, _state, make_automatic);
29630 0 : }
29631 :
29632 :
29633 0 : void _amdvertexset_clear(void* _p)
29634 : {
29635 0 : amdvertexset *p = (amdvertexset*)_p;
29636 0 : ae_touch_ptr((void*)p);
29637 0 : ae_vector_clear(&p->approxd);
29638 0 : ae_vector_clear(&p->optionalexactd);
29639 0 : ae_vector_clear(&p->isvertex);
29640 0 : ae_vector_clear(&p->vbegin);
29641 0 : ae_vector_clear(&p->vprev);
29642 0 : ae_vector_clear(&p->vnext);
29643 0 : }
29644 :
29645 :
29646 0 : void _amdvertexset_destroy(void* _p)
29647 : {
29648 0 : amdvertexset *p = (amdvertexset*)_p;
29649 0 : ae_touch_ptr((void*)p);
29650 0 : ae_vector_destroy(&p->approxd);
29651 0 : ae_vector_destroy(&p->optionalexactd);
29652 0 : ae_vector_destroy(&p->isvertex);
29653 0 : ae_vector_destroy(&p->vbegin);
29654 0 : ae_vector_destroy(&p->vprev);
29655 0 : ae_vector_destroy(&p->vnext);
29656 0 : }
29657 :
29658 :
29659 0 : void _amdllmatrix_init(void* _p, ae_state *_state, ae_bool make_automatic)
29660 : {
29661 0 : amdllmatrix *p = (amdllmatrix*)_p;
29662 0 : ae_touch_ptr((void*)p);
29663 0 : ae_vector_init(&p->vbegin, 0, DT_INT, _state, make_automatic);
29664 0 : ae_vector_init(&p->vcolcnt, 0, DT_INT, _state, make_automatic);
29665 0 : ae_vector_init(&p->entries, 0, DT_INT, _state, make_automatic);
29666 0 : }
29667 :
29668 :
29669 0 : void _amdllmatrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
29670 : {
29671 0 : amdllmatrix *dst = (amdllmatrix*)_dst;
29672 0 : amdllmatrix *src = (amdllmatrix*)_src;
29673 0 : dst->n = src->n;
29674 0 : ae_vector_init_copy(&dst->vbegin, &src->vbegin, _state, make_automatic);
29675 0 : ae_vector_init_copy(&dst->vcolcnt, &src->vcolcnt, _state, make_automatic);
29676 0 : ae_vector_init_copy(&dst->entries, &src->entries, _state, make_automatic);
29677 0 : dst->entriesinitialized = src->entriesinitialized;
29678 0 : }
29679 :
29680 :
29681 0 : void _amdllmatrix_clear(void* _p)
29682 : {
29683 0 : amdllmatrix *p = (amdllmatrix*)_p;
29684 0 : ae_touch_ptr((void*)p);
29685 0 : ae_vector_clear(&p->vbegin);
29686 0 : ae_vector_clear(&p->vcolcnt);
29687 0 : ae_vector_clear(&p->entries);
29688 0 : }
29689 :
29690 :
29691 0 : void _amdllmatrix_destroy(void* _p)
29692 : {
29693 0 : amdllmatrix *p = (amdllmatrix*)_p;
29694 0 : ae_touch_ptr((void*)p);
29695 0 : ae_vector_destroy(&p->vbegin);
29696 0 : ae_vector_destroy(&p->vcolcnt);
29697 0 : ae_vector_destroy(&p->entries);
29698 0 : }
29699 :
29700 :
29701 0 : void _amdbuffer_init(void* _p, ae_state *_state, ae_bool make_automatic)
29702 : {
29703 0 : amdbuffer *p = (amdbuffer*)_p;
29704 0 : ae_touch_ptr((void*)p);
29705 0 : ae_vector_init(&p->iseliminated, 0, DT_BOOL, _state, make_automatic);
29706 0 : ae_vector_init(&p->issupernode, 0, DT_BOOL, _state, make_automatic);
29707 0 : _amdknset_init(&p->setsuper, _state, make_automatic);
29708 0 : _amdknset_init(&p->seta, _state, make_automatic);
29709 0 : _amdknset_init(&p->sete, _state, make_automatic);
29710 0 : _amdllmatrix_init(&p->mtxl, _state, make_automatic);
29711 0 : _amdvertexset_init(&p->vertexdegrees, _state, make_automatic);
29712 0 : ae_vector_init(&p->perm, 0, DT_INT, _state, make_automatic);
29713 0 : ae_vector_init(&p->invperm, 0, DT_INT, _state, make_automatic);
29714 0 : ae_vector_init(&p->columnswaps, 0, DT_INT, _state, make_automatic);
29715 0 : _amdnset_init(&p->lp, _state, make_automatic);
29716 0 : _amdnset_init(&p->plp, _state, make_automatic);
29717 0 : _amdnset_init(&p->ep, _state, make_automatic);
29718 0 : _amdnset_init(&p->adji, _state, make_automatic);
29719 0 : _amdnset_init(&p->adjj, _state, make_automatic);
29720 0 : ae_vector_init(&p->ls, 0, DT_INT, _state, make_automatic);
29721 0 : _amdnset_init(&p->exactdegreetmp0, _state, make_automatic);
29722 0 : _amdknset_init(&p->hashbuckets, _state, make_automatic);
29723 0 : _amdnset_init(&p->nonemptybuckets, _state, make_automatic);
29724 0 : ae_vector_init(&p->sncandidates, 0, DT_INT, _state, make_automatic);
29725 0 : ae_vector_init(&p->tmp0, 0, DT_INT, _state, make_automatic);
29726 0 : ae_vector_init(&p->arrwe, 0, DT_INT, _state, make_automatic);
29727 0 : ae_matrix_init(&p->dbga, 0, 0, DT_REAL, _state, make_automatic);
29728 0 : }
29729 :
29730 :
29731 0 : void _amdbuffer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
29732 : {
29733 0 : amdbuffer *dst = (amdbuffer*)_dst;
29734 0 : amdbuffer *src = (amdbuffer*)_src;
29735 0 : dst->n = src->n;
29736 0 : dst->extendeddebug = src->extendeddebug;
29737 0 : dst->checkexactdegrees = src->checkexactdegrees;
29738 0 : ae_vector_init_copy(&dst->iseliminated, &src->iseliminated, _state, make_automatic);
29739 0 : ae_vector_init_copy(&dst->issupernode, &src->issupernode, _state, make_automatic);
29740 0 : _amdknset_init_copy(&dst->setsuper, &src->setsuper, _state, make_automatic);
29741 0 : _amdknset_init_copy(&dst->seta, &src->seta, _state, make_automatic);
29742 0 : _amdknset_init_copy(&dst->sete, &src->sete, _state, make_automatic);
29743 0 : _amdllmatrix_init_copy(&dst->mtxl, &src->mtxl, _state, make_automatic);
29744 0 : _amdvertexset_init_copy(&dst->vertexdegrees, &src->vertexdegrees, _state, make_automatic);
29745 0 : ae_vector_init_copy(&dst->perm, &src->perm, _state, make_automatic);
29746 0 : ae_vector_init_copy(&dst->invperm, &src->invperm, _state, make_automatic);
29747 0 : ae_vector_init_copy(&dst->columnswaps, &src->columnswaps, _state, make_automatic);
29748 0 : _amdnset_init_copy(&dst->lp, &src->lp, _state, make_automatic);
29749 0 : _amdnset_init_copy(&dst->plp, &src->plp, _state, make_automatic);
29750 0 : _amdnset_init_copy(&dst->ep, &src->ep, _state, make_automatic);
29751 0 : _amdnset_init_copy(&dst->adji, &src->adji, _state, make_automatic);
29752 0 : _amdnset_init_copy(&dst->adjj, &src->adjj, _state, make_automatic);
29753 0 : ae_vector_init_copy(&dst->ls, &src->ls, _state, make_automatic);
29754 0 : dst->lscnt = src->lscnt;
29755 0 : _amdnset_init_copy(&dst->exactdegreetmp0, &src->exactdegreetmp0, _state, make_automatic);
29756 0 : _amdknset_init_copy(&dst->hashbuckets, &src->hashbuckets, _state, make_automatic);
29757 0 : _amdnset_init_copy(&dst->nonemptybuckets, &src->nonemptybuckets, _state, make_automatic);
29758 0 : ae_vector_init_copy(&dst->sncandidates, &src->sncandidates, _state, make_automatic);
29759 0 : ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic);
29760 0 : ae_vector_init_copy(&dst->arrwe, &src->arrwe, _state, make_automatic);
29761 0 : ae_matrix_init_copy(&dst->dbga, &src->dbga, _state, make_automatic);
29762 0 : }
29763 :
29764 :
29765 0 : void _amdbuffer_clear(void* _p)
29766 : {
29767 0 : amdbuffer *p = (amdbuffer*)_p;
29768 0 : ae_touch_ptr((void*)p);
29769 0 : ae_vector_clear(&p->iseliminated);
29770 0 : ae_vector_clear(&p->issupernode);
29771 0 : _amdknset_clear(&p->setsuper);
29772 0 : _amdknset_clear(&p->seta);
29773 0 : _amdknset_clear(&p->sete);
29774 0 : _amdllmatrix_clear(&p->mtxl);
29775 0 : _amdvertexset_clear(&p->vertexdegrees);
29776 0 : ae_vector_clear(&p->perm);
29777 0 : ae_vector_clear(&p->invperm);
29778 0 : ae_vector_clear(&p->columnswaps);
29779 0 : _amdnset_clear(&p->lp);
29780 0 : _amdnset_clear(&p->plp);
29781 0 : _amdnset_clear(&p->ep);
29782 0 : _amdnset_clear(&p->adji);
29783 0 : _amdnset_clear(&p->adjj);
29784 0 : ae_vector_clear(&p->ls);
29785 0 : _amdnset_clear(&p->exactdegreetmp0);
29786 0 : _amdknset_clear(&p->hashbuckets);
29787 0 : _amdnset_clear(&p->nonemptybuckets);
29788 0 : ae_vector_clear(&p->sncandidates);
29789 0 : ae_vector_clear(&p->tmp0);
29790 0 : ae_vector_clear(&p->arrwe);
29791 0 : ae_matrix_clear(&p->dbga);
29792 0 : }
29793 :
29794 :
29795 0 : void _amdbuffer_destroy(void* _p)
29796 : {
29797 0 : amdbuffer *p = (amdbuffer*)_p;
29798 0 : ae_touch_ptr((void*)p);
29799 0 : ae_vector_destroy(&p->iseliminated);
29800 0 : ae_vector_destroy(&p->issupernode);
29801 0 : _amdknset_destroy(&p->setsuper);
29802 0 : _amdknset_destroy(&p->seta);
29803 0 : _amdknset_destroy(&p->sete);
29804 0 : _amdllmatrix_destroy(&p->mtxl);
29805 0 : _amdvertexset_destroy(&p->vertexdegrees);
29806 0 : ae_vector_destroy(&p->perm);
29807 0 : ae_vector_destroy(&p->invperm);
29808 0 : ae_vector_destroy(&p->columnswaps);
29809 0 : _amdnset_destroy(&p->lp);
29810 0 : _amdnset_destroy(&p->plp);
29811 0 : _amdnset_destroy(&p->ep);
29812 0 : _amdnset_destroy(&p->adji);
29813 0 : _amdnset_destroy(&p->adjj);
29814 0 : ae_vector_destroy(&p->ls);
29815 0 : _amdnset_destroy(&p->exactdegreetmp0);
29816 0 : _amdknset_destroy(&p->hashbuckets);
29817 0 : _amdnset_destroy(&p->nonemptybuckets);
29818 0 : ae_vector_destroy(&p->sncandidates);
29819 0 : ae_vector_destroy(&p->tmp0);
29820 0 : ae_vector_destroy(&p->arrwe);
29821 0 : ae_matrix_destroy(&p->dbga);
29822 0 : }
29823 :
29824 :
29825 : #endif
29826 : #if defined(AE_COMPILE_SPCHOL) || !defined(AE_PARTIAL_BUILD)
29827 :
29828 :
29829 : /*************************************************************************
29830 : Informational function, useful for debugging
29831 : *************************************************************************/
29832 0 : ae_int_t spsymmgetmaxfastkernel(ae_state *_state)
29833 : {
29834 : ae_int_t result;
29835 :
29836 :
29837 0 : result = spchol_maxfastkernel;
29838 0 : return result;
29839 : }
29840 :
29841 :
29842 : /*************************************************************************
29843 : Symbolic phase of Cholesky decomposition.
29844 :
29845 : Performs preliminary analysis of Cholesky/LDLT factorization. The latter
29846 : is computed with strictly diagonal D (no Bunch-Kauffman pivoting).
29847 :
29848 : The analysis object produced by this function will be used later to guide
29849 : actual decomposition.
29850 :
29851 : Depending on settings specified during factorization, may produce vanilla
29852 : Cholesky or L*D*LT decomposition (with strictly diagonal D), without
29853 : permutation or with permutation P (being either topological ordering or
29854 : sparsity preserving ordering).
29855 :
29856 : Thus, A is represented as either L*LT or L*D*LT or P*L*LT*PT or P*L*D*LT*PT.
29857 :
29858 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
29859 : matrices. However, numerical stability is guaranteed ONLY for a class
29860 : of quasi-definite matrices.
29861 :
29862 : INPUT PARAMETERS:
29863 : A - sparse square matrix in CRS format, with LOWER triangle
29864 : being used to store the matrix.
29865 : FactType - factorization type:
29866 : * 0 for traditional Cholesky
29867 : * 1 for LDLT decomposition with strictly diagonal D
29868 : PermType - permutation type:
29869 : *-2 for column count ordering (NOT RECOMMENDED!)
29870 : *-1 for absence of permutation
29871 : * 0 for best permutation available
29872 : * 1 for supernodal ordering (improves locality and
29873 : performance, but does NOT change fill-in pattern)
29874 : * 2 for supernodal AMD ordering (improves fill-in)
29875 : Analysis - can be uninitialized instance, or previous analysis
29876 : results. Previously allocated memory is reused as much
29877 : as possible.
29878 : Buf - buffer; may be completely uninitialized, or one remained
29879 : from previous calls (including ones with completely
29880 : different matrices). Previously allocated temporary
29881 : space will be reused as much as possible.
29882 :
29883 : OUTPUT PARAMETERS:
29884 : Analysis - symbolic analysis of the matrix structure which will
29885 : be used later to guide numerical factorization. The
29886 : numerical values are stored internally in the structure,
29887 : but you have to run factorization phase explicitly
29888 : with SPSymmAnalyze(). You can also reload another
29889 : matrix with same sparsity pattern with SPSymmReload().
29890 :
29891 : This function fails if and only if the matrix A is symbolically degenerate
29892 : i.e. has diagonal element which is exactly zero. In such case False is
29893 : returned.
29894 :
29895 : NOTE: defining 'SCHOLESKY' trace tag will activate tracing
29896 :
29897 : NOTE: defining 'DEBUG.SLOW' trace tag will activate extra-slow (roughly
29898 : N^3 ops) integrity checks, in addition to cheap O(1) ones.
29899 :
29900 : -- ALGLIB routine --
29901 : 20.09.2020
29902 : Bochkanov Sergey
29903 : *************************************************************************/
29904 0 : ae_bool spsymmanalyze(sparsematrix* a,
29905 : ae_int_t facttype,
29906 : ae_int_t permtype,
29907 : spcholanalysis* analysis,
29908 : ae_state *_state)
29909 : {
29910 : ae_int_t n;
29911 : ae_int_t i;
29912 : ae_bool permready;
29913 : ae_bool result;
29914 :
29915 :
29916 0 : ae_assert(sparseiscrs(a, _state), "SPSymmAnalyze: A is not stored in CRS format", _state);
29917 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SPSymmAnalyze: non-square A", _state);
29918 0 : ae_assert(facttype==0||facttype==1, "SPSymmAnalyze: unexpected FactType", _state);
29919 0 : ae_assert((((permtype==0||permtype==1)||permtype==2)||permtype==-1)||permtype==-2, "SPSymmAnalyze: unexpected PermType", _state);
29920 0 : if( permtype==0 )
29921 : {
29922 0 : permtype = 2;
29923 : }
29924 0 : result = ae_true;
29925 0 : n = sparsegetnrows(a, _state);
29926 0 : analysis->tasktype = 0;
29927 0 : analysis->n = n;
29928 0 : analysis->unitd = facttype==0;
29929 0 : analysis->permtype = permtype;
29930 0 : analysis->extendeddebug = ae_is_trace_enabled("DEBUG.SLOW");
29931 0 : analysis->dotrace = ae_is_trace_enabled("SCHOLESKY");
29932 0 : analysis->istopologicalordering = permtype==-1||permtype==1;
29933 0 : analysis->applypermutationtooutput = permtype==-1;
29934 0 : analysis->modtype = 0;
29935 0 : analysis->modparam0 = 0.0;
29936 0 : analysis->modparam1 = 0.0;
29937 0 : analysis->modparam2 = 0.0;
29938 0 : analysis->modparam3 = 0.0;
29939 :
29940 : /*
29941 : * Initial trace message
29942 : */
29943 0 : if( analysis->dotrace )
29944 : {
29945 0 : ae_trace("\n\n");
29946 0 : ae_trace("////////////////////////////////////////////////////////////////////////////////////////////////////\n");
29947 0 : ae_trace("// SPARSE CHOLESKY ANALYSIS STARTED //\n");
29948 0 : ae_trace("////////////////////////////////////////////////////////////////////////////////////////////////////\n");
29949 : }
29950 :
29951 : /*
29952 : * Initial integrity check - diagonal MUST be symbolically nonzero
29953 : */
29954 0 : for(i=0; i<=n-1; i++)
29955 : {
29956 0 : if( a->didx.ptr.p_int[i]==a->uidx.ptr.p_int[i] )
29957 : {
29958 0 : if( analysis->dotrace )
29959 : {
29960 0 : ae_trace("> the matrix diagonal is symbolically zero, stopping");
29961 : }
29962 0 : result = ae_false;
29963 0 : return result;
29964 : }
29965 : }
29966 :
29967 : /*
29968 : * Allocate temporaries
29969 : */
29970 0 : ivectorsetlengthatleast(&analysis->tmp0, n+1, _state);
29971 0 : ivectorsetlengthatleast(&analysis->tmp1, n+1, _state);
29972 0 : ivectorsetlengthatleast(&analysis->tmp2, n+1, _state);
29973 0 : ivectorsetlengthatleast(&analysis->tmp3, n+1, _state);
29974 0 : ivectorsetlengthatleast(&analysis->tmp4, n+1, _state);
29975 0 : bvectorsetlengthatleast(&analysis->flagarray, n+1, _state);
29976 :
29977 : /*
29978 : * What type of permutation do we have?
29979 : */
29980 0 : if( analysis->istopologicalordering )
29981 : {
29982 0 : ae_assert(permtype==-1||permtype==1, "SPSymmAnalyze: integrity check failed (ihebd)", _state);
29983 :
29984 : /*
29985 : * Build topologically ordered elimination tree
29986 : */
29987 0 : spchol_buildetree(a, n, &analysis->tmpparent, &analysis->superperm, &analysis->invsuperperm, &analysis->tmp0, &analysis->tmp1, &analysis->tmp2, &analysis->flagarray, _state);
29988 0 : ivectorsetlengthatleast(&analysis->fillinperm, n, _state);
29989 0 : ivectorsetlengthatleast(&analysis->invfillinperm, n, _state);
29990 0 : ivectorsetlengthatleast(&analysis->effectiveperm, n, _state);
29991 0 : ivectorsetlengthatleast(&analysis->inveffectiveperm, n, _state);
29992 0 : for(i=0; i<=n-1; i++)
29993 : {
29994 0 : analysis->fillinperm.ptr.p_int[i] = i;
29995 0 : analysis->invfillinperm.ptr.p_int[i] = i;
29996 0 : analysis->effectiveperm.ptr.p_int[i] = analysis->superperm.ptr.p_int[i];
29997 0 : analysis->inveffectiveperm.ptr.p_int[i] = analysis->invsuperperm.ptr.p_int[i];
29998 : }
29999 :
30000 : /*
30001 : * Reorder input matrix
30002 : */
30003 0 : spchol_topologicalpermutation(a, &analysis->superperm, &analysis->wrkat, _state);
30004 :
30005 : /*
30006 : * Analyze etree, build supernodal structure
30007 : */
30008 0 : spchol_createsupernodalstructure(&analysis->wrkat, &analysis->tmpparent, n, analysis, &analysis->node2supernode, &analysis->tmp0, &analysis->tmp1, &analysis->tmp2, &analysis->tmp3, &analysis->tmp4, &analysis->flagarray, _state);
30009 :
30010 : /*
30011 : * Having fully initialized supernodal structure, analyze dependencies
30012 : */
30013 0 : spchol_analyzesupernodaldependencies(analysis, a, &analysis->node2supernode, n, &analysis->tmp0, &analysis->tmp1, &analysis->flagarray, _state);
30014 : }
30015 : else
30016 : {
30017 :
30018 : /*
30019 : * Generate fill-in reducing permutation
30020 : */
30021 0 : permready = ae_false;
30022 0 : if( permtype==-2 )
30023 : {
30024 0 : spchol_generatedbgpermutation(a, n, &analysis->fillinperm, &analysis->invfillinperm, _state);
30025 0 : permready = ae_true;
30026 : }
30027 0 : if( permtype==2 )
30028 : {
30029 0 : generateamdpermutation(a, n, &analysis->fillinperm, &analysis->invfillinperm, &analysis->amdtmp, _state);
30030 0 : permready = ae_true;
30031 : }
30032 0 : ae_assert(permready, "SPSymmAnalyze: integrity check failed (pp4td)", _state);
30033 :
30034 : /*
30035 : * Apply permutation to the matrix, perform analysis on the initially reordered matrix
30036 : * (we may need one more reordering, now topological one, due to supernodal analysis).
30037 : * Build topologically ordered elimination tree
30038 : */
30039 0 : sparsesymmpermtblbuf(a, ae_false, &analysis->fillinperm, &analysis->tmpa, _state);
30040 0 : spchol_buildetree(&analysis->tmpa, n, &analysis->tmpparent, &analysis->superperm, &analysis->invsuperperm, &analysis->tmp0, &analysis->tmp1, &analysis->tmp2, &analysis->flagarray, _state);
30041 0 : ivectorsetlengthatleast(&analysis->effectiveperm, n, _state);
30042 0 : ivectorsetlengthatleast(&analysis->inveffectiveperm, n, _state);
30043 0 : for(i=0; i<=n-1; i++)
30044 : {
30045 0 : analysis->effectiveperm.ptr.p_int[i] = analysis->superperm.ptr.p_int[analysis->fillinperm.ptr.p_int[i]];
30046 0 : analysis->inveffectiveperm.ptr.p_int[analysis->effectiveperm.ptr.p_int[i]] = i;
30047 : }
30048 :
30049 : /*
30050 : * Reorder input matrix
30051 : */
30052 0 : spchol_topologicalpermutation(&analysis->tmpa, &analysis->superperm, &analysis->wrkat, _state);
30053 :
30054 : /*
30055 : * Analyze etree, build supernodal structure
30056 : */
30057 0 : spchol_createsupernodalstructure(&analysis->wrkat, &analysis->tmpparent, n, analysis, &analysis->node2supernode, &analysis->tmp0, &analysis->tmp1, &analysis->tmp2, &analysis->tmp3, &analysis->tmp4, &analysis->flagarray, _state);
30058 :
30059 : /*
30060 : * Having fully initialized supernodal structure, analyze dependencies
30061 : */
30062 0 : spchol_analyzesupernodaldependencies(analysis, &analysis->tmpa, &analysis->node2supernode, n, &analysis->tmp0, &analysis->tmp1, &analysis->flagarray, _state);
30063 : }
30064 0 : return result;
30065 : }
30066 :
30067 :
30068 : /*************************************************************************
30069 : Sets modified Cholesky type
30070 :
30071 : INPUT PARAMETERS:
30072 : Analysis - symbolic analysis of the matrix structure
30073 : ModStrategy - modification type:
30074 : * 0 for traditional Cholesky/LDLT (Cholesky fails when
30075 : encounters nonpositive pivot, LDLT fails when zero
30076 : pivot is encountered, no stability checks for
30077 : overflows/underflows)
30078 : * 1 for modified Cholesky with additional checks:
30079 : * pivots less than ModParam0 are increased; (similar
30080 : procedure with proper generalization is applied to
30081 : LDLT)
30082 : * if, at some moment, sum of absolute values of
30083 : elements in column J will become greater than
30084 : ModParam1, Cholesky/LDLT will treat it as failure
30085 : and will stop immediately
30086 : * if ModParam0 is zero, no pivot modification is applied
30087 : * if ModParam1 is zero, no overflow check is performed
30088 : P0, P1, P2,P3 - modification parameters #0 #1, #2 and #3.
30089 : Params #2 and #3 are ignored in current version.
30090 :
30091 : OUTPUT PARAMETERS:
30092 : Analysis - symbolic analysis of the matrix structure, new strategy
30093 : (results will be seen with next SPSymmFactorize() call)
30094 :
30095 : -- ALGLIB routine --
30096 : 20.09.2020
30097 : Bochkanov Sergey
30098 : *************************************************************************/
30099 0 : void spsymmsetmodificationstrategy(spcholanalysis* analysis,
30100 : ae_int_t modstrategy,
30101 : double p0,
30102 : double p1,
30103 : double p2,
30104 : double p3,
30105 : ae_state *_state)
30106 : {
30107 :
30108 :
30109 0 : ae_assert(modstrategy==0||modstrategy==1, "SPSymmSetModificationStrategy: unexpected ModStrategy", _state);
30110 0 : ae_assert(ae_isfinite(p0, _state)&&ae_fp_greater_eq(p0,(double)(0)), "SPSymmSetModificationStrategy: bad P0", _state);
30111 0 : ae_assert(ae_isfinite(p1, _state), "SPSymmSetModificationStrategy: bad P1", _state);
30112 0 : ae_assert(ae_isfinite(p2, _state), "SPSymmSetModificationStrategy: bad P2", _state);
30113 0 : ae_assert(ae_isfinite(p3, _state), "SPSymmSetModificationStrategy: bad P3", _state);
30114 0 : analysis->modtype = modstrategy;
30115 0 : analysis->modparam0 = p0;
30116 0 : analysis->modparam1 = p1;
30117 0 : analysis->modparam2 = p2;
30118 0 : analysis->modparam3 = p3;
30119 0 : }
30120 :
30121 :
30122 : /*************************************************************************
30123 : Updates symmetric matrix internally stored in previously initialized
30124 : Analysis object.
30125 :
30126 : You can use this function to perform multiple factorizations with same
30127 : sparsity patterns: perform symbolic analysis once with SPSymmAnalyze(),
30128 : then update internal matrix with SPSymmReload() and call SPSymmFactorize().
30129 :
30130 : INPUT PARAMETERS:
30131 : Analysis - symbolic analysis of the matrix structure
30132 : A - sparse square matrix in CRS format with LOWER triangle
30133 : being used to store the matrix. The matrix MUST have
30134 : sparsity pattern exactly same as one used to
30135 : initialize the Analysis object.
30136 : The algorithm will fail in an unpredictable way if
30137 : something different was passed.
30138 :
30139 : OUTPUT PARAMETERS:
30140 : Analysis - symbolic analysis of the matrix structure which will
30141 : be used later to guide numerical factorization. The
30142 : numerical values are stored internally in the structure,
30143 : but you have to run factorization phase explicitly
30144 : with SPSymmAnalyze(). You can also reload another
30145 : matrix with same sparsity pattern with SPSymmReload().
30146 :
30147 : -- ALGLIB routine --
30148 : 20.09.2020
30149 : Bochkanov Sergey
30150 : *************************************************************************/
30151 0 : void spsymmreload(spcholanalysis* analysis,
30152 : sparsematrix* a,
30153 : ae_state *_state)
30154 : {
30155 :
30156 :
30157 0 : ae_assert(sparseiscrs(a, _state), "SPSymmReload: A is not stored in CRS format", _state);
30158 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SPSymmReload: non-square A", _state);
30159 0 : if( analysis->istopologicalordering )
30160 : {
30161 :
30162 : /*
30163 : * Topological (fill-in preserving) ordering is used, we can copy
30164 : * A directly into WrkAT using joint permute+transpose
30165 : */
30166 0 : spchol_topologicalpermutation(a, &analysis->effectiveperm, &analysis->wrkat, _state);
30167 : }
30168 : else
30169 : {
30170 :
30171 : /*
30172 : * Non-topological permutation; first we perform generic symmetric
30173 : * permutation, then transpose result
30174 : */
30175 0 : sparsesymmpermtblbuf(a, ae_false, &analysis->effectiveperm, &analysis->tmpa, _state);
30176 0 : sparsecopytransposecrsbuf(&analysis->tmpa, &analysis->wrkat, _state);
30177 : }
30178 0 : }
30179 :
30180 :
30181 : /*************************************************************************
30182 : Sparse Cholesky factorization of SPD matrix stored in CRS format, using
30183 : precomputed analysis of sparsity pattern stored in Analysis object and
30184 : the matrix that is presently loaded into A.
30185 :
30186 : Depending on settings specified during factorization, may produce vanilla
30187 : Cholesky or L*D*LT decomposition (with strictly diagonal D), without
30188 : permutation or with permutation P (being either topological ordering or
30189 : sparsity preserving ordering).
30190 :
30191 : Thus, A is represented as either L*LT or L*D*LT or P*L*LT*PT or P*L*D*LT*PT.
30192 :
30193 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
30194 : matrices. However, numerical stability is guaranteed ONLY for a class
30195 : of quasi-definite matrices.
30196 :
30197 : INPUT PARAMETERS:
30198 : Analysis - prior analysis performed on some sparse matrix, with
30199 : matrix being stored in Analysis. This matrix is
30200 : destroyed during factorization.
30201 : D, P - possibly preallocated buffers
30202 :
30203 : OUTPUT PARAMETERS:
30204 : A - Cholesky decomposition of A stored in CRS format
30205 : in LOWER triangle.
30206 : D - array[N], diagonal factor. If no diagonal factor was
30207 : required during analysis phase, still returned but
30208 : filled with units.
30209 : P - array[N], pivots. Permutation matrix P is a product of
30210 : P(0)*P(1)*...*P(N-1), where P(i) is a permutation of
30211 : row/col I and P[I] (with P[I]>=I).
30212 : If no permutation was requested during analysis phase,
30213 : still returned but filled with unit elements.
30214 :
30215 : The function returns True when factorization resulted in nondegenerate
30216 : matrix. False is returned when factorization fails (Cholesky factorization
30217 : of indefinite matrix) or LDLT factorization has exactly zero elements at
30218 : the diagonal.
30219 :
30220 : In the latter case contents of A, D and P is undefined.
30221 :
30222 : -- ALGLIB routine --
30223 : 20.09.2020
30224 : Bochkanov Sergey
30225 : *************************************************************************/
30226 0 : ae_bool spsymmfactorize(spcholanalysis* analysis,
30227 : sparsematrix* a,
30228 : /* Real */ ae_vector* d,
30229 : /* Integer */ ae_vector* p,
30230 : ae_state *_state)
30231 : {
30232 : ae_int_t i;
30233 : ae_int_t j;
30234 : ae_int_t k;
30235 : ae_int_t ii;
30236 : ae_int_t i0;
30237 : ae_int_t i1;
30238 : ae_int_t n;
30239 : ae_int_t cols0;
30240 : ae_int_t cols1;
30241 : ae_int_t offss;
30242 : ae_int_t sstride;
30243 : ae_int_t blocksize;
30244 : ae_int_t sidx;
30245 : ae_int_t uidx;
30246 : ae_bool result;
30247 :
30248 :
30249 0 : ae_assert(analysis->tasktype==0, "SPCholFactorize: Analysis type does not match current task", _state);
30250 0 : result = ae_true;
30251 0 : n = analysis->n;
30252 :
30253 : /*
30254 : * Prepare structures:
30255 : * * WrkRows[] store pointers to beginnings of the offdiagonal supernode row ranges;
30256 : * at the beginning of the work WrkRows[]=0, but as we advance from the column
30257 : * range [0,A) to [A,B), to [B,C) and so on, we advance WrkRows[] in order to
30258 : * quickly skip parts that are less than A, less than B, less than C and so on.
30259 : */
30260 0 : ivectorsetlengthatleast(&analysis->raw2smap, n, _state);
30261 0 : ivectorsetlengthatleast(&analysis->tmp0, n+1, _state);
30262 0 : bsetallocv(n, ae_false, &analysis->flagarray, _state);
30263 0 : isetallocv(analysis->nsuper, 0, &analysis->wrkrows, _state);
30264 0 : rsetallocv(n, 0.0, &analysis->diagd, _state);
30265 0 : rsetallocv(analysis->rowoffsets.ptr.p_int[analysis->nsuper], 0.0, &analysis->rowstorage, _state);
30266 :
30267 : /*
30268 : * Now we can run actual supernodal Cholesky
30269 : */
30270 0 : for(sidx=0; sidx<=analysis->nsuper-1; sidx++)
30271 : {
30272 0 : cols0 = analysis->supercolrange.ptr.p_int[sidx];
30273 0 : cols1 = analysis->supercolrange.ptr.p_int[sidx+1];
30274 0 : blocksize = cols1-cols0;
30275 0 : offss = analysis->rowoffsets.ptr.p_int[sidx];
30276 0 : sstride = analysis->rowstrides.ptr.p_int[sidx];
30277 :
30278 : /*
30279 : * Prepare mapping of raw (range 0...N-1) indexes into internal (range 0...BlockSize+OffdiagSize-1) ones
30280 : */
30281 0 : if( analysis->extendeddebug )
30282 : {
30283 0 : isetv(n, -1, &analysis->raw2smap, _state);
30284 : }
30285 0 : for(i=cols0; i<=cols1-1; i++)
30286 : {
30287 0 : analysis->raw2smap.ptr.p_int[i] = i-cols0;
30288 : }
30289 0 : for(k=analysis->superrowridx.ptr.p_int[sidx]; k<=analysis->superrowridx.ptr.p_int[sidx+1]-1; k++)
30290 : {
30291 0 : analysis->raw2smap.ptr.p_int[analysis->superrowidx.ptr.p_int[k]] = blocksize+(k-analysis->superrowridx.ptr.p_int[sidx]);
30292 : }
30293 :
30294 : /*
30295 : * Load supernode #SIdx using Raw2SMap to perform quick transformation between global and local indexing.
30296 : */
30297 0 : for(j=cols0; j<=cols1-1; j++)
30298 : {
30299 0 : i0 = analysis->wrkat.ridx.ptr.p_int[j];
30300 0 : i1 = analysis->wrkat.ridx.ptr.p_int[j+1]-1;
30301 0 : for(ii=i0; ii<=i1; ii++)
30302 : {
30303 0 : analysis->rowstorage.ptr.p_double[offss+analysis->raw2smap.ptr.p_int[analysis->wrkat.idx.ptr.p_int[ii]]*sstride+(j-cols0)] = analysis->wrkat.vals.ptr.p_double[ii];
30304 : }
30305 : }
30306 :
30307 : /*
30308 : * Update current supernode with nonzeros from the current row
30309 : */
30310 0 : for(ii=analysis->ladjplusr.ptr.p_int[sidx]; ii<=analysis->ladjplusr.ptr.p_int[sidx+1]-1; ii++)
30311 : {
30312 0 : uidx = analysis->ladjplus.ptr.p_int[ii];
30313 0 : analysis->wrkrows.ptr.p_int[uidx] = spchol_updatesupernode(analysis, sidx, cols0, cols1, offss, &analysis->raw2smap, uidx, analysis->wrkrows.ptr.p_int[uidx], &analysis->diagd, analysis->supercolrange.ptr.p_int[uidx], _state);
30314 : }
30315 :
30316 : /*
30317 : * Factorize current supernode
30318 : */
30319 0 : if( !spchol_factorizesupernode(analysis, sidx, _state) )
30320 : {
30321 0 : result = ae_false;
30322 0 : return result;
30323 : }
30324 : }
30325 :
30326 : /*
30327 : * Convert from supernodal storage to SparseMatrix format
30328 : */
30329 0 : spchol_extractmatrix(analysis, &analysis->rowoffsets, &analysis->rowstrides, &analysis->rowstorage, &analysis->diagd, n, a, d, p, &analysis->tmp0, _state);
30330 0 : return result;
30331 : }
30332 :
30333 :
30334 : /*************************************************************************
30335 : This function generates test reodering used for debug purposes only
30336 :
30337 : INPUT PARAMETERS
30338 : A - lower triangular sparse matrix in CRS format
30339 : N - problem size
30340 :
30341 : OUTPUT PARAMETERS
30342 : Perm - array[N], maps original indexes I to permuted indexes
30343 : InvPerm - array[N], maps permuted indexes I to original indexes
30344 :
30345 : -- ALGLIB PROJECT --
30346 : Copyright 05.10.2020 by Bochkanov Sergey.
30347 : *************************************************************************/
30348 0 : static void spchol_generatedbgpermutation(sparsematrix* a,
30349 : ae_int_t n,
30350 : /* Integer */ ae_vector* perm,
30351 : /* Integer */ ae_vector* invperm,
30352 : ae_state *_state)
30353 : {
30354 : ae_int_t i;
30355 :
30356 :
30357 0 : ivectorsetlengthatleast(perm, n, _state);
30358 0 : ivectorsetlengthatleast(invperm, n, _state);
30359 0 : for(i=0; i<=n-1; i++)
30360 : {
30361 0 : perm->ptr.p_int[i] = n-1-i;
30362 0 : invperm->ptr.p_int[i] = n-1-i;
30363 : }
30364 0 : }
30365 :
30366 :
30367 : /*************************************************************************
30368 : This function builds elimination tree and reorders it according to the
30369 : topological post-ordering.
30370 :
30371 : INPUT PARAMETERS
30372 : A - lower triangular sparse matrix in CRS format
30373 : N - problem size
30374 :
30375 : tRawParentOfRawNode,
30376 : tRawParentOfReorderedNode,
30377 : tTmp,
30378 : tFlagArray - preallocated temporary arrays, length at least N+1, no
30379 : meaningful output is provided in these variables
30380 :
30381 : OUTPUT PARAMETERS
30382 : Parent - array[N], Parent[I] contains index of parent of I-th
30383 : column (after topological reordering). -1 is used to
30384 : denote column with no parents.
30385 : SupernodalPermutation
30386 : - array[N], maps original indexes I to permuted indexes
30387 : InvSupernodalPermutation
30388 : - array[N], maps permuted indexes I to original indexes
30389 :
30390 : -- ALGLIB PROJECT --
30391 : Copyright 05.10.2020 by Bochkanov Sergey.
30392 : *************************************************************************/
30393 0 : static void spchol_buildetree(sparsematrix* a,
30394 : ae_int_t n,
30395 : /* Integer */ ae_vector* parent,
30396 : /* Integer */ ae_vector* supernodalpermutation,
30397 : /* Integer */ ae_vector* invsupernodalpermutation,
30398 : /* Integer */ ae_vector* trawparentofrawnode,
30399 : /* Integer */ ae_vector* trawparentofreorderednode,
30400 : /* Integer */ ae_vector* ttmp,
30401 : /* Boolean */ ae_vector* tflagarray,
30402 : ae_state *_state)
30403 : {
30404 : ae_int_t i;
30405 : ae_int_t j;
30406 : ae_int_t k;
30407 : ae_int_t sidx;
30408 : ae_int_t parentk;
30409 : ae_int_t unprocessedchildrencnt;
30410 : ae_int_t j0;
30411 : ae_int_t j1;
30412 : ae_int_t jj;
30413 :
30414 :
30415 0 : ae_assert(trawparentofrawnode->cnt>=n+1, "BuildETree: input buffer tRawParentOfRawNode is too short", _state);
30416 0 : ae_assert(ttmp->cnt>=n+1, "BuildETree: input buffer tTmp is too short", _state);
30417 0 : ae_assert(trawparentofreorderednode->cnt>=n+1, "BuildETree: input buffer tRawParentOfReorderedNode is too short", _state);
30418 0 : ae_assert(tflagarray->cnt>=n+1, "BuildETree: input buffer tFlagArray is too short", _state);
30419 :
30420 : /*
30421 : * Avoid spurious compiler warnings
30422 : */
30423 0 : unprocessedchildrencnt = 0;
30424 :
30425 : /*
30426 : * Build elimination tree with original column order using path compression:
30427 : * tTmp[] array stores indexes of some ancestor of the vertex.
30428 : */
30429 0 : for(i=0; i<=n-1; i++)
30430 : {
30431 0 : trawparentofrawnode->ptr.p_int[i] = -1;
30432 0 : ttmp->ptr.p_int[i] = i;
30433 0 : j0 = a->ridx.ptr.p_int[i];
30434 0 : j1 = a->didx.ptr.p_int[i]-1;
30435 0 : for(jj=j0; jj<=j1; jj++)
30436 : {
30437 0 : j = a->idx.ptr.p_int[jj];
30438 0 : k = ttmp->ptr.p_int[j];
30439 0 : ttmp->ptr.p_int[j] = i;
30440 0 : parentk = trawparentofrawnode->ptr.p_int[k];
30441 0 : while(parentk>=0)
30442 : {
30443 0 : ttmp->ptr.p_int[k] = i;
30444 0 : k = parentk;
30445 0 : parentk = trawparentofrawnode->ptr.p_int[k];
30446 : }
30447 0 : if( k!=i )
30448 : {
30449 0 : trawparentofrawnode->ptr.p_int[k] = i;
30450 : }
30451 : }
30452 : }
30453 :
30454 : /*
30455 : * Compute topological ordering of the elimination tree, produce:
30456 : * * direct and inverse permutations
30457 : * * reordered etree stored in Parent[]
30458 : */
30459 0 : isetallocv(n, -1, invsupernodalpermutation, _state);
30460 0 : isetallocv(n, -1, supernodalpermutation, _state);
30461 0 : isetallocv(n, -1, parent, _state);
30462 0 : isetv(n, -1, trawparentofreorderednode, _state);
30463 0 : isetv(n, 0, ttmp, _state);
30464 0 : for(i=0; i<=n-1; i++)
30465 : {
30466 0 : k = trawparentofrawnode->ptr.p_int[i];
30467 0 : if( k>=0 )
30468 : {
30469 0 : ttmp->ptr.p_int[k] = ttmp->ptr.p_int[k]+1;
30470 : }
30471 : }
30472 0 : bsetv(n, ae_true, tflagarray, _state);
30473 0 : sidx = 0;
30474 0 : for(i=0; i<=n-1; i++)
30475 : {
30476 0 : if( tflagarray->ptr.p_bool[i] )
30477 : {
30478 :
30479 : /*
30480 : * Move column I to position SIdx, decrease unprocessed children count
30481 : */
30482 0 : supernodalpermutation->ptr.p_int[i] = sidx;
30483 0 : invsupernodalpermutation->ptr.p_int[sidx] = i;
30484 0 : tflagarray->ptr.p_bool[i] = ae_false;
30485 0 : k = trawparentofrawnode->ptr.p_int[i];
30486 0 : trawparentofreorderednode->ptr.p_int[sidx] = k;
30487 0 : if( k>=0 )
30488 : {
30489 0 : unprocessedchildrencnt = ttmp->ptr.p_int[k]-1;
30490 0 : ttmp->ptr.p_int[k] = unprocessedchildrencnt;
30491 : }
30492 0 : sidx = sidx+1;
30493 :
30494 : /*
30495 : * Add parents (as long as parent has no unprocessed children)
30496 : */
30497 0 : while(k>=0&&unprocessedchildrencnt==0)
30498 : {
30499 0 : supernodalpermutation->ptr.p_int[k] = sidx;
30500 0 : invsupernodalpermutation->ptr.p_int[sidx] = k;
30501 0 : tflagarray->ptr.p_bool[k] = ae_false;
30502 0 : k = trawparentofrawnode->ptr.p_int[k];
30503 0 : trawparentofreorderednode->ptr.p_int[sidx] = k;
30504 0 : if( k>=0 )
30505 : {
30506 0 : unprocessedchildrencnt = ttmp->ptr.p_int[k]-1;
30507 0 : ttmp->ptr.p_int[k] = unprocessedchildrencnt;
30508 : }
30509 0 : sidx = sidx+1;
30510 : }
30511 : }
30512 : }
30513 0 : for(i=0; i<=n-1; i++)
30514 : {
30515 0 : k = trawparentofreorderednode->ptr.p_int[i];
30516 0 : if( k>=0 )
30517 : {
30518 0 : parent->ptr.p_int[i] = supernodalpermutation->ptr.p_int[k];
30519 : }
30520 : }
30521 0 : }
30522 :
30523 :
30524 : /*************************************************************************
30525 : This function analyzes postordered elimination tree and creates supernodal
30526 : structure in Analysis object.
30527 :
30528 : INPUT PARAMETERS
30529 : AT - upper triangular CRS matrix, transpose and reordering
30530 : of the original input matrix A
30531 : Parent - array[N], supernodal etree
30532 : N - problem size
30533 :
30534 : tChildrenR,
30535 : tChildrenI,
30536 : tParentNodeOfSupernode,
30537 : tNode2Supernode,
30538 : tTmp0,
30539 : tFlagArray - temporary arrays, length at least N+1, simply provide
30540 : preallocated place.
30541 :
30542 : OUTPUT PARAMETERS
30543 : Analysis - following fields are initialized:
30544 : * Analysis.NSuper
30545 : * Analysis.SuperColRange
30546 : * Analysis.SuperRowRIdx
30547 : * Analysis.SuperRowIdx
30548 : * Analysis.ParentSupernode
30549 : * Analysis.OutRowCounts
30550 : other fields are ignored and not changed.
30551 : Node2Supernode- array[N] that maps node indexes to supernode indexes
30552 :
30553 : -- ALGLIB PROJECT --
30554 : Copyright 05.10.2020 by Bochkanov Sergey.
30555 : *************************************************************************/
30556 0 : static void spchol_createsupernodalstructure(sparsematrix* at,
30557 : /* Integer */ ae_vector* parent,
30558 : ae_int_t n,
30559 : spcholanalysis* analysis,
30560 : /* Integer */ ae_vector* node2supernode,
30561 : /* Integer */ ae_vector* tchildrenr,
30562 : /* Integer */ ae_vector* tchildreni,
30563 : /* Integer */ ae_vector* tparentnodeofsupernode,
30564 : /* Integer */ ae_vector* tfakenonzeros,
30565 : /* Integer */ ae_vector* ttmp0,
30566 : /* Boolean */ ae_vector* tflagarray,
30567 : ae_state *_state)
30568 : {
30569 : ae_int_t nsuper;
30570 : ae_int_t i;
30571 : ae_int_t j;
30572 : ae_int_t k;
30573 : ae_int_t sidx;
30574 : ae_int_t i0;
30575 : ae_int_t ii;
30576 : ae_int_t columnidx;
30577 : ae_int_t nodeidx;
30578 : ae_int_t rfirst;
30579 : ae_int_t rlast;
30580 : ae_int_t cols0;
30581 : ae_int_t cols1;
30582 : ae_int_t blocksize;
30583 : ae_bool createsupernode;
30584 : ae_int_t colcount;
30585 : ae_int_t offdiagcnt;
30586 : ae_int_t childcolcount;
30587 : ae_int_t childoffdiagcnt;
30588 : ae_int_t fakezerosinnewsupernode;
30589 : double mergeinefficiency;
30590 : ae_bool hastheonlychild;
30591 :
30592 :
30593 0 : ae_assert(ttmp0->cnt>=n+1, "CreateSupernodalStructure: input buffer tTmp0 is too short", _state);
30594 0 : ae_assert(tchildrenr->cnt>=n+1, "CreateSupernodalStructure: input buffer ChildrenR is too short", _state);
30595 0 : ae_assert(tchildreni->cnt>=n+1, "CreateSupernodalStructure: input buffer ChildrenI is too short", _state);
30596 0 : ae_assert(tparentnodeofsupernode->cnt>=n+1, "CreateSupernodalStructure: input buffer tParentNodeOfSupernode is too short", _state);
30597 0 : ae_assert(tfakenonzeros->cnt>=n+1, "CreateSupernodalStructure: input buffer tFakeNonzeros is too short", _state);
30598 0 : ae_assert(tflagarray->cnt>=n+1, "CreateSupernodalStructure: input buffer tFlagArray is too short", _state);
30599 :
30600 : /*
30601 : * Trace
30602 : */
30603 0 : if( analysis->dotrace )
30604 : {
30605 0 : ae_trace("=== GENERATING SUPERNODAL STRUCTURE ================================================================\n");
30606 : }
30607 :
30608 : /*
30609 : * Convert etree from per-column parent array to per-column children list
30610 : */
30611 0 : isetv(n, 0, ttmp0, _state);
30612 0 : for(i=0; i<=n-1; i++)
30613 : {
30614 0 : nodeidx = parent->ptr.p_int[i];
30615 0 : if( nodeidx>=0 )
30616 : {
30617 0 : ttmp0->ptr.p_int[nodeidx] = ttmp0->ptr.p_int[nodeidx]+1;
30618 : }
30619 : }
30620 0 : tchildrenr->ptr.p_int[0] = 0;
30621 0 : for(i=0; i<=n-1; i++)
30622 : {
30623 0 : tchildrenr->ptr.p_int[i+1] = tchildrenr->ptr.p_int[i]+ttmp0->ptr.p_int[i];
30624 : }
30625 0 : isetv(n, 0, ttmp0, _state);
30626 0 : for(i=0; i<=n-1; i++)
30627 : {
30628 0 : k = parent->ptr.p_int[i];
30629 0 : if( k>=0 )
30630 : {
30631 0 : tchildreni->ptr.p_int[tchildrenr->ptr.p_int[k]+ttmp0->ptr.p_int[k]] = i;
30632 0 : ttmp0->ptr.p_int[k] = ttmp0->ptr.p_int[k]+1;
30633 : }
30634 : }
30635 :
30636 : /*
30637 : * Analyze supernodal structure:
30638 : * * determine children count for each node
30639 : * * combine chains of children into supernodes
30640 : * * generate direct and inverse supernodal (topological) permutations
30641 : * * generate column structure of supernodes (after supernodal permutation)
30642 : */
30643 0 : isetallocv(n, -1, node2supernode, _state);
30644 0 : ivectorsetlengthatleast(&analysis->supercolrange, n+1, _state);
30645 0 : ivectorsetlengthatleast(&analysis->superrowridx, n+1, _state);
30646 0 : isetv(n, n+1, tparentnodeofsupernode, _state);
30647 0 : bsetv(n, ae_true, tflagarray, _state);
30648 0 : nsuper = 0;
30649 0 : analysis->supercolrange.ptr.p_int[0] = 0;
30650 0 : analysis->superrowridx.ptr.p_int[0] = 0;
30651 0 : while(analysis->supercolrange.ptr.p_int[nsuper]<n)
30652 : {
30653 0 : columnidx = analysis->supercolrange.ptr.p_int[nsuper];
30654 :
30655 : /*
30656 : * Compute nonzero pattern of the column, create temporary standalone node
30657 : * for possible supernodal merge. Newly created node has just one column
30658 : * and no fake nonzeros.
30659 : */
30660 0 : rfirst = analysis->superrowridx.ptr.p_int[nsuper];
30661 0 : rlast = spchol_computenonzeropattern(at, columnidx, n, &analysis->superrowridx, &analysis->superrowidx, nsuper, tchildrenr, tchildreni, node2supernode, tflagarray, ttmp0, _state);
30662 0 : analysis->supercolrange.ptr.p_int[nsuper+1] = columnidx+1;
30663 0 : analysis->superrowridx.ptr.p_int[nsuper+1] = rlast;
30664 0 : node2supernode->ptr.p_int[columnidx] = nsuper;
30665 0 : tparentnodeofsupernode->ptr.p_int[nsuper] = parent->ptr.p_int[columnidx];
30666 0 : tfakenonzeros->ptr.p_int[nsuper] = 0;
30667 0 : offdiagcnt = rlast-rfirst;
30668 0 : colcount = 1;
30669 0 : nsuper = nsuper+1;
30670 0 : if( analysis->dotrace )
30671 : {
30672 0 : ae_trace("> incoming column %0d\n",
30673 : (int)(columnidx));
30674 0 : ae_trace("offdiagnnz = %0d\n",
30675 0 : (int)(rlast-rfirst));
30676 0 : ae_trace("children = [ ");
30677 0 : for(i=tchildrenr->ptr.p_int[columnidx]; i<=tchildrenr->ptr.p_int[columnidx+1]-1; i++)
30678 : {
30679 0 : ae_trace("S%0d ",
30680 0 : (int)(node2supernode->ptr.p_int[tchildreni->ptr.p_int[i]]));
30681 : }
30682 0 : ae_trace("]\n");
30683 : }
30684 :
30685 : /*
30686 : * Decide whether to merge column with previous supernode or not
30687 : */
30688 0 : childcolcount = 0;
30689 0 : childoffdiagcnt = 0;
30690 0 : mergeinefficiency = 0.0;
30691 0 : fakezerosinnewsupernode = 0;
30692 0 : createsupernode = ae_false;
30693 0 : hastheonlychild = ae_false;
30694 0 : if( nsuper>=2&&tparentnodeofsupernode->ptr.p_int[nsuper-2]==columnidx )
30695 : {
30696 0 : childcolcount = analysis->supercolrange.ptr.p_int[nsuper-1]-analysis->supercolrange.ptr.p_int[nsuper-2];
30697 0 : childoffdiagcnt = analysis->superrowridx.ptr.p_int[nsuper-1]-analysis->superrowridx.ptr.p_int[nsuper-2];
30698 0 : hastheonlychild = tchildrenr->ptr.p_int[columnidx+1]-tchildrenr->ptr.p_int[columnidx]==1;
30699 0 : if( (hastheonlychild||spchol_relaxedsupernodes)&&colcount+childcolcount<=spchol_maxsupernode )
30700 : {
30701 0 : i = colcount+childcolcount;
30702 0 : k = i*(i+1)/2+offdiagcnt*i;
30703 0 : fakezerosinnewsupernode = tfakenonzeros->ptr.p_int[nsuper-2]+tfakenonzeros->ptr.p_int[nsuper-1]+(offdiagcnt-(childoffdiagcnt-1))*childcolcount;
30704 0 : mergeinefficiency = (double)fakezerosinnewsupernode/(double)k;
30705 0 : if( colcount+childcolcount==2&&fakezerosinnewsupernode<=spchol_smallfakestolerance )
30706 : {
30707 0 : createsupernode = ae_true;
30708 : }
30709 0 : if( ae_fp_less_eq(mergeinefficiency,spchol_maxmergeinefficiency) )
30710 : {
30711 0 : createsupernode = ae_true;
30712 : }
30713 : }
30714 : }
30715 :
30716 : /*
30717 : * Create supernode if needed
30718 : */
30719 0 : if( createsupernode )
30720 : {
30721 :
30722 : /*
30723 : * Create supernode from nodes NSuper-2 and NSuper-1.
30724 : * Because these nodes are in the child-parent relation, we can simply
30725 : * copy nonzero pattern from NSuper-1.
30726 : */
30727 0 : ae_assert(tparentnodeofsupernode->ptr.p_int[nsuper-2]==columnidx, "CreateSupernodalStructure: integrity check 9472 failed", _state);
30728 0 : i0 = analysis->superrowridx.ptr.p_int[nsuper-1];
30729 0 : ii = analysis->superrowridx.ptr.p_int[nsuper]-analysis->superrowridx.ptr.p_int[nsuper-1];
30730 0 : rfirst = analysis->superrowridx.ptr.p_int[nsuper-2];
30731 0 : rlast = rfirst+ii;
30732 0 : for(i=0; i<=ii-1; i++)
30733 : {
30734 0 : analysis->superrowidx.ptr.p_int[rfirst+i] = analysis->superrowidx.ptr.p_int[i0+i];
30735 : }
30736 0 : analysis->supercolrange.ptr.p_int[nsuper-1] = columnidx+1;
30737 0 : analysis->superrowridx.ptr.p_int[nsuper-1] = rlast;
30738 0 : node2supernode->ptr.p_int[columnidx] = nsuper-2;
30739 0 : tfakenonzeros->ptr.p_int[nsuper-2] = fakezerosinnewsupernode;
30740 0 : tparentnodeofsupernode->ptr.p_int[nsuper-2] = parent->ptr.p_int[columnidx];
30741 0 : nsuper = nsuper-1;
30742 :
30743 : /*
30744 : * Trace
30745 : */
30746 0 : if( analysis->dotrace )
30747 : {
30748 0 : ae_trace("> merged with supernode S%0d",
30749 0 : (int)(nsuper-1));
30750 0 : if( ae_fp_neq(mergeinefficiency,(double)(0)) )
30751 : {
30752 0 : ae_trace(" (%2.0f%% inefficiency)",
30753 : (double)(mergeinefficiency*100));
30754 : }
30755 0 : ae_trace("\n*\n");
30756 : }
30757 : }
30758 : else
30759 : {
30760 :
30761 : /*
30762 : * Trace
30763 : */
30764 0 : if( analysis->dotrace )
30765 : {
30766 0 : ae_trace("> standalone node S%0d created\n*\n",
30767 0 : (int)(nsuper-1));
30768 : }
30769 : }
30770 : }
30771 0 : analysis->nsuper = nsuper;
30772 0 : ae_assert(analysis->nsuper>=1, "SPSymmAnalyze: integrity check failed (95mgd)", _state);
30773 0 : ae_assert(analysis->supercolrange.ptr.p_int[0]==0, "SPCholFactorize: integrity check failed (f446s)", _state);
30774 0 : ae_assert(analysis->supercolrange.ptr.p_int[nsuper]==n, "SPSymmAnalyze: integrity check failed (04ut4)", _state);
30775 0 : isetallocv(nsuper, -1, &analysis->parentsupernode, _state);
30776 0 : for(sidx=0; sidx<=nsuper-1; sidx++)
30777 : {
30778 0 : nodeidx = tparentnodeofsupernode->ptr.p_int[sidx];
30779 0 : if( nodeidx>=0 )
30780 : {
30781 0 : nodeidx = node2supernode->ptr.p_int[nodeidx];
30782 0 : analysis->parentsupernode.ptr.p_int[sidx] = nodeidx;
30783 : }
30784 : }
30785 :
30786 : /*
30787 : * Allocate supernodal storage
30788 : */
30789 0 : ivectorsetlengthatleast(&analysis->rowoffsets, analysis->nsuper+1, _state);
30790 0 : ivectorsetlengthatleast(&analysis->rowstrides, analysis->nsuper, _state);
30791 0 : analysis->rowoffsets.ptr.p_int[0] = 0;
30792 0 : for(i=0; i<=analysis->nsuper-1; i++)
30793 : {
30794 0 : blocksize = analysis->supercolrange.ptr.p_int[i+1]-analysis->supercolrange.ptr.p_int[i];
30795 0 : analysis->rowstrides.ptr.p_int[i] = spchol_recommendedstridefor(blocksize, _state);
30796 0 : analysis->rowoffsets.ptr.p_int[i+1] = analysis->rowoffsets.ptr.p_int[i];
30797 0 : analysis->rowoffsets.ptr.p_int[i+1] = analysis->rowoffsets.ptr.p_int[i+1]+analysis->rowstrides.ptr.p_int[i]*blocksize;
30798 0 : analysis->rowoffsets.ptr.p_int[i+1] = analysis->rowoffsets.ptr.p_int[i+1]+analysis->rowstrides.ptr.p_int[i]*(analysis->superrowridx.ptr.p_int[i+1]-analysis->superrowridx.ptr.p_int[i]);
30799 0 : analysis->rowoffsets.ptr.p_int[i+1] = spchol_alignpositioninarray(analysis->rowoffsets.ptr.p_int[i+1], _state);
30800 : }
30801 :
30802 : /*
30803 : * Analyze output structure
30804 : */
30805 0 : isetallocv(n, 0, &analysis->outrowcounts, _state);
30806 0 : for(sidx=0; sidx<=nsuper-1; sidx++)
30807 : {
30808 0 : cols0 = analysis->supercolrange.ptr.p_int[sidx];
30809 0 : cols1 = analysis->supercolrange.ptr.p_int[sidx+1];
30810 0 : rfirst = analysis->superrowridx.ptr.p_int[sidx];
30811 0 : rlast = analysis->superrowridx.ptr.p_int[sidx+1];
30812 0 : blocksize = cols1-cols0;
30813 0 : for(j=cols0; j<=cols1-1; j++)
30814 : {
30815 0 : analysis->outrowcounts.ptr.p_int[j] = analysis->outrowcounts.ptr.p_int[j]+(j-cols0+1);
30816 : }
30817 0 : for(ii=rfirst; ii<=rlast-1; ii++)
30818 : {
30819 0 : i0 = analysis->superrowidx.ptr.p_int[ii];
30820 0 : analysis->outrowcounts.ptr.p_int[i0] = analysis->outrowcounts.ptr.p_int[i0]+blocksize;
30821 : }
30822 : }
30823 0 : }
30824 :
30825 :
30826 : /*************************************************************************
30827 : This function analyzes supernodal structure and precomputes dependency
30828 : matrix LAdj+
30829 :
30830 : INPUT PARAMETERS
30831 : Analysis - analysis object with completely initialized supernodal
30832 : structure
30833 : RawA - original (before reordering) input matrix
30834 : Node2Supernode- mapping from node to supernode indexes
30835 : N - problem size
30836 :
30837 : tTmp0,
30838 : tTmp1,
30839 : tFlagArray - temporary arrays, length at least N+1, simply provide
30840 : preallocated place.
30841 :
30842 : OUTPUT PARAMETERS
30843 : Analysis - following fields are initialized:
30844 : * Analysis.LAdjPlus
30845 : * Analysis.LAdjPlusR
30846 : Node2Supernode- array[N] that maps node indexes to supernode indexes
30847 :
30848 : -- ALGLIB PROJECT --
30849 : Copyright 05.10.2020 by Bochkanov Sergey.
30850 : *************************************************************************/
30851 0 : static void spchol_analyzesupernodaldependencies(spcholanalysis* analysis,
30852 : sparsematrix* rawa,
30853 : /* Integer */ ae_vector* node2supernode,
30854 : ae_int_t n,
30855 : /* Integer */ ae_vector* ttmp0,
30856 : /* Integer */ ae_vector* ttmp1,
30857 : /* Boolean */ ae_vector* tflagarray,
30858 : ae_state *_state)
30859 : {
30860 : ae_int_t i;
30861 : ae_int_t j;
30862 : ae_int_t rowidx;
30863 : ae_int_t j0;
30864 : ae_int_t j1;
30865 : ae_int_t jj;
30866 : ae_int_t rfirst;
30867 : ae_int_t rlast;
30868 : ae_int_t sidx;
30869 : ae_int_t uidx;
30870 : ae_int_t dbgrank1nodes;
30871 : ae_int_t dbgrank2nodes;
30872 : ae_int_t dbgrank3nodes;
30873 : ae_int_t dbgrank4nodes;
30874 : ae_int_t dbgbignodes;
30875 : double dbgtotalflop;
30876 : double dbgnoscatterflop;
30877 : double dbgnorowscatterflop;
30878 : double dbgnocolscatterflop;
30879 : double dbgcholeskyflop;
30880 : double dbgcholesky4flop;
30881 : double dbgrank1flop;
30882 : double dbgrank4plusflop;
30883 : double dbg444flop;
30884 : double dbgxx4flop;
30885 : double uflop;
30886 : ae_int_t wrkrow;
30887 : ae_int_t offdiagrow;
30888 : ae_int_t lastrow;
30889 : ae_int_t uwidth;
30890 : ae_int_t uheight;
30891 : ae_int_t urank;
30892 : ae_int_t theight;
30893 : ae_int_t twidth;
30894 :
30895 :
30896 0 : ae_assert(ttmp0->cnt>=n+1, "AnalyzeSupernodalDependencies: input buffer tTmp0 is too short", _state);
30897 0 : ae_assert(ttmp1->cnt>=n+1, "AnalyzeSupernodalDependencies: input buffer tTmp1 is too short", _state);
30898 0 : ae_assert(tflagarray->cnt>=n+1, "AnalyzeSupernodalDependencies: input buffer tTmp0 is too short", _state);
30899 0 : ae_assert(sparseiscrs(rawa, _state), "AnalyzeSupernodalDependencies: RawA must be CRS matrix", _state);
30900 :
30901 : /*
30902 : * Determine LAdjPlus - supernodes feeding updates to the SIdx-th one.
30903 : *
30904 : * Without supernodes we have: K-th row of L (also denoted as ladj+(K))
30905 : * includes original nonzeros from A (also denoted as ladj(K)) as well
30906 : * as all elements on paths in elimination tree from ladj(K) to K.
30907 : *
30908 : * With supernodes: same principle applied.
30909 : */
30910 0 : isetallocv(analysis->nsuper+1, 0, &analysis->ladjplusr, _state);
30911 0 : bsetv(n, ae_true, tflagarray, _state);
30912 0 : analysis->ladjplusr.ptr.p_int[0] = 0;
30913 0 : for(sidx=0; sidx<=analysis->nsuper-1; sidx++)
30914 : {
30915 :
30916 : /*
30917 : * Generate list of nodes feeding updates to SIdx-th one
30918 : */
30919 0 : ivectorgrowto(&analysis->ladjplus, analysis->ladjplusr.ptr.p_int[sidx]+analysis->nsuper, _state);
30920 0 : rfirst = analysis->ladjplusr.ptr.p_int[sidx];
30921 0 : rlast = rfirst;
30922 0 : for(rowidx=analysis->supercolrange.ptr.p_int[sidx]; rowidx<=analysis->supercolrange.ptr.p_int[sidx+1]-1; rowidx++)
30923 : {
30924 0 : i = analysis->invsuperperm.ptr.p_int[rowidx];
30925 0 : j0 = rawa->ridx.ptr.p_int[i];
30926 0 : j1 = rawa->uidx.ptr.p_int[i]-1;
30927 0 : for(jj=j0; jj<=j1; jj++)
30928 : {
30929 0 : j = node2supernode->ptr.p_int[analysis->superperm.ptr.p_int[rawa->idx.ptr.p_int[jj]]];
30930 0 : if( j<sidx&&tflagarray->ptr.p_bool[j] )
30931 : {
30932 0 : analysis->ladjplus.ptr.p_int[rlast] = j;
30933 0 : tflagarray->ptr.p_bool[j] = ae_false;
30934 0 : rlast = rlast+1;
30935 0 : j = analysis->parentsupernode.ptr.p_int[j];
30936 0 : while((j>=0&&j<sidx)&&tflagarray->ptr.p_bool[j])
30937 : {
30938 0 : analysis->ladjplus.ptr.p_int[rlast] = j;
30939 0 : tflagarray->ptr.p_bool[j] = ae_false;
30940 0 : rlast = rlast+1;
30941 0 : j = analysis->parentsupernode.ptr.p_int[j];
30942 : }
30943 : }
30944 : }
30945 : }
30946 0 : for(i=rfirst; i<=rlast-1; i++)
30947 : {
30948 0 : tflagarray->ptr.p_bool[analysis->ladjplus.ptr.p_int[i]] = ae_true;
30949 : }
30950 0 : analysis->ladjplusr.ptr.p_int[sidx+1] = rlast;
30951 : }
30952 :
30953 : /*
30954 : * Analyze statistics for trace output
30955 : */
30956 0 : if( analysis->dotrace )
30957 : {
30958 0 : ae_trace("=== ANALYZING SUPERNODAL DEPENDENCIES ==============================================================\n");
30959 0 : dbgrank1nodes = 0;
30960 0 : dbgrank2nodes = 0;
30961 0 : dbgrank3nodes = 0;
30962 0 : dbgrank4nodes = 0;
30963 0 : dbgbignodes = 0;
30964 0 : dbgtotalflop = (double)(0);
30965 0 : dbgnoscatterflop = (double)(0);
30966 0 : dbgnorowscatterflop = (double)(0);
30967 0 : dbgnocolscatterflop = (double)(0);
30968 0 : dbgrank1flop = (double)(0);
30969 0 : dbgrank4plusflop = (double)(0);
30970 0 : dbg444flop = (double)(0);
30971 0 : dbgxx4flop = (double)(0);
30972 0 : dbgcholeskyflop = (double)(0);
30973 0 : dbgcholesky4flop = (double)(0);
30974 0 : isetv(analysis->nsuper, 0, ttmp0, _state);
30975 0 : for(sidx=0; sidx<=analysis->nsuper-1; sidx++)
30976 : {
30977 :
30978 : /*
30979 : * Node sizes
30980 : */
30981 0 : if( analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx]==1 )
30982 : {
30983 0 : inc(&dbgrank1nodes, _state);
30984 : }
30985 0 : if( analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx]==2 )
30986 : {
30987 0 : inc(&dbgrank2nodes, _state);
30988 : }
30989 0 : if( analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx]==3 )
30990 : {
30991 0 : inc(&dbgrank3nodes, _state);
30992 : }
30993 0 : if( analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx]==4 )
30994 : {
30995 0 : inc(&dbgrank4nodes, _state);
30996 : }
30997 0 : if( analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx]>4 )
30998 : {
30999 0 : inc(&dbgbignodes, _state);
31000 : }
31001 :
31002 : /*
31003 : * FLOP counts
31004 : */
31005 0 : twidth = analysis->supercolrange.ptr.p_int[sidx+1]-analysis->supercolrange.ptr.p_int[sidx];
31006 0 : theight = twidth+(analysis->superrowridx.ptr.p_int[sidx+1]-analysis->superrowridx.ptr.p_int[sidx]);
31007 0 : for(i=analysis->ladjplusr.ptr.p_int[sidx]; i<=analysis->ladjplusr.ptr.p_int[sidx+1]-1; i++)
31008 : {
31009 0 : uidx = analysis->ladjplus.ptr.p_int[i];
31010 :
31011 : /*
31012 : * Determine update width, height, rank
31013 : */
31014 0 : wrkrow = ttmp0->ptr.p_int[uidx];
31015 0 : offdiagrow = wrkrow;
31016 0 : lastrow = analysis->superrowridx.ptr.p_int[uidx+1]-analysis->superrowridx.ptr.p_int[uidx];
31017 0 : while(offdiagrow<lastrow&&analysis->superrowidx.ptr.p_int[analysis->superrowridx.ptr.p_int[uidx]+offdiagrow]<analysis->supercolrange.ptr.p_int[sidx+1])
31018 : {
31019 0 : offdiagrow = offdiagrow+1;
31020 : }
31021 0 : uwidth = offdiagrow-wrkrow;
31022 0 : uheight = lastrow-wrkrow;
31023 0 : urank = analysis->supercolrange.ptr.p_int[uidx+1]-analysis->supercolrange.ptr.p_int[uidx];
31024 0 : ttmp0->ptr.p_int[uidx] = offdiagrow;
31025 :
31026 : /*
31027 : * Compute update FLOP cost
31028 : */
31029 0 : uflop = rmul3((double)(uwidth), (double)(uheight), (double)(urank), _state);
31030 0 : dbgtotalflop = dbgtotalflop+uflop;
31031 0 : if( uheight==theight&&uwidth==twidth )
31032 : {
31033 0 : dbgnoscatterflop = dbgnoscatterflop+uflop;
31034 : }
31035 0 : if( uheight==theight )
31036 : {
31037 0 : dbgnorowscatterflop = dbgnorowscatterflop+uflop;
31038 : }
31039 0 : if( uwidth==twidth )
31040 : {
31041 0 : dbgnocolscatterflop = dbgnocolscatterflop+uflop;
31042 : }
31043 0 : if( urank==1 )
31044 : {
31045 0 : dbgrank1flop = dbgrank1flop+uflop;
31046 : }
31047 0 : if( urank>=4 )
31048 : {
31049 0 : dbgrank4plusflop = dbgrank4plusflop+uflop;
31050 : }
31051 0 : if( (urank==4&&uwidth==4)&&twidth==4 )
31052 : {
31053 0 : dbg444flop = dbg444flop+uflop;
31054 : }
31055 0 : if( twidth==4 )
31056 : {
31057 0 : dbgxx4flop = dbgxx4flop+uflop;
31058 : }
31059 : }
31060 0 : uflop = (double)(0);
31061 0 : for(i=0; i<=twidth-1; i++)
31062 : {
31063 0 : uflop = uflop+(theight-i)*i+(theight-i);
31064 : }
31065 0 : dbgtotalflop = dbgtotalflop+uflop;
31066 0 : dbgcholeskyflop = dbgcholeskyflop+uflop;
31067 0 : if( twidth==4 )
31068 : {
31069 0 : dbgcholesky4flop = dbgcholesky4flop+uflop;
31070 : }
31071 : }
31072 :
31073 : /*
31074 : * Output
31075 : */
31076 0 : ae_trace("> node size statistics:\n");
31077 0 : ae_trace("rank1 = %6d\n",
31078 : (int)(dbgrank1nodes));
31079 0 : ae_trace("rank2 = %6d\n",
31080 : (int)(dbgrank2nodes));
31081 0 : ae_trace("rank3 = %6d\n",
31082 : (int)(dbgrank3nodes));
31083 0 : ae_trace("rank4 = %6d\n",
31084 : (int)(dbgrank4nodes));
31085 0 : ae_trace("big nodes = %6d\n",
31086 : (int)(dbgbignodes));
31087 0 : ae_trace("> Total FLOP count (fused multiply-adds):\n");
31088 0 : ae_trace("total = %8.2f MFLOP\n",
31089 : (double)(1.0E-6*dbgtotalflop));
31090 0 : ae_trace("> FLOP counts for updates:\n");
31091 0 : ae_trace("no-sctr = %8.2f MFLOP (no row scatter, no col scatter, best case)\n",
31092 : (double)(1.0E-6*dbgnoscatterflop));
31093 0 : ae_trace("M4*44->N4 = %8.2f MFLOP (no col scatter, big blocks, good case)\n",
31094 : (double)(1.0E-6*dbg444flop));
31095 0 : ae_trace("no-row-sctr = %8.2f MFLOP (no row scatter, good case for col-wise storage)\n",
31096 : (double)(1.0E-6*dbgnorowscatterflop));
31097 0 : ae_trace("no-col-sctr = %8.2f MFLOP (no col scatter, good case for row-wise storage)\n",
31098 : (double)(1.0E-6*dbgnocolscatterflop));
31099 0 : ae_trace("XX*XX->N4 = %8.2f MFLOP\n",
31100 : (double)(1.0E-6*dbgxx4flop));
31101 0 : ae_trace("rank1 = %8.2f MFLOP\n",
31102 : (double)(1.0E-6*dbgrank1flop));
31103 0 : ae_trace("rank4+ = %8.2f MFLOP\n",
31104 : (double)(1.0E-6*dbgrank4plusflop));
31105 0 : ae_trace("> FLOP counts for Cholesky:\n");
31106 0 : ae_trace("cholesky = %8.2f MFLOP\n",
31107 : (double)(1.0E-6*dbgcholeskyflop));
31108 0 : ae_trace("cholesky4 = %8.2f MFLOP\n",
31109 : (double)(1.0E-6*dbgcholesky4flop));
31110 : }
31111 0 : }
31112 :
31113 :
31114 : /*************************************************************************
31115 : This function extracts computed matrix from the supernodal storage.
31116 : Depending on settings, a supernodal permutation can be applied to the matrix.
31117 :
31118 : INPUT PARAMETERS
31119 : Analysis - analysis object with completely initialized supernodal
31120 : structure
31121 : Offsets - offsets for supernodal storage
31122 : Strides - row strides for supernodal storage
31123 : RowStorage - supernodal storage
31124 : DiagD - diagonal factor
31125 : N - problem size
31126 :
31127 : TmpP - preallocated temporary array[N+1]
31128 :
31129 : OUTPUT PARAMETERS
31130 : A - sparse matrix in CRS format:
31131 : * for PermType=0, sparse matrix in the original ordering
31132 : (i.e. the matrix is reordered prior to output that
31133 : may require considerable amount of operations due to
31134 : permutation being applied)
31135 : * for PermType=1, sparse matrix in the topological
31136 : ordering. The least overhead for output.
31137 : D - array[N], diagonal
31138 : P - output permutation in product form
31139 :
31140 : -- ALGLIB PROJECT --
31141 : Copyright 05.10.2020 by Bochkanov Sergey.
31142 : *************************************************************************/
31143 0 : static void spchol_extractmatrix(spcholanalysis* analysis,
31144 : /* Integer */ ae_vector* offsets,
31145 : /* Integer */ ae_vector* strides,
31146 : /* Real */ ae_vector* rowstorage,
31147 : /* Real */ ae_vector* diagd,
31148 : ae_int_t n,
31149 : sparsematrix* a,
31150 : /* Real */ ae_vector* d,
31151 : /* Integer */ ae_vector* p,
31152 : /* Integer */ ae_vector* tmpp,
31153 : ae_state *_state)
31154 : {
31155 : ae_int_t i;
31156 : ae_int_t j;
31157 : ae_int_t k;
31158 : ae_int_t sidx;
31159 : ae_int_t i0;
31160 : ae_int_t ii;
31161 : ae_int_t rfirst;
31162 : ae_int_t rlast;
31163 : ae_int_t cols0;
31164 : ae_int_t cols1;
31165 : ae_int_t blocksize;
31166 : ae_int_t rowstride;
31167 : ae_int_t offdiagsize;
31168 : ae_int_t offssdiag;
31169 :
31170 :
31171 0 : ae_assert(tmpp->cnt>=n+1, "ExtractMatrix: preallocated temporary TmpP is too short", _state);
31172 :
31173 : /*
31174 : * Basic initialization
31175 : */
31176 0 : a->matrixtype = 1;
31177 0 : a->n = n;
31178 0 : a->m = n;
31179 :
31180 : /*
31181 : * Various permutation types
31182 : */
31183 0 : if( analysis->applypermutationtooutput )
31184 : {
31185 0 : ae_assert(analysis->istopologicalordering, "ExtractMatrix: critical integrity check failed (attempt to merge in nontopological permutation)", _state);
31186 :
31187 : /*
31188 : * Output matrix is topologically permuted, so we return A=L*L' instead of A=P*L*L'*P'.
31189 : * Somewhat inefficient because we have to apply permutation to L returned by supernodal code.
31190 : */
31191 0 : ivectorsetlengthatleast(&a->ridx, n+1, _state);
31192 0 : ivectorsetlengthatleast(&a->didx, n, _state);
31193 0 : a->ridx.ptr.p_int[0] = 0;
31194 0 : for(i=0; i<=n-1; i++)
31195 : {
31196 0 : a->ridx.ptr.p_int[i+1] = a->ridx.ptr.p_int[i]+analysis->outrowcounts.ptr.p_int[analysis->effectiveperm.ptr.p_int[i]];
31197 : }
31198 0 : for(i=0; i<=n-1; i++)
31199 : {
31200 0 : a->didx.ptr.p_int[i] = a->ridx.ptr.p_int[i];
31201 : }
31202 0 : a->ninitialized = a->ridx.ptr.p_int[n];
31203 0 : rvectorsetlengthatleast(&a->vals, a->ninitialized, _state);
31204 0 : ivectorsetlengthatleast(&a->idx, a->ninitialized, _state);
31205 0 : for(sidx=0; sidx<=analysis->nsuper-1; sidx++)
31206 : {
31207 0 : cols0 = analysis->supercolrange.ptr.p_int[sidx];
31208 0 : cols1 = analysis->supercolrange.ptr.p_int[sidx+1];
31209 0 : rfirst = analysis->superrowridx.ptr.p_int[sidx];
31210 0 : rlast = analysis->superrowridx.ptr.p_int[sidx+1];
31211 0 : blocksize = cols1-cols0;
31212 0 : offdiagsize = rlast-rfirst;
31213 0 : rowstride = strides->ptr.p_int[sidx];
31214 0 : offssdiag = offsets->ptr.p_int[sidx];
31215 0 : for(i=0; i<=blocksize-1; i++)
31216 : {
31217 0 : i0 = analysis->inveffectiveperm.ptr.p_int[cols0+i];
31218 0 : ii = a->didx.ptr.p_int[i0];
31219 0 : for(j=0; j<=i; j++)
31220 : {
31221 0 : a->idx.ptr.p_int[ii] = analysis->inveffectiveperm.ptr.p_int[cols0+j];
31222 0 : a->vals.ptr.p_double[ii] = rowstorage->ptr.p_double[offssdiag+i*rowstride+j];
31223 0 : ii = ii+1;
31224 : }
31225 0 : a->didx.ptr.p_int[i0] = ii;
31226 : }
31227 0 : for(k=0; k<=offdiagsize-1; k++)
31228 : {
31229 0 : i0 = analysis->inveffectiveperm.ptr.p_int[analysis->superrowidx.ptr.p_int[k+rfirst]];
31230 0 : ii = a->didx.ptr.p_int[i0];
31231 0 : for(j=0; j<=blocksize-1; j++)
31232 : {
31233 0 : a->idx.ptr.p_int[ii] = analysis->inveffectiveperm.ptr.p_int[cols0+j];
31234 0 : a->vals.ptr.p_double[ii] = rowstorage->ptr.p_double[offssdiag+(blocksize+k)*rowstride+j];
31235 0 : ii = ii+1;
31236 : }
31237 0 : a->didx.ptr.p_int[i0] = ii;
31238 : }
31239 : }
31240 0 : for(i=0; i<=n-1; i++)
31241 : {
31242 0 : ae_assert(a->didx.ptr.p_int[i]==a->ridx.ptr.p_int[i+1], "ExtractMatrix: integrity check failed (9473t)", _state);
31243 0 : tagsortmiddleir(&a->idx, &a->vals, a->ridx.ptr.p_int[i], a->ridx.ptr.p_int[i+1]-a->ridx.ptr.p_int[i], _state);
31244 0 : ae_assert(a->idx.ptr.p_int[a->ridx.ptr.p_int[i+1]-1]==i, "ExtractMatrix: integrity check failed (e4tfd)", _state);
31245 : }
31246 0 : sparseinitduidx(a, _state);
31247 :
31248 : /*
31249 : * Prepare D[] and P[]
31250 : */
31251 0 : rvectorsetlengthatleast(d, n, _state);
31252 0 : ivectorsetlengthatleast(p, n, _state);
31253 0 : for(i=0; i<=n-1; i++)
31254 : {
31255 0 : d->ptr.p_double[i] = diagd->ptr.p_double[analysis->effectiveperm.ptr.p_int[i]];
31256 0 : p->ptr.p_int[i] = i;
31257 : }
31258 : }
31259 : else
31260 : {
31261 :
31262 : /*
31263 : * The permutation is NOT applied to L prior to extraction,
31264 : * we return both L and P: A=P*L*L'*P'.
31265 : */
31266 0 : ivectorsetlengthatleast(&a->ridx, n+1, _state);
31267 0 : ivectorsetlengthatleast(&a->didx, n, _state);
31268 0 : a->ridx.ptr.p_int[0] = 0;
31269 0 : for(i=0; i<=n-1; i++)
31270 : {
31271 0 : a->ridx.ptr.p_int[i+1] = a->ridx.ptr.p_int[i]+analysis->outrowcounts.ptr.p_int[i];
31272 : }
31273 0 : for(i=0; i<=n-1; i++)
31274 : {
31275 0 : a->didx.ptr.p_int[i] = a->ridx.ptr.p_int[i];
31276 : }
31277 0 : a->ninitialized = a->ridx.ptr.p_int[n];
31278 0 : rvectorsetlengthatleast(&a->vals, a->ninitialized, _state);
31279 0 : ivectorsetlengthatleast(&a->idx, a->ninitialized, _state);
31280 0 : for(sidx=0; sidx<=analysis->nsuper-1; sidx++)
31281 : {
31282 0 : cols0 = analysis->supercolrange.ptr.p_int[sidx];
31283 0 : cols1 = analysis->supercolrange.ptr.p_int[sidx+1];
31284 0 : rfirst = analysis->superrowridx.ptr.p_int[sidx];
31285 0 : rlast = analysis->superrowridx.ptr.p_int[sidx+1];
31286 0 : blocksize = cols1-cols0;
31287 0 : offdiagsize = rlast-rfirst;
31288 0 : rowstride = strides->ptr.p_int[sidx];
31289 0 : offssdiag = offsets->ptr.p_int[sidx];
31290 0 : for(i=0; i<=blocksize-1; i++)
31291 : {
31292 0 : i0 = cols0+i;
31293 0 : ii = a->didx.ptr.p_int[i0];
31294 0 : for(j=0; j<=i; j++)
31295 : {
31296 0 : a->idx.ptr.p_int[ii] = cols0+j;
31297 0 : a->vals.ptr.p_double[ii] = rowstorage->ptr.p_double[offssdiag+i*rowstride+j];
31298 0 : ii = ii+1;
31299 : }
31300 0 : a->didx.ptr.p_int[i0] = ii;
31301 : }
31302 0 : for(k=0; k<=offdiagsize-1; k++)
31303 : {
31304 0 : i0 = analysis->superrowidx.ptr.p_int[k+rfirst];
31305 0 : ii = a->didx.ptr.p_int[i0];
31306 0 : for(j=0; j<=blocksize-1; j++)
31307 : {
31308 0 : a->idx.ptr.p_int[ii] = cols0+j;
31309 0 : a->vals.ptr.p_double[ii] = rowstorage->ptr.p_double[offssdiag+(blocksize+k)*rowstride+j];
31310 0 : ii = ii+1;
31311 : }
31312 0 : a->didx.ptr.p_int[i0] = ii;
31313 : }
31314 : }
31315 0 : for(i=0; i<=n-1; i++)
31316 : {
31317 0 : ae_assert(a->didx.ptr.p_int[i]==a->ridx.ptr.p_int[i+1], "ExtractMatrix: integrity check failed (34e43)", _state);
31318 0 : ae_assert(a->idx.ptr.p_int[a->ridx.ptr.p_int[i+1]-1]==i, "ExtractMatrix: integrity check failed (k4df5)", _state);
31319 : }
31320 0 : sparseinitduidx(a, _state);
31321 :
31322 : /*
31323 : * Extract diagonal
31324 : */
31325 0 : rvectorsetlengthatleast(d, n, _state);
31326 0 : for(i=0; i<=n-1; i++)
31327 : {
31328 0 : d->ptr.p_double[i] = diagd->ptr.p_double[i];
31329 : }
31330 :
31331 : /*
31332 : * Convert permutation table into product form
31333 : */
31334 0 : ivectorsetlengthatleast(p, n, _state);
31335 0 : for(i=0; i<=n-1; i++)
31336 : {
31337 0 : p->ptr.p_int[i] = i;
31338 0 : tmpp->ptr.p_int[i] = i;
31339 : }
31340 0 : for(i=0; i<=n-1; i++)
31341 : {
31342 :
31343 : /*
31344 : * We need to move element K to position I.
31345 : * J is where K actually stored
31346 : */
31347 0 : k = analysis->inveffectiveperm.ptr.p_int[i];
31348 0 : j = tmpp->ptr.p_int[k];
31349 :
31350 : /*
31351 : * Swap elements of P[I:N-1] that is used to store current locations of elements in different way
31352 : */
31353 0 : i0 = p->ptr.p_int[i];
31354 0 : p->ptr.p_int[i] = p->ptr.p_int[j];
31355 0 : p->ptr.p_int[j] = i0;
31356 :
31357 : /*
31358 : * record pivoting of positions I and J
31359 : */
31360 0 : p->ptr.p_int[i] = j;
31361 0 : tmpp->ptr.p_int[i0] = j;
31362 : }
31363 : }
31364 0 : }
31365 :
31366 :
31367 : /*************************************************************************
31368 : This function is a specialized version of SparseSymmPermTbl() that takes
31369 : into account specifics of topological reorderings (improves performance)
31370 : and additionally transposes its output.
31371 :
31372 : INPUT PARAMETERS
31373 : A - sparse lower triangular matrix in CRS format.
31374 : P - array[N] which stores permutation table; P[I]=J means
31375 : that I-th row/column of matrix A is moved to J-th
31376 : position. For performance reasons we do NOT check that
31377 : P[] is a correct permutation (that there is no
31378 : repetitions, just that all its elements are in [0,N)
31379 : range.
31380 : B - sparse matrix object that will hold output.
31381 : Previously allocated memory will be reused as much as
31382 : possible.
31383 :
31384 : OUTPUT PARAMETERS
31385 : B - permuted and transposed upper triangular matrix in the
31386 : special internal CRS-like matrix format (MatrixType=-10082).
31387 :
31388 : -- ALGLIB PROJECT --
31389 : Copyright 05.10.2020 by Bochkanov Sergey.
31390 : *************************************************************************/
31391 0 : static void spchol_topologicalpermutation(sparsematrix* a,
31392 : /* Integer */ ae_vector* p,
31393 : sparsematrix* b,
31394 : ae_state *_state)
31395 : {
31396 : ae_int_t i;
31397 : ae_int_t j;
31398 : ae_int_t jj;
31399 : ae_int_t j0;
31400 : ae_int_t j1;
31401 : ae_int_t k;
31402 : ae_int_t k0;
31403 : ae_int_t n;
31404 : ae_bool bflag;
31405 :
31406 :
31407 0 : ae_assert(a->matrixtype==1, "TopologicalPermutation: incorrect matrix type (convert your matrix to CRS)", _state);
31408 0 : ae_assert(p->cnt>=a->n, "TopologicalPermutation: Length(P)<N", _state);
31409 0 : ae_assert(a->m==a->n, "TopologicalPermutation: matrix is non-square", _state);
31410 0 : ae_assert(a->ninitialized==a->ridx.ptr.p_int[a->n], "TopologicalPermutation: integrity check failed", _state);
31411 0 : bflag = ae_true;
31412 0 : n = a->n;
31413 0 : for(i=0; i<=n-1; i++)
31414 : {
31415 0 : j = p->ptr.p_int[i];
31416 0 : bflag = (bflag&&j>=0)&&j<n;
31417 : }
31418 0 : ae_assert(bflag, "TopologicalPermutation: P[] contains values outside of [0,N) range", _state);
31419 :
31420 : /*
31421 : * Prepare output
31422 : */
31423 0 : b->matrixtype = -10082;
31424 0 : b->n = n;
31425 0 : b->m = n;
31426 0 : ivectorsetlengthatleast(&b->didx, n, _state);
31427 0 : ivectorsetlengthatleast(&b->uidx, n, _state);
31428 :
31429 : /*
31430 : * Determine row sizes (temporary stored in DIdx) and ranges
31431 : */
31432 0 : isetv(n, 0, &b->uidx, _state);
31433 0 : for(i=0; i<=n-1; i++)
31434 : {
31435 0 : j0 = a->ridx.ptr.p_int[i];
31436 0 : j1 = a->uidx.ptr.p_int[i]-1;
31437 0 : for(jj=j0; jj<=j1; jj++)
31438 : {
31439 0 : j = a->idx.ptr.p_int[jj];
31440 0 : b->uidx.ptr.p_int[j] = b->uidx.ptr.p_int[j]+1;
31441 : }
31442 : }
31443 0 : for(i=0; i<=n-1; i++)
31444 : {
31445 0 : b->didx.ptr.p_int[p->ptr.p_int[i]] = b->uidx.ptr.p_int[i];
31446 : }
31447 0 : ivectorsetlengthatleast(&b->ridx, n+1, _state);
31448 0 : b->ridx.ptr.p_int[0] = 0;
31449 0 : for(i=0; i<=n-1; i++)
31450 : {
31451 0 : b->ridx.ptr.p_int[i+1] = b->ridx.ptr.p_int[i]+b->didx.ptr.p_int[i];
31452 0 : b->uidx.ptr.p_int[i] = b->ridx.ptr.p_int[i];
31453 : }
31454 0 : b->ninitialized = b->ridx.ptr.p_int[n];
31455 0 : ivectorsetlengthatleast(&b->idx, b->ninitialized, _state);
31456 0 : rvectorsetlengthatleast(&b->vals, b->ninitialized, _state);
31457 :
31458 : /*
31459 : * Process matrix
31460 : */
31461 0 : for(i=0; i<=n-1; i++)
31462 : {
31463 0 : j0 = a->ridx.ptr.p_int[i];
31464 0 : j1 = a->uidx.ptr.p_int[i]-1;
31465 0 : k = p->ptr.p_int[i];
31466 0 : for(jj=j0; jj<=j1; jj++)
31467 : {
31468 0 : j = p->ptr.p_int[a->idx.ptr.p_int[jj]];
31469 0 : k0 = b->uidx.ptr.p_int[j];
31470 0 : b->idx.ptr.p_int[k0] = k;
31471 0 : b->vals.ptr.p_double[k0] = a->vals.ptr.p_double[jj];
31472 0 : b->uidx.ptr.p_int[j] = k0+1;
31473 : }
31474 : }
31475 0 : }
31476 :
31477 :
31478 : /*************************************************************************
31479 : Determine nonzero pattern of the column.
31480 :
31481 : This function takes as input:
31482 : * A^T - transpose of original input matrix
31483 : * index of column of L being computed
31484 : * SuperRowRIdx[] and SuperRowIdx[] - arrays that store row structure of
31485 : supernodes, and NSuper - supernodes count
31486 : * ChildrenNodesR[], ChildrenNodesI[] - arrays that store children nodes
31487 : for each node
31488 : * Node2Supernode[] - array that maps node indexes to supernodes
31489 : * TrueArray[] - array[N] that has all of its elements set to True (this
31490 : invariant is preserved on output)
31491 : * Tmp0[] - array[N], temporary array
31492 :
31493 : As output, it constructs nonzero pattern (diagonal element not included)
31494 : of the column #ColumnIdx on top of SuperRowIdx[] array, starting at
31495 : location SuperRowIdx[SuperRowRIdx[NSuper]] and till location
31496 : SuperRowIdx[Result-1], where Result is a function result.
31497 :
31498 : The SuperRowIdx[] array is automatically resized as needed.
31499 :
31500 : It is important that this function computes nonzero pattern, but it does
31501 : NOT change other supernodal structures. The caller still has to finalize
31502 : the column (setup supernode ranges, mappings, etc).
31503 :
31504 : -- ALGLIB routine --
31505 : 20.09.2020
31506 : Bochkanov Sergey
31507 : *************************************************************************/
31508 0 : static ae_int_t spchol_computenonzeropattern(sparsematrix* wrkat,
31509 : ae_int_t columnidx,
31510 : ae_int_t n,
31511 : /* Integer */ ae_vector* superrowridx,
31512 : /* Integer */ ae_vector* superrowidx,
31513 : ae_int_t nsuper,
31514 : /* Integer */ ae_vector* childrennodesr,
31515 : /* Integer */ ae_vector* childrennodesi,
31516 : /* Integer */ ae_vector* node2supernode,
31517 : /* Boolean */ ae_vector* truearray,
31518 : /* Integer */ ae_vector* tmp0,
31519 : ae_state *_state)
31520 : {
31521 : ae_int_t i;
31522 : ae_int_t ii;
31523 : ae_int_t jj;
31524 : ae_int_t i0;
31525 : ae_int_t i1;
31526 : ae_int_t j0;
31527 : ae_int_t j1;
31528 : ae_int_t cidx;
31529 : ae_int_t rfirst;
31530 : ae_int_t rlast;
31531 : ae_int_t tfirst;
31532 : ae_int_t tlast;
31533 : ae_int_t supernodalchildrencount;
31534 : ae_int_t result;
31535 :
31536 :
31537 0 : ae_assert(truearray->cnt>=n, "ComputeNonzeroPattern: input temporary is too short", _state);
31538 0 : ae_assert(tmp0->cnt>=n, "ComputeNonzeroPattern: input temporary is too short", _state);
31539 :
31540 : /*
31541 : * Determine supernodal children in Tmp0
31542 : */
31543 0 : supernodalchildrencount = 0;
31544 0 : i0 = childrennodesr->ptr.p_int[columnidx];
31545 0 : i1 = childrennodesr->ptr.p_int[columnidx+1]-1;
31546 0 : for(ii=i0; ii<=i1; ii++)
31547 : {
31548 0 : i = node2supernode->ptr.p_int[childrennodesi->ptr.p_int[ii]];
31549 0 : if( truearray->ptr.p_bool[i] )
31550 : {
31551 0 : tmp0->ptr.p_int[supernodalchildrencount] = i;
31552 0 : truearray->ptr.p_bool[i] = ae_false;
31553 0 : supernodalchildrencount = supernodalchildrencount+1;
31554 : }
31555 : }
31556 0 : for(i=0; i<=supernodalchildrencount-1; i++)
31557 : {
31558 0 : truearray->ptr.p_bool[tmp0->ptr.p_int[i]] = ae_true;
31559 : }
31560 :
31561 : /*
31562 : * Initialized column by nonzero pattern from A
31563 : */
31564 0 : rfirst = superrowridx->ptr.p_int[nsuper];
31565 0 : tfirst = rfirst+n;
31566 0 : igrowv(rfirst+2*n, superrowidx, _state);
31567 0 : i0 = wrkat->ridx.ptr.p_int[columnidx]+1;
31568 0 : i1 = wrkat->ridx.ptr.p_int[columnidx+1];
31569 0 : icopyvx(i1-i0, &wrkat->idx, i0, superrowidx, rfirst, _state);
31570 0 : rlast = rfirst+(i1-i0);
31571 :
31572 : /*
31573 : * For column with small number of children use ordered merge algorithm.
31574 : * For column with many children it is better to perform unsorted merge,
31575 : * and then sort the sequence.
31576 : */
31577 0 : if( supernodalchildrencount<=4 )
31578 : {
31579 :
31580 : /*
31581 : * Ordered merge. The best approach for small number of children,
31582 : * but may have O(N^2) running time when O(N) children are present.
31583 : */
31584 0 : for(cidx=0; cidx<=supernodalchildrencount-1; cidx++)
31585 : {
31586 :
31587 : /*
31588 : * Skip initial elements that do not contribute to subdiagonal nonzero pattern
31589 : */
31590 0 : i0 = superrowridx->ptr.p_int[tmp0->ptr.p_int[cidx]];
31591 0 : i1 = superrowridx->ptr.p_int[tmp0->ptr.p_int[cidx]+1]-1;
31592 0 : while(i0<=i1&&superrowidx->ptr.p_int[i0]<=columnidx)
31593 : {
31594 0 : i0 = i0+1;
31595 : }
31596 0 : j0 = rfirst;
31597 0 : j1 = rlast-1;
31598 :
31599 : /*
31600 : * Handle degenerate cases: empty merge target or empty merge source.
31601 : */
31602 0 : if( j1<j0 )
31603 : {
31604 0 : icopyvx(i1-i0+1, superrowidx, i0, superrowidx, rlast, _state);
31605 0 : rlast = rlast+(i1-i0+1);
31606 0 : continue;
31607 : }
31608 0 : if( i1<i0 )
31609 : {
31610 0 : continue;
31611 : }
31612 :
31613 : /*
31614 : * General case: two non-empty sorted sequences given by [I0,I1] and [J0,J1],
31615 : * have to be merged and stored into [RFirst,RLast).
31616 : */
31617 0 : ii = superrowidx->ptr.p_int[i0];
31618 0 : jj = superrowidx->ptr.p_int[j0];
31619 0 : tlast = tfirst;
31620 : for(;;)
31621 : {
31622 0 : if( ii<jj )
31623 : {
31624 0 : superrowidx->ptr.p_int[tlast] = ii;
31625 0 : tlast = tlast+1;
31626 0 : i0 = i0+1;
31627 0 : if( i0>i1 )
31628 : {
31629 0 : break;
31630 : }
31631 0 : ii = superrowidx->ptr.p_int[i0];
31632 : }
31633 0 : if( jj<ii )
31634 : {
31635 0 : superrowidx->ptr.p_int[tlast] = jj;
31636 0 : tlast = tlast+1;
31637 0 : j0 = j0+1;
31638 0 : if( j0>j1 )
31639 : {
31640 0 : break;
31641 : }
31642 0 : jj = superrowidx->ptr.p_int[j0];
31643 : }
31644 0 : if( jj==ii )
31645 : {
31646 0 : superrowidx->ptr.p_int[tlast] = ii;
31647 0 : tlast = tlast+1;
31648 0 : i0 = i0+1;
31649 0 : j0 = j0+1;
31650 0 : if( i0>i1 )
31651 : {
31652 0 : break;
31653 : }
31654 0 : if( j0>j1 )
31655 : {
31656 0 : break;
31657 : }
31658 0 : ii = superrowidx->ptr.p_int[i0];
31659 0 : jj = superrowidx->ptr.p_int[j0];
31660 : }
31661 : }
31662 0 : for(ii=i0; ii<=i1; ii++)
31663 : {
31664 0 : superrowidx->ptr.p_int[tlast] = superrowidx->ptr.p_int[ii];
31665 0 : tlast = tlast+1;
31666 : }
31667 0 : for(jj=j0; jj<=j1; jj++)
31668 : {
31669 0 : superrowidx->ptr.p_int[tlast] = superrowidx->ptr.p_int[jj];
31670 0 : tlast = tlast+1;
31671 : }
31672 0 : icopyvx(tlast-tfirst, superrowidx, tfirst, superrowidx, rfirst, _state);
31673 0 : rlast = rfirst+(tlast-tfirst);
31674 : }
31675 0 : result = rlast;
31676 : }
31677 : else
31678 : {
31679 :
31680 : /*
31681 : * Unordered merge followed by sort. Guaranteed N*logN worst case.
31682 : */
31683 0 : for(ii=rfirst; ii<=rlast-1; ii++)
31684 : {
31685 0 : truearray->ptr.p_bool[superrowidx->ptr.p_int[ii]] = ae_false;
31686 : }
31687 0 : for(cidx=0; cidx<=supernodalchildrencount-1; cidx++)
31688 : {
31689 :
31690 : /*
31691 : * Skip initial elements that do not contribute to subdiagonal nonzero pattern
31692 : */
31693 0 : i0 = superrowridx->ptr.p_int[tmp0->ptr.p_int[cidx]];
31694 0 : i1 = superrowridx->ptr.p_int[tmp0->ptr.p_int[cidx]+1]-1;
31695 0 : while(i0<=i1&&superrowidx->ptr.p_int[i0]<=columnidx)
31696 : {
31697 0 : i0 = i0+1;
31698 : }
31699 :
31700 : /*
31701 : * Append elements not present in the sequence
31702 : */
31703 0 : for(ii=i0; ii<=i1; ii++)
31704 : {
31705 0 : i = superrowidx->ptr.p_int[ii];
31706 0 : if( truearray->ptr.p_bool[i] )
31707 : {
31708 0 : superrowidx->ptr.p_int[rlast] = i;
31709 0 : rlast = rlast+1;
31710 0 : truearray->ptr.p_bool[i] = ae_false;
31711 : }
31712 : }
31713 : }
31714 0 : for(ii=rfirst; ii<=rlast-1; ii++)
31715 : {
31716 0 : truearray->ptr.p_bool[superrowidx->ptr.p_int[ii]] = ae_true;
31717 : }
31718 0 : tagsortmiddlei(superrowidx, rfirst, rlast-rfirst, _state);
31719 0 : result = rlast;
31720 : }
31721 0 : return result;
31722 : }
31723 :
31724 :
31725 : /*************************************************************************
31726 : Update target supernode with data from one of its children. This operation
31727 : is a supernodal equivalent of the column update in the left-looking
31728 : Cholesky.
31729 :
31730 : The generic update has following form:
31731 :
31732 : S := S - scatter(U*D*Uc')
31733 :
31734 : where
31735 : * S is an tHeight*tWidth rectangular target matrix that is:
31736 : * stored with tStride>=tWidth in RowStorage[OffsS:OffsS+tHeight*tStride-1]
31737 : * lower trapezoidal i.e. its leading tWidth*tWidth submatrix is lower
31738 : triangular. One may update either entire tWidth*tWidth submatrix or
31739 : just its lower part, because upper triangle is not referenced anyway.
31740 : * the height of S is not given because it is not actually needed
31741 : * U is an uHeight*uRank rectangular update matrix tht is:
31742 : * stored with row stride uStride>=uRank in RowStorage[OffsU:OffsU+uHeight*uStride-1].
31743 : * Uc is the leading uWidth*uRank submatrix of U
31744 : * D is uRank*uRank diagonal matrix that is:
31745 : * stored in DiagD[OffsD:OffsD+uRank-1]
31746 : * unit, when Analysis.UnitD=True. In this case it can be ignored, although
31747 : DiagD still contains 1's in all of its entries
31748 : * uHeight<=tHeight, uWidth<=tWidth, so scatter operation is needed to update
31749 : S with smaller update.
31750 : * scatter() is an operation that extends smaller uHeight*uWidth update
31751 : matrix U*Uc' into larger tHeight*tWidth target matrix by adding zero rows
31752 : and columns into U*Uc':
31753 : * I-th row of update modifies Raw2SMap[SuperRowIdx[URBase+I]]-th row of
31754 : the matrix S
31755 : * J-th column of update modifies Raw2SMap[SuperRowIdx[URBase+J]]-th col
31756 : of the matrix S
31757 :
31758 : -- ALGLIB routine --
31759 : 20.09.2020
31760 : Bochkanov Sergey
31761 : *************************************************************************/
31762 0 : static ae_int_t spchol_updatesupernode(spcholanalysis* analysis,
31763 : ae_int_t sidx,
31764 : ae_int_t cols0,
31765 : ae_int_t cols1,
31766 : ae_int_t offss,
31767 : /* Integer */ ae_vector* raw2smap,
31768 : ae_int_t uidx,
31769 : ae_int_t wrkrow,
31770 : /* Real */ ae_vector* diagd,
31771 : ae_int_t offsd,
31772 : ae_state *_state)
31773 : {
31774 : ae_int_t i;
31775 : ae_int_t j;
31776 : ae_int_t k;
31777 : ae_int_t colu0;
31778 : ae_int_t colu1;
31779 : ae_int_t urbase;
31780 : ae_int_t urlast;
31781 : ae_int_t urank;
31782 : ae_int_t uwidth;
31783 : ae_int_t uheight;
31784 : ae_int_t urowstride;
31785 : ae_int_t twidth;
31786 : ae_int_t trowstride;
31787 : ae_int_t targetrow;
31788 : ae_int_t targetcol;
31789 : ae_int_t offsu;
31790 : ae_int_t offdiagrow;
31791 : ae_int_t lastrow;
31792 : ae_int_t offs0;
31793 : ae_int_t offsj;
31794 : ae_int_t offsk;
31795 : double v;
31796 : ae_int_t result;
31797 :
31798 :
31799 0 : twidth = cols1-cols0;
31800 0 : offsu = analysis->rowoffsets.ptr.p_int[uidx];
31801 0 : colu0 = analysis->supercolrange.ptr.p_int[uidx];
31802 0 : colu1 = analysis->supercolrange.ptr.p_int[uidx+1];
31803 0 : urbase = analysis->superrowridx.ptr.p_int[uidx];
31804 0 : urlast = analysis->superrowridx.ptr.p_int[uidx+1];
31805 0 : urank = colu1-colu0;
31806 0 : trowstride = analysis->rowstrides.ptr.p_int[sidx];
31807 0 : urowstride = analysis->rowstrides.ptr.p_int[uidx];
31808 :
31809 : /*
31810 : * Skip leading uRank+WrkRow rows of U because they are not used.
31811 : */
31812 0 : offsu = offsu+(colu1-colu0+wrkrow)*urowstride;
31813 :
31814 : /*
31815 : * Analyze range of rows in supernode LAdjPlus[II] and determine two subranges:
31816 : * * one with indexes stored at SuperRowIdx[WrkRow:OffdiagRow);
31817 : * these indexes are the ones that intersect with range of rows/columns [ColS0,ColS1)
31818 : * occupied by diagonal block of the supernode SIdx
31819 : * * one with indexes stored at SuperRowIdx[OffdiagRow:LastRow);
31820 : * these indexes are ones that intersect with range of rows occupied by
31821 : * offdiagonal block of the supernode SIdx
31822 : */
31823 0 : if( analysis->extendeddebug )
31824 : {
31825 0 : ae_assert(analysis->superrowidx.ptr.p_int[urbase+wrkrow]>=cols0, "SPCholFactorize: integrity check 6378 failed", _state);
31826 0 : ae_assert(analysis->superrowidx.ptr.p_int[urbase+wrkrow]<cols1, "SPCholFactorize: integrity check 6729 failed", _state);
31827 : }
31828 0 : offdiagrow = wrkrow;
31829 0 : lastrow = urlast-urbase;
31830 0 : while(offdiagrow<lastrow&&analysis->superrowidx.ptr.p_int[offdiagrow+urbase]<cols1)
31831 : {
31832 0 : offdiagrow = offdiagrow+1;
31833 : }
31834 0 : uwidth = offdiagrow-wrkrow;
31835 0 : uheight = lastrow-wrkrow;
31836 0 : result = offdiagrow;
31837 0 : if( analysis->extendeddebug )
31838 : {
31839 :
31840 : /*
31841 : * Extended integrity check (if requested)
31842 : */
31843 0 : ae_assert(wrkrow<offdiagrow&&analysis->superrowidx.ptr.p_int[wrkrow+urbase]>=cols0, "SPCholFactorize: integrity check failed (44trg6)", _state);
31844 0 : for(i=wrkrow; i<=lastrow-1; i++)
31845 : {
31846 0 : ae_assert(raw2smap->ptr.p_int[analysis->superrowidx.ptr.p_int[i+urbase]]>=0, "SPCholFactorize: integrity check failed (43t63)", _state);
31847 : }
31848 : }
31849 :
31850 : /*
31851 : * Handle special cases
31852 : */
31853 0 : if( trowstride==4 )
31854 : {
31855 :
31856 : /*
31857 : * Target is stride-4 column, try several kernels that may work with tWidth=3 and tWidth=4
31858 : */
31859 0 : if( ((uwidth==4&&twidth==4)&&urank==4)&&urowstride==4 )
31860 : {
31861 0 : if( spchol_updatekernel4444(&analysis->rowstorage, offss, offsu, uheight, &analysis->diagd, colu0, raw2smap, &analysis->superrowidx, urbase+wrkrow, _state) )
31862 : {
31863 0 : return result;
31864 : }
31865 : }
31866 0 : if( spchol_updatekernelabc4(&analysis->rowstorage, offss, twidth, offsu, uheight, urank, urowstride, uwidth, &analysis->diagd, colu0, raw2smap, &analysis->superrowidx, urbase+wrkrow, _state) )
31867 : {
31868 0 : return result;
31869 : }
31870 : }
31871 0 : if( urank==1&&urowstride==1 )
31872 : {
31873 0 : if( spchol_updatekernelrank1(&analysis->rowstorage, offss, twidth, trowstride, offsu, uheight, uwidth, &analysis->diagd, colu0, raw2smap, &analysis->superrowidx, urbase+wrkrow, _state) )
31874 : {
31875 0 : return result;
31876 : }
31877 : }
31878 0 : if( urank==2&&urowstride==2 )
31879 : {
31880 0 : if( spchol_updatekernelrank2(&analysis->rowstorage, offss, twidth, trowstride, offsu, uheight, uwidth, &analysis->diagd, colu0, raw2smap, &analysis->superrowidx, urbase+wrkrow, _state) )
31881 : {
31882 0 : return result;
31883 : }
31884 : }
31885 :
31886 : /*
31887 : * Handle general update, rerefence code
31888 : */
31889 0 : ivectorsetlengthatleast(&analysis->u2smap, uheight, _state);
31890 0 : for(i=0; i<=uheight-1; i++)
31891 : {
31892 0 : analysis->u2smap.ptr.p_int[i] = raw2smap->ptr.p_int[analysis->superrowidx.ptr.p_int[urbase+wrkrow+i]];
31893 : }
31894 0 : if( analysis->unitd )
31895 : {
31896 :
31897 : /*
31898 : * Unit D, vanilla Cholesky
31899 : */
31900 0 : for(k=0; k<=uheight-1; k++)
31901 : {
31902 0 : targetrow = offss+analysis->u2smap.ptr.p_int[k]*trowstride;
31903 0 : for(j=0; j<=uwidth-1; j++)
31904 : {
31905 0 : targetcol = analysis->u2smap.ptr.p_int[j];
31906 0 : offsj = offsu+j*urowstride;
31907 0 : offsk = offsu+k*urowstride;
31908 0 : offs0 = targetrow+targetcol;
31909 0 : v = analysis->rowstorage.ptr.p_double[offs0];
31910 0 : for(i=0; i<=urank-1; i++)
31911 : {
31912 0 : v = v-analysis->rowstorage.ptr.p_double[offsj+i]*analysis->rowstorage.ptr.p_double[offsk+i];
31913 : }
31914 0 : analysis->rowstorage.ptr.p_double[offs0] = v;
31915 : }
31916 : }
31917 : }
31918 : else
31919 : {
31920 :
31921 : /*
31922 : * Non-unit D, LDLT decomposition
31923 : */
31924 0 : for(k=0; k<=uheight-1; k++)
31925 : {
31926 0 : targetrow = offss+analysis->u2smap.ptr.p_int[k]*trowstride;
31927 0 : for(j=0; j<=uwidth-1; j++)
31928 : {
31929 0 : targetcol = analysis->u2smap.ptr.p_int[j];
31930 0 : offsj = offsu+j*urowstride;
31931 0 : offsk = offsu+k*urowstride;
31932 0 : offs0 = targetrow+targetcol;
31933 0 : v = analysis->rowstorage.ptr.p_double[offs0];
31934 0 : for(i=0; i<=urank-1; i++)
31935 : {
31936 0 : v = v-analysis->rowstorage.ptr.p_double[offsj+i]*diagd->ptr.p_double[offsd+i]*analysis->rowstorage.ptr.p_double[offsk+i];
31937 : }
31938 0 : analysis->rowstorage.ptr.p_double[offs0] = v;
31939 : }
31940 : }
31941 : }
31942 0 : return result;
31943 : }
31944 :
31945 :
31946 : /*************************************************************************
31947 : Factorizes target supernode, returns True on success, False on failure.
31948 :
31949 : -- ALGLIB routine --
31950 : 20.09.2020
31951 : Bochkanov Sergey
31952 : *************************************************************************/
31953 0 : static ae_bool spchol_factorizesupernode(spcholanalysis* analysis,
31954 : ae_int_t sidx,
31955 : ae_state *_state)
31956 : {
31957 : ae_int_t i;
31958 : ae_int_t j;
31959 : ae_int_t k;
31960 : ae_int_t cols0;
31961 : ae_int_t cols1;
31962 : ae_int_t offss;
31963 : ae_int_t blocksize;
31964 : ae_int_t offdiagsize;
31965 : ae_int_t sstride;
31966 : double v;
31967 : double vs;
31968 : double possignvraw;
31969 : ae_bool controlpivot;
31970 : ae_bool controloverflow;
31971 : ae_bool result;
31972 :
31973 :
31974 0 : cols0 = analysis->supercolrange.ptr.p_int[sidx];
31975 0 : cols1 = analysis->supercolrange.ptr.p_int[sidx+1];
31976 0 : offss = analysis->rowoffsets.ptr.p_int[sidx];
31977 0 : blocksize = cols1-cols0;
31978 0 : offdiagsize = analysis->superrowridx.ptr.p_int[sidx+1]-analysis->superrowridx.ptr.p_int[sidx];
31979 0 : sstride = analysis->rowstrides.ptr.p_int[sidx];
31980 0 : controlpivot = analysis->modtype==1&&ae_fp_greater(analysis->modparam0,(double)(0));
31981 0 : controloverflow = analysis->modtype==1&&ae_fp_greater(analysis->modparam1,(double)(0));
31982 0 : if( analysis->unitd )
31983 : {
31984 :
31985 : /*
31986 : * Classic Cholesky
31987 : */
31988 0 : for(j=0; j<=blocksize-1; j++)
31989 : {
31990 :
31991 : /*
31992 : * Compute J-th column
31993 : */
31994 0 : vs = (double)(0);
31995 0 : for(k=j; k<=blocksize+offdiagsize-1; k++)
31996 : {
31997 0 : v = analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
31998 0 : for(i=0; i<=j-1; i++)
31999 : {
32000 0 : v = v-analysis->rowstorage.ptr.p_double[offss+k*sstride+i]*analysis->rowstorage.ptr.p_double[offss+j*sstride+i];
32001 : }
32002 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v;
32003 0 : vs = vs+ae_fabs(v, _state);
32004 : }
32005 0 : if( controloverflow&&ae_fp_greater(vs,analysis->modparam1) )
32006 : {
32007 :
32008 : /*
32009 : * Possible failure due to accumulation of numerical errors
32010 : */
32011 0 : result = ae_false;
32012 0 : return result;
32013 : }
32014 :
32015 : /*
32016 : * Handle pivot element
32017 : */
32018 0 : v = analysis->rowstorage.ptr.p_double[offss+j*sstride+j];
32019 0 : if( controlpivot&&ae_fp_less_eq(v,analysis->modparam0) )
32020 : {
32021 :
32022 : /*
32023 : * Basic modified Cholesky
32024 : */
32025 0 : v = ae_sqrt(analysis->modparam0, _state);
32026 0 : analysis->diagd.ptr.p_double[cols0+j] = 1.0;
32027 0 : analysis->rowstorage.ptr.p_double[offss+j*sstride+j] = v;
32028 0 : v = 1/v;
32029 0 : for(k=j+1; k<=blocksize+offdiagsize-1; k++)
32030 : {
32031 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v*analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
32032 : }
32033 : }
32034 : else
32035 : {
32036 :
32037 : /*
32038 : * Default case
32039 : */
32040 0 : if( ae_fp_less_eq(v,(double)(0)) )
32041 : {
32042 0 : result = ae_false;
32043 0 : return result;
32044 : }
32045 0 : analysis->diagd.ptr.p_double[cols0+j] = 1.0;
32046 0 : v = 1/ae_sqrt(v, _state);
32047 0 : for(k=j; k<=blocksize+offdiagsize-1; k++)
32048 : {
32049 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v*analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
32050 : }
32051 : }
32052 : }
32053 : }
32054 : else
32055 : {
32056 :
32057 : /*
32058 : * LDLT with diagonal D
32059 : */
32060 0 : for(j=0; j<=blocksize-1; j++)
32061 : {
32062 :
32063 : /*
32064 : * Compute J-th column
32065 : */
32066 0 : vs = (double)(0);
32067 0 : for(k=j; k<=blocksize+offdiagsize-1; k++)
32068 : {
32069 0 : v = analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
32070 0 : for(i=0; i<=j-1; i++)
32071 : {
32072 0 : v = v-analysis->rowstorage.ptr.p_double[offss+k*sstride+i]*analysis->diagd.ptr.p_double[cols0+i]*analysis->rowstorage.ptr.p_double[offss+j*sstride+i];
32073 : }
32074 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v;
32075 0 : vs = vs+ae_fabs(v, _state);
32076 : }
32077 0 : if( controloverflow&&ae_fp_greater(vs,analysis->modparam1) )
32078 : {
32079 :
32080 : /*
32081 : * Possible failure due to accumulation of numerical errors
32082 : */
32083 0 : result = ae_false;
32084 0 : return result;
32085 : }
32086 :
32087 : /*
32088 : * Handle pivot element
32089 : */
32090 0 : ae_assert(analysis->wrkat.idx.ptr.p_int[analysis->wrkat.ridx.ptr.p_int[cols0+j]]==cols0+j, "FactorizeSupernode: integrity check failed", _state);
32091 0 : possignvraw = possign(analysis->wrkat.vals.ptr.p_double[analysis->wrkat.ridx.ptr.p_int[cols0+j]], _state);
32092 0 : v = analysis->rowstorage.ptr.p_double[offss+j*sstride+j];
32093 0 : if( controlpivot&&ae_fp_less_eq(v/possignvraw,analysis->modparam0) )
32094 : {
32095 :
32096 : /*
32097 : * Basic modified LDLT
32098 : */
32099 0 : v = possignvraw*analysis->modparam0;
32100 0 : analysis->diagd.ptr.p_double[cols0+j] = v;
32101 0 : analysis->rowstorage.ptr.p_double[offss+j*sstride+j] = 1.0;
32102 0 : v = 1/v;
32103 0 : for(k=j+1; k<=blocksize+offdiagsize-1; k++)
32104 : {
32105 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v*analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
32106 : }
32107 : }
32108 : else
32109 : {
32110 :
32111 : /*
32112 : * Unmodified LDLT
32113 : */
32114 0 : if( ae_fp_eq(v,(double)(0)) )
32115 : {
32116 0 : result = ae_false;
32117 0 : return result;
32118 : }
32119 0 : analysis->diagd.ptr.p_double[cols0+j] = v;
32120 0 : v = 1/v;
32121 0 : for(k=j; k<=blocksize+offdiagsize-1; k++)
32122 : {
32123 0 : analysis->rowstorage.ptr.p_double[offss+k*sstride+j] = v*analysis->rowstorage.ptr.p_double[offss+k*sstride+j];
32124 : }
32125 : }
32126 : }
32127 : }
32128 0 : result = ae_true;
32129 0 : return result;
32130 : }
32131 :
32132 :
32133 : /*************************************************************************
32134 : This function returns recommended stride for given row size
32135 :
32136 : -- ALGLIB routine --
32137 : 20.10.2020
32138 : Bochkanov Sergey
32139 : *************************************************************************/
32140 0 : static ae_int_t spchol_recommendedstridefor(ae_int_t rowsize,
32141 : ae_state *_state)
32142 : {
32143 : ae_int_t result;
32144 :
32145 :
32146 0 : result = rowsize;
32147 0 : if( rowsize==3 )
32148 : {
32149 0 : result = 4;
32150 : }
32151 0 : return result;
32152 : }
32153 :
32154 :
32155 : /*************************************************************************
32156 : This function aligns position in array in order to better accommodate to
32157 : SIMD specifics.
32158 :
32159 : NOTE: this function aligns position measured in double precision numbers,
32160 : not in bits or bytes. If you want to have 256-bit aligned position,
32161 : round Offs to nearest multiple of 4 that is not less than Offs.
32162 :
32163 : -- ALGLIB routine --
32164 : 20.10.2020
32165 : Bochkanov Sergey
32166 : *************************************************************************/
32167 0 : static ae_int_t spchol_alignpositioninarray(ae_int_t offs,
32168 : ae_state *_state)
32169 : {
32170 : ae_int_t result;
32171 :
32172 :
32173 0 : result = offs;
32174 0 : if( offs%4!=0 )
32175 : {
32176 0 : result = result+(4-offs%4);
32177 : }
32178 0 : return result;
32179 : }
32180 :
32181 :
32182 : /*************************************************************************
32183 : Fast kernels for small supernodal updates: special 4x4x4x4 function.
32184 :
32185 : ! See comments on UpdateSupernode() for information on generic supernodal
32186 : ! updates, including notation used below.
32187 :
32188 : The generic update has following form:
32189 :
32190 : S := S - scatter(U*D*Uc')
32191 :
32192 : This specialized function performs 4x4x4x4 update, i.e.:
32193 : * S is a tHeight*4 matrix
32194 : * U is a uHeight*4 matrix
32195 : * Uc' is a 4*4 matrix
32196 : * scatter() scatters rows of U*Uc', but does not scatter columns (they are
32197 : densely packed).
32198 :
32199 : Return value:
32200 : * True if update was applied
32201 : * False if kernel refused to perform an update.
32202 :
32203 : -- ALGLIB routine --
32204 : 20.09.2020
32205 : Bochkanov Sergey
32206 : *************************************************************************/
32207 0 : static ae_bool spchol_updatekernel4444(/* Real */ ae_vector* rowstorage,
32208 : ae_int_t offss,
32209 : ae_int_t offsu,
32210 : ae_int_t uheight,
32211 : /* Real */ ae_vector* diagd,
32212 : ae_int_t offsd,
32213 : /* Integer */ ae_vector* raw2smap,
32214 : /* Integer */ ae_vector* superrowidx,
32215 : ae_int_t urbase,
32216 : ae_state *_state)
32217 : {
32218 : ae_int_t k;
32219 : ae_int_t targetrow;
32220 : ae_int_t offsk;
32221 : double d0;
32222 : double d1;
32223 : double d2;
32224 : double d3;
32225 : double u00;
32226 : double u01;
32227 : double u02;
32228 : double u03;
32229 : double u10;
32230 : double u11;
32231 : double u12;
32232 : double u13;
32233 : double u20;
32234 : double u21;
32235 : double u22;
32236 : double u23;
32237 : double u30;
32238 : double u31;
32239 : double u32;
32240 : double u33;
32241 : double uk0;
32242 : double uk1;
32243 : double uk2;
32244 : double uk3;
32245 : ae_bool result;
32246 :
32247 :
32248 0 : d0 = diagd->ptr.p_double[offsd+0];
32249 0 : d1 = diagd->ptr.p_double[offsd+1];
32250 0 : d2 = diagd->ptr.p_double[offsd+2];
32251 0 : d3 = diagd->ptr.p_double[offsd+3];
32252 0 : u00 = d0*rowstorage->ptr.p_double[offsu+0*4+0];
32253 0 : u01 = d1*rowstorage->ptr.p_double[offsu+0*4+1];
32254 0 : u02 = d2*rowstorage->ptr.p_double[offsu+0*4+2];
32255 0 : u03 = d3*rowstorage->ptr.p_double[offsu+0*4+3];
32256 0 : u10 = d0*rowstorage->ptr.p_double[offsu+1*4+0];
32257 0 : u11 = d1*rowstorage->ptr.p_double[offsu+1*4+1];
32258 0 : u12 = d2*rowstorage->ptr.p_double[offsu+1*4+2];
32259 0 : u13 = d3*rowstorage->ptr.p_double[offsu+1*4+3];
32260 0 : u20 = d0*rowstorage->ptr.p_double[offsu+2*4+0];
32261 0 : u21 = d1*rowstorage->ptr.p_double[offsu+2*4+1];
32262 0 : u22 = d2*rowstorage->ptr.p_double[offsu+2*4+2];
32263 0 : u23 = d3*rowstorage->ptr.p_double[offsu+2*4+3];
32264 0 : u30 = d0*rowstorage->ptr.p_double[offsu+3*4+0];
32265 0 : u31 = d1*rowstorage->ptr.p_double[offsu+3*4+1];
32266 0 : u32 = d2*rowstorage->ptr.p_double[offsu+3*4+2];
32267 0 : u33 = d3*rowstorage->ptr.p_double[offsu+3*4+3];
32268 0 : for(k=0; k<=uheight-1; k++)
32269 : {
32270 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*4;
32271 0 : offsk = offsu+k*4;
32272 0 : uk0 = rowstorage->ptr.p_double[offsk+0];
32273 0 : uk1 = rowstorage->ptr.p_double[offsk+1];
32274 0 : uk2 = rowstorage->ptr.p_double[offsk+2];
32275 0 : uk3 = rowstorage->ptr.p_double[offsk+3];
32276 0 : rowstorage->ptr.p_double[targetrow+0] = rowstorage->ptr.p_double[targetrow+0]-u00*uk0-u01*uk1-u02*uk2-u03*uk3;
32277 0 : rowstorage->ptr.p_double[targetrow+1] = rowstorage->ptr.p_double[targetrow+1]-u10*uk0-u11*uk1-u12*uk2-u13*uk3;
32278 0 : rowstorage->ptr.p_double[targetrow+2] = rowstorage->ptr.p_double[targetrow+2]-u20*uk0-u21*uk1-u22*uk2-u23*uk3;
32279 0 : rowstorage->ptr.p_double[targetrow+3] = rowstorage->ptr.p_double[targetrow+3]-u30*uk0-u31*uk1-u32*uk2-u33*uk3;
32280 : }
32281 0 : result = ae_true;
32282 0 : return result;
32283 : }
32284 :
32285 :
32286 : /*************************************************************************
32287 : Fast kernels for small supernodal updates: special 4x4x4x4 function.
32288 :
32289 : ! See comments on UpdateSupernode() for information on generic supernodal
32290 : ! updates, including notation used below.
32291 :
32292 : The generic update has following form:
32293 :
32294 : S := S - scatter(U*D*Uc')
32295 :
32296 : This specialized function performs AxBxCx4 update, i.e.:
32297 : * S is a tHeight*A matrix with row stride equal to 4 (usually it means that
32298 : it has 3 or 4 columns)
32299 : * U is a uHeight*B matrix
32300 : * Uc' is a B*C matrix, with C<=A
32301 : * scatter() scatters rows and columns of U*Uc'
32302 :
32303 : Return value:
32304 : * True if update was applied
32305 : * False if kernel refused to perform an update (quick exit for unsupported
32306 : combinations of input sizes)
32307 :
32308 : -- ALGLIB routine --
32309 : 20.09.2020
32310 : Bochkanov Sergey
32311 : *************************************************************************/
32312 0 : static ae_bool spchol_updatekernelabc4(/* Real */ ae_vector* rowstorage,
32313 : ae_int_t offss,
32314 : ae_int_t twidth,
32315 : ae_int_t offsu,
32316 : ae_int_t uheight,
32317 : ae_int_t urank,
32318 : ae_int_t urowstride,
32319 : ae_int_t uwidth,
32320 : /* Real */ ae_vector* diagd,
32321 : ae_int_t offsd,
32322 : /* Integer */ ae_vector* raw2smap,
32323 : /* Integer */ ae_vector* superrowidx,
32324 : ae_int_t urbase,
32325 : ae_state *_state)
32326 : {
32327 : ae_int_t k;
32328 : ae_int_t targetrow;
32329 : ae_int_t targetcol;
32330 : ae_int_t offsk;
32331 : double d0;
32332 : double d1;
32333 : double d2;
32334 : double d3;
32335 : double u00;
32336 : double u01;
32337 : double u02;
32338 : double u03;
32339 : double u10;
32340 : double u11;
32341 : double u12;
32342 : double u13;
32343 : double u20;
32344 : double u21;
32345 : double u22;
32346 : double u23;
32347 : double u30;
32348 : double u31;
32349 : double u32;
32350 : double u33;
32351 : double uk0;
32352 : double uk1;
32353 : double uk2;
32354 : double uk3;
32355 : ae_int_t srccol0;
32356 : ae_int_t srccol1;
32357 : ae_int_t srccol2;
32358 : ae_int_t srccol3;
32359 : ae_bool result;
32360 :
32361 :
32362 :
32363 : /*
32364 : * Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
32365 : */
32366 0 : result = ae_false;
32367 0 : if( twidth<3||twidth>4 )
32368 : {
32369 0 : return result;
32370 : }
32371 0 : if( uwidth<3||uwidth>4 )
32372 : {
32373 0 : return result;
32374 : }
32375 0 : if( urank>4 )
32376 : {
32377 0 : return result;
32378 : }
32379 :
32380 : /*
32381 : * Determine source columns for target columns, -1 if target column
32382 : * is not updated.
32383 : */
32384 0 : srccol0 = -1;
32385 0 : srccol1 = -1;
32386 0 : srccol2 = -1;
32387 0 : srccol3 = -1;
32388 0 : for(k=0; k<=uwidth-1; k++)
32389 : {
32390 0 : targetcol = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]];
32391 0 : if( targetcol==0 )
32392 : {
32393 0 : srccol0 = k;
32394 : }
32395 0 : if( targetcol==1 )
32396 : {
32397 0 : srccol1 = k;
32398 : }
32399 0 : if( targetcol==2 )
32400 : {
32401 0 : srccol2 = k;
32402 : }
32403 0 : if( targetcol==3 )
32404 : {
32405 0 : srccol3 = k;
32406 : }
32407 : }
32408 :
32409 : /*
32410 : * Load update matrix into aligned/rearranged 4x4 storage
32411 : */
32412 0 : d0 = (double)(0);
32413 0 : d1 = (double)(0);
32414 0 : d2 = (double)(0);
32415 0 : d3 = (double)(0);
32416 0 : u00 = (double)(0);
32417 0 : u01 = (double)(0);
32418 0 : u02 = (double)(0);
32419 0 : u03 = (double)(0);
32420 0 : u10 = (double)(0);
32421 0 : u11 = (double)(0);
32422 0 : u12 = (double)(0);
32423 0 : u13 = (double)(0);
32424 0 : u20 = (double)(0);
32425 0 : u21 = (double)(0);
32426 0 : u22 = (double)(0);
32427 0 : u23 = (double)(0);
32428 0 : u30 = (double)(0);
32429 0 : u31 = (double)(0);
32430 0 : u32 = (double)(0);
32431 0 : u33 = (double)(0);
32432 0 : if( urank>=1 )
32433 : {
32434 0 : d0 = diagd->ptr.p_double[offsd+0];
32435 : }
32436 0 : if( urank>=2 )
32437 : {
32438 0 : d1 = diagd->ptr.p_double[offsd+1];
32439 : }
32440 0 : if( urank>=3 )
32441 : {
32442 0 : d2 = diagd->ptr.p_double[offsd+2];
32443 : }
32444 0 : if( urank>=4 )
32445 : {
32446 0 : d3 = diagd->ptr.p_double[offsd+3];
32447 : }
32448 0 : if( srccol0>=0 )
32449 : {
32450 0 : if( urank>=1 )
32451 : {
32452 0 : u00 = d0*rowstorage->ptr.p_double[offsu+srccol0*urowstride+0];
32453 : }
32454 0 : if( urank>=2 )
32455 : {
32456 0 : u01 = d1*rowstorage->ptr.p_double[offsu+srccol0*urowstride+1];
32457 : }
32458 0 : if( urank>=3 )
32459 : {
32460 0 : u02 = d2*rowstorage->ptr.p_double[offsu+srccol0*urowstride+2];
32461 : }
32462 0 : if( urank>=4 )
32463 : {
32464 0 : u03 = d3*rowstorage->ptr.p_double[offsu+srccol0*urowstride+3];
32465 : }
32466 : }
32467 0 : if( srccol1>=0 )
32468 : {
32469 0 : if( urank>=1 )
32470 : {
32471 0 : u10 = d0*rowstorage->ptr.p_double[offsu+srccol1*urowstride+0];
32472 : }
32473 0 : if( urank>=2 )
32474 : {
32475 0 : u11 = d1*rowstorage->ptr.p_double[offsu+srccol1*urowstride+1];
32476 : }
32477 0 : if( urank>=3 )
32478 : {
32479 0 : u12 = d2*rowstorage->ptr.p_double[offsu+srccol1*urowstride+2];
32480 : }
32481 0 : if( urank>=4 )
32482 : {
32483 0 : u13 = d3*rowstorage->ptr.p_double[offsu+srccol1*urowstride+3];
32484 : }
32485 : }
32486 0 : if( srccol2>=0 )
32487 : {
32488 0 : if( urank>=1 )
32489 : {
32490 0 : u20 = d0*rowstorage->ptr.p_double[offsu+srccol2*urowstride+0];
32491 : }
32492 0 : if( urank>=2 )
32493 : {
32494 0 : u21 = d1*rowstorage->ptr.p_double[offsu+srccol2*urowstride+1];
32495 : }
32496 0 : if( urank>=3 )
32497 : {
32498 0 : u22 = d2*rowstorage->ptr.p_double[offsu+srccol2*urowstride+2];
32499 : }
32500 0 : if( urank>=4 )
32501 : {
32502 0 : u23 = d3*rowstorage->ptr.p_double[offsu+srccol2*urowstride+3];
32503 : }
32504 : }
32505 0 : if( srccol3>=0 )
32506 : {
32507 0 : if( urank>=1 )
32508 : {
32509 0 : u30 = d0*rowstorage->ptr.p_double[offsu+srccol3*urowstride+0];
32510 : }
32511 0 : if( urank>=2 )
32512 : {
32513 0 : u31 = d1*rowstorage->ptr.p_double[offsu+srccol3*urowstride+1];
32514 : }
32515 0 : if( urank>=3 )
32516 : {
32517 0 : u32 = d2*rowstorage->ptr.p_double[offsu+srccol3*urowstride+2];
32518 : }
32519 0 : if( urank>=4 )
32520 : {
32521 0 : u33 = d3*rowstorage->ptr.p_double[offsu+srccol3*urowstride+3];
32522 : }
32523 : }
32524 :
32525 : /*
32526 : * Run update
32527 : */
32528 0 : if( urank==1 )
32529 : {
32530 0 : for(k=0; k<=uheight-1; k++)
32531 : {
32532 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*4;
32533 0 : offsk = offsu+k*urowstride;
32534 0 : uk0 = rowstorage->ptr.p_double[offsk+0];
32535 0 : rowstorage->ptr.p_double[targetrow+0] = rowstorage->ptr.p_double[targetrow+0]-u00*uk0;
32536 0 : rowstorage->ptr.p_double[targetrow+1] = rowstorage->ptr.p_double[targetrow+1]-u10*uk0;
32537 0 : rowstorage->ptr.p_double[targetrow+2] = rowstorage->ptr.p_double[targetrow+2]-u20*uk0;
32538 0 : rowstorage->ptr.p_double[targetrow+3] = rowstorage->ptr.p_double[targetrow+3]-u30*uk0;
32539 : }
32540 : }
32541 0 : if( urank==2 )
32542 : {
32543 0 : for(k=0; k<=uheight-1; k++)
32544 : {
32545 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*4;
32546 0 : offsk = offsu+k*urowstride;
32547 0 : uk0 = rowstorage->ptr.p_double[offsk+0];
32548 0 : uk1 = rowstorage->ptr.p_double[offsk+1];
32549 0 : rowstorage->ptr.p_double[targetrow+0] = rowstorage->ptr.p_double[targetrow+0]-u00*uk0-u01*uk1;
32550 0 : rowstorage->ptr.p_double[targetrow+1] = rowstorage->ptr.p_double[targetrow+1]-u10*uk0-u11*uk1;
32551 0 : rowstorage->ptr.p_double[targetrow+2] = rowstorage->ptr.p_double[targetrow+2]-u20*uk0-u21*uk1;
32552 0 : rowstorage->ptr.p_double[targetrow+3] = rowstorage->ptr.p_double[targetrow+3]-u30*uk0-u31*uk1;
32553 : }
32554 : }
32555 0 : if( urank==3 )
32556 : {
32557 0 : for(k=0; k<=uheight-1; k++)
32558 : {
32559 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*4;
32560 0 : offsk = offsu+k*urowstride;
32561 0 : uk0 = rowstorage->ptr.p_double[offsk+0];
32562 0 : uk1 = rowstorage->ptr.p_double[offsk+1];
32563 0 : uk2 = rowstorage->ptr.p_double[offsk+2];
32564 0 : rowstorage->ptr.p_double[targetrow+0] = rowstorage->ptr.p_double[targetrow+0]-u00*uk0-u01*uk1-u02*uk2;
32565 0 : rowstorage->ptr.p_double[targetrow+1] = rowstorage->ptr.p_double[targetrow+1]-u10*uk0-u11*uk1-u12*uk2;
32566 0 : rowstorage->ptr.p_double[targetrow+2] = rowstorage->ptr.p_double[targetrow+2]-u20*uk0-u21*uk1-u22*uk2;
32567 0 : rowstorage->ptr.p_double[targetrow+3] = rowstorage->ptr.p_double[targetrow+3]-u30*uk0-u31*uk1-u32*uk2;
32568 : }
32569 : }
32570 0 : if( urank==4 )
32571 : {
32572 0 : for(k=0; k<=uheight-1; k++)
32573 : {
32574 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*4;
32575 0 : offsk = offsu+k*urowstride;
32576 0 : uk0 = rowstorage->ptr.p_double[offsk+0];
32577 0 : uk1 = rowstorage->ptr.p_double[offsk+1];
32578 0 : uk2 = rowstorage->ptr.p_double[offsk+2];
32579 0 : uk3 = rowstorage->ptr.p_double[offsk+3];
32580 0 : rowstorage->ptr.p_double[targetrow+0] = rowstorage->ptr.p_double[targetrow+0]-u00*uk0-u01*uk1-u02*uk2-u03*uk3;
32581 0 : rowstorage->ptr.p_double[targetrow+1] = rowstorage->ptr.p_double[targetrow+1]-u10*uk0-u11*uk1-u12*uk2-u13*uk3;
32582 0 : rowstorage->ptr.p_double[targetrow+2] = rowstorage->ptr.p_double[targetrow+2]-u20*uk0-u21*uk1-u22*uk2-u23*uk3;
32583 0 : rowstorage->ptr.p_double[targetrow+3] = rowstorage->ptr.p_double[targetrow+3]-u30*uk0-u31*uk1-u32*uk2-u33*uk3;
32584 : }
32585 : }
32586 0 : result = ae_true;
32587 0 : return result;
32588 : }
32589 :
32590 :
32591 : /*************************************************************************
32592 : Fast kernels for small supernodal updates: special rank-1 function.
32593 :
32594 : ! See comments on UpdateSupernode() for information on generic supernodal
32595 : ! updates, including notation used below.
32596 :
32597 : The generic update has following form:
32598 :
32599 : S := S - scatter(U*D*Uc')
32600 :
32601 : This specialized function performs rank-1 update, i.e.:
32602 : * S is a tHeight*A matrix, with A<=4
32603 : * U is a uHeight*1 matrix with unit stride
32604 : * Uc' is a 1*B matrix, with B<=A
32605 : * scatter() scatters rows and columns of U*Uc'
32606 :
32607 : Return value:
32608 : * True if update was applied
32609 : * False if kernel refused to perform an update (quick exit for unsupported
32610 : combinations of input sizes)
32611 :
32612 : -- ALGLIB routine --
32613 : 20.09.2020
32614 : Bochkanov Sergey
32615 : *************************************************************************/
32616 0 : static ae_bool spchol_updatekernelrank1(/* Real */ ae_vector* rowstorage,
32617 : ae_int_t offss,
32618 : ae_int_t twidth,
32619 : ae_int_t trowstride,
32620 : ae_int_t offsu,
32621 : ae_int_t uheight,
32622 : ae_int_t uwidth,
32623 : /* Real */ ae_vector* diagd,
32624 : ae_int_t offsd,
32625 : /* Integer */ ae_vector* raw2smap,
32626 : /* Integer */ ae_vector* superrowidx,
32627 : ae_int_t urbase,
32628 : ae_state *_state)
32629 : {
32630 : ae_int_t k;
32631 : ae_int_t targetrow;
32632 : double d0;
32633 : double u00;
32634 : double u10;
32635 : double u20;
32636 : double u30;
32637 : double uk;
32638 : ae_int_t col0;
32639 : ae_int_t col1;
32640 : ae_int_t col2;
32641 : ae_int_t col3;
32642 : ae_bool result;
32643 :
32644 :
32645 :
32646 : /*
32647 : * Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
32648 : */
32649 0 : result = ae_false;
32650 0 : if( twidth>4 )
32651 : {
32652 0 : return result;
32653 : }
32654 0 : if( uwidth>4 )
32655 : {
32656 0 : return result;
32657 : }
32658 :
32659 : /*
32660 : * Determine target columns, load update matrix
32661 : */
32662 0 : d0 = diagd->ptr.p_double[offsd];
32663 0 : col0 = 0;
32664 0 : col1 = 0;
32665 0 : col2 = 0;
32666 0 : col3 = 0;
32667 0 : u00 = (double)(0);
32668 0 : u10 = (double)(0);
32669 0 : u20 = (double)(0);
32670 0 : u30 = (double)(0);
32671 0 : if( uwidth>=1 )
32672 : {
32673 0 : col0 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+0]];
32674 0 : u00 = d0*rowstorage->ptr.p_double[offsu+0];
32675 : }
32676 0 : if( uwidth>=2 )
32677 : {
32678 0 : col1 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+1]];
32679 0 : u10 = d0*rowstorage->ptr.p_double[offsu+1];
32680 : }
32681 0 : if( uwidth>=3 )
32682 : {
32683 0 : col2 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+2]];
32684 0 : u20 = d0*rowstorage->ptr.p_double[offsu+2];
32685 : }
32686 0 : if( uwidth>=4 )
32687 : {
32688 0 : col3 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+3]];
32689 0 : u30 = d0*rowstorage->ptr.p_double[offsu+3];
32690 : }
32691 :
32692 : /*
32693 : * Run update
32694 : */
32695 0 : if( uwidth==1 )
32696 : {
32697 0 : for(k=0; k<=uheight-1; k++)
32698 : {
32699 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32700 0 : uk = rowstorage->ptr.p_double[offsu+k];
32701 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk;
32702 : }
32703 : }
32704 0 : if( uwidth==2 )
32705 : {
32706 0 : for(k=0; k<=uheight-1; k++)
32707 : {
32708 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32709 0 : uk = rowstorage->ptr.p_double[offsu+k];
32710 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk;
32711 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk;
32712 : }
32713 : }
32714 0 : if( uwidth==3 )
32715 : {
32716 0 : for(k=0; k<=uheight-1; k++)
32717 : {
32718 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32719 0 : uk = rowstorage->ptr.p_double[offsu+k];
32720 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk;
32721 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk;
32722 0 : rowstorage->ptr.p_double[targetrow+col2] = rowstorage->ptr.p_double[targetrow+col2]-u20*uk;
32723 : }
32724 : }
32725 0 : if( uwidth==4 )
32726 : {
32727 0 : for(k=0; k<=uheight-1; k++)
32728 : {
32729 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32730 0 : uk = rowstorage->ptr.p_double[offsu+k];
32731 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk;
32732 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk;
32733 0 : rowstorage->ptr.p_double[targetrow+col2] = rowstorage->ptr.p_double[targetrow+col2]-u20*uk;
32734 0 : rowstorage->ptr.p_double[targetrow+col3] = rowstorage->ptr.p_double[targetrow+col3]-u30*uk;
32735 : }
32736 : }
32737 0 : result = ae_true;
32738 0 : return result;
32739 : }
32740 :
32741 :
32742 : /*************************************************************************
32743 : Fast kernels for small supernodal updates: special rank-2 function.
32744 :
32745 : ! See comments on UpdateSupernode() for information on generic supernodal
32746 : ! updates, including notation used below.
32747 :
32748 : The generic update has following form:
32749 :
32750 : S := S - scatter(U*D*Uc')
32751 :
32752 : This specialized function performs rank-2 update, i.e.:
32753 : * S is a tHeight*A matrix, with A<=4
32754 : * U is a uHeight*2 matrix with row stride equal to 2
32755 : * Uc' is a 2*B matrix, with B<=A
32756 : * scatter() scatters rows and columns of U*Uc
32757 :
32758 : Return value:
32759 : * True if update was applied
32760 : * False if kernel refused to perform an update (quick exit for unsupported
32761 : combinations of input sizes)
32762 :
32763 : -- ALGLIB routine --
32764 : 20.09.2020
32765 : Bochkanov Sergey
32766 : *************************************************************************/
32767 0 : static ae_bool spchol_updatekernelrank2(/* Real */ ae_vector* rowstorage,
32768 : ae_int_t offss,
32769 : ae_int_t twidth,
32770 : ae_int_t trowstride,
32771 : ae_int_t offsu,
32772 : ae_int_t uheight,
32773 : ae_int_t uwidth,
32774 : /* Real */ ae_vector* diagd,
32775 : ae_int_t offsd,
32776 : /* Integer */ ae_vector* raw2smap,
32777 : /* Integer */ ae_vector* superrowidx,
32778 : ae_int_t urbase,
32779 : ae_state *_state)
32780 : {
32781 : ae_int_t k;
32782 : ae_int_t targetrow;
32783 : double d0;
32784 : double d1;
32785 : double u00;
32786 : double u10;
32787 : double u20;
32788 : double u30;
32789 : double u01;
32790 : double u11;
32791 : double u21;
32792 : double u31;
32793 : double uk0;
32794 : double uk1;
32795 : ae_int_t col0;
32796 : ae_int_t col1;
32797 : ae_int_t col2;
32798 : ae_int_t col3;
32799 : ae_bool result;
32800 :
32801 :
32802 :
32803 : /*
32804 : * Filter out unsupported combinations (ones that are too sparse for the non-SIMD code)
32805 : */
32806 0 : result = ae_false;
32807 0 : if( twidth>4 )
32808 : {
32809 0 : return result;
32810 : }
32811 0 : if( uwidth>4 )
32812 : {
32813 0 : return result;
32814 : }
32815 :
32816 : /*
32817 : * Determine target columns, load update matrix
32818 : */
32819 0 : d0 = diagd->ptr.p_double[offsd];
32820 0 : d1 = diagd->ptr.p_double[offsd+1];
32821 0 : col0 = 0;
32822 0 : col1 = 0;
32823 0 : col2 = 0;
32824 0 : col3 = 0;
32825 0 : u00 = (double)(0);
32826 0 : u01 = (double)(0);
32827 0 : u10 = (double)(0);
32828 0 : u11 = (double)(0);
32829 0 : u20 = (double)(0);
32830 0 : u21 = (double)(0);
32831 0 : u30 = (double)(0);
32832 0 : u31 = (double)(0);
32833 0 : if( uwidth>=1 )
32834 : {
32835 0 : col0 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+0]];
32836 0 : u00 = d0*rowstorage->ptr.p_double[offsu+0];
32837 0 : u01 = d1*rowstorage->ptr.p_double[offsu+1];
32838 : }
32839 0 : if( uwidth>=2 )
32840 : {
32841 0 : col1 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+1]];
32842 0 : u10 = d0*rowstorage->ptr.p_double[offsu+1*2+0];
32843 0 : u11 = d1*rowstorage->ptr.p_double[offsu+1*2+1];
32844 : }
32845 0 : if( uwidth>=3 )
32846 : {
32847 0 : col2 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+2]];
32848 0 : u20 = d0*rowstorage->ptr.p_double[offsu+2*2+0];
32849 0 : u21 = d1*rowstorage->ptr.p_double[offsu+2*2+1];
32850 : }
32851 0 : if( uwidth>=4 )
32852 : {
32853 0 : col3 = raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+3]];
32854 0 : u30 = d0*rowstorage->ptr.p_double[offsu+3*2+0];
32855 0 : u31 = d1*rowstorage->ptr.p_double[offsu+3*2+1];
32856 : }
32857 :
32858 : /*
32859 : * Run update
32860 : */
32861 0 : if( uwidth==1 )
32862 : {
32863 0 : for(k=0; k<=uheight-1; k++)
32864 : {
32865 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32866 0 : uk0 = rowstorage->ptr.p_double[offsu+2*k+0];
32867 0 : uk1 = rowstorage->ptr.p_double[offsu+2*k+1];
32868 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk0-u01*uk1;
32869 : }
32870 : }
32871 0 : if( uwidth==2 )
32872 : {
32873 0 : for(k=0; k<=uheight-1; k++)
32874 : {
32875 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32876 0 : uk0 = rowstorage->ptr.p_double[offsu+2*k+0];
32877 0 : uk1 = rowstorage->ptr.p_double[offsu+2*k+1];
32878 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk0-u01*uk1;
32879 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk0-u11*uk1;
32880 : }
32881 : }
32882 0 : if( uwidth==3 )
32883 : {
32884 0 : for(k=0; k<=uheight-1; k++)
32885 : {
32886 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32887 0 : uk0 = rowstorage->ptr.p_double[offsu+2*k+0];
32888 0 : uk1 = rowstorage->ptr.p_double[offsu+2*k+1];
32889 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk0-u01*uk1;
32890 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk0-u11*uk1;
32891 0 : rowstorage->ptr.p_double[targetrow+col2] = rowstorage->ptr.p_double[targetrow+col2]-u20*uk0-u21*uk1;
32892 : }
32893 : }
32894 0 : if( uwidth==4 )
32895 : {
32896 0 : for(k=0; k<=uheight-1; k++)
32897 : {
32898 0 : targetrow = offss+raw2smap->ptr.p_int[superrowidx->ptr.p_int[urbase+k]]*trowstride;
32899 0 : uk0 = rowstorage->ptr.p_double[offsu+2*k+0];
32900 0 : uk1 = rowstorage->ptr.p_double[offsu+2*k+1];
32901 0 : rowstorage->ptr.p_double[targetrow+col0] = rowstorage->ptr.p_double[targetrow+col0]-u00*uk0-u01*uk1;
32902 0 : rowstorage->ptr.p_double[targetrow+col1] = rowstorage->ptr.p_double[targetrow+col1]-u10*uk0-u11*uk1;
32903 0 : rowstorage->ptr.p_double[targetrow+col2] = rowstorage->ptr.p_double[targetrow+col2]-u20*uk0-u21*uk1;
32904 0 : rowstorage->ptr.p_double[targetrow+col3] = rowstorage->ptr.p_double[targetrow+col3]-u30*uk0-u31*uk1;
32905 : }
32906 : }
32907 0 : result = ae_true;
32908 0 : return result;
32909 : }
32910 :
32911 :
32912 0 : void _spcholanalysis_init(void* _p, ae_state *_state, ae_bool make_automatic)
32913 : {
32914 0 : spcholanalysis *p = (spcholanalysis*)_p;
32915 0 : ae_touch_ptr((void*)p);
32916 0 : ae_vector_init(&p->parentsupernode, 0, DT_INT, _state, make_automatic);
32917 0 : ae_vector_init(&p->supercolrange, 0, DT_INT, _state, make_automatic);
32918 0 : ae_vector_init(&p->superrowridx, 0, DT_INT, _state, make_automatic);
32919 0 : ae_vector_init(&p->superrowidx, 0, DT_INT, _state, make_automatic);
32920 0 : ae_vector_init(&p->fillinperm, 0, DT_INT, _state, make_automatic);
32921 0 : ae_vector_init(&p->invfillinperm, 0, DT_INT, _state, make_automatic);
32922 0 : ae_vector_init(&p->superperm, 0, DT_INT, _state, make_automatic);
32923 0 : ae_vector_init(&p->invsuperperm, 0, DT_INT, _state, make_automatic);
32924 0 : ae_vector_init(&p->effectiveperm, 0, DT_INT, _state, make_automatic);
32925 0 : ae_vector_init(&p->inveffectiveperm, 0, DT_INT, _state, make_automatic);
32926 0 : ae_vector_init(&p->ladjplusr, 0, DT_INT, _state, make_automatic);
32927 0 : ae_vector_init(&p->ladjplus, 0, DT_INT, _state, make_automatic);
32928 0 : ae_vector_init(&p->outrowcounts, 0, DT_INT, _state, make_automatic);
32929 0 : _sparsematrix_init(&p->wrkat, _state, make_automatic);
32930 0 : ae_vector_init(&p->rowstorage, 0, DT_REAL, _state, make_automatic);
32931 0 : ae_vector_init(&p->rowstrides, 0, DT_INT, _state, make_automatic);
32932 0 : ae_vector_init(&p->rowoffsets, 0, DT_INT, _state, make_automatic);
32933 0 : ae_vector_init(&p->diagd, 0, DT_REAL, _state, make_automatic);
32934 0 : ae_vector_init(&p->wrkrows, 0, DT_INT, _state, make_automatic);
32935 0 : ae_vector_init(&p->flagarray, 0, DT_BOOL, _state, make_automatic);
32936 0 : ae_vector_init(&p->tmpparent, 0, DT_INT, _state, make_automatic);
32937 0 : ae_vector_init(&p->node2supernode, 0, DT_INT, _state, make_automatic);
32938 0 : ae_vector_init(&p->u2smap, 0, DT_INT, _state, make_automatic);
32939 0 : ae_vector_init(&p->raw2smap, 0, DT_INT, _state, make_automatic);
32940 0 : _amdbuffer_init(&p->amdtmp, _state, make_automatic);
32941 0 : ae_vector_init(&p->tmp0, 0, DT_INT, _state, make_automatic);
32942 0 : ae_vector_init(&p->tmp1, 0, DT_INT, _state, make_automatic);
32943 0 : ae_vector_init(&p->tmp2, 0, DT_INT, _state, make_automatic);
32944 0 : ae_vector_init(&p->tmp3, 0, DT_INT, _state, make_automatic);
32945 0 : ae_vector_init(&p->tmp4, 0, DT_INT, _state, make_automatic);
32946 0 : _sparsematrix_init(&p->tmpa, _state, make_automatic);
32947 0 : }
32948 :
32949 :
32950 0 : void _spcholanalysis_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
32951 : {
32952 0 : spcholanalysis *dst = (spcholanalysis*)_dst;
32953 0 : spcholanalysis *src = (spcholanalysis*)_src;
32954 0 : dst->tasktype = src->tasktype;
32955 0 : dst->n = src->n;
32956 0 : dst->permtype = src->permtype;
32957 0 : dst->unitd = src->unitd;
32958 0 : dst->modtype = src->modtype;
32959 0 : dst->modparam0 = src->modparam0;
32960 0 : dst->modparam1 = src->modparam1;
32961 0 : dst->modparam2 = src->modparam2;
32962 0 : dst->modparam3 = src->modparam3;
32963 0 : dst->extendeddebug = src->extendeddebug;
32964 0 : dst->dotrace = src->dotrace;
32965 0 : dst->nsuper = src->nsuper;
32966 0 : ae_vector_init_copy(&dst->parentsupernode, &src->parentsupernode, _state, make_automatic);
32967 0 : ae_vector_init_copy(&dst->supercolrange, &src->supercolrange, _state, make_automatic);
32968 0 : ae_vector_init_copy(&dst->superrowridx, &src->superrowridx, _state, make_automatic);
32969 0 : ae_vector_init_copy(&dst->superrowidx, &src->superrowidx, _state, make_automatic);
32970 0 : ae_vector_init_copy(&dst->fillinperm, &src->fillinperm, _state, make_automatic);
32971 0 : ae_vector_init_copy(&dst->invfillinperm, &src->invfillinperm, _state, make_automatic);
32972 0 : ae_vector_init_copy(&dst->superperm, &src->superperm, _state, make_automatic);
32973 0 : ae_vector_init_copy(&dst->invsuperperm, &src->invsuperperm, _state, make_automatic);
32974 0 : ae_vector_init_copy(&dst->effectiveperm, &src->effectiveperm, _state, make_automatic);
32975 0 : ae_vector_init_copy(&dst->inveffectiveperm, &src->inveffectiveperm, _state, make_automatic);
32976 0 : dst->istopologicalordering = src->istopologicalordering;
32977 0 : dst->applypermutationtooutput = src->applypermutationtooutput;
32978 0 : ae_vector_init_copy(&dst->ladjplusr, &src->ladjplusr, _state, make_automatic);
32979 0 : ae_vector_init_copy(&dst->ladjplus, &src->ladjplus, _state, make_automatic);
32980 0 : ae_vector_init_copy(&dst->outrowcounts, &src->outrowcounts, _state, make_automatic);
32981 0 : _sparsematrix_init_copy(&dst->wrkat, &src->wrkat, _state, make_automatic);
32982 0 : ae_vector_init_copy(&dst->rowstorage, &src->rowstorage, _state, make_automatic);
32983 0 : ae_vector_init_copy(&dst->rowstrides, &src->rowstrides, _state, make_automatic);
32984 0 : ae_vector_init_copy(&dst->rowoffsets, &src->rowoffsets, _state, make_automatic);
32985 0 : ae_vector_init_copy(&dst->diagd, &src->diagd, _state, make_automatic);
32986 0 : ae_vector_init_copy(&dst->wrkrows, &src->wrkrows, _state, make_automatic);
32987 0 : ae_vector_init_copy(&dst->flagarray, &src->flagarray, _state, make_automatic);
32988 0 : ae_vector_init_copy(&dst->tmpparent, &src->tmpparent, _state, make_automatic);
32989 0 : ae_vector_init_copy(&dst->node2supernode, &src->node2supernode, _state, make_automatic);
32990 0 : ae_vector_init_copy(&dst->u2smap, &src->u2smap, _state, make_automatic);
32991 0 : ae_vector_init_copy(&dst->raw2smap, &src->raw2smap, _state, make_automatic);
32992 0 : _amdbuffer_init_copy(&dst->amdtmp, &src->amdtmp, _state, make_automatic);
32993 0 : ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic);
32994 0 : ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic);
32995 0 : ae_vector_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic);
32996 0 : ae_vector_init_copy(&dst->tmp3, &src->tmp3, _state, make_automatic);
32997 0 : ae_vector_init_copy(&dst->tmp4, &src->tmp4, _state, make_automatic);
32998 0 : _sparsematrix_init_copy(&dst->tmpa, &src->tmpa, _state, make_automatic);
32999 0 : }
33000 :
33001 :
33002 0 : void _spcholanalysis_clear(void* _p)
33003 : {
33004 0 : spcholanalysis *p = (spcholanalysis*)_p;
33005 0 : ae_touch_ptr((void*)p);
33006 0 : ae_vector_clear(&p->parentsupernode);
33007 0 : ae_vector_clear(&p->supercolrange);
33008 0 : ae_vector_clear(&p->superrowridx);
33009 0 : ae_vector_clear(&p->superrowidx);
33010 0 : ae_vector_clear(&p->fillinperm);
33011 0 : ae_vector_clear(&p->invfillinperm);
33012 0 : ae_vector_clear(&p->superperm);
33013 0 : ae_vector_clear(&p->invsuperperm);
33014 0 : ae_vector_clear(&p->effectiveperm);
33015 0 : ae_vector_clear(&p->inveffectiveperm);
33016 0 : ae_vector_clear(&p->ladjplusr);
33017 0 : ae_vector_clear(&p->ladjplus);
33018 0 : ae_vector_clear(&p->outrowcounts);
33019 0 : _sparsematrix_clear(&p->wrkat);
33020 0 : ae_vector_clear(&p->rowstorage);
33021 0 : ae_vector_clear(&p->rowstrides);
33022 0 : ae_vector_clear(&p->rowoffsets);
33023 0 : ae_vector_clear(&p->diagd);
33024 0 : ae_vector_clear(&p->wrkrows);
33025 0 : ae_vector_clear(&p->flagarray);
33026 0 : ae_vector_clear(&p->tmpparent);
33027 0 : ae_vector_clear(&p->node2supernode);
33028 0 : ae_vector_clear(&p->u2smap);
33029 0 : ae_vector_clear(&p->raw2smap);
33030 0 : _amdbuffer_clear(&p->amdtmp);
33031 0 : ae_vector_clear(&p->tmp0);
33032 0 : ae_vector_clear(&p->tmp1);
33033 0 : ae_vector_clear(&p->tmp2);
33034 0 : ae_vector_clear(&p->tmp3);
33035 0 : ae_vector_clear(&p->tmp4);
33036 0 : _sparsematrix_clear(&p->tmpa);
33037 0 : }
33038 :
33039 :
33040 0 : void _spcholanalysis_destroy(void* _p)
33041 : {
33042 0 : spcholanalysis *p = (spcholanalysis*)_p;
33043 0 : ae_touch_ptr((void*)p);
33044 0 : ae_vector_destroy(&p->parentsupernode);
33045 0 : ae_vector_destroy(&p->supercolrange);
33046 0 : ae_vector_destroy(&p->superrowridx);
33047 0 : ae_vector_destroy(&p->superrowidx);
33048 0 : ae_vector_destroy(&p->fillinperm);
33049 0 : ae_vector_destroy(&p->invfillinperm);
33050 0 : ae_vector_destroy(&p->superperm);
33051 0 : ae_vector_destroy(&p->invsuperperm);
33052 0 : ae_vector_destroy(&p->effectiveperm);
33053 0 : ae_vector_destroy(&p->inveffectiveperm);
33054 0 : ae_vector_destroy(&p->ladjplusr);
33055 0 : ae_vector_destroy(&p->ladjplus);
33056 0 : ae_vector_destroy(&p->outrowcounts);
33057 0 : _sparsematrix_destroy(&p->wrkat);
33058 0 : ae_vector_destroy(&p->rowstorage);
33059 0 : ae_vector_destroy(&p->rowstrides);
33060 0 : ae_vector_destroy(&p->rowoffsets);
33061 0 : ae_vector_destroy(&p->diagd);
33062 0 : ae_vector_destroy(&p->wrkrows);
33063 0 : ae_vector_destroy(&p->flagarray);
33064 0 : ae_vector_destroy(&p->tmpparent);
33065 0 : ae_vector_destroy(&p->node2supernode);
33066 0 : ae_vector_destroy(&p->u2smap);
33067 0 : ae_vector_destroy(&p->raw2smap);
33068 0 : _amdbuffer_destroy(&p->amdtmp);
33069 0 : ae_vector_destroy(&p->tmp0);
33070 0 : ae_vector_destroy(&p->tmp1);
33071 0 : ae_vector_destroy(&p->tmp2);
33072 0 : ae_vector_destroy(&p->tmp3);
33073 0 : ae_vector_destroy(&p->tmp4);
33074 0 : _sparsematrix_destroy(&p->tmpa);
33075 0 : }
33076 :
33077 :
33078 : #endif
33079 : #if defined(AE_COMPILE_MATGEN) || !defined(AE_PARTIAL_BUILD)
33080 :
33081 :
33082 : /*************************************************************************
33083 : Generation of a random uniformly distributed (Haar) orthogonal matrix
33084 :
33085 : INPUT PARAMETERS:
33086 : N - matrix size, N>=1
33087 :
33088 : OUTPUT PARAMETERS:
33089 : A - orthogonal NxN matrix, array[0..N-1,0..N-1]
33090 :
33091 : NOTE: this function uses algorithm described in Stewart, G. W. (1980),
33092 : "The Efficient Generation of Random Orthogonal Matrices with an
33093 : Application to Condition Estimators".
33094 :
33095 : Speaking short, to generate an (N+1)x(N+1) orthogonal matrix, it:
33096 : * takes an NxN one
33097 : * takes uniformly distributed unit vector of dimension N+1.
33098 : * constructs a Householder reflection from the vector, then applies
33099 : it to the smaller matrix (embedded in the larger size with a 1 at
33100 : the bottom right corner).
33101 :
33102 : -- ALGLIB routine --
33103 : 04.12.2009
33104 : Bochkanov Sergey
33105 : *************************************************************************/
33106 0 : void rmatrixrndorthogonal(ae_int_t n,
33107 : /* Real */ ae_matrix* a,
33108 : ae_state *_state)
33109 : {
33110 : ae_int_t i;
33111 : ae_int_t j;
33112 :
33113 0 : ae_matrix_clear(a);
33114 :
33115 0 : ae_assert(n>=1, "RMatrixRndOrthogonal: N<1!", _state);
33116 0 : ae_matrix_set_length(a, n, n, _state);
33117 0 : for(i=0; i<=n-1; i++)
33118 : {
33119 0 : for(j=0; j<=n-1; j++)
33120 : {
33121 0 : if( i==j )
33122 : {
33123 0 : a->ptr.pp_double[i][j] = (double)(1);
33124 : }
33125 : else
33126 : {
33127 0 : a->ptr.pp_double[i][j] = (double)(0);
33128 : }
33129 : }
33130 : }
33131 0 : rmatrixrndorthogonalfromtheright(a, n, n, _state);
33132 0 : }
33133 :
33134 :
33135 : /*************************************************************************
33136 : Generation of random NxN matrix with given condition number and norm2(A)=1
33137 :
33138 : INPUT PARAMETERS:
33139 : N - matrix size
33140 : C - condition number (in 2-norm)
33141 :
33142 : OUTPUT PARAMETERS:
33143 : A - random matrix with norm2(A)=1 and cond(A)=C
33144 :
33145 : -- ALGLIB routine --
33146 : 04.12.2009
33147 : Bochkanov Sergey
33148 : *************************************************************************/
33149 0 : void rmatrixrndcond(ae_int_t n,
33150 : double c,
33151 : /* Real */ ae_matrix* a,
33152 : ae_state *_state)
33153 : {
33154 : ae_frame _frame_block;
33155 : ae_int_t i;
33156 : ae_int_t j;
33157 : double l1;
33158 : double l2;
33159 : hqrndstate rs;
33160 :
33161 0 : ae_frame_make(_state, &_frame_block);
33162 0 : memset(&rs, 0, sizeof(rs));
33163 0 : ae_matrix_clear(a);
33164 0 : _hqrndstate_init(&rs, _state, ae_true);
33165 :
33166 0 : ae_assert(n>=1&&ae_fp_greater_eq(c,(double)(1)), "RMatrixRndCond: N<1 or C<1!", _state);
33167 0 : ae_matrix_set_length(a, n, n, _state);
33168 0 : if( n==1 )
33169 : {
33170 :
33171 : /*
33172 : * special case
33173 : */
33174 0 : a->ptr.pp_double[0][0] = (double)(2*ae_randominteger(2, _state)-1);
33175 0 : ae_frame_leave(_state);
33176 0 : return;
33177 : }
33178 0 : hqrndrandomize(&rs, _state);
33179 0 : l1 = (double)(0);
33180 0 : l2 = ae_log(1/c, _state);
33181 0 : for(i=0; i<=n-1; i++)
33182 : {
33183 0 : for(j=0; j<=n-1; j++)
33184 : {
33185 0 : a->ptr.pp_double[i][j] = (double)(0);
33186 : }
33187 : }
33188 0 : a->ptr.pp_double[0][0] = ae_exp(l1, _state);
33189 0 : for(i=1; i<=n-2; i++)
33190 : {
33191 0 : a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state);
33192 : }
33193 0 : a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state);
33194 0 : rmatrixrndorthogonalfromtheleft(a, n, n, _state);
33195 0 : rmatrixrndorthogonalfromtheright(a, n, n, _state);
33196 0 : ae_frame_leave(_state);
33197 : }
33198 :
33199 :
33200 : /*************************************************************************
33201 : Generation of a random Haar distributed orthogonal complex matrix
33202 :
33203 : INPUT PARAMETERS:
33204 : N - matrix size, N>=1
33205 :
33206 : OUTPUT PARAMETERS:
33207 : A - orthogonal NxN matrix, array[0..N-1,0..N-1]
33208 :
33209 : NOTE: this function uses algorithm described in Stewart, G. W. (1980),
33210 : "The Efficient Generation of Random Orthogonal Matrices with an
33211 : Application to Condition Estimators".
33212 :
33213 : Speaking short, to generate an (N+1)x(N+1) orthogonal matrix, it:
33214 : * takes an NxN one
33215 : * takes uniformly distributed unit vector of dimension N+1.
33216 : * constructs a Householder reflection from the vector, then applies
33217 : it to the smaller matrix (embedded in the larger size with a 1 at
33218 : the bottom right corner).
33219 :
33220 : -- ALGLIB routine --
33221 : 04.12.2009
33222 : Bochkanov Sergey
33223 : *************************************************************************/
33224 0 : void cmatrixrndorthogonal(ae_int_t n,
33225 : /* Complex */ ae_matrix* a,
33226 : ae_state *_state)
33227 : {
33228 : ae_int_t i;
33229 : ae_int_t j;
33230 :
33231 0 : ae_matrix_clear(a);
33232 :
33233 0 : ae_assert(n>=1, "CMatrixRndOrthogonal: N<1!", _state);
33234 0 : ae_matrix_set_length(a, n, n, _state);
33235 0 : for(i=0; i<=n-1; i++)
33236 : {
33237 0 : for(j=0; j<=n-1; j++)
33238 : {
33239 0 : if( i==j )
33240 : {
33241 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(1);
33242 : }
33243 : else
33244 : {
33245 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
33246 : }
33247 : }
33248 : }
33249 0 : cmatrixrndorthogonalfromtheright(a, n, n, _state);
33250 0 : }
33251 :
33252 :
33253 : /*************************************************************************
33254 : Generation of random NxN complex matrix with given condition number C and
33255 : norm2(A)=1
33256 :
33257 : INPUT PARAMETERS:
33258 : N - matrix size
33259 : C - condition number (in 2-norm)
33260 :
33261 : OUTPUT PARAMETERS:
33262 : A - random matrix with norm2(A)=1 and cond(A)=C
33263 :
33264 : -- ALGLIB routine --
33265 : 04.12.2009
33266 : Bochkanov Sergey
33267 : *************************************************************************/
33268 0 : void cmatrixrndcond(ae_int_t n,
33269 : double c,
33270 : /* Complex */ ae_matrix* a,
33271 : ae_state *_state)
33272 : {
33273 : ae_frame _frame_block;
33274 : ae_int_t i;
33275 : ae_int_t j;
33276 : double l1;
33277 : double l2;
33278 : hqrndstate state;
33279 : ae_complex v;
33280 :
33281 0 : ae_frame_make(_state, &_frame_block);
33282 0 : memset(&state, 0, sizeof(state));
33283 0 : ae_matrix_clear(a);
33284 0 : _hqrndstate_init(&state, _state, ae_true);
33285 :
33286 0 : ae_assert(n>=1&&ae_fp_greater_eq(c,(double)(1)), "CMatrixRndCond: N<1 or C<1!", _state);
33287 0 : ae_matrix_set_length(a, n, n, _state);
33288 0 : if( n==1 )
33289 : {
33290 :
33291 : /*
33292 : * special case
33293 : */
33294 0 : hqrndrandomize(&state, _state);
33295 0 : hqrndunit2(&state, &v.x, &v.y, _state);
33296 0 : a->ptr.pp_complex[0][0] = v;
33297 0 : ae_frame_leave(_state);
33298 0 : return;
33299 : }
33300 0 : hqrndrandomize(&state, _state);
33301 0 : l1 = (double)(0);
33302 0 : l2 = ae_log(1/c, _state);
33303 0 : for(i=0; i<=n-1; i++)
33304 : {
33305 0 : for(j=0; j<=n-1; j++)
33306 : {
33307 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
33308 : }
33309 : }
33310 0 : a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state));
33311 0 : for(i=1; i<=n-2; i++)
33312 : {
33313 0 : a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&state, _state)*(l2-l1)+l1, _state));
33314 : }
33315 0 : a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state));
33316 0 : cmatrixrndorthogonalfromtheleft(a, n, n, _state);
33317 0 : cmatrixrndorthogonalfromtheright(a, n, n, _state);
33318 0 : ae_frame_leave(_state);
33319 : }
33320 :
33321 :
33322 : /*************************************************************************
33323 : Generation of random NxN symmetric matrix with given condition number and
33324 : norm2(A)=1
33325 :
33326 : INPUT PARAMETERS:
33327 : N - matrix size
33328 : C - condition number (in 2-norm)
33329 :
33330 : OUTPUT PARAMETERS:
33331 : A - random matrix with norm2(A)=1 and cond(A)=C
33332 :
33333 : -- ALGLIB routine --
33334 : 04.12.2009
33335 : Bochkanov Sergey
33336 : *************************************************************************/
33337 0 : void smatrixrndcond(ae_int_t n,
33338 : double c,
33339 : /* Real */ ae_matrix* a,
33340 : ae_state *_state)
33341 : {
33342 : ae_frame _frame_block;
33343 : ae_int_t i;
33344 : ae_int_t j;
33345 : double l1;
33346 : double l2;
33347 : hqrndstate rs;
33348 :
33349 0 : ae_frame_make(_state, &_frame_block);
33350 0 : memset(&rs, 0, sizeof(rs));
33351 0 : ae_matrix_clear(a);
33352 0 : _hqrndstate_init(&rs, _state, ae_true);
33353 :
33354 0 : ae_assert(n>=1&&ae_fp_greater_eq(c,(double)(1)), "SMatrixRndCond: N<1 or C<1!", _state);
33355 0 : ae_matrix_set_length(a, n, n, _state);
33356 0 : if( n==1 )
33357 : {
33358 :
33359 : /*
33360 : * special case
33361 : */
33362 0 : a->ptr.pp_double[0][0] = (double)(2*ae_randominteger(2, _state)-1);
33363 0 : ae_frame_leave(_state);
33364 0 : return;
33365 : }
33366 :
33367 : /*
33368 : * Prepare matrix
33369 : */
33370 0 : hqrndrandomize(&rs, _state);
33371 0 : l1 = (double)(0);
33372 0 : l2 = ae_log(1/c, _state);
33373 0 : for(i=0; i<=n-1; i++)
33374 : {
33375 0 : for(j=0; j<=n-1; j++)
33376 : {
33377 0 : a->ptr.pp_double[i][j] = (double)(0);
33378 : }
33379 : }
33380 0 : a->ptr.pp_double[0][0] = ae_exp(l1, _state);
33381 0 : for(i=1; i<=n-2; i++)
33382 : {
33383 0 : a->ptr.pp_double[i][i] = (2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state);
33384 : }
33385 0 : a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state);
33386 :
33387 : /*
33388 : * Multiply
33389 : */
33390 0 : smatrixrndmultiply(a, n, _state);
33391 0 : ae_frame_leave(_state);
33392 : }
33393 :
33394 :
33395 : /*************************************************************************
33396 : Generation of random NxN symmetric positive definite matrix with given
33397 : condition number and norm2(A)=1
33398 :
33399 : INPUT PARAMETERS:
33400 : N - matrix size
33401 : C - condition number (in 2-norm)
33402 :
33403 : OUTPUT PARAMETERS:
33404 : A - random SPD matrix with norm2(A)=1 and cond(A)=C
33405 :
33406 : -- ALGLIB routine --
33407 : 04.12.2009
33408 : Bochkanov Sergey
33409 : *************************************************************************/
33410 0 : void spdmatrixrndcond(ae_int_t n,
33411 : double c,
33412 : /* Real */ ae_matrix* a,
33413 : ae_state *_state)
33414 : {
33415 : ae_frame _frame_block;
33416 : ae_int_t i;
33417 : ae_int_t j;
33418 : double l1;
33419 : double l2;
33420 : hqrndstate rs;
33421 :
33422 0 : ae_frame_make(_state, &_frame_block);
33423 0 : memset(&rs, 0, sizeof(rs));
33424 0 : ae_matrix_clear(a);
33425 0 : _hqrndstate_init(&rs, _state, ae_true);
33426 :
33427 :
33428 : /*
33429 : * Special cases
33430 : */
33431 0 : if( n<=0||ae_fp_less(c,(double)(1)) )
33432 : {
33433 0 : ae_frame_leave(_state);
33434 0 : return;
33435 : }
33436 0 : ae_matrix_set_length(a, n, n, _state);
33437 0 : if( n==1 )
33438 : {
33439 0 : a->ptr.pp_double[0][0] = (double)(1);
33440 0 : ae_frame_leave(_state);
33441 0 : return;
33442 : }
33443 :
33444 : /*
33445 : * Prepare matrix
33446 : */
33447 0 : hqrndrandomize(&rs, _state);
33448 0 : l1 = (double)(0);
33449 0 : l2 = ae_log(1/c, _state);
33450 0 : for(i=0; i<=n-1; i++)
33451 : {
33452 0 : for(j=0; j<=n-1; j++)
33453 : {
33454 0 : a->ptr.pp_double[i][j] = (double)(0);
33455 : }
33456 : }
33457 0 : a->ptr.pp_double[0][0] = ae_exp(l1, _state);
33458 0 : for(i=1; i<=n-2; i++)
33459 : {
33460 0 : a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state);
33461 : }
33462 0 : a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state);
33463 :
33464 : /*
33465 : * Multiply
33466 : */
33467 0 : smatrixrndmultiply(a, n, _state);
33468 0 : ae_frame_leave(_state);
33469 : }
33470 :
33471 :
33472 : /*************************************************************************
33473 : Generation of random NxN Hermitian matrix with given condition number and
33474 : norm2(A)=1
33475 :
33476 : INPUT PARAMETERS:
33477 : N - matrix size
33478 : C - condition number (in 2-norm)
33479 :
33480 : OUTPUT PARAMETERS:
33481 : A - random matrix with norm2(A)=1 and cond(A)=C
33482 :
33483 : -- ALGLIB routine --
33484 : 04.12.2009
33485 : Bochkanov Sergey
33486 : *************************************************************************/
33487 0 : void hmatrixrndcond(ae_int_t n,
33488 : double c,
33489 : /* Complex */ ae_matrix* a,
33490 : ae_state *_state)
33491 : {
33492 : ae_frame _frame_block;
33493 : ae_int_t i;
33494 : ae_int_t j;
33495 : double l1;
33496 : double l2;
33497 : hqrndstate rs;
33498 :
33499 0 : ae_frame_make(_state, &_frame_block);
33500 0 : memset(&rs, 0, sizeof(rs));
33501 0 : ae_matrix_clear(a);
33502 0 : _hqrndstate_init(&rs, _state, ae_true);
33503 :
33504 0 : ae_assert(n>=1&&ae_fp_greater_eq(c,(double)(1)), "HMatrixRndCond: N<1 or C<1!", _state);
33505 0 : ae_matrix_set_length(a, n, n, _state);
33506 0 : if( n==1 )
33507 : {
33508 :
33509 : /*
33510 : * special case
33511 : */
33512 0 : a->ptr.pp_complex[0][0] = ae_complex_from_i(2*ae_randominteger(2, _state)-1);
33513 0 : ae_frame_leave(_state);
33514 0 : return;
33515 : }
33516 :
33517 : /*
33518 : * Prepare matrix
33519 : */
33520 0 : hqrndrandomize(&rs, _state);
33521 0 : l1 = (double)(0);
33522 0 : l2 = ae_log(1/c, _state);
33523 0 : for(i=0; i<=n-1; i++)
33524 : {
33525 0 : for(j=0; j<=n-1; j++)
33526 : {
33527 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
33528 : }
33529 : }
33530 0 : a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state));
33531 0 : for(i=1; i<=n-2; i++)
33532 : {
33533 0 : a->ptr.pp_complex[i][i] = ae_complex_from_d((2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state));
33534 : }
33535 0 : a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state));
33536 :
33537 : /*
33538 : * Multiply
33539 : */
33540 0 : hmatrixrndmultiply(a, n, _state);
33541 :
33542 : /*
33543 : * post-process to ensure that matrix diagonal is real
33544 : */
33545 0 : for(i=0; i<=n-1; i++)
33546 : {
33547 0 : a->ptr.pp_complex[i][i].y = (double)(0);
33548 : }
33549 0 : ae_frame_leave(_state);
33550 : }
33551 :
33552 :
33553 : /*************************************************************************
33554 : Generation of random NxN Hermitian positive definite matrix with given
33555 : condition number and norm2(A)=1
33556 :
33557 : INPUT PARAMETERS:
33558 : N - matrix size
33559 : C - condition number (in 2-norm)
33560 :
33561 : OUTPUT PARAMETERS:
33562 : A - random HPD matrix with norm2(A)=1 and cond(A)=C
33563 :
33564 : -- ALGLIB routine --
33565 : 04.12.2009
33566 : Bochkanov Sergey
33567 : *************************************************************************/
33568 0 : void hpdmatrixrndcond(ae_int_t n,
33569 : double c,
33570 : /* Complex */ ae_matrix* a,
33571 : ae_state *_state)
33572 : {
33573 : ae_frame _frame_block;
33574 : ae_int_t i;
33575 : ae_int_t j;
33576 : double l1;
33577 : double l2;
33578 : hqrndstate rs;
33579 :
33580 0 : ae_frame_make(_state, &_frame_block);
33581 0 : memset(&rs, 0, sizeof(rs));
33582 0 : ae_matrix_clear(a);
33583 0 : _hqrndstate_init(&rs, _state, ae_true);
33584 :
33585 :
33586 : /*
33587 : * Special cases
33588 : */
33589 0 : if( n<=0||ae_fp_less(c,(double)(1)) )
33590 : {
33591 0 : ae_frame_leave(_state);
33592 0 : return;
33593 : }
33594 0 : ae_matrix_set_length(a, n, n, _state);
33595 0 : if( n==1 )
33596 : {
33597 0 : a->ptr.pp_complex[0][0] = ae_complex_from_i(1);
33598 0 : ae_frame_leave(_state);
33599 0 : return;
33600 : }
33601 :
33602 : /*
33603 : * Prepare matrix
33604 : */
33605 0 : hqrndrandomize(&rs, _state);
33606 0 : l1 = (double)(0);
33607 0 : l2 = ae_log(1/c, _state);
33608 0 : for(i=0; i<=n-1; i++)
33609 : {
33610 0 : for(j=0; j<=n-1; j++)
33611 : {
33612 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
33613 : }
33614 : }
33615 0 : a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state));
33616 0 : for(i=1; i<=n-2; i++)
33617 : {
33618 0 : a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state));
33619 : }
33620 0 : a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state));
33621 :
33622 : /*
33623 : * Multiply
33624 : */
33625 0 : hmatrixrndmultiply(a, n, _state);
33626 :
33627 : /*
33628 : * post-process to ensure that matrix diagonal is real
33629 : */
33630 0 : for(i=0; i<=n-1; i++)
33631 : {
33632 0 : a->ptr.pp_complex[i][i].y = (double)(0);
33633 : }
33634 0 : ae_frame_leave(_state);
33635 : }
33636 :
33637 :
33638 : /*************************************************************************
33639 : Multiplication of MxN matrix by NxN random Haar distributed orthogonal matrix
33640 :
33641 : INPUT PARAMETERS:
33642 : A - matrix, array[0..M-1, 0..N-1]
33643 : M, N- matrix size
33644 :
33645 : OUTPUT PARAMETERS:
33646 : A - A*Q, where Q is random NxN orthogonal matrix
33647 :
33648 : -- ALGLIB routine --
33649 : 04.12.2009
33650 : Bochkanov Sergey
33651 : *************************************************************************/
33652 0 : void rmatrixrndorthogonalfromtheright(/* Real */ ae_matrix* a,
33653 : ae_int_t m,
33654 : ae_int_t n,
33655 : ae_state *_state)
33656 : {
33657 : ae_frame _frame_block;
33658 : double tau;
33659 : double lambdav;
33660 : ae_int_t s;
33661 : ae_int_t i;
33662 : double u1;
33663 : double u2;
33664 : ae_vector w;
33665 : ae_vector v;
33666 : hqrndstate state;
33667 :
33668 0 : ae_frame_make(_state, &_frame_block);
33669 0 : memset(&w, 0, sizeof(w));
33670 0 : memset(&v, 0, sizeof(v));
33671 0 : memset(&state, 0, sizeof(state));
33672 0 : ae_vector_init(&w, 0, DT_REAL, _state, ae_true);
33673 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
33674 0 : _hqrndstate_init(&state, _state, ae_true);
33675 :
33676 0 : ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state);
33677 0 : if( n==1 )
33678 : {
33679 :
33680 : /*
33681 : * Special case
33682 : */
33683 0 : tau = (double)(2*ae_randominteger(2, _state)-1);
33684 0 : for(i=0; i<=m-1; i++)
33685 : {
33686 0 : a->ptr.pp_double[i][0] = a->ptr.pp_double[i][0]*tau;
33687 : }
33688 0 : ae_frame_leave(_state);
33689 0 : return;
33690 : }
33691 :
33692 : /*
33693 : * General case.
33694 : * First pass.
33695 : */
33696 0 : ae_vector_set_length(&w, m, _state);
33697 0 : ae_vector_set_length(&v, n+1, _state);
33698 0 : hqrndrandomize(&state, _state);
33699 0 : for(s=2; s<=n; s++)
33700 : {
33701 :
33702 : /*
33703 : * Prepare random normal v
33704 : */
33705 0 : do
33706 : {
33707 0 : i = 1;
33708 0 : while(i<=s)
33709 : {
33710 0 : hqrndnormal2(&state, &u1, &u2, _state);
33711 0 : v.ptr.p_double[i] = u1;
33712 0 : if( i+1<=s )
33713 : {
33714 0 : v.ptr.p_double[i+1] = u2;
33715 : }
33716 0 : i = i+2;
33717 : }
33718 0 : lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s));
33719 : }
33720 0 : while(ae_fp_eq(lambdav,(double)(0)));
33721 :
33722 : /*
33723 : * Prepare and apply reflection
33724 : */
33725 0 : generatereflection(&v, s, &tau, _state);
33726 0 : v.ptr.p_double[1] = (double)(1);
33727 0 : applyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state);
33728 : }
33729 :
33730 : /*
33731 : * Second pass.
33732 : */
33733 0 : for(i=0; i<=n-1; i++)
33734 : {
33735 0 : tau = (double)(2*hqrnduniformi(&state, 2, _state)-1);
33736 0 : ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,m-1), tau);
33737 : }
33738 0 : ae_frame_leave(_state);
33739 : }
33740 :
33741 :
33742 : /*************************************************************************
33743 : Multiplication of MxN matrix by MxM random Haar distributed orthogonal matrix
33744 :
33745 : INPUT PARAMETERS:
33746 : A - matrix, array[0..M-1, 0..N-1]
33747 : M, N- matrix size
33748 :
33749 : OUTPUT PARAMETERS:
33750 : A - Q*A, where Q is random MxM orthogonal matrix
33751 :
33752 : -- ALGLIB routine --
33753 : 04.12.2009
33754 : Bochkanov Sergey
33755 : *************************************************************************/
33756 0 : void rmatrixrndorthogonalfromtheleft(/* Real */ ae_matrix* a,
33757 : ae_int_t m,
33758 : ae_int_t n,
33759 : ae_state *_state)
33760 : {
33761 : ae_frame _frame_block;
33762 : double tau;
33763 : double lambdav;
33764 : ae_int_t s;
33765 : ae_int_t i;
33766 : ae_int_t j;
33767 : double u1;
33768 : double u2;
33769 : ae_vector w;
33770 : ae_vector v;
33771 : hqrndstate state;
33772 :
33773 0 : ae_frame_make(_state, &_frame_block);
33774 0 : memset(&w, 0, sizeof(w));
33775 0 : memset(&v, 0, sizeof(v));
33776 0 : memset(&state, 0, sizeof(state));
33777 0 : ae_vector_init(&w, 0, DT_REAL, _state, ae_true);
33778 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
33779 0 : _hqrndstate_init(&state, _state, ae_true);
33780 :
33781 0 : ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state);
33782 0 : if( m==1 )
33783 : {
33784 :
33785 : /*
33786 : * special case
33787 : */
33788 0 : tau = (double)(2*ae_randominteger(2, _state)-1);
33789 0 : for(j=0; j<=n-1; j++)
33790 : {
33791 0 : a->ptr.pp_double[0][j] = a->ptr.pp_double[0][j]*tau;
33792 : }
33793 0 : ae_frame_leave(_state);
33794 0 : return;
33795 : }
33796 :
33797 : /*
33798 : * General case.
33799 : * First pass.
33800 : */
33801 0 : ae_vector_set_length(&w, n, _state);
33802 0 : ae_vector_set_length(&v, m+1, _state);
33803 0 : hqrndrandomize(&state, _state);
33804 0 : for(s=2; s<=m; s++)
33805 : {
33806 :
33807 : /*
33808 : * Prepare random normal v
33809 : */
33810 0 : do
33811 : {
33812 0 : i = 1;
33813 0 : while(i<=s)
33814 : {
33815 0 : hqrndnormal2(&state, &u1, &u2, _state);
33816 0 : v.ptr.p_double[i] = u1;
33817 0 : if( i+1<=s )
33818 : {
33819 0 : v.ptr.p_double[i+1] = u2;
33820 : }
33821 0 : i = i+2;
33822 : }
33823 0 : lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s));
33824 : }
33825 0 : while(ae_fp_eq(lambdav,(double)(0)));
33826 :
33827 : /*
33828 : * Prepare and apply reflection
33829 : */
33830 0 : generatereflection(&v, s, &tau, _state);
33831 0 : v.ptr.p_double[1] = (double)(1);
33832 0 : applyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state);
33833 : }
33834 :
33835 : /*
33836 : * Second pass.
33837 : */
33838 0 : for(i=0; i<=m-1; i++)
33839 : {
33840 0 : tau = (double)(2*hqrnduniformi(&state, 2, _state)-1);
33841 0 : ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau);
33842 : }
33843 0 : ae_frame_leave(_state);
33844 : }
33845 :
33846 :
33847 : /*************************************************************************
33848 : Multiplication of MxN complex matrix by NxN random Haar distributed
33849 : complex orthogonal matrix
33850 :
33851 : INPUT PARAMETERS:
33852 : A - matrix, array[0..M-1, 0..N-1]
33853 : M, N- matrix size
33854 :
33855 : OUTPUT PARAMETERS:
33856 : A - A*Q, where Q is random NxN orthogonal matrix
33857 :
33858 : -- ALGLIB routine --
33859 : 04.12.2009
33860 : Bochkanov Sergey
33861 : *************************************************************************/
33862 0 : void cmatrixrndorthogonalfromtheright(/* Complex */ ae_matrix* a,
33863 : ae_int_t m,
33864 : ae_int_t n,
33865 : ae_state *_state)
33866 : {
33867 : ae_frame _frame_block;
33868 : ae_complex lambdav;
33869 : ae_complex tau;
33870 : ae_int_t s;
33871 : ae_int_t i;
33872 : ae_vector w;
33873 : ae_vector v;
33874 : hqrndstate state;
33875 :
33876 0 : ae_frame_make(_state, &_frame_block);
33877 0 : memset(&w, 0, sizeof(w));
33878 0 : memset(&v, 0, sizeof(v));
33879 0 : memset(&state, 0, sizeof(state));
33880 0 : ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true);
33881 0 : ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true);
33882 0 : _hqrndstate_init(&state, _state, ae_true);
33883 :
33884 0 : ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state);
33885 0 : if( n==1 )
33886 : {
33887 :
33888 : /*
33889 : * Special case
33890 : */
33891 0 : hqrndrandomize(&state, _state);
33892 0 : hqrndunit2(&state, &tau.x, &tau.y, _state);
33893 0 : for(i=0; i<=m-1; i++)
33894 : {
33895 0 : a->ptr.pp_complex[i][0] = ae_c_mul(a->ptr.pp_complex[i][0],tau);
33896 : }
33897 0 : ae_frame_leave(_state);
33898 0 : return;
33899 : }
33900 :
33901 : /*
33902 : * General case.
33903 : * First pass.
33904 : */
33905 0 : ae_vector_set_length(&w, m, _state);
33906 0 : ae_vector_set_length(&v, n+1, _state);
33907 0 : hqrndrandomize(&state, _state);
33908 0 : for(s=2; s<=n; s++)
33909 : {
33910 :
33911 : /*
33912 : * Prepare random normal v
33913 : */
33914 0 : do
33915 : {
33916 0 : for(i=1; i<=s; i++)
33917 : {
33918 0 : hqrndnormal2(&state, &tau.x, &tau.y, _state);
33919 0 : v.ptr.p_complex[i] = tau;
33920 : }
33921 0 : lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s));
33922 : }
33923 0 : while(ae_c_eq_d(lambdav,(double)(0)));
33924 :
33925 : /*
33926 : * Prepare and apply reflection
33927 : */
33928 0 : complexgeneratereflection(&v, s, &tau, _state);
33929 0 : v.ptr.p_complex[1] = ae_complex_from_i(1);
33930 0 : complexapplyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state);
33931 : }
33932 :
33933 : /*
33934 : * Second pass.
33935 : */
33936 0 : for(i=0; i<=n-1; i++)
33937 : {
33938 0 : hqrndunit2(&state, &tau.x, &tau.y, _state);
33939 0 : ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,m-1), tau);
33940 : }
33941 0 : ae_frame_leave(_state);
33942 : }
33943 :
33944 :
33945 : /*************************************************************************
33946 : Multiplication of MxN complex matrix by MxM random Haar distributed
33947 : complex orthogonal matrix
33948 :
33949 : INPUT PARAMETERS:
33950 : A - matrix, array[0..M-1, 0..N-1]
33951 : M, N- matrix size
33952 :
33953 : OUTPUT PARAMETERS:
33954 : A - Q*A, where Q is random MxM orthogonal matrix
33955 :
33956 : -- ALGLIB routine --
33957 : 04.12.2009
33958 : Bochkanov Sergey
33959 : *************************************************************************/
33960 0 : void cmatrixrndorthogonalfromtheleft(/* Complex */ ae_matrix* a,
33961 : ae_int_t m,
33962 : ae_int_t n,
33963 : ae_state *_state)
33964 : {
33965 : ae_frame _frame_block;
33966 : ae_complex tau;
33967 : ae_complex lambdav;
33968 : ae_int_t s;
33969 : ae_int_t i;
33970 : ae_int_t j;
33971 : ae_vector w;
33972 : ae_vector v;
33973 : hqrndstate state;
33974 :
33975 0 : ae_frame_make(_state, &_frame_block);
33976 0 : memset(&w, 0, sizeof(w));
33977 0 : memset(&v, 0, sizeof(v));
33978 0 : memset(&state, 0, sizeof(state));
33979 0 : ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true);
33980 0 : ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true);
33981 0 : _hqrndstate_init(&state, _state, ae_true);
33982 :
33983 0 : ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state);
33984 0 : if( m==1 )
33985 : {
33986 :
33987 : /*
33988 : * special case
33989 : */
33990 0 : hqrndrandomize(&state, _state);
33991 0 : hqrndunit2(&state, &tau.x, &tau.y, _state);
33992 0 : for(j=0; j<=n-1; j++)
33993 : {
33994 0 : a->ptr.pp_complex[0][j] = ae_c_mul(a->ptr.pp_complex[0][j],tau);
33995 : }
33996 0 : ae_frame_leave(_state);
33997 0 : return;
33998 : }
33999 :
34000 : /*
34001 : * General case.
34002 : * First pass.
34003 : */
34004 0 : ae_vector_set_length(&w, n, _state);
34005 0 : ae_vector_set_length(&v, m+1, _state);
34006 0 : hqrndrandomize(&state, _state);
34007 0 : for(s=2; s<=m; s++)
34008 : {
34009 :
34010 : /*
34011 : * Prepare random normal v
34012 : */
34013 0 : do
34014 : {
34015 0 : for(i=1; i<=s; i++)
34016 : {
34017 0 : hqrndnormal2(&state, &tau.x, &tau.y, _state);
34018 0 : v.ptr.p_complex[i] = tau;
34019 : }
34020 0 : lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s));
34021 : }
34022 0 : while(ae_c_eq_d(lambdav,(double)(0)));
34023 :
34024 : /*
34025 : * Prepare and apply reflection
34026 : */
34027 0 : complexgeneratereflection(&v, s, &tau, _state);
34028 0 : v.ptr.p_complex[1] = ae_complex_from_i(1);
34029 0 : complexapplyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state);
34030 : }
34031 :
34032 : /*
34033 : * Second pass.
34034 : */
34035 0 : for(i=0; i<=m-1; i++)
34036 : {
34037 0 : hqrndunit2(&state, &tau.x, &tau.y, _state);
34038 0 : ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau);
34039 : }
34040 0 : ae_frame_leave(_state);
34041 : }
34042 :
34043 :
34044 : /*************************************************************************
34045 : Symmetric multiplication of NxN matrix by random Haar distributed
34046 : orthogonal matrix
34047 :
34048 : INPUT PARAMETERS:
34049 : A - matrix, array[0..N-1, 0..N-1]
34050 : N - matrix size
34051 :
34052 : OUTPUT PARAMETERS:
34053 : A - Q'*A*Q, where Q is random NxN orthogonal matrix
34054 :
34055 : -- ALGLIB routine --
34056 : 04.12.2009
34057 : Bochkanov Sergey
34058 : *************************************************************************/
34059 0 : void smatrixrndmultiply(/* Real */ ae_matrix* a,
34060 : ae_int_t n,
34061 : ae_state *_state)
34062 : {
34063 : ae_frame _frame_block;
34064 : double tau;
34065 : double lambdav;
34066 : ae_int_t s;
34067 : ae_int_t i;
34068 : double u1;
34069 : double u2;
34070 : ae_vector w;
34071 : ae_vector v;
34072 : hqrndstate state;
34073 :
34074 0 : ae_frame_make(_state, &_frame_block);
34075 0 : memset(&w, 0, sizeof(w));
34076 0 : memset(&v, 0, sizeof(v));
34077 0 : memset(&state, 0, sizeof(state));
34078 0 : ae_vector_init(&w, 0, DT_REAL, _state, ae_true);
34079 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
34080 0 : _hqrndstate_init(&state, _state, ae_true);
34081 :
34082 :
34083 : /*
34084 : * General case.
34085 : */
34086 0 : ae_vector_set_length(&w, n, _state);
34087 0 : ae_vector_set_length(&v, n+1, _state);
34088 0 : hqrndrandomize(&state, _state);
34089 0 : for(s=2; s<=n; s++)
34090 : {
34091 :
34092 : /*
34093 : * Prepare random normal v
34094 : */
34095 0 : do
34096 : {
34097 0 : i = 1;
34098 0 : while(i<=s)
34099 : {
34100 0 : hqrndnormal2(&state, &u1, &u2, _state);
34101 0 : v.ptr.p_double[i] = u1;
34102 0 : if( i+1<=s )
34103 : {
34104 0 : v.ptr.p_double[i+1] = u2;
34105 : }
34106 0 : i = i+2;
34107 : }
34108 0 : lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s));
34109 : }
34110 0 : while(ae_fp_eq(lambdav,(double)(0)));
34111 :
34112 : /*
34113 : * Prepare and apply reflection
34114 : */
34115 0 : generatereflection(&v, s, &tau, _state);
34116 0 : v.ptr.p_double[1] = (double)(1);
34117 0 : applyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state);
34118 0 : applyreflectionfromtheleft(a, tau, &v, n-s, n-1, 0, n-1, &w, _state);
34119 : }
34120 :
34121 : /*
34122 : * Second pass.
34123 : */
34124 0 : for(i=0; i<=n-1; i++)
34125 : {
34126 0 : tau = (double)(2*hqrnduniformi(&state, 2, _state)-1);
34127 0 : ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,n-1), tau);
34128 0 : ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau);
34129 : }
34130 :
34131 : /*
34132 : * Copy upper triangle to lower
34133 : */
34134 0 : for(i=0; i<=n-2; i++)
34135 : {
34136 0 : ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &a->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1));
34137 : }
34138 0 : ae_frame_leave(_state);
34139 0 : }
34140 :
34141 :
34142 : /*************************************************************************
34143 : Hermitian multiplication of NxN matrix by random Haar distributed
34144 : complex orthogonal matrix
34145 :
34146 : INPUT PARAMETERS:
34147 : A - matrix, array[0..N-1, 0..N-1]
34148 : N - matrix size
34149 :
34150 : OUTPUT PARAMETERS:
34151 : A - Q^H*A*Q, where Q is random NxN orthogonal matrix
34152 :
34153 : -- ALGLIB routine --
34154 : 04.12.2009
34155 : Bochkanov Sergey
34156 : *************************************************************************/
34157 0 : void hmatrixrndmultiply(/* Complex */ ae_matrix* a,
34158 : ae_int_t n,
34159 : ae_state *_state)
34160 : {
34161 : ae_frame _frame_block;
34162 : ae_complex tau;
34163 : ae_complex lambdav;
34164 : ae_int_t s;
34165 : ae_int_t i;
34166 : ae_vector w;
34167 : ae_vector v;
34168 : hqrndstate state;
34169 :
34170 0 : ae_frame_make(_state, &_frame_block);
34171 0 : memset(&w, 0, sizeof(w));
34172 0 : memset(&v, 0, sizeof(v));
34173 0 : memset(&state, 0, sizeof(state));
34174 0 : ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true);
34175 0 : ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true);
34176 0 : _hqrndstate_init(&state, _state, ae_true);
34177 :
34178 :
34179 : /*
34180 : * General case.
34181 : */
34182 0 : ae_vector_set_length(&w, n, _state);
34183 0 : ae_vector_set_length(&v, n+1, _state);
34184 0 : hqrndrandomize(&state, _state);
34185 0 : for(s=2; s<=n; s++)
34186 : {
34187 :
34188 : /*
34189 : * Prepare random normal v
34190 : */
34191 0 : do
34192 : {
34193 0 : for(i=1; i<=s; i++)
34194 : {
34195 0 : hqrndnormal2(&state, &tau.x, &tau.y, _state);
34196 0 : v.ptr.p_complex[i] = tau;
34197 : }
34198 0 : lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s));
34199 : }
34200 0 : while(ae_c_eq_d(lambdav,(double)(0)));
34201 :
34202 : /*
34203 : * Prepare and apply reflection
34204 : */
34205 0 : complexgeneratereflection(&v, s, &tau, _state);
34206 0 : v.ptr.p_complex[1] = ae_complex_from_i(1);
34207 0 : complexapplyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state);
34208 0 : complexapplyreflectionfromtheleft(a, ae_c_conj(tau, _state), &v, n-s, n-1, 0, n-1, &w, _state);
34209 : }
34210 :
34211 : /*
34212 : * Second pass.
34213 : */
34214 0 : for(i=0; i<=n-1; i++)
34215 : {
34216 0 : hqrndunit2(&state, &tau.x, &tau.y, _state);
34217 0 : ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,n-1), tau);
34218 0 : tau = ae_c_conj(tau, _state);
34219 0 : ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau);
34220 : }
34221 :
34222 : /*
34223 : * Change all values from lower triangle by complex-conjugate values
34224 : * from upper one
34225 : */
34226 0 : for(i=0; i<=n-2; i++)
34227 : {
34228 0 : ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &a->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1));
34229 : }
34230 0 : for(s=0; s<=n-2; s++)
34231 : {
34232 0 : for(i=s+1; i<=n-1; i++)
34233 : {
34234 0 : a->ptr.pp_complex[i][s].y = -a->ptr.pp_complex[i][s].y;
34235 : }
34236 : }
34237 0 : ae_frame_leave(_state);
34238 0 : }
34239 :
34240 :
34241 : #endif
34242 : #if defined(AE_COMPILE_TRFAC) || !defined(AE_PARTIAL_BUILD)
34243 :
34244 :
34245 : /*************************************************************************
34246 : LU decomposition of a general real matrix with row pivoting
34247 :
34248 : A is represented as A = P*L*U, where:
34249 : * L is lower unitriangular matrix
34250 : * U is upper triangular matrix
34251 : * P = P0*P1*...*PK, K=min(M,N)-1,
34252 : Pi - permutation matrix for I and Pivots[I]
34253 :
34254 : ! COMMERCIAL EDITION OF ALGLIB:
34255 : !
34256 : ! Commercial Edition of ALGLIB includes following important improvements
34257 : ! of this function:
34258 : ! * high-performance native backend with same C# interface (C# version)
34259 : ! * multithreading support (C++ and C# versions)
34260 : ! * hardware vendor (Intel) implementations of linear algebra primitives
34261 : ! (C++ and C# versions, x86/x64 platform)
34262 : !
34263 : ! We recommend you to read 'Working with commercial version' section of
34264 : ! ALGLIB Reference Manual in order to find out how to use performance-
34265 : ! related features provided by commercial edition of ALGLIB.
34266 :
34267 : INPUT PARAMETERS:
34268 : A - array[0..M-1, 0..N-1].
34269 : M - number of rows in matrix A.
34270 : N - number of columns in matrix A.
34271 :
34272 :
34273 : OUTPUT PARAMETERS:
34274 : A - matrices L and U in compact form:
34275 : * L is stored under main diagonal
34276 : * U is stored on and above main diagonal
34277 : Pivots - permutation matrix in compact form.
34278 : array[0..Min(M-1,N-1)].
34279 :
34280 : -- ALGLIB routine --
34281 : 10.01.2010
34282 : Bochkanov Sergey
34283 : *************************************************************************/
34284 0 : void rmatrixlu(/* Real */ ae_matrix* a,
34285 : ae_int_t m,
34286 : ae_int_t n,
34287 : /* Integer */ ae_vector* pivots,
34288 : ae_state *_state)
34289 : {
34290 :
34291 0 : ae_vector_clear(pivots);
34292 :
34293 0 : ae_assert(m>0, "RMatrixLU: incorrect M!", _state);
34294 0 : ae_assert(n>0, "RMatrixLU: incorrect N!", _state);
34295 0 : rmatrixplu(a, m, n, pivots, _state);
34296 0 : }
34297 :
34298 :
34299 : /*************************************************************************
34300 : LU decomposition of a general complex matrix with row pivoting
34301 :
34302 : A is represented as A = P*L*U, where:
34303 : * L is lower unitriangular matrix
34304 : * U is upper triangular matrix
34305 : * P = P0*P1*...*PK, K=min(M,N)-1,
34306 : Pi - permutation matrix for I and Pivots[I]
34307 :
34308 : ! COMMERCIAL EDITION OF ALGLIB:
34309 : !
34310 : ! Commercial Edition of ALGLIB includes following important improvements
34311 : ! of this function:
34312 : ! * high-performance native backend with same C# interface (C# version)
34313 : ! * multithreading support (C++ and C# versions)
34314 : ! * hardware vendor (Intel) implementations of linear algebra primitives
34315 : ! (C++ and C# versions, x86/x64 platform)
34316 : !
34317 : ! We recommend you to read 'Working with commercial version' section of
34318 : ! ALGLIB Reference Manual in order to find out how to use performance-
34319 : ! related features provided by commercial edition of ALGLIB.
34320 :
34321 : INPUT PARAMETERS:
34322 : A - array[0..M-1, 0..N-1].
34323 : M - number of rows in matrix A.
34324 : N - number of columns in matrix A.
34325 :
34326 :
34327 : OUTPUT PARAMETERS:
34328 : A - matrices L and U in compact form:
34329 : * L is stored under main diagonal
34330 : * U is stored on and above main diagonal
34331 : Pivots - permutation matrix in compact form.
34332 : array[0..Min(M-1,N-1)].
34333 :
34334 : -- ALGLIB routine --
34335 : 10.01.2010
34336 : Bochkanov Sergey
34337 : *************************************************************************/
34338 0 : void cmatrixlu(/* Complex */ ae_matrix* a,
34339 : ae_int_t m,
34340 : ae_int_t n,
34341 : /* Integer */ ae_vector* pivots,
34342 : ae_state *_state)
34343 : {
34344 :
34345 0 : ae_vector_clear(pivots);
34346 :
34347 0 : ae_assert(m>0, "CMatrixLU: incorrect M!", _state);
34348 0 : ae_assert(n>0, "CMatrixLU: incorrect N!", _state);
34349 0 : cmatrixplu(a, m, n, pivots, _state);
34350 0 : }
34351 :
34352 :
34353 : /*************************************************************************
34354 : Cache-oblivious Cholesky decomposition
34355 :
34356 : The algorithm computes Cholesky decomposition of a Hermitian positive-
34357 : definite matrix. The result of an algorithm is a representation of A as
34358 : A=U'*U or A=L*L' (here X' denotes conj(X^T)).
34359 :
34360 : ! COMMERCIAL EDITION OF ALGLIB:
34361 : !
34362 : ! Commercial Edition of ALGLIB includes following important improvements
34363 : ! of this function:
34364 : ! * high-performance native backend with same C# interface (C# version)
34365 : ! * multithreading support (C++ and C# versions)
34366 : ! * hardware vendor (Intel) implementations of linear algebra primitives
34367 : ! (C++ and C# versions, x86/x64 platform)
34368 : !
34369 : ! We recommend you to read 'Working with commercial version' section of
34370 : ! ALGLIB Reference Manual in order to find out how to use performance-
34371 : ! related features provided by commercial edition of ALGLIB.
34372 :
34373 : INPUT PARAMETERS:
34374 : A - upper or lower triangle of a factorized matrix.
34375 : array with elements [0..N-1, 0..N-1].
34376 : N - size of matrix A.
34377 : IsUpper - if IsUpper=True, then A contains an upper triangle of
34378 : a symmetric matrix, otherwise A contains a lower one.
34379 :
34380 : OUTPUT PARAMETERS:
34381 : A - the result of factorization. If IsUpper=True, then
34382 : the upper triangle contains matrix U, so that A = U'*U,
34383 : and the elements below the main diagonal are not modified.
34384 : Similarly, if IsUpper = False.
34385 :
34386 : RESULT:
34387 : If the matrix is positive-definite, the function returns True.
34388 : Otherwise, the function returns False. Contents of A is not determined
34389 : in such case.
34390 :
34391 : -- ALGLIB routine --
34392 : 15.12.2009-22.01.2018
34393 : Bochkanov Sergey
34394 : *************************************************************************/
34395 0 : ae_bool hpdmatrixcholesky(/* Complex */ ae_matrix* a,
34396 : ae_int_t n,
34397 : ae_bool isupper,
34398 : ae_state *_state)
34399 : {
34400 : ae_frame _frame_block;
34401 : ae_vector tmp;
34402 : ae_bool result;
34403 :
34404 0 : ae_frame_make(_state, &_frame_block);
34405 0 : memset(&tmp, 0, sizeof(tmp));
34406 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
34407 :
34408 0 : if( n<1 )
34409 : {
34410 0 : result = ae_false;
34411 0 : ae_frame_leave(_state);
34412 0 : return result;
34413 : }
34414 0 : result = trfac_hpdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state);
34415 0 : ae_frame_leave(_state);
34416 0 : return result;
34417 : }
34418 :
34419 :
34420 : /*************************************************************************
34421 : Cache-oblivious Cholesky decomposition
34422 :
34423 : The algorithm computes Cholesky decomposition of a symmetric positive-
34424 : definite matrix. The result of an algorithm is a representation of A as
34425 : A=U^T*U or A=L*L^T
34426 :
34427 : ! COMMERCIAL EDITION OF ALGLIB:
34428 : !
34429 : ! Commercial Edition of ALGLIB includes following important improvements
34430 : ! of this function:
34431 : ! * high-performance native backend with same C# interface (C# version)
34432 : ! * multithreading support (C++ and C# versions)
34433 : ! * hardware vendor (Intel) implementations of linear algebra primitives
34434 : ! (C++ and C# versions, x86/x64 platform)
34435 : !
34436 : ! We recommend you to read 'Working with commercial version' section of
34437 : ! ALGLIB Reference Manual in order to find out how to use performance-
34438 : ! related features provided by commercial edition of ALGLIB.
34439 :
34440 : INPUT PARAMETERS:
34441 : A - upper or lower triangle of a factorized matrix.
34442 : array with elements [0..N-1, 0..N-1].
34443 : N - size of matrix A.
34444 : IsUpper - if IsUpper=True, then A contains an upper triangle of
34445 : a symmetric matrix, otherwise A contains a lower one.
34446 :
34447 : OUTPUT PARAMETERS:
34448 : A - the result of factorization. If IsUpper=True, then
34449 : the upper triangle contains matrix U, so that A = U^T*U,
34450 : and the elements below the main diagonal are not modified.
34451 : Similarly, if IsUpper = False.
34452 :
34453 : RESULT:
34454 : If the matrix is positive-definite, the function returns True.
34455 : Otherwise, the function returns False. Contents of A is not determined
34456 : in such case.
34457 :
34458 : -- ALGLIB routine --
34459 : 15.12.2009
34460 : Bochkanov Sergey
34461 : *************************************************************************/
34462 0 : ae_bool spdmatrixcholesky(/* Real */ ae_matrix* a,
34463 : ae_int_t n,
34464 : ae_bool isupper,
34465 : ae_state *_state)
34466 : {
34467 : ae_frame _frame_block;
34468 : ae_vector tmp;
34469 : ae_bool result;
34470 :
34471 0 : ae_frame_make(_state, &_frame_block);
34472 0 : memset(&tmp, 0, sizeof(tmp));
34473 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
34474 :
34475 0 : if( n<1 )
34476 : {
34477 0 : result = ae_false;
34478 0 : ae_frame_leave(_state);
34479 0 : return result;
34480 : }
34481 0 : result = spdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state);
34482 0 : ae_frame_leave(_state);
34483 0 : return result;
34484 : }
34485 :
34486 :
34487 : /*************************************************************************
34488 : Update of Cholesky decomposition: rank-1 update to original A. "Buffered"
34489 : version which uses preallocated buffer which is saved between subsequent
34490 : function calls.
34491 :
34492 : This function uses internally allocated buffer which is not saved between
34493 : subsequent calls. So, if you perform a lot of subsequent updates,
34494 : we recommend you to use "buffered" version of this function:
34495 : SPDMatrixCholeskyUpdateAdd1Buf().
34496 :
34497 : INPUT PARAMETERS:
34498 : A - upper or lower Cholesky factor.
34499 : array with elements [0..N-1, 0..N-1].
34500 : Exception is thrown if array size is too small.
34501 : N - size of matrix A, N>0
34502 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
34503 : otherwise A contains a lower one.
34504 : U - array[N], rank-1 update to A: A_mod = A + u*u'
34505 : Exception is thrown if array size is too small.
34506 : BufR - possibly preallocated buffer; automatically resized if
34507 : needed. It is recommended to reuse this buffer if you
34508 : perform a lot of subsequent decompositions.
34509 :
34510 : OUTPUT PARAMETERS:
34511 : A - updated factorization. If IsUpper=True, then the upper
34512 : triangle contains matrix U, and the elements below the main
34513 : diagonal are not modified. Similarly, if IsUpper = False.
34514 :
34515 : NOTE: this function always succeeds, so it does not return completion code
34516 :
34517 : NOTE: this function checks sizes of input arrays, but it does NOT checks
34518 : for presence of infinities or NAN's.
34519 :
34520 : -- ALGLIB --
34521 : 03.02.2014
34522 : Sergey Bochkanov
34523 : *************************************************************************/
34524 0 : void spdmatrixcholeskyupdateadd1(/* Real */ ae_matrix* a,
34525 : ae_int_t n,
34526 : ae_bool isupper,
34527 : /* Real */ ae_vector* u,
34528 : ae_state *_state)
34529 : {
34530 : ae_frame _frame_block;
34531 : ae_vector bufr;
34532 :
34533 0 : ae_frame_make(_state, &_frame_block);
34534 0 : memset(&bufr, 0, sizeof(bufr));
34535 0 : ae_vector_init(&bufr, 0, DT_REAL, _state, ae_true);
34536 :
34537 0 : ae_assert(n>0, "SPDMatrixCholeskyUpdateAdd1: N<=0", _state);
34538 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyUpdateAdd1: Rows(A)<N", _state);
34539 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyUpdateAdd1: Cols(A)<N", _state);
34540 0 : ae_assert(u->cnt>=n, "SPDMatrixCholeskyUpdateAdd1: Length(U)<N", _state);
34541 0 : spdmatrixcholeskyupdateadd1buf(a, n, isupper, u, &bufr, _state);
34542 0 : ae_frame_leave(_state);
34543 0 : }
34544 :
34545 :
34546 : /*************************************************************************
34547 : Update of Cholesky decomposition: "fixing" some variables.
34548 :
34549 : This function uses internally allocated buffer which is not saved between
34550 : subsequent calls. So, if you perform a lot of subsequent updates,
34551 : we recommend you to use "buffered" version of this function:
34552 : SPDMatrixCholeskyUpdateFixBuf().
34553 :
34554 : "FIXING" EXPLAINED:
34555 :
34556 : Suppose we have N*N positive definite matrix A. "Fixing" some variable
34557 : means filling corresponding row/column of A by zeros, and setting
34558 : diagonal element to 1.
34559 :
34560 : For example, if we fix 2nd variable in 4*4 matrix A, it becomes Af:
34561 :
34562 : ( A00 A01 A02 A03 ) ( Af00 0 Af02 Af03 )
34563 : ( A10 A11 A12 A13 ) ( 0 1 0 0 )
34564 : ( A20 A21 A22 A23 ) => ( Af20 0 Af22 Af23 )
34565 : ( A30 A31 A32 A33 ) ( Af30 0 Af32 Af33 )
34566 :
34567 : If we have Cholesky decomposition of A, it must be recalculated after
34568 : variables were fixed. However, it is possible to use efficient
34569 : algorithm, which needs O(K*N^2) time to "fix" K variables, given
34570 : Cholesky decomposition of original, "unfixed" A.
34571 :
34572 : INPUT PARAMETERS:
34573 : A - upper or lower Cholesky factor.
34574 : array with elements [0..N-1, 0..N-1].
34575 : Exception is thrown if array size is too small.
34576 : N - size of matrix A, N>0
34577 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
34578 : otherwise A contains a lower one.
34579 : Fix - array[N], I-th element is True if I-th variable must be
34580 : fixed. Exception is thrown if array size is too small.
34581 : BufR - possibly preallocated buffer; automatically resized if
34582 : needed. It is recommended to reuse this buffer if you
34583 : perform a lot of subsequent decompositions.
34584 :
34585 : OUTPUT PARAMETERS:
34586 : A - updated factorization. If IsUpper=True, then the upper
34587 : triangle contains matrix U, and the elements below the main
34588 : diagonal are not modified. Similarly, if IsUpper = False.
34589 :
34590 : NOTE: this function always succeeds, so it does not return completion code
34591 :
34592 : NOTE: this function checks sizes of input arrays, but it does NOT checks
34593 : for presence of infinities or NAN's.
34594 :
34595 : NOTE: this function is efficient only for moderate amount of updated
34596 : variables - say, 0.1*N or 0.3*N. For larger amount of variables it
34597 : will still work, but you may get better performance with
34598 : straightforward Cholesky.
34599 :
34600 : -- ALGLIB --
34601 : 03.02.2014
34602 : Sergey Bochkanov
34603 : *************************************************************************/
34604 0 : void spdmatrixcholeskyupdatefix(/* Real */ ae_matrix* a,
34605 : ae_int_t n,
34606 : ae_bool isupper,
34607 : /* Boolean */ ae_vector* fix,
34608 : ae_state *_state)
34609 : {
34610 : ae_frame _frame_block;
34611 : ae_vector bufr;
34612 :
34613 0 : ae_frame_make(_state, &_frame_block);
34614 0 : memset(&bufr, 0, sizeof(bufr));
34615 0 : ae_vector_init(&bufr, 0, DT_REAL, _state, ae_true);
34616 :
34617 0 : ae_assert(n>0, "SPDMatrixCholeskyUpdateFix: N<=0", _state);
34618 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyUpdateFix: Rows(A)<N", _state);
34619 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyUpdateFix: Cols(A)<N", _state);
34620 0 : ae_assert(fix->cnt>=n, "SPDMatrixCholeskyUpdateFix: Length(Fix)<N", _state);
34621 0 : spdmatrixcholeskyupdatefixbuf(a, n, isupper, fix, &bufr, _state);
34622 0 : ae_frame_leave(_state);
34623 0 : }
34624 :
34625 :
34626 : /*************************************************************************
34627 : Update of Cholesky decomposition: rank-1 update to original A. "Buffered"
34628 : version which uses preallocated buffer which is saved between subsequent
34629 : function calls.
34630 :
34631 : See comments for SPDMatrixCholeskyUpdateAdd1() for more information.
34632 :
34633 : INPUT PARAMETERS:
34634 : A - upper or lower Cholesky factor.
34635 : array with elements [0..N-1, 0..N-1].
34636 : Exception is thrown if array size is too small.
34637 : N - size of matrix A, N>0
34638 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
34639 : otherwise A contains a lower one.
34640 : U - array[N], rank-1 update to A: A_mod = A + u*u'
34641 : Exception is thrown if array size is too small.
34642 : BufR - possibly preallocated buffer; automatically resized if
34643 : needed. It is recommended to reuse this buffer if you
34644 : perform a lot of subsequent decompositions.
34645 :
34646 : OUTPUT PARAMETERS:
34647 : A - updated factorization. If IsUpper=True, then the upper
34648 : triangle contains matrix U, and the elements below the main
34649 : diagonal are not modified. Similarly, if IsUpper = False.
34650 :
34651 : -- ALGLIB --
34652 : 03.02.2014
34653 : Sergey Bochkanov
34654 : *************************************************************************/
34655 0 : void spdmatrixcholeskyupdateadd1buf(/* Real */ ae_matrix* a,
34656 : ae_int_t n,
34657 : ae_bool isupper,
34658 : /* Real */ ae_vector* u,
34659 : /* Real */ ae_vector* bufr,
34660 : ae_state *_state)
34661 : {
34662 : ae_int_t i;
34663 : ae_int_t j;
34664 : ae_int_t nz;
34665 : double cs;
34666 : double sn;
34667 : double v;
34668 : double vv;
34669 :
34670 :
34671 0 : ae_assert(n>0, "SPDMatrixCholeskyUpdateAdd1Buf: N<=0", _state);
34672 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyUpdateAdd1Buf: Rows(A)<N", _state);
34673 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyUpdateAdd1Buf: Cols(A)<N", _state);
34674 0 : ae_assert(u->cnt>=n, "SPDMatrixCholeskyUpdateAdd1Buf: Length(U)<N", _state);
34675 :
34676 : /*
34677 : * Find index of first non-zero entry in U
34678 : */
34679 0 : nz = n;
34680 0 : for(i=0; i<=n-1; i++)
34681 : {
34682 0 : if( ae_fp_neq(u->ptr.p_double[i],(double)(0)) )
34683 : {
34684 0 : nz = i;
34685 0 : break;
34686 : }
34687 : }
34688 0 : if( nz==n )
34689 : {
34690 :
34691 : /*
34692 : * Nothing to update
34693 : */
34694 0 : return;
34695 : }
34696 :
34697 : /*
34698 : * If working with upper triangular matrix
34699 : */
34700 0 : if( isupper )
34701 : {
34702 :
34703 : /*
34704 : * Perform a sequence of updates which fix variables one by one.
34705 : * This approach is different from one which is used when we work
34706 : * with lower triangular matrix.
34707 : */
34708 0 : rvectorsetlengthatleast(bufr, n, _state);
34709 0 : for(j=nz; j<=n-1; j++)
34710 : {
34711 0 : bufr->ptr.p_double[j] = u->ptr.p_double[j];
34712 : }
34713 0 : for(i=nz; i<=n-1; i++)
34714 : {
34715 0 : if( ae_fp_neq(bufr->ptr.p_double[i],(double)(0)) )
34716 : {
34717 0 : generaterotation(a->ptr.pp_double[i][i], bufr->ptr.p_double[i], &cs, &sn, &v, _state);
34718 0 : a->ptr.pp_double[i][i] = v;
34719 0 : bufr->ptr.p_double[i] = 0.0;
34720 0 : for(j=i+1; j<=n-1; j++)
34721 : {
34722 0 : v = a->ptr.pp_double[i][j];
34723 0 : vv = bufr->ptr.p_double[j];
34724 0 : a->ptr.pp_double[i][j] = cs*v+sn*vv;
34725 0 : bufr->ptr.p_double[j] = -sn*v+cs*vv;
34726 : }
34727 : }
34728 : }
34729 : }
34730 : else
34731 : {
34732 :
34733 : /*
34734 : * Calculate rows of modified Cholesky factor, row-by-row
34735 : * (updates performed during variable fixing are applied
34736 : * simultaneously to each row)
34737 : */
34738 0 : rvectorsetlengthatleast(bufr, 3*n, _state);
34739 0 : for(j=nz; j<=n-1; j++)
34740 : {
34741 0 : bufr->ptr.p_double[j] = u->ptr.p_double[j];
34742 : }
34743 0 : for(i=nz; i<=n-1; i++)
34744 : {
34745 :
34746 : /*
34747 : * Update all previous updates [Idx+1...I-1] to I-th row
34748 : */
34749 0 : vv = bufr->ptr.p_double[i];
34750 0 : for(j=nz; j<=i-1; j++)
34751 : {
34752 0 : cs = bufr->ptr.p_double[n+2*j+0];
34753 0 : sn = bufr->ptr.p_double[n+2*j+1];
34754 0 : v = a->ptr.pp_double[i][j];
34755 0 : a->ptr.pp_double[i][j] = cs*v+sn*vv;
34756 0 : vv = -sn*v+cs*vv;
34757 : }
34758 :
34759 : /*
34760 : * generate rotation applied to I-th element of update vector
34761 : */
34762 0 : generaterotation(a->ptr.pp_double[i][i], vv, &cs, &sn, &v, _state);
34763 0 : a->ptr.pp_double[i][i] = v;
34764 0 : bufr->ptr.p_double[n+2*i+0] = cs;
34765 0 : bufr->ptr.p_double[n+2*i+1] = sn;
34766 : }
34767 : }
34768 : }
34769 :
34770 :
34771 : /*************************************************************************
34772 : Update of Cholesky decomposition: "fixing" some variables. "Buffered"
34773 : version which uses preallocated buffer which is saved between subsequent
34774 : function calls.
34775 :
34776 : See comments for SPDMatrixCholeskyUpdateFix() for more information.
34777 :
34778 : INPUT PARAMETERS:
34779 : A - upper or lower Cholesky factor.
34780 : array with elements [0..N-1, 0..N-1].
34781 : Exception is thrown if array size is too small.
34782 : N - size of matrix A, N>0
34783 : IsUpper - if IsUpper=True, then A contains upper Cholesky factor;
34784 : otherwise A contains a lower one.
34785 : Fix - array[N], I-th element is True if I-th variable must be
34786 : fixed. Exception is thrown if array size is too small.
34787 : BufR - possibly preallocated buffer; automatically resized if
34788 : needed. It is recommended to reuse this buffer if you
34789 : perform a lot of subsequent decompositions.
34790 :
34791 : OUTPUT PARAMETERS:
34792 : A - updated factorization. If IsUpper=True, then the upper
34793 : triangle contains matrix U, and the elements below the main
34794 : diagonal are not modified. Similarly, if IsUpper = False.
34795 :
34796 : -- ALGLIB --
34797 : 03.02.2014
34798 : Sergey Bochkanov
34799 : *************************************************************************/
34800 0 : void spdmatrixcholeskyupdatefixbuf(/* Real */ ae_matrix* a,
34801 : ae_int_t n,
34802 : ae_bool isupper,
34803 : /* Boolean */ ae_vector* fix,
34804 : /* Real */ ae_vector* bufr,
34805 : ae_state *_state)
34806 : {
34807 : ae_int_t i;
34808 : ae_int_t j;
34809 : ae_int_t k;
34810 : ae_int_t nfix;
34811 : ae_int_t idx;
34812 : double cs;
34813 : double sn;
34814 : double v;
34815 : double vv;
34816 :
34817 :
34818 0 : ae_assert(n>0, "SPDMatrixCholeskyUpdateFixBuf: N<=0", _state);
34819 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyUpdateFixBuf: Rows(A)<N", _state);
34820 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyUpdateFixBuf: Cols(A)<N", _state);
34821 0 : ae_assert(fix->cnt>=n, "SPDMatrixCholeskyUpdateFixBuf: Length(Fix)<N", _state);
34822 :
34823 : /*
34824 : * Count number of variables to fix.
34825 : * Quick exit if NFix=0 or NFix=N
34826 : */
34827 0 : nfix = 0;
34828 0 : for(i=0; i<=n-1; i++)
34829 : {
34830 0 : if( fix->ptr.p_bool[i] )
34831 : {
34832 0 : inc(&nfix, _state);
34833 : }
34834 : }
34835 0 : if( nfix==0 )
34836 : {
34837 :
34838 : /*
34839 : * Nothing to fix
34840 : */
34841 0 : return;
34842 : }
34843 0 : if( nfix==n )
34844 : {
34845 :
34846 : /*
34847 : * All variables are fixed.
34848 : * Set A to identity and exit.
34849 : */
34850 0 : if( isupper )
34851 : {
34852 0 : for(i=0; i<=n-1; i++)
34853 : {
34854 0 : a->ptr.pp_double[i][i] = (double)(1);
34855 0 : for(j=i+1; j<=n-1; j++)
34856 : {
34857 0 : a->ptr.pp_double[i][j] = (double)(0);
34858 : }
34859 : }
34860 : }
34861 : else
34862 : {
34863 0 : for(i=0; i<=n-1; i++)
34864 : {
34865 0 : for(j=0; j<=i-1; j++)
34866 : {
34867 0 : a->ptr.pp_double[i][j] = (double)(0);
34868 : }
34869 0 : a->ptr.pp_double[i][i] = (double)(1);
34870 : }
34871 : }
34872 0 : return;
34873 : }
34874 :
34875 : /*
34876 : * If working with upper triangular matrix
34877 : */
34878 0 : if( isupper )
34879 : {
34880 :
34881 : /*
34882 : * Perform a sequence of updates which fix variables one by one.
34883 : * This approach is different from one which is used when we work
34884 : * with lower triangular matrix.
34885 : */
34886 0 : rvectorsetlengthatleast(bufr, n, _state);
34887 0 : for(k=0; k<=n-1; k++)
34888 : {
34889 0 : if( fix->ptr.p_bool[k] )
34890 : {
34891 0 : idx = k;
34892 :
34893 : /*
34894 : * Quick exit if it is last variable
34895 : */
34896 0 : if( idx==n-1 )
34897 : {
34898 0 : for(i=0; i<=idx-1; i++)
34899 : {
34900 0 : a->ptr.pp_double[i][idx] = 0.0;
34901 : }
34902 0 : a->ptr.pp_double[idx][idx] = 1.0;
34903 0 : continue;
34904 : }
34905 :
34906 : /*
34907 : * We have Cholesky decomposition of quadratic term in A,
34908 : * with upper triangle being stored as given below:
34909 : *
34910 : * ( U00 u01 U02 )
34911 : * U = ( u11 u12 )
34912 : * ( U22 )
34913 : *
34914 : * Here u11 is diagonal element corresponding to variable K. We
34915 : * want to fix this variable, and we do so by modifying U as follows:
34916 : *
34917 : * ( U00 0 U02 )
34918 : * U_mod = ( 1 0 )
34919 : * ( U_m )
34920 : *
34921 : * with U_m = CHOLESKY [ (U22^T)*U22 + (u12^T)*u12 ]
34922 : *
34923 : * Of course, we can calculate U_m by calculating (U22^T)*U22 explicitly,
34924 : * modifying it and performing Cholesky decomposition of modified matrix.
34925 : * However, we can treat it as follows:
34926 : * * we already have CHOLESKY[(U22^T)*U22], which is equal to U22
34927 : * * we have rank-1 update (u12^T)*u12 applied to (U22^T)*U22
34928 : * * thus, we can calculate updated Cholesky with O(N^2) algorithm
34929 : * instead of O(N^3) one
34930 : */
34931 0 : for(j=idx+1; j<=n-1; j++)
34932 : {
34933 0 : bufr->ptr.p_double[j] = a->ptr.pp_double[idx][j];
34934 : }
34935 0 : for(i=0; i<=idx-1; i++)
34936 : {
34937 0 : a->ptr.pp_double[i][idx] = 0.0;
34938 : }
34939 0 : a->ptr.pp_double[idx][idx] = 1.0;
34940 0 : for(i=idx+1; i<=n-1; i++)
34941 : {
34942 0 : a->ptr.pp_double[idx][i] = 0.0;
34943 : }
34944 0 : for(i=idx+1; i<=n-1; i++)
34945 : {
34946 0 : if( ae_fp_neq(bufr->ptr.p_double[i],(double)(0)) )
34947 : {
34948 0 : generaterotation(a->ptr.pp_double[i][i], bufr->ptr.p_double[i], &cs, &sn, &v, _state);
34949 0 : a->ptr.pp_double[i][i] = v;
34950 0 : bufr->ptr.p_double[i] = 0.0;
34951 0 : for(j=i+1; j<=n-1; j++)
34952 : {
34953 0 : v = a->ptr.pp_double[i][j];
34954 0 : vv = bufr->ptr.p_double[j];
34955 0 : a->ptr.pp_double[i][j] = cs*v+sn*vv;
34956 0 : bufr->ptr.p_double[j] = -sn*v+cs*vv;
34957 : }
34958 : }
34959 : }
34960 : }
34961 : }
34962 : }
34963 : else
34964 : {
34965 :
34966 : /*
34967 : * Calculate rows of modified Cholesky factor, row-by-row
34968 : * (updates performed during variable fixing are applied
34969 : * simultaneously to each row)
34970 : */
34971 0 : rvectorsetlengthatleast(bufr, 3*n, _state);
34972 0 : for(k=0; k<=n-1; k++)
34973 : {
34974 0 : if( fix->ptr.p_bool[k] )
34975 : {
34976 0 : idx = k;
34977 :
34978 : /*
34979 : * Quick exit if it is last variable
34980 : */
34981 0 : if( idx==n-1 )
34982 : {
34983 0 : for(i=0; i<=idx-1; i++)
34984 : {
34985 0 : a->ptr.pp_double[idx][i] = 0.0;
34986 : }
34987 0 : a->ptr.pp_double[idx][idx] = 1.0;
34988 0 : continue;
34989 : }
34990 :
34991 : /*
34992 : * store column to buffer and clear row/column of A
34993 : */
34994 0 : for(j=idx+1; j<=n-1; j++)
34995 : {
34996 0 : bufr->ptr.p_double[j] = a->ptr.pp_double[j][idx];
34997 : }
34998 0 : for(i=0; i<=idx-1; i++)
34999 : {
35000 0 : a->ptr.pp_double[idx][i] = 0.0;
35001 : }
35002 0 : a->ptr.pp_double[idx][idx] = 1.0;
35003 0 : for(i=idx+1; i<=n-1; i++)
35004 : {
35005 0 : a->ptr.pp_double[i][idx] = 0.0;
35006 : }
35007 :
35008 : /*
35009 : * Apply update to rows of A
35010 : */
35011 0 : for(i=idx+1; i<=n-1; i++)
35012 : {
35013 :
35014 : /*
35015 : * Update all previous updates [Idx+1...I-1] to I-th row
35016 : */
35017 0 : vv = bufr->ptr.p_double[i];
35018 0 : for(j=idx+1; j<=i-1; j++)
35019 : {
35020 0 : cs = bufr->ptr.p_double[n+2*j+0];
35021 0 : sn = bufr->ptr.p_double[n+2*j+1];
35022 0 : v = a->ptr.pp_double[i][j];
35023 0 : a->ptr.pp_double[i][j] = cs*v+sn*vv;
35024 0 : vv = -sn*v+cs*vv;
35025 : }
35026 :
35027 : /*
35028 : * generate rotation applied to I-th element of update vector
35029 : */
35030 0 : generaterotation(a->ptr.pp_double[i][i], vv, &cs, &sn, &v, _state);
35031 0 : a->ptr.pp_double[i][i] = v;
35032 0 : bufr->ptr.p_double[n+2*i+0] = cs;
35033 0 : bufr->ptr.p_double[n+2*i+1] = sn;
35034 : }
35035 : }
35036 : }
35037 : }
35038 : }
35039 :
35040 :
35041 : /*************************************************************************
35042 : Sparse LU decomposition with column pivoting for sparsity and row pivoting
35043 : for stability. Input must be square sparse matrix stored in CRS format.
35044 :
35045 : The algorithm computes LU decomposition of a general square matrix
35046 : (rectangular ones are not supported). The result of an algorithm is a
35047 : representation of A as A = P*L*U*Q, where:
35048 : * L is lower unitriangular matrix
35049 : * U is upper triangular matrix
35050 : * P = P0*P1*...*PK, K=N-1, Pi - permutation matrix for I and P[I]
35051 : * Q = QK*...*Q1*Q0, K=N-1, Qi - permutation matrix for I and Q[I]
35052 :
35053 : This function pivots columns for higher sparsity, and then pivots rows for
35054 : stability (larger element at the diagonal).
35055 :
35056 : INPUT PARAMETERS:
35057 : A - sparse NxN matrix in CRS format. An exception is generated
35058 : if matrix is non-CRS or non-square.
35059 : PivotType- pivoting strategy:
35060 : * 0 for best pivoting available (2 in current version)
35061 : * 1 for row-only pivoting (NOT RECOMMENDED)
35062 : * 2 for complete pivoting which produces most sparse outputs
35063 :
35064 : OUTPUT PARAMETERS:
35065 : A - the result of factorization, matrices L and U stored in
35066 : compact form using CRS sparse storage format:
35067 : * lower unitriangular L is stored strictly under main diagonal
35068 : * upper triangilar U is stored ON and ABOVE main diagonal
35069 : P - row permutation matrix in compact form, array[N]
35070 : Q - col permutation matrix in compact form, array[N]
35071 :
35072 : This function always succeeds, i.e. it ALWAYS returns valid factorization,
35073 : but for your convenience it also returns boolean value which helps to
35074 : detect symbolically degenerate matrices:
35075 : * function returns TRUE, if the matrix was factorized AND symbolically
35076 : non-degenerate
35077 : * function returns FALSE, if the matrix was factorized but U has strictly
35078 : zero elements at the diagonal (the factorization is returned anyway).
35079 :
35080 :
35081 : -- ALGLIB routine --
35082 : 03.09.2018
35083 : Bochkanov Sergey
35084 : *************************************************************************/
35085 0 : ae_bool sparselu(sparsematrix* a,
35086 : ae_int_t pivottype,
35087 : /* Integer */ ae_vector* p,
35088 : /* Integer */ ae_vector* q,
35089 : ae_state *_state)
35090 : {
35091 : ae_frame _frame_block;
35092 : sluv2buffer buf2;
35093 : ae_bool result;
35094 :
35095 0 : ae_frame_make(_state, &_frame_block);
35096 0 : memset(&buf2, 0, sizeof(buf2));
35097 0 : ae_vector_clear(p);
35098 0 : ae_vector_clear(q);
35099 0 : _sluv2buffer_init(&buf2, _state, ae_true);
35100 :
35101 0 : ae_assert((pivottype==0||pivottype==1)||pivottype==2, "SparseLU: unexpected pivot type", _state);
35102 0 : ae_assert(sparseiscrs(a, _state), "SparseLU: A is not stored in CRS format", _state);
35103 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseLU: non-square A", _state);
35104 0 : result = sptrflu(a, pivottype, p, q, &buf2, _state);
35105 0 : ae_frame_leave(_state);
35106 0 : return result;
35107 : }
35108 :
35109 :
35110 : /*************************************************************************
35111 : Sparse Cholesky decomposition for skyline matrixm using in-place algorithm
35112 : without allocating additional storage.
35113 :
35114 : The algorithm computes Cholesky decomposition of a symmetric positive-
35115 : definite sparse matrix. The result of an algorithm is a representation of
35116 : A as A=U^T*U or A=L*L^T
35117 :
35118 : This function allows to perform very efficient decomposition of low-profile
35119 : matrices (average bandwidth is ~5-10 elements). For larger matrices it is
35120 : recommended to use supernodal Cholesky decomposition: SparseCholeskyP() or
35121 : SparseCholeskyAnalyze()/SparseCholeskyFactorize().
35122 :
35123 : INPUT PARAMETERS:
35124 : A - sparse matrix in skyline storage (SKS) format.
35125 : N - size of matrix A (can be smaller than actual size of A)
35126 : IsUpper - if IsUpper=True, then factorization is performed on upper
35127 : triangle. Another triangle is ignored (it may contant some
35128 : data, but it is not changed).
35129 :
35130 :
35131 : OUTPUT PARAMETERS:
35132 : A - the result of factorization, stored in SKS. If IsUpper=True,
35133 : then the upper triangle contains matrix U, such that
35134 : A = U^T*U. Lower triangle is not changed.
35135 : Similarly, if IsUpper = False. In this case L is returned,
35136 : and we have A = L*(L^T).
35137 : Note that THIS function does not perform permutation of
35138 : rows to reduce bandwidth.
35139 :
35140 : RESULT:
35141 : If the matrix is positive-definite, the function returns True.
35142 : Otherwise, the function returns False. Contents of A is not determined
35143 : in such case.
35144 :
35145 : NOTE: for performance reasons this function does NOT check that input
35146 : matrix includes only finite values. It is your responsibility to
35147 : make sure that there are no infinite or NAN values in the matrix.
35148 :
35149 : -- ALGLIB routine --
35150 : 16.01.2014
35151 : Bochkanov Sergey
35152 : *************************************************************************/
35153 0 : ae_bool sparsecholeskyskyline(sparsematrix* a,
35154 : ae_int_t n,
35155 : ae_bool isupper,
35156 : ae_state *_state)
35157 : {
35158 : ae_int_t i;
35159 : ae_int_t j;
35160 : ae_int_t k;
35161 : ae_int_t jnz;
35162 : ae_int_t jnza;
35163 : ae_int_t jnzl;
35164 : double v;
35165 : double vv;
35166 : double a12;
35167 : ae_int_t nready;
35168 : ae_int_t nadd;
35169 : ae_int_t banda;
35170 : ae_int_t offsa;
35171 : ae_int_t offsl;
35172 : ae_bool result;
35173 :
35174 :
35175 0 : ae_assert(n>=0, "SparseCholeskySkyline: N<0", _state);
35176 0 : ae_assert(sparsegetnrows(a, _state)>=n, "SparseCholeskySkyline: rows(A)<N", _state);
35177 0 : ae_assert(sparsegetncols(a, _state)>=n, "SparseCholeskySkyline: cols(A)<N", _state);
35178 0 : ae_assert(sparseissks(a, _state), "SparseCholeskySkyline: A is not stored in SKS format", _state);
35179 0 : result = ae_false;
35180 :
35181 : /*
35182 : * transpose if needed
35183 : */
35184 0 : if( isupper )
35185 : {
35186 0 : sparsetransposesks(a, _state);
35187 : }
35188 :
35189 : /*
35190 : * Perform Cholesky decomposition:
35191 : * * we assume than leading NReady*NReady submatrix is done
35192 : * * having Cholesky decomposition of NReady*NReady submatrix we
35193 : * obtain decomposition of larger (NReady+NAdd)*(NReady+NAdd) one.
35194 : *
35195 : * Here is algorithm. At the start we have
35196 : *
35197 : * ( | )
35198 : * ( L | )
35199 : * S = ( | )
35200 : * (----------)
35201 : * ( A | B )
35202 : *
35203 : * with L being already computed Cholesky factor, A and B being
35204 : * unprocessed parts of the matrix. Of course, L/A/B are stored
35205 : * in SKS format.
35206 : *
35207 : * Then, we calculate A1:=(inv(L)*A')' and replace A with A1.
35208 : * Then, we calculate B1:=B-A1*A1' and replace B with B1
35209 : *
35210 : * Finally, we calculate small NAdd*NAdd Cholesky of B1 with
35211 : * dense solver. Now, L/A1/B1 are Cholesky decomposition of the
35212 : * larger (NReady+NAdd)*(NReady+NAdd) matrix.
35213 : */
35214 0 : nready = 0;
35215 0 : nadd = 1;
35216 0 : while(nready<n)
35217 : {
35218 0 : ae_assert(nadd==1, "SkylineCholesky: internal error", _state);
35219 :
35220 : /*
35221 : * Calculate A1:=(inv(L)*A')'
35222 : *
35223 : * Elements are calculated row by row (example below is given
35224 : * for NAdd=1):
35225 : * * first, we solve L[0,0]*A1[0]=A[0]
35226 : * * then, we solve L[1,0]*A1[0]+L[1,1]*A1[1]=A[1]
35227 : * * then, we move to next row and so on
35228 : * * during calculation of A1 we update A12 - squared norm of A1
35229 : *
35230 : * We extensively use sparsity of both A/A1 and L:
35231 : * * first, equations from 0 to BANDWIDTH(A1)-1 are completely zero
35232 : * * second, for I>=BANDWIDTH(A1), I-th equation is reduced from
35233 : * L[I,0]*A1[0] + L[I,1]*A1[1] + ... + L[I,I]*A1[I] = A[I]
35234 : * to
35235 : * L[I,JNZ]*A1[JNZ] + ... + L[I,I]*A1[I] = A[I]
35236 : * where JNZ = max(NReady-BANDWIDTH(A1),I-BANDWIDTH(L[i]))
35237 : * (JNZ is an index of the firts column where both A and L become
35238 : * nonzero).
35239 : *
35240 : * NOTE: we rely on details of SparseMatrix internal storage format.
35241 : * This is allowed by SparseMatrix specification.
35242 : */
35243 0 : a12 = 0.0;
35244 0 : if( a->didx.ptr.p_int[nready]>0 )
35245 : {
35246 0 : banda = a->didx.ptr.p_int[nready];
35247 0 : for(i=nready-banda; i<=nready-1; i++)
35248 : {
35249 :
35250 : /*
35251 : * Elements of A1[0:I-1] were computed:
35252 : * * A1[0:NReady-BandA-1] are zero (sparse)
35253 : * * A1[NReady-BandA:I-1] replaced corresponding elements of A
35254 : *
35255 : * Now it is time to get I-th one.
35256 : *
35257 : * First, we calculate:
35258 : * * JNZA - index of the first column where A become nonzero
35259 : * * JNZL - index of the first column where L become nonzero
35260 : * * JNZ - index of the first column where both A and L become nonzero
35261 : * * OffsA - offset of A[JNZ] in A.Vals
35262 : * * OffsL - offset of L[I,JNZ] in A.Vals
35263 : *
35264 : * Then, we solve SUM(A1[j]*L[I,j],j=JNZ..I-1) + A1[I]*L[I,I] = A[I],
35265 : * with A1[JNZ..I-1] already known, and A1[I] unknown.
35266 : */
35267 0 : jnza = nready-banda;
35268 0 : jnzl = i-a->didx.ptr.p_int[i];
35269 0 : jnz = ae_maxint(jnza, jnzl, _state);
35270 0 : offsa = a->ridx.ptr.p_int[nready]+(jnz-jnza);
35271 0 : offsl = a->ridx.ptr.p_int[i]+(jnz-jnzl);
35272 0 : v = 0.0;
35273 0 : k = i-1-jnz;
35274 0 : for(j=0; j<=k; j++)
35275 : {
35276 0 : v = v+a->vals.ptr.p_double[offsa+j]*a->vals.ptr.p_double[offsl+j];
35277 : }
35278 0 : vv = (a->vals.ptr.p_double[offsa+k+1]-v)/a->vals.ptr.p_double[offsl+k+1];
35279 0 : a->vals.ptr.p_double[offsa+k+1] = vv;
35280 0 : a12 = a12+vv*vv;
35281 : }
35282 : }
35283 :
35284 : /*
35285 : * Calculate CHOLESKY(B-A1*A1')
35286 : */
35287 0 : offsa = a->ridx.ptr.p_int[nready]+a->didx.ptr.p_int[nready];
35288 0 : v = a->vals.ptr.p_double[offsa];
35289 0 : if( ae_fp_less_eq(v,a12) )
35290 : {
35291 0 : result = ae_false;
35292 0 : return result;
35293 : }
35294 0 : a->vals.ptr.p_double[offsa] = ae_sqrt(v-a12, _state);
35295 :
35296 : /*
35297 : * Increase size of the updated matrix
35298 : */
35299 0 : inc(&nready, _state);
35300 : }
35301 :
35302 : /*
35303 : * transpose if needed
35304 : */
35305 0 : if( isupper )
35306 : {
35307 0 : sparsetransposesks(a, _state);
35308 : }
35309 0 : result = ae_true;
35310 0 : return result;
35311 : }
35312 :
35313 :
35314 : /*************************************************************************
35315 : Sparse Cholesky decomposition for a matrix stored in any sparse storage,
35316 : without rows/cols permutation.
35317 :
35318 : This function is the most convenient (less parameters to specify), although
35319 : less efficient, version of sparse Cholesky.
35320 :
35321 : Internally it:
35322 : * calls SparseCholeskyAnalyze() function to perform symbolic analysis
35323 : phase with no permutation being configured.
35324 : * calls SparseCholeskyFactorize() function to perform numerical phase of
35325 : the factorization
35326 :
35327 : Following alternatives may result in better performance:
35328 : * using SparseCholeskyP(), which selects best pivoting available, which
35329 : almost always results in improved sparsity and cache locality
35330 : * using SparseCholeskyAnalyze() and SparseCholeskyFactorize() functions
35331 : directly, which may improve performance of repetitive factorizations
35332 : with same sparsity patterns.
35333 :
35334 : The latter also allows one to perform LDLT factorization of indefinite
35335 : matrix (one with strictly diagonal D, which is known to be stable only
35336 : in few special cases, like quasi-definite matrices).
35337 :
35338 : INPUT PARAMETERS:
35339 : A - a square NxN sparse matrix, stored in any storage format.
35340 : IsUpper - if IsUpper=True, then factorization is performed on upper
35341 : triangle. Another triangle is ignored on input, dropped
35342 : on output. Similarly, if IsUpper=False, the lower triangle
35343 : is processed.
35344 :
35345 : OUTPUT PARAMETERS:
35346 : A - the result of factorization, stored in CRS format:
35347 : * if IsUpper=True, then the upper triangle contains matrix
35348 : U such that A = U^T*U and the lower triangle is empty.
35349 : * similarly, if IsUpper=False, then lower triangular L is
35350 : returned and we have A = L*(L^T).
35351 : Note that THIS function does not perform permutation of
35352 : the rows to reduce fill-in.
35353 :
35354 : RESULT:
35355 : If the matrix is positive-definite, the function returns True.
35356 : Otherwise, the function returns False. Contents of A is undefined
35357 : in such case.
35358 :
35359 : NOTE: for performance reasons this function does NOT check that input
35360 : matrix includes only finite values. It is your responsibility to
35361 : make sure that there are no infinite or NAN values in the matrix.
35362 :
35363 : -- ALGLIB routine --
35364 : 16.09.2020
35365 : Bochkanov Sergey
35366 : *************************************************************************/
35367 0 : ae_bool sparsecholesky(sparsematrix* a, ae_bool isupper, ae_state *_state)
35368 : {
35369 : ae_frame _frame_block;
35370 : sparsedecompositionanalysis analysis;
35371 : ae_int_t facttype;
35372 : ae_int_t permtype;
35373 : ae_vector dummyd;
35374 : ae_vector dummyp;
35375 : ae_bool result;
35376 :
35377 0 : ae_frame_make(_state, &_frame_block);
35378 0 : memset(&analysis, 0, sizeof(analysis));
35379 0 : memset(&dummyd, 0, sizeof(dummyd));
35380 0 : memset(&dummyp, 0, sizeof(dummyp));
35381 0 : _sparsedecompositionanalysis_init(&analysis, _state, ae_true);
35382 0 : ae_vector_init(&dummyd, 0, DT_REAL, _state, ae_true);
35383 0 : ae_vector_init(&dummyp, 0, DT_INT, _state, ae_true);
35384 :
35385 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseCholesky: A is not square", _state);
35386 :
35387 : /*
35388 : * Quick exit
35389 : */
35390 0 : if( sparsegetnrows(a, _state)==0 )
35391 : {
35392 0 : result = ae_true;
35393 0 : ae_frame_leave(_state);
35394 0 : return result;
35395 : }
35396 :
35397 : /*
35398 : * Choose factorization and permutation: vanilla Cholesky and no permutation
35399 : */
35400 0 : facttype = 0;
35401 0 : permtype = -1;
35402 :
35403 : /*
35404 : * Easy case - CRS matrix in lower triangle, no conversion or transposition is needed
35405 : */
35406 0 : if( sparseiscrs(a, _state)&&!isupper )
35407 : {
35408 0 : result = spsymmanalyze(a, facttype, permtype, &analysis.analysis, _state);
35409 0 : if( !result )
35410 : {
35411 0 : ae_frame_leave(_state);
35412 0 : return result;
35413 : }
35414 0 : result = spsymmfactorize(&analysis.analysis, a, &dummyd, &dummyp, _state);
35415 0 : ae_frame_leave(_state);
35416 0 : return result;
35417 : }
35418 :
35419 : /*
35420 : * A bit more complex - we need conversion and/or transposition
35421 : */
35422 0 : if( isupper )
35423 : {
35424 0 : sparsecopytocrsbuf(a, &analysis.wrkat, _state);
35425 0 : sparsecopytransposecrsbuf(&analysis.wrkat, &analysis.wrka, _state);
35426 : }
35427 : else
35428 : {
35429 0 : sparsecopytocrsbuf(a, &analysis.wrka, _state);
35430 : }
35431 0 : result = spsymmanalyze(&analysis.wrka, facttype, permtype, &analysis.analysis, _state);
35432 0 : if( !result )
35433 : {
35434 0 : ae_frame_leave(_state);
35435 0 : return result;
35436 : }
35437 0 : result = spsymmfactorize(&analysis.analysis, &analysis.wrka, &dummyd, &dummyp, _state);
35438 0 : if( !result )
35439 : {
35440 0 : ae_frame_leave(_state);
35441 0 : return result;
35442 : }
35443 0 : if( isupper )
35444 : {
35445 0 : sparsecopytransposecrsbuf(&analysis.wrka, a, _state);
35446 : }
35447 : else
35448 : {
35449 0 : sparsecopybuf(&analysis.wrka, a, _state);
35450 : }
35451 0 : ae_frame_leave(_state);
35452 0 : return result;
35453 : }
35454 :
35455 :
35456 : /*************************************************************************
35457 : Sparse Cholesky decomposition for a matrix stored in any sparse storage
35458 : format, with performance-enhancing permutation of rows/cols.
35459 :
35460 : Present version is configured to perform supernodal permutation which
35461 : sparsity reducing ordering.
35462 :
35463 : This function is a wrapper around generic sparse decomposition functions
35464 : that internally:
35465 : * calls SparseCholeskyAnalyze() function to perform symbolic analysis
35466 : phase with best available permutation being configured.
35467 : * calls SparseCholeskyFactorize() function to perform numerical phase of
35468 : the factorization.
35469 :
35470 : NOTE: using SparseCholeskyAnalyze() and SparseCholeskyFactorize() directly
35471 : may improve performance of repetitive factorizations with same
35472 : sparsity patterns. It also allows one to perform LDLT factorization
35473 : of indefinite matrix - a factorization with strictly diagonal D,
35474 : which is known to be stable only in few special cases, like quasi-
35475 : definite matrices.
35476 :
35477 : INPUT PARAMETERS:
35478 : A - a square NxN sparse matrix, stored in any storage format.
35479 : IsUpper - if IsUpper=True, then factorization is performed on upper
35480 : triangle. Another triangle is ignored on input, dropped
35481 : on output. Similarly, if IsUpper=False, the lower triangle
35482 : is processed.
35483 :
35484 : OUTPUT PARAMETERS:
35485 : A - the result of factorization, stored in CRS format:
35486 : * if IsUpper=True, then the upper triangle contains matrix
35487 : U such that A = U^T*U and the lower triangle is empty.
35488 : * similarly, if IsUpper=False, then lower triangular L is
35489 : returned and we have A = L*(L^T).
35490 : P - a row/column permutation, a product of P0*P1*...*Pk, k=N-1,
35491 : with Pi being permutation of rows/cols I and P[I]
35492 :
35493 : RESULT:
35494 : If the matrix is positive-definite, the function returns True.
35495 : Otherwise, the function returns False. Contents of A is undefined
35496 : in such case.
35497 :
35498 : NOTE: for performance reasons this function does NOT check that input
35499 : matrix includes only finite values. It is your responsibility to
35500 : make sure that there are no infinite or NAN values in the matrix.
35501 :
35502 : -- ALGLIB routine --
35503 : 16.09.2020
35504 : Bochkanov Sergey
35505 : *************************************************************************/
35506 0 : ae_bool sparsecholeskyp(sparsematrix* a,
35507 : ae_bool isupper,
35508 : /* Integer */ ae_vector* p,
35509 : ae_state *_state)
35510 : {
35511 : ae_frame _frame_block;
35512 : sparsedecompositionanalysis analysis;
35513 : ae_vector dummyd;
35514 : ae_int_t facttype;
35515 : ae_int_t permtype;
35516 : ae_bool result;
35517 :
35518 0 : ae_frame_make(_state, &_frame_block);
35519 0 : memset(&analysis, 0, sizeof(analysis));
35520 0 : memset(&dummyd, 0, sizeof(dummyd));
35521 0 : ae_vector_clear(p);
35522 0 : _sparsedecompositionanalysis_init(&analysis, _state, ae_true);
35523 0 : ae_vector_init(&dummyd, 0, DT_REAL, _state, ae_true);
35524 :
35525 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseCholeskyP: A is not square", _state);
35526 :
35527 : /*
35528 : * Quick exit
35529 : */
35530 0 : if( sparsegetnrows(a, _state)==0 )
35531 : {
35532 0 : result = ae_true;
35533 0 : ae_frame_leave(_state);
35534 0 : return result;
35535 : }
35536 :
35537 : /*
35538 : * Choose factorization and permutation: vanilla Cholesky and best permutation available
35539 : */
35540 0 : facttype = 0;
35541 0 : permtype = 0;
35542 :
35543 : /*
35544 : * Easy case - CRS matrix in lower triangle, no conversion or transposition is needed
35545 : */
35546 0 : if( sparseiscrs(a, _state)&&!isupper )
35547 : {
35548 0 : result = spsymmanalyze(a, facttype, permtype, &analysis.analysis, _state);
35549 0 : if( !result )
35550 : {
35551 0 : ae_frame_leave(_state);
35552 0 : return result;
35553 : }
35554 0 : result = spsymmfactorize(&analysis.analysis, a, &dummyd, p, _state);
35555 0 : ae_frame_leave(_state);
35556 0 : return result;
35557 : }
35558 :
35559 : /*
35560 : * A bit more complex - we need conversion and/or transposition
35561 : */
35562 0 : if( isupper )
35563 : {
35564 0 : sparsecopytocrsbuf(a, &analysis.wrkat, _state);
35565 0 : sparsecopytransposecrsbuf(&analysis.wrkat, &analysis.wrka, _state);
35566 : }
35567 : else
35568 : {
35569 0 : sparsecopytocrsbuf(a, &analysis.wrka, _state);
35570 : }
35571 0 : result = spsymmanalyze(&analysis.wrka, facttype, permtype, &analysis.analysis, _state);
35572 0 : if( !result )
35573 : {
35574 0 : ae_frame_leave(_state);
35575 0 : return result;
35576 : }
35577 0 : result = spsymmfactorize(&analysis.analysis, &analysis.wrka, &dummyd, p, _state);
35578 0 : if( !result )
35579 : {
35580 0 : ae_frame_leave(_state);
35581 0 : return result;
35582 : }
35583 0 : if( isupper )
35584 : {
35585 0 : sparsecopytransposecrsbuf(&analysis.wrka, a, _state);
35586 : }
35587 : else
35588 : {
35589 0 : sparsecopybuf(&analysis.wrka, a, _state);
35590 : }
35591 0 : ae_frame_leave(_state);
35592 0 : return result;
35593 : }
35594 :
35595 :
35596 : /*************************************************************************
35597 : Sparse Cholesky/LDLT decomposition: symbolic analysis phase.
35598 :
35599 : This function is a part of the 'expert' sparse Cholesky API:
35600 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
35601 : matrix to be factorized into internal storage
35602 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
35603 : with lower bounds on pivot magnitudes and additional overflow safeguards
35604 : * SparseCholeskyFactorize(), that performs numeric factorization using
35605 : precomputed symbolic analysis and internally stored matrix - and outputs
35606 : result
35607 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
35608 : pattern into internal storage so one may reuse previously allocated
35609 : temporaries and previously performed symbolic analysis
35610 :
35611 : This specific function performs preliminary analysis of the Cholesky/LDLT
35612 : factorization. It allows to choose different permutation types and to
35613 : choose between classic Cholesky and indefinite LDLT factorization (the
35614 : latter is computed with strictly diagonal D, i.e. without Bunch-Kauffman
35615 : pivoting).
35616 :
35617 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
35618 : matrices. However, numerical stability is guaranteed ONLY for a class
35619 : of quasi-definite matrices.
35620 :
35621 : NOTE: all internal processing is performed with lower triangular matrices
35622 : stored in CRS format. Any other storage formats and/or upper
35623 : triangular storage means that one format conversion and/or one
35624 : transposition will be performed internally for the analysis and
35625 : factorization phases. Thus, highest performance is achieved when
35626 : input is a lower triangular CRS matrix.
35627 :
35628 : INPUT PARAMETERS:
35629 : A - sparse square matrix in any sparse storage format.
35630 : IsUpper - whether upper or lower triangle is decomposed (the
35631 : other one is ignored).
35632 : FactType - factorization type:
35633 : * 0 for traditional Cholesky of SPD matrix
35634 : * 1 for LDLT decomposition with strictly diagonal D,
35635 : which may have non-positive entries.
35636 : PermType - permutation type:
35637 : *-1 for absence of permutation
35638 : * 0 for best fill-in reducing permutation available
35639 : * 1 for supernodal ordering (improves locality and
35640 : performance, does NOT change fill-in factor)
35641 : * 2 for AMD (approximate minimum degree) ordering
35642 :
35643 : OUTPUT PARAMETERS:
35644 : Analysis - contains:
35645 : * symbolic analysis of the matrix structure which will
35646 : be used later to guide numerical factorization.
35647 : * specific numeric values loaded into internal memory
35648 : waiting for the factorization to be performed
35649 :
35650 : This function fails if and only if the matrix A is symbolically degenerate
35651 : i.e. has diagonal element which is exactly zero. In such case False is
35652 : returned, contents of Analysis object is undefined.
35653 :
35654 : -- ALGLIB routine --
35655 : 20.09.2020
35656 : Bochkanov Sergey
35657 : *************************************************************************/
35658 0 : ae_bool sparsecholeskyanalyze(sparsematrix* a,
35659 : ae_bool isupper,
35660 : ae_int_t facttype,
35661 : ae_int_t permtype,
35662 : sparsedecompositionanalysis* analysis,
35663 : ae_state *_state)
35664 : {
35665 : ae_bool result;
35666 :
35667 0 : _sparsedecompositionanalysis_clear(analysis);
35668 :
35669 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseCholeskyAnalyze: A is not square", _state);
35670 0 : ae_assert(facttype==0||facttype==1, "SparseCholeskyAnalyze: unexpected FactType", _state);
35671 0 : ae_assert((((permtype==0||permtype==1)||permtype==2)||permtype==-1)||permtype==-2, "SparseCholeskyAnalyze: unexpected PermType", _state);
35672 0 : analysis->n = sparsegetnrows(a, _state);
35673 0 : analysis->facttype = facttype;
35674 0 : analysis->permtype = permtype;
35675 0 : if( !sparseiscrs(a, _state) )
35676 : {
35677 :
35678 : /*
35679 : * The matrix is stored in non-CRS format. First, we have to convert
35680 : * it to CRS. Then we may need to transpose it in order to get lower
35681 : * triangular one (as supported by SPSymmAnalyze).
35682 : */
35683 0 : sparsecopytocrs(a, &analysis->crsa, _state);
35684 0 : if( isupper )
35685 : {
35686 0 : sparsecopytransposecrsbuf(&analysis->crsa, &analysis->crsat, _state);
35687 0 : result = spsymmanalyze(&analysis->crsat, facttype, permtype, &analysis->analysis, _state);
35688 : }
35689 : else
35690 : {
35691 0 : result = spsymmanalyze(&analysis->crsa, facttype, permtype, &analysis->analysis, _state);
35692 : }
35693 : }
35694 : else
35695 : {
35696 :
35697 : /*
35698 : * The matrix is stored in CRS format. However we may need to
35699 : * transpose it in order to get lower triangular one (as supported
35700 : * by SPSymmAnalyze).
35701 : */
35702 0 : if( isupper )
35703 : {
35704 0 : sparsecopytransposecrsbuf(a, &analysis->crsat, _state);
35705 0 : result = spsymmanalyze(&analysis->crsat, facttype, permtype, &analysis->analysis, _state);
35706 : }
35707 : else
35708 : {
35709 0 : result = spsymmanalyze(a, facttype, permtype, &analysis->analysis, _state);
35710 : }
35711 : }
35712 0 : return result;
35713 : }
35714 :
35715 :
35716 : /*************************************************************************
35717 : Allows to control stability-improving modification strategy for sparse
35718 : Cholesky/LDLT decompositions. Modified Cholesky is more robust than its
35719 : unmodified counterpart.
35720 :
35721 : This function is a part of the 'expert' sparse Cholesky API:
35722 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
35723 : matrix to be factorized into internal storage
35724 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
35725 : with lower bounds on pivot magnitudes and additional overflow safeguards
35726 : * SparseCholeskyFactorize(), that performs numeric factorization using
35727 : precomputed symbolic analysis and internally stored matrix - and outputs
35728 : result
35729 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
35730 : pattern into internal storage so one may reuse previously allocated
35731 : temporaries and previously performed symbolic analysis
35732 :
35733 : INPUT PARAMETERS:
35734 : Analysis - symbolic analysis of the matrix structure
35735 : ModStrategy - modification type:
35736 : * 0 for traditional Cholesky/LDLT (Cholesky fails when
35737 : encounters nonpositive pivot, LDLT fails when zero
35738 : pivot is encountered, no stability checks for
35739 : overflows/underflows)
35740 : * 1 for modified Cholesky with additional checks:
35741 : * pivots less than ModParam0 are increased; (similar
35742 : sign-preserving procedure is applied during LDLT)
35743 : * if, at some moment, sum of absolute values of
35744 : elements in column J will become greater than
35745 : ModParam1, Cholesky/LDLT will treat it as failure
35746 : and will stop immediately
35747 : P0, P1, P2,P3 - modification parameters #0 #1, #2 and #3.
35748 : Params #2 and #3 are ignored in current version.
35749 :
35750 : OUTPUT PARAMETERS:
35751 : Analysis - symbolic analysis of the matrix structure, new strategy
35752 : Results will be seen with next SparseCholeskyFactorize()
35753 : call.
35754 :
35755 : -- ALGLIB routine --
35756 : 20.09.2020
35757 : Bochkanov Sergey
35758 : *************************************************************************/
35759 0 : void sparsecholeskysetmodtype(sparsedecompositionanalysis* analysis,
35760 : ae_int_t modstrategy,
35761 : double p0,
35762 : double p1,
35763 : double p2,
35764 : double p3,
35765 : ae_state *_state)
35766 : {
35767 :
35768 :
35769 0 : spsymmsetmodificationstrategy(&analysis->analysis, modstrategy, p0, p1, p2, p3, _state);
35770 0 : }
35771 :
35772 :
35773 : /*************************************************************************
35774 : Sparse Cholesky decomposition: numerical analysis phase.
35775 :
35776 : This function is a part of the 'expert' sparse Cholesky API:
35777 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
35778 : matrix to be factorized into internal storage
35779 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
35780 : with lower bounds on pivot magnitudes and additional overflow safeguards
35781 : * SparseCholeskyFactorize(), that performs numeric factorization using
35782 : precomputed symbolic analysis and internally stored matrix - and outputs
35783 : result
35784 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
35785 : pattern into internal storage so one may reuse previously allocated
35786 : temporaries and previously performed symbolic analysis
35787 :
35788 : Depending on settings specified during SparseCholeskyAnalyze() call it may
35789 : produce classic Cholesky or L*D*LT decomposition (with strictly diagonal
35790 : D), without permutation or with performance-enhancing permutation P.
35791 :
35792 : NOTE: all internal processing is performed with lower triangular matrices
35793 : stored in CRS format. Any other storage formats and/or upper
35794 : triangular storage means that one format conversion and/or one
35795 : transposition will be performed internally for the analysis and
35796 : factorization phases. Thus, highest performance is achieved when
35797 : input is a lower triangular CRS matrix, and lower triangular output
35798 : is requested.
35799 :
35800 : NOTE: L*D*LT family of factorization may be used to factorize indefinite
35801 : matrices. However, numerical stability is guaranteed ONLY for a class
35802 : of quasi-definite matrices.
35803 :
35804 : INPUT PARAMETERS:
35805 : Analysis - prior analysis with internally stored matrix which will
35806 : be factorized
35807 : NeedUpper - whether upper triangular or lower triangular output is
35808 : needed
35809 :
35810 : OUTPUT PARAMETERS:
35811 : A - Cholesky decomposition of A stored in lower triangular
35812 : CRS format, i.e. A=L*L' (or upper triangular CRS, with
35813 : A=U'*U, depending on NeedUpper parameter).
35814 : D - array[N], diagonal factor. If no diagonal factor was
35815 : required during analysis phase, still returned but
35816 : filled with 1's
35817 : P - array[N], pivots. Permutation matrix P is a product of
35818 : P(0)*P(1)*...*P(N-1), where P(i) is a permutation of
35819 : row/col I and P[I] (with P[I]>=I).
35820 : If no permutation was requested during analysis phase,
35821 : still returned but filled with identity permutation.
35822 :
35823 : The function returns True when factorization resulted in nondegenerate
35824 : matrix. False is returned when factorization fails (Cholesky factorization
35825 : of indefinite matrix) or LDLT factorization has exactly zero elements at
35826 : the diagonal. In the latter case contents of A, D and P is undefined.
35827 :
35828 : The analysis object is not changed during the factorization. Subsequent
35829 : calls to SparseCholeskyFactorize() will result in same factorization being
35830 : performed one more time.
35831 :
35832 : -- ALGLIB routine --
35833 : 20.09.2020
35834 : Bochkanov Sergey
35835 : *************************************************************************/
35836 0 : ae_bool sparsecholeskyfactorize(sparsedecompositionanalysis* analysis,
35837 : ae_bool needupper,
35838 : sparsematrix* a,
35839 : /* Real */ ae_vector* d,
35840 : /* Integer */ ae_vector* p,
35841 : ae_state *_state)
35842 : {
35843 : ae_bool result;
35844 :
35845 0 : _sparsematrix_clear(a);
35846 0 : ae_vector_clear(d);
35847 0 : ae_vector_clear(p);
35848 :
35849 0 : if( needupper )
35850 : {
35851 0 : result = spsymmfactorize(&analysis->analysis, &analysis->wrka, d, p, _state);
35852 0 : if( !result )
35853 : {
35854 0 : return result;
35855 : }
35856 0 : sparsecopytransposecrsbuf(&analysis->wrka, a, _state);
35857 : }
35858 : else
35859 : {
35860 0 : result = spsymmfactorize(&analysis->analysis, a, d, p, _state);
35861 : }
35862 0 : return result;
35863 : }
35864 :
35865 :
35866 : /*************************************************************************
35867 : Sparse Cholesky decomposition: update internally stored matrix with
35868 : another one with exactly same sparsity pattern.
35869 :
35870 : This function is a part of the 'expert' sparse Cholesky API:
35871 : * SparseCholeskyAnalyze(), that performs symbolic analysis phase and loads
35872 : matrix to be factorized into internal storage
35873 : * SparseCholeskySetModType(), that allows to use modified Cholesky/LDLT
35874 : with lower bounds on pivot magnitudes and additional overflow safeguards
35875 : * SparseCholeskyFactorize(), that performs numeric factorization using
35876 : precomputed symbolic analysis and internally stored matrix - and outputs
35877 : result
35878 : * SparseCholeskyReload(), that reloads one more matrix with same sparsity
35879 : pattern into internal storage so one may reuse previously allocated
35880 : temporaries and previously performed symbolic analysis
35881 :
35882 : This specific function replaces internally stored numerical values with
35883 : ones from another sparse matrix (but having exactly same sparsity pattern
35884 : as one that was used for initial SparseCholeskyAnalyze() call).
35885 :
35886 : NOTE: all internal processing is performed with lower triangular matrices
35887 : stored in CRS format. Any other storage formats and/or upper
35888 : triangular storage means that one format conversion and/or one
35889 : transposition will be performed internally for the analysis and
35890 : factorization phases. Thus, highest performance is achieved when
35891 : input is a lower triangular CRS matrix.
35892 :
35893 : INPUT PARAMETERS:
35894 : Analysis - analysis object
35895 : A - sparse square matrix in any sparse storage format. It
35896 : MUST have exactly same sparsity pattern as that of the
35897 : matrix that was passed to SparseCholeskyAnalyze().
35898 : Any difference (missing elements or additional elements)
35899 : may result in unpredictable and undefined behavior -
35900 : an algorithm may fail due to memory access violation.
35901 : IsUpper - whether upper or lower triangle is decomposed (the
35902 : other one is ignored).
35903 :
35904 : OUTPUT PARAMETERS:
35905 : Analysis - contains:
35906 : * symbolic analysis of the matrix structure which will
35907 : be used later to guide numerical factorization.
35908 : * specific numeric values loaded into internal memory
35909 : waiting for the factorization to be performed
35910 :
35911 : -- ALGLIB routine --
35912 : 20.09.2020
35913 : Bochkanov Sergey
35914 : *************************************************************************/
35915 0 : void sparsecholeskyreload(sparsedecompositionanalysis* analysis,
35916 : sparsematrix* a,
35917 : ae_bool isupper,
35918 : ae_state *_state)
35919 : {
35920 :
35921 :
35922 0 : ae_assert(sparsegetnrows(a, _state)==sparsegetncols(a, _state), "SparseCholeskyReload: A is not square", _state);
35923 0 : ae_assert(sparsegetnrows(a, _state)==analysis->n, "SparseCholeskyReload: size of A does not match that stored in Analysis", _state);
35924 0 : if( !sparseiscrs(a, _state) )
35925 : {
35926 :
35927 : /*
35928 : * The matrix is stored in non-CRS format. First, we have to convert
35929 : * it to CRS. Then we may need to transpose it in order to get lower
35930 : * triangular one (as supported by SPSymmAnalyze).
35931 : */
35932 0 : sparsecopytocrs(a, &analysis->crsa, _state);
35933 0 : if( isupper )
35934 : {
35935 0 : sparsecopytransposecrsbuf(&analysis->crsa, &analysis->crsat, _state);
35936 0 : spsymmreload(&analysis->analysis, &analysis->crsat, _state);
35937 : }
35938 : else
35939 : {
35940 0 : spsymmreload(&analysis->analysis, &analysis->crsa, _state);
35941 : }
35942 : }
35943 : else
35944 : {
35945 :
35946 : /*
35947 : * The matrix is stored in CRS format. However we may need to
35948 : * transpose it in order to get lower triangular one (as supported
35949 : * by SPSymmAnalyze).
35950 : */
35951 0 : if( isupper )
35952 : {
35953 0 : sparsecopytransposecrsbuf(a, &analysis->crsat, _state);
35954 0 : spsymmreload(&analysis->analysis, &analysis->crsat, _state);
35955 : }
35956 : else
35957 : {
35958 0 : spsymmreload(&analysis->analysis, a, _state);
35959 : }
35960 : }
35961 0 : }
35962 :
35963 :
35964 0 : void rmatrixlup(/* Real */ ae_matrix* a,
35965 : ae_int_t m,
35966 : ae_int_t n,
35967 : /* Integer */ ae_vector* pivots,
35968 : ae_state *_state)
35969 : {
35970 : ae_frame _frame_block;
35971 : ae_vector tmp;
35972 : ae_int_t i;
35973 : ae_int_t j;
35974 : double mx;
35975 : double v;
35976 :
35977 0 : ae_frame_make(_state, &_frame_block);
35978 0 : memset(&tmp, 0, sizeof(tmp));
35979 0 : ae_vector_clear(pivots);
35980 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
35981 :
35982 :
35983 : /*
35984 : * Internal LU decomposition subroutine.
35985 : * Never call it directly.
35986 : */
35987 0 : ae_assert(m>0, "RMatrixLUP: incorrect M!", _state);
35988 0 : ae_assert(n>0, "RMatrixLUP: incorrect N!", _state);
35989 :
35990 : /*
35991 : * Scale matrix to avoid overflows,
35992 : * decompose it, then scale back.
35993 : */
35994 0 : mx = (double)(0);
35995 0 : for(i=0; i<=m-1; i++)
35996 : {
35997 0 : for(j=0; j<=n-1; j++)
35998 : {
35999 0 : mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state);
36000 : }
36001 : }
36002 0 : if( ae_fp_neq(mx,(double)(0)) )
36003 : {
36004 0 : v = 1/mx;
36005 0 : for(i=0; i<=m-1; i++)
36006 : {
36007 0 : ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v);
36008 : }
36009 : }
36010 0 : ae_vector_set_length(pivots, ae_minint(m, n, _state), _state);
36011 0 : ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state);
36012 0 : rmatrixluprec(a, 0, m, n, pivots, &tmp, _state);
36013 0 : if( ae_fp_neq(mx,(double)(0)) )
36014 : {
36015 0 : v = mx;
36016 0 : for(i=0; i<=m-1; i++)
36017 : {
36018 0 : ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v);
36019 : }
36020 : }
36021 0 : ae_frame_leave(_state);
36022 0 : }
36023 :
36024 :
36025 0 : void cmatrixlup(/* Complex */ ae_matrix* a,
36026 : ae_int_t m,
36027 : ae_int_t n,
36028 : /* Integer */ ae_vector* pivots,
36029 : ae_state *_state)
36030 : {
36031 : ae_frame _frame_block;
36032 : ae_vector tmp;
36033 : ae_int_t i;
36034 : ae_int_t j;
36035 : double mx;
36036 : double v;
36037 :
36038 0 : ae_frame_make(_state, &_frame_block);
36039 0 : memset(&tmp, 0, sizeof(tmp));
36040 0 : ae_vector_clear(pivots);
36041 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
36042 :
36043 :
36044 : /*
36045 : * Internal LU decomposition subroutine.
36046 : * Never call it directly.
36047 : */
36048 0 : ae_assert(m>0, "CMatrixLUP: incorrect M!", _state);
36049 0 : ae_assert(n>0, "CMatrixLUP: incorrect N!", _state);
36050 :
36051 : /*
36052 : * Scale matrix to avoid overflows,
36053 : * decompose it, then scale back.
36054 : */
36055 0 : mx = (double)(0);
36056 0 : for(i=0; i<=m-1; i++)
36057 : {
36058 0 : for(j=0; j<=n-1; j++)
36059 : {
36060 0 : mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state);
36061 : }
36062 : }
36063 0 : if( ae_fp_neq(mx,(double)(0)) )
36064 : {
36065 0 : v = 1/mx;
36066 0 : for(i=0; i<=m-1; i++)
36067 : {
36068 0 : ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v);
36069 : }
36070 : }
36071 0 : ae_vector_set_length(pivots, ae_minint(m, n, _state), _state);
36072 0 : ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state);
36073 0 : cmatrixluprec(a, 0, m, n, pivots, &tmp, _state);
36074 0 : if( ae_fp_neq(mx,(double)(0)) )
36075 : {
36076 0 : v = mx;
36077 0 : for(i=0; i<=m-1; i++)
36078 : {
36079 0 : ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v);
36080 : }
36081 : }
36082 0 : ae_frame_leave(_state);
36083 0 : }
36084 :
36085 :
36086 0 : void rmatrixplu(/* Real */ ae_matrix* a,
36087 : ae_int_t m,
36088 : ae_int_t n,
36089 : /* Integer */ ae_vector* pivots,
36090 : ae_state *_state)
36091 : {
36092 : ae_frame _frame_block;
36093 : ae_vector tmp;
36094 : ae_int_t i;
36095 : ae_int_t j;
36096 : double mx;
36097 : double v;
36098 :
36099 0 : ae_frame_make(_state, &_frame_block);
36100 0 : memset(&tmp, 0, sizeof(tmp));
36101 0 : ae_vector_clear(pivots);
36102 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
36103 :
36104 :
36105 : /*
36106 : * Internal LU decomposition subroutine.
36107 : * Never call it directly.
36108 : */
36109 0 : ae_assert(m>0, "RMatrixPLU: incorrect M!", _state);
36110 0 : ae_assert(n>0, "RMatrixPLU: incorrect N!", _state);
36111 0 : ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state);
36112 0 : ae_vector_set_length(pivots, ae_minint(m, n, _state), _state);
36113 :
36114 : /*
36115 : * Scale matrix to avoid overflows,
36116 : * decompose it, then scale back.
36117 : */
36118 0 : mx = (double)(0);
36119 0 : for(i=0; i<=m-1; i++)
36120 : {
36121 0 : for(j=0; j<=n-1; j++)
36122 : {
36123 0 : mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state);
36124 : }
36125 : }
36126 0 : if( ae_fp_neq(mx,(double)(0)) )
36127 : {
36128 0 : v = 1/mx;
36129 0 : for(i=0; i<=m-1; i++)
36130 : {
36131 0 : ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v);
36132 : }
36133 : }
36134 0 : rmatrixplurec(a, 0, m, n, pivots, &tmp, _state);
36135 0 : if( ae_fp_neq(mx,(double)(0)) )
36136 : {
36137 0 : v = mx;
36138 0 : for(i=0; i<=ae_minint(m, n, _state)-1; i++)
36139 : {
36140 0 : ae_v_muld(&a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v);
36141 : }
36142 : }
36143 0 : ae_frame_leave(_state);
36144 0 : }
36145 :
36146 :
36147 0 : void cmatrixplu(/* Complex */ ae_matrix* a,
36148 : ae_int_t m,
36149 : ae_int_t n,
36150 : /* Integer */ ae_vector* pivots,
36151 : ae_state *_state)
36152 : {
36153 : ae_frame _frame_block;
36154 : ae_vector tmp;
36155 : ae_int_t i;
36156 : ae_int_t j;
36157 : double mx;
36158 : ae_complex v;
36159 :
36160 0 : ae_frame_make(_state, &_frame_block);
36161 0 : memset(&tmp, 0, sizeof(tmp));
36162 0 : ae_vector_clear(pivots);
36163 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
36164 :
36165 :
36166 : /*
36167 : * Internal LU decomposition subroutine.
36168 : * Never call it directly.
36169 : */
36170 0 : ae_assert(m>0, "CMatrixPLU: incorrect M!", _state);
36171 0 : ae_assert(n>0, "CMatrixPLU: incorrect N!", _state);
36172 0 : ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state);
36173 0 : ae_vector_set_length(pivots, ae_minint(m, n, _state), _state);
36174 :
36175 : /*
36176 : * Scale matrix to avoid overflows,
36177 : * decompose it, then scale back.
36178 : */
36179 0 : mx = (double)(0);
36180 0 : for(i=0; i<=m-1; i++)
36181 : {
36182 0 : for(j=0; j<=n-1; j++)
36183 : {
36184 0 : mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state);
36185 : }
36186 : }
36187 0 : if( ae_fp_neq(mx,(double)(0)) )
36188 : {
36189 0 : v = ae_complex_from_d(1/mx);
36190 0 : for(i=0; i<=m-1; i++)
36191 : {
36192 0 : ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v);
36193 : }
36194 : }
36195 0 : cmatrixplurec(a, 0, m, n, pivots, &tmp, _state);
36196 0 : if( ae_fp_neq(mx,(double)(0)) )
36197 : {
36198 0 : v = ae_complex_from_d(mx);
36199 0 : for(i=0; i<=ae_minint(m, n, _state)-1; i++)
36200 : {
36201 0 : ae_v_cmulc(&a->ptr.pp_complex[i][i], 1, ae_v_len(i,n-1), v);
36202 : }
36203 : }
36204 0 : ae_frame_leave(_state);
36205 0 : }
36206 :
36207 :
36208 : /*************************************************************************
36209 : Advanced interface for SPDMatrixCholesky, performs no temporary allocations.
36210 :
36211 : INPUT PARAMETERS:
36212 : A - matrix given by upper or lower triangle
36213 : Offs - offset of diagonal block to decompose
36214 : N - diagonal block size
36215 : IsUpper - what half is given
36216 : Tmp - temporary array; allocated by function, if its size is too
36217 : small; can be reused on subsequent calls.
36218 :
36219 : OUTPUT PARAMETERS:
36220 : A - upper (or lower) triangle contains Cholesky decomposition
36221 :
36222 : RESULT:
36223 : True, on success
36224 : False, on failure
36225 :
36226 : -- ALGLIB routine --
36227 : 15.12.2009
36228 : Bochkanov Sergey
36229 : *************************************************************************/
36230 0 : ae_bool spdmatrixcholeskyrec(/* Real */ ae_matrix* a,
36231 : ae_int_t offs,
36232 : ae_int_t n,
36233 : ae_bool isupper,
36234 : /* Real */ ae_vector* tmp,
36235 : ae_state *_state)
36236 : {
36237 : ae_int_t n1;
36238 : ae_int_t n2;
36239 : ae_int_t tsa;
36240 : ae_int_t tsb;
36241 : ae_bool result;
36242 :
36243 :
36244 0 : tsa = matrixtilesizea(_state);
36245 0 : tsb = matrixtilesizeb(_state);
36246 :
36247 : /*
36248 : * Allocate temporaries
36249 : */
36250 0 : if( tmp->cnt<2*n )
36251 : {
36252 0 : ae_vector_set_length(tmp, 2*n, _state);
36253 : }
36254 :
36255 : /*
36256 : * Basecases
36257 : */
36258 0 : if( n<1 )
36259 : {
36260 0 : result = ae_false;
36261 0 : return result;
36262 : }
36263 0 : if( n==1 )
36264 : {
36265 0 : if( ae_fp_greater(a->ptr.pp_double[offs][offs],(double)(0)) )
36266 : {
36267 0 : a->ptr.pp_double[offs][offs] = ae_sqrt(a->ptr.pp_double[offs][offs], _state);
36268 0 : result = ae_true;
36269 : }
36270 : else
36271 : {
36272 0 : result = ae_false;
36273 : }
36274 0 : return result;
36275 : }
36276 0 : if( n<=tsb )
36277 : {
36278 0 : if( spdmatrixcholeskymkl(a, offs, n, isupper, &result, _state) )
36279 : {
36280 0 : return result;
36281 : }
36282 : }
36283 0 : if( n<=tsa )
36284 : {
36285 0 : result = trfac_spdmatrixcholesky2(a, offs, n, isupper, tmp, _state);
36286 0 : return result;
36287 : }
36288 :
36289 : /*
36290 : * Split task into smaller ones
36291 : */
36292 0 : if( n>tsb )
36293 : {
36294 :
36295 : /*
36296 : * Split leading B-sized block from the beginning (block-matrix approach)
36297 : */
36298 0 : n1 = tsb;
36299 0 : n2 = n-n1;
36300 : }
36301 : else
36302 : {
36303 :
36304 : /*
36305 : * Smaller than B-size, perform cache-oblivious split
36306 : */
36307 0 : tiledsplit(n, tsa, &n1, &n2, _state);
36308 : }
36309 0 : result = spdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state);
36310 0 : if( !result )
36311 : {
36312 0 : return result;
36313 : }
36314 0 : if( n2>0 )
36315 : {
36316 0 : if( isupper )
36317 : {
36318 0 : rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 1, a, offs, offs+n1, _state);
36319 0 : rmatrixsyrk(n2, n1, -1.0, a, offs, offs+n1, 1, 1.0, a, offs+n1, offs+n1, isupper, _state);
36320 : }
36321 : else
36322 : {
36323 0 : rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 1, a, offs+n1, offs, _state);
36324 0 : rmatrixsyrk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state);
36325 : }
36326 0 : result = spdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state);
36327 0 : if( !result )
36328 : {
36329 0 : return result;
36330 : }
36331 : }
36332 0 : return result;
36333 : }
36334 :
36335 :
36336 : /*************************************************************************
36337 : Recursive computational subroutine for HPDMatrixCholesky
36338 :
36339 : -- ALGLIB routine --
36340 : 15.12.2009
36341 : Bochkanov Sergey
36342 : *************************************************************************/
36343 0 : static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a,
36344 : ae_int_t offs,
36345 : ae_int_t n,
36346 : ae_bool isupper,
36347 : /* Complex */ ae_vector* tmp,
36348 : ae_state *_state)
36349 : {
36350 : ae_int_t n1;
36351 : ae_int_t n2;
36352 : ae_int_t tsa;
36353 : ae_int_t tsb;
36354 : ae_bool result;
36355 :
36356 :
36357 0 : tsa = matrixtilesizea(_state)/2;
36358 0 : tsb = matrixtilesizeb(_state);
36359 :
36360 : /*
36361 : * check N
36362 : */
36363 0 : if( n<1 )
36364 : {
36365 0 : result = ae_false;
36366 0 : return result;
36367 : }
36368 :
36369 : /*
36370 : * Prepare buffer
36371 : */
36372 0 : if( tmp->cnt<2*n )
36373 : {
36374 0 : ae_vector_set_length(tmp, 2*n, _state);
36375 : }
36376 :
36377 : /*
36378 : * Basecases
36379 : *
36380 : * NOTE: we do not use MKL for basecases because their price is only
36381 : * minor part of overall running time for N>256.
36382 : */
36383 0 : if( n==1 )
36384 : {
36385 0 : if( ae_fp_greater(a->ptr.pp_complex[offs][offs].x,(double)(0)) )
36386 : {
36387 0 : a->ptr.pp_complex[offs][offs] = ae_complex_from_d(ae_sqrt(a->ptr.pp_complex[offs][offs].x, _state));
36388 0 : result = ae_true;
36389 : }
36390 : else
36391 : {
36392 0 : result = ae_false;
36393 : }
36394 0 : return result;
36395 : }
36396 0 : if( n<=tsa )
36397 : {
36398 0 : result = trfac_hpdmatrixcholesky2(a, offs, n, isupper, tmp, _state);
36399 0 : return result;
36400 : }
36401 :
36402 : /*
36403 : * Split task into smaller ones
36404 : */
36405 0 : if( n>tsb )
36406 : {
36407 :
36408 : /*
36409 : * Split leading B-sized block from the beginning (block-matrix approach)
36410 : */
36411 0 : n1 = tsb;
36412 0 : n2 = n-n1;
36413 : }
36414 : else
36415 : {
36416 :
36417 : /*
36418 : * Smaller than B-size, perform cache-oblivious split
36419 : */
36420 0 : tiledsplit(n, tsa, &n1, &n2, _state);
36421 : }
36422 0 : result = trfac_hpdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state);
36423 0 : if( !result )
36424 : {
36425 0 : return result;
36426 : }
36427 0 : if( n2>0 )
36428 : {
36429 0 : if( isupper )
36430 : {
36431 0 : cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 2, a, offs, offs+n1, _state);
36432 0 : cmatrixherk(n2, n1, -1.0, a, offs, offs+n1, 2, 1.0, a, offs+n1, offs+n1, isupper, _state);
36433 : }
36434 : else
36435 : {
36436 0 : cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 2, a, offs+n1, offs, _state);
36437 0 : cmatrixherk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state);
36438 : }
36439 0 : result = trfac_hpdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state);
36440 0 : if( !result )
36441 : {
36442 0 : return result;
36443 : }
36444 : }
36445 0 : return result;
36446 : }
36447 :
36448 :
36449 : /*************************************************************************
36450 : Level-2 Hermitian Cholesky subroutine.
36451 :
36452 : -- LAPACK routine (version 3.0) --
36453 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
36454 : Courant Institute, Argonne National Lab, and Rice University
36455 : February 29, 1992
36456 : *************************************************************************/
36457 0 : static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa,
36458 : ae_int_t offs,
36459 : ae_int_t n,
36460 : ae_bool isupper,
36461 : /* Complex */ ae_vector* tmp,
36462 : ae_state *_state)
36463 : {
36464 : ae_int_t i;
36465 : ae_int_t j;
36466 : double ajj;
36467 : ae_complex v;
36468 : double r;
36469 : ae_bool result;
36470 :
36471 :
36472 0 : result = ae_true;
36473 0 : if( n<0 )
36474 : {
36475 0 : result = ae_false;
36476 0 : return result;
36477 : }
36478 :
36479 : /*
36480 : * Quick return if possible
36481 : */
36482 0 : if( n==0 )
36483 : {
36484 0 : return result;
36485 : }
36486 0 : if( isupper )
36487 : {
36488 :
36489 : /*
36490 : * Compute the Cholesky factorization A = U'*U.
36491 : */
36492 0 : for(j=0; j<=n-1; j++)
36493 : {
36494 :
36495 : /*
36496 : * Compute U(J,J) and test for non-positive-definiteness.
36497 : */
36498 0 : v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "N", ae_v_len(offs,offs+j-1));
36499 0 : ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x;
36500 0 : if( ae_fp_less_eq(ajj,(double)(0)) )
36501 : {
36502 0 : aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj);
36503 0 : result = ae_false;
36504 0 : return result;
36505 : }
36506 0 : ajj = ae_sqrt(ajj, _state);
36507 0 : aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj);
36508 :
36509 : /*
36510 : * Compute elements J+1:N-1 of row J.
36511 : */
36512 0 : if( j<n-1 )
36513 : {
36514 0 : if( j>0 )
36515 : {
36516 0 : ae_v_cmoveneg(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", ae_v_len(0,j-1));
36517 0 : cmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state);
36518 0 : ae_v_cadd(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, &tmp->ptr.p_complex[n], 1, "N", ae_v_len(offs+j+1,offs+n-1));
36519 : }
36520 0 : r = 1/ajj;
36521 0 : ae_v_cmuld(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r);
36522 : }
36523 : }
36524 : }
36525 : else
36526 : {
36527 :
36528 : /*
36529 : * Compute the Cholesky factorization A = L*L'.
36530 : */
36531 0 : for(j=0; j<=n-1; j++)
36532 : {
36533 :
36534 : /*
36535 : * Compute L(J+1,J+1) and test for non-positive-definiteness.
36536 : */
36537 0 : v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", &aaa->ptr.pp_complex[offs+j][offs], 1, "N", ae_v_len(offs,offs+j-1));
36538 0 : ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x;
36539 0 : if( ae_fp_less_eq(ajj,(double)(0)) )
36540 : {
36541 0 : aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj);
36542 0 : result = ae_false;
36543 0 : return result;
36544 : }
36545 0 : ajj = ae_sqrt(ajj, _state);
36546 0 : aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj);
36547 :
36548 : /*
36549 : * Compute elements J+1:N of column J.
36550 : */
36551 0 : if( j<n-1 )
36552 : {
36553 0 : r = 1/ajj;
36554 0 : if( j>0 )
36555 : {
36556 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", ae_v_len(0,j-1));
36557 0 : cmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state);
36558 0 : for(i=0; i<=n-j-2; i++)
36559 : {
36560 0 : aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_mul_d(ae_c_sub(aaa->ptr.pp_complex[offs+j+1+i][offs+j],tmp->ptr.p_complex[n+i]),r);
36561 : }
36562 : }
36563 : else
36564 : {
36565 0 : for(i=0; i<=n-j-2; i++)
36566 : {
36567 0 : aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_mul_d(aaa->ptr.pp_complex[offs+j+1+i][offs+j],r);
36568 : }
36569 : }
36570 : }
36571 : }
36572 : }
36573 0 : return result;
36574 : }
36575 :
36576 :
36577 : /*************************************************************************
36578 : Level-2 Cholesky subroutine
36579 :
36580 : -- LAPACK routine (version 3.0) --
36581 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
36582 : Courant Institute, Argonne National Lab, and Rice University
36583 : February 29, 1992
36584 : *************************************************************************/
36585 0 : static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa,
36586 : ae_int_t offs,
36587 : ae_int_t n,
36588 : ae_bool isupper,
36589 : /* Real */ ae_vector* tmp,
36590 : ae_state *_state)
36591 : {
36592 : ae_int_t i;
36593 : ae_int_t j;
36594 : double ajj;
36595 : double v;
36596 : double r;
36597 : ae_bool result;
36598 :
36599 :
36600 0 : result = ae_true;
36601 0 : if( n<0 )
36602 : {
36603 0 : result = ae_false;
36604 0 : return result;
36605 : }
36606 :
36607 : /*
36608 : * Quick return if possible
36609 : */
36610 0 : if( n==0 )
36611 : {
36612 0 : return result;
36613 : }
36614 0 : if( isupper )
36615 : {
36616 :
36617 : /*
36618 : * Compute the Cholesky factorization A = U'*U.
36619 : */
36620 0 : for(j=0; j<=n-1; j++)
36621 : {
36622 :
36623 : /*
36624 : * Compute U(J,J) and test for non-positive-definiteness.
36625 : */
36626 0 : v = ae_v_dotproduct(&aaa->ptr.pp_double[offs][offs+j], aaa->stride, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(offs,offs+j-1));
36627 0 : ajj = aaa->ptr.pp_double[offs+j][offs+j]-v;
36628 0 : if( ae_fp_less_eq(ajj,(double)(0)) )
36629 : {
36630 0 : aaa->ptr.pp_double[offs+j][offs+j] = ajj;
36631 0 : result = ae_false;
36632 0 : return result;
36633 : }
36634 0 : ajj = ae_sqrt(ajj, _state);
36635 0 : aaa->ptr.pp_double[offs+j][offs+j] = ajj;
36636 :
36637 : /*
36638 : * Compute elements J+1:N-1 of row J.
36639 : */
36640 0 : if( j<n-1 )
36641 : {
36642 0 : if( j>0 )
36643 : {
36644 0 : ae_v_moveneg(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(0,j-1));
36645 0 : rmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state);
36646 0 : ae_v_add(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, &tmp->ptr.p_double[n], 1, ae_v_len(offs+j+1,offs+n-1));
36647 : }
36648 0 : r = 1/ajj;
36649 0 : ae_v_muld(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r);
36650 : }
36651 : }
36652 : }
36653 : else
36654 : {
36655 :
36656 : /*
36657 : * Compute the Cholesky factorization A = L*L'.
36658 : */
36659 0 : for(j=0; j<=n-1; j++)
36660 : {
36661 :
36662 : /*
36663 : * Compute L(J+1,J+1) and test for non-positive-definiteness.
36664 : */
36665 0 : v = ae_v_dotproduct(&aaa->ptr.pp_double[offs+j][offs], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(offs,offs+j-1));
36666 0 : ajj = aaa->ptr.pp_double[offs+j][offs+j]-v;
36667 0 : if( ae_fp_less_eq(ajj,(double)(0)) )
36668 : {
36669 0 : aaa->ptr.pp_double[offs+j][offs+j] = ajj;
36670 0 : result = ae_false;
36671 0 : return result;
36672 : }
36673 0 : ajj = ae_sqrt(ajj, _state);
36674 0 : aaa->ptr.pp_double[offs+j][offs+j] = ajj;
36675 :
36676 : /*
36677 : * Compute elements J+1:N of column J.
36678 : */
36679 0 : if( j<n-1 )
36680 : {
36681 0 : r = 1/ajj;
36682 0 : if( j>0 )
36683 : {
36684 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(0,j-1));
36685 0 : rmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state);
36686 0 : for(i=0; i<=n-j-2; i++)
36687 : {
36688 0 : aaa->ptr.pp_double[offs+j+1+i][offs+j] = (aaa->ptr.pp_double[offs+j+1+i][offs+j]-tmp->ptr.p_double[n+i])*r;
36689 : }
36690 : }
36691 : else
36692 : {
36693 0 : for(i=0; i<=n-j-2; i++)
36694 : {
36695 0 : aaa->ptr.pp_double[offs+j+1+i][offs+j] = aaa->ptr.pp_double[offs+j+1+i][offs+j]*r;
36696 : }
36697 : }
36698 : }
36699 : }
36700 : }
36701 0 : return result;
36702 : }
36703 :
36704 :
36705 0 : void _sparsedecompositionanalysis_init(void* _p, ae_state *_state, ae_bool make_automatic)
36706 : {
36707 0 : sparsedecompositionanalysis *p = (sparsedecompositionanalysis*)_p;
36708 0 : ae_touch_ptr((void*)p);
36709 0 : _spcholanalysis_init(&p->analysis, _state, make_automatic);
36710 0 : _sparsematrix_init(&p->wrka, _state, make_automatic);
36711 0 : _sparsematrix_init(&p->wrkat, _state, make_automatic);
36712 0 : _sparsematrix_init(&p->crsa, _state, make_automatic);
36713 0 : _sparsematrix_init(&p->crsat, _state, make_automatic);
36714 0 : }
36715 :
36716 :
36717 0 : void _sparsedecompositionanalysis_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
36718 : {
36719 0 : sparsedecompositionanalysis *dst = (sparsedecompositionanalysis*)_dst;
36720 0 : sparsedecompositionanalysis *src = (sparsedecompositionanalysis*)_src;
36721 0 : dst->n = src->n;
36722 0 : dst->facttype = src->facttype;
36723 0 : dst->permtype = src->permtype;
36724 0 : _spcholanalysis_init_copy(&dst->analysis, &src->analysis, _state, make_automatic);
36725 0 : _sparsematrix_init_copy(&dst->wrka, &src->wrka, _state, make_automatic);
36726 0 : _sparsematrix_init_copy(&dst->wrkat, &src->wrkat, _state, make_automatic);
36727 0 : _sparsematrix_init_copy(&dst->crsa, &src->crsa, _state, make_automatic);
36728 0 : _sparsematrix_init_copy(&dst->crsat, &src->crsat, _state, make_automatic);
36729 0 : }
36730 :
36731 :
36732 0 : void _sparsedecompositionanalysis_clear(void* _p)
36733 : {
36734 0 : sparsedecompositionanalysis *p = (sparsedecompositionanalysis*)_p;
36735 0 : ae_touch_ptr((void*)p);
36736 0 : _spcholanalysis_clear(&p->analysis);
36737 0 : _sparsematrix_clear(&p->wrka);
36738 0 : _sparsematrix_clear(&p->wrkat);
36739 0 : _sparsematrix_clear(&p->crsa);
36740 0 : _sparsematrix_clear(&p->crsat);
36741 0 : }
36742 :
36743 :
36744 0 : void _sparsedecompositionanalysis_destroy(void* _p)
36745 : {
36746 0 : sparsedecompositionanalysis *p = (sparsedecompositionanalysis*)_p;
36747 0 : ae_touch_ptr((void*)p);
36748 0 : _spcholanalysis_destroy(&p->analysis);
36749 0 : _sparsematrix_destroy(&p->wrka);
36750 0 : _sparsematrix_destroy(&p->wrkat);
36751 0 : _sparsematrix_destroy(&p->crsa);
36752 0 : _sparsematrix_destroy(&p->crsat);
36753 0 : }
36754 :
36755 :
36756 : #endif
36757 : #if defined(AE_COMPILE_RCOND) || !defined(AE_PARTIAL_BUILD)
36758 :
36759 :
36760 : /*************************************************************************
36761 : Estimate of a matrix condition number (1-norm)
36762 :
36763 : The algorithm calculates a lower bound of the condition number. In this case,
36764 : the algorithm does not return a lower bound of the condition number, but an
36765 : inverse number (to avoid an overflow in case of a singular matrix).
36766 :
36767 : Input parameters:
36768 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
36769 : N - size of matrix A.
36770 :
36771 : Result: 1/LowerBound(cond(A))
36772 :
36773 : NOTE:
36774 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
36775 : 0.0 is returned in such cases.
36776 : *************************************************************************/
36777 0 : double rmatrixrcond1(/* Real */ ae_matrix* a,
36778 : ae_int_t n,
36779 : ae_state *_state)
36780 : {
36781 : ae_frame _frame_block;
36782 : ae_matrix _a;
36783 : ae_int_t i;
36784 : ae_int_t j;
36785 : double v;
36786 : double nrm;
36787 : ae_vector pivots;
36788 : ae_vector t;
36789 : double result;
36790 :
36791 0 : ae_frame_make(_state, &_frame_block);
36792 0 : memset(&_a, 0, sizeof(_a));
36793 0 : memset(&pivots, 0, sizeof(pivots));
36794 0 : memset(&t, 0, sizeof(t));
36795 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
36796 0 : a = &_a;
36797 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
36798 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
36799 :
36800 0 : ae_assert(n>=1, "RMatrixRCond1: N<1!", _state);
36801 0 : ae_vector_set_length(&t, n, _state);
36802 0 : for(i=0; i<=n-1; i++)
36803 : {
36804 0 : t.ptr.p_double[i] = (double)(0);
36805 : }
36806 0 : for(i=0; i<=n-1; i++)
36807 : {
36808 0 : for(j=0; j<=n-1; j++)
36809 : {
36810 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state);
36811 : }
36812 : }
36813 0 : nrm = (double)(0);
36814 0 : for(i=0; i<=n-1; i++)
36815 : {
36816 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
36817 : }
36818 0 : rmatrixlu(a, n, n, &pivots, _state);
36819 0 : rcond_rmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state);
36820 0 : result = v;
36821 0 : ae_frame_leave(_state);
36822 0 : return result;
36823 : }
36824 :
36825 :
36826 : /*************************************************************************
36827 : Estimate of a matrix condition number (infinity-norm).
36828 :
36829 : The algorithm calculates a lower bound of the condition number. In this case,
36830 : the algorithm does not return a lower bound of the condition number, but an
36831 : inverse number (to avoid an overflow in case of a singular matrix).
36832 :
36833 : Input parameters:
36834 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
36835 : N - size of matrix A.
36836 :
36837 : Result: 1/LowerBound(cond(A))
36838 :
36839 : NOTE:
36840 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
36841 : 0.0 is returned in such cases.
36842 : *************************************************************************/
36843 0 : double rmatrixrcondinf(/* Real */ ae_matrix* a,
36844 : ae_int_t n,
36845 : ae_state *_state)
36846 : {
36847 : ae_frame _frame_block;
36848 : ae_matrix _a;
36849 : ae_int_t i;
36850 : ae_int_t j;
36851 : double v;
36852 : double nrm;
36853 : ae_vector pivots;
36854 : double result;
36855 :
36856 0 : ae_frame_make(_state, &_frame_block);
36857 0 : memset(&_a, 0, sizeof(_a));
36858 0 : memset(&pivots, 0, sizeof(pivots));
36859 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
36860 0 : a = &_a;
36861 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
36862 :
36863 0 : ae_assert(n>=1, "RMatrixRCondInf: N<1!", _state);
36864 0 : nrm = (double)(0);
36865 0 : for(i=0; i<=n-1; i++)
36866 : {
36867 0 : v = (double)(0);
36868 0 : for(j=0; j<=n-1; j++)
36869 : {
36870 0 : v = v+ae_fabs(a->ptr.pp_double[i][j], _state);
36871 : }
36872 0 : nrm = ae_maxreal(nrm, v, _state);
36873 : }
36874 0 : rmatrixlu(a, n, n, &pivots, _state);
36875 0 : rcond_rmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state);
36876 0 : result = v;
36877 0 : ae_frame_leave(_state);
36878 0 : return result;
36879 : }
36880 :
36881 :
36882 : /*************************************************************************
36883 : Condition number estimate of a symmetric positive definite matrix.
36884 :
36885 : The algorithm calculates a lower bound of the condition number. In this case,
36886 : the algorithm does not return a lower bound of the condition number, but an
36887 : inverse number (to avoid an overflow in case of a singular matrix).
36888 :
36889 : It should be noted that 1-norm and inf-norm of condition numbers of symmetric
36890 : matrices are equal, so the algorithm doesn't take into account the
36891 : differences between these types of norms.
36892 :
36893 : Input parameters:
36894 : A - symmetric positive definite matrix which is given by its
36895 : upper or lower triangle depending on the value of
36896 : IsUpper. Array with elements [0..N-1, 0..N-1].
36897 : N - size of matrix A.
36898 : IsUpper - storage format.
36899 :
36900 : Result:
36901 : 1/LowerBound(cond(A)), if matrix A is positive definite,
36902 : -1, if matrix A is not positive definite, and its condition number
36903 : could not be found by this algorithm.
36904 :
36905 : NOTE:
36906 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
36907 : 0.0 is returned in such cases.
36908 : *************************************************************************/
36909 0 : double spdmatrixrcond(/* Real */ ae_matrix* a,
36910 : ae_int_t n,
36911 : ae_bool isupper,
36912 : ae_state *_state)
36913 : {
36914 : ae_frame _frame_block;
36915 : ae_matrix _a;
36916 : ae_int_t i;
36917 : ae_int_t j;
36918 : ae_int_t j1;
36919 : ae_int_t j2;
36920 : double v;
36921 : double nrm;
36922 : ae_vector t;
36923 : double result;
36924 :
36925 0 : ae_frame_make(_state, &_frame_block);
36926 0 : memset(&_a, 0, sizeof(_a));
36927 0 : memset(&t, 0, sizeof(t));
36928 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
36929 0 : a = &_a;
36930 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
36931 :
36932 0 : ae_vector_set_length(&t, n, _state);
36933 0 : for(i=0; i<=n-1; i++)
36934 : {
36935 0 : t.ptr.p_double[i] = (double)(0);
36936 : }
36937 0 : for(i=0; i<=n-1; i++)
36938 : {
36939 0 : if( isupper )
36940 : {
36941 0 : j1 = i;
36942 0 : j2 = n-1;
36943 : }
36944 : else
36945 : {
36946 0 : j1 = 0;
36947 0 : j2 = i;
36948 : }
36949 0 : for(j=j1; j<=j2; j++)
36950 : {
36951 0 : if( i==j )
36952 : {
36953 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state);
36954 : }
36955 : else
36956 : {
36957 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][j], _state);
36958 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state);
36959 : }
36960 : }
36961 : }
36962 0 : nrm = (double)(0);
36963 0 : for(i=0; i<=n-1; i++)
36964 : {
36965 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
36966 : }
36967 0 : if( spdmatrixcholesky(a, n, isupper, _state) )
36968 : {
36969 0 : rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state);
36970 0 : result = v;
36971 : }
36972 : else
36973 : {
36974 0 : result = (double)(-1);
36975 : }
36976 0 : ae_frame_leave(_state);
36977 0 : return result;
36978 : }
36979 :
36980 :
36981 : /*************************************************************************
36982 : Triangular matrix: estimate of a condition number (1-norm)
36983 :
36984 : The algorithm calculates a lower bound of the condition number. In this case,
36985 : the algorithm does not return a lower bound of the condition number, but an
36986 : inverse number (to avoid an overflow in case of a singular matrix).
36987 :
36988 : Input parameters:
36989 : A - matrix. Array[0..N-1, 0..N-1].
36990 : N - size of A.
36991 : IsUpper - True, if the matrix is upper triangular.
36992 : IsUnit - True, if the matrix has a unit diagonal.
36993 :
36994 : Result: 1/LowerBound(cond(A))
36995 :
36996 : NOTE:
36997 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
36998 : 0.0 is returned in such cases.
36999 : *************************************************************************/
37000 0 : double rmatrixtrrcond1(/* Real */ ae_matrix* a,
37001 : ae_int_t n,
37002 : ae_bool isupper,
37003 : ae_bool isunit,
37004 : ae_state *_state)
37005 : {
37006 : ae_frame _frame_block;
37007 : ae_int_t i;
37008 : ae_int_t j;
37009 : double v;
37010 : double nrm;
37011 : ae_vector pivots;
37012 : ae_vector t;
37013 : ae_int_t j1;
37014 : ae_int_t j2;
37015 : double result;
37016 :
37017 0 : ae_frame_make(_state, &_frame_block);
37018 0 : memset(&pivots, 0, sizeof(pivots));
37019 0 : memset(&t, 0, sizeof(t));
37020 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37021 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
37022 :
37023 0 : ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state);
37024 0 : ae_vector_set_length(&t, n, _state);
37025 0 : for(i=0; i<=n-1; i++)
37026 : {
37027 0 : t.ptr.p_double[i] = (double)(0);
37028 : }
37029 0 : for(i=0; i<=n-1; i++)
37030 : {
37031 0 : if( isupper )
37032 : {
37033 0 : j1 = i+1;
37034 0 : j2 = n-1;
37035 : }
37036 : else
37037 : {
37038 0 : j1 = 0;
37039 0 : j2 = i-1;
37040 : }
37041 0 : for(j=j1; j<=j2; j++)
37042 : {
37043 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state);
37044 : }
37045 0 : if( isunit )
37046 : {
37047 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+1;
37048 : }
37049 : else
37050 : {
37051 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state);
37052 : }
37053 : }
37054 0 : nrm = (double)(0);
37055 0 : for(i=0; i<=n-1; i++)
37056 : {
37057 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
37058 : }
37059 0 : rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state);
37060 0 : result = v;
37061 0 : ae_frame_leave(_state);
37062 0 : return result;
37063 : }
37064 :
37065 :
37066 : /*************************************************************************
37067 : Triangular matrix: estimate of a matrix condition number (infinity-norm).
37068 :
37069 : The algorithm calculates a lower bound of the condition number. In this case,
37070 : the algorithm does not return a lower bound of the condition number, but an
37071 : inverse number (to avoid an overflow in case of a singular matrix).
37072 :
37073 : Input parameters:
37074 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
37075 : N - size of matrix A.
37076 : IsUpper - True, if the matrix is upper triangular.
37077 : IsUnit - True, if the matrix has a unit diagonal.
37078 :
37079 : Result: 1/LowerBound(cond(A))
37080 :
37081 : NOTE:
37082 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37083 : 0.0 is returned in such cases.
37084 : *************************************************************************/
37085 0 : double rmatrixtrrcondinf(/* Real */ ae_matrix* a,
37086 : ae_int_t n,
37087 : ae_bool isupper,
37088 : ae_bool isunit,
37089 : ae_state *_state)
37090 : {
37091 : ae_frame _frame_block;
37092 : ae_int_t i;
37093 : ae_int_t j;
37094 : double v;
37095 : double nrm;
37096 : ae_vector pivots;
37097 : ae_int_t j1;
37098 : ae_int_t j2;
37099 : double result;
37100 :
37101 0 : ae_frame_make(_state, &_frame_block);
37102 0 : memset(&pivots, 0, sizeof(pivots));
37103 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37104 :
37105 0 : ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state);
37106 0 : nrm = (double)(0);
37107 0 : for(i=0; i<=n-1; i++)
37108 : {
37109 0 : if( isupper )
37110 : {
37111 0 : j1 = i+1;
37112 0 : j2 = n-1;
37113 : }
37114 : else
37115 : {
37116 0 : j1 = 0;
37117 0 : j2 = i-1;
37118 : }
37119 0 : v = (double)(0);
37120 0 : for(j=j1; j<=j2; j++)
37121 : {
37122 0 : v = v+ae_fabs(a->ptr.pp_double[i][j], _state);
37123 : }
37124 0 : if( isunit )
37125 : {
37126 0 : v = v+1;
37127 : }
37128 : else
37129 : {
37130 0 : v = v+ae_fabs(a->ptr.pp_double[i][i], _state);
37131 : }
37132 0 : nrm = ae_maxreal(nrm, v, _state);
37133 : }
37134 0 : rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state);
37135 0 : result = v;
37136 0 : ae_frame_leave(_state);
37137 0 : return result;
37138 : }
37139 :
37140 :
37141 : /*************************************************************************
37142 : Condition number estimate of a Hermitian positive definite matrix.
37143 :
37144 : The algorithm calculates a lower bound of the condition number. In this case,
37145 : the algorithm does not return a lower bound of the condition number, but an
37146 : inverse number (to avoid an overflow in case of a singular matrix).
37147 :
37148 : It should be noted that 1-norm and inf-norm of condition numbers of symmetric
37149 : matrices are equal, so the algorithm doesn't take into account the
37150 : differences between these types of norms.
37151 :
37152 : Input parameters:
37153 : A - Hermitian positive definite matrix which is given by its
37154 : upper or lower triangle depending on the value of
37155 : IsUpper. Array with elements [0..N-1, 0..N-1].
37156 : N - size of matrix A.
37157 : IsUpper - storage format.
37158 :
37159 : Result:
37160 : 1/LowerBound(cond(A)), if matrix A is positive definite,
37161 : -1, if matrix A is not positive definite, and its condition number
37162 : could not be found by this algorithm.
37163 :
37164 : NOTE:
37165 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37166 : 0.0 is returned in such cases.
37167 : *************************************************************************/
37168 0 : double hpdmatrixrcond(/* Complex */ ae_matrix* a,
37169 : ae_int_t n,
37170 : ae_bool isupper,
37171 : ae_state *_state)
37172 : {
37173 : ae_frame _frame_block;
37174 : ae_matrix _a;
37175 : ae_int_t i;
37176 : ae_int_t j;
37177 : ae_int_t j1;
37178 : ae_int_t j2;
37179 : double v;
37180 : double nrm;
37181 : ae_vector t;
37182 : double result;
37183 :
37184 0 : ae_frame_make(_state, &_frame_block);
37185 0 : memset(&_a, 0, sizeof(_a));
37186 0 : memset(&t, 0, sizeof(t));
37187 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
37188 0 : a = &_a;
37189 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
37190 :
37191 0 : ae_vector_set_length(&t, n, _state);
37192 0 : for(i=0; i<=n-1; i++)
37193 : {
37194 0 : t.ptr.p_double[i] = (double)(0);
37195 : }
37196 0 : for(i=0; i<=n-1; i++)
37197 : {
37198 0 : if( isupper )
37199 : {
37200 0 : j1 = i;
37201 0 : j2 = n-1;
37202 : }
37203 : else
37204 : {
37205 0 : j1 = 0;
37206 0 : j2 = i;
37207 : }
37208 0 : for(j=j1; j<=j2; j++)
37209 : {
37210 0 : if( i==j )
37211 : {
37212 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state);
37213 : }
37214 : else
37215 : {
37216 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37217 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37218 : }
37219 : }
37220 : }
37221 0 : nrm = (double)(0);
37222 0 : for(i=0; i<=n-1; i++)
37223 : {
37224 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
37225 : }
37226 0 : if( hpdmatrixcholesky(a, n, isupper, _state) )
37227 : {
37228 0 : rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state);
37229 0 : result = v;
37230 : }
37231 : else
37232 : {
37233 0 : result = (double)(-1);
37234 : }
37235 0 : ae_frame_leave(_state);
37236 0 : return result;
37237 : }
37238 :
37239 :
37240 : /*************************************************************************
37241 : Estimate of a matrix condition number (1-norm)
37242 :
37243 : The algorithm calculates a lower bound of the condition number. In this case,
37244 : the algorithm does not return a lower bound of the condition number, but an
37245 : inverse number (to avoid an overflow in case of a singular matrix).
37246 :
37247 : Input parameters:
37248 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
37249 : N - size of matrix A.
37250 :
37251 : Result: 1/LowerBound(cond(A))
37252 :
37253 : NOTE:
37254 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37255 : 0.0 is returned in such cases.
37256 : *************************************************************************/
37257 0 : double cmatrixrcond1(/* Complex */ ae_matrix* a,
37258 : ae_int_t n,
37259 : ae_state *_state)
37260 : {
37261 : ae_frame _frame_block;
37262 : ae_matrix _a;
37263 : ae_int_t i;
37264 : ae_int_t j;
37265 : double v;
37266 : double nrm;
37267 : ae_vector pivots;
37268 : ae_vector t;
37269 : double result;
37270 :
37271 0 : ae_frame_make(_state, &_frame_block);
37272 0 : memset(&_a, 0, sizeof(_a));
37273 0 : memset(&pivots, 0, sizeof(pivots));
37274 0 : memset(&t, 0, sizeof(t));
37275 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
37276 0 : a = &_a;
37277 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37278 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
37279 :
37280 0 : ae_assert(n>=1, "CMatrixRCond1: N<1!", _state);
37281 0 : ae_vector_set_length(&t, n, _state);
37282 0 : for(i=0; i<=n-1; i++)
37283 : {
37284 0 : t.ptr.p_double[i] = (double)(0);
37285 : }
37286 0 : for(i=0; i<=n-1; i++)
37287 : {
37288 0 : for(j=0; j<=n-1; j++)
37289 : {
37290 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37291 : }
37292 : }
37293 0 : nrm = (double)(0);
37294 0 : for(i=0; i<=n-1; i++)
37295 : {
37296 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
37297 : }
37298 0 : cmatrixlu(a, n, n, &pivots, _state);
37299 0 : rcond_cmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state);
37300 0 : result = v;
37301 0 : ae_frame_leave(_state);
37302 0 : return result;
37303 : }
37304 :
37305 :
37306 : /*************************************************************************
37307 : Estimate of a matrix condition number (infinity-norm).
37308 :
37309 : The algorithm calculates a lower bound of the condition number. In this case,
37310 : the algorithm does not return a lower bound of the condition number, but an
37311 : inverse number (to avoid an overflow in case of a singular matrix).
37312 :
37313 : Input parameters:
37314 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
37315 : N - size of matrix A.
37316 :
37317 : Result: 1/LowerBound(cond(A))
37318 :
37319 : NOTE:
37320 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37321 : 0.0 is returned in such cases.
37322 : *************************************************************************/
37323 0 : double cmatrixrcondinf(/* Complex */ ae_matrix* a,
37324 : ae_int_t n,
37325 : ae_state *_state)
37326 : {
37327 : ae_frame _frame_block;
37328 : ae_matrix _a;
37329 : ae_int_t i;
37330 : ae_int_t j;
37331 : double v;
37332 : double nrm;
37333 : ae_vector pivots;
37334 : double result;
37335 :
37336 0 : ae_frame_make(_state, &_frame_block);
37337 0 : memset(&_a, 0, sizeof(_a));
37338 0 : memset(&pivots, 0, sizeof(pivots));
37339 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
37340 0 : a = &_a;
37341 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37342 :
37343 0 : ae_assert(n>=1, "CMatrixRCondInf: N<1!", _state);
37344 0 : nrm = (double)(0);
37345 0 : for(i=0; i<=n-1; i++)
37346 : {
37347 0 : v = (double)(0);
37348 0 : for(j=0; j<=n-1; j++)
37349 : {
37350 0 : v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37351 : }
37352 0 : nrm = ae_maxreal(nrm, v, _state);
37353 : }
37354 0 : cmatrixlu(a, n, n, &pivots, _state);
37355 0 : rcond_cmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state);
37356 0 : result = v;
37357 0 : ae_frame_leave(_state);
37358 0 : return result;
37359 : }
37360 :
37361 :
37362 : /*************************************************************************
37363 : Estimate of the condition number of a matrix given by its LU decomposition (1-norm)
37364 :
37365 : The algorithm calculates a lower bound of the condition number. In this case,
37366 : the algorithm does not return a lower bound of the condition number, but an
37367 : inverse number (to avoid an overflow in case of a singular matrix).
37368 :
37369 : Input parameters:
37370 : LUA - LU decomposition of a matrix in compact form. Output of
37371 : the RMatrixLU subroutine.
37372 : N - size of matrix A.
37373 :
37374 : Result: 1/LowerBound(cond(A))
37375 :
37376 : NOTE:
37377 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37378 : 0.0 is returned in such cases.
37379 : *************************************************************************/
37380 0 : double rmatrixlurcond1(/* Real */ ae_matrix* lua,
37381 : ae_int_t n,
37382 : ae_state *_state)
37383 : {
37384 : double v;
37385 : double result;
37386 :
37387 :
37388 0 : rcond_rmatrixrcondluinternal(lua, n, ae_true, ae_false, (double)(0), &v, _state);
37389 0 : result = v;
37390 0 : return result;
37391 : }
37392 :
37393 :
37394 : /*************************************************************************
37395 : Estimate of the condition number of a matrix given by its LU decomposition
37396 : (infinity norm).
37397 :
37398 : The algorithm calculates a lower bound of the condition number. In this case,
37399 : the algorithm does not return a lower bound of the condition number, but an
37400 : inverse number (to avoid an overflow in case of a singular matrix).
37401 :
37402 : Input parameters:
37403 : LUA - LU decomposition of a matrix in compact form. Output of
37404 : the RMatrixLU subroutine.
37405 : N - size of matrix A.
37406 :
37407 : Result: 1/LowerBound(cond(A))
37408 :
37409 : NOTE:
37410 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37411 : 0.0 is returned in such cases.
37412 : *************************************************************************/
37413 0 : double rmatrixlurcondinf(/* Real */ ae_matrix* lua,
37414 : ae_int_t n,
37415 : ae_state *_state)
37416 : {
37417 : double v;
37418 : double result;
37419 :
37420 :
37421 0 : rcond_rmatrixrcondluinternal(lua, n, ae_false, ae_false, (double)(0), &v, _state);
37422 0 : result = v;
37423 0 : return result;
37424 : }
37425 :
37426 :
37427 : /*************************************************************************
37428 : Condition number estimate of a symmetric positive definite matrix given by
37429 : Cholesky decomposition.
37430 :
37431 : The algorithm calculates a lower bound of the condition number. In this
37432 : case, the algorithm does not return a lower bound of the condition number,
37433 : but an inverse number (to avoid an overflow in case of a singular matrix).
37434 :
37435 : It should be noted that 1-norm and inf-norm condition numbers of symmetric
37436 : matrices are equal, so the algorithm doesn't take into account the
37437 : differences between these types of norms.
37438 :
37439 : Input parameters:
37440 : CD - Cholesky decomposition of matrix A,
37441 : output of SMatrixCholesky subroutine.
37442 : N - size of matrix A.
37443 :
37444 : Result: 1/LowerBound(cond(A))
37445 :
37446 : NOTE:
37447 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37448 : 0.0 is returned in such cases.
37449 : *************************************************************************/
37450 0 : double spdmatrixcholeskyrcond(/* Real */ ae_matrix* a,
37451 : ae_int_t n,
37452 : ae_bool isupper,
37453 : ae_state *_state)
37454 : {
37455 : double v;
37456 : double result;
37457 :
37458 :
37459 0 : rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, (double)(0), &v, _state);
37460 0 : result = v;
37461 0 : return result;
37462 : }
37463 :
37464 :
37465 : /*************************************************************************
37466 : Condition number estimate of a Hermitian positive definite matrix given by
37467 : Cholesky decomposition.
37468 :
37469 : The algorithm calculates a lower bound of the condition number. In this
37470 : case, the algorithm does not return a lower bound of the condition number,
37471 : but an inverse number (to avoid an overflow in case of a singular matrix).
37472 :
37473 : It should be noted that 1-norm and inf-norm condition numbers of symmetric
37474 : matrices are equal, so the algorithm doesn't take into account the
37475 : differences between these types of norms.
37476 :
37477 : Input parameters:
37478 : CD - Cholesky decomposition of matrix A,
37479 : output of SMatrixCholesky subroutine.
37480 : N - size of matrix A.
37481 :
37482 : Result: 1/LowerBound(cond(A))
37483 :
37484 : NOTE:
37485 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37486 : 0.0 is returned in such cases.
37487 : *************************************************************************/
37488 0 : double hpdmatrixcholeskyrcond(/* Complex */ ae_matrix* a,
37489 : ae_int_t n,
37490 : ae_bool isupper,
37491 : ae_state *_state)
37492 : {
37493 : double v;
37494 : double result;
37495 :
37496 :
37497 0 : rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, (double)(0), &v, _state);
37498 0 : result = v;
37499 0 : return result;
37500 : }
37501 :
37502 :
37503 : /*************************************************************************
37504 : Estimate of the condition number of a matrix given by its LU decomposition (1-norm)
37505 :
37506 : The algorithm calculates a lower bound of the condition number. In this case,
37507 : the algorithm does not return a lower bound of the condition number, but an
37508 : inverse number (to avoid an overflow in case of a singular matrix).
37509 :
37510 : Input parameters:
37511 : LUA - LU decomposition of a matrix in compact form. Output of
37512 : the CMatrixLU subroutine.
37513 : N - size of matrix A.
37514 :
37515 : Result: 1/LowerBound(cond(A))
37516 :
37517 : NOTE:
37518 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37519 : 0.0 is returned in such cases.
37520 : *************************************************************************/
37521 0 : double cmatrixlurcond1(/* Complex */ ae_matrix* lua,
37522 : ae_int_t n,
37523 : ae_state *_state)
37524 : {
37525 : double v;
37526 : double result;
37527 :
37528 :
37529 0 : ae_assert(n>=1, "CMatrixLURCond1: N<1!", _state);
37530 0 : rcond_cmatrixrcondluinternal(lua, n, ae_true, ae_false, 0.0, &v, _state);
37531 0 : result = v;
37532 0 : return result;
37533 : }
37534 :
37535 :
37536 : /*************************************************************************
37537 : Estimate of the condition number of a matrix given by its LU decomposition
37538 : (infinity norm).
37539 :
37540 : The algorithm calculates a lower bound of the condition number. In this case,
37541 : the algorithm does not return a lower bound of the condition number, but an
37542 : inverse number (to avoid an overflow in case of a singular matrix).
37543 :
37544 : Input parameters:
37545 : LUA - LU decomposition of a matrix in compact form. Output of
37546 : the CMatrixLU subroutine.
37547 : N - size of matrix A.
37548 :
37549 : Result: 1/LowerBound(cond(A))
37550 :
37551 : NOTE:
37552 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37553 : 0.0 is returned in such cases.
37554 : *************************************************************************/
37555 0 : double cmatrixlurcondinf(/* Complex */ ae_matrix* lua,
37556 : ae_int_t n,
37557 : ae_state *_state)
37558 : {
37559 : double v;
37560 : double result;
37561 :
37562 :
37563 0 : ae_assert(n>=1, "CMatrixLURCondInf: N<1!", _state);
37564 0 : rcond_cmatrixrcondluinternal(lua, n, ae_false, ae_false, 0.0, &v, _state);
37565 0 : result = v;
37566 0 : return result;
37567 : }
37568 :
37569 :
37570 : /*************************************************************************
37571 : Triangular matrix: estimate of a condition number (1-norm)
37572 :
37573 : The algorithm calculates a lower bound of the condition number. In this case,
37574 : the algorithm does not return a lower bound of the condition number, but an
37575 : inverse number (to avoid an overflow in case of a singular matrix).
37576 :
37577 : Input parameters:
37578 : A - matrix. Array[0..N-1, 0..N-1].
37579 : N - size of A.
37580 : IsUpper - True, if the matrix is upper triangular.
37581 : IsUnit - True, if the matrix has a unit diagonal.
37582 :
37583 : Result: 1/LowerBound(cond(A))
37584 :
37585 : NOTE:
37586 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37587 : 0.0 is returned in such cases.
37588 : *************************************************************************/
37589 0 : double cmatrixtrrcond1(/* Complex */ ae_matrix* a,
37590 : ae_int_t n,
37591 : ae_bool isupper,
37592 : ae_bool isunit,
37593 : ae_state *_state)
37594 : {
37595 : ae_frame _frame_block;
37596 : ae_int_t i;
37597 : ae_int_t j;
37598 : double v;
37599 : double nrm;
37600 : ae_vector pivots;
37601 : ae_vector t;
37602 : ae_int_t j1;
37603 : ae_int_t j2;
37604 : double result;
37605 :
37606 0 : ae_frame_make(_state, &_frame_block);
37607 0 : memset(&pivots, 0, sizeof(pivots));
37608 0 : memset(&t, 0, sizeof(t));
37609 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37610 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
37611 :
37612 0 : ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state);
37613 0 : ae_vector_set_length(&t, n, _state);
37614 0 : for(i=0; i<=n-1; i++)
37615 : {
37616 0 : t.ptr.p_double[i] = (double)(0);
37617 : }
37618 0 : for(i=0; i<=n-1; i++)
37619 : {
37620 0 : if( isupper )
37621 : {
37622 0 : j1 = i+1;
37623 0 : j2 = n-1;
37624 : }
37625 : else
37626 : {
37627 0 : j1 = 0;
37628 0 : j2 = i-1;
37629 : }
37630 0 : for(j=j1; j<=j2; j++)
37631 : {
37632 0 : t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37633 : }
37634 0 : if( isunit )
37635 : {
37636 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+1;
37637 : }
37638 : else
37639 : {
37640 0 : t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state);
37641 : }
37642 : }
37643 0 : nrm = (double)(0);
37644 0 : for(i=0; i<=n-1; i++)
37645 : {
37646 0 : nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state);
37647 : }
37648 0 : rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state);
37649 0 : result = v;
37650 0 : ae_frame_leave(_state);
37651 0 : return result;
37652 : }
37653 :
37654 :
37655 : /*************************************************************************
37656 : Triangular matrix: estimate of a matrix condition number (infinity-norm).
37657 :
37658 : The algorithm calculates a lower bound of the condition number. In this case,
37659 : the algorithm does not return a lower bound of the condition number, but an
37660 : inverse number (to avoid an overflow in case of a singular matrix).
37661 :
37662 : Input parameters:
37663 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
37664 : N - size of matrix A.
37665 : IsUpper - True, if the matrix is upper triangular.
37666 : IsUnit - True, if the matrix has a unit diagonal.
37667 :
37668 : Result: 1/LowerBound(cond(A))
37669 :
37670 : NOTE:
37671 : if k(A) is very large, then matrix is assumed degenerate, k(A)=INF,
37672 : 0.0 is returned in such cases.
37673 : *************************************************************************/
37674 0 : double cmatrixtrrcondinf(/* Complex */ ae_matrix* a,
37675 : ae_int_t n,
37676 : ae_bool isupper,
37677 : ae_bool isunit,
37678 : ae_state *_state)
37679 : {
37680 : ae_frame _frame_block;
37681 : ae_int_t i;
37682 : ae_int_t j;
37683 : double v;
37684 : double nrm;
37685 : ae_vector pivots;
37686 : ae_int_t j1;
37687 : ae_int_t j2;
37688 : double result;
37689 :
37690 0 : ae_frame_make(_state, &_frame_block);
37691 0 : memset(&pivots, 0, sizeof(pivots));
37692 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
37693 :
37694 0 : ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state);
37695 0 : nrm = (double)(0);
37696 0 : for(i=0; i<=n-1; i++)
37697 : {
37698 0 : if( isupper )
37699 : {
37700 0 : j1 = i+1;
37701 0 : j2 = n-1;
37702 : }
37703 : else
37704 : {
37705 0 : j1 = 0;
37706 0 : j2 = i-1;
37707 : }
37708 0 : v = (double)(0);
37709 0 : for(j=j1; j<=j2; j++)
37710 : {
37711 0 : v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state);
37712 : }
37713 0 : if( isunit )
37714 : {
37715 0 : v = v+1;
37716 : }
37717 : else
37718 : {
37719 0 : v = v+ae_c_abs(a->ptr.pp_complex[i][i], _state);
37720 : }
37721 0 : nrm = ae_maxreal(nrm, v, _state);
37722 : }
37723 0 : rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state);
37724 0 : result = v;
37725 0 : ae_frame_leave(_state);
37726 0 : return result;
37727 : }
37728 :
37729 :
37730 : /*************************************************************************
37731 : Threshold for rcond: matrices with condition number beyond this threshold
37732 : are considered singular.
37733 :
37734 : Threshold must be far enough from underflow, at least Sqr(Threshold) must
37735 : be greater than underflow.
37736 : *************************************************************************/
37737 0 : double rcondthreshold(ae_state *_state)
37738 : {
37739 : double result;
37740 :
37741 :
37742 0 : result = ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state);
37743 0 : return result;
37744 : }
37745 :
37746 :
37747 : /*************************************************************************
37748 : Internal subroutine for condition number estimation
37749 :
37750 : -- LAPACK routine (version 3.0) --
37751 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
37752 : Courant Institute, Argonne National Lab, and Rice University
37753 : February 29, 1992
37754 : *************************************************************************/
37755 0 : static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a,
37756 : ae_int_t n,
37757 : ae_bool isupper,
37758 : ae_bool isunit,
37759 : ae_bool onenorm,
37760 : double anorm,
37761 : double* rc,
37762 : ae_state *_state)
37763 : {
37764 : ae_frame _frame_block;
37765 : ae_vector ex;
37766 : ae_vector ev;
37767 : ae_vector iwork;
37768 : ae_vector tmp;
37769 : ae_int_t i;
37770 : ae_int_t j;
37771 : ae_int_t kase;
37772 : ae_int_t kase1;
37773 : ae_int_t j1;
37774 : ae_int_t j2;
37775 : double ainvnm;
37776 : double maxgrowth;
37777 : double s;
37778 :
37779 0 : ae_frame_make(_state, &_frame_block);
37780 0 : memset(&ex, 0, sizeof(ex));
37781 0 : memset(&ev, 0, sizeof(ev));
37782 0 : memset(&iwork, 0, sizeof(iwork));
37783 0 : memset(&tmp, 0, sizeof(tmp));
37784 0 : *rc = 0;
37785 0 : ae_vector_init(&ex, 0, DT_REAL, _state, ae_true);
37786 0 : ae_vector_init(&ev, 0, DT_REAL, _state, ae_true);
37787 0 : ae_vector_init(&iwork, 0, DT_INT, _state, ae_true);
37788 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
37789 :
37790 :
37791 : /*
37792 : * RC=0 if something happens
37793 : */
37794 0 : *rc = (double)(0);
37795 :
37796 : /*
37797 : * init
37798 : */
37799 0 : if( onenorm )
37800 : {
37801 0 : kase1 = 1;
37802 : }
37803 : else
37804 : {
37805 0 : kase1 = 2;
37806 : }
37807 0 : ae_vector_set_length(&iwork, n+1, _state);
37808 0 : ae_vector_set_length(&tmp, n, _state);
37809 :
37810 : /*
37811 : * prepare parameters for triangular solver
37812 : */
37813 0 : maxgrowth = 1/rcondthreshold(_state);
37814 0 : s = (double)(0);
37815 0 : for(i=0; i<=n-1; i++)
37816 : {
37817 0 : if( isupper )
37818 : {
37819 0 : j1 = i+1;
37820 0 : j2 = n-1;
37821 : }
37822 : else
37823 : {
37824 0 : j1 = 0;
37825 0 : j2 = i-1;
37826 : }
37827 0 : for(j=j1; j<=j2; j++)
37828 : {
37829 0 : s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][j], _state), _state);
37830 : }
37831 0 : if( isunit )
37832 : {
37833 0 : s = ae_maxreal(s, (double)(1), _state);
37834 : }
37835 : else
37836 : {
37837 0 : s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][i], _state), _state);
37838 : }
37839 : }
37840 0 : if( ae_fp_eq(s,(double)(0)) )
37841 : {
37842 0 : s = (double)(1);
37843 : }
37844 0 : s = 1/s;
37845 :
37846 : /*
37847 : * Scale according to S
37848 : */
37849 0 : anorm = anorm*s;
37850 :
37851 : /*
37852 : * Quick return if possible
37853 : * We assume that ANORM<>0 after this block
37854 : */
37855 0 : if( ae_fp_eq(anorm,(double)(0)) )
37856 : {
37857 0 : ae_frame_leave(_state);
37858 0 : return;
37859 : }
37860 0 : if( n==1 )
37861 : {
37862 0 : *rc = (double)(1);
37863 0 : ae_frame_leave(_state);
37864 0 : return;
37865 : }
37866 :
37867 : /*
37868 : * Estimate the norm of inv(A).
37869 : */
37870 0 : ainvnm = (double)(0);
37871 0 : kase = 0;
37872 : for(;;)
37873 : {
37874 0 : rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state);
37875 0 : if( kase==0 )
37876 : {
37877 0 : break;
37878 : }
37879 :
37880 : /*
37881 : * from 1-based array to 0-based
37882 : */
37883 0 : for(i=0; i<=n-1; i++)
37884 : {
37885 0 : ex.ptr.p_double[i] = ex.ptr.p_double[i+1];
37886 : }
37887 :
37888 : /*
37889 : * multiply by inv(A) or inv(A')
37890 : */
37891 0 : if( kase==kase1 )
37892 : {
37893 :
37894 : /*
37895 : * multiply by inv(A)
37896 : */
37897 0 : if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) )
37898 : {
37899 0 : ae_frame_leave(_state);
37900 0 : return;
37901 : }
37902 : }
37903 : else
37904 : {
37905 :
37906 : /*
37907 : * multiply by inv(A')
37908 : */
37909 0 : if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 1, isunit, maxgrowth, _state) )
37910 : {
37911 0 : ae_frame_leave(_state);
37912 0 : return;
37913 : }
37914 : }
37915 :
37916 : /*
37917 : * from 0-based array to 1-based
37918 : */
37919 0 : for(i=n-1; i>=0; i--)
37920 : {
37921 0 : ex.ptr.p_double[i+1] = ex.ptr.p_double[i];
37922 : }
37923 : }
37924 :
37925 : /*
37926 : * Compute the estimate of the reciprocal condition number.
37927 : */
37928 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
37929 : {
37930 0 : *rc = 1/ainvnm;
37931 0 : *rc = *rc/anorm;
37932 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
37933 : {
37934 0 : *rc = (double)(0);
37935 : }
37936 : }
37937 0 : ae_frame_leave(_state);
37938 : }
37939 :
37940 :
37941 : /*************************************************************************
37942 : Condition number estimation
37943 :
37944 : -- LAPACK routine (version 3.0) --
37945 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
37946 : Courant Institute, Argonne National Lab, and Rice University
37947 : March 31, 1993
37948 : *************************************************************************/
37949 0 : static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a,
37950 : ae_int_t n,
37951 : ae_bool isupper,
37952 : ae_bool isunit,
37953 : ae_bool onenorm,
37954 : double anorm,
37955 : double* rc,
37956 : ae_state *_state)
37957 : {
37958 : ae_frame _frame_block;
37959 : ae_vector ex;
37960 : ae_vector cwork2;
37961 : ae_vector cwork3;
37962 : ae_vector cwork4;
37963 : ae_vector isave;
37964 : ae_vector rsave;
37965 : ae_int_t kase;
37966 : ae_int_t kase1;
37967 : double ainvnm;
37968 : ae_int_t i;
37969 : ae_int_t j;
37970 : ae_int_t j1;
37971 : ae_int_t j2;
37972 : double s;
37973 : double maxgrowth;
37974 :
37975 0 : ae_frame_make(_state, &_frame_block);
37976 0 : memset(&ex, 0, sizeof(ex));
37977 0 : memset(&cwork2, 0, sizeof(cwork2));
37978 0 : memset(&cwork3, 0, sizeof(cwork3));
37979 0 : memset(&cwork4, 0, sizeof(cwork4));
37980 0 : memset(&isave, 0, sizeof(isave));
37981 0 : memset(&rsave, 0, sizeof(rsave));
37982 0 : *rc = 0;
37983 0 : ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true);
37984 0 : ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true);
37985 0 : ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true);
37986 0 : ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true);
37987 0 : ae_vector_init(&isave, 0, DT_INT, _state, ae_true);
37988 0 : ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true);
37989 :
37990 :
37991 : /*
37992 : * RC=0 if something happens
37993 : */
37994 0 : *rc = (double)(0);
37995 :
37996 : /*
37997 : * init
37998 : */
37999 0 : if( n<=0 )
38000 : {
38001 0 : ae_frame_leave(_state);
38002 0 : return;
38003 : }
38004 0 : if( n==0 )
38005 : {
38006 0 : *rc = (double)(1);
38007 0 : ae_frame_leave(_state);
38008 0 : return;
38009 : }
38010 0 : ae_vector_set_length(&cwork2, n+1, _state);
38011 :
38012 : /*
38013 : * prepare parameters for triangular solver
38014 : */
38015 0 : maxgrowth = 1/rcondthreshold(_state);
38016 0 : s = (double)(0);
38017 0 : for(i=0; i<=n-1; i++)
38018 : {
38019 0 : if( isupper )
38020 : {
38021 0 : j1 = i+1;
38022 0 : j2 = n-1;
38023 : }
38024 : else
38025 : {
38026 0 : j1 = 0;
38027 0 : j2 = i-1;
38028 : }
38029 0 : for(j=j1; j<=j2; j++)
38030 : {
38031 0 : s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state);
38032 : }
38033 0 : if( isunit )
38034 : {
38035 0 : s = ae_maxreal(s, (double)(1), _state);
38036 : }
38037 : else
38038 : {
38039 0 : s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][i], _state), _state);
38040 : }
38041 : }
38042 0 : if( ae_fp_eq(s,(double)(0)) )
38043 : {
38044 0 : s = (double)(1);
38045 : }
38046 0 : s = 1/s;
38047 :
38048 : /*
38049 : * Scale according to S
38050 : */
38051 0 : anorm = anorm*s;
38052 :
38053 : /*
38054 : * Quick return if possible
38055 : */
38056 0 : if( ae_fp_eq(anorm,(double)(0)) )
38057 : {
38058 0 : ae_frame_leave(_state);
38059 0 : return;
38060 : }
38061 :
38062 : /*
38063 : * Estimate the norm of inv(A).
38064 : */
38065 0 : ainvnm = (double)(0);
38066 0 : if( onenorm )
38067 : {
38068 0 : kase1 = 1;
38069 : }
38070 : else
38071 : {
38072 0 : kase1 = 2;
38073 : }
38074 0 : kase = 0;
38075 : for(;;)
38076 : {
38077 0 : rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state);
38078 0 : if( kase==0 )
38079 : {
38080 0 : break;
38081 : }
38082 :
38083 : /*
38084 : * From 1-based to 0-based
38085 : */
38086 0 : for(i=0; i<=n-1; i++)
38087 : {
38088 0 : ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1];
38089 : }
38090 :
38091 : /*
38092 : * multiply by inv(A) or inv(A')
38093 : */
38094 0 : if( kase==kase1 )
38095 : {
38096 :
38097 : /*
38098 : * multiply by inv(A)
38099 : */
38100 0 : if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) )
38101 : {
38102 0 : ae_frame_leave(_state);
38103 0 : return;
38104 : }
38105 : }
38106 : else
38107 : {
38108 :
38109 : /*
38110 : * multiply by inv(A')
38111 : */
38112 0 : if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 2, isunit, maxgrowth, _state) )
38113 : {
38114 0 : ae_frame_leave(_state);
38115 0 : return;
38116 : }
38117 : }
38118 :
38119 : /*
38120 : * from 0-based to 1-based
38121 : */
38122 0 : for(i=n-1; i>=0; i--)
38123 : {
38124 0 : ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i];
38125 : }
38126 : }
38127 :
38128 : /*
38129 : * Compute the estimate of the reciprocal condition number.
38130 : */
38131 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
38132 : {
38133 0 : *rc = 1/ainvnm;
38134 0 : *rc = *rc/anorm;
38135 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
38136 : {
38137 0 : *rc = (double)(0);
38138 : }
38139 : }
38140 0 : ae_frame_leave(_state);
38141 : }
38142 :
38143 :
38144 : /*************************************************************************
38145 : Internal subroutine for condition number estimation
38146 :
38147 : -- LAPACK routine (version 3.0) --
38148 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
38149 : Courant Institute, Argonne National Lab, and Rice University
38150 : February 29, 1992
38151 : *************************************************************************/
38152 0 : static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha,
38153 : ae_int_t n,
38154 : ae_bool isupper,
38155 : ae_bool isnormprovided,
38156 : double anorm,
38157 : double* rc,
38158 : ae_state *_state)
38159 : {
38160 : ae_frame _frame_block;
38161 : ae_int_t i;
38162 : ae_int_t j;
38163 : ae_int_t kase;
38164 : double ainvnm;
38165 : ae_vector ex;
38166 : ae_vector ev;
38167 : ae_vector tmp;
38168 : ae_vector iwork;
38169 : double sa;
38170 : double v;
38171 : double maxgrowth;
38172 :
38173 0 : ae_frame_make(_state, &_frame_block);
38174 0 : memset(&ex, 0, sizeof(ex));
38175 0 : memset(&ev, 0, sizeof(ev));
38176 0 : memset(&tmp, 0, sizeof(tmp));
38177 0 : memset(&iwork, 0, sizeof(iwork));
38178 0 : *rc = 0;
38179 0 : ae_vector_init(&ex, 0, DT_REAL, _state, ae_true);
38180 0 : ae_vector_init(&ev, 0, DT_REAL, _state, ae_true);
38181 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
38182 0 : ae_vector_init(&iwork, 0, DT_INT, _state, ae_true);
38183 :
38184 0 : ae_assert(n>=1, "Assertion failed", _state);
38185 0 : ae_vector_set_length(&tmp, n, _state);
38186 :
38187 : /*
38188 : * RC=0 if something happens
38189 : */
38190 0 : *rc = (double)(0);
38191 :
38192 : /*
38193 : * prepare parameters for triangular solver
38194 : */
38195 0 : maxgrowth = 1/rcondthreshold(_state);
38196 0 : sa = (double)(0);
38197 0 : if( isupper )
38198 : {
38199 0 : for(i=0; i<=n-1; i++)
38200 : {
38201 0 : for(j=i; j<=n-1; j++)
38202 : {
38203 0 : sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state);
38204 : }
38205 : }
38206 : }
38207 : else
38208 : {
38209 0 : for(i=0; i<=n-1; i++)
38210 : {
38211 0 : for(j=0; j<=i; j++)
38212 : {
38213 0 : sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state);
38214 : }
38215 : }
38216 : }
38217 0 : if( ae_fp_eq(sa,(double)(0)) )
38218 : {
38219 0 : sa = (double)(1);
38220 : }
38221 0 : sa = 1/sa;
38222 :
38223 : /*
38224 : * Estimate the norm of A.
38225 : */
38226 0 : if( !isnormprovided )
38227 : {
38228 0 : kase = 0;
38229 0 : anorm = (double)(0);
38230 : for(;;)
38231 : {
38232 0 : rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state);
38233 0 : if( kase==0 )
38234 : {
38235 0 : break;
38236 : }
38237 0 : if( isupper )
38238 : {
38239 :
38240 : /*
38241 : * Multiply by U
38242 : */
38243 0 : for(i=1; i<=n; i++)
38244 : {
38245 0 : v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1));
38246 0 : ex.ptr.p_double[i] = v;
38247 : }
38248 0 : ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa);
38249 :
38250 : /*
38251 : * Multiply by U'
38252 : */
38253 0 : for(i=0; i<=n-1; i++)
38254 : {
38255 0 : tmp.ptr.p_double[i] = (double)(0);
38256 : }
38257 0 : for(i=0; i<=n-1; i++)
38258 : {
38259 0 : v = ex.ptr.p_double[i+1];
38260 0 : ae_v_addd(&tmp.ptr.p_double[i], 1, &cha->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v);
38261 : }
38262 0 : ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n));
38263 0 : ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa);
38264 : }
38265 : else
38266 : {
38267 :
38268 : /*
38269 : * Multiply by L'
38270 : */
38271 0 : for(i=0; i<=n-1; i++)
38272 : {
38273 0 : tmp.ptr.p_double[i] = (double)(0);
38274 : }
38275 0 : for(i=0; i<=n-1; i++)
38276 : {
38277 0 : v = ex.ptr.p_double[i+1];
38278 0 : ae_v_addd(&tmp.ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i), v);
38279 : }
38280 0 : ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n));
38281 0 : ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa);
38282 :
38283 : /*
38284 : * Multiply by L
38285 : */
38286 0 : for(i=n; i>=1; i--)
38287 : {
38288 0 : v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-1));
38289 0 : ex.ptr.p_double[i] = v;
38290 : }
38291 0 : ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa);
38292 : }
38293 : }
38294 : }
38295 :
38296 : /*
38297 : * Quick return if possible
38298 : */
38299 0 : if( ae_fp_eq(anorm,(double)(0)) )
38300 : {
38301 0 : ae_frame_leave(_state);
38302 0 : return;
38303 : }
38304 0 : if( n==1 )
38305 : {
38306 0 : *rc = (double)(1);
38307 0 : ae_frame_leave(_state);
38308 0 : return;
38309 : }
38310 :
38311 : /*
38312 : * Estimate the 1-norm of inv(A).
38313 : */
38314 0 : kase = 0;
38315 : for(;;)
38316 : {
38317 0 : rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state);
38318 0 : if( kase==0 )
38319 : {
38320 0 : break;
38321 : }
38322 0 : for(i=0; i<=n-1; i++)
38323 : {
38324 0 : ex.ptr.p_double[i] = ex.ptr.p_double[i+1];
38325 : }
38326 0 : if( isupper )
38327 : {
38328 :
38329 : /*
38330 : * Multiply by inv(U').
38331 : */
38332 0 : if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) )
38333 : {
38334 0 : ae_frame_leave(_state);
38335 0 : return;
38336 : }
38337 :
38338 : /*
38339 : * Multiply by inv(U).
38340 : */
38341 0 : if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) )
38342 : {
38343 0 : ae_frame_leave(_state);
38344 0 : return;
38345 : }
38346 : }
38347 : else
38348 : {
38349 :
38350 : /*
38351 : * Multiply by inv(L).
38352 : */
38353 0 : if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) )
38354 : {
38355 0 : ae_frame_leave(_state);
38356 0 : return;
38357 : }
38358 :
38359 : /*
38360 : * Multiply by inv(L').
38361 : */
38362 0 : if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) )
38363 : {
38364 0 : ae_frame_leave(_state);
38365 0 : return;
38366 : }
38367 : }
38368 0 : for(i=n-1; i>=0; i--)
38369 : {
38370 0 : ex.ptr.p_double[i+1] = ex.ptr.p_double[i];
38371 : }
38372 : }
38373 :
38374 : /*
38375 : * Compute the estimate of the reciprocal condition number.
38376 : */
38377 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
38378 : {
38379 0 : v = 1/ainvnm;
38380 0 : *rc = v/anorm;
38381 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
38382 : {
38383 0 : *rc = (double)(0);
38384 : }
38385 : }
38386 0 : ae_frame_leave(_state);
38387 : }
38388 :
38389 :
38390 : /*************************************************************************
38391 : Internal subroutine for condition number estimation
38392 :
38393 : -- LAPACK routine (version 3.0) --
38394 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
38395 : Courant Institute, Argonne National Lab, and Rice University
38396 : February 29, 1992
38397 : *************************************************************************/
38398 0 : static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha,
38399 : ae_int_t n,
38400 : ae_bool isupper,
38401 : ae_bool isnormprovided,
38402 : double anorm,
38403 : double* rc,
38404 : ae_state *_state)
38405 : {
38406 : ae_frame _frame_block;
38407 : ae_vector isave;
38408 : ae_vector rsave;
38409 : ae_vector ex;
38410 : ae_vector ev;
38411 : ae_vector tmp;
38412 : ae_int_t kase;
38413 : double ainvnm;
38414 : ae_complex v;
38415 : ae_int_t i;
38416 : ae_int_t j;
38417 : double sa;
38418 : double maxgrowth;
38419 :
38420 0 : ae_frame_make(_state, &_frame_block);
38421 0 : memset(&isave, 0, sizeof(isave));
38422 0 : memset(&rsave, 0, sizeof(rsave));
38423 0 : memset(&ex, 0, sizeof(ex));
38424 0 : memset(&ev, 0, sizeof(ev));
38425 0 : memset(&tmp, 0, sizeof(tmp));
38426 0 : *rc = 0;
38427 0 : ae_vector_init(&isave, 0, DT_INT, _state, ae_true);
38428 0 : ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true);
38429 0 : ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true);
38430 0 : ae_vector_init(&ev, 0, DT_COMPLEX, _state, ae_true);
38431 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
38432 :
38433 0 : ae_assert(n>=1, "Assertion failed", _state);
38434 0 : ae_vector_set_length(&tmp, n, _state);
38435 :
38436 : /*
38437 : * RC=0 if something happens
38438 : */
38439 0 : *rc = (double)(0);
38440 :
38441 : /*
38442 : * prepare parameters for triangular solver
38443 : */
38444 0 : maxgrowth = 1/rcondthreshold(_state);
38445 0 : sa = (double)(0);
38446 0 : if( isupper )
38447 : {
38448 0 : for(i=0; i<=n-1; i++)
38449 : {
38450 0 : for(j=i; j<=n-1; j++)
38451 : {
38452 0 : sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state);
38453 : }
38454 : }
38455 : }
38456 : else
38457 : {
38458 0 : for(i=0; i<=n-1; i++)
38459 : {
38460 0 : for(j=0; j<=i; j++)
38461 : {
38462 0 : sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state);
38463 : }
38464 : }
38465 : }
38466 0 : if( ae_fp_eq(sa,(double)(0)) )
38467 : {
38468 0 : sa = (double)(1);
38469 : }
38470 0 : sa = 1/sa;
38471 :
38472 : /*
38473 : * Estimate the norm of A
38474 : */
38475 0 : if( !isnormprovided )
38476 : {
38477 0 : anorm = (double)(0);
38478 0 : kase = 0;
38479 : for(;;)
38480 : {
38481 0 : rcond_cmatrixestimatenorm(n, &ev, &ex, &anorm, &kase, &isave, &rsave, _state);
38482 0 : if( kase==0 )
38483 : {
38484 0 : break;
38485 : }
38486 0 : if( isupper )
38487 : {
38488 :
38489 : /*
38490 : * Multiply by U
38491 : */
38492 0 : for(i=1; i<=n; i++)
38493 : {
38494 0 : v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1));
38495 0 : ex.ptr.p_complex[i] = v;
38496 : }
38497 0 : ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa);
38498 :
38499 : /*
38500 : * Multiply by U'
38501 : */
38502 0 : for(i=0; i<=n-1; i++)
38503 : {
38504 0 : tmp.ptr.p_complex[i] = ae_complex_from_i(0);
38505 : }
38506 0 : for(i=0; i<=n-1; i++)
38507 : {
38508 0 : v = ex.ptr.p_complex[i+1];
38509 0 : ae_v_caddc(&tmp.ptr.p_complex[i], 1, &cha->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(i,n-1), v);
38510 : }
38511 0 : ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n));
38512 0 : ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa);
38513 : }
38514 : else
38515 : {
38516 :
38517 : /*
38518 : * Multiply by L'
38519 : */
38520 0 : for(i=0; i<=n-1; i++)
38521 : {
38522 0 : tmp.ptr.p_complex[i] = ae_complex_from_i(0);
38523 : }
38524 0 : for(i=0; i<=n-1; i++)
38525 : {
38526 0 : v = ex.ptr.p_complex[i+1];
38527 0 : ae_v_caddc(&tmp.ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i), v);
38528 : }
38529 0 : ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n));
38530 0 : ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa);
38531 :
38532 : /*
38533 : * Multiply by L
38534 : */
38535 0 : for(i=n; i>=1; i--)
38536 : {
38537 0 : v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-1));
38538 0 : ex.ptr.p_complex[i] = v;
38539 : }
38540 0 : ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa);
38541 : }
38542 : }
38543 : }
38544 :
38545 : /*
38546 : * Quick return if possible
38547 : * After this block we assume that ANORM<>0
38548 : */
38549 0 : if( ae_fp_eq(anorm,(double)(0)) )
38550 : {
38551 0 : ae_frame_leave(_state);
38552 0 : return;
38553 : }
38554 0 : if( n==1 )
38555 : {
38556 0 : *rc = (double)(1);
38557 0 : ae_frame_leave(_state);
38558 0 : return;
38559 : }
38560 :
38561 : /*
38562 : * Estimate the norm of inv(A).
38563 : */
38564 0 : ainvnm = (double)(0);
38565 0 : kase = 0;
38566 : for(;;)
38567 : {
38568 0 : rcond_cmatrixestimatenorm(n, &ev, &ex, &ainvnm, &kase, &isave, &rsave, _state);
38569 0 : if( kase==0 )
38570 : {
38571 0 : break;
38572 : }
38573 0 : for(i=0; i<=n-1; i++)
38574 : {
38575 0 : ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1];
38576 : }
38577 0 : if( isupper )
38578 : {
38579 :
38580 : /*
38581 : * Multiply by inv(U').
38582 : */
38583 0 : if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) )
38584 : {
38585 0 : ae_frame_leave(_state);
38586 0 : return;
38587 : }
38588 :
38589 : /*
38590 : * Multiply by inv(U).
38591 : */
38592 0 : if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) )
38593 : {
38594 0 : ae_frame_leave(_state);
38595 0 : return;
38596 : }
38597 : }
38598 : else
38599 : {
38600 :
38601 : /*
38602 : * Multiply by inv(L).
38603 : */
38604 0 : if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) )
38605 : {
38606 0 : ae_frame_leave(_state);
38607 0 : return;
38608 : }
38609 :
38610 : /*
38611 : * Multiply by inv(L').
38612 : */
38613 0 : if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) )
38614 : {
38615 0 : ae_frame_leave(_state);
38616 0 : return;
38617 : }
38618 : }
38619 0 : for(i=n-1; i>=0; i--)
38620 : {
38621 0 : ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i];
38622 : }
38623 : }
38624 :
38625 : /*
38626 : * Compute the estimate of the reciprocal condition number.
38627 : */
38628 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
38629 : {
38630 0 : *rc = 1/ainvnm;
38631 0 : *rc = *rc/anorm;
38632 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
38633 : {
38634 0 : *rc = (double)(0);
38635 : }
38636 : }
38637 0 : ae_frame_leave(_state);
38638 : }
38639 :
38640 :
38641 : /*************************************************************************
38642 : Internal subroutine for condition number estimation
38643 :
38644 : -- LAPACK routine (version 3.0) --
38645 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
38646 : Courant Institute, Argonne National Lab, and Rice University
38647 : February 29, 1992
38648 : *************************************************************************/
38649 0 : static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua,
38650 : ae_int_t n,
38651 : ae_bool onenorm,
38652 : ae_bool isanormprovided,
38653 : double anorm,
38654 : double* rc,
38655 : ae_state *_state)
38656 : {
38657 : ae_frame _frame_block;
38658 : ae_vector ex;
38659 : ae_vector ev;
38660 : ae_vector iwork;
38661 : ae_vector tmp;
38662 : double v;
38663 : ae_int_t i;
38664 : ae_int_t j;
38665 : ae_int_t kase;
38666 : ae_int_t kase1;
38667 : double ainvnm;
38668 : double maxgrowth;
38669 : double su;
38670 : double sl;
38671 : ae_bool mupper;
38672 : ae_bool munit;
38673 :
38674 0 : ae_frame_make(_state, &_frame_block);
38675 0 : memset(&ex, 0, sizeof(ex));
38676 0 : memset(&ev, 0, sizeof(ev));
38677 0 : memset(&iwork, 0, sizeof(iwork));
38678 0 : memset(&tmp, 0, sizeof(tmp));
38679 0 : *rc = 0;
38680 0 : ae_vector_init(&ex, 0, DT_REAL, _state, ae_true);
38681 0 : ae_vector_init(&ev, 0, DT_REAL, _state, ae_true);
38682 0 : ae_vector_init(&iwork, 0, DT_INT, _state, ae_true);
38683 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
38684 :
38685 :
38686 : /*
38687 : * RC=0 if something happens
38688 : */
38689 0 : *rc = (double)(0);
38690 :
38691 : /*
38692 : * init
38693 : */
38694 0 : if( onenorm )
38695 : {
38696 0 : kase1 = 1;
38697 : }
38698 : else
38699 : {
38700 0 : kase1 = 2;
38701 : }
38702 0 : mupper = ae_true;
38703 0 : munit = ae_true;
38704 0 : ae_vector_set_length(&iwork, n+1, _state);
38705 0 : ae_vector_set_length(&tmp, n, _state);
38706 :
38707 : /*
38708 : * prepare parameters for triangular solver
38709 : */
38710 0 : maxgrowth = 1/rcondthreshold(_state);
38711 0 : su = (double)(0);
38712 0 : sl = (double)(1);
38713 0 : for(i=0; i<=n-1; i++)
38714 : {
38715 0 : for(j=0; j<=i-1; j++)
38716 : {
38717 0 : sl = ae_maxreal(sl, ae_fabs(lua->ptr.pp_double[i][j], _state), _state);
38718 : }
38719 0 : for(j=i; j<=n-1; j++)
38720 : {
38721 0 : su = ae_maxreal(su, ae_fabs(lua->ptr.pp_double[i][j], _state), _state);
38722 : }
38723 : }
38724 0 : if( ae_fp_eq(su,(double)(0)) )
38725 : {
38726 0 : su = (double)(1);
38727 : }
38728 0 : su = 1/su;
38729 0 : sl = 1/sl;
38730 :
38731 : /*
38732 : * Estimate the norm of A.
38733 : */
38734 0 : if( !isanormprovided )
38735 : {
38736 0 : kase = 0;
38737 0 : anorm = (double)(0);
38738 : for(;;)
38739 : {
38740 0 : rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state);
38741 0 : if( kase==0 )
38742 : {
38743 0 : break;
38744 : }
38745 0 : if( kase==kase1 )
38746 : {
38747 :
38748 : /*
38749 : * Multiply by U
38750 : */
38751 0 : for(i=1; i<=n; i++)
38752 : {
38753 0 : v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1));
38754 0 : ex.ptr.p_double[i] = v;
38755 : }
38756 :
38757 : /*
38758 : * Multiply by L
38759 : */
38760 0 : for(i=n; i>=1; i--)
38761 : {
38762 0 : if( i>1 )
38763 : {
38764 0 : v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-2));
38765 : }
38766 : else
38767 : {
38768 0 : v = (double)(0);
38769 : }
38770 0 : ex.ptr.p_double[i] = ex.ptr.p_double[i]+v;
38771 : }
38772 : }
38773 : else
38774 : {
38775 :
38776 : /*
38777 : * Multiply by L'
38778 : */
38779 0 : for(i=0; i<=n-1; i++)
38780 : {
38781 0 : tmp.ptr.p_double[i] = (double)(0);
38782 : }
38783 0 : for(i=0; i<=n-1; i++)
38784 : {
38785 0 : v = ex.ptr.p_double[i+1];
38786 0 : if( i>=1 )
38787 : {
38788 0 : ae_v_addd(&tmp.ptr.p_double[0], 1, &lua->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), v);
38789 : }
38790 0 : tmp.ptr.p_double[i] = tmp.ptr.p_double[i]+v;
38791 : }
38792 0 : ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n));
38793 :
38794 : /*
38795 : * Multiply by U'
38796 : */
38797 0 : for(i=0; i<=n-1; i++)
38798 : {
38799 0 : tmp.ptr.p_double[i] = (double)(0);
38800 : }
38801 0 : for(i=0; i<=n-1; i++)
38802 : {
38803 0 : v = ex.ptr.p_double[i+1];
38804 0 : ae_v_addd(&tmp.ptr.p_double[i], 1, &lua->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v);
38805 : }
38806 0 : ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n));
38807 : }
38808 : }
38809 : }
38810 :
38811 : /*
38812 : * Scale according to SU/SL
38813 : */
38814 0 : anorm = anorm*su*sl;
38815 :
38816 : /*
38817 : * Quick return if possible
38818 : * We assume that ANORM<>0 after this block
38819 : */
38820 0 : if( ae_fp_eq(anorm,(double)(0)) )
38821 : {
38822 0 : ae_frame_leave(_state);
38823 0 : return;
38824 : }
38825 0 : if( n==1 )
38826 : {
38827 0 : *rc = (double)(1);
38828 0 : ae_frame_leave(_state);
38829 0 : return;
38830 : }
38831 :
38832 : /*
38833 : * Estimate the norm of inv(A).
38834 : */
38835 0 : ainvnm = (double)(0);
38836 0 : kase = 0;
38837 : for(;;)
38838 : {
38839 0 : rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state);
38840 0 : if( kase==0 )
38841 : {
38842 0 : break;
38843 : }
38844 :
38845 : /*
38846 : * from 1-based array to 0-based
38847 : */
38848 0 : for(i=0; i<=n-1; i++)
38849 : {
38850 0 : ex.ptr.p_double[i] = ex.ptr.p_double[i+1];
38851 : }
38852 :
38853 : /*
38854 : * multiply by inv(A) or inv(A')
38855 : */
38856 0 : if( kase==kase1 )
38857 : {
38858 :
38859 : /*
38860 : * Multiply by inv(L).
38861 : */
38862 0 : if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 0, munit, maxgrowth, _state) )
38863 : {
38864 0 : ae_frame_leave(_state);
38865 0 : return;
38866 : }
38867 :
38868 : /*
38869 : * Multiply by inv(U).
38870 : */
38871 0 : if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 0, !munit, maxgrowth, _state) )
38872 : {
38873 0 : ae_frame_leave(_state);
38874 0 : return;
38875 : }
38876 : }
38877 : else
38878 : {
38879 :
38880 : /*
38881 : * Multiply by inv(U').
38882 : */
38883 0 : if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 1, !munit, maxgrowth, _state) )
38884 : {
38885 0 : ae_frame_leave(_state);
38886 0 : return;
38887 : }
38888 :
38889 : /*
38890 : * Multiply by inv(L').
38891 : */
38892 0 : if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 1, munit, maxgrowth, _state) )
38893 : {
38894 0 : ae_frame_leave(_state);
38895 0 : return;
38896 : }
38897 : }
38898 :
38899 : /*
38900 : * from 0-based array to 1-based
38901 : */
38902 0 : for(i=n-1; i>=0; i--)
38903 : {
38904 0 : ex.ptr.p_double[i+1] = ex.ptr.p_double[i];
38905 : }
38906 : }
38907 :
38908 : /*
38909 : * Compute the estimate of the reciprocal condition number.
38910 : */
38911 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
38912 : {
38913 0 : *rc = 1/ainvnm;
38914 0 : *rc = *rc/anorm;
38915 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
38916 : {
38917 0 : *rc = (double)(0);
38918 : }
38919 : }
38920 0 : ae_frame_leave(_state);
38921 : }
38922 :
38923 :
38924 : /*************************************************************************
38925 : Condition number estimation
38926 :
38927 : -- LAPACK routine (version 3.0) --
38928 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
38929 : Courant Institute, Argonne National Lab, and Rice University
38930 : March 31, 1993
38931 : *************************************************************************/
38932 0 : static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua,
38933 : ae_int_t n,
38934 : ae_bool onenorm,
38935 : ae_bool isanormprovided,
38936 : double anorm,
38937 : double* rc,
38938 : ae_state *_state)
38939 : {
38940 : ae_frame _frame_block;
38941 : ae_vector ex;
38942 : ae_vector cwork2;
38943 : ae_vector cwork3;
38944 : ae_vector cwork4;
38945 : ae_vector isave;
38946 : ae_vector rsave;
38947 : ae_int_t kase;
38948 : ae_int_t kase1;
38949 : double ainvnm;
38950 : ae_complex v;
38951 : ae_int_t i;
38952 : ae_int_t j;
38953 : double su;
38954 : double sl;
38955 : double maxgrowth;
38956 :
38957 0 : ae_frame_make(_state, &_frame_block);
38958 0 : memset(&ex, 0, sizeof(ex));
38959 0 : memset(&cwork2, 0, sizeof(cwork2));
38960 0 : memset(&cwork3, 0, sizeof(cwork3));
38961 0 : memset(&cwork4, 0, sizeof(cwork4));
38962 0 : memset(&isave, 0, sizeof(isave));
38963 0 : memset(&rsave, 0, sizeof(rsave));
38964 0 : *rc = 0;
38965 0 : ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true);
38966 0 : ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true);
38967 0 : ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true);
38968 0 : ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true);
38969 0 : ae_vector_init(&isave, 0, DT_INT, _state, ae_true);
38970 0 : ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true);
38971 :
38972 0 : if( n<=0 )
38973 : {
38974 0 : ae_frame_leave(_state);
38975 0 : return;
38976 : }
38977 0 : ae_vector_set_length(&cwork2, n+1, _state);
38978 0 : *rc = (double)(0);
38979 0 : if( n==0 )
38980 : {
38981 0 : *rc = (double)(1);
38982 0 : ae_frame_leave(_state);
38983 0 : return;
38984 : }
38985 :
38986 : /*
38987 : * prepare parameters for triangular solver
38988 : */
38989 0 : maxgrowth = 1/rcondthreshold(_state);
38990 0 : su = (double)(0);
38991 0 : sl = (double)(1);
38992 0 : for(i=0; i<=n-1; i++)
38993 : {
38994 0 : for(j=0; j<=i-1; j++)
38995 : {
38996 0 : sl = ae_maxreal(sl, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state);
38997 : }
38998 0 : for(j=i; j<=n-1; j++)
38999 : {
39000 0 : su = ae_maxreal(su, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state);
39001 : }
39002 : }
39003 0 : if( ae_fp_eq(su,(double)(0)) )
39004 : {
39005 0 : su = (double)(1);
39006 : }
39007 0 : su = 1/su;
39008 0 : sl = 1/sl;
39009 :
39010 : /*
39011 : * Estimate the norm of SU*SL*A.
39012 : */
39013 0 : if( !isanormprovided )
39014 : {
39015 0 : anorm = (double)(0);
39016 0 : if( onenorm )
39017 : {
39018 0 : kase1 = 1;
39019 : }
39020 : else
39021 : {
39022 0 : kase1 = 2;
39023 : }
39024 0 : kase = 0;
39025 0 : do
39026 : {
39027 0 : rcond_cmatrixestimatenorm(n, &cwork4, &ex, &anorm, &kase, &isave, &rsave, _state);
39028 0 : if( kase!=0 )
39029 : {
39030 0 : if( kase==kase1 )
39031 : {
39032 :
39033 : /*
39034 : * Multiply by U
39035 : */
39036 0 : for(i=1; i<=n; i++)
39037 : {
39038 0 : v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1));
39039 0 : ex.ptr.p_complex[i] = v;
39040 : }
39041 :
39042 : /*
39043 : * Multiply by L
39044 : */
39045 0 : for(i=n; i>=1; i--)
39046 : {
39047 0 : v = ae_complex_from_i(0);
39048 0 : if( i>1 )
39049 : {
39050 0 : v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-2));
39051 : }
39052 0 : ex.ptr.p_complex[i] = ae_c_add(v,ex.ptr.p_complex[i]);
39053 : }
39054 : }
39055 : else
39056 : {
39057 :
39058 : /*
39059 : * Multiply by L'
39060 : */
39061 0 : for(i=1; i<=n; i++)
39062 : {
39063 0 : cwork2.ptr.p_complex[i] = ae_complex_from_i(0);
39064 : }
39065 0 : for(i=1; i<=n; i++)
39066 : {
39067 0 : v = ex.ptr.p_complex[i];
39068 0 : if( i>1 )
39069 : {
39070 0 : ae_v_caddc(&cwork2.ptr.p_complex[1], 1, &lua->ptr.pp_complex[i-1][0], 1, "Conj", ae_v_len(1,i-1), v);
39071 : }
39072 0 : cwork2.ptr.p_complex[i] = ae_c_add(cwork2.ptr.p_complex[i],v);
39073 : }
39074 :
39075 : /*
39076 : * Multiply by U'
39077 : */
39078 0 : for(i=1; i<=n; i++)
39079 : {
39080 0 : ex.ptr.p_complex[i] = ae_complex_from_i(0);
39081 : }
39082 0 : for(i=1; i<=n; i++)
39083 : {
39084 0 : v = cwork2.ptr.p_complex[i];
39085 0 : ae_v_caddc(&ex.ptr.p_complex[i], 1, &lua->ptr.pp_complex[i-1][i-1], 1, "Conj", ae_v_len(i,n), v);
39086 : }
39087 : }
39088 : }
39089 : }
39090 0 : while(kase!=0);
39091 : }
39092 :
39093 : /*
39094 : * Scale according to SU/SL
39095 : */
39096 0 : anorm = anorm*su*sl;
39097 :
39098 : /*
39099 : * Quick return if possible
39100 : */
39101 0 : if( ae_fp_eq(anorm,(double)(0)) )
39102 : {
39103 0 : ae_frame_leave(_state);
39104 0 : return;
39105 : }
39106 :
39107 : /*
39108 : * Estimate the norm of inv(A).
39109 : */
39110 0 : ainvnm = (double)(0);
39111 0 : if( onenorm )
39112 : {
39113 0 : kase1 = 1;
39114 : }
39115 : else
39116 : {
39117 0 : kase1 = 2;
39118 : }
39119 0 : kase = 0;
39120 : for(;;)
39121 : {
39122 0 : rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state);
39123 0 : if( kase==0 )
39124 : {
39125 0 : break;
39126 : }
39127 :
39128 : /*
39129 : * From 1-based to 0-based
39130 : */
39131 0 : for(i=0; i<=n-1; i++)
39132 : {
39133 0 : ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1];
39134 : }
39135 :
39136 : /*
39137 : * multiply by inv(A) or inv(A')
39138 : */
39139 0 : if( kase==kase1 )
39140 : {
39141 :
39142 : /*
39143 : * Multiply by inv(L).
39144 : */
39145 0 : if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 0, ae_true, maxgrowth, _state) )
39146 : {
39147 0 : *rc = (double)(0);
39148 0 : ae_frame_leave(_state);
39149 0 : return;
39150 : }
39151 :
39152 : /*
39153 : * Multiply by inv(U).
39154 : */
39155 0 : if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 0, ae_false, maxgrowth, _state) )
39156 : {
39157 0 : *rc = (double)(0);
39158 0 : ae_frame_leave(_state);
39159 0 : return;
39160 : }
39161 : }
39162 : else
39163 : {
39164 :
39165 : /*
39166 : * Multiply by inv(U').
39167 : */
39168 0 : if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 2, ae_false, maxgrowth, _state) )
39169 : {
39170 0 : *rc = (double)(0);
39171 0 : ae_frame_leave(_state);
39172 0 : return;
39173 : }
39174 :
39175 : /*
39176 : * Multiply by inv(L').
39177 : */
39178 0 : if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 2, ae_true, maxgrowth, _state) )
39179 : {
39180 0 : *rc = (double)(0);
39181 0 : ae_frame_leave(_state);
39182 0 : return;
39183 : }
39184 : }
39185 :
39186 : /*
39187 : * from 0-based to 1-based
39188 : */
39189 0 : for(i=n-1; i>=0; i--)
39190 : {
39191 0 : ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i];
39192 : }
39193 : }
39194 :
39195 : /*
39196 : * Compute the estimate of the reciprocal condition number.
39197 : */
39198 0 : if( ae_fp_neq(ainvnm,(double)(0)) )
39199 : {
39200 0 : *rc = 1/ainvnm;
39201 0 : *rc = *rc/anorm;
39202 0 : if( ae_fp_less(*rc,rcondthreshold(_state)) )
39203 : {
39204 0 : *rc = (double)(0);
39205 : }
39206 : }
39207 0 : ae_frame_leave(_state);
39208 : }
39209 :
39210 :
39211 : /*************************************************************************
39212 : Internal subroutine for matrix norm estimation
39213 :
39214 : -- LAPACK auxiliary routine (version 3.0) --
39215 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
39216 : Courant Institute, Argonne National Lab, and Rice University
39217 : February 29, 1992
39218 : *************************************************************************/
39219 0 : static void rcond_rmatrixestimatenorm(ae_int_t n,
39220 : /* Real */ ae_vector* v,
39221 : /* Real */ ae_vector* x,
39222 : /* Integer */ ae_vector* isgn,
39223 : double* est,
39224 : ae_int_t* kase,
39225 : ae_state *_state)
39226 : {
39227 : ae_int_t itmax;
39228 : ae_int_t i;
39229 : double t;
39230 : ae_bool flg;
39231 : ae_int_t positer;
39232 : ae_int_t posj;
39233 : ae_int_t posjlast;
39234 : ae_int_t posjump;
39235 : ae_int_t posaltsgn;
39236 : ae_int_t posestold;
39237 : ae_int_t postemp;
39238 :
39239 :
39240 0 : itmax = 5;
39241 0 : posaltsgn = n+1;
39242 0 : posestold = n+2;
39243 0 : postemp = n+3;
39244 0 : positer = n+1;
39245 0 : posj = n+2;
39246 0 : posjlast = n+3;
39247 0 : posjump = n+4;
39248 0 : if( *kase==0 )
39249 : {
39250 0 : ae_vector_set_length(v, n+4, _state);
39251 0 : ae_vector_set_length(x, n+1, _state);
39252 0 : ae_vector_set_length(isgn, n+5, _state);
39253 0 : t = (double)1/(double)n;
39254 0 : for(i=1; i<=n; i++)
39255 : {
39256 0 : x->ptr.p_double[i] = t;
39257 : }
39258 0 : *kase = 1;
39259 0 : isgn->ptr.p_int[posjump] = 1;
39260 0 : return;
39261 : }
39262 :
39263 : /*
39264 : * ................ ENTRY (JUMP = 1)
39265 : * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
39266 : */
39267 0 : if( isgn->ptr.p_int[posjump]==1 )
39268 : {
39269 0 : if( n==1 )
39270 : {
39271 0 : v->ptr.p_double[1] = x->ptr.p_double[1];
39272 0 : *est = ae_fabs(v->ptr.p_double[1], _state);
39273 0 : *kase = 0;
39274 0 : return;
39275 : }
39276 0 : *est = (double)(0);
39277 0 : for(i=1; i<=n; i++)
39278 : {
39279 0 : *est = *est+ae_fabs(x->ptr.p_double[i], _state);
39280 : }
39281 0 : for(i=1; i<=n; i++)
39282 : {
39283 0 : if( ae_fp_greater_eq(x->ptr.p_double[i],(double)(0)) )
39284 : {
39285 0 : x->ptr.p_double[i] = (double)(1);
39286 : }
39287 : else
39288 : {
39289 0 : x->ptr.p_double[i] = (double)(-1);
39290 : }
39291 0 : isgn->ptr.p_int[i] = ae_sign(x->ptr.p_double[i], _state);
39292 : }
39293 0 : *kase = 2;
39294 0 : isgn->ptr.p_int[posjump] = 2;
39295 0 : return;
39296 : }
39297 :
39298 : /*
39299 : * ................ ENTRY (JUMP = 2)
39300 : * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
39301 : */
39302 0 : if( isgn->ptr.p_int[posjump]==2 )
39303 : {
39304 0 : isgn->ptr.p_int[posj] = 1;
39305 0 : for(i=2; i<=n; i++)
39306 : {
39307 0 : if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) )
39308 : {
39309 0 : isgn->ptr.p_int[posj] = i;
39310 : }
39311 : }
39312 0 : isgn->ptr.p_int[positer] = 2;
39313 :
39314 : /*
39315 : * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
39316 : */
39317 0 : for(i=1; i<=n; i++)
39318 : {
39319 0 : x->ptr.p_double[i] = (double)(0);
39320 : }
39321 0 : x->ptr.p_double[isgn->ptr.p_int[posj]] = (double)(1);
39322 0 : *kase = 1;
39323 0 : isgn->ptr.p_int[posjump] = 3;
39324 0 : return;
39325 : }
39326 :
39327 : /*
39328 : * ................ ENTRY (JUMP = 3)
39329 : * X HAS BEEN OVERWRITTEN BY A*X.
39330 : */
39331 0 : if( isgn->ptr.p_int[posjump]==3 )
39332 : {
39333 0 : ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n));
39334 0 : v->ptr.p_double[posestold] = *est;
39335 0 : *est = (double)(0);
39336 0 : for(i=1; i<=n; i++)
39337 : {
39338 0 : *est = *est+ae_fabs(v->ptr.p_double[i], _state);
39339 : }
39340 0 : flg = ae_false;
39341 0 : for(i=1; i<=n; i++)
39342 : {
39343 0 : if( (ae_fp_greater_eq(x->ptr.p_double[i],(double)(0))&&isgn->ptr.p_int[i]<0)||(ae_fp_less(x->ptr.p_double[i],(double)(0))&&isgn->ptr.p_int[i]>=0) )
39344 : {
39345 0 : flg = ae_true;
39346 : }
39347 : }
39348 :
39349 : /*
39350 : * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED.
39351 : * OR MAY BE CYCLING.
39352 : */
39353 0 : if( !flg||ae_fp_less_eq(*est,v->ptr.p_double[posestold]) )
39354 : {
39355 0 : v->ptr.p_double[posaltsgn] = (double)(1);
39356 0 : for(i=1; i<=n; i++)
39357 : {
39358 0 : x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1));
39359 0 : v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn];
39360 : }
39361 0 : *kase = 1;
39362 0 : isgn->ptr.p_int[posjump] = 5;
39363 0 : return;
39364 : }
39365 0 : for(i=1; i<=n; i++)
39366 : {
39367 0 : if( ae_fp_greater_eq(x->ptr.p_double[i],(double)(0)) )
39368 : {
39369 0 : x->ptr.p_double[i] = (double)(1);
39370 0 : isgn->ptr.p_int[i] = 1;
39371 : }
39372 : else
39373 : {
39374 0 : x->ptr.p_double[i] = (double)(-1);
39375 0 : isgn->ptr.p_int[i] = -1;
39376 : }
39377 : }
39378 0 : *kase = 2;
39379 0 : isgn->ptr.p_int[posjump] = 4;
39380 0 : return;
39381 : }
39382 :
39383 : /*
39384 : * ................ ENTRY (JUMP = 4)
39385 : * X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X.
39386 : */
39387 0 : if( isgn->ptr.p_int[posjump]==4 )
39388 : {
39389 0 : isgn->ptr.p_int[posjlast] = isgn->ptr.p_int[posj];
39390 0 : isgn->ptr.p_int[posj] = 1;
39391 0 : for(i=2; i<=n; i++)
39392 : {
39393 0 : if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) )
39394 : {
39395 0 : isgn->ptr.p_int[posj] = i;
39396 : }
39397 : }
39398 0 : if( ae_fp_neq(x->ptr.p_double[isgn->ptr.p_int[posjlast]],ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state))&&isgn->ptr.p_int[positer]<itmax )
39399 : {
39400 0 : isgn->ptr.p_int[positer] = isgn->ptr.p_int[positer]+1;
39401 0 : for(i=1; i<=n; i++)
39402 : {
39403 0 : x->ptr.p_double[i] = (double)(0);
39404 : }
39405 0 : x->ptr.p_double[isgn->ptr.p_int[posj]] = (double)(1);
39406 0 : *kase = 1;
39407 0 : isgn->ptr.p_int[posjump] = 3;
39408 0 : return;
39409 : }
39410 :
39411 : /*
39412 : * ITERATION COMPLETE. FINAL STAGE.
39413 : */
39414 0 : v->ptr.p_double[posaltsgn] = (double)(1);
39415 0 : for(i=1; i<=n; i++)
39416 : {
39417 0 : x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1));
39418 0 : v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn];
39419 : }
39420 0 : *kase = 1;
39421 0 : isgn->ptr.p_int[posjump] = 5;
39422 0 : return;
39423 : }
39424 :
39425 : /*
39426 : * ................ ENTRY (JUMP = 5)
39427 : * X HAS BEEN OVERWRITTEN BY A*X.
39428 : */
39429 0 : if( isgn->ptr.p_int[posjump]==5 )
39430 : {
39431 0 : v->ptr.p_double[postemp] = (double)(0);
39432 0 : for(i=1; i<=n; i++)
39433 : {
39434 0 : v->ptr.p_double[postemp] = v->ptr.p_double[postemp]+ae_fabs(x->ptr.p_double[i], _state);
39435 : }
39436 0 : v->ptr.p_double[postemp] = 2*v->ptr.p_double[postemp]/(3*n);
39437 0 : if( ae_fp_greater(v->ptr.p_double[postemp],*est) )
39438 : {
39439 0 : ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n));
39440 0 : *est = v->ptr.p_double[postemp];
39441 : }
39442 0 : *kase = 0;
39443 0 : return;
39444 : }
39445 : }
39446 :
39447 :
39448 0 : static void rcond_cmatrixestimatenorm(ae_int_t n,
39449 : /* Complex */ ae_vector* v,
39450 : /* Complex */ ae_vector* x,
39451 : double* est,
39452 : ae_int_t* kase,
39453 : /* Integer */ ae_vector* isave,
39454 : /* Real */ ae_vector* rsave,
39455 : ae_state *_state)
39456 : {
39457 : ae_int_t itmax;
39458 : ae_int_t i;
39459 : ae_int_t iter;
39460 : ae_int_t j;
39461 : ae_int_t jlast;
39462 : ae_int_t jump;
39463 : double absxi;
39464 : double altsgn;
39465 : double estold;
39466 : double safmin;
39467 : double temp;
39468 :
39469 :
39470 :
39471 : /*
39472 : *Executable Statements ..
39473 : */
39474 0 : itmax = 5;
39475 0 : safmin = ae_minrealnumber;
39476 0 : if( *kase==0 )
39477 : {
39478 0 : ae_vector_set_length(v, n+1, _state);
39479 0 : ae_vector_set_length(x, n+1, _state);
39480 0 : ae_vector_set_length(isave, 5, _state);
39481 0 : ae_vector_set_length(rsave, 4, _state);
39482 0 : for(i=1; i<=n; i++)
39483 : {
39484 0 : x->ptr.p_complex[i] = ae_complex_from_d((double)1/(double)n);
39485 : }
39486 0 : *kase = 1;
39487 0 : jump = 1;
39488 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39489 0 : return;
39490 : }
39491 0 : rcond_internalcomplexrcondloadall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39492 :
39493 : /*
39494 : * ENTRY (JUMP = 1)
39495 : * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X.
39496 : */
39497 0 : if( jump==1 )
39498 : {
39499 0 : if( n==1 )
39500 : {
39501 0 : v->ptr.p_complex[1] = x->ptr.p_complex[1];
39502 0 : *est = ae_c_abs(v->ptr.p_complex[1], _state);
39503 0 : *kase = 0;
39504 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39505 0 : return;
39506 : }
39507 0 : *est = rcond_internalcomplexrcondscsum1(x, n, _state);
39508 0 : for(i=1; i<=n; i++)
39509 : {
39510 0 : absxi = ae_c_abs(x->ptr.p_complex[i], _state);
39511 0 : if( ae_fp_greater(absxi,safmin) )
39512 : {
39513 0 : x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi);
39514 : }
39515 : else
39516 : {
39517 0 : x->ptr.p_complex[i] = ae_complex_from_i(1);
39518 : }
39519 : }
39520 0 : *kase = 2;
39521 0 : jump = 2;
39522 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39523 0 : return;
39524 : }
39525 :
39526 : /*
39527 : * ENTRY (JUMP = 2)
39528 : * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
39529 : */
39530 0 : if( jump==2 )
39531 : {
39532 0 : j = rcond_internalcomplexrcondicmax1(x, n, _state);
39533 0 : iter = 2;
39534 :
39535 : /*
39536 : * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
39537 : */
39538 0 : for(i=1; i<=n; i++)
39539 : {
39540 0 : x->ptr.p_complex[i] = ae_complex_from_i(0);
39541 : }
39542 0 : x->ptr.p_complex[j] = ae_complex_from_i(1);
39543 0 : *kase = 1;
39544 0 : jump = 3;
39545 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39546 0 : return;
39547 : }
39548 :
39549 : /*
39550 : * ENTRY (JUMP = 3)
39551 : * X HAS BEEN OVERWRITTEN BY A*X.
39552 : */
39553 0 : if( jump==3 )
39554 : {
39555 0 : ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n));
39556 0 : estold = *est;
39557 0 : *est = rcond_internalcomplexrcondscsum1(v, n, _state);
39558 :
39559 : /*
39560 : * TEST FOR CYCLING.
39561 : */
39562 0 : if( ae_fp_less_eq(*est,estold) )
39563 : {
39564 :
39565 : /*
39566 : * ITERATION COMPLETE. FINAL STAGE.
39567 : */
39568 0 : altsgn = (double)(1);
39569 0 : for(i=1; i<=n; i++)
39570 : {
39571 0 : x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1)));
39572 0 : altsgn = -altsgn;
39573 : }
39574 0 : *kase = 1;
39575 0 : jump = 5;
39576 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39577 0 : return;
39578 : }
39579 0 : for(i=1; i<=n; i++)
39580 : {
39581 0 : absxi = ae_c_abs(x->ptr.p_complex[i], _state);
39582 0 : if( ae_fp_greater(absxi,safmin) )
39583 : {
39584 0 : x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi);
39585 : }
39586 : else
39587 : {
39588 0 : x->ptr.p_complex[i] = ae_complex_from_i(1);
39589 : }
39590 : }
39591 0 : *kase = 2;
39592 0 : jump = 4;
39593 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39594 0 : return;
39595 : }
39596 :
39597 : /*
39598 : * ENTRY (JUMP = 4)
39599 : * X HAS BEEN OVERWRITTEN BY CTRANS(A)*X.
39600 : */
39601 0 : if( jump==4 )
39602 : {
39603 0 : jlast = j;
39604 0 : j = rcond_internalcomplexrcondicmax1(x, n, _state);
39605 0 : if( ae_fp_neq(ae_c_abs(x->ptr.p_complex[jlast], _state),ae_c_abs(x->ptr.p_complex[j], _state))&&iter<itmax )
39606 : {
39607 0 : iter = iter+1;
39608 :
39609 : /*
39610 : * MAIN LOOP - ITERATIONS 2,3,...,ITMAX.
39611 : */
39612 0 : for(i=1; i<=n; i++)
39613 : {
39614 0 : x->ptr.p_complex[i] = ae_complex_from_i(0);
39615 : }
39616 0 : x->ptr.p_complex[j] = ae_complex_from_i(1);
39617 0 : *kase = 1;
39618 0 : jump = 3;
39619 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39620 0 : return;
39621 : }
39622 :
39623 : /*
39624 : * ITERATION COMPLETE. FINAL STAGE.
39625 : */
39626 0 : altsgn = (double)(1);
39627 0 : for(i=1; i<=n; i++)
39628 : {
39629 0 : x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1)));
39630 0 : altsgn = -altsgn;
39631 : }
39632 0 : *kase = 1;
39633 0 : jump = 5;
39634 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39635 0 : return;
39636 : }
39637 :
39638 : /*
39639 : * ENTRY (JUMP = 5)
39640 : * X HAS BEEN OVERWRITTEN BY A*X.
39641 : */
39642 0 : if( jump==5 )
39643 : {
39644 0 : temp = 2*(rcond_internalcomplexrcondscsum1(x, n, _state)/(3*n));
39645 0 : if( ae_fp_greater(temp,*est) )
39646 : {
39647 0 : ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n));
39648 0 : *est = temp;
39649 : }
39650 0 : *kase = 0;
39651 0 : rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state);
39652 0 : return;
39653 : }
39654 : }
39655 :
39656 :
39657 0 : static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x,
39658 : ae_int_t n,
39659 : ae_state *_state)
39660 : {
39661 : ae_int_t i;
39662 : double result;
39663 :
39664 :
39665 0 : result = (double)(0);
39666 0 : for(i=1; i<=n; i++)
39667 : {
39668 0 : result = result+ae_c_abs(x->ptr.p_complex[i], _state);
39669 : }
39670 0 : return result;
39671 : }
39672 :
39673 :
39674 0 : static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x,
39675 : ae_int_t n,
39676 : ae_state *_state)
39677 : {
39678 : ae_int_t i;
39679 : double m;
39680 : ae_int_t result;
39681 :
39682 :
39683 0 : result = 1;
39684 0 : m = ae_c_abs(x->ptr.p_complex[1], _state);
39685 0 : for(i=2; i<=n; i++)
39686 : {
39687 0 : if( ae_fp_greater(ae_c_abs(x->ptr.p_complex[i], _state),m) )
39688 : {
39689 0 : result = i;
39690 0 : m = ae_c_abs(x->ptr.p_complex[i], _state);
39691 : }
39692 : }
39693 0 : return result;
39694 : }
39695 :
39696 :
39697 0 : static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave,
39698 : /* Real */ ae_vector* rsave,
39699 : ae_int_t* i,
39700 : ae_int_t* iter,
39701 : ae_int_t* j,
39702 : ae_int_t* jlast,
39703 : ae_int_t* jump,
39704 : double* absxi,
39705 : double* altsgn,
39706 : double* estold,
39707 : double* temp,
39708 : ae_state *_state)
39709 : {
39710 :
39711 :
39712 0 : isave->ptr.p_int[0] = *i;
39713 0 : isave->ptr.p_int[1] = *iter;
39714 0 : isave->ptr.p_int[2] = *j;
39715 0 : isave->ptr.p_int[3] = *jlast;
39716 0 : isave->ptr.p_int[4] = *jump;
39717 0 : rsave->ptr.p_double[0] = *absxi;
39718 0 : rsave->ptr.p_double[1] = *altsgn;
39719 0 : rsave->ptr.p_double[2] = *estold;
39720 0 : rsave->ptr.p_double[3] = *temp;
39721 0 : }
39722 :
39723 :
39724 0 : static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave,
39725 : /* Real */ ae_vector* rsave,
39726 : ae_int_t* i,
39727 : ae_int_t* iter,
39728 : ae_int_t* j,
39729 : ae_int_t* jlast,
39730 : ae_int_t* jump,
39731 : double* absxi,
39732 : double* altsgn,
39733 : double* estold,
39734 : double* temp,
39735 : ae_state *_state)
39736 : {
39737 :
39738 :
39739 0 : *i = isave->ptr.p_int[0];
39740 0 : *iter = isave->ptr.p_int[1];
39741 0 : *j = isave->ptr.p_int[2];
39742 0 : *jlast = isave->ptr.p_int[3];
39743 0 : *jump = isave->ptr.p_int[4];
39744 0 : *absxi = rsave->ptr.p_double[0];
39745 0 : *altsgn = rsave->ptr.p_double[1];
39746 0 : *estold = rsave->ptr.p_double[2];
39747 0 : *temp = rsave->ptr.p_double[3];
39748 0 : }
39749 :
39750 :
39751 : #endif
39752 : #if defined(AE_COMPILE_MATINV) || !defined(AE_PARTIAL_BUILD)
39753 :
39754 :
39755 : /*************************************************************************
39756 : Inversion of a matrix given by its LU decomposition.
39757 :
39758 : ! COMMERCIAL EDITION OF ALGLIB:
39759 : !
39760 : ! Commercial Edition of ALGLIB includes following important improvements
39761 : ! of this function:
39762 : ! * high-performance native backend with same C# interface (C# version)
39763 : ! * multithreading support (C++ and C# versions)
39764 : ! * hardware vendor (Intel) implementations of linear algebra primitives
39765 : ! (C++ and C# versions, x86/x64 platform)
39766 : !
39767 : ! We recommend you to read 'Working with commercial version' section of
39768 : ! ALGLIB Reference Manual in order to find out how to use performance-
39769 : ! related features provided by commercial edition of ALGLIB.
39770 :
39771 : INPUT PARAMETERS:
39772 : A - LU decomposition of the matrix
39773 : (output of RMatrixLU subroutine).
39774 : Pivots - table of permutations
39775 : (the output of RMatrixLU subroutine).
39776 : N - size of matrix A (optional) :
39777 : * if given, only principal NxN submatrix is processed and
39778 : overwritten. other elements are unchanged.
39779 : * if not given, size is automatically determined from
39780 : matrix size (A must be square matrix)
39781 :
39782 : OUTPUT PARAMETERS:
39783 : Info - return code:
39784 : * -3 A is singular, or VERY close to singular.
39785 : it is filled by zeros in such cases.
39786 : * 1 task is solved (but matrix A may be ill-conditioned,
39787 : check R1/RInf parameters for condition numbers).
39788 : Rep - solver report, see below for more info
39789 : A - inverse of matrix A.
39790 : Array whose indexes range within [0..N-1, 0..N-1].
39791 :
39792 : SOLVER REPORT
39793 :
39794 : Subroutine sets following fields of the Rep structure:
39795 : * R1 reciprocal of condition number: 1/cond(A), 1-norm.
39796 : * RInf reciprocal of condition number: 1/cond(A), inf-norm.
39797 :
39798 : -- ALGLIB routine --
39799 : 05.02.2010
39800 : Bochkanov Sergey
39801 : *************************************************************************/
39802 0 : void rmatrixluinverse(/* Real */ ae_matrix* a,
39803 : /* Integer */ ae_vector* pivots,
39804 : ae_int_t n,
39805 : ae_int_t* info,
39806 : matinvreport* rep,
39807 : ae_state *_state)
39808 : {
39809 : ae_frame _frame_block;
39810 : ae_vector work;
39811 : ae_int_t i;
39812 : ae_int_t j;
39813 : ae_int_t k;
39814 : double v;
39815 : sinteger sinfo;
39816 :
39817 0 : ae_frame_make(_state, &_frame_block);
39818 0 : memset(&work, 0, sizeof(work));
39819 0 : memset(&sinfo, 0, sizeof(sinfo));
39820 0 : *info = 0;
39821 0 : _matinvreport_clear(rep);
39822 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
39823 0 : _sinteger_init(&sinfo, _state, ae_true);
39824 :
39825 0 : ae_assert(n>0, "RMatrixLUInverse: N<=0!", _state);
39826 0 : ae_assert(a->cols>=n, "RMatrixLUInverse: cols(A)<N!", _state);
39827 0 : ae_assert(a->rows>=n, "RMatrixLUInverse: rows(A)<N!", _state);
39828 0 : ae_assert(pivots->cnt>=n, "RMatrixLUInverse: len(Pivots)<N!", _state);
39829 0 : ae_assert(apservisfinitematrix(a, n, n, _state), "RMatrixLUInverse: A contains infinite or NaN values!", _state);
39830 0 : *info = 1;
39831 0 : for(i=0; i<=n-1; i++)
39832 : {
39833 0 : if( pivots->ptr.p_int[i]>n-1||pivots->ptr.p_int[i]<i )
39834 : {
39835 0 : *info = -1;
39836 : }
39837 : }
39838 0 : ae_assert(*info>0, "RMatrixLUInverse: incorrect Pivots array!", _state);
39839 :
39840 : /*
39841 : * calculate condition numbers
39842 : */
39843 0 : rep->r1 = rmatrixlurcond1(a, n, _state);
39844 0 : rep->rinf = rmatrixlurcondinf(a, n, _state);
39845 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
39846 : {
39847 0 : for(i=0; i<=n-1; i++)
39848 : {
39849 0 : for(j=0; j<=n-1; j++)
39850 : {
39851 0 : a->ptr.pp_double[i][j] = (double)(0);
39852 : }
39853 : }
39854 0 : rep->r1 = (double)(0);
39855 0 : rep->rinf = (double)(0);
39856 0 : *info = -3;
39857 0 : ae_frame_leave(_state);
39858 0 : return;
39859 : }
39860 :
39861 : /*
39862 : * Call cache-oblivious code
39863 : */
39864 0 : ae_vector_set_length(&work, n, _state);
39865 0 : sinfo.val = 1;
39866 0 : matinv_rmatrixluinverserec(a, 0, n, &work, &sinfo, rep, _state);
39867 0 : *info = sinfo.val;
39868 :
39869 : /*
39870 : * apply permutations
39871 : */
39872 0 : for(i=0; i<=n-1; i++)
39873 : {
39874 0 : for(j=n-2; j>=0; j--)
39875 : {
39876 0 : k = pivots->ptr.p_int[j];
39877 0 : v = a->ptr.pp_double[i][j];
39878 0 : a->ptr.pp_double[i][j] = a->ptr.pp_double[i][k];
39879 0 : a->ptr.pp_double[i][k] = v;
39880 : }
39881 : }
39882 0 : ae_frame_leave(_state);
39883 : }
39884 :
39885 :
39886 : /*************************************************************************
39887 : Inversion of a general matrix.
39888 :
39889 : ! COMMERCIAL EDITION OF ALGLIB:
39890 : !
39891 : ! Commercial Edition of ALGLIB includes following important improvements
39892 : ! of this function:
39893 : ! * high-performance native backend with same C# interface (C# version)
39894 : ! * multithreading support (C++ and C# versions)
39895 : ! * hardware vendor (Intel) implementations of linear algebra primitives
39896 : ! (C++ and C# versions, x86/x64 platform)
39897 : !
39898 : ! We recommend you to read 'Working with commercial version' section of
39899 : ! ALGLIB Reference Manual in order to find out how to use performance-
39900 : ! related features provided by commercial edition of ALGLIB.
39901 :
39902 : Input parameters:
39903 : A - matrix.
39904 : N - size of matrix A (optional) :
39905 : * if given, only principal NxN submatrix is processed and
39906 : overwritten. other elements are unchanged.
39907 : * if not given, size is automatically determined from
39908 : matrix size (A must be square matrix)
39909 :
39910 : Output parameters:
39911 : Info - return code, same as in RMatrixLUInverse
39912 : Rep - solver report, same as in RMatrixLUInverse
39913 : A - inverse of matrix A, same as in RMatrixLUInverse
39914 :
39915 : Result:
39916 : True, if the matrix is not singular.
39917 : False, if the matrix is singular.
39918 :
39919 : -- ALGLIB --
39920 : Copyright 2005-2010 by Bochkanov Sergey
39921 : *************************************************************************/
39922 0 : void rmatrixinverse(/* Real */ ae_matrix* a,
39923 : ae_int_t n,
39924 : ae_int_t* info,
39925 : matinvreport* rep,
39926 : ae_state *_state)
39927 : {
39928 : ae_frame _frame_block;
39929 : ae_vector pivots;
39930 :
39931 0 : ae_frame_make(_state, &_frame_block);
39932 0 : memset(&pivots, 0, sizeof(pivots));
39933 0 : *info = 0;
39934 0 : _matinvreport_clear(rep);
39935 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
39936 :
39937 0 : ae_assert(n>0, "RMatrixInverse: N<=0!", _state);
39938 0 : ae_assert(a->cols>=n, "RMatrixInverse: cols(A)<N!", _state);
39939 0 : ae_assert(a->rows>=n, "RMatrixInverse: rows(A)<N!", _state);
39940 0 : ae_assert(apservisfinitematrix(a, n, n, _state), "RMatrixInverse: A contains infinite or NaN values!", _state);
39941 0 : rmatrixlu(a, n, n, &pivots, _state);
39942 0 : rmatrixluinverse(a, &pivots, n, info, rep, _state);
39943 0 : ae_frame_leave(_state);
39944 0 : }
39945 :
39946 :
39947 : /*************************************************************************
39948 : Inversion of a matrix given by its LU decomposition.
39949 :
39950 : ! COMMERCIAL EDITION OF ALGLIB:
39951 : !
39952 : ! Commercial Edition of ALGLIB includes following important improvements
39953 : ! of this function:
39954 : ! * high-performance native backend with same C# interface (C# version)
39955 : ! * multithreading support (C++ and C# versions)
39956 : ! * hardware vendor (Intel) implementations of linear algebra primitives
39957 : ! (C++ and C# versions, x86/x64 platform)
39958 : !
39959 : ! We recommend you to read 'Working with commercial version' section of
39960 : ! ALGLIB Reference Manual in order to find out how to use performance-
39961 : ! related features provided by commercial edition of ALGLIB.
39962 :
39963 : INPUT PARAMETERS:
39964 : A - LU decomposition of the matrix
39965 : (output of CMatrixLU subroutine).
39966 : Pivots - table of permutations
39967 : (the output of CMatrixLU subroutine).
39968 : N - size of matrix A (optional) :
39969 : * if given, only principal NxN submatrix is processed and
39970 : overwritten. other elements are unchanged.
39971 : * if not given, size is automatically determined from
39972 : matrix size (A must be square matrix)
39973 :
39974 : OUTPUT PARAMETERS:
39975 : Info - return code, same as in RMatrixLUInverse
39976 : Rep - solver report, same as in RMatrixLUInverse
39977 : A - inverse of matrix A, same as in RMatrixLUInverse
39978 :
39979 : -- ALGLIB routine --
39980 : 05.02.2010
39981 : Bochkanov Sergey
39982 : *************************************************************************/
39983 0 : void cmatrixluinverse(/* Complex */ ae_matrix* a,
39984 : /* Integer */ ae_vector* pivots,
39985 : ae_int_t n,
39986 : ae_int_t* info,
39987 : matinvreport* rep,
39988 : ae_state *_state)
39989 : {
39990 : ae_frame _frame_block;
39991 : ae_vector work;
39992 : ae_int_t i;
39993 : ae_int_t j;
39994 : ae_int_t k;
39995 : ae_complex v;
39996 : sinteger sinfo;
39997 :
39998 0 : ae_frame_make(_state, &_frame_block);
39999 0 : memset(&work, 0, sizeof(work));
40000 0 : memset(&sinfo, 0, sizeof(sinfo));
40001 0 : *info = 0;
40002 0 : _matinvreport_clear(rep);
40003 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
40004 0 : _sinteger_init(&sinfo, _state, ae_true);
40005 :
40006 0 : ae_assert(n>0, "CMatrixLUInverse: N<=0!", _state);
40007 0 : ae_assert(a->cols>=n, "CMatrixLUInverse: cols(A)<N!", _state);
40008 0 : ae_assert(a->rows>=n, "CMatrixLUInverse: rows(A)<N!", _state);
40009 0 : ae_assert(pivots->cnt>=n, "CMatrixLUInverse: len(Pivots)<N!", _state);
40010 0 : ae_assert(apservisfinitecmatrix(a, n, n, _state), "CMatrixLUInverse: A contains infinite or NaN values!", _state);
40011 0 : *info = 1;
40012 0 : for(i=0; i<=n-1; i++)
40013 : {
40014 0 : if( pivots->ptr.p_int[i]>n-1||pivots->ptr.p_int[i]<i )
40015 : {
40016 0 : *info = -1;
40017 : }
40018 : }
40019 0 : ae_assert(*info>0, "CMatrixLUInverse: incorrect Pivots array!", _state);
40020 :
40021 : /*
40022 : * calculate condition numbers
40023 : */
40024 0 : rep->r1 = cmatrixlurcond1(a, n, _state);
40025 0 : rep->rinf = cmatrixlurcondinf(a, n, _state);
40026 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
40027 : {
40028 0 : for(i=0; i<=n-1; i++)
40029 : {
40030 0 : for(j=0; j<=n-1; j++)
40031 : {
40032 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
40033 : }
40034 : }
40035 0 : rep->r1 = (double)(0);
40036 0 : rep->rinf = (double)(0);
40037 0 : *info = -3;
40038 0 : ae_frame_leave(_state);
40039 0 : return;
40040 : }
40041 :
40042 : /*
40043 : * Call cache-oblivious code
40044 : */
40045 0 : ae_vector_set_length(&work, n, _state);
40046 0 : sinfo.val = 1;
40047 0 : matinv_cmatrixluinverserec(a, 0, n, &work, &sinfo, rep, _state);
40048 0 : *info = sinfo.val;
40049 :
40050 : /*
40051 : * apply permutations
40052 : */
40053 0 : for(i=0; i<=n-1; i++)
40054 : {
40055 0 : for(j=n-2; j>=0; j--)
40056 : {
40057 0 : k = pivots->ptr.p_int[j];
40058 0 : v = a->ptr.pp_complex[i][j];
40059 0 : a->ptr.pp_complex[i][j] = a->ptr.pp_complex[i][k];
40060 0 : a->ptr.pp_complex[i][k] = v;
40061 : }
40062 : }
40063 0 : ae_frame_leave(_state);
40064 : }
40065 :
40066 :
40067 : /*************************************************************************
40068 : Inversion of a general matrix.
40069 :
40070 : ! COMMERCIAL EDITION OF ALGLIB:
40071 : !
40072 : ! Commercial Edition of ALGLIB includes following important improvements
40073 : ! of this function:
40074 : ! * high-performance native backend with same C# interface (C# version)
40075 : ! * multithreading support (C++ and C# versions)
40076 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40077 : ! (C++ and C# versions, x86/x64 platform)
40078 : !
40079 : ! We recommend you to read 'Working with commercial version' section of
40080 : ! ALGLIB Reference Manual in order to find out how to use performance-
40081 : ! related features provided by commercial edition of ALGLIB.
40082 :
40083 : Input parameters:
40084 : A - matrix
40085 : N - size of matrix A (optional) :
40086 : * if given, only principal NxN submatrix is processed and
40087 : overwritten. other elements are unchanged.
40088 : * if not given, size is automatically determined from
40089 : matrix size (A must be square matrix)
40090 :
40091 : Output parameters:
40092 : Info - return code, same as in RMatrixLUInverse
40093 : Rep - solver report, same as in RMatrixLUInverse
40094 : A - inverse of matrix A, same as in RMatrixLUInverse
40095 :
40096 : -- ALGLIB --
40097 : Copyright 2005 by Bochkanov Sergey
40098 : *************************************************************************/
40099 0 : void cmatrixinverse(/* Complex */ ae_matrix* a,
40100 : ae_int_t n,
40101 : ae_int_t* info,
40102 : matinvreport* rep,
40103 : ae_state *_state)
40104 : {
40105 : ae_frame _frame_block;
40106 : ae_vector pivots;
40107 :
40108 0 : ae_frame_make(_state, &_frame_block);
40109 0 : memset(&pivots, 0, sizeof(pivots));
40110 0 : *info = 0;
40111 0 : _matinvreport_clear(rep);
40112 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
40113 :
40114 0 : ae_assert(n>0, "CRMatrixInverse: N<=0!", _state);
40115 0 : ae_assert(a->cols>=n, "CRMatrixInverse: cols(A)<N!", _state);
40116 0 : ae_assert(a->rows>=n, "CRMatrixInverse: rows(A)<N!", _state);
40117 0 : ae_assert(apservisfinitecmatrix(a, n, n, _state), "CMatrixInverse: A contains infinite or NaN values!", _state);
40118 0 : cmatrixlu(a, n, n, &pivots, _state);
40119 0 : cmatrixluinverse(a, &pivots, n, info, rep, _state);
40120 0 : ae_frame_leave(_state);
40121 0 : }
40122 :
40123 :
40124 : /*************************************************************************
40125 : Inversion of a symmetric positive definite matrix which is given
40126 : by Cholesky decomposition.
40127 :
40128 : ! COMMERCIAL EDITION OF ALGLIB:
40129 : !
40130 : ! Commercial Edition of ALGLIB includes following important improvements
40131 : ! of this function:
40132 : ! * high-performance native backend with same C# interface (C# version)
40133 : ! * multithreading support (C++ and C# versions)
40134 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40135 : ! (C++ and C# versions, x86/x64 platform)
40136 : !
40137 : ! We recommend you to read 'Working with commercial version' section of
40138 : ! ALGLIB Reference Manual in order to find out how to use performance-
40139 : ! related features provided by commercial edition of ALGLIB.
40140 :
40141 : Input parameters:
40142 : A - Cholesky decomposition of the matrix to be inverted:
40143 : A=U'*U or A = L*L'.
40144 : Output of SPDMatrixCholesky subroutine.
40145 : N - size of matrix A (optional) :
40146 : * if given, only principal NxN submatrix is processed and
40147 : overwritten. other elements are unchanged.
40148 : * if not given, size is automatically determined from
40149 : matrix size (A must be square matrix)
40150 : IsUpper - storage type (optional):
40151 : * if True, symmetric matrix A is given by its upper
40152 : triangle, and the lower triangle isn't used/changed by
40153 : function
40154 : * if False, symmetric matrix A is given by its lower
40155 : triangle, and the upper triangle isn't used/changed by
40156 : function
40157 : * if not given, lower half is used.
40158 :
40159 : Output parameters:
40160 : Info - return code, same as in RMatrixLUInverse
40161 : Rep - solver report, same as in RMatrixLUInverse
40162 : A - inverse of matrix A, same as in RMatrixLUInverse
40163 :
40164 : -- ALGLIB routine --
40165 : 10.02.2010
40166 : Bochkanov Sergey
40167 : *************************************************************************/
40168 0 : void spdmatrixcholeskyinverse(/* Real */ ae_matrix* a,
40169 : ae_int_t n,
40170 : ae_bool isupper,
40171 : ae_int_t* info,
40172 : matinvreport* rep,
40173 : ae_state *_state)
40174 : {
40175 : ae_frame _frame_block;
40176 : ae_int_t i;
40177 : ae_int_t j;
40178 : ae_vector tmp;
40179 : matinvreport rep2;
40180 : ae_bool f;
40181 :
40182 0 : ae_frame_make(_state, &_frame_block);
40183 0 : memset(&tmp, 0, sizeof(tmp));
40184 0 : memset(&rep2, 0, sizeof(rep2));
40185 0 : *info = 0;
40186 0 : _matinvreport_clear(rep);
40187 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
40188 0 : _matinvreport_init(&rep2, _state, ae_true);
40189 :
40190 0 : ae_assert(n>0, "SPDMatrixCholeskyInverse: N<=0!", _state);
40191 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyInverse: cols(A)<N!", _state);
40192 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyInverse: rows(A)<N!", _state);
40193 0 : *info = 1;
40194 0 : f = ae_true;
40195 0 : for(i=0; i<=n-1; i++)
40196 : {
40197 0 : f = f&&ae_isfinite(a->ptr.pp_double[i][i], _state);
40198 : }
40199 0 : ae_assert(f, "SPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state);
40200 :
40201 : /*
40202 : * calculate condition numbers
40203 : */
40204 0 : rep->r1 = spdmatrixcholeskyrcond(a, n, isupper, _state);
40205 0 : rep->rinf = rep->r1;
40206 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
40207 : {
40208 0 : if( isupper )
40209 : {
40210 0 : for(i=0; i<=n-1; i++)
40211 : {
40212 0 : for(j=i; j<=n-1; j++)
40213 : {
40214 0 : a->ptr.pp_double[i][j] = (double)(0);
40215 : }
40216 : }
40217 : }
40218 : else
40219 : {
40220 0 : for(i=0; i<=n-1; i++)
40221 : {
40222 0 : for(j=0; j<=i; j++)
40223 : {
40224 0 : a->ptr.pp_double[i][j] = (double)(0);
40225 : }
40226 : }
40227 : }
40228 0 : rep->r1 = (double)(0);
40229 0 : rep->rinf = (double)(0);
40230 0 : *info = -3;
40231 0 : ae_frame_leave(_state);
40232 0 : return;
40233 : }
40234 :
40235 : /*
40236 : * Inverse
40237 : */
40238 0 : ae_vector_set_length(&tmp, n, _state);
40239 0 : spdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state);
40240 0 : ae_frame_leave(_state);
40241 : }
40242 :
40243 :
40244 : /*************************************************************************
40245 : Inversion of a symmetric positive definite matrix.
40246 :
40247 : Given an upper or lower triangle of a symmetric positive definite matrix,
40248 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
40249 : depending on the input.
40250 :
40251 : ! COMMERCIAL EDITION OF ALGLIB:
40252 : !
40253 : ! Commercial Edition of ALGLIB includes following important improvements
40254 : ! of this function:
40255 : ! * high-performance native backend with same C# interface (C# version)
40256 : ! * multithreading support (C++ and C# versions)
40257 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40258 : ! (C++ and C# versions, x86/x64 platform)
40259 : !
40260 : ! We recommend you to read 'Working with commercial version' section of
40261 : ! ALGLIB Reference Manual in order to find out how to use performance-
40262 : ! related features provided by commercial edition of ALGLIB.
40263 :
40264 : Input parameters:
40265 : A - matrix to be inverted (upper or lower triangle).
40266 : Array with elements [0..N-1,0..N-1].
40267 : N - size of matrix A (optional) :
40268 : * if given, only principal NxN submatrix is processed and
40269 : overwritten. other elements are unchanged.
40270 : * if not given, size is automatically determined from
40271 : matrix size (A must be square matrix)
40272 : IsUpper - storage type (optional):
40273 : * if True, symmetric matrix A is given by its upper
40274 : triangle, and the lower triangle isn't used/changed by
40275 : function
40276 : * if False, symmetric matrix A is given by its lower
40277 : triangle, and the upper triangle isn't used/changed by
40278 : function
40279 : * if not given, both lower and upper triangles must be
40280 : filled.
40281 :
40282 : Output parameters:
40283 : Info - return code, same as in RMatrixLUInverse
40284 : Rep - solver report, same as in RMatrixLUInverse
40285 : A - inverse of matrix A, same as in RMatrixLUInverse
40286 :
40287 : -- ALGLIB routine --
40288 : 10.02.2010
40289 : Bochkanov Sergey
40290 : *************************************************************************/
40291 0 : void spdmatrixinverse(/* Real */ ae_matrix* a,
40292 : ae_int_t n,
40293 : ae_bool isupper,
40294 : ae_int_t* info,
40295 : matinvreport* rep,
40296 : ae_state *_state)
40297 : {
40298 :
40299 0 : *info = 0;
40300 0 : _matinvreport_clear(rep);
40301 :
40302 0 : ae_assert(n>0, "SPDMatrixInverse: N<=0!", _state);
40303 0 : ae_assert(a->cols>=n, "SPDMatrixInverse: cols(A)<N!", _state);
40304 0 : ae_assert(a->rows>=n, "SPDMatrixInverse: rows(A)<N!", _state);
40305 0 : ae_assert(isfinitertrmatrix(a, n, isupper, _state), "SPDMatrixInverse: A contains infinite or NaN values!", _state);
40306 0 : *info = 1;
40307 0 : if( spdmatrixcholesky(a, n, isupper, _state) )
40308 : {
40309 0 : spdmatrixcholeskyinverse(a, n, isupper, info, rep, _state);
40310 : }
40311 : else
40312 : {
40313 0 : *info = -3;
40314 : }
40315 0 : }
40316 :
40317 :
40318 : /*************************************************************************
40319 : Inversion of a Hermitian positive definite matrix which is given
40320 : by Cholesky decomposition.
40321 :
40322 : ! COMMERCIAL EDITION OF ALGLIB:
40323 : !
40324 : ! Commercial Edition of ALGLIB includes following important improvements
40325 : ! of this function:
40326 : ! * high-performance native backend with same C# interface (C# version)
40327 : ! * multithreading support (C++ and C# versions)
40328 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40329 : ! (C++ and C# versions, x86/x64 platform)
40330 : !
40331 : ! We recommend you to read 'Working with commercial version' section of
40332 : ! ALGLIB Reference Manual in order to find out how to use performance-
40333 : ! related features provided by commercial edition of ALGLIB.
40334 :
40335 : Input parameters:
40336 : A - Cholesky decomposition of the matrix to be inverted:
40337 : A=U'*U or A = L*L'.
40338 : Output of HPDMatrixCholesky subroutine.
40339 : N - size of matrix A (optional) :
40340 : * if given, only principal NxN submatrix is processed and
40341 : overwritten. other elements are unchanged.
40342 : * if not given, size is automatically determined from
40343 : matrix size (A must be square matrix)
40344 : IsUpper - storage type (optional):
40345 : * if True, symmetric matrix A is given by its upper
40346 : triangle, and the lower triangle isn't used/changed by
40347 : function
40348 : * if False, symmetric matrix A is given by its lower
40349 : triangle, and the upper triangle isn't used/changed by
40350 : function
40351 : * if not given, lower half is used.
40352 :
40353 : Output parameters:
40354 : Info - return code, same as in RMatrixLUInverse
40355 : Rep - solver report, same as in RMatrixLUInverse
40356 : A - inverse of matrix A, same as in RMatrixLUInverse
40357 :
40358 : -- ALGLIB routine --
40359 : 10.02.2010
40360 : Bochkanov Sergey
40361 : *************************************************************************/
40362 0 : void hpdmatrixcholeskyinverse(/* Complex */ ae_matrix* a,
40363 : ae_int_t n,
40364 : ae_bool isupper,
40365 : ae_int_t* info,
40366 : matinvreport* rep,
40367 : ae_state *_state)
40368 : {
40369 : ae_frame _frame_block;
40370 : ae_int_t i;
40371 : ae_int_t j;
40372 : matinvreport rep2;
40373 : ae_vector tmp;
40374 : ae_bool f;
40375 :
40376 0 : ae_frame_make(_state, &_frame_block);
40377 0 : memset(&rep2, 0, sizeof(rep2));
40378 0 : memset(&tmp, 0, sizeof(tmp));
40379 0 : *info = 0;
40380 0 : _matinvreport_clear(rep);
40381 0 : _matinvreport_init(&rep2, _state, ae_true);
40382 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
40383 :
40384 0 : ae_assert(n>0, "HPDMatrixCholeskyInverse: N<=0!", _state);
40385 0 : ae_assert(a->cols>=n, "HPDMatrixCholeskyInverse: cols(A)<N!", _state);
40386 0 : ae_assert(a->rows>=n, "HPDMatrixCholeskyInverse: rows(A)<N!", _state);
40387 0 : f = ae_true;
40388 0 : for(i=0; i<=n-1; i++)
40389 : {
40390 0 : f = (f&&ae_isfinite(a->ptr.pp_complex[i][i].x, _state))&&ae_isfinite(a->ptr.pp_complex[i][i].y, _state);
40391 : }
40392 0 : ae_assert(f, "HPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state);
40393 0 : *info = 1;
40394 :
40395 : /*
40396 : * calculate condition numbers
40397 : */
40398 0 : rep->r1 = hpdmatrixcholeskyrcond(a, n, isupper, _state);
40399 0 : rep->rinf = rep->r1;
40400 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
40401 : {
40402 0 : if( isupper )
40403 : {
40404 0 : for(i=0; i<=n-1; i++)
40405 : {
40406 0 : for(j=i; j<=n-1; j++)
40407 : {
40408 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
40409 : }
40410 : }
40411 : }
40412 : else
40413 : {
40414 0 : for(i=0; i<=n-1; i++)
40415 : {
40416 0 : for(j=0; j<=i; j++)
40417 : {
40418 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
40419 : }
40420 : }
40421 : }
40422 0 : rep->r1 = (double)(0);
40423 0 : rep->rinf = (double)(0);
40424 0 : *info = -3;
40425 0 : ae_frame_leave(_state);
40426 0 : return;
40427 : }
40428 :
40429 : /*
40430 : * Inverse
40431 : */
40432 0 : ae_vector_set_length(&tmp, n, _state);
40433 0 : matinv_hpdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state);
40434 0 : ae_frame_leave(_state);
40435 : }
40436 :
40437 :
40438 : /*************************************************************************
40439 : Inversion of a Hermitian positive definite matrix.
40440 :
40441 : Given an upper or lower triangle of a Hermitian positive definite matrix,
40442 : the algorithm generates matrix A^-1 and saves the upper or lower triangle
40443 : depending on the input.
40444 :
40445 : ! COMMERCIAL EDITION OF ALGLIB:
40446 : !
40447 : ! Commercial Edition of ALGLIB includes following important improvements
40448 : ! of this function:
40449 : ! * high-performance native backend with same C# interface (C# version)
40450 : ! * multithreading support (C++ and C# versions)
40451 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40452 : ! (C++ and C# versions, x86/x64 platform)
40453 : !
40454 : ! We recommend you to read 'Working with commercial version' section of
40455 : ! ALGLIB Reference Manual in order to find out how to use performance-
40456 : ! related features provided by commercial edition of ALGLIB.
40457 :
40458 : Input parameters:
40459 : A - matrix to be inverted (upper or lower triangle).
40460 : Array with elements [0..N-1,0..N-1].
40461 : N - size of matrix A (optional) :
40462 : * if given, only principal NxN submatrix is processed and
40463 : overwritten. other elements are unchanged.
40464 : * if not given, size is automatically determined from
40465 : matrix size (A must be square matrix)
40466 : IsUpper - storage type (optional):
40467 : * if True, symmetric matrix A is given by its upper
40468 : triangle, and the lower triangle isn't used/changed by
40469 : function
40470 : * if False, symmetric matrix A is given by its lower
40471 : triangle, and the upper triangle isn't used/changed by
40472 : function
40473 : * if not given, both lower and upper triangles must be
40474 : filled.
40475 :
40476 : Output parameters:
40477 : Info - return code, same as in RMatrixLUInverse
40478 : Rep - solver report, same as in RMatrixLUInverse
40479 : A - inverse of matrix A, same as in RMatrixLUInverse
40480 :
40481 : -- ALGLIB routine --
40482 : 10.02.2010
40483 : Bochkanov Sergey
40484 : *************************************************************************/
40485 0 : void hpdmatrixinverse(/* Complex */ ae_matrix* a,
40486 : ae_int_t n,
40487 : ae_bool isupper,
40488 : ae_int_t* info,
40489 : matinvreport* rep,
40490 : ae_state *_state)
40491 : {
40492 :
40493 0 : *info = 0;
40494 0 : _matinvreport_clear(rep);
40495 :
40496 0 : ae_assert(n>0, "HPDMatrixInverse: N<=0!", _state);
40497 0 : ae_assert(a->cols>=n, "HPDMatrixInverse: cols(A)<N!", _state);
40498 0 : ae_assert(a->rows>=n, "HPDMatrixInverse: rows(A)<N!", _state);
40499 0 : ae_assert(apservisfinitectrmatrix(a, n, isupper, _state), "HPDMatrixInverse: A contains infinite or NaN values!", _state);
40500 0 : *info = 1;
40501 0 : if( hpdmatrixcholesky(a, n, isupper, _state) )
40502 : {
40503 0 : hpdmatrixcholeskyinverse(a, n, isupper, info, rep, _state);
40504 : }
40505 : else
40506 : {
40507 0 : *info = -3;
40508 : }
40509 0 : }
40510 :
40511 :
40512 : /*************************************************************************
40513 : Triangular matrix inverse (real)
40514 :
40515 : The subroutine inverts the following types of matrices:
40516 : * upper triangular
40517 : * upper triangular with unit diagonal
40518 : * lower triangular
40519 : * lower triangular with unit diagonal
40520 :
40521 : In case of an upper (lower) triangular matrix, the inverse matrix will
40522 : also be upper (lower) triangular, and after the end of the algorithm, the
40523 : inverse matrix replaces the source matrix. The elements below (above) the
40524 : main diagonal are not changed by the algorithm.
40525 :
40526 : If the matrix has a unit diagonal, the inverse matrix also has a unit
40527 : diagonal, and the diagonal elements are not passed to the algorithm.
40528 :
40529 : ! COMMERCIAL EDITION OF ALGLIB:
40530 : !
40531 : ! Commercial Edition of ALGLIB includes following important improvements
40532 : ! of this function:
40533 : ! * high-performance native backend with same C# interface (C# version)
40534 : ! * multithreading support (C++ and C# versions)
40535 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40536 : ! (C++ and C# versions, x86/x64 platform)
40537 : !
40538 : ! We recommend you to read 'Working with commercial version' section of
40539 : ! ALGLIB Reference Manual in order to find out how to use performance-
40540 : ! related features provided by commercial edition of ALGLIB.
40541 :
40542 : Input parameters:
40543 : A - matrix, array[0..N-1, 0..N-1].
40544 : N - size of matrix A (optional) :
40545 : * if given, only principal NxN submatrix is processed and
40546 : overwritten. other elements are unchanged.
40547 : * if not given, size is automatically determined from
40548 : matrix size (A must be square matrix)
40549 : IsUpper - True, if the matrix is upper triangular.
40550 : IsUnit - diagonal type (optional):
40551 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
40552 : * if False, matrix diagonal is arbitrary
40553 : * if not given, False is assumed
40554 :
40555 : Output parameters:
40556 : Info - same as for RMatrixLUInverse
40557 : Rep - same as for RMatrixLUInverse
40558 : A - same as for RMatrixLUInverse.
40559 :
40560 : -- ALGLIB --
40561 : Copyright 05.02.2010 by Bochkanov Sergey
40562 : *************************************************************************/
40563 0 : void rmatrixtrinverse(/* Real */ ae_matrix* a,
40564 : ae_int_t n,
40565 : ae_bool isupper,
40566 : ae_bool isunit,
40567 : ae_int_t* info,
40568 : matinvreport* rep,
40569 : ae_state *_state)
40570 : {
40571 : ae_frame _frame_block;
40572 : ae_int_t i;
40573 : ae_int_t j;
40574 : ae_vector tmp;
40575 : sinteger sinfo;
40576 :
40577 0 : ae_frame_make(_state, &_frame_block);
40578 0 : memset(&tmp, 0, sizeof(tmp));
40579 0 : memset(&sinfo, 0, sizeof(sinfo));
40580 0 : *info = 0;
40581 0 : _matinvreport_clear(rep);
40582 0 : ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true);
40583 0 : _sinteger_init(&sinfo, _state, ae_true);
40584 :
40585 0 : ae_assert(n>0, "RMatrixTRInverse: N<=0!", _state);
40586 0 : ae_assert(a->cols>=n, "RMatrixTRInverse: cols(A)<N!", _state);
40587 0 : ae_assert(a->rows>=n, "RMatrixTRInverse: rows(A)<N!", _state);
40588 0 : ae_assert(isfinitertrmatrix(a, n, isupper, _state), "RMatrixTRInverse: A contains infinite or NaN values!", _state);
40589 :
40590 : /*
40591 : * calculate condition numbers
40592 : */
40593 0 : rep->r1 = rmatrixtrrcond1(a, n, isupper, isunit, _state);
40594 0 : rep->rinf = rmatrixtrrcondinf(a, n, isupper, isunit, _state);
40595 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
40596 : {
40597 0 : for(i=0; i<=n-1; i++)
40598 : {
40599 0 : for(j=0; j<=n-1; j++)
40600 : {
40601 0 : a->ptr.pp_double[i][j] = (double)(0);
40602 : }
40603 : }
40604 0 : rep->r1 = (double)(0);
40605 0 : rep->rinf = (double)(0);
40606 0 : *info = -3;
40607 0 : ae_frame_leave(_state);
40608 0 : return;
40609 : }
40610 :
40611 : /*
40612 : * Invert
40613 : */
40614 0 : ae_vector_set_length(&tmp, n, _state);
40615 0 : sinfo.val = 1;
40616 0 : matinv_rmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, &sinfo, _state);
40617 0 : *info = sinfo.val;
40618 0 : ae_frame_leave(_state);
40619 : }
40620 :
40621 :
40622 : /*************************************************************************
40623 : Triangular matrix inverse (complex)
40624 :
40625 : The subroutine inverts the following types of matrices:
40626 : * upper triangular
40627 : * upper triangular with unit diagonal
40628 : * lower triangular
40629 : * lower triangular with unit diagonal
40630 :
40631 : In case of an upper (lower) triangular matrix, the inverse matrix will
40632 : also be upper (lower) triangular, and after the end of the algorithm, the
40633 : inverse matrix replaces the source matrix. The elements below (above) the
40634 : main diagonal are not changed by the algorithm.
40635 :
40636 : If the matrix has a unit diagonal, the inverse matrix also has a unit
40637 : diagonal, and the diagonal elements are not passed to the algorithm.
40638 :
40639 : ! COMMERCIAL EDITION OF ALGLIB:
40640 : !
40641 : ! Commercial Edition of ALGLIB includes following important improvements
40642 : ! of this function:
40643 : ! * high-performance native backend with same C# interface (C# version)
40644 : ! * multithreading support (C++ and C# versions)
40645 : ! * hardware vendor (Intel) implementations of linear algebra primitives
40646 : ! (C++ and C# versions, x86/x64 platform)
40647 : !
40648 : ! We recommend you to read 'Working with commercial version' section of
40649 : ! ALGLIB Reference Manual in order to find out how to use performance-
40650 : ! related features provided by commercial edition of ALGLIB.
40651 :
40652 : Input parameters:
40653 : A - matrix, array[0..N-1, 0..N-1].
40654 : N - size of matrix A (optional) :
40655 : * if given, only principal NxN submatrix is processed and
40656 : overwritten. other elements are unchanged.
40657 : * if not given, size is automatically determined from
40658 : matrix size (A must be square matrix)
40659 : IsUpper - True, if the matrix is upper triangular.
40660 : IsUnit - diagonal type (optional):
40661 : * if True, matrix has unit diagonal (a[i,i] are NOT used)
40662 : * if False, matrix diagonal is arbitrary
40663 : * if not given, False is assumed
40664 :
40665 : Output parameters:
40666 : Info - same as for RMatrixLUInverse
40667 : Rep - same as for RMatrixLUInverse
40668 : A - same as for RMatrixLUInverse.
40669 :
40670 : -- ALGLIB --
40671 : Copyright 05.02.2010 by Bochkanov Sergey
40672 : *************************************************************************/
40673 0 : void cmatrixtrinverse(/* Complex */ ae_matrix* a,
40674 : ae_int_t n,
40675 : ae_bool isupper,
40676 : ae_bool isunit,
40677 : ae_int_t* info,
40678 : matinvreport* rep,
40679 : ae_state *_state)
40680 : {
40681 : ae_frame _frame_block;
40682 : ae_int_t i;
40683 : ae_int_t j;
40684 : ae_vector tmp;
40685 : sinteger sinfo;
40686 :
40687 0 : ae_frame_make(_state, &_frame_block);
40688 0 : memset(&tmp, 0, sizeof(tmp));
40689 0 : memset(&sinfo, 0, sizeof(sinfo));
40690 0 : *info = 0;
40691 0 : _matinvreport_clear(rep);
40692 0 : ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true);
40693 0 : _sinteger_init(&sinfo, _state, ae_true);
40694 :
40695 0 : ae_assert(n>0, "CMatrixTRInverse: N<=0!", _state);
40696 0 : ae_assert(a->cols>=n, "CMatrixTRInverse: cols(A)<N!", _state);
40697 0 : ae_assert(a->rows>=n, "CMatrixTRInverse: rows(A)<N!", _state);
40698 0 : ae_assert(apservisfinitectrmatrix(a, n, isupper, _state), "CMatrixTRInverse: A contains infinite or NaN values!", _state);
40699 :
40700 : /*
40701 : * calculate condition numbers
40702 : */
40703 0 : rep->r1 = cmatrixtrrcond1(a, n, isupper, isunit, _state);
40704 0 : rep->rinf = cmatrixtrrcondinf(a, n, isupper, isunit, _state);
40705 0 : if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) )
40706 : {
40707 0 : for(i=0; i<=n-1; i++)
40708 : {
40709 0 : for(j=0; j<=n-1; j++)
40710 : {
40711 0 : a->ptr.pp_complex[i][j] = ae_complex_from_i(0);
40712 : }
40713 : }
40714 0 : rep->r1 = (double)(0);
40715 0 : rep->rinf = (double)(0);
40716 0 : *info = -3;
40717 0 : ae_frame_leave(_state);
40718 0 : return;
40719 : }
40720 :
40721 : /*
40722 : * Invert
40723 : */
40724 0 : ae_vector_set_length(&tmp, n, _state);
40725 0 : sinfo.val = 1;
40726 0 : matinv_cmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, &sinfo, _state);
40727 0 : *info = sinfo.val;
40728 0 : ae_frame_leave(_state);
40729 : }
40730 :
40731 :
40732 : /*************************************************************************
40733 : Recursive subroutine for SPD inversion.
40734 :
40735 : NOTE: this function expects that matris is strictly positive-definite.
40736 :
40737 : -- ALGLIB routine --
40738 : 10.02.2010
40739 : Bochkanov Sergey
40740 : *************************************************************************/
40741 0 : void spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a,
40742 : ae_int_t offs,
40743 : ae_int_t n,
40744 : ae_bool isupper,
40745 : /* Real */ ae_vector* tmp,
40746 : ae_state *_state)
40747 : {
40748 : ae_frame _frame_block;
40749 : ae_int_t i;
40750 : ae_int_t j;
40751 : double v;
40752 : ae_int_t n1;
40753 : ae_int_t n2;
40754 : sinteger sinfo2;
40755 : ae_int_t tsa;
40756 : ae_int_t tsb;
40757 : ae_int_t tscur;
40758 :
40759 0 : ae_frame_make(_state, &_frame_block);
40760 0 : memset(&sinfo2, 0, sizeof(sinfo2));
40761 0 : _sinteger_init(&sinfo2, _state, ae_true);
40762 :
40763 0 : if( n<1 )
40764 : {
40765 0 : ae_frame_leave(_state);
40766 0 : return;
40767 : }
40768 0 : tsa = matrixtilesizea(_state);
40769 0 : tsb = matrixtilesizeb(_state);
40770 0 : tscur = tsb;
40771 0 : if( n<=tsb )
40772 : {
40773 0 : tscur = tsa;
40774 : }
40775 :
40776 : /*
40777 : * Base case
40778 : */
40779 0 : if( n<=tsa )
40780 : {
40781 0 : sinfo2.val = 1;
40782 0 : matinv_rmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &sinfo2, _state);
40783 0 : ae_assert(sinfo2.val>0, "SPDMatrixCholeskyInverseRec: integrity check failed", _state);
40784 0 : if( isupper )
40785 : {
40786 :
40787 : /*
40788 : * Compute the product U * U'.
40789 : * NOTE: we never assume that diagonal of U is real
40790 : */
40791 0 : for(i=0; i<=n-1; i++)
40792 : {
40793 0 : if( i==0 )
40794 : {
40795 :
40796 : /*
40797 : * 1x1 matrix
40798 : */
40799 0 : a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state);
40800 : }
40801 : else
40802 : {
40803 :
40804 : /*
40805 : * (I+1)x(I+1) matrix,
40806 : *
40807 : * ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H )
40808 : * ( ) * ( ) = ( )
40809 : * ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H )
40810 : *
40811 : * A11 is IxI, A22 is 1x1.
40812 : */
40813 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(0,i-1));
40814 0 : for(j=0; j<=i-1; j++)
40815 : {
40816 0 : v = a->ptr.pp_double[offs+j][offs+i];
40817 0 : ae_v_addd(&a->ptr.pp_double[offs+j][offs+j], 1, &tmp->ptr.p_double[j], 1, ae_v_len(offs+j,offs+i-1), v);
40818 : }
40819 0 : v = a->ptr.pp_double[offs+i][offs+i];
40820 0 : ae_v_muld(&a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v);
40821 0 : a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state);
40822 : }
40823 : }
40824 : }
40825 : else
40826 : {
40827 :
40828 : /*
40829 : * Compute the product L' * L
40830 : * NOTE: we never assume that diagonal of L is real
40831 : */
40832 0 : for(i=0; i<=n-1; i++)
40833 : {
40834 0 : if( i==0 )
40835 : {
40836 :
40837 : /*
40838 : * 1x1 matrix
40839 : */
40840 0 : a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state);
40841 : }
40842 : else
40843 : {
40844 :
40845 : /*
40846 : * (I+1)x(I+1) matrix,
40847 : *
40848 : * ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 )
40849 : * ( ) * ( ) = ( )
40850 : * ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 )
40851 : *
40852 : * A11 is IxI, A22 is 1x1.
40853 : */
40854 0 : ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs], 1, ae_v_len(0,i-1));
40855 0 : for(j=0; j<=i-1; j++)
40856 : {
40857 0 : v = a->ptr.pp_double[offs+i][offs+j];
40858 0 : ae_v_addd(&a->ptr.pp_double[offs+j][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+j), v);
40859 : }
40860 0 : v = a->ptr.pp_double[offs+i][offs+i];
40861 0 : ae_v_muld(&a->ptr.pp_double[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v);
40862 0 : a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state);
40863 : }
40864 : }
40865 : }
40866 0 : ae_frame_leave(_state);
40867 0 : return;
40868 : }
40869 :
40870 : /*
40871 : * Recursive code: triangular factor inversion merged with
40872 : * UU' or L'L multiplication
40873 : */
40874 0 : tiledsplit(n, tscur, &n1, &n2, _state);
40875 :
40876 : /*
40877 : * form off-diagonal block of trangular inverse
40878 : */
40879 0 : if( isupper )
40880 : {
40881 0 : for(i=0; i<=n1-1; i++)
40882 : {
40883 0 : ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
40884 : }
40885 0 : rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state);
40886 0 : rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state);
40887 : }
40888 : else
40889 : {
40890 0 : for(i=0; i<=n2-1; i++)
40891 : {
40892 0 : ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
40893 : }
40894 0 : rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state);
40895 0 : rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state);
40896 : }
40897 :
40898 : /*
40899 : * invert first diagonal block
40900 : */
40901 0 : spdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state);
40902 :
40903 : /*
40904 : * update first diagonal block with off-diagonal block,
40905 : * update off-diagonal block
40906 : */
40907 0 : if( isupper )
40908 : {
40909 0 : rmatrixsyrk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state);
40910 0 : rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs, offs+n1, _state);
40911 : }
40912 : else
40913 : {
40914 0 : rmatrixsyrk(n1, n2, 1.0, a, offs+n1, offs, 1, 1.0, a, offs, offs, isupper, _state);
40915 0 : rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs+n1, offs, _state);
40916 : }
40917 :
40918 : /*
40919 : * invert second diagonal block
40920 : */
40921 0 : spdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state);
40922 0 : ae_frame_leave(_state);
40923 : }
40924 :
40925 :
40926 : /*************************************************************************
40927 : Serial stub for GPL edition.
40928 : *************************************************************************/
40929 0 : ae_bool _trypexec_spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a,
40930 : ae_int_t offs,
40931 : ae_int_t n,
40932 : ae_bool isupper,
40933 : /* Real */ ae_vector* tmp,
40934 : ae_state *_state)
40935 : {
40936 0 : return ae_false;
40937 : }
40938 :
40939 :
40940 : /*************************************************************************
40941 : Triangular matrix inversion, recursive subroutine
40942 :
40943 : NOTE: this function sets Info on failure, leaves it unchanged on success.
40944 :
40945 : NOTE: only Tmp[Offs:Offs+N-1] is modified, other entries of the temporary array are not modified
40946 :
40947 : -- ALGLIB --
40948 : 05.02.2010, Bochkanov Sergey.
40949 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
40950 : Courant Institute, Argonne National Lab, and Rice University
40951 : February 29, 1992.
40952 : *************************************************************************/
40953 0 : static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a,
40954 : ae_int_t offs,
40955 : ae_int_t n,
40956 : ae_bool isupper,
40957 : ae_bool isunit,
40958 : /* Real */ ae_vector* tmp,
40959 : sinteger* info,
40960 : ae_state *_state)
40961 : {
40962 : ae_int_t n1;
40963 : ae_int_t n2;
40964 : ae_int_t mn;
40965 : ae_int_t i;
40966 : ae_int_t j;
40967 : double v;
40968 : double ajj;
40969 : ae_int_t tsa;
40970 : ae_int_t tsb;
40971 : ae_int_t tscur;
40972 :
40973 :
40974 0 : if( n<1 )
40975 : {
40976 0 : info->val = -1;
40977 0 : return;
40978 : }
40979 0 : tsa = matrixtilesizea(_state);
40980 0 : tsb = matrixtilesizeb(_state);
40981 0 : tscur = tsb;
40982 0 : if( n<=tsb )
40983 : {
40984 0 : tscur = tsa;
40985 : }
40986 :
40987 : /*
40988 : * Try to activate parallelism
40989 : */
40990 0 : if( n>=2*tsb&&ae_fp_greater_eq(rmul3((double)(n), (double)(n), (double)(n), _state)*((double)1/(double)3),smpactivationlevel(_state)) )
40991 : {
40992 0 : if( _trypexec_matinv_rmatrixtrinverserec(a,offs,n,isupper,isunit,tmp,info, _state) )
40993 : {
40994 0 : return;
40995 : }
40996 : }
40997 :
40998 : /*
40999 : * Base case
41000 : */
41001 0 : if( n<=tsa )
41002 : {
41003 0 : if( isupper )
41004 : {
41005 :
41006 : /*
41007 : * Compute inverse of upper triangular matrix.
41008 : */
41009 0 : for(j=0; j<=n-1; j++)
41010 : {
41011 0 : if( !isunit )
41012 : {
41013 0 : if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],(double)(0)) )
41014 : {
41015 0 : info->val = -3;
41016 0 : return;
41017 : }
41018 0 : a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j];
41019 0 : ajj = -a->ptr.pp_double[offs+j][offs+j];
41020 : }
41021 : else
41022 : {
41023 0 : ajj = (double)(-1);
41024 : }
41025 :
41026 : /*
41027 : * Compute elements 1:j-1 of j-th column.
41028 : */
41029 0 : if( j>0 )
41030 : {
41031 0 : ae_v_move(&tmp->ptr.p_double[offs+0], 1, &a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1));
41032 0 : for(i=0; i<=j-1; i++)
41033 : {
41034 0 : if( i<j-1 )
41035 : {
41036 0 : v = ae_v_dotproduct(&a->ptr.pp_double[offs+i][offs+i+1], 1, &tmp->ptr.p_double[offs+i+1], 1, ae_v_len(offs+i+1,offs+j-1));
41037 : }
41038 : else
41039 : {
41040 0 : v = (double)(0);
41041 : }
41042 0 : if( !isunit )
41043 : {
41044 0 : a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[offs+i];
41045 : }
41046 : else
41047 : {
41048 0 : a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[offs+i];
41049 : }
41050 : }
41051 0 : ae_v_muld(&a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj);
41052 : }
41053 : }
41054 : }
41055 : else
41056 : {
41057 :
41058 : /*
41059 : * Compute inverse of lower triangular matrix.
41060 : */
41061 0 : for(j=n-1; j>=0; j--)
41062 : {
41063 0 : if( !isunit )
41064 : {
41065 0 : if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],(double)(0)) )
41066 : {
41067 0 : info->val = -3;
41068 0 : return;
41069 : }
41070 0 : a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j];
41071 0 : ajj = -a->ptr.pp_double[offs+j][offs+j];
41072 : }
41073 : else
41074 : {
41075 0 : ajj = (double)(-1);
41076 : }
41077 0 : if( j<n-1 )
41078 : {
41079 :
41080 : /*
41081 : * Compute elements j+1:n of j-th column.
41082 : */
41083 0 : ae_v_move(&tmp->ptr.p_double[offs+j+1], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1));
41084 0 : for(i=j+1; i<=n-1; i++)
41085 : {
41086 0 : if( i>j+1 )
41087 : {
41088 0 : v = ae_v_dotproduct(&a->ptr.pp_double[offs+i][offs+j+1], 1, &tmp->ptr.p_double[offs+j+1], 1, ae_v_len(offs+j+1,offs+i-1));
41089 : }
41090 : else
41091 : {
41092 0 : v = (double)(0);
41093 : }
41094 0 : if( !isunit )
41095 : {
41096 0 : a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[offs+i];
41097 : }
41098 : else
41099 : {
41100 0 : a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[offs+i];
41101 : }
41102 : }
41103 0 : ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj);
41104 : }
41105 : }
41106 : }
41107 0 : return;
41108 : }
41109 :
41110 : /*
41111 : * Recursive case
41112 : */
41113 0 : tiledsplit(n, tscur, &n1, &n2, _state);
41114 0 : mn = imin2(n1, n2, _state);
41115 0 : touchint(&mn, _state);
41116 0 : if( n2>0 )
41117 : {
41118 0 : if( isupper )
41119 : {
41120 0 : for(i=0; i<=n1-1; i++)
41121 : {
41122 0 : ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
41123 : }
41124 0 : rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state);
41125 0 : matinv_rmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, _state);
41126 0 : rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state);
41127 : }
41128 : else
41129 : {
41130 0 : for(i=0; i<=n2-1; i++)
41131 : {
41132 0 : ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
41133 : }
41134 0 : rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state);
41135 0 : matinv_rmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, _state);
41136 0 : rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state);
41137 : }
41138 : }
41139 0 : matinv_rmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, _state);
41140 : }
41141 :
41142 :
41143 : /*************************************************************************
41144 : Serial stub for GPL edition.
41145 : *************************************************************************/
41146 0 : ae_bool _trypexec_matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a,
41147 : ae_int_t offs,
41148 : ae_int_t n,
41149 : ae_bool isupper,
41150 : ae_bool isunit,
41151 : /* Real */ ae_vector* tmp,
41152 : sinteger* info,
41153 : ae_state *_state)
41154 : {
41155 0 : return ae_false;
41156 : }
41157 :
41158 :
41159 : /*************************************************************************
41160 : Triangular matrix inversion, recursive subroutine.
41161 :
41162 : Info is modified on failure, left unchanged on success.
41163 :
41164 : -- ALGLIB --
41165 : 05.02.2010, Bochkanov Sergey.
41166 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
41167 : Courant Institute, Argonne National Lab, and Rice University
41168 : February 29, 1992.
41169 : *************************************************************************/
41170 0 : static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a,
41171 : ae_int_t offs,
41172 : ae_int_t n,
41173 : ae_bool isupper,
41174 : ae_bool isunit,
41175 : /* Complex */ ae_vector* tmp,
41176 : sinteger* info,
41177 : ae_state *_state)
41178 : {
41179 : ae_int_t n1;
41180 : ae_int_t n2;
41181 : ae_int_t i;
41182 : ae_int_t j;
41183 : ae_complex v;
41184 : ae_complex ajj;
41185 : ae_int_t tsa;
41186 : ae_int_t tsb;
41187 : ae_int_t tscur;
41188 : ae_int_t mn;
41189 :
41190 :
41191 0 : if( n<1 )
41192 : {
41193 0 : info->val = -1;
41194 0 : return;
41195 : }
41196 0 : tsa = matrixtilesizea(_state)/2;
41197 0 : tsb = matrixtilesizeb(_state);
41198 0 : tscur = tsb;
41199 0 : if( n<=tsb )
41200 : {
41201 0 : tscur = tsa;
41202 : }
41203 :
41204 : /*
41205 : * Try to activate parallelism
41206 : */
41207 0 : if( n>=2*tsb&&ae_fp_greater_eq(rmul3((double)(n), (double)(n), (double)(n), _state)*((double)4/(double)3),smpactivationlevel(_state)) )
41208 : {
41209 0 : if( _trypexec_matinv_cmatrixtrinverserec(a,offs,n,isupper,isunit,tmp,info, _state) )
41210 : {
41211 0 : return;
41212 : }
41213 : }
41214 :
41215 : /*
41216 : * Base case
41217 : */
41218 0 : if( n<=tsa )
41219 : {
41220 0 : if( isupper )
41221 : {
41222 :
41223 : /*
41224 : * Compute inverse of upper triangular matrix.
41225 : */
41226 0 : for(j=0; j<=n-1; j++)
41227 : {
41228 0 : if( !isunit )
41229 : {
41230 0 : if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],(double)(0)) )
41231 : {
41232 0 : info->val = -3;
41233 0 : return;
41234 : }
41235 0 : a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]);
41236 0 : ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]);
41237 : }
41238 : else
41239 : {
41240 0 : ajj = ae_complex_from_i(-1);
41241 : }
41242 :
41243 : /*
41244 : * Compute elements 1:j-1 of j-th column.
41245 : */
41246 0 : if( j>0 )
41247 : {
41248 0 : ae_v_cmove(&tmp->ptr.p_complex[offs+0], 1, &a->ptr.pp_complex[offs+0][offs+j], a->stride, "N", ae_v_len(offs+0,offs+j-1));
41249 0 : for(i=0; i<=j-1; i++)
41250 : {
41251 0 : if( i<j-1 )
41252 : {
41253 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[offs+i][offs+i+1], 1, "N", &tmp->ptr.p_complex[offs+i+1], 1, "N", ae_v_len(offs+i+1,offs+j-1));
41254 : }
41255 : else
41256 : {
41257 0 : v = ae_complex_from_i(0);
41258 : }
41259 0 : if( !isunit )
41260 : {
41261 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[offs+i]));
41262 : }
41263 : else
41264 : {
41265 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[offs+i]);
41266 : }
41267 : }
41268 0 : ae_v_cmulc(&a->ptr.pp_complex[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj);
41269 : }
41270 : }
41271 : }
41272 : else
41273 : {
41274 :
41275 : /*
41276 : * Compute inverse of lower triangular matrix.
41277 : */
41278 0 : for(j=n-1; j>=0; j--)
41279 : {
41280 0 : if( !isunit )
41281 : {
41282 0 : if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],(double)(0)) )
41283 : {
41284 0 : info->val = -3;
41285 0 : return;
41286 : }
41287 0 : a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]);
41288 0 : ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]);
41289 : }
41290 : else
41291 : {
41292 0 : ajj = ae_complex_from_i(-1);
41293 : }
41294 0 : if( j<n-1 )
41295 : {
41296 :
41297 : /*
41298 : * Compute elements j+1:n of j-th column.
41299 : */
41300 0 : ae_v_cmove(&tmp->ptr.p_complex[offs+j+1], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(offs+j+1,offs+n-1));
41301 0 : for(i=j+1; i<=n-1; i++)
41302 : {
41303 0 : if( i>j+1 )
41304 : {
41305 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[offs+i][offs+j+1], 1, "N", &tmp->ptr.p_complex[offs+j+1], 1, "N", ae_v_len(offs+j+1,offs+i-1));
41306 : }
41307 : else
41308 : {
41309 0 : v = ae_complex_from_i(0);
41310 : }
41311 0 : if( !isunit )
41312 : {
41313 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[offs+i]));
41314 : }
41315 : else
41316 : {
41317 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[offs+i]);
41318 : }
41319 : }
41320 0 : ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj);
41321 : }
41322 : }
41323 : }
41324 0 : return;
41325 : }
41326 :
41327 : /*
41328 : * Recursive case
41329 : */
41330 0 : tiledsplit(n, tscur, &n1, &n2, _state);
41331 0 : mn = imin2(n1, n2, _state);
41332 0 : touchint(&mn, _state);
41333 0 : if( n2>0 )
41334 : {
41335 0 : if( isupper )
41336 : {
41337 0 : for(i=0; i<=n1-1; i++)
41338 : {
41339 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
41340 : }
41341 0 : cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state);
41342 0 : matinv_cmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, _state);
41343 0 : cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state);
41344 : }
41345 : else
41346 : {
41347 0 : for(i=0; i<=n2-1; i++)
41348 : {
41349 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
41350 : }
41351 0 : cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state);
41352 0 : matinv_cmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, _state);
41353 0 : cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state);
41354 : }
41355 : }
41356 0 : matinv_cmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, _state);
41357 : }
41358 :
41359 :
41360 : /*************************************************************************
41361 : Serial stub for GPL edition.
41362 : *************************************************************************/
41363 0 : ae_bool _trypexec_matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a,
41364 : ae_int_t offs,
41365 : ae_int_t n,
41366 : ae_bool isupper,
41367 : ae_bool isunit,
41368 : /* Complex */ ae_vector* tmp,
41369 : sinteger* info,
41370 : ae_state *_state)
41371 : {
41372 0 : return ae_false;
41373 : }
41374 :
41375 :
41376 0 : static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a,
41377 : ae_int_t offs,
41378 : ae_int_t n,
41379 : /* Real */ ae_vector* work,
41380 : sinteger* info,
41381 : matinvreport* rep,
41382 : ae_state *_state)
41383 : {
41384 : ae_int_t i;
41385 : ae_int_t j;
41386 : double v;
41387 : ae_int_t n1;
41388 : ae_int_t n2;
41389 : ae_int_t tsa;
41390 : ae_int_t tsb;
41391 : ae_int_t tscur;
41392 : ae_int_t mn;
41393 :
41394 :
41395 0 : if( n<1 )
41396 : {
41397 0 : info->val = -1;
41398 0 : return;
41399 : }
41400 0 : tsa = matrixtilesizea(_state);
41401 0 : tsb = matrixtilesizeb(_state);
41402 0 : tscur = tsb;
41403 0 : if( n<=tsb )
41404 : {
41405 0 : tscur = tsa;
41406 : }
41407 :
41408 : /*
41409 : * Try parallelism
41410 : */
41411 0 : if( n>=2*tsb&&ae_fp_greater_eq((double)8/(double)6*rmul3((double)(n), (double)(n), (double)(n), _state),smpactivationlevel(_state)) )
41412 : {
41413 0 : if( _trypexec_matinv_rmatrixluinverserec(a,offs,n,work,info,rep, _state) )
41414 : {
41415 0 : return;
41416 : }
41417 : }
41418 :
41419 : /*
41420 : * Base case
41421 : */
41422 0 : if( n<=tsa )
41423 : {
41424 :
41425 : /*
41426 : * Form inv(U)
41427 : */
41428 0 : matinv_rmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, info, _state);
41429 0 : if( info->val<=0 )
41430 : {
41431 0 : return;
41432 : }
41433 :
41434 : /*
41435 : * Solve the equation inv(A)*L = inv(U) for inv(A).
41436 : */
41437 0 : for(j=n-1; j>=0; j--)
41438 : {
41439 :
41440 : /*
41441 : * Copy current column of L to WORK and replace with zeros.
41442 : */
41443 0 : for(i=j+1; i<=n-1; i++)
41444 : {
41445 0 : work->ptr.p_double[i] = a->ptr.pp_double[offs+i][offs+j];
41446 0 : a->ptr.pp_double[offs+i][offs+j] = (double)(0);
41447 : }
41448 :
41449 : /*
41450 : * Compute current column of inv(A).
41451 : */
41452 0 : if( j<n-1 )
41453 : {
41454 0 : for(i=0; i<=n-1; i++)
41455 : {
41456 0 : v = ae_v_dotproduct(&a->ptr.pp_double[offs+i][offs+j+1], 1, &work->ptr.p_double[j+1], 1, ae_v_len(offs+j+1,offs+n-1));
41457 0 : a->ptr.pp_double[offs+i][offs+j] = a->ptr.pp_double[offs+i][offs+j]-v;
41458 : }
41459 : }
41460 : }
41461 0 : return;
41462 : }
41463 :
41464 : /*
41465 : * Recursive code:
41466 : *
41467 : * ( L1 ) ( U1 U12 )
41468 : * A = ( ) * ( )
41469 : * ( L12 L2 ) ( U2 )
41470 : *
41471 : * ( W X )
41472 : * A^-1 = ( )
41473 : * ( Y Z )
41474 : *
41475 : * In-place calculation can be done as follows:
41476 : * * X := inv(U1)*U12*inv(U2)
41477 : * * Y := inv(L2)*L12*inv(L1)
41478 : * * W := inv(L1*U1)+X*Y
41479 : * * X := -X*inv(L2)
41480 : * * Y := -inv(U2)*Y
41481 : * * Z := inv(L2*U2)
41482 : *
41483 : * Reordering w.r.t. interdependencies gives us:
41484 : *
41485 : * * X := inv(U1)*U12 \ suitable for parallel execution
41486 : * * Y := L12*inv(L1) /
41487 : *
41488 : * * X := X*inv(U2) \
41489 : * * Y := inv(L2)*Y | suitable for parallel execution
41490 : * * W := inv(L1*U1) /
41491 : *
41492 : * * W := W+X*Y
41493 : *
41494 : * * X := -X*inv(L2) \ suitable for parallel execution
41495 : * * Y := -inv(U2)*Y /
41496 : *
41497 : * * Z := inv(L2*U2)
41498 : */
41499 0 : tiledsplit(n, tscur, &n1, &n2, _state);
41500 0 : mn = imin2(n1, n2, _state);
41501 0 : touchint(&mn, _state);
41502 0 : ae_assert(n2>0, "LUInverseRec: internal error!", _state);
41503 :
41504 : /*
41505 : * X := inv(U1)*U12
41506 : * Y := L12*inv(L1)
41507 : */
41508 0 : rmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state);
41509 0 : rmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state);
41510 :
41511 : /*
41512 : * X := X*inv(U2)
41513 : * Y := inv(L2)*Y
41514 : * W := inv(L1*U1)
41515 : */
41516 0 : rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state);
41517 0 : rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state);
41518 0 : matinv_rmatrixluinverserec(a, offs, n1, work, info, rep, _state);
41519 0 : if( info->val<=0 )
41520 : {
41521 0 : return;
41522 : }
41523 :
41524 : /*
41525 : * W := W+X*Y
41526 : */
41527 0 : rmatrixgemm(n1, n1, n2, 1.0, a, offs, offs+n1, 0, a, offs+n1, offs, 0, 1.0, a, offs, offs, _state);
41528 :
41529 : /*
41530 : * X := -X*inv(L2)
41531 : * Y := -inv(U2)*Y
41532 : */
41533 0 : rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state);
41534 0 : rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state);
41535 0 : for(i=0; i<=n1-1; i++)
41536 : {
41537 0 : ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
41538 : }
41539 0 : for(i=0; i<=n2-1; i++)
41540 : {
41541 0 : ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
41542 : }
41543 :
41544 : /*
41545 : * Z := inv(L2*U2)
41546 : */
41547 0 : matinv_rmatrixluinverserec(a, offs+n1, n2, work, info, rep, _state);
41548 : }
41549 :
41550 :
41551 : /*************************************************************************
41552 : Serial stub for GPL edition.
41553 : *************************************************************************/
41554 0 : ae_bool _trypexec_matinv_rmatrixluinverserec(/* Real */ ae_matrix* a,
41555 : ae_int_t offs,
41556 : ae_int_t n,
41557 : /* Real */ ae_vector* work,
41558 : sinteger* info,
41559 : matinvreport* rep,
41560 : ae_state *_state)
41561 : {
41562 0 : return ae_false;
41563 : }
41564 :
41565 :
41566 0 : static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a,
41567 : ae_int_t offs,
41568 : ae_int_t n,
41569 : /* Complex */ ae_vector* work,
41570 : sinteger* ssinfo,
41571 : matinvreport* rep,
41572 : ae_state *_state)
41573 : {
41574 : ae_int_t i;
41575 : ae_int_t j;
41576 : ae_complex v;
41577 : ae_int_t n1;
41578 : ae_int_t n2;
41579 : ae_int_t mn;
41580 : ae_int_t tsa;
41581 : ae_int_t tsb;
41582 : ae_int_t tscur;
41583 :
41584 :
41585 0 : if( n<1 )
41586 : {
41587 0 : ssinfo->val = -1;
41588 0 : return;
41589 : }
41590 0 : tsa = matrixtilesizea(_state)/2;
41591 0 : tsb = matrixtilesizeb(_state);
41592 0 : tscur = tsb;
41593 0 : if( n<=tsb )
41594 : {
41595 0 : tscur = tsa;
41596 : }
41597 :
41598 : /*
41599 : * Try parallelism
41600 : */
41601 0 : if( n>=2*tsb&&ae_fp_greater_eq((double)32/(double)6*rmul3((double)(n), (double)(n), (double)(n), _state),smpactivationlevel(_state)) )
41602 : {
41603 0 : if( _trypexec_matinv_cmatrixluinverserec(a,offs,n,work,ssinfo,rep, _state) )
41604 : {
41605 0 : return;
41606 : }
41607 : }
41608 :
41609 : /*
41610 : * Base case
41611 : */
41612 0 : if( n<=tsa )
41613 : {
41614 :
41615 : /*
41616 : * Form inv(U)
41617 : */
41618 0 : matinv_cmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, ssinfo, _state);
41619 0 : if( ssinfo->val<=0 )
41620 : {
41621 0 : return;
41622 : }
41623 :
41624 : /*
41625 : * Solve the equation inv(A)*L = inv(U) for inv(A).
41626 : */
41627 0 : for(j=n-1; j>=0; j--)
41628 : {
41629 :
41630 : /*
41631 : * Copy current column of L to WORK and replace with zeros.
41632 : */
41633 0 : for(i=j+1; i<=n-1; i++)
41634 : {
41635 0 : work->ptr.p_complex[i] = a->ptr.pp_complex[offs+i][offs+j];
41636 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_complex_from_i(0);
41637 : }
41638 :
41639 : /*
41640 : * Compute current column of inv(A).
41641 : */
41642 0 : if( j<n-1 )
41643 : {
41644 0 : for(i=0; i<=n-1; i++)
41645 : {
41646 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[offs+i][offs+j+1], 1, "N", &work->ptr.p_complex[j+1], 1, "N", ae_v_len(offs+j+1,offs+n-1));
41647 0 : a->ptr.pp_complex[offs+i][offs+j] = ae_c_sub(a->ptr.pp_complex[offs+i][offs+j],v);
41648 : }
41649 : }
41650 : }
41651 0 : return;
41652 : }
41653 :
41654 : /*
41655 : * Recursive code:
41656 : *
41657 : * ( L1 ) ( U1 U12 )
41658 : * A = ( ) * ( )
41659 : * ( L12 L2 ) ( U2 )
41660 : *
41661 : * ( W X )
41662 : * A^-1 = ( )
41663 : * ( Y Z )
41664 : *
41665 : * In-place calculation can be done as follows:
41666 : * * X := inv(U1)*U12*inv(U2)
41667 : * * Y := inv(L2)*L12*inv(L1)
41668 : * * W := inv(L1*U1)+X*Y
41669 : * * X := -X*inv(L2)
41670 : * * Y := -inv(U2)*Y
41671 : * * Z := inv(L2*U2)
41672 : *
41673 : * Reordering w.r.t. interdependencies gives us:
41674 : *
41675 : * * X := inv(U1)*U12 \ suitable for parallel execution
41676 : * * Y := L12*inv(L1) /
41677 : *
41678 : * * X := X*inv(U2) \
41679 : * * Y := inv(L2)*Y | suitable for parallel execution
41680 : * * W := inv(L1*U1) /
41681 : *
41682 : * * W := W+X*Y
41683 : *
41684 : * * X := -X*inv(L2) \ suitable for parallel execution
41685 : * * Y := -inv(U2)*Y /
41686 : *
41687 : * * Z := inv(L2*U2)
41688 : */
41689 0 : tiledsplit(n, tscur, &n1, &n2, _state);
41690 0 : mn = imin2(n1, n2, _state);
41691 0 : touchint(&mn, _state);
41692 0 : ae_assert(n2>0, "LUInverseRec: internal error!", _state);
41693 :
41694 : /*
41695 : * X := inv(U1)*U12
41696 : * Y := L12*inv(L1)
41697 : */
41698 0 : cmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state);
41699 0 : cmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state);
41700 :
41701 : /*
41702 : * X := X*inv(U2)
41703 : * Y := inv(L2)*Y
41704 : * W := inv(L1*U1)
41705 : */
41706 0 : cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state);
41707 0 : cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state);
41708 0 : matinv_cmatrixluinverserec(a, offs, n1, work, ssinfo, rep, _state);
41709 0 : if( ssinfo->val<=0 )
41710 : {
41711 0 : return;
41712 : }
41713 :
41714 : /*
41715 : * W := W+X*Y
41716 : */
41717 0 : cmatrixgemm(n1, n1, n2, ae_complex_from_d(1.0), a, offs, offs+n1, 0, a, offs+n1, offs, 0, ae_complex_from_d(1.0), a, offs, offs, _state);
41718 :
41719 : /*
41720 : * X := -X*inv(L2)
41721 : * Y := -inv(U2)*Y
41722 : */
41723 0 : cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state);
41724 0 : cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state);
41725 0 : for(i=0; i<=n1-1; i++)
41726 : {
41727 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
41728 : }
41729 0 : for(i=0; i<=n2-1; i++)
41730 : {
41731 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
41732 : }
41733 :
41734 : /*
41735 : * Z := inv(L2*U2)
41736 : */
41737 0 : matinv_cmatrixluinverserec(a, offs+n1, n2, work, ssinfo, rep, _state);
41738 : }
41739 :
41740 :
41741 : /*************************************************************************
41742 : Serial stub for GPL edition.
41743 : *************************************************************************/
41744 0 : ae_bool _trypexec_matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a,
41745 : ae_int_t offs,
41746 : ae_int_t n,
41747 : /* Complex */ ae_vector* work,
41748 : sinteger* ssinfo,
41749 : matinvreport* rep,
41750 : ae_state *_state)
41751 : {
41752 0 : return ae_false;
41753 : }
41754 :
41755 :
41756 : /*************************************************************************
41757 : Recursive subroutine for HPD inversion.
41758 :
41759 : -- ALGLIB routine --
41760 : 10.02.2010
41761 : Bochkanov Sergey
41762 : *************************************************************************/
41763 0 : static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a,
41764 : ae_int_t offs,
41765 : ae_int_t n,
41766 : ae_bool isupper,
41767 : /* Complex */ ae_vector* tmp,
41768 : ae_state *_state)
41769 : {
41770 : ae_frame _frame_block;
41771 : ae_int_t i;
41772 : ae_int_t j;
41773 : ae_complex v;
41774 : ae_int_t n1;
41775 : ae_int_t n2;
41776 : sinteger sinfo;
41777 : ae_int_t tsa;
41778 : ae_int_t tsb;
41779 : ae_int_t tscur;
41780 :
41781 0 : ae_frame_make(_state, &_frame_block);
41782 0 : memset(&sinfo, 0, sizeof(sinfo));
41783 0 : _sinteger_init(&sinfo, _state, ae_true);
41784 :
41785 0 : if( n<1 )
41786 : {
41787 0 : ae_frame_leave(_state);
41788 0 : return;
41789 : }
41790 0 : tsa = matrixtilesizea(_state)/2;
41791 0 : tsb = matrixtilesizeb(_state);
41792 0 : tscur = tsb;
41793 0 : if( n<=tsb )
41794 : {
41795 0 : tscur = tsa;
41796 : }
41797 :
41798 : /*
41799 : * Base case
41800 : */
41801 0 : if( n<=tsa )
41802 : {
41803 0 : sinfo.val = 1;
41804 0 : matinv_cmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &sinfo, _state);
41805 0 : ae_assert(sinfo.val>0, "HPDMatrixCholeskyInverseRec: integrity check failed", _state);
41806 0 : if( isupper )
41807 : {
41808 :
41809 : /*
41810 : * Compute the product U * U'.
41811 : * NOTE: we never assume that diagonal of U is real
41812 : */
41813 0 : for(i=0; i<=n-1; i++)
41814 : {
41815 0 : if( i==0 )
41816 : {
41817 :
41818 : /*
41819 : * 1x1 matrix
41820 : */
41821 0 : a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state));
41822 : }
41823 : else
41824 : {
41825 :
41826 : /*
41827 : * (I+1)x(I+1) matrix,
41828 : *
41829 : * ( A11 A12 ) ( A11^H ) ( A11*A11^H+A12*A12^H A12*A22^H )
41830 : * ( ) * ( ) = ( )
41831 : * ( A22 ) ( A12^H A22^H ) ( A22*A12^H A22*A22^H )
41832 : *
41833 : * A11 is IxI, A22 is 1x1.
41834 : */
41835 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+i], a->stride, "Conj", ae_v_len(0,i-1));
41836 0 : for(j=0; j<=i-1; j++)
41837 : {
41838 0 : v = a->ptr.pp_complex[offs+j][offs+i];
41839 0 : ae_v_caddc(&a->ptr.pp_complex[offs+j][offs+j], 1, &tmp->ptr.p_complex[j], 1, "N", ae_v_len(offs+j,offs+i-1), v);
41840 : }
41841 0 : v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state);
41842 0 : ae_v_cmulc(&a->ptr.pp_complex[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v);
41843 0 : a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state));
41844 : }
41845 : }
41846 : }
41847 : else
41848 : {
41849 :
41850 : /*
41851 : * Compute the product L' * L
41852 : * NOTE: we never assume that diagonal of L is real
41853 : */
41854 0 : for(i=0; i<=n-1; i++)
41855 : {
41856 0 : if( i==0 )
41857 : {
41858 :
41859 : /*
41860 : * 1x1 matrix
41861 : */
41862 0 : a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state));
41863 : }
41864 : else
41865 : {
41866 :
41867 : /*
41868 : * (I+1)x(I+1) matrix,
41869 : *
41870 : * ( A11^H A21^H ) ( A11 ) ( A11^H*A11+A21^H*A21 A21^H*A22 )
41871 : * ( ) * ( ) = ( )
41872 : * ( A22^H ) ( A21 A22 ) ( A22^H*A21 A22^H*A22 )
41873 : *
41874 : * A11 is IxI, A22 is 1x1.
41875 : */
41876 0 : ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs], 1, "N", ae_v_len(0,i-1));
41877 0 : for(j=0; j<=i-1; j++)
41878 : {
41879 0 : v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+j], _state);
41880 0 : ae_v_caddc(&a->ptr.pp_complex[offs+j][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+j), v);
41881 : }
41882 0 : v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state);
41883 0 : ae_v_cmulc(&a->ptr.pp_complex[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v);
41884 0 : a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state));
41885 : }
41886 : }
41887 : }
41888 0 : ae_frame_leave(_state);
41889 0 : return;
41890 : }
41891 :
41892 : /*
41893 : * Recursive code: triangular factor inversion merged with
41894 : * UU' or L'L multiplication
41895 : */
41896 0 : tiledsplit(n, tscur, &n1, &n2, _state);
41897 :
41898 : /*
41899 : * form off-diagonal block of trangular inverse
41900 : */
41901 0 : if( isupper )
41902 : {
41903 0 : for(i=0; i<=n1-1; i++)
41904 : {
41905 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1);
41906 : }
41907 0 : cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state);
41908 0 : cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state);
41909 : }
41910 : else
41911 : {
41912 0 : for(i=0; i<=n2-1; i++)
41913 : {
41914 0 : ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1);
41915 : }
41916 0 : cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state);
41917 0 : cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state);
41918 : }
41919 :
41920 : /*
41921 : * invert first diagonal block
41922 : */
41923 0 : matinv_hpdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state);
41924 :
41925 : /*
41926 : * update first diagonal block with off-diagonal block,
41927 : * update off-diagonal block
41928 : */
41929 0 : if( isupper )
41930 : {
41931 0 : cmatrixherk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state);
41932 0 : cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs, offs+n1, _state);
41933 : }
41934 : else
41935 : {
41936 0 : cmatrixherk(n1, n2, 1.0, a, offs+n1, offs, 2, 1.0, a, offs, offs, isupper, _state);
41937 0 : cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs+n1, offs, _state);
41938 : }
41939 :
41940 : /*
41941 : * invert second diagonal block
41942 : */
41943 0 : matinv_hpdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state);
41944 0 : ae_frame_leave(_state);
41945 : }
41946 :
41947 :
41948 0 : void _matinvreport_init(void* _p, ae_state *_state, ae_bool make_automatic)
41949 : {
41950 0 : matinvreport *p = (matinvreport*)_p;
41951 0 : ae_touch_ptr((void*)p);
41952 0 : }
41953 :
41954 :
41955 0 : void _matinvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
41956 : {
41957 0 : matinvreport *dst = (matinvreport*)_dst;
41958 0 : matinvreport *src = (matinvreport*)_src;
41959 0 : dst->r1 = src->r1;
41960 0 : dst->rinf = src->rinf;
41961 0 : }
41962 :
41963 :
41964 0 : void _matinvreport_clear(void* _p)
41965 : {
41966 0 : matinvreport *p = (matinvreport*)_p;
41967 0 : ae_touch_ptr((void*)p);
41968 0 : }
41969 :
41970 :
41971 0 : void _matinvreport_destroy(void* _p)
41972 : {
41973 0 : matinvreport *p = (matinvreport*)_p;
41974 0 : ae_touch_ptr((void*)p);
41975 0 : }
41976 :
41977 :
41978 : #endif
41979 : #if defined(AE_COMPILE_ORTFAC) || !defined(AE_PARTIAL_BUILD)
41980 :
41981 :
41982 : /*************************************************************************
41983 : QR decomposition of a rectangular matrix of size MxN
41984 :
41985 : ! COMMERCIAL EDITION OF ALGLIB:
41986 : !
41987 : ! Commercial Edition of ALGLIB includes following important improvements
41988 : ! of this function:
41989 : ! * high-performance native backend with same C# interface (C# version)
41990 : ! * multithreading support (C++ and C# versions)
41991 : ! * hardware vendor (Intel) implementations of linear algebra primitives
41992 : ! (C++ and C# versions, x86/x64 platform)
41993 : !
41994 : ! We recommend you to read 'Working with commercial version' section of
41995 : ! ALGLIB Reference Manual in order to find out how to use performance-
41996 : ! related features provided by commercial edition of ALGLIB.
41997 :
41998 : Input parameters:
41999 : A - matrix A whose indexes range within [0..M-1, 0..N-1].
42000 : M - number of rows in matrix A.
42001 : N - number of columns in matrix A.
42002 :
42003 : Output parameters:
42004 : A - matrices Q and R in compact form (see below).
42005 : Tau - array of scalar factors which are used to form
42006 : matrix Q. Array whose index ranges within [0.. Min(M-1,N-1)].
42007 :
42008 : Matrix A is represented as A = QR, where Q is an orthogonal matrix of size
42009 : MxM, R - upper triangular (or upper trapezoid) matrix of size M x N.
42010 :
42011 : The elements of matrix R are located on and above the main diagonal of
42012 : matrix A. The elements which are located in Tau array and below the main
42013 : diagonal of matrix A are used to form matrix Q as follows:
42014 :
42015 : Matrix Q is represented as a product of elementary reflections
42016 :
42017 : Q = H(0)*H(2)*...*H(k-1),
42018 :
42019 : where k = min(m,n), and each H(i) is in the form
42020 :
42021 : H(i) = 1 - tau * v * (v^T)
42022 :
42023 : where tau is a scalar stored in Tau[I]; v - real vector,
42024 : so that v(0:i-1) = 0, v(i) = 1, v(i+1:m-1) stored in A(i+1:m-1,i).
42025 :
42026 : -- ALGLIB routine --
42027 : 17.02.2010
42028 : Bochkanov Sergey
42029 : *************************************************************************/
42030 0 : void rmatrixqr(/* Real */ ae_matrix* a,
42031 : ae_int_t m,
42032 : ae_int_t n,
42033 : /* Real */ ae_vector* tau,
42034 : ae_state *_state)
42035 : {
42036 : ae_frame _frame_block;
42037 : ae_vector work;
42038 : ae_vector t;
42039 : ae_vector taubuf;
42040 : ae_int_t minmn;
42041 : ae_matrix tmpa;
42042 : ae_matrix tmpt;
42043 : ae_matrix tmpr;
42044 : ae_int_t blockstart;
42045 : ae_int_t blocksize;
42046 : ae_int_t rowscount;
42047 : ae_int_t i;
42048 : ae_int_t ts;
42049 :
42050 0 : ae_frame_make(_state, &_frame_block);
42051 0 : memset(&work, 0, sizeof(work));
42052 0 : memset(&t, 0, sizeof(t));
42053 0 : memset(&taubuf, 0, sizeof(taubuf));
42054 0 : memset(&tmpa, 0, sizeof(tmpa));
42055 0 : memset(&tmpt, 0, sizeof(tmpt));
42056 0 : memset(&tmpr, 0, sizeof(tmpr));
42057 0 : ae_vector_clear(tau);
42058 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
42059 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
42060 0 : ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true);
42061 0 : ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true);
42062 0 : ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true);
42063 0 : ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true);
42064 :
42065 0 : if( m<=0||n<=0 )
42066 : {
42067 0 : ae_frame_leave(_state);
42068 0 : return;
42069 : }
42070 0 : minmn = ae_minint(m, n, _state);
42071 0 : ts = matrixtilesizeb(_state);
42072 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
42073 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
42074 0 : ae_vector_set_length(tau, minmn, _state);
42075 0 : ae_vector_set_length(&taubuf, minmn, _state);
42076 0 : ae_matrix_set_length(&tmpa, m, ts, _state);
42077 0 : ae_matrix_set_length(&tmpt, ts, 2*ts, _state);
42078 0 : ae_matrix_set_length(&tmpr, 2*ts, n, _state);
42079 :
42080 : /*
42081 : * Blocked code
42082 : */
42083 0 : blockstart = 0;
42084 0 : while(blockstart!=minmn)
42085 : {
42086 :
42087 : /*
42088 : * Determine block size
42089 : */
42090 0 : blocksize = minmn-blockstart;
42091 0 : if( blocksize>ts )
42092 : {
42093 0 : blocksize = ts;
42094 : }
42095 0 : rowscount = m-blockstart;
42096 :
42097 : /*
42098 : * QR decomposition of submatrix.
42099 : * Matrix is copied to temporary storage to solve
42100 : * some TLB issues arising from non-contiguous memory
42101 : * access pattern.
42102 : */
42103 0 : rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state);
42104 0 : rmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state);
42105 0 : rmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state);
42106 0 : ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1));
42107 :
42108 : /*
42109 : * Update the rest, choose between:
42110 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
42111 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
42112 : * representation for products of Householder transformations',
42113 : * by R. Schreiber and C. Van Loan.
42114 : */
42115 0 : if( blockstart+blocksize<=n-1 )
42116 : {
42117 0 : if( n-blockstart-blocksize>=2*ts||rowscount>=4*ts )
42118 : {
42119 :
42120 : /*
42121 : * Prepare block reflector
42122 : */
42123 0 : ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state);
42124 :
42125 : /*
42126 : * Multiply the rest of A by Q'.
42127 : *
42128 : * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
42129 : * Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA'
42130 : */
42131 0 : rmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, 1.0, &tmpa, 0, 0, 1, a, blockstart, blockstart+blocksize, 0, 0.0, &tmpr, 0, 0, _state);
42132 0 : rmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, 1.0, &tmpt, 0, 0, 1, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state);
42133 0 : rmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, a, blockstart, blockstart+blocksize, _state);
42134 : }
42135 : else
42136 : {
42137 :
42138 : /*
42139 : * Level 2 algorithm
42140 : */
42141 0 : for(i=0; i<=blocksize-1; i++)
42142 : {
42143 0 : ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i));
42144 0 : t.ptr.p_double[1] = (double)(1);
42145 0 : applyreflectionfromtheleft(a, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state);
42146 : }
42147 : }
42148 : }
42149 :
42150 : /*
42151 : * Advance
42152 : */
42153 0 : blockstart = blockstart+blocksize;
42154 : }
42155 0 : ae_frame_leave(_state);
42156 : }
42157 :
42158 :
42159 : /*************************************************************************
42160 : LQ decomposition of a rectangular matrix of size MxN
42161 :
42162 : ! COMMERCIAL EDITION OF ALGLIB:
42163 : !
42164 : ! Commercial Edition of ALGLIB includes following important improvements
42165 : ! of this function:
42166 : ! * high-performance native backend with same C# interface (C# version)
42167 : ! * multithreading support (C++ and C# versions)
42168 : ! * hardware vendor (Intel) implementations of linear algebra primitives
42169 : ! (C++ and C# versions, x86/x64 platform)
42170 : !
42171 : ! We recommend you to read 'Working with commercial version' section of
42172 : ! ALGLIB Reference Manual in order to find out how to use performance-
42173 : ! related features provided by commercial edition of ALGLIB.
42174 :
42175 : Input parameters:
42176 : A - matrix A whose indexes range within [0..M-1, 0..N-1].
42177 : M - number of rows in matrix A.
42178 : N - number of columns in matrix A.
42179 :
42180 : Output parameters:
42181 : A - matrices L and Q in compact form (see below)
42182 : Tau - array of scalar factors which are used to form
42183 : matrix Q. Array whose index ranges within [0..Min(M,N)-1].
42184 :
42185 : Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size
42186 : MxM, L - lower triangular (or lower trapezoid) matrix of size M x N.
42187 :
42188 : The elements of matrix L are located on and below the main diagonal of
42189 : matrix A. The elements which are located in Tau array and above the main
42190 : diagonal of matrix A are used to form matrix Q as follows:
42191 :
42192 : Matrix Q is represented as a product of elementary reflections
42193 :
42194 : Q = H(k-1)*H(k-2)*...*H(1)*H(0),
42195 :
42196 : where k = min(m,n), and each H(i) is of the form
42197 :
42198 : H(i) = 1 - tau * v * (v^T)
42199 :
42200 : where tau is a scalar stored in Tau[I]; v - real vector, so that v(0:i-1)=0,
42201 : v(i) = 1, v(i+1:n-1) stored in A(i,i+1:n-1).
42202 :
42203 : -- ALGLIB routine --
42204 : 17.02.2010
42205 : Bochkanov Sergey
42206 : *************************************************************************/
42207 0 : void rmatrixlq(/* Real */ ae_matrix* a,
42208 : ae_int_t m,
42209 : ae_int_t n,
42210 : /* Real */ ae_vector* tau,
42211 : ae_state *_state)
42212 : {
42213 : ae_frame _frame_block;
42214 : ae_vector work;
42215 : ae_vector t;
42216 : ae_vector taubuf;
42217 : ae_int_t minmn;
42218 : ae_matrix tmpa;
42219 : ae_matrix tmpt;
42220 : ae_matrix tmpr;
42221 : ae_int_t blockstart;
42222 : ae_int_t blocksize;
42223 : ae_int_t columnscount;
42224 : ae_int_t i;
42225 : ae_int_t ts;
42226 :
42227 0 : ae_frame_make(_state, &_frame_block);
42228 0 : memset(&work, 0, sizeof(work));
42229 0 : memset(&t, 0, sizeof(t));
42230 0 : memset(&taubuf, 0, sizeof(taubuf));
42231 0 : memset(&tmpa, 0, sizeof(tmpa));
42232 0 : memset(&tmpt, 0, sizeof(tmpt));
42233 0 : memset(&tmpr, 0, sizeof(tmpr));
42234 0 : ae_vector_clear(tau);
42235 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
42236 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
42237 0 : ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true);
42238 0 : ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true);
42239 0 : ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true);
42240 0 : ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true);
42241 :
42242 0 : if( m<=0||n<=0 )
42243 : {
42244 0 : ae_frame_leave(_state);
42245 0 : return;
42246 : }
42247 0 : minmn = ae_minint(m, n, _state);
42248 0 : ts = matrixtilesizeb(_state);
42249 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
42250 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
42251 0 : ae_vector_set_length(tau, minmn, _state);
42252 0 : ae_vector_set_length(&taubuf, minmn, _state);
42253 0 : ae_matrix_set_length(&tmpa, ts, n, _state);
42254 0 : ae_matrix_set_length(&tmpt, ts, 2*ts, _state);
42255 0 : ae_matrix_set_length(&tmpr, m, 2*ts, _state);
42256 :
42257 : /*
42258 : * Blocked code
42259 : */
42260 0 : blockstart = 0;
42261 0 : while(blockstart!=minmn)
42262 : {
42263 :
42264 : /*
42265 : * Determine block size
42266 : */
42267 0 : blocksize = minmn-blockstart;
42268 0 : if( blocksize>ts )
42269 : {
42270 0 : blocksize = ts;
42271 : }
42272 0 : columnscount = n-blockstart;
42273 :
42274 : /*
42275 : * LQ decomposition of submatrix.
42276 : * Matrix is copied to temporary storage to solve
42277 : * some TLB issues arising from non-contiguous memory
42278 : * access pattern.
42279 : */
42280 0 : rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state);
42281 0 : rmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state);
42282 0 : rmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state);
42283 0 : ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1));
42284 :
42285 : /*
42286 : * Update the rest, choose between:
42287 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
42288 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
42289 : * representation for products of Householder transformations',
42290 : * by R. Schreiber and C. Van Loan.
42291 : */
42292 0 : if( blockstart+blocksize<=m-1 )
42293 : {
42294 0 : if( m-blockstart-blocksize>=2*ts )
42295 : {
42296 :
42297 : /*
42298 : * Prepare block reflector
42299 : */
42300 0 : ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state);
42301 :
42302 : /*
42303 : * Multiply the rest of A by Q.
42304 : *
42305 : * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA
42306 : */
42307 0 : rmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, 1.0, a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state);
42308 0 : rmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, 0.0, &tmpr, 0, blocksize, _state);
42309 0 : rmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, a, blockstart+blocksize, blockstart, _state);
42310 : }
42311 : else
42312 : {
42313 :
42314 : /*
42315 : * Level 2 algorithm
42316 : */
42317 0 : for(i=0; i<=blocksize-1; i++)
42318 : {
42319 0 : ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i));
42320 0 : t.ptr.p_double[1] = (double)(1);
42321 0 : applyreflectionfromtheright(a, taubuf.ptr.p_double[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state);
42322 : }
42323 : }
42324 : }
42325 :
42326 : /*
42327 : * Advance
42328 : */
42329 0 : blockstart = blockstart+blocksize;
42330 : }
42331 0 : ae_frame_leave(_state);
42332 : }
42333 :
42334 :
42335 : /*************************************************************************
42336 : QR decomposition of a rectangular complex matrix of size MxN
42337 :
42338 : ! COMMERCIAL EDITION OF ALGLIB:
42339 : !
42340 : ! Commercial Edition of ALGLIB includes following important improvements
42341 : ! of this function:
42342 : ! * high-performance native backend with same C# interface (C# version)
42343 : ! * multithreading support (C++ and C# versions)
42344 : ! * hardware vendor (Intel) implementations of linear algebra primitives
42345 : ! (C++ and C# versions, x86/x64 platform)
42346 : !
42347 : ! We recommend you to read 'Working with commercial version' section of
42348 : ! ALGLIB Reference Manual in order to find out how to use performance-
42349 : ! related features provided by commercial edition of ALGLIB.
42350 :
42351 : Input parameters:
42352 : A - matrix A whose indexes range within [0..M-1, 0..N-1]
42353 : M - number of rows in matrix A.
42354 : N - number of columns in matrix A.
42355 :
42356 : Output parameters:
42357 : A - matrices Q and R in compact form
42358 : Tau - array of scalar factors which are used to form matrix Q. Array
42359 : whose indexes range within [0.. Min(M,N)-1]
42360 :
42361 : Matrix A is represented as A = QR, where Q is an orthogonal matrix of size
42362 : MxM, R - upper triangular (or upper trapezoid) matrix of size MxN.
42363 :
42364 : -- LAPACK routine (version 3.0) --
42365 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
42366 : Courant Institute, Argonne National Lab, and Rice University
42367 : September 30, 1994
42368 : *************************************************************************/
42369 0 : void cmatrixqr(/* Complex */ ae_matrix* a,
42370 : ae_int_t m,
42371 : ae_int_t n,
42372 : /* Complex */ ae_vector* tau,
42373 : ae_state *_state)
42374 : {
42375 : ae_frame _frame_block;
42376 : ae_vector work;
42377 : ae_vector t;
42378 : ae_vector taubuf;
42379 : ae_int_t minmn;
42380 : ae_matrix tmpa;
42381 : ae_matrix tmpt;
42382 : ae_matrix tmpr;
42383 : ae_int_t blockstart;
42384 : ae_int_t blocksize;
42385 : ae_int_t rowscount;
42386 : ae_int_t i;
42387 : ae_int_t ts;
42388 :
42389 0 : ae_frame_make(_state, &_frame_block);
42390 0 : memset(&work, 0, sizeof(work));
42391 0 : memset(&t, 0, sizeof(t));
42392 0 : memset(&taubuf, 0, sizeof(taubuf));
42393 0 : memset(&tmpa, 0, sizeof(tmpa));
42394 0 : memset(&tmpt, 0, sizeof(tmpt));
42395 0 : memset(&tmpr, 0, sizeof(tmpr));
42396 0 : ae_vector_clear(tau);
42397 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
42398 0 : ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true);
42399 0 : ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true);
42400 0 : ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true);
42401 0 : ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true);
42402 0 : ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true);
42403 :
42404 0 : if( m<=0||n<=0 )
42405 : {
42406 0 : ae_frame_leave(_state);
42407 0 : return;
42408 : }
42409 0 : ts = matrixtilesizeb(_state)/2;
42410 0 : minmn = ae_minint(m, n, _state);
42411 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
42412 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
42413 0 : ae_vector_set_length(tau, minmn, _state);
42414 0 : ae_vector_set_length(&taubuf, minmn, _state);
42415 0 : ae_matrix_set_length(&tmpa, m, ts, _state);
42416 0 : ae_matrix_set_length(&tmpt, ts, ts, _state);
42417 0 : ae_matrix_set_length(&tmpr, 2*ts, n, _state);
42418 :
42419 : /*
42420 : * Blocked code
42421 : */
42422 0 : blockstart = 0;
42423 0 : while(blockstart!=minmn)
42424 : {
42425 :
42426 : /*
42427 : * Determine block size
42428 : */
42429 0 : blocksize = minmn-blockstart;
42430 0 : if( blocksize>ts )
42431 : {
42432 0 : blocksize = ts;
42433 : }
42434 0 : rowscount = m-blockstart;
42435 :
42436 : /*
42437 : * QR decomposition of submatrix.
42438 : * Matrix is copied to temporary storage to solve
42439 : * some TLB issues arising from non-contiguous memory
42440 : * access pattern.
42441 : */
42442 0 : cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state);
42443 0 : ortfac_cmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state);
42444 0 : cmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state);
42445 0 : ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1));
42446 :
42447 : /*
42448 : * Update the rest, choose between:
42449 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
42450 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
42451 : * representation for products of Householder transformations',
42452 : * by R. Schreiber and C. Van Loan.
42453 : */
42454 0 : if( blockstart+blocksize<=n-1 )
42455 : {
42456 0 : if( n-blockstart-blocksize>=2*ts )
42457 : {
42458 :
42459 : /*
42460 : * Prepare block reflector
42461 : */
42462 0 : ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state);
42463 :
42464 : /*
42465 : * Multiply the rest of A by Q'.
42466 : *
42467 : * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
42468 : * Q' = E + Y*T'*Y' = E + TmpA*TmpT'*TmpA'
42469 : */
42470 0 : cmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, a, blockstart, blockstart+blocksize, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state);
42471 0 : cmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 2, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state);
42472 0 : cmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), a, blockstart, blockstart+blocksize, _state);
42473 : }
42474 : else
42475 : {
42476 :
42477 : /*
42478 : * Level 2 algorithm
42479 : */
42480 0 : for(i=0; i<=blocksize-1; i++)
42481 : {
42482 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i));
42483 0 : t.ptr.p_complex[1] = ae_complex_from_i(1);
42484 0 : complexapplyreflectionfromtheleft(a, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state);
42485 : }
42486 : }
42487 : }
42488 :
42489 : /*
42490 : * Advance
42491 : */
42492 0 : blockstart = blockstart+blocksize;
42493 : }
42494 0 : ae_frame_leave(_state);
42495 : }
42496 :
42497 :
42498 : /*************************************************************************
42499 : LQ decomposition of a rectangular complex matrix of size MxN
42500 :
42501 : ! COMMERCIAL EDITION OF ALGLIB:
42502 : !
42503 : ! Commercial Edition of ALGLIB includes following important improvements
42504 : ! of this function:
42505 : ! * high-performance native backend with same C# interface (C# version)
42506 : ! * multithreading support (C++ and C# versions)
42507 : ! * hardware vendor (Intel) implementations of linear algebra primitives
42508 : ! (C++ and C# versions, x86/x64 platform)
42509 : !
42510 : ! We recommend you to read 'Working with commercial version' section of
42511 : ! ALGLIB Reference Manual in order to find out how to use performance-
42512 : ! related features provided by commercial edition of ALGLIB.
42513 :
42514 : Input parameters:
42515 : A - matrix A whose indexes range within [0..M-1, 0..N-1]
42516 : M - number of rows in matrix A.
42517 : N - number of columns in matrix A.
42518 :
42519 : Output parameters:
42520 : A - matrices Q and L in compact form
42521 : Tau - array of scalar factors which are used to form matrix Q. Array
42522 : whose indexes range within [0.. Min(M,N)-1]
42523 :
42524 : Matrix A is represented as A = LQ, where Q is an orthogonal matrix of size
42525 : MxM, L - lower triangular (or lower trapezoid) matrix of size MxN.
42526 :
42527 : -- LAPACK routine (version 3.0) --
42528 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
42529 : Courant Institute, Argonne National Lab, and Rice University
42530 : September 30, 1994
42531 : *************************************************************************/
42532 0 : void cmatrixlq(/* Complex */ ae_matrix* a,
42533 : ae_int_t m,
42534 : ae_int_t n,
42535 : /* Complex */ ae_vector* tau,
42536 : ae_state *_state)
42537 : {
42538 : ae_frame _frame_block;
42539 : ae_vector work;
42540 : ae_vector t;
42541 : ae_vector taubuf;
42542 : ae_int_t minmn;
42543 : ae_matrix tmpa;
42544 : ae_matrix tmpt;
42545 : ae_matrix tmpr;
42546 : ae_int_t blockstart;
42547 : ae_int_t blocksize;
42548 : ae_int_t columnscount;
42549 : ae_int_t i;
42550 : ae_int_t ts;
42551 :
42552 0 : ae_frame_make(_state, &_frame_block);
42553 0 : memset(&work, 0, sizeof(work));
42554 0 : memset(&t, 0, sizeof(t));
42555 0 : memset(&taubuf, 0, sizeof(taubuf));
42556 0 : memset(&tmpa, 0, sizeof(tmpa));
42557 0 : memset(&tmpt, 0, sizeof(tmpt));
42558 0 : memset(&tmpr, 0, sizeof(tmpr));
42559 0 : ae_vector_clear(tau);
42560 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
42561 0 : ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true);
42562 0 : ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true);
42563 0 : ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true);
42564 0 : ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true);
42565 0 : ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true);
42566 :
42567 0 : if( m<=0||n<=0 )
42568 : {
42569 0 : ae_frame_leave(_state);
42570 0 : return;
42571 : }
42572 0 : ts = matrixtilesizeb(_state)/2;
42573 0 : minmn = ae_minint(m, n, _state);
42574 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
42575 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
42576 0 : ae_vector_set_length(tau, minmn, _state);
42577 0 : ae_vector_set_length(&taubuf, minmn, _state);
42578 0 : ae_matrix_set_length(&tmpa, ts, n, _state);
42579 0 : ae_matrix_set_length(&tmpt, ts, ts, _state);
42580 0 : ae_matrix_set_length(&tmpr, m, 2*ts, _state);
42581 :
42582 : /*
42583 : * Blocked code
42584 : */
42585 0 : blockstart = 0;
42586 0 : while(blockstart!=minmn)
42587 : {
42588 :
42589 : /*
42590 : * Determine block size
42591 : */
42592 0 : blocksize = minmn-blockstart;
42593 0 : if( blocksize>ts )
42594 : {
42595 0 : blocksize = ts;
42596 : }
42597 0 : columnscount = n-blockstart;
42598 :
42599 : /*
42600 : * LQ decomposition of submatrix.
42601 : * Matrix is copied to temporary storage to solve
42602 : * some TLB issues arising from non-contiguous memory
42603 : * access pattern.
42604 : */
42605 0 : cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state);
42606 0 : ortfac_cmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state);
42607 0 : cmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state);
42608 0 : ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1));
42609 :
42610 : /*
42611 : * Update the rest, choose between:
42612 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
42613 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
42614 : * representation for products of Householder transformations',
42615 : * by R. Schreiber and C. Van Loan.
42616 : */
42617 0 : if( blockstart+blocksize<=m-1 )
42618 : {
42619 0 : if( m-blockstart-blocksize>=2*ts )
42620 : {
42621 :
42622 : /*
42623 : * Prepare block reflector
42624 : */
42625 0 : ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state);
42626 :
42627 : /*
42628 : * Multiply the rest of A by Q.
42629 : *
42630 : * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA
42631 : */
42632 0 : cmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state);
42633 0 : cmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state);
42634 0 : cmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, _state);
42635 : }
42636 : else
42637 : {
42638 :
42639 : /*
42640 : * Level 2 algorithm
42641 : */
42642 0 : for(i=0; i<=blocksize-1; i++)
42643 : {
42644 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i));
42645 0 : t.ptr.p_complex[1] = ae_complex_from_i(1);
42646 0 : complexapplyreflectionfromtheright(a, taubuf.ptr.p_complex[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state);
42647 : }
42648 : }
42649 : }
42650 :
42651 : /*
42652 : * Advance
42653 : */
42654 0 : blockstart = blockstart+blocksize;
42655 : }
42656 0 : ae_frame_leave(_state);
42657 : }
42658 :
42659 :
42660 : /*************************************************************************
42661 : Partial unpacking of matrix Q from the QR decomposition of a matrix A
42662 :
42663 : ! COMMERCIAL EDITION OF ALGLIB:
42664 : !
42665 : ! Commercial Edition of ALGLIB includes following important improvements
42666 : ! of this function:
42667 : ! * high-performance native backend with same C# interface (C# version)
42668 : ! * multithreading support (C++ and C# versions)
42669 : ! * hardware vendor (Intel) implementations of linear algebra primitives
42670 : ! (C++ and C# versions, x86/x64 platform)
42671 : !
42672 : ! We recommend you to read 'Working with commercial version' section of
42673 : ! ALGLIB Reference Manual in order to find out how to use performance-
42674 : ! related features provided by commercial edition of ALGLIB.
42675 :
42676 : Input parameters:
42677 : A - matrices Q and R in compact form.
42678 : Output of RMatrixQR subroutine.
42679 : M - number of rows in given matrix A. M>=0.
42680 : N - number of columns in given matrix A. N>=0.
42681 : Tau - scalar factors which are used to form Q.
42682 : Output of the RMatrixQR subroutine.
42683 : QColumns - required number of columns of matrix Q. M>=QColumns>=0.
42684 :
42685 : Output parameters:
42686 : Q - first QColumns columns of matrix Q.
42687 : Array whose indexes range within [0..M-1, 0..QColumns-1].
42688 : If QColumns=0, the array remains unchanged.
42689 :
42690 : -- ALGLIB routine --
42691 : 17.02.2010
42692 : Bochkanov Sergey
42693 : *************************************************************************/
42694 0 : void rmatrixqrunpackq(/* Real */ ae_matrix* a,
42695 : ae_int_t m,
42696 : ae_int_t n,
42697 : /* Real */ ae_vector* tau,
42698 : ae_int_t qcolumns,
42699 : /* Real */ ae_matrix* q,
42700 : ae_state *_state)
42701 : {
42702 : ae_frame _frame_block;
42703 : ae_vector work;
42704 : ae_vector t;
42705 : ae_vector taubuf;
42706 : ae_int_t minmn;
42707 : ae_int_t refcnt;
42708 : ae_matrix tmpa;
42709 : ae_matrix tmpt;
42710 : ae_matrix tmpr;
42711 : ae_int_t blockstart;
42712 : ae_int_t blocksize;
42713 : ae_int_t rowscount;
42714 : ae_int_t i;
42715 : ae_int_t j;
42716 : ae_int_t ts;
42717 :
42718 0 : ae_frame_make(_state, &_frame_block);
42719 0 : memset(&work, 0, sizeof(work));
42720 0 : memset(&t, 0, sizeof(t));
42721 0 : memset(&taubuf, 0, sizeof(taubuf));
42722 0 : memset(&tmpa, 0, sizeof(tmpa));
42723 0 : memset(&tmpt, 0, sizeof(tmpt));
42724 0 : memset(&tmpr, 0, sizeof(tmpr));
42725 0 : ae_matrix_clear(q);
42726 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
42727 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
42728 0 : ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true);
42729 0 : ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true);
42730 0 : ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true);
42731 0 : ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true);
42732 :
42733 0 : ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state);
42734 0 : if( (m<=0||n<=0)||qcolumns<=0 )
42735 : {
42736 0 : ae_frame_leave(_state);
42737 0 : return;
42738 : }
42739 :
42740 : /*
42741 : * init
42742 : */
42743 0 : ts = matrixtilesizeb(_state);
42744 0 : minmn = ae_minint(m, n, _state);
42745 0 : refcnt = ae_minint(minmn, qcolumns, _state);
42746 0 : ae_matrix_set_length(q, m, qcolumns, _state);
42747 0 : for(i=0; i<=m-1; i++)
42748 : {
42749 0 : for(j=0; j<=qcolumns-1; j++)
42750 : {
42751 0 : if( i==j )
42752 : {
42753 0 : q->ptr.pp_double[i][j] = (double)(1);
42754 : }
42755 : else
42756 : {
42757 0 : q->ptr.pp_double[i][j] = (double)(0);
42758 : }
42759 : }
42760 : }
42761 0 : ae_vector_set_length(&work, ae_maxint(m, qcolumns, _state)+1, _state);
42762 0 : ae_vector_set_length(&t, ae_maxint(m, qcolumns, _state)+1, _state);
42763 0 : ae_vector_set_length(&taubuf, minmn, _state);
42764 0 : ae_matrix_set_length(&tmpa, m, ts, _state);
42765 0 : ae_matrix_set_length(&tmpt, ts, 2*ts, _state);
42766 0 : ae_matrix_set_length(&tmpr, 2*ts, qcolumns, _state);
42767 :
42768 : /*
42769 : * Blocked code
42770 : */
42771 0 : blockstart = ts*(refcnt/ts);
42772 0 : blocksize = refcnt-blockstart;
42773 0 : while(blockstart>=0)
42774 : {
42775 0 : rowscount = m-blockstart;
42776 0 : if( blocksize>0 )
42777 : {
42778 :
42779 : /*
42780 : * Copy current block
42781 : */
42782 0 : rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state);
42783 0 : ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1));
42784 :
42785 : /*
42786 : * Update, choose between:
42787 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
42788 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
42789 : * representation for products of Householder transformations',
42790 : * by R. Schreiber and C. Van Loan.
42791 : */
42792 0 : if( qcolumns>=2*ts )
42793 : {
42794 :
42795 : /*
42796 : * Prepare block reflector
42797 : */
42798 0 : ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state);
42799 :
42800 : /*
42801 : * Multiply matrix by Q.
42802 : *
42803 : * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
42804 : */
42805 0 : rmatrixgemm(blocksize, qcolumns, rowscount, 1.0, &tmpa, 0, 0, 1, q, blockstart, 0, 0, 0.0, &tmpr, 0, 0, _state);
42806 0 : rmatrixgemm(blocksize, qcolumns, blocksize, 1.0, &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state);
42807 0 : rmatrixgemm(rowscount, qcolumns, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, q, blockstart, 0, _state);
42808 : }
42809 : else
42810 : {
42811 :
42812 : /*
42813 : * Level 2 algorithm
42814 : */
42815 0 : for(i=blocksize-1; i>=0; i--)
42816 : {
42817 0 : ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i));
42818 0 : t.ptr.p_double[1] = (double)(1);
42819 0 : applyreflectionfromtheleft(q, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state);
42820 : }
42821 : }
42822 : }
42823 :
42824 : /*
42825 : * Advance
42826 : */
42827 0 : blockstart = blockstart-ts;
42828 0 : blocksize = ts;
42829 : }
42830 0 : ae_frame_leave(_state);
42831 : }
42832 :
42833 :
42834 : /*************************************************************************
42835 : Unpacking of matrix R from the QR decomposition of a matrix A
42836 :
42837 : Input parameters:
42838 : A - matrices Q and R in compact form.
42839 : Output of RMatrixQR subroutine.
42840 : M - number of rows in given matrix A. M>=0.
42841 : N - number of columns in given matrix A. N>=0.
42842 :
42843 : Output parameters:
42844 : R - matrix R, array[0..M-1, 0..N-1].
42845 :
42846 : -- ALGLIB routine --
42847 : 17.02.2010
42848 : Bochkanov Sergey
42849 : *************************************************************************/
42850 0 : void rmatrixqrunpackr(/* Real */ ae_matrix* a,
42851 : ae_int_t m,
42852 : ae_int_t n,
42853 : /* Real */ ae_matrix* r,
42854 : ae_state *_state)
42855 : {
42856 : ae_int_t i;
42857 : ae_int_t k;
42858 :
42859 0 : ae_matrix_clear(r);
42860 :
42861 0 : if( m<=0||n<=0 )
42862 : {
42863 0 : return;
42864 : }
42865 0 : k = ae_minint(m, n, _state);
42866 0 : ae_matrix_set_length(r, m, n, _state);
42867 0 : for(i=0; i<=n-1; i++)
42868 : {
42869 0 : r->ptr.pp_double[0][i] = (double)(0);
42870 : }
42871 0 : for(i=1; i<=m-1; i++)
42872 : {
42873 0 : ae_v_move(&r->ptr.pp_double[i][0], 1, &r->ptr.pp_double[0][0], 1, ae_v_len(0,n-1));
42874 : }
42875 0 : for(i=0; i<=k-1; i++)
42876 : {
42877 0 : ae_v_move(&r->ptr.pp_double[i][i], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1));
42878 : }
42879 : }
42880 :
42881 :
42882 : /*************************************************************************
42883 : Partial unpacking of matrix Q from the LQ decomposition of a matrix A
42884 :
42885 : ! COMMERCIAL EDITION OF ALGLIB:
42886 : !
42887 : ! Commercial Edition of ALGLIB includes following important improvements
42888 : ! of this function:
42889 : ! * high-performance native backend with same C# interface (C# version)
42890 : ! * multithreading support (C++ and C# versions)
42891 : ! * hardware vendor (Intel) implementations of linear algebra primitives
42892 : ! (C++ and C# versions, x86/x64 platform)
42893 : !
42894 : ! We recommend you to read 'Working with commercial version' section of
42895 : ! ALGLIB Reference Manual in order to find out how to use performance-
42896 : ! related features provided by commercial edition of ALGLIB.
42897 :
42898 : Input parameters:
42899 : A - matrices L and Q in compact form.
42900 : Output of RMatrixLQ subroutine.
42901 : M - number of rows in given matrix A. M>=0.
42902 : N - number of columns in given matrix A. N>=0.
42903 : Tau - scalar factors which are used to form Q.
42904 : Output of the RMatrixLQ subroutine.
42905 : QRows - required number of rows in matrix Q. N>=QRows>=0.
42906 :
42907 : Output parameters:
42908 : Q - first QRows rows of matrix Q. Array whose indexes range
42909 : within [0..QRows-1, 0..N-1]. If QRows=0, the array remains
42910 : unchanged.
42911 :
42912 : -- ALGLIB routine --
42913 : 17.02.2010
42914 : Bochkanov Sergey
42915 : *************************************************************************/
42916 0 : void rmatrixlqunpackq(/* Real */ ae_matrix* a,
42917 : ae_int_t m,
42918 : ae_int_t n,
42919 : /* Real */ ae_vector* tau,
42920 : ae_int_t qrows,
42921 : /* Real */ ae_matrix* q,
42922 : ae_state *_state)
42923 : {
42924 : ae_frame _frame_block;
42925 : ae_vector work;
42926 : ae_vector t;
42927 : ae_vector taubuf;
42928 : ae_int_t minmn;
42929 : ae_int_t refcnt;
42930 : ae_matrix tmpa;
42931 : ae_matrix tmpt;
42932 : ae_matrix tmpr;
42933 : ae_int_t blockstart;
42934 : ae_int_t blocksize;
42935 : ae_int_t columnscount;
42936 : ae_int_t i;
42937 : ae_int_t j;
42938 : ae_int_t ts;
42939 :
42940 0 : ae_frame_make(_state, &_frame_block);
42941 0 : memset(&work, 0, sizeof(work));
42942 0 : memset(&t, 0, sizeof(t));
42943 0 : memset(&taubuf, 0, sizeof(taubuf));
42944 0 : memset(&tmpa, 0, sizeof(tmpa));
42945 0 : memset(&tmpt, 0, sizeof(tmpt));
42946 0 : memset(&tmpr, 0, sizeof(tmpr));
42947 0 : ae_matrix_clear(q);
42948 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
42949 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
42950 0 : ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true);
42951 0 : ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true);
42952 0 : ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true);
42953 0 : ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true);
42954 :
42955 0 : ae_assert(qrows<=n, "RMatrixLQUnpackQ: QRows>N!", _state);
42956 0 : if( (m<=0||n<=0)||qrows<=0 )
42957 : {
42958 0 : ae_frame_leave(_state);
42959 0 : return;
42960 : }
42961 :
42962 : /*
42963 : * init
42964 : */
42965 0 : ts = matrixtilesizeb(_state);
42966 0 : minmn = ae_minint(m, n, _state);
42967 0 : refcnt = ae_minint(minmn, qrows, _state);
42968 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
42969 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
42970 0 : ae_vector_set_length(&taubuf, minmn, _state);
42971 0 : ae_matrix_set_length(&tmpa, ts, n, _state);
42972 0 : ae_matrix_set_length(&tmpt, ts, 2*ts, _state);
42973 0 : ae_matrix_set_length(&tmpr, qrows, 2*ts, _state);
42974 0 : ae_matrix_set_length(q, qrows, n, _state);
42975 0 : for(i=0; i<=qrows-1; i++)
42976 : {
42977 0 : for(j=0; j<=n-1; j++)
42978 : {
42979 0 : if( i==j )
42980 : {
42981 0 : q->ptr.pp_double[i][j] = (double)(1);
42982 : }
42983 : else
42984 : {
42985 0 : q->ptr.pp_double[i][j] = (double)(0);
42986 : }
42987 : }
42988 : }
42989 :
42990 : /*
42991 : * Blocked code
42992 : */
42993 0 : blockstart = ts*(refcnt/ts);
42994 0 : blocksize = refcnt-blockstart;
42995 0 : while(blockstart>=0)
42996 : {
42997 0 : columnscount = n-blockstart;
42998 0 : if( blocksize>0 )
42999 : {
43000 :
43001 : /*
43002 : * Copy submatrix
43003 : */
43004 0 : rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state);
43005 0 : ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1));
43006 :
43007 : /*
43008 : * Update matrix, choose between:
43009 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
43010 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
43011 : * representation for products of Householder transformations',
43012 : * by R. Schreiber and C. Van Loan.
43013 : */
43014 0 : if( qrows>=2*ts )
43015 : {
43016 :
43017 : /*
43018 : * Prepare block reflector
43019 : */
43020 0 : ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state);
43021 :
43022 : /*
43023 : * Multiply the rest of A by Q'.
43024 : *
43025 : * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA
43026 : */
43027 0 : rmatrixgemm(qrows, blocksize, columnscount, 1.0, q, 0, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state);
43028 0 : rmatrixgemm(qrows, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 1, 0.0, &tmpr, 0, blocksize, _state);
43029 0 : rmatrixgemm(qrows, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, q, 0, blockstart, _state);
43030 : }
43031 : else
43032 : {
43033 :
43034 : /*
43035 : * Level 2 algorithm
43036 : */
43037 0 : for(i=blocksize-1; i>=0; i--)
43038 : {
43039 0 : ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i));
43040 0 : t.ptr.p_double[1] = (double)(1);
43041 0 : applyreflectionfromtheright(q, taubuf.ptr.p_double[i], &t, 0, qrows-1, blockstart+i, n-1, &work, _state);
43042 : }
43043 : }
43044 : }
43045 :
43046 : /*
43047 : * Advance
43048 : */
43049 0 : blockstart = blockstart-ts;
43050 0 : blocksize = ts;
43051 : }
43052 0 : ae_frame_leave(_state);
43053 : }
43054 :
43055 :
43056 : /*************************************************************************
43057 : Unpacking of matrix L from the LQ decomposition of a matrix A
43058 :
43059 : Input parameters:
43060 : A - matrices Q and L in compact form.
43061 : Output of RMatrixLQ subroutine.
43062 : M - number of rows in given matrix A. M>=0.
43063 : N - number of columns in given matrix A. N>=0.
43064 :
43065 : Output parameters:
43066 : L - matrix L, array[0..M-1, 0..N-1].
43067 :
43068 : -- ALGLIB routine --
43069 : 17.02.2010
43070 : Bochkanov Sergey
43071 : *************************************************************************/
43072 0 : void rmatrixlqunpackl(/* Real */ ae_matrix* a,
43073 : ae_int_t m,
43074 : ae_int_t n,
43075 : /* Real */ ae_matrix* l,
43076 : ae_state *_state)
43077 : {
43078 : ae_int_t i;
43079 : ae_int_t k;
43080 :
43081 0 : ae_matrix_clear(l);
43082 :
43083 0 : if( m<=0||n<=0 )
43084 : {
43085 0 : return;
43086 : }
43087 0 : ae_matrix_set_length(l, m, n, _state);
43088 0 : for(i=0; i<=n-1; i++)
43089 : {
43090 0 : l->ptr.pp_double[0][i] = (double)(0);
43091 : }
43092 0 : for(i=1; i<=m-1; i++)
43093 : {
43094 0 : ae_v_move(&l->ptr.pp_double[i][0], 1, &l->ptr.pp_double[0][0], 1, ae_v_len(0,n-1));
43095 : }
43096 0 : for(i=0; i<=m-1; i++)
43097 : {
43098 0 : k = ae_minint(i, n-1, _state);
43099 0 : ae_v_move(&l->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k));
43100 : }
43101 : }
43102 :
43103 :
43104 : /*************************************************************************
43105 : Partial unpacking of matrix Q from QR decomposition of a complex matrix A.
43106 :
43107 : ! COMMERCIAL EDITION OF ALGLIB:
43108 : !
43109 : ! Commercial Edition of ALGLIB includes following important improvements
43110 : ! of this function:
43111 : ! * high-performance native backend with same C# interface (C# version)
43112 : ! * multithreading support (C++ and C# versions)
43113 : ! * hardware vendor (Intel) implementations of linear algebra primitives
43114 : ! (C++ and C# versions, x86/x64 platform)
43115 : !
43116 : ! We recommend you to read 'Working with commercial version' section of
43117 : ! ALGLIB Reference Manual in order to find out how to use performance-
43118 : ! related features provided by commercial edition of ALGLIB.
43119 :
43120 : Input parameters:
43121 : A - matrices Q and R in compact form.
43122 : Output of CMatrixQR subroutine .
43123 : M - number of rows in matrix A. M>=0.
43124 : N - number of columns in matrix A. N>=0.
43125 : Tau - scalar factors which are used to form Q.
43126 : Output of CMatrixQR subroutine .
43127 : QColumns - required number of columns in matrix Q. M>=QColumns>=0.
43128 :
43129 : Output parameters:
43130 : Q - first QColumns columns of matrix Q.
43131 : Array whose index ranges within [0..M-1, 0..QColumns-1].
43132 : If QColumns=0, array isn't changed.
43133 :
43134 : -- ALGLIB routine --
43135 : 17.02.2010
43136 : Bochkanov Sergey
43137 : *************************************************************************/
43138 0 : void cmatrixqrunpackq(/* Complex */ ae_matrix* a,
43139 : ae_int_t m,
43140 : ae_int_t n,
43141 : /* Complex */ ae_vector* tau,
43142 : ae_int_t qcolumns,
43143 : /* Complex */ ae_matrix* q,
43144 : ae_state *_state)
43145 : {
43146 : ae_frame _frame_block;
43147 : ae_vector work;
43148 : ae_vector t;
43149 : ae_vector taubuf;
43150 : ae_int_t minmn;
43151 : ae_int_t refcnt;
43152 : ae_matrix tmpa;
43153 : ae_matrix tmpt;
43154 : ae_matrix tmpr;
43155 : ae_int_t blockstart;
43156 : ae_int_t blocksize;
43157 : ae_int_t rowscount;
43158 : ae_int_t i;
43159 : ae_int_t j;
43160 : ae_int_t ts;
43161 :
43162 0 : ae_frame_make(_state, &_frame_block);
43163 0 : memset(&work, 0, sizeof(work));
43164 0 : memset(&t, 0, sizeof(t));
43165 0 : memset(&taubuf, 0, sizeof(taubuf));
43166 0 : memset(&tmpa, 0, sizeof(tmpa));
43167 0 : memset(&tmpt, 0, sizeof(tmpt));
43168 0 : memset(&tmpr, 0, sizeof(tmpr));
43169 0 : ae_matrix_clear(q);
43170 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
43171 0 : ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true);
43172 0 : ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true);
43173 0 : ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true);
43174 0 : ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true);
43175 0 : ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true);
43176 :
43177 0 : ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state);
43178 0 : if( m<=0||n<=0 )
43179 : {
43180 0 : ae_frame_leave(_state);
43181 0 : return;
43182 : }
43183 :
43184 : /*
43185 : * init
43186 : */
43187 0 : ts = matrixtilesizeb(_state)/2;
43188 0 : minmn = ae_minint(m, n, _state);
43189 0 : refcnt = ae_minint(minmn, qcolumns, _state);
43190 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
43191 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
43192 0 : ae_vector_set_length(&taubuf, minmn, _state);
43193 0 : ae_matrix_set_length(&tmpa, m, ts, _state);
43194 0 : ae_matrix_set_length(&tmpt, ts, ts, _state);
43195 0 : ae_matrix_set_length(&tmpr, 2*ts, qcolumns, _state);
43196 0 : ae_matrix_set_length(q, m, qcolumns, _state);
43197 0 : for(i=0; i<=m-1; i++)
43198 : {
43199 0 : for(j=0; j<=qcolumns-1; j++)
43200 : {
43201 0 : if( i==j )
43202 : {
43203 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(1);
43204 : }
43205 : else
43206 : {
43207 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(0);
43208 : }
43209 : }
43210 : }
43211 :
43212 : /*
43213 : * Blocked code
43214 : */
43215 0 : blockstart = ts*(refcnt/ts);
43216 0 : blocksize = refcnt-blockstart;
43217 0 : while(blockstart>=0)
43218 : {
43219 0 : rowscount = m-blockstart;
43220 0 : if( blocksize>0 )
43221 : {
43222 :
43223 : /*
43224 : * QR decomposition of submatrix.
43225 : * Matrix is copied to temporary storage to solve
43226 : * some TLB issues arising from non-contiguous memory
43227 : * access pattern.
43228 : */
43229 0 : cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state);
43230 0 : ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1));
43231 :
43232 : /*
43233 : * Update matrix, choose between:
43234 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
43235 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
43236 : * representation for products of Householder transformations',
43237 : * by R. Schreiber and C. Van Loan.
43238 : */
43239 0 : if( qcolumns>=2*ts )
43240 : {
43241 :
43242 : /*
43243 : * Prepare block reflector
43244 : */
43245 0 : ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state);
43246 :
43247 : /*
43248 : * Multiply the rest of A by Q.
43249 : *
43250 : * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA'
43251 : */
43252 0 : cmatrixgemm(blocksize, qcolumns, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, q, blockstart, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state);
43253 0 : cmatrixgemm(blocksize, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state);
43254 0 : cmatrixgemm(rowscount, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), q, blockstart, 0, _state);
43255 : }
43256 : else
43257 : {
43258 :
43259 : /*
43260 : * Level 2 algorithm
43261 : */
43262 0 : for(i=blocksize-1; i>=0; i--)
43263 : {
43264 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i));
43265 0 : t.ptr.p_complex[1] = ae_complex_from_i(1);
43266 0 : complexapplyreflectionfromtheleft(q, taubuf.ptr.p_complex[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state);
43267 : }
43268 : }
43269 : }
43270 :
43271 : /*
43272 : * Advance
43273 : */
43274 0 : blockstart = blockstart-ts;
43275 0 : blocksize = ts;
43276 : }
43277 0 : ae_frame_leave(_state);
43278 : }
43279 :
43280 :
43281 : /*************************************************************************
43282 : Unpacking of matrix R from the QR decomposition of a matrix A
43283 :
43284 : Input parameters:
43285 : A - matrices Q and R in compact form.
43286 : Output of CMatrixQR subroutine.
43287 : M - number of rows in given matrix A. M>=0.
43288 : N - number of columns in given matrix A. N>=0.
43289 :
43290 : Output parameters:
43291 : R - matrix R, array[0..M-1, 0..N-1].
43292 :
43293 : -- ALGLIB routine --
43294 : 17.02.2010
43295 : Bochkanov Sergey
43296 : *************************************************************************/
43297 0 : void cmatrixqrunpackr(/* Complex */ ae_matrix* a,
43298 : ae_int_t m,
43299 : ae_int_t n,
43300 : /* Complex */ ae_matrix* r,
43301 : ae_state *_state)
43302 : {
43303 : ae_int_t i;
43304 : ae_int_t k;
43305 :
43306 0 : ae_matrix_clear(r);
43307 :
43308 0 : if( m<=0||n<=0 )
43309 : {
43310 0 : return;
43311 : }
43312 0 : k = ae_minint(m, n, _state);
43313 0 : ae_matrix_set_length(r, m, n, _state);
43314 0 : for(i=0; i<=n-1; i++)
43315 : {
43316 0 : r->ptr.pp_complex[0][i] = ae_complex_from_i(0);
43317 : }
43318 0 : for(i=1; i<=m-1; i++)
43319 : {
43320 0 : ae_v_cmove(&r->ptr.pp_complex[i][0], 1, &r->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1));
43321 : }
43322 0 : for(i=0; i<=k-1; i++)
43323 : {
43324 0 : ae_v_cmove(&r->ptr.pp_complex[i][i], 1, &a->ptr.pp_complex[i][i], 1, "N", ae_v_len(i,n-1));
43325 : }
43326 : }
43327 :
43328 :
43329 : /*************************************************************************
43330 : Partial unpacking of matrix Q from LQ decomposition of a complex matrix A.
43331 :
43332 : ! COMMERCIAL EDITION OF ALGLIB:
43333 : !
43334 : ! Commercial Edition of ALGLIB includes following important improvements
43335 : ! of this function:
43336 : ! * high-performance native backend with same C# interface (C# version)
43337 : ! * multithreading support (C++ and C# versions)
43338 : ! * hardware vendor (Intel) implementations of linear algebra primitives
43339 : ! (C++ and C# versions, x86/x64 platform)
43340 : !
43341 : ! We recommend you to read 'Working with commercial version' section of
43342 : ! ALGLIB Reference Manual in order to find out how to use performance-
43343 : ! related features provided by commercial edition of ALGLIB.
43344 :
43345 : Input parameters:
43346 : A - matrices Q and R in compact form.
43347 : Output of CMatrixLQ subroutine .
43348 : M - number of rows in matrix A. M>=0.
43349 : N - number of columns in matrix A. N>=0.
43350 : Tau - scalar factors which are used to form Q.
43351 : Output of CMatrixLQ subroutine .
43352 : QRows - required number of rows in matrix Q. N>=QColumns>=0.
43353 :
43354 : Output parameters:
43355 : Q - first QRows rows of matrix Q.
43356 : Array whose index ranges within [0..QRows-1, 0..N-1].
43357 : If QRows=0, array isn't changed.
43358 :
43359 : -- ALGLIB routine --
43360 : 17.02.2010
43361 : Bochkanov Sergey
43362 : *************************************************************************/
43363 0 : void cmatrixlqunpackq(/* Complex */ ae_matrix* a,
43364 : ae_int_t m,
43365 : ae_int_t n,
43366 : /* Complex */ ae_vector* tau,
43367 : ae_int_t qrows,
43368 : /* Complex */ ae_matrix* q,
43369 : ae_state *_state)
43370 : {
43371 : ae_frame _frame_block;
43372 : ae_vector work;
43373 : ae_vector t;
43374 : ae_vector taubuf;
43375 : ae_int_t minmn;
43376 : ae_int_t refcnt;
43377 : ae_matrix tmpa;
43378 : ae_matrix tmpt;
43379 : ae_matrix tmpr;
43380 : ae_int_t blockstart;
43381 : ae_int_t blocksize;
43382 : ae_int_t columnscount;
43383 : ae_int_t i;
43384 : ae_int_t j;
43385 : ae_int_t ts;
43386 :
43387 0 : ae_frame_make(_state, &_frame_block);
43388 0 : memset(&work, 0, sizeof(work));
43389 0 : memset(&t, 0, sizeof(t));
43390 0 : memset(&taubuf, 0, sizeof(taubuf));
43391 0 : memset(&tmpa, 0, sizeof(tmpa));
43392 0 : memset(&tmpt, 0, sizeof(tmpt));
43393 0 : memset(&tmpr, 0, sizeof(tmpr));
43394 0 : ae_matrix_clear(q);
43395 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
43396 0 : ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true);
43397 0 : ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true);
43398 0 : ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true);
43399 0 : ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true);
43400 0 : ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true);
43401 :
43402 0 : if( m<=0||n<=0 )
43403 : {
43404 0 : ae_frame_leave(_state);
43405 0 : return;
43406 : }
43407 :
43408 : /*
43409 : * Init
43410 : */
43411 0 : ts = matrixtilesizeb(_state)/2;
43412 0 : minmn = ae_minint(m, n, _state);
43413 0 : refcnt = ae_minint(minmn, qrows, _state);
43414 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
43415 0 : ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state);
43416 0 : ae_vector_set_length(&taubuf, minmn, _state);
43417 0 : ae_matrix_set_length(&tmpa, ts, n, _state);
43418 0 : ae_matrix_set_length(&tmpt, ts, ts, _state);
43419 0 : ae_matrix_set_length(&tmpr, qrows, 2*ts, _state);
43420 0 : ae_matrix_set_length(q, qrows, n, _state);
43421 0 : for(i=0; i<=qrows-1; i++)
43422 : {
43423 0 : for(j=0; j<=n-1; j++)
43424 : {
43425 0 : if( i==j )
43426 : {
43427 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(1);
43428 : }
43429 : else
43430 : {
43431 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(0);
43432 : }
43433 : }
43434 : }
43435 :
43436 : /*
43437 : * Blocked code
43438 : */
43439 0 : blockstart = ts*(refcnt/ts);
43440 0 : blocksize = refcnt-blockstart;
43441 0 : while(blockstart>=0)
43442 : {
43443 0 : columnscount = n-blockstart;
43444 0 : if( blocksize>0 )
43445 : {
43446 :
43447 : /*
43448 : * LQ decomposition of submatrix.
43449 : * Matrix is copied to temporary storage to solve
43450 : * some TLB issues arising from non-contiguous memory
43451 : * access pattern.
43452 : */
43453 0 : cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state);
43454 0 : ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1));
43455 :
43456 : /*
43457 : * Update matrix, choose between:
43458 : * a) Level 2 algorithm (when the rest of the matrix is small enough)
43459 : * b) blocked algorithm, see algorithm 5 from 'A storage efficient WY
43460 : * representation for products of Householder transformations',
43461 : * by R. Schreiber and C. Van Loan.
43462 : */
43463 0 : if( qrows>=2*ts )
43464 : {
43465 :
43466 : /*
43467 : * Prepare block reflector
43468 : */
43469 0 : ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state);
43470 :
43471 : /*
43472 : * Multiply the rest of A by Q'.
43473 : *
43474 : * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA
43475 : */
43476 0 : cmatrixgemm(qrows, blocksize, columnscount, ae_complex_from_d(1.0), q, 0, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state);
43477 0 : cmatrixgemm(qrows, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state);
43478 0 : cmatrixgemm(qrows, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), q, 0, blockstart, _state);
43479 : }
43480 : else
43481 : {
43482 :
43483 : /*
43484 : * Level 2 algorithm
43485 : */
43486 0 : for(i=blocksize-1; i>=0; i--)
43487 : {
43488 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i));
43489 0 : t.ptr.p_complex[1] = ae_complex_from_i(1);
43490 0 : complexapplyreflectionfromtheright(q, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, 0, qrows-1, blockstart+i, n-1, &work, _state);
43491 : }
43492 : }
43493 : }
43494 :
43495 : /*
43496 : * Advance
43497 : */
43498 0 : blockstart = blockstart-ts;
43499 0 : blocksize = ts;
43500 : }
43501 0 : ae_frame_leave(_state);
43502 : }
43503 :
43504 :
43505 : /*************************************************************************
43506 : Unpacking of matrix L from the LQ decomposition of a matrix A
43507 :
43508 : Input parameters:
43509 : A - matrices Q and L in compact form.
43510 : Output of CMatrixLQ subroutine.
43511 : M - number of rows in given matrix A. M>=0.
43512 : N - number of columns in given matrix A. N>=0.
43513 :
43514 : Output parameters:
43515 : L - matrix L, array[0..M-1, 0..N-1].
43516 :
43517 : -- ALGLIB routine --
43518 : 17.02.2010
43519 : Bochkanov Sergey
43520 : *************************************************************************/
43521 0 : void cmatrixlqunpackl(/* Complex */ ae_matrix* a,
43522 : ae_int_t m,
43523 : ae_int_t n,
43524 : /* Complex */ ae_matrix* l,
43525 : ae_state *_state)
43526 : {
43527 : ae_int_t i;
43528 : ae_int_t k;
43529 :
43530 0 : ae_matrix_clear(l);
43531 :
43532 0 : if( m<=0||n<=0 )
43533 : {
43534 0 : return;
43535 : }
43536 0 : ae_matrix_set_length(l, m, n, _state);
43537 0 : for(i=0; i<=n-1; i++)
43538 : {
43539 0 : l->ptr.pp_complex[0][i] = ae_complex_from_i(0);
43540 : }
43541 0 : for(i=1; i<=m-1; i++)
43542 : {
43543 0 : ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &l->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1));
43544 : }
43545 0 : for(i=0; i<=m-1; i++)
43546 : {
43547 0 : k = ae_minint(i, n-1, _state);
43548 0 : ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,k));
43549 : }
43550 : }
43551 :
43552 :
43553 : /*************************************************************************
43554 : Base case for real QR
43555 :
43556 : -- LAPACK routine (version 3.0) --
43557 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
43558 : Courant Institute, Argonne National Lab, and Rice University
43559 : September 30, 1994.
43560 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
43561 : pseudocode, 2007-2010.
43562 : *************************************************************************/
43563 0 : void rmatrixqrbasecase(/* Real */ ae_matrix* a,
43564 : ae_int_t m,
43565 : ae_int_t n,
43566 : /* Real */ ae_vector* work,
43567 : /* Real */ ae_vector* t,
43568 : /* Real */ ae_vector* tau,
43569 : ae_state *_state)
43570 : {
43571 : ae_int_t i;
43572 : ae_int_t k;
43573 : ae_int_t minmn;
43574 : double tmp;
43575 :
43576 :
43577 0 : minmn = ae_minint(m, n, _state);
43578 :
43579 : /*
43580 : * Test the input arguments
43581 : */
43582 0 : k = minmn;
43583 0 : for(i=0; i<=k-1; i++)
43584 : {
43585 :
43586 : /*
43587 : * Generate elementary reflector H(i) to annihilate A(i+1:m,i)
43588 : */
43589 0 : ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i));
43590 0 : generatereflection(t, m-i, &tmp, _state);
43591 0 : tau->ptr.p_double[i] = tmp;
43592 0 : ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t->ptr.p_double[1], 1, ae_v_len(i,m-1));
43593 0 : t->ptr.p_double[1] = (double)(1);
43594 0 : if( i<n )
43595 : {
43596 :
43597 : /*
43598 : * Apply H(i) to A(i:m-1,i+1:n-1) from the left
43599 : */
43600 0 : applyreflectionfromtheleft(a, tau->ptr.p_double[i], t, i, m-1, i+1, n-1, work, _state);
43601 : }
43602 : }
43603 0 : }
43604 :
43605 :
43606 : /*************************************************************************
43607 : Base case for real LQ
43608 :
43609 : -- LAPACK routine (version 3.0) --
43610 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
43611 : Courant Institute, Argonne National Lab, and Rice University
43612 : September 30, 1994.
43613 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
43614 : pseudocode, 2007-2010.
43615 : *************************************************************************/
43616 0 : void rmatrixlqbasecase(/* Real */ ae_matrix* a,
43617 : ae_int_t m,
43618 : ae_int_t n,
43619 : /* Real */ ae_vector* work,
43620 : /* Real */ ae_vector* t,
43621 : /* Real */ ae_vector* tau,
43622 : ae_state *_state)
43623 : {
43624 : ae_int_t i;
43625 : ae_int_t k;
43626 : double tmp;
43627 :
43628 :
43629 0 : k = ae_minint(m, n, _state);
43630 0 : for(i=0; i<=k-1; i++)
43631 : {
43632 :
43633 : /*
43634 : * Generate elementary reflector H(i) to annihilate A(i,i+1:n-1)
43635 : */
43636 0 : ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i));
43637 0 : generatereflection(t, n-i, &tmp, _state);
43638 0 : tau->ptr.p_double[i] = tmp;
43639 0 : ae_v_move(&a->ptr.pp_double[i][i], 1, &t->ptr.p_double[1], 1, ae_v_len(i,n-1));
43640 0 : t->ptr.p_double[1] = (double)(1);
43641 0 : if( i<n )
43642 : {
43643 :
43644 : /*
43645 : * Apply H(i) to A(i+1:m,i:n) from the right
43646 : */
43647 0 : applyreflectionfromtheright(a, tau->ptr.p_double[i], t, i+1, m-1, i, n-1, work, _state);
43648 : }
43649 : }
43650 0 : }
43651 :
43652 :
43653 : /*************************************************************************
43654 : Reduction of a rectangular matrix to bidiagonal form
43655 :
43656 : The algorithm reduces the rectangular matrix A to bidiagonal form by
43657 : orthogonal transformations P and Q: A = Q*B*(P^T).
43658 :
43659 : ! COMMERCIAL EDITION OF ALGLIB:
43660 : !
43661 : ! Commercial Edition of ALGLIB includes following important improvements
43662 : ! of this function:
43663 : ! * high-performance native backend with same C# interface (C# version)
43664 : ! * hardware vendor (Intel) implementations of linear algebra primitives
43665 : ! (C++ and C# versions, x86/x64 platform)
43666 : !
43667 : ! We recommend you to read 'Working with commercial version' section of
43668 : ! ALGLIB Reference Manual in order to find out how to use performance-
43669 : ! related features provided by commercial edition of ALGLIB.
43670 :
43671 : Input parameters:
43672 : A - source matrix. array[0..M-1, 0..N-1]
43673 : M - number of rows in matrix A.
43674 : N - number of columns in matrix A.
43675 :
43676 : Output parameters:
43677 : A - matrices Q, B, P in compact form (see below).
43678 : TauQ - scalar factors which are used to form matrix Q.
43679 : TauP - scalar factors which are used to form matrix P.
43680 :
43681 : The main diagonal and one of the secondary diagonals of matrix A are
43682 : replaced with bidiagonal matrix B. Other elements contain elementary
43683 : reflections which form MxM matrix Q and NxN matrix P, respectively.
43684 :
43685 : If M>=N, B is the upper bidiagonal MxN matrix and is stored in the
43686 : corresponding elements of matrix A. Matrix Q is represented as a
43687 : product of elementary reflections Q = H(0)*H(1)*...*H(n-1), where
43688 : H(i) = 1-tau*v*v'. Here tau is a scalar which is stored in TauQ[i], and
43689 : vector v has the following structure: v(0:i-1)=0, v(i)=1, v(i+1:m-1) is
43690 : stored in elements A(i+1:m-1,i). Matrix P is as follows: P =
43691 : G(0)*G(1)*...*G(n-2), where G(i) = 1 - tau*u*u'. Tau is stored in TauP[i],
43692 : u(0:i)=0, u(i+1)=1, u(i+2:n-1) is stored in elements A(i,i+2:n-1).
43693 :
43694 : If M<N, B is the lower bidiagonal MxN matrix and is stored in the
43695 : corresponding elements of matrix A. Q = H(0)*H(1)*...*H(m-2), where
43696 : H(i) = 1 - tau*v*v', tau is stored in TauQ, v(0:i)=0, v(i+1)=1, v(i+2:m-1)
43697 : is stored in elements A(i+2:m-1,i). P = G(0)*G(1)*...*G(m-1),
43698 : G(i) = 1-tau*u*u', tau is stored in TauP, u(0:i-1)=0, u(i)=1, u(i+1:n-1)
43699 : is stored in A(i,i+1:n-1).
43700 :
43701 : EXAMPLE:
43702 :
43703 : m=6, n=5 (m > n): m=5, n=6 (m < n):
43704 :
43705 : ( d e u1 u1 u1 ) ( d u1 u1 u1 u1 u1 )
43706 : ( v1 d e u2 u2 ) ( e d u2 u2 u2 u2 )
43707 : ( v1 v2 d e u3 ) ( v1 e d u3 u3 u3 )
43708 : ( v1 v2 v3 d e ) ( v1 v2 e d u4 u4 )
43709 : ( v1 v2 v3 v4 d ) ( v1 v2 v3 e d u5 )
43710 : ( v1 v2 v3 v4 v5 )
43711 :
43712 : Here vi and ui are vectors which form H(i) and G(i), and d and e -
43713 : are the diagonal and off-diagonal elements of matrix B.
43714 :
43715 : -- LAPACK routine (version 3.0) --
43716 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
43717 : Courant Institute, Argonne National Lab, and Rice University
43718 : September 30, 1994.
43719 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
43720 : pseudocode, 2007-2010.
43721 : *************************************************************************/
43722 0 : void rmatrixbd(/* Real */ ae_matrix* a,
43723 : ae_int_t m,
43724 : ae_int_t n,
43725 : /* Real */ ae_vector* tauq,
43726 : /* Real */ ae_vector* taup,
43727 : ae_state *_state)
43728 : {
43729 : ae_frame _frame_block;
43730 : ae_vector work;
43731 : ae_vector t;
43732 : ae_int_t maxmn;
43733 : ae_int_t i;
43734 : double ltau;
43735 :
43736 0 : ae_frame_make(_state, &_frame_block);
43737 0 : memset(&work, 0, sizeof(work));
43738 0 : memset(&t, 0, sizeof(t));
43739 0 : ae_vector_clear(tauq);
43740 0 : ae_vector_clear(taup);
43741 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
43742 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
43743 :
43744 :
43745 : /*
43746 : * Prepare
43747 : */
43748 0 : if( n<=0||m<=0 )
43749 : {
43750 0 : ae_frame_leave(_state);
43751 0 : return;
43752 : }
43753 0 : maxmn = ae_maxint(m, n, _state);
43754 0 : ae_vector_set_length(&work, maxmn+1, _state);
43755 0 : ae_vector_set_length(&t, maxmn+1, _state);
43756 0 : if( m>=n )
43757 : {
43758 0 : ae_vector_set_length(tauq, n, _state);
43759 0 : ae_vector_set_length(taup, n, _state);
43760 0 : for(i=0; i<=n-1; i++)
43761 : {
43762 0 : tauq->ptr.p_double[i] = 0.0;
43763 0 : taup->ptr.p_double[i] = 0.0;
43764 : }
43765 : }
43766 : else
43767 : {
43768 0 : ae_vector_set_length(tauq, m, _state);
43769 0 : ae_vector_set_length(taup, m, _state);
43770 0 : for(i=0; i<=m-1; i++)
43771 : {
43772 0 : tauq->ptr.p_double[i] = 0.0;
43773 0 : taup->ptr.p_double[i] = 0.0;
43774 : }
43775 : }
43776 :
43777 : /*
43778 : * Try to use MKL code
43779 : *
43780 : * NOTE: buffers Work[] and T[] are used for temporary storage of diagonals;
43781 : * because they are present in A[], we do not use them.
43782 : */
43783 0 : if( rmatrixbdmkl(a, m, n, &work, &t, tauq, taup, _state) )
43784 : {
43785 0 : ae_frame_leave(_state);
43786 0 : return;
43787 : }
43788 :
43789 : /*
43790 : * ALGLIB code
43791 : */
43792 0 : if( m>=n )
43793 : {
43794 :
43795 : /*
43796 : * Reduce to upper bidiagonal form
43797 : */
43798 0 : for(i=0; i<=n-1; i++)
43799 : {
43800 :
43801 : /*
43802 : * Generate elementary reflector H(i) to annihilate A(i+1:m-1,i)
43803 : */
43804 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i));
43805 0 : generatereflection(&t, m-i, <au, _state);
43806 0 : tauq->ptr.p_double[i] = ltau;
43807 0 : ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i,m-1));
43808 0 : t.ptr.p_double[1] = (double)(1);
43809 :
43810 : /*
43811 : * Apply H(i) to A(i:m-1,i+1:n-1) from the left
43812 : */
43813 0 : applyreflectionfromtheleft(a, ltau, &t, i, m-1, i+1, n-1, &work, _state);
43814 0 : if( i<n-1 )
43815 : {
43816 :
43817 : /*
43818 : * Generate elementary reflector G(i) to annihilate
43819 : * A(i,i+2:n-1)
43820 : */
43821 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i+1], 1, ae_v_len(1,n-i-1));
43822 0 : generatereflection(&t, n-1-i, <au, _state);
43823 0 : taup->ptr.p_double[i] = ltau;
43824 0 : ae_v_move(&a->ptr.pp_double[i][i+1], 1, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1));
43825 0 : t.ptr.p_double[1] = (double)(1);
43826 :
43827 : /*
43828 : * Apply G(i) to A(i+1:m-1,i+1:n-1) from the right
43829 : */
43830 0 : applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state);
43831 : }
43832 : else
43833 : {
43834 0 : taup->ptr.p_double[i] = (double)(0);
43835 : }
43836 : }
43837 : }
43838 : else
43839 : {
43840 :
43841 : /*
43842 : * Reduce to lower bidiagonal form
43843 : */
43844 0 : for(i=0; i<=m-1; i++)
43845 : {
43846 :
43847 : /*
43848 : * Generate elementary reflector G(i) to annihilate A(i,i+1:n-1)
43849 : */
43850 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i));
43851 0 : generatereflection(&t, n-i, <au, _state);
43852 0 : taup->ptr.p_double[i] = ltau;
43853 0 : ae_v_move(&a->ptr.pp_double[i][i], 1, &t.ptr.p_double[1], 1, ae_v_len(i,n-1));
43854 0 : t.ptr.p_double[1] = (double)(1);
43855 :
43856 : /*
43857 : * Apply G(i) to A(i+1:m-1,i:n-1) from the right
43858 : */
43859 0 : applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i, n-1, &work, _state);
43860 0 : if( i<m-1 )
43861 : {
43862 :
43863 : /*
43864 : * Generate elementary reflector H(i) to annihilate
43865 : * A(i+2:m-1,i)
43866 : */
43867 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,m-1-i));
43868 0 : generatereflection(&t, m-1-i, <au, _state);
43869 0 : tauq->ptr.p_double[i] = ltau;
43870 0 : ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,m-1));
43871 0 : t.ptr.p_double[1] = (double)(1);
43872 :
43873 : /*
43874 : * Apply H(i) to A(i+1:m-1,i+1:n-1) from the left
43875 : */
43876 0 : applyreflectionfromtheleft(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state);
43877 : }
43878 : else
43879 : {
43880 0 : tauq->ptr.p_double[i] = (double)(0);
43881 : }
43882 : }
43883 : }
43884 0 : ae_frame_leave(_state);
43885 : }
43886 :
43887 :
43888 : /*************************************************************************
43889 : Unpacking matrix Q which reduces a matrix to bidiagonal form.
43890 :
43891 : ! COMMERCIAL EDITION OF ALGLIB:
43892 : !
43893 : ! Commercial Edition of ALGLIB includes following important improvements
43894 : ! of this function:
43895 : ! * high-performance native backend with same C# interface (C# version)
43896 : ! * hardware vendor (Intel) implementations of linear algebra primitives
43897 : ! (C++ and C# versions, x86/x64 platform)
43898 : !
43899 : ! We recommend you to read 'Working with commercial version' section of
43900 : ! ALGLIB Reference Manual in order to find out how to use performance-
43901 : ! related features provided by commercial edition of ALGLIB.
43902 :
43903 : Input parameters:
43904 : QP - matrices Q and P in compact form.
43905 : Output of ToBidiagonal subroutine.
43906 : M - number of rows in matrix A.
43907 : N - number of columns in matrix A.
43908 : TAUQ - scalar factors which are used to form Q.
43909 : Output of ToBidiagonal subroutine.
43910 : QColumns - required number of columns in matrix Q.
43911 : M>=QColumns>=0.
43912 :
43913 : Output parameters:
43914 : Q - first QColumns columns of matrix Q.
43915 : Array[0..M-1, 0..QColumns-1]
43916 : If QColumns=0, the array is not modified.
43917 :
43918 : -- ALGLIB --
43919 : 2005-2010
43920 : Bochkanov Sergey
43921 : *************************************************************************/
43922 0 : void rmatrixbdunpackq(/* Real */ ae_matrix* qp,
43923 : ae_int_t m,
43924 : ae_int_t n,
43925 : /* Real */ ae_vector* tauq,
43926 : ae_int_t qcolumns,
43927 : /* Real */ ae_matrix* q,
43928 : ae_state *_state)
43929 : {
43930 : ae_int_t i;
43931 : ae_int_t j;
43932 :
43933 0 : ae_matrix_clear(q);
43934 :
43935 0 : ae_assert(qcolumns<=m, "RMatrixBDUnpackQ: QColumns>M!", _state);
43936 0 : ae_assert(qcolumns>=0, "RMatrixBDUnpackQ: QColumns<0!", _state);
43937 0 : if( (m==0||n==0)||qcolumns==0 )
43938 : {
43939 0 : return;
43940 : }
43941 :
43942 : /*
43943 : * prepare Q
43944 : */
43945 0 : ae_matrix_set_length(q, m, qcolumns, _state);
43946 0 : for(i=0; i<=m-1; i++)
43947 : {
43948 0 : for(j=0; j<=qcolumns-1; j++)
43949 : {
43950 0 : if( i==j )
43951 : {
43952 0 : q->ptr.pp_double[i][j] = (double)(1);
43953 : }
43954 : else
43955 : {
43956 0 : q->ptr.pp_double[i][j] = (double)(0);
43957 : }
43958 : }
43959 : }
43960 :
43961 : /*
43962 : * Calculate
43963 : */
43964 0 : rmatrixbdmultiplybyq(qp, m, n, tauq, q, m, qcolumns, ae_false, ae_false, _state);
43965 : }
43966 :
43967 :
43968 : /*************************************************************************
43969 : Multiplication by matrix Q which reduces matrix A to bidiagonal form.
43970 :
43971 : The algorithm allows pre- or post-multiply by Q or Q'.
43972 :
43973 : ! COMMERCIAL EDITION OF ALGLIB:
43974 : !
43975 : ! Commercial Edition of ALGLIB includes following important improvements
43976 : ! of this function:
43977 : ! * high-performance native backend with same C# interface (C# version)
43978 : ! * hardware vendor (Intel) implementations of linear algebra primitives
43979 : ! (C++ and C# versions, x86/x64 platform)
43980 : !
43981 : ! We recommend you to read 'Working with commercial version' section of
43982 : ! ALGLIB Reference Manual in order to find out how to use performance-
43983 : ! related features provided by commercial edition of ALGLIB.
43984 :
43985 : Input parameters:
43986 : QP - matrices Q and P in compact form.
43987 : Output of ToBidiagonal subroutine.
43988 : M - number of rows in matrix A.
43989 : N - number of columns in matrix A.
43990 : TAUQ - scalar factors which are used to form Q.
43991 : Output of ToBidiagonal subroutine.
43992 : Z - multiplied matrix.
43993 : array[0..ZRows-1,0..ZColumns-1]
43994 : ZRows - number of rows in matrix Z. If FromTheRight=False,
43995 : ZRows=M, otherwise ZRows can be arbitrary.
43996 : ZColumns - number of columns in matrix Z. If FromTheRight=True,
43997 : ZColumns=M, otherwise ZColumns can be arbitrary.
43998 : FromTheRight - pre- or post-multiply.
43999 : DoTranspose - multiply by Q or Q'.
44000 :
44001 : Output parameters:
44002 : Z - product of Z and Q.
44003 : Array[0..ZRows-1,0..ZColumns-1]
44004 : If ZRows=0 or ZColumns=0, the array is not modified.
44005 :
44006 : -- ALGLIB --
44007 : 2005-2010
44008 : Bochkanov Sergey
44009 : *************************************************************************/
44010 0 : void rmatrixbdmultiplybyq(/* Real */ ae_matrix* qp,
44011 : ae_int_t m,
44012 : ae_int_t n,
44013 : /* Real */ ae_vector* tauq,
44014 : /* Real */ ae_matrix* z,
44015 : ae_int_t zrows,
44016 : ae_int_t zcolumns,
44017 : ae_bool fromtheright,
44018 : ae_bool dotranspose,
44019 : ae_state *_state)
44020 : {
44021 : ae_frame _frame_block;
44022 : ae_int_t i;
44023 : ae_int_t i1;
44024 : ae_int_t i2;
44025 : ae_int_t istep;
44026 : ae_vector v;
44027 : ae_vector work;
44028 : ae_vector dummy;
44029 : ae_int_t mx;
44030 :
44031 0 : ae_frame_make(_state, &_frame_block);
44032 0 : memset(&v, 0, sizeof(v));
44033 0 : memset(&work, 0, sizeof(work));
44034 0 : memset(&dummy, 0, sizeof(dummy));
44035 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
44036 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
44037 0 : ae_vector_init(&dummy, 0, DT_REAL, _state, ae_true);
44038 :
44039 0 : if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 )
44040 : {
44041 0 : ae_frame_leave(_state);
44042 0 : return;
44043 : }
44044 0 : ae_assert((fromtheright&&zcolumns==m)||(!fromtheright&&zrows==m), "RMatrixBDMultiplyByQ: incorrect Z size!", _state);
44045 :
44046 : /*
44047 : * Try to use MKL code
44048 : */
44049 0 : if( rmatrixbdmultiplybymkl(qp, m, n, tauq, &dummy, z, zrows, zcolumns, ae_true, fromtheright, dotranspose, _state) )
44050 : {
44051 0 : ae_frame_leave(_state);
44052 0 : return;
44053 : }
44054 :
44055 : /*
44056 : * init
44057 : */
44058 0 : mx = ae_maxint(m, n, _state);
44059 0 : mx = ae_maxint(mx, zrows, _state);
44060 0 : mx = ae_maxint(mx, zcolumns, _state);
44061 0 : ae_vector_set_length(&v, mx+1, _state);
44062 0 : ae_vector_set_length(&work, mx+1, _state);
44063 0 : if( m>=n )
44064 : {
44065 :
44066 : /*
44067 : * setup
44068 : */
44069 0 : if( fromtheright )
44070 : {
44071 0 : i1 = 0;
44072 0 : i2 = n-1;
44073 0 : istep = 1;
44074 : }
44075 : else
44076 : {
44077 0 : i1 = n-1;
44078 0 : i2 = 0;
44079 0 : istep = -1;
44080 : }
44081 0 : if( dotranspose )
44082 : {
44083 0 : i = i1;
44084 0 : i1 = i2;
44085 0 : i2 = i;
44086 0 : istep = -istep;
44087 : }
44088 :
44089 : /*
44090 : * Process
44091 : */
44092 0 : i = i1;
44093 0 : do
44094 : {
44095 0 : ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], qp->stride, ae_v_len(1,m-i));
44096 0 : v.ptr.p_double[1] = (double)(1);
44097 0 : if( fromtheright )
44098 : {
44099 0 : applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i, m-1, &work, _state);
44100 : }
44101 : else
44102 : {
44103 0 : applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i, m-1, 0, zcolumns-1, &work, _state);
44104 : }
44105 0 : i = i+istep;
44106 : }
44107 0 : while(i!=i2+istep);
44108 : }
44109 : else
44110 : {
44111 :
44112 : /*
44113 : * setup
44114 : */
44115 0 : if( fromtheright )
44116 : {
44117 0 : i1 = 0;
44118 0 : i2 = m-2;
44119 0 : istep = 1;
44120 : }
44121 : else
44122 : {
44123 0 : i1 = m-2;
44124 0 : i2 = 0;
44125 0 : istep = -1;
44126 : }
44127 0 : if( dotranspose )
44128 : {
44129 0 : i = i1;
44130 0 : i1 = i2;
44131 0 : i2 = i;
44132 0 : istep = -istep;
44133 : }
44134 :
44135 : /*
44136 : * Process
44137 : */
44138 0 : if( m-1>0 )
44139 : {
44140 0 : i = i1;
44141 0 : do
44142 : {
44143 0 : ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i+1][i], qp->stride, ae_v_len(1,m-i-1));
44144 0 : v.ptr.p_double[1] = (double)(1);
44145 0 : if( fromtheright )
44146 : {
44147 0 : applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i+1, m-1, &work, _state);
44148 : }
44149 : else
44150 : {
44151 0 : applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i+1, m-1, 0, zcolumns-1, &work, _state);
44152 : }
44153 0 : i = i+istep;
44154 : }
44155 0 : while(i!=i2+istep);
44156 : }
44157 : }
44158 0 : ae_frame_leave(_state);
44159 : }
44160 :
44161 :
44162 : /*************************************************************************
44163 : Unpacking matrix P which reduces matrix A to bidiagonal form.
44164 : The subroutine returns transposed matrix P.
44165 :
44166 : Input parameters:
44167 : QP - matrices Q and P in compact form.
44168 : Output of ToBidiagonal subroutine.
44169 : M - number of rows in matrix A.
44170 : N - number of columns in matrix A.
44171 : TAUP - scalar factors which are used to form P.
44172 : Output of ToBidiagonal subroutine.
44173 : PTRows - required number of rows of matrix P^T. N >= PTRows >= 0.
44174 :
44175 : Output parameters:
44176 : PT - first PTRows columns of matrix P^T
44177 : Array[0..PTRows-1, 0..N-1]
44178 : If PTRows=0, the array is not modified.
44179 :
44180 : -- ALGLIB --
44181 : 2005-2010
44182 : Bochkanov Sergey
44183 : *************************************************************************/
44184 0 : void rmatrixbdunpackpt(/* Real */ ae_matrix* qp,
44185 : ae_int_t m,
44186 : ae_int_t n,
44187 : /* Real */ ae_vector* taup,
44188 : ae_int_t ptrows,
44189 : /* Real */ ae_matrix* pt,
44190 : ae_state *_state)
44191 : {
44192 : ae_int_t i;
44193 : ae_int_t j;
44194 :
44195 0 : ae_matrix_clear(pt);
44196 :
44197 0 : ae_assert(ptrows<=n, "RMatrixBDUnpackPT: PTRows>N!", _state);
44198 0 : ae_assert(ptrows>=0, "RMatrixBDUnpackPT: PTRows<0!", _state);
44199 0 : if( (m==0||n==0)||ptrows==0 )
44200 : {
44201 0 : return;
44202 : }
44203 :
44204 : /*
44205 : * prepare PT
44206 : */
44207 0 : ae_matrix_set_length(pt, ptrows, n, _state);
44208 0 : for(i=0; i<=ptrows-1; i++)
44209 : {
44210 0 : for(j=0; j<=n-1; j++)
44211 : {
44212 0 : if( i==j )
44213 : {
44214 0 : pt->ptr.pp_double[i][j] = (double)(1);
44215 : }
44216 : else
44217 : {
44218 0 : pt->ptr.pp_double[i][j] = (double)(0);
44219 : }
44220 : }
44221 : }
44222 :
44223 : /*
44224 : * Calculate
44225 : */
44226 0 : rmatrixbdmultiplybyp(qp, m, n, taup, pt, ptrows, n, ae_true, ae_true, _state);
44227 : }
44228 :
44229 :
44230 : /*************************************************************************
44231 : Multiplication by matrix P which reduces matrix A to bidiagonal form.
44232 :
44233 : The algorithm allows pre- or post-multiply by P or P'.
44234 :
44235 : Input parameters:
44236 : QP - matrices Q and P in compact form.
44237 : Output of RMatrixBD subroutine.
44238 : M - number of rows in matrix A.
44239 : N - number of columns in matrix A.
44240 : TAUP - scalar factors which are used to form P.
44241 : Output of RMatrixBD subroutine.
44242 : Z - multiplied matrix.
44243 : Array whose indexes range within [0..ZRows-1,0..ZColumns-1].
44244 : ZRows - number of rows in matrix Z. If FromTheRight=False,
44245 : ZRows=N, otherwise ZRows can be arbitrary.
44246 : ZColumns - number of columns in matrix Z. If FromTheRight=True,
44247 : ZColumns=N, otherwise ZColumns can be arbitrary.
44248 : FromTheRight - pre- or post-multiply.
44249 : DoTranspose - multiply by P or P'.
44250 :
44251 : Output parameters:
44252 : Z - product of Z and P.
44253 : Array whose indexes range within [0..ZRows-1,0..ZColumns-1].
44254 : If ZRows=0 or ZColumns=0, the array is not modified.
44255 :
44256 : -- ALGLIB --
44257 : 2005-2010
44258 : Bochkanov Sergey
44259 : *************************************************************************/
44260 0 : void rmatrixbdmultiplybyp(/* Real */ ae_matrix* qp,
44261 : ae_int_t m,
44262 : ae_int_t n,
44263 : /* Real */ ae_vector* taup,
44264 : /* Real */ ae_matrix* z,
44265 : ae_int_t zrows,
44266 : ae_int_t zcolumns,
44267 : ae_bool fromtheright,
44268 : ae_bool dotranspose,
44269 : ae_state *_state)
44270 : {
44271 : ae_frame _frame_block;
44272 : ae_int_t i;
44273 : ae_vector v;
44274 : ae_vector work;
44275 : ae_vector dummy;
44276 : ae_int_t mx;
44277 : ae_int_t i1;
44278 : ae_int_t i2;
44279 : ae_int_t istep;
44280 :
44281 0 : ae_frame_make(_state, &_frame_block);
44282 0 : memset(&v, 0, sizeof(v));
44283 0 : memset(&work, 0, sizeof(work));
44284 0 : memset(&dummy, 0, sizeof(dummy));
44285 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
44286 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
44287 0 : ae_vector_init(&dummy, 0, DT_REAL, _state, ae_true);
44288 :
44289 0 : if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 )
44290 : {
44291 0 : ae_frame_leave(_state);
44292 0 : return;
44293 : }
44294 0 : ae_assert((fromtheright&&zcolumns==n)||(!fromtheright&&zrows==n), "RMatrixBDMultiplyByP: incorrect Z size!", _state);
44295 :
44296 : /*
44297 : * init
44298 : */
44299 0 : mx = ae_maxint(m, n, _state);
44300 0 : mx = ae_maxint(mx, zrows, _state);
44301 0 : mx = ae_maxint(mx, zcolumns, _state);
44302 0 : ae_vector_set_length(&v, mx+1, _state);
44303 0 : ae_vector_set_length(&work, mx+1, _state);
44304 0 : if( m>=n )
44305 : {
44306 :
44307 : /*
44308 : * setup
44309 : */
44310 0 : if( fromtheright )
44311 : {
44312 0 : i1 = n-2;
44313 0 : i2 = 0;
44314 0 : istep = -1;
44315 : }
44316 : else
44317 : {
44318 0 : i1 = 0;
44319 0 : i2 = n-2;
44320 0 : istep = 1;
44321 : }
44322 0 : if( !dotranspose )
44323 : {
44324 0 : i = i1;
44325 0 : i1 = i2;
44326 0 : i2 = i;
44327 0 : istep = -istep;
44328 : }
44329 :
44330 : /*
44331 : * Process
44332 : */
44333 0 : if( n-1>0 )
44334 : {
44335 0 : i = i1;
44336 0 : do
44337 : {
44338 0 : ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i+1], 1, ae_v_len(1,n-1-i));
44339 0 : v.ptr.p_double[1] = (double)(1);
44340 0 : if( fromtheright )
44341 : {
44342 0 : applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i+1, n-1, &work, _state);
44343 : }
44344 : else
44345 : {
44346 0 : applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i+1, n-1, 0, zcolumns-1, &work, _state);
44347 : }
44348 0 : i = i+istep;
44349 : }
44350 0 : while(i!=i2+istep);
44351 : }
44352 : }
44353 : else
44354 : {
44355 :
44356 : /*
44357 : * setup
44358 : */
44359 0 : if( fromtheright )
44360 : {
44361 0 : i1 = m-1;
44362 0 : i2 = 0;
44363 0 : istep = -1;
44364 : }
44365 : else
44366 : {
44367 0 : i1 = 0;
44368 0 : i2 = m-1;
44369 0 : istep = 1;
44370 : }
44371 0 : if( !dotranspose )
44372 : {
44373 0 : i = i1;
44374 0 : i1 = i2;
44375 0 : i2 = i;
44376 0 : istep = -istep;
44377 : }
44378 :
44379 : /*
44380 : * Process
44381 : */
44382 0 : i = i1;
44383 0 : do
44384 : {
44385 0 : ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], 1, ae_v_len(1,n-i));
44386 0 : v.ptr.p_double[1] = (double)(1);
44387 0 : if( fromtheright )
44388 : {
44389 0 : applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i, n-1, &work, _state);
44390 : }
44391 : else
44392 : {
44393 0 : applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i, n-1, 0, zcolumns-1, &work, _state);
44394 : }
44395 0 : i = i+istep;
44396 : }
44397 0 : while(i!=i2+istep);
44398 : }
44399 0 : ae_frame_leave(_state);
44400 : }
44401 :
44402 :
44403 : /*************************************************************************
44404 : Unpacking of the main and secondary diagonals of bidiagonal decomposition
44405 : of matrix A.
44406 :
44407 : Input parameters:
44408 : B - output of RMatrixBD subroutine.
44409 : M - number of rows in matrix B.
44410 : N - number of columns in matrix B.
44411 :
44412 : Output parameters:
44413 : IsUpper - True, if the matrix is upper bidiagonal.
44414 : otherwise IsUpper is False.
44415 : D - the main diagonal.
44416 : Array whose index ranges within [0..Min(M,N)-1].
44417 : E - the secondary diagonal (upper or lower, depending on
44418 : the value of IsUpper).
44419 : Array index ranges within [0..Min(M,N)-1], the last
44420 : element is not used.
44421 :
44422 : -- ALGLIB --
44423 : 2005-2010
44424 : Bochkanov Sergey
44425 : *************************************************************************/
44426 0 : void rmatrixbdunpackdiagonals(/* Real */ ae_matrix* b,
44427 : ae_int_t m,
44428 : ae_int_t n,
44429 : ae_bool* isupper,
44430 : /* Real */ ae_vector* d,
44431 : /* Real */ ae_vector* e,
44432 : ae_state *_state)
44433 : {
44434 : ae_int_t i;
44435 :
44436 0 : *isupper = ae_false;
44437 0 : ae_vector_clear(d);
44438 0 : ae_vector_clear(e);
44439 :
44440 0 : *isupper = m>=n;
44441 0 : if( m<=0||n<=0 )
44442 : {
44443 0 : return;
44444 : }
44445 0 : if( *isupper )
44446 : {
44447 0 : ae_vector_set_length(d, n, _state);
44448 0 : ae_vector_set_length(e, n, _state);
44449 0 : for(i=0; i<=n-2; i++)
44450 : {
44451 0 : d->ptr.p_double[i] = b->ptr.pp_double[i][i];
44452 0 : e->ptr.p_double[i] = b->ptr.pp_double[i][i+1];
44453 : }
44454 0 : d->ptr.p_double[n-1] = b->ptr.pp_double[n-1][n-1];
44455 : }
44456 : else
44457 : {
44458 0 : ae_vector_set_length(d, m, _state);
44459 0 : ae_vector_set_length(e, m, _state);
44460 0 : for(i=0; i<=m-2; i++)
44461 : {
44462 0 : d->ptr.p_double[i] = b->ptr.pp_double[i][i];
44463 0 : e->ptr.p_double[i] = b->ptr.pp_double[i+1][i];
44464 : }
44465 0 : d->ptr.p_double[m-1] = b->ptr.pp_double[m-1][m-1];
44466 : }
44467 : }
44468 :
44469 :
44470 : /*************************************************************************
44471 : Reduction of a square matrix to upper Hessenberg form: Q'*A*Q = H,
44472 : where Q is an orthogonal matrix, H - Hessenberg matrix.
44473 :
44474 : ! COMMERCIAL EDITION OF ALGLIB:
44475 : !
44476 : ! Commercial Edition of ALGLIB includes following important improvements
44477 : ! of this function:
44478 : ! * high-performance native backend with same C# interface (C# version)
44479 : ! * hardware vendor (Intel) implementations of linear algebra primitives
44480 : ! (C++ and C# versions, x86/x64 platform)
44481 : !
44482 : ! We recommend you to read 'Working with commercial version' section of
44483 : ! ALGLIB Reference Manual in order to find out how to use performance-
44484 : ! related features provided by commercial edition of ALGLIB.
44485 :
44486 : Input parameters:
44487 : A - matrix A with elements [0..N-1, 0..N-1]
44488 : N - size of matrix A.
44489 :
44490 : Output parameters:
44491 : A - matrices Q and P in compact form (see below).
44492 : Tau - array of scalar factors which are used to form matrix Q.
44493 : Array whose index ranges within [0..N-2]
44494 :
44495 : Matrix H is located on the main diagonal, on the lower secondary diagonal
44496 : and above the main diagonal of matrix A. The elements which are used to
44497 : form matrix Q are situated in array Tau and below the lower secondary
44498 : diagonal of matrix A as follows:
44499 :
44500 : Matrix Q is represented as a product of elementary reflections
44501 :
44502 : Q = H(0)*H(2)*...*H(n-2),
44503 :
44504 : where each H(i) is given by
44505 :
44506 : H(i) = 1 - tau * v * (v^T)
44507 :
44508 : where tau is a scalar stored in Tau[I]; v - is a real vector,
44509 : so that v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) stored in A(i+2:n-1,i).
44510 :
44511 : -- LAPACK routine (version 3.0) --
44512 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
44513 : Courant Institute, Argonne National Lab, and Rice University
44514 : October 31, 1992
44515 : *************************************************************************/
44516 0 : void rmatrixhessenberg(/* Real */ ae_matrix* a,
44517 : ae_int_t n,
44518 : /* Real */ ae_vector* tau,
44519 : ae_state *_state)
44520 : {
44521 : ae_frame _frame_block;
44522 : ae_int_t i;
44523 : double v;
44524 : ae_vector t;
44525 : ae_vector work;
44526 :
44527 0 : ae_frame_make(_state, &_frame_block);
44528 0 : memset(&t, 0, sizeof(t));
44529 0 : memset(&work, 0, sizeof(work));
44530 0 : ae_vector_clear(tau);
44531 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
44532 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
44533 :
44534 0 : ae_assert(n>=0, "RMatrixHessenberg: incorrect N!", _state);
44535 :
44536 : /*
44537 : * Quick return if possible
44538 : */
44539 0 : if( n<=1 )
44540 : {
44541 0 : ae_frame_leave(_state);
44542 0 : return;
44543 : }
44544 :
44545 : /*
44546 : * Allocate place
44547 : */
44548 0 : ae_vector_set_length(tau, n-2+1, _state);
44549 0 : ae_vector_set_length(&t, n+1, _state);
44550 0 : ae_vector_set_length(&work, n-1+1, _state);
44551 :
44552 : /*
44553 : * MKL version
44554 : */
44555 0 : if( rmatrixhessenbergmkl(a, n, tau, _state) )
44556 : {
44557 0 : ae_frame_leave(_state);
44558 0 : return;
44559 : }
44560 :
44561 : /*
44562 : * ALGLIB version
44563 : */
44564 0 : for(i=0; i<=n-2; i++)
44565 : {
44566 :
44567 : /*
44568 : * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
44569 : */
44570 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
44571 0 : generatereflection(&t, n-i-1, &v, _state);
44572 0 : ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1));
44573 0 : tau->ptr.p_double[i] = v;
44574 0 : t.ptr.p_double[1] = (double)(1);
44575 :
44576 : /*
44577 : * Apply H(i) to A(1:ihi,i+1:ihi) from the right
44578 : */
44579 0 : applyreflectionfromtheright(a, v, &t, 0, n-1, i+1, n-1, &work, _state);
44580 :
44581 : /*
44582 : * Apply H(i) to A(i+1:ihi,i+1:n) from the left
44583 : */
44584 0 : applyreflectionfromtheleft(a, v, &t, i+1, n-1, i+1, n-1, &work, _state);
44585 : }
44586 0 : ae_frame_leave(_state);
44587 : }
44588 :
44589 :
44590 : /*************************************************************************
44591 : Unpacking matrix Q which reduces matrix A to upper Hessenberg form
44592 :
44593 : ! COMMERCIAL EDITION OF ALGLIB:
44594 : !
44595 : ! Commercial Edition of ALGLIB includes following important improvements
44596 : ! of this function:
44597 : ! * high-performance native backend with same C# interface (C# version)
44598 : ! * hardware vendor (Intel) implementations of linear algebra primitives
44599 : ! (C++ and C# versions, x86/x64 platform)
44600 : !
44601 : ! We recommend you to read 'Working with commercial version' section of
44602 : ! ALGLIB Reference Manual in order to find out how to use performance-
44603 : ! related features provided by commercial edition of ALGLIB.
44604 :
44605 : Input parameters:
44606 : A - output of RMatrixHessenberg subroutine.
44607 : N - size of matrix A.
44608 : Tau - scalar factors which are used to form Q.
44609 : Output of RMatrixHessenberg subroutine.
44610 :
44611 : Output parameters:
44612 : Q - matrix Q.
44613 : Array whose indexes range within [0..N-1, 0..N-1].
44614 :
44615 : -- ALGLIB --
44616 : 2005-2010
44617 : Bochkanov Sergey
44618 : *************************************************************************/
44619 0 : void rmatrixhessenbergunpackq(/* Real */ ae_matrix* a,
44620 : ae_int_t n,
44621 : /* Real */ ae_vector* tau,
44622 : /* Real */ ae_matrix* q,
44623 : ae_state *_state)
44624 : {
44625 : ae_frame _frame_block;
44626 : ae_int_t i;
44627 : ae_int_t j;
44628 : ae_vector v;
44629 : ae_vector work;
44630 :
44631 0 : ae_frame_make(_state, &_frame_block);
44632 0 : memset(&v, 0, sizeof(v));
44633 0 : memset(&work, 0, sizeof(work));
44634 0 : ae_matrix_clear(q);
44635 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
44636 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
44637 :
44638 0 : if( n==0 )
44639 : {
44640 0 : ae_frame_leave(_state);
44641 0 : return;
44642 : }
44643 :
44644 : /*
44645 : * init
44646 : */
44647 0 : ae_matrix_set_length(q, n-1+1, n-1+1, _state);
44648 0 : ae_vector_set_length(&v, n-1+1, _state);
44649 0 : ae_vector_set_length(&work, n-1+1, _state);
44650 0 : for(i=0; i<=n-1; i++)
44651 : {
44652 0 : for(j=0; j<=n-1; j++)
44653 : {
44654 0 : if( i==j )
44655 : {
44656 0 : q->ptr.pp_double[i][j] = (double)(1);
44657 : }
44658 : else
44659 : {
44660 0 : q->ptr.pp_double[i][j] = (double)(0);
44661 : }
44662 : }
44663 : }
44664 :
44665 : /*
44666 : * MKL version
44667 : */
44668 0 : if( rmatrixhessenbergunpackqmkl(a, n, tau, q, _state) )
44669 : {
44670 0 : ae_frame_leave(_state);
44671 0 : return;
44672 : }
44673 :
44674 : /*
44675 : * ALGLIB version: unpack Q
44676 : */
44677 0 : for(i=0; i<=n-2; i++)
44678 : {
44679 :
44680 : /*
44681 : * Apply H(i)
44682 : */
44683 0 : ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
44684 0 : v.ptr.p_double[1] = (double)(1);
44685 0 : applyreflectionfromtheright(q, tau->ptr.p_double[i], &v, 0, n-1, i+1, n-1, &work, _state);
44686 : }
44687 0 : ae_frame_leave(_state);
44688 : }
44689 :
44690 :
44691 : /*************************************************************************
44692 : Unpacking matrix H (the result of matrix A reduction to upper Hessenberg form)
44693 :
44694 : Input parameters:
44695 : A - output of RMatrixHessenberg subroutine.
44696 : N - size of matrix A.
44697 :
44698 : Output parameters:
44699 : H - matrix H. Array whose indexes range within [0..N-1, 0..N-1].
44700 :
44701 : -- ALGLIB --
44702 : 2005-2010
44703 : Bochkanov Sergey
44704 : *************************************************************************/
44705 0 : void rmatrixhessenbergunpackh(/* Real */ ae_matrix* a,
44706 : ae_int_t n,
44707 : /* Real */ ae_matrix* h,
44708 : ae_state *_state)
44709 : {
44710 : ae_frame _frame_block;
44711 : ae_int_t i;
44712 : ae_int_t j;
44713 : ae_vector v;
44714 : ae_vector work;
44715 :
44716 0 : ae_frame_make(_state, &_frame_block);
44717 0 : memset(&v, 0, sizeof(v));
44718 0 : memset(&work, 0, sizeof(work));
44719 0 : ae_matrix_clear(h);
44720 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
44721 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
44722 :
44723 0 : if( n==0 )
44724 : {
44725 0 : ae_frame_leave(_state);
44726 0 : return;
44727 : }
44728 0 : ae_matrix_set_length(h, n-1+1, n-1+1, _state);
44729 0 : for(i=0; i<=n-1; i++)
44730 : {
44731 0 : for(j=0; j<=i-2; j++)
44732 : {
44733 0 : h->ptr.pp_double[i][j] = (double)(0);
44734 : }
44735 0 : j = ae_maxint(0, i-1, _state);
44736 0 : ae_v_move(&h->ptr.pp_double[i][j], 1, &a->ptr.pp_double[i][j], 1, ae_v_len(j,n-1));
44737 : }
44738 0 : ae_frame_leave(_state);
44739 : }
44740 :
44741 :
44742 : /*************************************************************************
44743 : Reduction of a symmetric matrix which is given by its higher or lower
44744 : triangular part to a tridiagonal matrix using orthogonal similarity
44745 : transformation: Q'*A*Q=T.
44746 :
44747 : ! COMMERCIAL EDITION OF ALGLIB:
44748 : !
44749 : ! Commercial Edition of ALGLIB includes following important improvements
44750 : ! of this function:
44751 : ! * high-performance native backend with same C# interface (C# version)
44752 : ! * hardware vendor (Intel) implementations of linear algebra primitives
44753 : ! (C++ and C# versions, x86/x64 platform)
44754 : !
44755 : ! We recommend you to read 'Working with commercial version' section of
44756 : ! ALGLIB Reference Manual in order to find out how to use performance-
44757 : ! related features provided by commercial edition of ALGLIB.
44758 :
44759 : Input parameters:
44760 : A - matrix to be transformed
44761 : array with elements [0..N-1, 0..N-1].
44762 : N - size of matrix A.
44763 : IsUpper - storage format. If IsUpper = True, then matrix A is given
44764 : by its upper triangle, and the lower triangle is not used
44765 : and not modified by the algorithm, and vice versa
44766 : if IsUpper = False.
44767 :
44768 : Output parameters:
44769 : A - matrices T and Q in compact form (see lower)
44770 : Tau - array of factors which are forming matrices H(i)
44771 : array with elements [0..N-2].
44772 : D - main diagonal of symmetric matrix T.
44773 : array with elements [0..N-1].
44774 : E - secondary diagonal of symmetric matrix T.
44775 : array with elements [0..N-2].
44776 :
44777 :
44778 : If IsUpper=True, the matrix Q is represented as a product of elementary
44779 : reflectors
44780 :
44781 : Q = H(n-2) . . . H(2) H(0).
44782 :
44783 : Each H(i) has the form
44784 :
44785 : H(i) = I - tau * v * v'
44786 :
44787 : where tau is a real scalar, and v is a real vector with
44788 : v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
44789 : A(0:i-1,i+1), and tau in TAU(i).
44790 :
44791 : If IsUpper=False, the matrix Q is represented as a product of elementary
44792 : reflectors
44793 :
44794 : Q = H(0) H(2) . . . H(n-2).
44795 :
44796 : Each H(i) has the form
44797 :
44798 : H(i) = I - tau * v * v'
44799 :
44800 : where tau is a real scalar, and v is a real vector with
44801 : v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
44802 : and tau in TAU(i).
44803 :
44804 : The contents of A on exit are illustrated by the following examples
44805 : with n = 5:
44806 :
44807 : if UPLO = 'U': if UPLO = 'L':
44808 :
44809 : ( d e v1 v2 v3 ) ( d )
44810 : ( d e v2 v3 ) ( e d )
44811 : ( d e v3 ) ( v0 e d )
44812 : ( d e ) ( v0 v1 e d )
44813 : ( d ) ( v0 v1 v2 e d )
44814 :
44815 : where d and e denote diagonal and off-diagonal elements of T, and vi
44816 : denotes an element of the vector defining H(i).
44817 :
44818 : -- LAPACK routine (version 3.0) --
44819 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
44820 : Courant Institute, Argonne National Lab, and Rice University
44821 : October 31, 1992
44822 : *************************************************************************/
44823 0 : void smatrixtd(/* Real */ ae_matrix* a,
44824 : ae_int_t n,
44825 : ae_bool isupper,
44826 : /* Real */ ae_vector* tau,
44827 : /* Real */ ae_vector* d,
44828 : /* Real */ ae_vector* e,
44829 : ae_state *_state)
44830 : {
44831 : ae_frame _frame_block;
44832 : ae_int_t i;
44833 : double alpha;
44834 : double taui;
44835 : double v;
44836 : ae_vector t;
44837 : ae_vector t2;
44838 : ae_vector t3;
44839 :
44840 0 : ae_frame_make(_state, &_frame_block);
44841 0 : memset(&t, 0, sizeof(t));
44842 0 : memset(&t2, 0, sizeof(t2));
44843 0 : memset(&t3, 0, sizeof(t3));
44844 0 : ae_vector_clear(tau);
44845 0 : ae_vector_clear(d);
44846 0 : ae_vector_clear(e);
44847 0 : ae_vector_init(&t, 0, DT_REAL, _state, ae_true);
44848 0 : ae_vector_init(&t2, 0, DT_REAL, _state, ae_true);
44849 0 : ae_vector_init(&t3, 0, DT_REAL, _state, ae_true);
44850 :
44851 0 : if( n<=0 )
44852 : {
44853 0 : ae_frame_leave(_state);
44854 0 : return;
44855 : }
44856 0 : ae_vector_set_length(&t, n+1, _state);
44857 0 : ae_vector_set_length(&t2, n+1, _state);
44858 0 : ae_vector_set_length(&t3, n+1, _state);
44859 0 : if( n>1 )
44860 : {
44861 0 : ae_vector_set_length(tau, n-2+1, _state);
44862 : }
44863 0 : ae_vector_set_length(d, n-1+1, _state);
44864 0 : if( n>1 )
44865 : {
44866 0 : ae_vector_set_length(e, n-2+1, _state);
44867 : }
44868 :
44869 : /*
44870 : * Try to use MKL
44871 : */
44872 0 : if( smatrixtdmkl(a, n, isupper, tau, d, e, _state) )
44873 : {
44874 0 : ae_frame_leave(_state);
44875 0 : return;
44876 : }
44877 :
44878 : /*
44879 : * ALGLIB version
44880 : */
44881 0 : if( isupper )
44882 : {
44883 :
44884 : /*
44885 : * Reduce the upper triangle of A
44886 : */
44887 0 : for(i=n-2; i>=0; i--)
44888 : {
44889 :
44890 : /*
44891 : * Generate elementary reflector H() = E - tau * v * v'
44892 : */
44893 0 : if( i>=1 )
44894 : {
44895 0 : ae_v_move(&t.ptr.p_double[2], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(2,i+1));
44896 : }
44897 0 : t.ptr.p_double[1] = a->ptr.pp_double[i][i+1];
44898 0 : generatereflection(&t, i+1, &taui, _state);
44899 0 : if( i>=1 )
44900 : {
44901 0 : ae_v_move(&a->ptr.pp_double[0][i+1], a->stride, &t.ptr.p_double[2], 1, ae_v_len(0,i-1));
44902 : }
44903 0 : a->ptr.pp_double[i][i+1] = t.ptr.p_double[1];
44904 0 : e->ptr.p_double[i] = a->ptr.pp_double[i][i+1];
44905 0 : if( ae_fp_neq(taui,(double)(0)) )
44906 : {
44907 :
44908 : /*
44909 : * Apply H from both sides to A
44910 : */
44911 0 : a->ptr.pp_double[i][i+1] = (double)(1);
44912 :
44913 : /*
44914 : * Compute x := tau * A * v storing x in TAU
44915 : */
44916 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1));
44917 0 : symmetricmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t3, _state);
44918 0 : ae_v_move(&tau->ptr.p_double[0], 1, &t3.ptr.p_double[1], 1, ae_v_len(0,i));
44919 :
44920 : /*
44921 : * Compute w := x - 1/2 * tau * (x'*v) * v
44922 : */
44923 0 : v = ae_v_dotproduct(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i));
44924 0 : alpha = -0.5*taui*v;
44925 0 : ae_v_addd(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i), alpha);
44926 :
44927 : /*
44928 : * Apply the transformation as a rank-2 update:
44929 : * A := A - v * w' - w * v'
44930 : */
44931 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1));
44932 0 : ae_v_move(&t3.ptr.p_double[1], 1, &tau->ptr.p_double[0], 1, ae_v_len(1,i+1));
44933 0 : symmetricrank2update(a, isupper, 0, i, &t, &t3, &t2, (double)(-1), _state);
44934 0 : a->ptr.pp_double[i][i+1] = e->ptr.p_double[i];
44935 : }
44936 0 : d->ptr.p_double[i+1] = a->ptr.pp_double[i+1][i+1];
44937 0 : tau->ptr.p_double[i] = taui;
44938 : }
44939 0 : d->ptr.p_double[0] = a->ptr.pp_double[0][0];
44940 : }
44941 : else
44942 : {
44943 :
44944 : /*
44945 : * Reduce the lower triangle of A
44946 : */
44947 0 : for(i=0; i<=n-2; i++)
44948 : {
44949 :
44950 : /*
44951 : * Generate elementary reflector H = E - tau * v * v'
44952 : */
44953 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
44954 0 : generatereflection(&t, n-i-1, &taui, _state);
44955 0 : ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1));
44956 0 : e->ptr.p_double[i] = a->ptr.pp_double[i+1][i];
44957 0 : if( ae_fp_neq(taui,(double)(0)) )
44958 : {
44959 :
44960 : /*
44961 : * Apply H from both sides to A
44962 : */
44963 0 : a->ptr.pp_double[i+1][i] = (double)(1);
44964 :
44965 : /*
44966 : * Compute x := tau * A * v storing y in TAU
44967 : */
44968 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
44969 0 : symmetricmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state);
44970 0 : ae_v_move(&tau->ptr.p_double[i], 1, &t2.ptr.p_double[1], 1, ae_v_len(i,n-2));
44971 :
44972 : /*
44973 : * Compute w := x - 1/2 * tau * (x'*v) * v
44974 : */
44975 0 : v = ae_v_dotproduct(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2));
44976 0 : alpha = -0.5*taui*v;
44977 0 : ae_v_addd(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2), alpha);
44978 :
44979 : /*
44980 : * Apply the transformation as a rank-2 update:
44981 : * A := A - v * w' - w * v'
44982 : *
44983 : */
44984 0 : ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
44985 0 : ae_v_move(&t2.ptr.p_double[1], 1, &tau->ptr.p_double[i], 1, ae_v_len(1,n-i-1));
44986 0 : symmetricrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, (double)(-1), _state);
44987 0 : a->ptr.pp_double[i+1][i] = e->ptr.p_double[i];
44988 : }
44989 0 : d->ptr.p_double[i] = a->ptr.pp_double[i][i];
44990 0 : tau->ptr.p_double[i] = taui;
44991 : }
44992 0 : d->ptr.p_double[n-1] = a->ptr.pp_double[n-1][n-1];
44993 : }
44994 0 : ae_frame_leave(_state);
44995 : }
44996 :
44997 :
44998 : /*************************************************************************
44999 : Unpacking matrix Q which reduces symmetric matrix to a tridiagonal
45000 : form.
45001 :
45002 : ! COMMERCIAL EDITION OF ALGLIB:
45003 : !
45004 : ! Commercial Edition of ALGLIB includes following important improvements
45005 : ! of this function:
45006 : ! * high-performance native backend with same C# interface (C# version)
45007 : ! * hardware vendor (Intel) implementations of linear algebra primitives
45008 : ! (C++ and C# versions, x86/x64 platform)
45009 : !
45010 : ! We recommend you to read 'Working with commercial version' section of
45011 : ! ALGLIB Reference Manual in order to find out how to use performance-
45012 : ! related features provided by commercial edition of ALGLIB.
45013 :
45014 : Input parameters:
45015 : A - the result of a SMatrixTD subroutine
45016 : N - size of matrix A.
45017 : IsUpper - storage format (a parameter of SMatrixTD subroutine)
45018 : Tau - the result of a SMatrixTD subroutine
45019 :
45020 : Output parameters:
45021 : Q - transformation matrix.
45022 : array with elements [0..N-1, 0..N-1].
45023 :
45024 : -- ALGLIB --
45025 : Copyright 2005-2010 by Bochkanov Sergey
45026 : *************************************************************************/
45027 0 : void smatrixtdunpackq(/* Real */ ae_matrix* a,
45028 : ae_int_t n,
45029 : ae_bool isupper,
45030 : /* Real */ ae_vector* tau,
45031 : /* Real */ ae_matrix* q,
45032 : ae_state *_state)
45033 : {
45034 : ae_frame _frame_block;
45035 : ae_int_t i;
45036 : ae_int_t j;
45037 : ae_vector v;
45038 : ae_vector work;
45039 :
45040 0 : ae_frame_make(_state, &_frame_block);
45041 0 : memset(&v, 0, sizeof(v));
45042 0 : memset(&work, 0, sizeof(work));
45043 0 : ae_matrix_clear(q);
45044 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
45045 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
45046 :
45047 0 : if( n==0 )
45048 : {
45049 0 : ae_frame_leave(_state);
45050 0 : return;
45051 : }
45052 :
45053 : /*
45054 : * init
45055 : */
45056 0 : ae_matrix_set_length(q, n-1+1, n-1+1, _state);
45057 0 : ae_vector_set_length(&v, n+1, _state);
45058 0 : ae_vector_set_length(&work, n-1+1, _state);
45059 0 : for(i=0; i<=n-1; i++)
45060 : {
45061 0 : for(j=0; j<=n-1; j++)
45062 : {
45063 0 : if( i==j )
45064 : {
45065 0 : q->ptr.pp_double[i][j] = (double)(1);
45066 : }
45067 : else
45068 : {
45069 0 : q->ptr.pp_double[i][j] = (double)(0);
45070 : }
45071 : }
45072 : }
45073 :
45074 : /*
45075 : * MKL version
45076 : */
45077 0 : if( smatrixtdunpackqmkl(a, n, isupper, tau, q, _state) )
45078 : {
45079 0 : ae_frame_leave(_state);
45080 0 : return;
45081 : }
45082 :
45083 : /*
45084 : * ALGLIB version: unpack Q
45085 : */
45086 0 : if( isupper )
45087 : {
45088 0 : for(i=0; i<=n-2; i++)
45089 : {
45090 :
45091 : /*
45092 : * Apply H(i)
45093 : */
45094 0 : ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1));
45095 0 : v.ptr.p_double[i+1] = (double)(1);
45096 0 : applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, 0, i, 0, n-1, &work, _state);
45097 : }
45098 : }
45099 : else
45100 : {
45101 0 : for(i=n-2; i>=0; i--)
45102 : {
45103 :
45104 : /*
45105 : * Apply H(i)
45106 : */
45107 0 : ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1));
45108 0 : v.ptr.p_double[1] = (double)(1);
45109 0 : applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, i+1, n-1, 0, n-1, &work, _state);
45110 : }
45111 : }
45112 0 : ae_frame_leave(_state);
45113 : }
45114 :
45115 :
45116 : /*************************************************************************
45117 : Reduction of a Hermitian matrix which is given by its higher or lower
45118 : triangular part to a real tridiagonal matrix using unitary similarity
45119 : transformation: Q'*A*Q = T.
45120 :
45121 : ! COMMERCIAL EDITION OF ALGLIB:
45122 : !
45123 : ! Commercial Edition of ALGLIB includes following important improvements
45124 : ! of this function:
45125 : ! * high-performance native backend with same C# interface (C# version)
45126 : ! * hardware vendor (Intel) implementations of linear algebra primitives
45127 : ! (C++ and C# versions, x86/x64 platform)
45128 : !
45129 : ! We recommend you to read 'Working with commercial version' section of
45130 : ! ALGLIB Reference Manual in order to find out how to use performance-
45131 : ! related features provided by commercial edition of ALGLIB.
45132 :
45133 : Input parameters:
45134 : A - matrix to be transformed
45135 : array with elements [0..N-1, 0..N-1].
45136 : N - size of matrix A.
45137 : IsUpper - storage format. If IsUpper = True, then matrix A is given
45138 : by its upper triangle, and the lower triangle is not used
45139 : and not modified by the algorithm, and vice versa
45140 : if IsUpper = False.
45141 :
45142 : Output parameters:
45143 : A - matrices T and Q in compact form (see lower)
45144 : Tau - array of factors which are forming matrices H(i)
45145 : array with elements [0..N-2].
45146 : D - main diagonal of real symmetric matrix T.
45147 : array with elements [0..N-1].
45148 : E - secondary diagonal of real symmetric matrix T.
45149 : array with elements [0..N-2].
45150 :
45151 :
45152 : If IsUpper=True, the matrix Q is represented as a product of elementary
45153 : reflectors
45154 :
45155 : Q = H(n-2) . . . H(2) H(0).
45156 :
45157 : Each H(i) has the form
45158 :
45159 : H(i) = I - tau * v * v'
45160 :
45161 : where tau is a complex scalar, and v is a complex vector with
45162 : v(i+1:n-1) = 0, v(i) = 1, v(0:i-1) is stored on exit in
45163 : A(0:i-1,i+1), and tau in TAU(i).
45164 :
45165 : If IsUpper=False, the matrix Q is represented as a product of elementary
45166 : reflectors
45167 :
45168 : Q = H(0) H(2) . . . H(n-2).
45169 :
45170 : Each H(i) has the form
45171 :
45172 : H(i) = I - tau * v * v'
45173 :
45174 : where tau is a complex scalar, and v is a complex vector with
45175 : v(0:i) = 0, v(i+1) = 1, v(i+2:n-1) is stored on exit in A(i+2:n-1,i),
45176 : and tau in TAU(i).
45177 :
45178 : The contents of A on exit are illustrated by the following examples
45179 : with n = 5:
45180 :
45181 : if UPLO = 'U': if UPLO = 'L':
45182 :
45183 : ( d e v1 v2 v3 ) ( d )
45184 : ( d e v2 v3 ) ( e d )
45185 : ( d e v3 ) ( v0 e d )
45186 : ( d e ) ( v0 v1 e d )
45187 : ( d ) ( v0 v1 v2 e d )
45188 :
45189 : where d and e denote diagonal and off-diagonal elements of T, and vi
45190 : denotes an element of the vector defining H(i).
45191 :
45192 : -- LAPACK routine (version 3.0) --
45193 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
45194 : Courant Institute, Argonne National Lab, and Rice University
45195 : October 31, 1992
45196 : *************************************************************************/
45197 0 : void hmatrixtd(/* Complex */ ae_matrix* a,
45198 : ae_int_t n,
45199 : ae_bool isupper,
45200 : /* Complex */ ae_vector* tau,
45201 : /* Real */ ae_vector* d,
45202 : /* Real */ ae_vector* e,
45203 : ae_state *_state)
45204 : {
45205 : ae_frame _frame_block;
45206 : ae_int_t i;
45207 : ae_complex alpha;
45208 : ae_complex taui;
45209 : ae_complex v;
45210 : ae_vector t;
45211 : ae_vector t2;
45212 : ae_vector t3;
45213 :
45214 0 : ae_frame_make(_state, &_frame_block);
45215 0 : memset(&t, 0, sizeof(t));
45216 0 : memset(&t2, 0, sizeof(t2));
45217 0 : memset(&t3, 0, sizeof(t3));
45218 0 : ae_vector_clear(tau);
45219 0 : ae_vector_clear(d);
45220 0 : ae_vector_clear(e);
45221 0 : ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true);
45222 0 : ae_vector_init(&t2, 0, DT_COMPLEX, _state, ae_true);
45223 0 : ae_vector_init(&t3, 0, DT_COMPLEX, _state, ae_true);
45224 :
45225 :
45226 : /*
45227 : * Init and test
45228 : */
45229 0 : if( n<=0 )
45230 : {
45231 0 : ae_frame_leave(_state);
45232 0 : return;
45233 : }
45234 0 : for(i=0; i<=n-1; i++)
45235 : {
45236 0 : ae_assert(ae_fp_eq(a->ptr.pp_complex[i][i].y,(double)(0)), "Assertion failed", _state);
45237 : }
45238 0 : if( n>1 )
45239 : {
45240 0 : ae_vector_set_length(tau, n-2+1, _state);
45241 0 : ae_vector_set_length(e, n-2+1, _state);
45242 : }
45243 0 : ae_vector_set_length(d, n-1+1, _state);
45244 0 : ae_vector_set_length(&t, n-1+1, _state);
45245 0 : ae_vector_set_length(&t2, n-1+1, _state);
45246 0 : ae_vector_set_length(&t3, n-1+1, _state);
45247 :
45248 : /*
45249 : * MKL version
45250 : */
45251 0 : if( hmatrixtdmkl(a, n, isupper, tau, d, e, _state) )
45252 : {
45253 0 : ae_frame_leave(_state);
45254 0 : return;
45255 : }
45256 :
45257 : /*
45258 : * ALGLIB version
45259 : */
45260 0 : if( isupper )
45261 : {
45262 :
45263 : /*
45264 : * Reduce the upper triangle of A
45265 : */
45266 0 : a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(a->ptr.pp_complex[n-1][n-1].x);
45267 0 : for(i=n-2; i>=0; i--)
45268 : {
45269 :
45270 : /*
45271 : * Generate elementary reflector H = I+1 - tau * v * v'
45272 : */
45273 0 : alpha = a->ptr.pp_complex[i][i+1];
45274 0 : t.ptr.p_complex[1] = alpha;
45275 0 : if( i>=1 )
45276 : {
45277 0 : ae_v_cmove(&t.ptr.p_complex[2], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(2,i+1));
45278 : }
45279 0 : complexgeneratereflection(&t, i+1, &taui, _state);
45280 0 : if( i>=1 )
45281 : {
45282 0 : ae_v_cmove(&a->ptr.pp_complex[0][i+1], a->stride, &t.ptr.p_complex[2], 1, "N", ae_v_len(0,i-1));
45283 : }
45284 0 : alpha = t.ptr.p_complex[1];
45285 0 : e->ptr.p_double[i] = alpha.x;
45286 0 : if( ae_c_neq_d(taui,(double)(0)) )
45287 : {
45288 :
45289 : /*
45290 : * Apply H(I+1) from both sides to A
45291 : */
45292 0 : a->ptr.pp_complex[i][i+1] = ae_complex_from_i(1);
45293 :
45294 : /*
45295 : * Compute x := tau * A * v storing x in TAU
45296 : */
45297 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1));
45298 0 : hermitianmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t2, _state);
45299 0 : ae_v_cmove(&tau->ptr.p_complex[0], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(0,i));
45300 :
45301 : /*
45302 : * Compute w := x - 1/2 * tau * (x'*v) * v
45303 : */
45304 0 : v = ae_v_cdotproduct(&tau->ptr.p_complex[0], 1, "Conj", &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i));
45305 0 : alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v));
45306 0 : ae_v_caddc(&tau->ptr.p_complex[0], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i), alpha);
45307 :
45308 : /*
45309 : * Apply the transformation as a rank-2 update:
45310 : * A := A - v * w' - w * v'
45311 : */
45312 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1));
45313 0 : ae_v_cmove(&t3.ptr.p_complex[1], 1, &tau->ptr.p_complex[0], 1, "N", ae_v_len(1,i+1));
45314 0 : hermitianrank2update(a, isupper, 0, i, &t, &t3, &t2, ae_complex_from_i(-1), _state);
45315 : }
45316 : else
45317 : {
45318 0 : a->ptr.pp_complex[i][i] = ae_complex_from_d(a->ptr.pp_complex[i][i].x);
45319 : }
45320 0 : a->ptr.pp_complex[i][i+1] = ae_complex_from_d(e->ptr.p_double[i]);
45321 0 : d->ptr.p_double[i+1] = a->ptr.pp_complex[i+1][i+1].x;
45322 0 : tau->ptr.p_complex[i] = taui;
45323 : }
45324 0 : d->ptr.p_double[0] = a->ptr.pp_complex[0][0].x;
45325 : }
45326 : else
45327 : {
45328 :
45329 : /*
45330 : * Reduce the lower triangle of A
45331 : */
45332 0 : a->ptr.pp_complex[0][0] = ae_complex_from_d(a->ptr.pp_complex[0][0].x);
45333 0 : for(i=0; i<=n-2; i++)
45334 : {
45335 :
45336 : /*
45337 : * Generate elementary reflector H = I - tau * v * v'
45338 : */
45339 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1));
45340 0 : complexgeneratereflection(&t, n-i-1, &taui, _state);
45341 0 : ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &t.ptr.p_complex[1], 1, "N", ae_v_len(i+1,n-1));
45342 0 : e->ptr.p_double[i] = a->ptr.pp_complex[i+1][i].x;
45343 0 : if( ae_c_neq_d(taui,(double)(0)) )
45344 : {
45345 :
45346 : /*
45347 : * Apply H(i) from both sides to A(i+1:n,i+1:n)
45348 : */
45349 0 : a->ptr.pp_complex[i+1][i] = ae_complex_from_i(1);
45350 :
45351 : /*
45352 : * Compute x := tau * A * v storing y in TAU
45353 : */
45354 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1));
45355 0 : hermitianmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state);
45356 0 : ae_v_cmove(&tau->ptr.p_complex[i], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(i,n-2));
45357 :
45358 : /*
45359 : * Compute w := x - 1/2 * tau * (x'*v) * v
45360 : */
45361 0 : v = ae_v_cdotproduct(&tau->ptr.p_complex[i], 1, "Conj", &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2));
45362 0 : alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v));
45363 0 : ae_v_caddc(&tau->ptr.p_complex[i], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2), alpha);
45364 :
45365 : /*
45366 : * Apply the transformation as a rank-2 update:
45367 : * A := A - v * w' - w * v'
45368 : */
45369 0 : ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1));
45370 0 : ae_v_cmove(&t2.ptr.p_complex[1], 1, &tau->ptr.p_complex[i], 1, "N", ae_v_len(1,n-i-1));
45371 0 : hermitianrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, ae_complex_from_i(-1), _state);
45372 : }
45373 : else
45374 : {
45375 0 : a->ptr.pp_complex[i+1][i+1] = ae_complex_from_d(a->ptr.pp_complex[i+1][i+1].x);
45376 : }
45377 0 : a->ptr.pp_complex[i+1][i] = ae_complex_from_d(e->ptr.p_double[i]);
45378 0 : d->ptr.p_double[i] = a->ptr.pp_complex[i][i].x;
45379 0 : tau->ptr.p_complex[i] = taui;
45380 : }
45381 0 : d->ptr.p_double[n-1] = a->ptr.pp_complex[n-1][n-1].x;
45382 : }
45383 0 : ae_frame_leave(_state);
45384 : }
45385 :
45386 :
45387 : /*************************************************************************
45388 : Unpacking matrix Q which reduces a Hermitian matrix to a real tridiagonal
45389 : form.
45390 :
45391 : ! COMMERCIAL EDITION OF ALGLIB:
45392 : !
45393 : ! Commercial Edition of ALGLIB includes following important improvements
45394 : ! of this function:
45395 : ! * high-performance native backend with same C# interface (C# version)
45396 : ! * hardware vendor (Intel) implementations of linear algebra primitives
45397 : ! (C++ and C# versions, x86/x64 platform)
45398 : !
45399 : ! We recommend you to read 'Working with commercial version' section of
45400 : ! ALGLIB Reference Manual in order to find out how to use performance-
45401 : ! related features provided by commercial edition of ALGLIB.
45402 :
45403 : Input parameters:
45404 : A - the result of a HMatrixTD subroutine
45405 : N - size of matrix A.
45406 : IsUpper - storage format (a parameter of HMatrixTD subroutine)
45407 : Tau - the result of a HMatrixTD subroutine
45408 :
45409 : Output parameters:
45410 : Q - transformation matrix.
45411 : array with elements [0..N-1, 0..N-1].
45412 :
45413 : -- ALGLIB --
45414 : Copyright 2005-2010 by Bochkanov Sergey
45415 : *************************************************************************/
45416 0 : void hmatrixtdunpackq(/* Complex */ ae_matrix* a,
45417 : ae_int_t n,
45418 : ae_bool isupper,
45419 : /* Complex */ ae_vector* tau,
45420 : /* Complex */ ae_matrix* q,
45421 : ae_state *_state)
45422 : {
45423 : ae_frame _frame_block;
45424 : ae_int_t i;
45425 : ae_int_t j;
45426 : ae_vector v;
45427 : ae_vector work;
45428 :
45429 0 : ae_frame_make(_state, &_frame_block);
45430 0 : memset(&v, 0, sizeof(v));
45431 0 : memset(&work, 0, sizeof(work));
45432 0 : ae_matrix_clear(q);
45433 0 : ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true);
45434 0 : ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true);
45435 :
45436 0 : if( n==0 )
45437 : {
45438 0 : ae_frame_leave(_state);
45439 0 : return;
45440 : }
45441 :
45442 : /*
45443 : * init
45444 : */
45445 0 : ae_matrix_set_length(q, n-1+1, n-1+1, _state);
45446 0 : ae_vector_set_length(&v, n+1, _state);
45447 0 : ae_vector_set_length(&work, n-1+1, _state);
45448 :
45449 : /*
45450 : * MKL version
45451 : */
45452 0 : if( hmatrixtdunpackqmkl(a, n, isupper, tau, q, _state) )
45453 : {
45454 0 : ae_frame_leave(_state);
45455 0 : return;
45456 : }
45457 :
45458 : /*
45459 : * ALGLIB version
45460 : */
45461 0 : for(i=0; i<=n-1; i++)
45462 : {
45463 0 : for(j=0; j<=n-1; j++)
45464 : {
45465 0 : if( i==j )
45466 : {
45467 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(1);
45468 : }
45469 : else
45470 : {
45471 0 : q->ptr.pp_complex[i][j] = ae_complex_from_i(0);
45472 : }
45473 : }
45474 : }
45475 0 : if( isupper )
45476 : {
45477 0 : for(i=0; i<=n-2; i++)
45478 : {
45479 :
45480 : /*
45481 : * Apply H(i)
45482 : */
45483 0 : ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1));
45484 0 : v.ptr.p_complex[i+1] = ae_complex_from_i(1);
45485 0 : complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, 0, i, 0, n-1, &work, _state);
45486 : }
45487 : }
45488 : else
45489 : {
45490 0 : for(i=n-2; i>=0; i--)
45491 : {
45492 :
45493 : /*
45494 : * Apply H(i)
45495 : */
45496 0 : ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1));
45497 0 : v.ptr.p_complex[1] = ae_complex_from_i(1);
45498 0 : complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, i+1, n-1, 0, n-1, &work, _state);
45499 : }
45500 : }
45501 0 : ae_frame_leave(_state);
45502 : }
45503 :
45504 :
45505 : /*************************************************************************
45506 : Base case for complex QR
45507 :
45508 : -- LAPACK routine (version 3.0) --
45509 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
45510 : Courant Institute, Argonne National Lab, and Rice University
45511 : September 30, 1994.
45512 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
45513 : pseudocode, 2007-2010.
45514 : *************************************************************************/
45515 0 : static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a,
45516 : ae_int_t m,
45517 : ae_int_t n,
45518 : /* Complex */ ae_vector* work,
45519 : /* Complex */ ae_vector* t,
45520 : /* Complex */ ae_vector* tau,
45521 : ae_state *_state)
45522 : {
45523 : ae_int_t i;
45524 : ae_int_t k;
45525 : ae_int_t mmi;
45526 : ae_int_t minmn;
45527 : ae_complex tmp;
45528 :
45529 :
45530 0 : minmn = ae_minint(m, n, _state);
45531 0 : if( minmn<=0 )
45532 : {
45533 0 : return;
45534 : }
45535 :
45536 : /*
45537 : * Test the input arguments
45538 : */
45539 0 : k = ae_minint(m, n, _state);
45540 0 : for(i=0; i<=k-1; i++)
45541 : {
45542 :
45543 : /*
45544 : * Generate elementary reflector H(i) to annihilate A(i+1:m,i)
45545 : */
45546 0 : mmi = m-i;
45547 0 : ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], a->stride, "N", ae_v_len(1,mmi));
45548 0 : complexgeneratereflection(t, mmi, &tmp, _state);
45549 0 : tau->ptr.p_complex[i] = tmp;
45550 0 : ae_v_cmove(&a->ptr.pp_complex[i][i], a->stride, &t->ptr.p_complex[1], 1, "N", ae_v_len(i,m-1));
45551 0 : t->ptr.p_complex[1] = ae_complex_from_i(1);
45552 0 : if( i<n-1 )
45553 : {
45554 :
45555 : /*
45556 : * Apply H'(i) to A(i:m,i+1:n) from the left
45557 : */
45558 0 : complexapplyreflectionfromtheleft(a, ae_c_conj(tau->ptr.p_complex[i], _state), t, i, m-1, i+1, n-1, work, _state);
45559 : }
45560 : }
45561 : }
45562 :
45563 :
45564 : /*************************************************************************
45565 : Base case for complex LQ
45566 :
45567 : -- LAPACK routine (version 3.0) --
45568 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
45569 : Courant Institute, Argonne National Lab, and Rice University
45570 : September 30, 1994.
45571 : Sergey Bochkanov, ALGLIB project, translation from FORTRAN to
45572 : pseudocode, 2007-2010.
45573 : *************************************************************************/
45574 0 : static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a,
45575 : ae_int_t m,
45576 : ae_int_t n,
45577 : /* Complex */ ae_vector* work,
45578 : /* Complex */ ae_vector* t,
45579 : /* Complex */ ae_vector* tau,
45580 : ae_state *_state)
45581 : {
45582 : ae_int_t i;
45583 : ae_int_t minmn;
45584 : ae_complex tmp;
45585 :
45586 :
45587 0 : minmn = ae_minint(m, n, _state);
45588 0 : if( minmn<=0 )
45589 : {
45590 0 : return;
45591 : }
45592 :
45593 : /*
45594 : * Test the input arguments
45595 : */
45596 0 : for(i=0; i<=minmn-1; i++)
45597 : {
45598 :
45599 : /*
45600 : * Generate elementary reflector H(i)
45601 : *
45602 : * NOTE: ComplexGenerateReflection() generates left reflector,
45603 : * i.e. H which reduces x by applyiong from the left, but we
45604 : * need RIGHT reflector. So we replace H=E-tau*v*v' by H^H,
45605 : * which changes v to conj(v).
45606 : */
45607 0 : ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,n-i));
45608 0 : complexgeneratereflection(t, n-i, &tmp, _state);
45609 0 : tau->ptr.p_complex[i] = tmp;
45610 0 : ae_v_cmove(&a->ptr.pp_complex[i][i], 1, &t->ptr.p_complex[1], 1, "Conj", ae_v_len(i,n-1));
45611 0 : t->ptr.p_complex[1] = ae_complex_from_i(1);
45612 0 : if( i<m-1 )
45613 : {
45614 :
45615 : /*
45616 : * Apply H'(i)
45617 : */
45618 0 : complexapplyreflectionfromtheright(a, tau->ptr.p_complex[i], t, i+1, m-1, i, n-1, work, _state);
45619 : }
45620 : }
45621 : }
45622 :
45623 :
45624 : /*************************************************************************
45625 : Generate block reflector:
45626 : * fill unused parts of reflectors matrix by zeros
45627 : * fill diagonal of reflectors matrix by ones
45628 : * generate triangular factor T
45629 :
45630 : PARAMETERS:
45631 : A - either LengthA*BlockSize (if ColumnwiseA) or
45632 : BlockSize*LengthA (if not ColumnwiseA) matrix of
45633 : elementary reflectors.
45634 : Modified on exit.
45635 : Tau - scalar factors
45636 : ColumnwiseA - reflectors are stored in rows or in columns
45637 : LengthA - length of largest reflector
45638 : BlockSize - number of reflectors
45639 : T - array[BlockSize,2*BlockSize]. Left BlockSize*BlockSize
45640 : submatrix stores triangular factor on exit.
45641 : WORK - array[BlockSize]
45642 :
45643 : -- ALGLIB routine --
45644 : 17.02.2010
45645 : Bochkanov Sergey
45646 : *************************************************************************/
45647 0 : static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a,
45648 : /* Real */ ae_vector* tau,
45649 : ae_bool columnwisea,
45650 : ae_int_t lengtha,
45651 : ae_int_t blocksize,
45652 : /* Real */ ae_matrix* t,
45653 : /* Real */ ae_vector* work,
45654 : ae_state *_state)
45655 : {
45656 : ae_int_t i;
45657 : ae_int_t j;
45658 : ae_int_t k;
45659 : double v;
45660 :
45661 :
45662 :
45663 : /*
45664 : * fill beginning of new column with zeros,
45665 : * load 1.0 in the first non-zero element
45666 : */
45667 0 : for(k=0; k<=blocksize-1; k++)
45668 : {
45669 0 : if( columnwisea )
45670 : {
45671 0 : for(i=0; i<=k-1; i++)
45672 : {
45673 0 : a->ptr.pp_double[i][k] = (double)(0);
45674 : }
45675 : }
45676 : else
45677 : {
45678 0 : for(i=0; i<=k-1; i++)
45679 : {
45680 0 : a->ptr.pp_double[k][i] = (double)(0);
45681 : }
45682 : }
45683 0 : a->ptr.pp_double[k][k] = (double)(1);
45684 : }
45685 :
45686 : /*
45687 : * Calculate Gram matrix of A
45688 : */
45689 0 : for(i=0; i<=blocksize-1; i++)
45690 : {
45691 0 : for(j=0; j<=blocksize-1; j++)
45692 : {
45693 0 : t->ptr.pp_double[i][blocksize+j] = (double)(0);
45694 : }
45695 : }
45696 0 : for(k=0; k<=lengtha-1; k++)
45697 : {
45698 0 : for(j=1; j<=blocksize-1; j++)
45699 : {
45700 0 : if( columnwisea )
45701 : {
45702 0 : v = a->ptr.pp_double[k][j];
45703 0 : if( ae_fp_neq(v,(double)(0)) )
45704 : {
45705 0 : ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[k][0], 1, ae_v_len(blocksize,blocksize+j-1), v);
45706 : }
45707 : }
45708 : else
45709 : {
45710 0 : v = a->ptr.pp_double[j][k];
45711 0 : if( ae_fp_neq(v,(double)(0)) )
45712 : {
45713 0 : ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[0][k], a->stride, ae_v_len(blocksize,blocksize+j-1), v);
45714 : }
45715 : }
45716 : }
45717 : }
45718 :
45719 : /*
45720 : * Prepare Y (stored in TmpA) and T (stored in TmpT)
45721 : */
45722 0 : for(k=0; k<=blocksize-1; k++)
45723 : {
45724 :
45725 : /*
45726 : * fill non-zero part of T, use pre-calculated Gram matrix
45727 : */
45728 0 : ae_v_move(&work->ptr.p_double[0], 1, &t->ptr.pp_double[k][blocksize], 1, ae_v_len(0,k-1));
45729 0 : for(i=0; i<=k-1; i++)
45730 : {
45731 0 : v = ae_v_dotproduct(&t->ptr.pp_double[i][i], 1, &work->ptr.p_double[i], 1, ae_v_len(i,k-1));
45732 0 : t->ptr.pp_double[i][k] = -tau->ptr.p_double[k]*v;
45733 : }
45734 0 : t->ptr.pp_double[k][k] = -tau->ptr.p_double[k];
45735 :
45736 : /*
45737 : * Rest of T is filled by zeros
45738 : */
45739 0 : for(i=k+1; i<=blocksize-1; i++)
45740 : {
45741 0 : t->ptr.pp_double[i][k] = (double)(0);
45742 : }
45743 : }
45744 0 : }
45745 :
45746 :
45747 : /*************************************************************************
45748 : Generate block reflector (complex):
45749 : * fill unused parts of reflectors matrix by zeros
45750 : * fill diagonal of reflectors matrix by ones
45751 : * generate triangular factor T
45752 :
45753 :
45754 : -- ALGLIB routine --
45755 : 17.02.2010
45756 : Bochkanov Sergey
45757 : *************************************************************************/
45758 0 : static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a,
45759 : /* Complex */ ae_vector* tau,
45760 : ae_bool columnwisea,
45761 : ae_int_t lengtha,
45762 : ae_int_t blocksize,
45763 : /* Complex */ ae_matrix* t,
45764 : /* Complex */ ae_vector* work,
45765 : ae_state *_state)
45766 : {
45767 : ae_int_t i;
45768 : ae_int_t k;
45769 : ae_complex v;
45770 :
45771 :
45772 :
45773 : /*
45774 : * Prepare Y (stored in TmpA) and T (stored in TmpT)
45775 : */
45776 0 : for(k=0; k<=blocksize-1; k++)
45777 : {
45778 :
45779 : /*
45780 : * fill beginning of new column with zeros,
45781 : * load 1.0 in the first non-zero element
45782 : */
45783 0 : if( columnwisea )
45784 : {
45785 0 : for(i=0; i<=k-1; i++)
45786 : {
45787 0 : a->ptr.pp_complex[i][k] = ae_complex_from_i(0);
45788 : }
45789 : }
45790 : else
45791 : {
45792 0 : for(i=0; i<=k-1; i++)
45793 : {
45794 0 : a->ptr.pp_complex[k][i] = ae_complex_from_i(0);
45795 : }
45796 : }
45797 0 : a->ptr.pp_complex[k][k] = ae_complex_from_i(1);
45798 :
45799 : /*
45800 : * fill non-zero part of T,
45801 : */
45802 0 : for(i=0; i<=k-1; i++)
45803 : {
45804 0 : if( columnwisea )
45805 : {
45806 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[k][i], a->stride, "Conj", &a->ptr.pp_complex[k][k], a->stride, "N", ae_v_len(k,lengtha-1));
45807 : }
45808 : else
45809 : {
45810 0 : v = ae_v_cdotproduct(&a->ptr.pp_complex[i][k], 1, "N", &a->ptr.pp_complex[k][k], 1, "Conj", ae_v_len(k,lengtha-1));
45811 : }
45812 0 : work->ptr.p_complex[i] = v;
45813 : }
45814 0 : for(i=0; i<=k-1; i++)
45815 : {
45816 0 : v = ae_v_cdotproduct(&t->ptr.pp_complex[i][i], 1, "N", &work->ptr.p_complex[i], 1, "N", ae_v_len(i,k-1));
45817 0 : t->ptr.pp_complex[i][k] = ae_c_neg(ae_c_mul(tau->ptr.p_complex[k],v));
45818 : }
45819 0 : t->ptr.pp_complex[k][k] = ae_c_neg(tau->ptr.p_complex[k]);
45820 :
45821 : /*
45822 : * Rest of T is filled by zeros
45823 : */
45824 0 : for(i=k+1; i<=blocksize-1; i++)
45825 : {
45826 0 : t->ptr.pp_complex[i][k] = ae_complex_from_i(0);
45827 : }
45828 : }
45829 0 : }
45830 :
45831 :
45832 : #endif
45833 : #if defined(AE_COMPILE_FBLS) || !defined(AE_PARTIAL_BUILD)
45834 :
45835 :
45836 : /*************************************************************************
45837 : Basic Cholesky solver for ScaleA*Cholesky(A)'*x = y.
45838 :
45839 : This subroutine assumes that:
45840 : * A*ScaleA is well scaled
45841 : * A is well-conditioned, so no zero divisions or overflow may occur
45842 :
45843 : INPUT PARAMETERS:
45844 : CHA - Cholesky decomposition of A
45845 : SqrtScaleA- square root of scale factor ScaleA
45846 : N - matrix size, N>=0.
45847 : IsUpper - storage type
45848 : XB - right part
45849 : Tmp - buffer; function automatically allocates it, if it is too
45850 : small. It can be reused if function is called several
45851 : times.
45852 :
45853 : OUTPUT PARAMETERS:
45854 : XB - solution
45855 :
45856 : NOTE 1: no assertion or tests are done during algorithm operation
45857 : NOTE 2: N=0 will force algorithm to silently return
45858 :
45859 : -- ALGLIB --
45860 : Copyright 13.10.2010 by Bochkanov Sergey
45861 : *************************************************************************/
45862 0 : void fblscholeskysolve(/* Real */ ae_matrix* cha,
45863 : double sqrtscalea,
45864 : ae_int_t n,
45865 : ae_bool isupper,
45866 : /* Real */ ae_vector* xb,
45867 : /* Real */ ae_vector* tmp,
45868 : ae_state *_state)
45869 : {
45870 : double v;
45871 :
45872 :
45873 0 : if( n<=0 )
45874 : {
45875 0 : return;
45876 : }
45877 0 : if( tmp->cnt<n )
45878 : {
45879 0 : ae_vector_set_length(tmp, n, _state);
45880 : }
45881 :
45882 : /*
45883 : * Scale right part
45884 : */
45885 0 : v = 1/ae_sqr(sqrtscalea, _state);
45886 0 : ae_v_muld(&xb->ptr.p_double[0], 1, ae_v_len(0,n-1), v);
45887 :
45888 : /*
45889 : * Solve A = L*L' or A=U'*U
45890 : */
45891 0 : if( isupper )
45892 : {
45893 :
45894 : /*
45895 : * Solve U'*y=b first.
45896 : */
45897 0 : rmatrixtrsv(n, cha, 0, 0, ae_true, ae_false, 1, xb, 0, _state);
45898 :
45899 : /*
45900 : * Solve U*x=y then.
45901 : */
45902 0 : rmatrixtrsv(n, cha, 0, 0, ae_true, ae_false, 0, xb, 0, _state);
45903 : }
45904 : else
45905 : {
45906 :
45907 : /*
45908 : * Solve L*y=b first
45909 : */
45910 0 : rmatrixtrsv(n, cha, 0, 0, ae_false, ae_false, 0, xb, 0, _state);
45911 :
45912 : /*
45913 : * Solve L'*x=y then.
45914 : */
45915 0 : rmatrixtrsv(n, cha, 0, 0, ae_false, ae_false, 1, xb, 0, _state);
45916 : }
45917 : }
45918 :
45919 :
45920 : /*************************************************************************
45921 : Fast basic linear solver: linear SPD CG
45922 :
45923 : Solves (A^T*A + alpha*I)*x = b where:
45924 : * A is MxN matrix
45925 : * alpha>0 is a scalar
45926 : * I is NxN identity matrix
45927 : * b is Nx1 vector
45928 : * X is Nx1 unknown vector.
45929 :
45930 : N iterations of linear conjugate gradient are used to solve problem.
45931 :
45932 : INPUT PARAMETERS:
45933 : A - array[M,N], matrix
45934 : M - number of rows
45935 : N - number of unknowns
45936 : B - array[N], right part
45937 : X - initial approxumation, array[N]
45938 : Buf - buffer; function automatically allocates it, if it is too
45939 : small. It can be reused if function is called several times
45940 : with same M and N.
45941 :
45942 : OUTPUT PARAMETERS:
45943 : X - improved solution
45944 :
45945 : NOTES:
45946 : * solver checks quality of improved solution. If (because of problem
45947 : condition number, numerical noise, etc.) new solution is WORSE than
45948 : original approximation, then original approximation is returned.
45949 : * solver assumes that both A, B, Alpha are well scaled (i.e. they are
45950 : less than sqrt(overflow) and greater than sqrt(underflow)).
45951 :
45952 : -- ALGLIB --
45953 : Copyright 20.08.2009 by Bochkanov Sergey
45954 : *************************************************************************/
45955 0 : void fblssolvecgx(/* Real */ ae_matrix* a,
45956 : ae_int_t m,
45957 : ae_int_t n,
45958 : double alpha,
45959 : /* Real */ ae_vector* b,
45960 : /* Real */ ae_vector* x,
45961 : /* Real */ ae_vector* buf,
45962 : ae_state *_state)
45963 : {
45964 : ae_int_t k;
45965 : ae_int_t offsrk;
45966 : ae_int_t offsrk1;
45967 : ae_int_t offsxk;
45968 : ae_int_t offsxk1;
45969 : ae_int_t offspk;
45970 : ae_int_t offspk1;
45971 : ae_int_t offstmp1;
45972 : ae_int_t offstmp2;
45973 : ae_int_t bs;
45974 : double e1;
45975 : double e2;
45976 : double rk2;
45977 : double rk12;
45978 : double pap;
45979 : double s;
45980 : double betak;
45981 : double v1;
45982 : double v2;
45983 :
45984 :
45985 :
45986 : /*
45987 : * Test for special case: B=0
45988 : */
45989 0 : v1 = ae_v_dotproduct(&b->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1));
45990 0 : if( ae_fp_eq(v1,(double)(0)) )
45991 : {
45992 0 : for(k=0; k<=n-1; k++)
45993 : {
45994 0 : x->ptr.p_double[k] = (double)(0);
45995 : }
45996 0 : return;
45997 : }
45998 :
45999 : /*
46000 : * Offsets inside Buf for:
46001 : * * R[K], R[K+1]
46002 : * * X[K], X[K+1]
46003 : * * P[K], P[K+1]
46004 : * * Tmp1 - array[M], Tmp2 - array[N]
46005 : */
46006 0 : offsrk = 0;
46007 0 : offsrk1 = offsrk+n;
46008 0 : offsxk = offsrk1+n;
46009 0 : offsxk1 = offsxk+n;
46010 0 : offspk = offsxk1+n;
46011 0 : offspk1 = offspk+n;
46012 0 : offstmp1 = offspk1+n;
46013 0 : offstmp2 = offstmp1+m;
46014 0 : bs = offstmp2+n;
46015 0 : if( buf->cnt<bs )
46016 : {
46017 0 : ae_vector_set_length(buf, bs, _state);
46018 : }
46019 :
46020 : /*
46021 : * x(0) = x
46022 : */
46023 0 : ae_v_move(&buf->ptr.p_double[offsxk], 1, &x->ptr.p_double[0], 1, ae_v_len(offsxk,offsxk+n-1));
46024 :
46025 : /*
46026 : * r(0) = b-A*x(0)
46027 : * RK2 = r(0)'*r(0)
46028 : */
46029 0 : rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state);
46030 0 : rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state);
46031 0 : ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha);
46032 0 : ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1));
46033 0 : ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1));
46034 0 : rk2 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1));
46035 0 : ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offspk,offspk+n-1));
46036 0 : e1 = ae_sqrt(rk2, _state);
46037 :
46038 : /*
46039 : * Cycle
46040 : */
46041 0 : for(k=0; k<=n-1; k++)
46042 : {
46043 :
46044 : /*
46045 : * Calculate A*p(k) - store in Buf[OffsTmp2:OffsTmp2+N-1]
46046 : * and p(k)'*A*p(k) - store in PAP
46047 : *
46048 : * If PAP=0, break (iteration is over)
46049 : */
46050 0 : rmatrixmv(m, n, a, 0, 0, 0, buf, offspk, buf, offstmp1, _state);
46051 0 : v1 = ae_v_dotproduct(&buf->ptr.p_double[offstmp1], 1, &buf->ptr.p_double[offstmp1], 1, ae_v_len(offstmp1,offstmp1+m-1));
46052 0 : v2 = ae_v_dotproduct(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk,offspk+n-1));
46053 0 : pap = v1+alpha*v2;
46054 0 : rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state);
46055 0 : ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha);
46056 0 : if( ae_fp_eq(pap,(double)(0)) )
46057 : {
46058 0 : break;
46059 : }
46060 :
46061 : /*
46062 : * S = (r(k)'*r(k))/(p(k)'*A*p(k))
46063 : */
46064 0 : s = rk2/pap;
46065 :
46066 : /*
46067 : * x(k+1) = x(k) + S*p(k)
46068 : */
46069 0 : ae_v_move(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offsxk1,offsxk1+n-1));
46070 0 : ae_v_addd(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offsxk1,offsxk1+n-1), s);
46071 :
46072 : /*
46073 : * r(k+1) = r(k) - S*A*p(k)
46074 : * RK12 = r(k+1)'*r(k+1)
46075 : *
46076 : * Break if r(k+1) small enough (when compared to r(k))
46077 : */
46078 0 : ae_v_move(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk1,offsrk1+n-1));
46079 0 : ae_v_subd(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk1,offsrk1+n-1), s);
46080 0 : rk12 = ae_v_dotproduct(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk1,offsrk1+n-1));
46081 0 : if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*ae_sqrt(rk2, _state)) )
46082 : {
46083 :
46084 : /*
46085 : * X(k) = x(k+1) before exit -
46086 : * - because we expect to find solution at x(k)
46087 : */
46088 0 : ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1));
46089 0 : break;
46090 : }
46091 :
46092 : /*
46093 : * BetaK = RK12/RK2
46094 : * p(k+1) = r(k+1)+betak*p(k)
46095 : */
46096 0 : betak = rk12/rk2;
46097 0 : ae_v_move(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offspk1,offspk1+n-1));
46098 0 : ae_v_addd(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk1,offspk1+n-1), betak);
46099 :
46100 : /*
46101 : * r(k) := r(k+1)
46102 : * x(k) := x(k+1)
46103 : * p(k) := p(k+1)
46104 : */
46105 0 : ae_v_move(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk,offsrk+n-1));
46106 0 : ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1));
46107 0 : ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk1], 1, ae_v_len(offspk,offspk+n-1));
46108 0 : rk2 = rk12;
46109 : }
46110 :
46111 : /*
46112 : * Calculate E2
46113 : */
46114 0 : rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state);
46115 0 : rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state);
46116 0 : ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha);
46117 0 : ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1));
46118 0 : ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1));
46119 0 : v1 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1));
46120 0 : e2 = ae_sqrt(v1, _state);
46121 :
46122 : /*
46123 : * Output result (if it was improved)
46124 : */
46125 0 : if( ae_fp_less(e2,e1) )
46126 : {
46127 0 : ae_v_move(&x->ptr.p_double[0], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(0,n-1));
46128 : }
46129 : }
46130 :
46131 :
46132 : /*************************************************************************
46133 : Construction of linear conjugate gradient solver.
46134 :
46135 : State parameter passed using "shared" semantics (i.e. previous state is NOT
46136 : erased). When it is already initialized, we can reause prevously allocated
46137 : memory.
46138 :
46139 : INPUT PARAMETERS:
46140 : X - initial solution
46141 : B - right part
46142 : N - system size
46143 : State - structure; may be preallocated, if we want to reuse memory
46144 :
46145 : OUTPUT PARAMETERS:
46146 : State - structure which is used by FBLSCGIteration() to store
46147 : algorithm state between subsequent calls.
46148 :
46149 : NOTE: no error checking is done; caller must check all parameters, prevent
46150 : overflows, and so on.
46151 :
46152 : -- ALGLIB --
46153 : Copyright 22.10.2009 by Bochkanov Sergey
46154 : *************************************************************************/
46155 0 : void fblscgcreate(/* Real */ ae_vector* x,
46156 : /* Real */ ae_vector* b,
46157 : ae_int_t n,
46158 : fblslincgstate* state,
46159 : ae_state *_state)
46160 : {
46161 :
46162 :
46163 0 : if( state->b.cnt<n )
46164 : {
46165 0 : ae_vector_set_length(&state->b, n, _state);
46166 : }
46167 0 : if( state->rk.cnt<n )
46168 : {
46169 0 : ae_vector_set_length(&state->rk, n, _state);
46170 : }
46171 0 : if( state->rk1.cnt<n )
46172 : {
46173 0 : ae_vector_set_length(&state->rk1, n, _state);
46174 : }
46175 0 : if( state->xk.cnt<n )
46176 : {
46177 0 : ae_vector_set_length(&state->xk, n, _state);
46178 : }
46179 0 : if( state->xk1.cnt<n )
46180 : {
46181 0 : ae_vector_set_length(&state->xk1, n, _state);
46182 : }
46183 0 : if( state->pk.cnt<n )
46184 : {
46185 0 : ae_vector_set_length(&state->pk, n, _state);
46186 : }
46187 0 : if( state->pk1.cnt<n )
46188 : {
46189 0 : ae_vector_set_length(&state->pk1, n, _state);
46190 : }
46191 0 : if( state->tmp2.cnt<n )
46192 : {
46193 0 : ae_vector_set_length(&state->tmp2, n, _state);
46194 : }
46195 0 : if( state->x.cnt<n )
46196 : {
46197 0 : ae_vector_set_length(&state->x, n, _state);
46198 : }
46199 0 : if( state->ax.cnt<n )
46200 : {
46201 0 : ae_vector_set_length(&state->ax, n, _state);
46202 : }
46203 0 : state->n = n;
46204 0 : ae_v_move(&state->xk.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1));
46205 0 : ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1));
46206 0 : ae_vector_set_length(&state->rstate.ia, 1+1, _state);
46207 0 : ae_vector_set_length(&state->rstate.ra, 6+1, _state);
46208 0 : state->rstate.stage = -1;
46209 0 : }
46210 :
46211 :
46212 : /*************************************************************************
46213 : Linear CG solver, function relying on reverse communication to calculate
46214 : matrix-vector products.
46215 :
46216 : See comments for FBLSLinCGState structure for more info.
46217 :
46218 : -- ALGLIB --
46219 : Copyright 22.10.2009 by Bochkanov Sergey
46220 : *************************************************************************/
46221 0 : ae_bool fblscgiteration(fblslincgstate* state, ae_state *_state)
46222 : {
46223 : ae_int_t n;
46224 : ae_int_t k;
46225 : double rk2;
46226 : double rk12;
46227 : double pap;
46228 : double s;
46229 : double betak;
46230 : double v1;
46231 : double v2;
46232 : ae_bool result;
46233 :
46234 :
46235 :
46236 : /*
46237 : * Reverse communication preparations
46238 : * I know it looks ugly, but it works the same way
46239 : * anywhere from C++ to Python.
46240 : *
46241 : * This code initializes locals by:
46242 : * * random values determined during code
46243 : * generation - on first subroutine call
46244 : * * values from previous call - on subsequent calls
46245 : */
46246 0 : if( state->rstate.stage>=0 )
46247 : {
46248 0 : n = state->rstate.ia.ptr.p_int[0];
46249 0 : k = state->rstate.ia.ptr.p_int[1];
46250 0 : rk2 = state->rstate.ra.ptr.p_double[0];
46251 0 : rk12 = state->rstate.ra.ptr.p_double[1];
46252 0 : pap = state->rstate.ra.ptr.p_double[2];
46253 0 : s = state->rstate.ra.ptr.p_double[3];
46254 0 : betak = state->rstate.ra.ptr.p_double[4];
46255 0 : v1 = state->rstate.ra.ptr.p_double[5];
46256 0 : v2 = state->rstate.ra.ptr.p_double[6];
46257 : }
46258 : else
46259 : {
46260 0 : n = 359;
46261 0 : k = -58;
46262 0 : rk2 = -919;
46263 0 : rk12 = -909;
46264 0 : pap = 81;
46265 0 : s = 255;
46266 0 : betak = 74;
46267 0 : v1 = -788;
46268 0 : v2 = 809;
46269 : }
46270 0 : if( state->rstate.stage==0 )
46271 : {
46272 0 : goto lbl_0;
46273 : }
46274 0 : if( state->rstate.stage==1 )
46275 : {
46276 0 : goto lbl_1;
46277 : }
46278 0 : if( state->rstate.stage==2 )
46279 : {
46280 0 : goto lbl_2;
46281 : }
46282 :
46283 : /*
46284 : * Routine body
46285 : */
46286 :
46287 : /*
46288 : * prepare locals
46289 : */
46290 0 : n = state->n;
46291 :
46292 : /*
46293 : * Test for special case: B=0
46294 : */
46295 0 : v1 = ae_v_dotproduct(&state->b.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1));
46296 0 : if( ae_fp_eq(v1,(double)(0)) )
46297 : {
46298 0 : for(k=0; k<=n-1; k++)
46299 : {
46300 0 : state->xk.ptr.p_double[k] = (double)(0);
46301 : }
46302 0 : result = ae_false;
46303 0 : return result;
46304 : }
46305 :
46306 : /*
46307 : * r(0) = b-A*x(0)
46308 : * RK2 = r(0)'*r(0)
46309 : */
46310 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46311 0 : state->rstate.stage = 0;
46312 0 : goto lbl_rcomm;
46313 0 : lbl_0:
46314 0 : ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1));
46315 0 : ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1));
46316 0 : rk2 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46317 0 : ae_v_move(&state->pk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46318 0 : state->e1 = ae_sqrt(rk2, _state);
46319 :
46320 : /*
46321 : * Cycle
46322 : */
46323 0 : k = 0;
46324 0 : lbl_3:
46325 0 : if( k>n-1 )
46326 : {
46327 0 : goto lbl_5;
46328 : }
46329 :
46330 : /*
46331 : * Calculate A*p(k) - store in State.Tmp2
46332 : * and p(k)'*A*p(k) - store in PAP
46333 : *
46334 : * If PAP=0, break (iteration is over)
46335 : */
46336 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46337 0 : state->rstate.stage = 1;
46338 0 : goto lbl_rcomm;
46339 0 : lbl_1:
46340 0 : ae_v_move(&state->tmp2.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1));
46341 0 : pap = state->xax;
46342 0 : if( !ae_isfinite(pap, _state) )
46343 : {
46344 0 : goto lbl_5;
46345 : }
46346 0 : if( ae_fp_less_eq(pap,(double)(0)) )
46347 : {
46348 0 : goto lbl_5;
46349 : }
46350 :
46351 : /*
46352 : * S = (r(k)'*r(k))/(p(k)'*A*p(k))
46353 : */
46354 0 : s = rk2/pap;
46355 :
46356 : /*
46357 : * x(k+1) = x(k) + S*p(k)
46358 : */
46359 0 : ae_v_move(&state->xk1.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46360 0 : ae_v_addd(&state->xk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), s);
46361 :
46362 : /*
46363 : * r(k+1) = r(k) - S*A*p(k)
46364 : * RK12 = r(k+1)'*r(k+1)
46365 : *
46366 : * Break if r(k+1) small enough (when compared to r(k))
46367 : */
46368 0 : ae_v_move(&state->rk1.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46369 0 : ae_v_subd(&state->rk1.ptr.p_double[0], 1, &state->tmp2.ptr.p_double[0], 1, ae_v_len(0,n-1), s);
46370 0 : rk12 = ae_v_dotproduct(&state->rk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46371 0 : if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*state->e1) )
46372 : {
46373 :
46374 : /*
46375 : * X(k) = x(k+1) before exit -
46376 : * - because we expect to find solution at x(k)
46377 : */
46378 0 : ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46379 0 : goto lbl_5;
46380 : }
46381 :
46382 : /*
46383 : * BetaK = RK12/RK2
46384 : * p(k+1) = r(k+1)+betak*p(k)
46385 : *
46386 : * NOTE: we expect that BetaK won't overflow because of
46387 : * "Sqrt(RK12)<=100*MachineEpsilon*E1" test above.
46388 : */
46389 0 : betak = rk12/rk2;
46390 0 : ae_v_move(&state->pk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46391 0 : ae_v_addd(&state->pk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak);
46392 :
46393 : /*
46394 : * r(k) := r(k+1)
46395 : * x(k) := x(k+1)
46396 : * p(k) := p(k+1)
46397 : */
46398 0 : ae_v_move(&state->rk.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46399 0 : ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46400 0 : ae_v_move(&state->pk.ptr.p_double[0], 1, &state->pk1.ptr.p_double[0], 1, ae_v_len(0,n-1));
46401 0 : rk2 = rk12;
46402 0 : k = k+1;
46403 0 : goto lbl_3;
46404 0 : lbl_5:
46405 :
46406 : /*
46407 : * Calculate E2
46408 : */
46409 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46410 0 : state->rstate.stage = 2;
46411 0 : goto lbl_rcomm;
46412 0 : lbl_2:
46413 0 : ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1));
46414 0 : ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1));
46415 0 : v1 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1));
46416 0 : state->e2 = ae_sqrt(v1, _state);
46417 0 : result = ae_false;
46418 0 : return result;
46419 :
46420 : /*
46421 : * Saving state
46422 : */
46423 0 : lbl_rcomm:
46424 0 : result = ae_true;
46425 0 : state->rstate.ia.ptr.p_int[0] = n;
46426 0 : state->rstate.ia.ptr.p_int[1] = k;
46427 0 : state->rstate.ra.ptr.p_double[0] = rk2;
46428 0 : state->rstate.ra.ptr.p_double[1] = rk12;
46429 0 : state->rstate.ra.ptr.p_double[2] = pap;
46430 0 : state->rstate.ra.ptr.p_double[3] = s;
46431 0 : state->rstate.ra.ptr.p_double[4] = betak;
46432 0 : state->rstate.ra.ptr.p_double[5] = v1;
46433 0 : state->rstate.ra.ptr.p_double[6] = v2;
46434 0 : return result;
46435 : }
46436 :
46437 :
46438 : /*************************************************************************
46439 : Construction of GMRES(k) solver.
46440 :
46441 : State parameter passed using "shared" semantics (i.e. previous state is NOT
46442 : erased). When it is already initialized, we can reause prevously allocated
46443 : memory.
46444 :
46445 : After (but not before!) initialization you can tweak following fields (they
46446 : are initialized by default values, but you can change it):
46447 : * State.EpsOrt - stop if norm of new candidate for orthogonalization is below EpsOrt
46448 : * State.EpsRes - stop of residual decreased below EpsRes*|B|
46449 : * State.EpsRed - stop if relative reduction of residual |R(k+1)|/|R(k)|>EpsRed
46450 :
46451 : INPUT PARAMETERS:
46452 : B - right part
46453 : N - system size
46454 : K - iterations count, K>=1
46455 : State - structure; may be preallocated, if we want to reuse memory
46456 :
46457 : OUTPUT PARAMETERS:
46458 : State - structure which is used by FBLSGMRESIteration() to store
46459 : algorithm state between subsequent calls.
46460 :
46461 : NOTE: no error checking is done; caller must check all parameters, prevent
46462 : overflows, and so on.
46463 :
46464 : -- ALGLIB --
46465 : Copyright 18.11.2020 by Bochkanov Sergey
46466 : *************************************************************************/
46467 0 : void fblsgmrescreate(/* Real */ ae_vector* b,
46468 : ae_int_t n,
46469 : ae_int_t k,
46470 : fblsgmresstate* state,
46471 : ae_state *_state)
46472 : {
46473 :
46474 :
46475 0 : ae_assert((n>0&&k>0)&&k<=n, "FBLSGMRESCreate: incorrect params", _state);
46476 0 : state->n = n;
46477 0 : state->itscnt = k;
46478 0 : state->epsort = (1000+ae_sqrt((double)(n), _state))*ae_machineepsilon;
46479 0 : state->epsres = (1000+ae_sqrt((double)(n), _state))*ae_machineepsilon;
46480 0 : state->epsred = 1.0;
46481 0 : state->epsdiag = (10000+n)*ae_machineepsilon;
46482 0 : state->itsperformed = 0;
46483 0 : state->retcode = 0;
46484 0 : rcopyallocv(n, b, &state->b, _state);
46485 0 : rallocv(n, &state->x, _state);
46486 0 : rallocv(n, &state->ax, _state);
46487 0 : ae_vector_set_length(&state->rstate.ia, 4+1, _state);
46488 0 : ae_vector_set_length(&state->rstate.ra, 10+1, _state);
46489 0 : state->rstate.stage = -1;
46490 0 : }
46491 :
46492 :
46493 : /*************************************************************************
46494 : Linear CG solver, function relying on reverse communication to calculate
46495 : matrix-vector products.
46496 :
46497 : See comments for FBLSLinCGState structure for more info.
46498 :
46499 : -- ALGLIB --
46500 : Copyright 22.10.2009 by Bochkanov Sergey
46501 : *************************************************************************/
46502 0 : ae_bool fblsgmresiteration(fblsgmresstate* state, ae_state *_state)
46503 : {
46504 : ae_int_t n;
46505 : ae_int_t itidx;
46506 : ae_int_t kdim;
46507 : double rmax;
46508 : double rmindiag;
46509 : double cs;
46510 : double sn;
46511 : double v;
46512 : double vv;
46513 : double anrm;
46514 : double qnrm;
46515 : double bnrm;
46516 : double resnrm;
46517 : double prevresnrm;
46518 : ae_int_t i;
46519 : ae_int_t j;
46520 : ae_bool result;
46521 :
46522 :
46523 :
46524 : /*
46525 : * Reverse communication preparations
46526 : * I know it looks ugly, but it works the same way
46527 : * anywhere from C++ to Python.
46528 : *
46529 : * This code initializes locals by:
46530 : * * random values determined during code
46531 : * generation - on first subroutine call
46532 : * * values from previous call - on subsequent calls
46533 : */
46534 0 : if( state->rstate.stage>=0 )
46535 : {
46536 0 : n = state->rstate.ia.ptr.p_int[0];
46537 0 : itidx = state->rstate.ia.ptr.p_int[1];
46538 0 : kdim = state->rstate.ia.ptr.p_int[2];
46539 0 : i = state->rstate.ia.ptr.p_int[3];
46540 0 : j = state->rstate.ia.ptr.p_int[4];
46541 0 : rmax = state->rstate.ra.ptr.p_double[0];
46542 0 : rmindiag = state->rstate.ra.ptr.p_double[1];
46543 0 : cs = state->rstate.ra.ptr.p_double[2];
46544 0 : sn = state->rstate.ra.ptr.p_double[3];
46545 0 : v = state->rstate.ra.ptr.p_double[4];
46546 0 : vv = state->rstate.ra.ptr.p_double[5];
46547 0 : anrm = state->rstate.ra.ptr.p_double[6];
46548 0 : qnrm = state->rstate.ra.ptr.p_double[7];
46549 0 : bnrm = state->rstate.ra.ptr.p_double[8];
46550 0 : resnrm = state->rstate.ra.ptr.p_double[9];
46551 0 : prevresnrm = state->rstate.ra.ptr.p_double[10];
46552 : }
46553 : else
46554 : {
46555 0 : n = 205;
46556 0 : itidx = -838;
46557 0 : kdim = 939;
46558 0 : i = -526;
46559 0 : j = 763;
46560 0 : rmax = -541;
46561 0 : rmindiag = -698;
46562 0 : cs = -900;
46563 0 : sn = -318;
46564 0 : v = -940;
46565 0 : vv = 1016;
46566 0 : anrm = -229;
46567 0 : qnrm = -536;
46568 0 : bnrm = 487;
46569 0 : resnrm = -115;
46570 0 : prevresnrm = 886;
46571 : }
46572 0 : if( state->rstate.stage==0 )
46573 : {
46574 0 : goto lbl_0;
46575 : }
46576 :
46577 : /*
46578 : * Routine body
46579 : */
46580 0 : n = state->n;
46581 0 : state->retcode = 1;
46582 :
46583 : /*
46584 : * Set up Q0
46585 : */
46586 0 : rsetallocv(n, 0.0, &state->xs, _state);
46587 0 : bnrm = ae_sqrt(rdotv2(n, &state->b, _state), _state);
46588 0 : if( ae_fp_eq(bnrm,(double)(0)) )
46589 : {
46590 0 : result = ae_false;
46591 0 : return result;
46592 : }
46593 0 : rallocm(state->itscnt+1, n, &state->qi, _state);
46594 0 : rallocm(state->itscnt, n, &state->aqi, _state);
46595 0 : rcopymulvr(n, 1/bnrm, &state->b, &state->qi, 0, _state);
46596 0 : rsetallocm(state->itscnt+1, state->itscnt, 0.0, &state->h, _state);
46597 0 : rsetallocm(state->itscnt+1, state->itscnt, 0.0, &state->hr, _state);
46598 0 : rsetallocm(state->itscnt+1, state->itscnt+1, 0.0, &state->hq, _state);
46599 0 : for(i=0; i<=state->itscnt; i++)
46600 : {
46601 0 : state->hq.ptr.pp_double[i][i] = (double)(1);
46602 : }
46603 0 : rsetallocv(state->itscnt+1, 0.0, &state->hqb, _state);
46604 0 : state->hqb.ptr.p_double[0] = bnrm;
46605 :
46606 : /*
46607 : * Perform iteration
46608 : */
46609 0 : resnrm = bnrm;
46610 0 : kdim = 0;
46611 0 : rmax = (double)(0);
46612 0 : rmindiag = 1.0E99;
46613 0 : rsetallocv(state->itscnt, 0.0, &state->ys, _state);
46614 0 : rallocv(ae_maxint(n, state->itscnt+2, _state), &state->tmp0, _state);
46615 0 : rallocv(ae_maxint(n, state->itscnt+2, _state), &state->tmp1, _state);
46616 0 : itidx = 0;
46617 0 : lbl_1:
46618 0 : if( itidx>state->itscnt-1 )
46619 : {
46620 0 : goto lbl_3;
46621 : }
46622 0 : prevresnrm = resnrm;
46623 :
46624 : /*
46625 : * Compute A*Qi[ItIdx], then compute Qi[ItIdx+1]
46626 : */
46627 0 : rcopyrv(n, &state->qi, itidx, &state->x, _state);
46628 0 : state->rstate.stage = 0;
46629 0 : goto lbl_rcomm;
46630 0 : lbl_0:
46631 0 : rcopyvr(n, &state->ax, &state->aqi, itidx, _state);
46632 0 : anrm = ae_sqrt(rdotv2(n, &state->ax, _state), _state);
46633 0 : if( ae_fp_eq(anrm,(double)(0)) )
46634 : {
46635 0 : state->retcode = 2;
46636 0 : goto lbl_3;
46637 : }
46638 0 : rowwisegramschmidt(&state->qi, itidx+1, n, &state->ax, &state->tmp0, ae_true, _state);
46639 0 : rowwisegramschmidt(&state->qi, itidx+1, n, &state->ax, &state->tmp1, ae_true, _state);
46640 0 : raddvc(itidx+1, 1.0, &state->tmp0, &state->h, itidx, _state);
46641 0 : raddvc(itidx+1, 1.0, &state->tmp1, &state->h, itidx, _state);
46642 0 : qnrm = ae_sqrt(rdotv2(n, &state->ax, _state), _state);
46643 0 : state->h.ptr.pp_double[itidx+1][itidx] = qnrm;
46644 0 : rmulv(n, 1/coalesce(qnrm, (double)(1), _state), &state->ax, _state);
46645 0 : rcopyvr(n, &state->ax, &state->qi, itidx+1, _state);
46646 :
46647 : /*
46648 : * We have QR decomposition of H from the previous iteration:
46649 : * * (ItIdx+1)*(ItIdx+1) orthogonal HQ embedded into larger (ItIdx+2)*(ItIdx+2) identity matrix
46650 : * * (ItIdx+1)*ItIdx triangular HR embedded into larger (ItIdx+2)*(ItIdx+1) zero matrix
46651 : *
46652 : * We just have to update QR decomposition after one more column is added to H:
46653 : * * multiply this column by HQ to obtain (ItIdx+2)-dimensional vector X
46654 : * * generate rotation to nullify last element of X to obtain (ItIdx+1)-dimensional vector Y
46655 : * that is copied into (ItIdx+1)-th column of HR
46656 : * * apply same rotation to HQ
46657 : * * apply same rotation to HQB - current right-hand side
46658 : */
46659 0 : rcopycv(itidx+2, &state->h, itidx, &state->tmp0, _state);
46660 0 : rmatrixgemv(itidx+2, itidx+2, 1.0, &state->hq, 0, 0, 0, &state->tmp0, 0, 0.0, &state->tmp1, 0, _state);
46661 0 : generaterotation(state->tmp1.ptr.p_double[itidx], state->tmp1.ptr.p_double[itidx+1], &cs, &sn, &v, _state);
46662 0 : state->tmp1.ptr.p_double[itidx] = v;
46663 0 : state->tmp1.ptr.p_double[itidx+1] = (double)(0);
46664 0 : rmax = ae_maxreal(rmax, rmaxabsv(itidx+2, &state->tmp1, _state), _state);
46665 0 : rmindiag = ae_minreal(rmindiag, ae_fabs(v, _state), _state);
46666 0 : if( ae_fp_less_eq(rmindiag,rmax*state->epsdiag) )
46667 : {
46668 0 : state->retcode = 3;
46669 0 : goto lbl_3;
46670 : }
46671 0 : rcopyvc(itidx+2, &state->tmp1, &state->hr, itidx, _state);
46672 0 : for(j=0; j<=itidx+1; j++)
46673 : {
46674 0 : v = state->hq.ptr.pp_double[itidx+0][j];
46675 0 : vv = state->hq.ptr.pp_double[itidx+1][j];
46676 0 : state->hq.ptr.pp_double[itidx+0][j] = cs*v+sn*vv;
46677 0 : state->hq.ptr.pp_double[itidx+1][j] = -sn*v+cs*vv;
46678 : }
46679 0 : v = state->hqb.ptr.p_double[itidx+0];
46680 0 : vv = state->hqb.ptr.p_double[itidx+1];
46681 0 : state->hqb.ptr.p_double[itidx+0] = cs*v+sn*vv;
46682 0 : state->hqb.ptr.p_double[itidx+1] = -sn*v+cs*vv;
46683 0 : resnrm = ae_fabs(state->hqb.ptr.p_double[itidx+1], _state);
46684 :
46685 : /*
46686 : * Previous attempt to extend R was successful (no small diagonal elements).
46687 : * Increase Krylov subspace dimensionality.
46688 : */
46689 0 : kdim = kdim+1;
46690 :
46691 : /*
46692 : * Iteration is over.
46693 : * Terminate if:
46694 : * * last Qi was nearly zero after orthogonalization.
46695 : * * sufficient decrease of residual
46696 : * * stagnation of residual
46697 : */
46698 0 : state->itsperformed = state->itsperformed+1;
46699 0 : if( ae_fp_less_eq(qnrm,state->epsort*anrm)||ae_fp_eq(qnrm,(double)(0)) )
46700 : {
46701 0 : state->retcode = 4;
46702 0 : goto lbl_3;
46703 : }
46704 0 : if( ae_fp_less_eq(resnrm,state->epsres*bnrm) )
46705 : {
46706 0 : state->retcode = 5;
46707 0 : goto lbl_3;
46708 : }
46709 0 : if( ae_fp_greater(resnrm/prevresnrm,state->epsred) )
46710 : {
46711 0 : state->retcode = 6;
46712 0 : goto lbl_3;
46713 : }
46714 0 : itidx = itidx+1;
46715 0 : goto lbl_1;
46716 0 : lbl_3:
46717 :
46718 : /*
46719 : * Post-solve
46720 : */
46721 0 : if( kdim>0 )
46722 : {
46723 0 : rcopyv(kdim, &state->hqb, &state->ys, _state);
46724 0 : rmatrixtrsv(kdim, &state->hr, 0, 0, ae_true, ae_false, 0, &state->ys, 0, _state);
46725 0 : rmatrixmv(n, kdim, &state->qi, 0, 0, 1, &state->ys, 0, &state->xs, 0, _state);
46726 : }
46727 0 : result = ae_false;
46728 0 : return result;
46729 :
46730 : /*
46731 : * Saving state
46732 : */
46733 0 : lbl_rcomm:
46734 0 : result = ae_true;
46735 0 : state->rstate.ia.ptr.p_int[0] = n;
46736 0 : state->rstate.ia.ptr.p_int[1] = itidx;
46737 0 : state->rstate.ia.ptr.p_int[2] = kdim;
46738 0 : state->rstate.ia.ptr.p_int[3] = i;
46739 0 : state->rstate.ia.ptr.p_int[4] = j;
46740 0 : state->rstate.ra.ptr.p_double[0] = rmax;
46741 0 : state->rstate.ra.ptr.p_double[1] = rmindiag;
46742 0 : state->rstate.ra.ptr.p_double[2] = cs;
46743 0 : state->rstate.ra.ptr.p_double[3] = sn;
46744 0 : state->rstate.ra.ptr.p_double[4] = v;
46745 0 : state->rstate.ra.ptr.p_double[5] = vv;
46746 0 : state->rstate.ra.ptr.p_double[6] = anrm;
46747 0 : state->rstate.ra.ptr.p_double[7] = qnrm;
46748 0 : state->rstate.ra.ptr.p_double[8] = bnrm;
46749 0 : state->rstate.ra.ptr.p_double[9] = resnrm;
46750 0 : state->rstate.ra.ptr.p_double[10] = prevresnrm;
46751 0 : return result;
46752 : }
46753 :
46754 :
46755 : /*************************************************************************
46756 : Fast least squares solver, solves well conditioned system without
46757 : performing any checks for degeneracy, and using user-provided buffers
46758 : (which are automatically reallocated if too small).
46759 :
46760 : This function is intended for solution of moderately sized systems. It
46761 : uses factorization algorithms based on Level 2 BLAS operations, thus it
46762 : won't work efficiently on large scale systems.
46763 :
46764 : INPUT PARAMETERS:
46765 : A - array[M,N], system matrix.
46766 : Contents of A is destroyed during solution.
46767 : B - array[M], right part
46768 : M - number of equations
46769 : N - number of variables, N<=M
46770 : Tmp0, Tmp1, Tmp2-
46771 : buffers; function automatically allocates them, if they are
46772 : too small. They can be reused if function is called
46773 : several times.
46774 :
46775 : OUTPUT PARAMETERS:
46776 : B - solution (first N components, next M-N are zero)
46777 :
46778 : -- ALGLIB --
46779 : Copyright 20.01.2012 by Bochkanov Sergey
46780 : *************************************************************************/
46781 0 : void fblssolvels(/* Real */ ae_matrix* a,
46782 : /* Real */ ae_vector* b,
46783 : ae_int_t m,
46784 : ae_int_t n,
46785 : /* Real */ ae_vector* tmp0,
46786 : /* Real */ ae_vector* tmp1,
46787 : /* Real */ ae_vector* tmp2,
46788 : ae_state *_state)
46789 : {
46790 : ae_int_t i;
46791 : ae_int_t k;
46792 : double v;
46793 :
46794 :
46795 0 : ae_assert(n>0, "FBLSSolveLS: N<=0", _state);
46796 0 : ae_assert(m>=n, "FBLSSolveLS: M<N", _state);
46797 0 : ae_assert(a->rows>=m, "FBLSSolveLS: Rows(A)<M", _state);
46798 0 : ae_assert(a->cols>=n, "FBLSSolveLS: Cols(A)<N", _state);
46799 0 : ae_assert(b->cnt>=m, "FBLSSolveLS: Length(B)<M", _state);
46800 :
46801 : /*
46802 : * Allocate temporaries
46803 : */
46804 0 : rvectorsetlengthatleast(tmp0, ae_maxint(m, n, _state)+1, _state);
46805 0 : rvectorsetlengthatleast(tmp1, ae_maxint(m, n, _state)+1, _state);
46806 0 : rvectorsetlengthatleast(tmp2, ae_minint(m, n, _state), _state);
46807 :
46808 : /*
46809 : * Call basecase QR
46810 : */
46811 0 : rmatrixqrbasecase(a, m, n, tmp0, tmp1, tmp2, _state);
46812 :
46813 : /*
46814 : * Multiply B by Q'
46815 : */
46816 0 : for(k=0; k<=n-1; k++)
46817 : {
46818 0 : for(i=0; i<=k-1; i++)
46819 : {
46820 0 : tmp0->ptr.p_double[i] = (double)(0);
46821 : }
46822 0 : ae_v_move(&tmp0->ptr.p_double[k], 1, &a->ptr.pp_double[k][k], a->stride, ae_v_len(k,m-1));
46823 0 : tmp0->ptr.p_double[k] = (double)(1);
46824 0 : v = ae_v_dotproduct(&tmp0->ptr.p_double[k], 1, &b->ptr.p_double[k], 1, ae_v_len(k,m-1));
46825 0 : v = v*tmp2->ptr.p_double[k];
46826 0 : ae_v_subd(&b->ptr.p_double[k], 1, &tmp0->ptr.p_double[k], 1, ae_v_len(k,m-1), v);
46827 : }
46828 :
46829 : /*
46830 : * Solve triangular system
46831 : */
46832 0 : b->ptr.p_double[n-1] = b->ptr.p_double[n-1]/a->ptr.pp_double[n-1][n-1];
46833 0 : for(i=n-2; i>=0; i--)
46834 : {
46835 0 : v = ae_v_dotproduct(&a->ptr.pp_double[i][i+1], 1, &b->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1));
46836 0 : b->ptr.p_double[i] = (b->ptr.p_double[i]-v)/a->ptr.pp_double[i][i];
46837 : }
46838 0 : for(i=n; i<=m-1; i++)
46839 : {
46840 0 : b->ptr.p_double[i] = 0.0;
46841 : }
46842 0 : }
46843 :
46844 :
46845 0 : void _fblslincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
46846 : {
46847 0 : fblslincgstate *p = (fblslincgstate*)_p;
46848 0 : ae_touch_ptr((void*)p);
46849 0 : ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic);
46850 0 : ae_vector_init(&p->ax, 0, DT_REAL, _state, make_automatic);
46851 0 : ae_vector_init(&p->rk, 0, DT_REAL, _state, make_automatic);
46852 0 : ae_vector_init(&p->rk1, 0, DT_REAL, _state, make_automatic);
46853 0 : ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic);
46854 0 : ae_vector_init(&p->xk1, 0, DT_REAL, _state, make_automatic);
46855 0 : ae_vector_init(&p->pk, 0, DT_REAL, _state, make_automatic);
46856 0 : ae_vector_init(&p->pk1, 0, DT_REAL, _state, make_automatic);
46857 0 : ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic);
46858 0 : _rcommstate_init(&p->rstate, _state, make_automatic);
46859 0 : ae_vector_init(&p->tmp2, 0, DT_REAL, _state, make_automatic);
46860 0 : }
46861 :
46862 :
46863 0 : void _fblslincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
46864 : {
46865 0 : fblslincgstate *dst = (fblslincgstate*)_dst;
46866 0 : fblslincgstate *src = (fblslincgstate*)_src;
46867 0 : dst->e1 = src->e1;
46868 0 : dst->e2 = src->e2;
46869 0 : ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic);
46870 0 : ae_vector_init_copy(&dst->ax, &src->ax, _state, make_automatic);
46871 0 : dst->xax = src->xax;
46872 0 : dst->n = src->n;
46873 0 : ae_vector_init_copy(&dst->rk, &src->rk, _state, make_automatic);
46874 0 : ae_vector_init_copy(&dst->rk1, &src->rk1, _state, make_automatic);
46875 0 : ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic);
46876 0 : ae_vector_init_copy(&dst->xk1, &src->xk1, _state, make_automatic);
46877 0 : ae_vector_init_copy(&dst->pk, &src->pk, _state, make_automatic);
46878 0 : ae_vector_init_copy(&dst->pk1, &src->pk1, _state, make_automatic);
46879 0 : ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic);
46880 0 : _rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
46881 0 : ae_vector_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic);
46882 0 : }
46883 :
46884 :
46885 0 : void _fblslincgstate_clear(void* _p)
46886 : {
46887 0 : fblslincgstate *p = (fblslincgstate*)_p;
46888 0 : ae_touch_ptr((void*)p);
46889 0 : ae_vector_clear(&p->x);
46890 0 : ae_vector_clear(&p->ax);
46891 0 : ae_vector_clear(&p->rk);
46892 0 : ae_vector_clear(&p->rk1);
46893 0 : ae_vector_clear(&p->xk);
46894 0 : ae_vector_clear(&p->xk1);
46895 0 : ae_vector_clear(&p->pk);
46896 0 : ae_vector_clear(&p->pk1);
46897 0 : ae_vector_clear(&p->b);
46898 0 : _rcommstate_clear(&p->rstate);
46899 0 : ae_vector_clear(&p->tmp2);
46900 0 : }
46901 :
46902 :
46903 0 : void _fblslincgstate_destroy(void* _p)
46904 : {
46905 0 : fblslincgstate *p = (fblslincgstate*)_p;
46906 0 : ae_touch_ptr((void*)p);
46907 0 : ae_vector_destroy(&p->x);
46908 0 : ae_vector_destroy(&p->ax);
46909 0 : ae_vector_destroy(&p->rk);
46910 0 : ae_vector_destroy(&p->rk1);
46911 0 : ae_vector_destroy(&p->xk);
46912 0 : ae_vector_destroy(&p->xk1);
46913 0 : ae_vector_destroy(&p->pk);
46914 0 : ae_vector_destroy(&p->pk1);
46915 0 : ae_vector_destroy(&p->b);
46916 0 : _rcommstate_destroy(&p->rstate);
46917 0 : ae_vector_destroy(&p->tmp2);
46918 0 : }
46919 :
46920 :
46921 0 : void _fblsgmresstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
46922 : {
46923 0 : fblsgmresstate *p = (fblsgmresstate*)_p;
46924 0 : ae_touch_ptr((void*)p);
46925 0 : ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic);
46926 0 : ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic);
46927 0 : ae_vector_init(&p->ax, 0, DT_REAL, _state, make_automatic);
46928 0 : ae_vector_init(&p->xs, 0, DT_REAL, _state, make_automatic);
46929 0 : ae_matrix_init(&p->qi, 0, 0, DT_REAL, _state, make_automatic);
46930 0 : ae_matrix_init(&p->aqi, 0, 0, DT_REAL, _state, make_automatic);
46931 0 : ae_matrix_init(&p->h, 0, 0, DT_REAL, _state, make_automatic);
46932 0 : ae_matrix_init(&p->hq, 0, 0, DT_REAL, _state, make_automatic);
46933 0 : ae_matrix_init(&p->hr, 0, 0, DT_REAL, _state, make_automatic);
46934 0 : ae_vector_init(&p->hqb, 0, DT_REAL, _state, make_automatic);
46935 0 : ae_vector_init(&p->ys, 0, DT_REAL, _state, make_automatic);
46936 0 : ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic);
46937 0 : ae_vector_init(&p->tmp1, 0, DT_REAL, _state, make_automatic);
46938 0 : _rcommstate_init(&p->rstate, _state, make_automatic);
46939 0 : }
46940 :
46941 :
46942 0 : void _fblsgmresstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
46943 : {
46944 0 : fblsgmresstate *dst = (fblsgmresstate*)_dst;
46945 0 : fblsgmresstate *src = (fblsgmresstate*)_src;
46946 0 : ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic);
46947 0 : ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic);
46948 0 : ae_vector_init_copy(&dst->ax, &src->ax, _state, make_automatic);
46949 0 : ae_vector_init_copy(&dst->xs, &src->xs, _state, make_automatic);
46950 0 : ae_matrix_init_copy(&dst->qi, &src->qi, _state, make_automatic);
46951 0 : ae_matrix_init_copy(&dst->aqi, &src->aqi, _state, make_automatic);
46952 0 : ae_matrix_init_copy(&dst->h, &src->h, _state, make_automatic);
46953 0 : ae_matrix_init_copy(&dst->hq, &src->hq, _state, make_automatic);
46954 0 : ae_matrix_init_copy(&dst->hr, &src->hr, _state, make_automatic);
46955 0 : ae_vector_init_copy(&dst->hqb, &src->hqb, _state, make_automatic);
46956 0 : ae_vector_init_copy(&dst->ys, &src->ys, _state, make_automatic);
46957 0 : ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic);
46958 0 : ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic);
46959 0 : dst->n = src->n;
46960 0 : dst->itscnt = src->itscnt;
46961 0 : dst->epsort = src->epsort;
46962 0 : dst->epsres = src->epsres;
46963 0 : dst->epsred = src->epsred;
46964 0 : dst->epsdiag = src->epsdiag;
46965 0 : dst->itsperformed = src->itsperformed;
46966 0 : dst->retcode = src->retcode;
46967 0 : _rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
46968 0 : }
46969 :
46970 :
46971 0 : void _fblsgmresstate_clear(void* _p)
46972 : {
46973 0 : fblsgmresstate *p = (fblsgmresstate*)_p;
46974 0 : ae_touch_ptr((void*)p);
46975 0 : ae_vector_clear(&p->b);
46976 0 : ae_vector_clear(&p->x);
46977 0 : ae_vector_clear(&p->ax);
46978 0 : ae_vector_clear(&p->xs);
46979 0 : ae_matrix_clear(&p->qi);
46980 0 : ae_matrix_clear(&p->aqi);
46981 0 : ae_matrix_clear(&p->h);
46982 0 : ae_matrix_clear(&p->hq);
46983 0 : ae_matrix_clear(&p->hr);
46984 0 : ae_vector_clear(&p->hqb);
46985 0 : ae_vector_clear(&p->ys);
46986 0 : ae_vector_clear(&p->tmp0);
46987 0 : ae_vector_clear(&p->tmp1);
46988 0 : _rcommstate_clear(&p->rstate);
46989 0 : }
46990 :
46991 :
46992 0 : void _fblsgmresstate_destroy(void* _p)
46993 : {
46994 0 : fblsgmresstate *p = (fblsgmresstate*)_p;
46995 0 : ae_touch_ptr((void*)p);
46996 0 : ae_vector_destroy(&p->b);
46997 0 : ae_vector_destroy(&p->x);
46998 0 : ae_vector_destroy(&p->ax);
46999 0 : ae_vector_destroy(&p->xs);
47000 0 : ae_matrix_destroy(&p->qi);
47001 0 : ae_matrix_destroy(&p->aqi);
47002 0 : ae_matrix_destroy(&p->h);
47003 0 : ae_matrix_destroy(&p->hq);
47004 0 : ae_matrix_destroy(&p->hr);
47005 0 : ae_vector_destroy(&p->hqb);
47006 0 : ae_vector_destroy(&p->ys);
47007 0 : ae_vector_destroy(&p->tmp0);
47008 0 : ae_vector_destroy(&p->tmp1);
47009 0 : _rcommstate_destroy(&p->rstate);
47010 0 : }
47011 :
47012 :
47013 : #endif
47014 : #if defined(AE_COMPILE_BDSVD) || !defined(AE_PARTIAL_BUILD)
47015 :
47016 :
47017 : /*************************************************************************
47018 : Singular value decomposition of a bidiagonal matrix (extended algorithm)
47019 :
47020 : COMMERCIAL EDITION OF ALGLIB:
47021 :
47022 : ! Commercial version of ALGLIB includes one important improvement of
47023 : ! this function, which can be used from C++ and C#:
47024 : ! * Intel MKL support (lightweight Intel MKL is shipped with ALGLIB)
47025 : !
47026 : ! Intel MKL gives approximately constant (with respect to number of
47027 : ! worker threads) acceleration factor which depends on CPU being used,
47028 : ! problem size and "baseline" ALGLIB edition which is used for
47029 : ! comparison.
47030 : !
47031 : ! Generally, commercial ALGLIB is several times faster than open-source
47032 : ! generic C edition, and many times faster than open-source C# edition.
47033 : !
47034 : ! Multithreaded acceleration is NOT supported for this function.
47035 : !
47036 : ! We recommend you to read 'Working with commercial version' section of
47037 : ! ALGLIB Reference Manual in order to find out how to use performance-
47038 : ! related features provided by commercial edition of ALGLIB.
47039 :
47040 : The algorithm performs the singular value decomposition of a bidiagonal
47041 : matrix B (upper or lower) representing it as B = Q*S*P^T, where Q and P -
47042 : orthogonal matrices, S - diagonal matrix with non-negative elements on the
47043 : main diagonal, in descending order.
47044 :
47045 : The algorithm finds singular values. In addition, the algorithm can
47046 : calculate matrices Q and P (more precisely, not the matrices, but their
47047 : product with given matrices U and VT - U*Q and (P^T)*VT)). Of course,
47048 : matrices U and VT can be of any type, including identity. Furthermore, the
47049 : algorithm can calculate Q'*C (this product is calculated more effectively
47050 : than U*Q, because this calculation operates with rows instead of matrix
47051 : columns).
47052 :
47053 : The feature of the algorithm is its ability to find all singular values
47054 : including those which are arbitrarily close to 0 with relative accuracy
47055 : close to machine precision. If the parameter IsFractionalAccuracyRequired
47056 : is set to True, all singular values will have high relative accuracy close
47057 : to machine precision. If the parameter is set to False, only the biggest
47058 : singular value will have relative accuracy close to machine precision.
47059 : The absolute error of other singular values is equal to the absolute error
47060 : of the biggest singular value.
47061 :
47062 : Input parameters:
47063 : D - main diagonal of matrix B.
47064 : Array whose index ranges within [0..N-1].
47065 : E - superdiagonal (or subdiagonal) of matrix B.
47066 : Array whose index ranges within [0..N-2].
47067 : N - size of matrix B.
47068 : IsUpper - True, if the matrix is upper bidiagonal.
47069 : IsFractionalAccuracyRequired -
47070 : THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0
47071 : SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY.
47072 : U - matrix to be multiplied by Q.
47073 : Array whose indexes range within [0..NRU-1, 0..N-1].
47074 : The matrix can be bigger, in that case only the submatrix
47075 : [0..NRU-1, 0..N-1] will be multiplied by Q.
47076 : NRU - number of rows in matrix U.
47077 : C - matrix to be multiplied by Q'.
47078 : Array whose indexes range within [0..N-1, 0..NCC-1].
47079 : The matrix can be bigger, in that case only the submatrix
47080 : [0..N-1, 0..NCC-1] will be multiplied by Q'.
47081 : NCC - number of columns in matrix C.
47082 : VT - matrix to be multiplied by P^T.
47083 : Array whose indexes range within [0..N-1, 0..NCVT-1].
47084 : The matrix can be bigger, in that case only the submatrix
47085 : [0..N-1, 0..NCVT-1] will be multiplied by P^T.
47086 : NCVT - number of columns in matrix VT.
47087 :
47088 : Output parameters:
47089 : D - singular values of matrix B in descending order.
47090 : U - if NRU>0, contains matrix U*Q.
47091 : VT - if NCVT>0, contains matrix (P^T)*VT.
47092 : C - if NCC>0, contains matrix Q'*C.
47093 :
47094 : Result:
47095 : True, if the algorithm has converged.
47096 : False, if the algorithm hasn't converged (rare case).
47097 :
47098 : NOTE: multiplication U*Q is performed by means of transposition to internal
47099 : buffer, multiplication and backward transposition. It helps to avoid
47100 : costly columnwise operations and speed-up algorithm.
47101 :
47102 : Additional information:
47103 : The type of convergence is controlled by the internal parameter TOL.
47104 : If the parameter is greater than 0, the singular values will have
47105 : relative accuracy TOL. If TOL<0, the singular values will have
47106 : absolute accuracy ABS(TOL)*norm(B).
47107 : By default, |TOL| falls within the range of 10*Epsilon and 100*Epsilon,
47108 : where Epsilon is the machine precision. It is not recommended to use
47109 : TOL less than 10*Epsilon since this will considerably slow down the
47110 : algorithm and may not lead to error decreasing.
47111 :
47112 : History:
47113 : * 31 March, 2007.
47114 : changed MAXITR from 6 to 12.
47115 :
47116 : -- LAPACK routine (version 3.0) --
47117 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
47118 : Courant Institute, Argonne National Lab, and Rice University
47119 : October 31, 1999.
47120 : *************************************************************************/
47121 0 : ae_bool rmatrixbdsvd(/* Real */ ae_vector* d,
47122 : /* Real */ ae_vector* e,
47123 : ae_int_t n,
47124 : ae_bool isupper,
47125 : ae_bool isfractionalaccuracyrequired,
47126 : /* Real */ ae_matrix* u,
47127 : ae_int_t nru,
47128 : /* Real */ ae_matrix* c,
47129 : ae_int_t ncc,
47130 : /* Real */ ae_matrix* vt,
47131 : ae_int_t ncvt,
47132 : ae_state *_state)
47133 : {
47134 : ae_frame _frame_block;
47135 : ae_vector _e;
47136 : ae_int_t i;
47137 : ae_vector en;
47138 : ae_vector d1;
47139 : ae_vector e1;
47140 : ae_bool result;
47141 :
47142 0 : ae_frame_make(_state, &_frame_block);
47143 0 : memset(&_e, 0, sizeof(_e));
47144 0 : memset(&en, 0, sizeof(en));
47145 0 : memset(&d1, 0, sizeof(d1));
47146 0 : memset(&e1, 0, sizeof(e1));
47147 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
47148 0 : e = &_e;
47149 0 : ae_vector_init(&en, 0, DT_REAL, _state, ae_true);
47150 0 : ae_vector_init(&d1, 0, DT_REAL, _state, ae_true);
47151 0 : ae_vector_init(&e1, 0, DT_REAL, _state, ae_true);
47152 :
47153 0 : result = ae_false;
47154 :
47155 : /*
47156 : * Try to use MKL
47157 : */
47158 0 : ae_vector_set_length(&en, n, _state);
47159 0 : for(i=0; i<=n-2; i++)
47160 : {
47161 0 : en.ptr.p_double[i] = e->ptr.p_double[i];
47162 : }
47163 0 : en.ptr.p_double[n-1] = 0.0;
47164 0 : if( rmatrixbdsvdmkl(d, &en, n, isupper, u, nru, c, ncc, vt, ncvt, &result, _state) )
47165 : {
47166 0 : ae_frame_leave(_state);
47167 0 : return result;
47168 : }
47169 :
47170 : /*
47171 : * Use ALGLIB code
47172 : */
47173 0 : ae_vector_set_length(&d1, n+1, _state);
47174 0 : ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n));
47175 0 : if( n>1 )
47176 : {
47177 0 : ae_vector_set_length(&e1, n-1+1, _state);
47178 0 : ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1));
47179 : }
47180 0 : result = bdsvd_bidiagonalsvddecompositioninternal(&d1, &e1, n, isupper, isfractionalaccuracyrequired, u, 0, nru, c, 0, ncc, vt, 0, ncvt, _state);
47181 0 : ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1));
47182 0 : ae_frame_leave(_state);
47183 0 : return result;
47184 : }
47185 :
47186 :
47187 0 : ae_bool bidiagonalsvddecomposition(/* Real */ ae_vector* d,
47188 : /* Real */ ae_vector* e,
47189 : ae_int_t n,
47190 : ae_bool isupper,
47191 : ae_bool isfractionalaccuracyrequired,
47192 : /* Real */ ae_matrix* u,
47193 : ae_int_t nru,
47194 : /* Real */ ae_matrix* c,
47195 : ae_int_t ncc,
47196 : /* Real */ ae_matrix* vt,
47197 : ae_int_t ncvt,
47198 : ae_state *_state)
47199 : {
47200 : ae_frame _frame_block;
47201 : ae_vector _e;
47202 : ae_bool result;
47203 :
47204 0 : ae_frame_make(_state, &_frame_block);
47205 0 : memset(&_e, 0, sizeof(_e));
47206 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
47207 0 : e = &_e;
47208 :
47209 0 : result = bdsvd_bidiagonalsvddecompositioninternal(d, e, n, isupper, isfractionalaccuracyrequired, u, 1, nru, c, 1, ncc, vt, 1, ncvt, _state);
47210 0 : ae_frame_leave(_state);
47211 0 : return result;
47212 : }
47213 :
47214 :
47215 : /*************************************************************************
47216 : Internal working subroutine for bidiagonal decomposition
47217 : *************************************************************************/
47218 0 : static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d,
47219 : /* Real */ ae_vector* e,
47220 : ae_int_t n,
47221 : ae_bool isupper,
47222 : ae_bool isfractionalaccuracyrequired,
47223 : /* Real */ ae_matrix* uu,
47224 : ae_int_t ustart,
47225 : ae_int_t nru,
47226 : /* Real */ ae_matrix* c,
47227 : ae_int_t cstart,
47228 : ae_int_t ncc,
47229 : /* Real */ ae_matrix* vt,
47230 : ae_int_t vstart,
47231 : ae_int_t ncvt,
47232 : ae_state *_state)
47233 : {
47234 : ae_frame _frame_block;
47235 : ae_vector _e;
47236 : ae_int_t i;
47237 : ae_int_t idir;
47238 : ae_int_t isub;
47239 : ae_int_t iter;
47240 : ae_int_t j;
47241 : ae_int_t ll;
47242 : ae_int_t lll;
47243 : ae_int_t m;
47244 : ae_int_t maxit;
47245 : ae_int_t oldll;
47246 : ae_int_t oldm;
47247 : double abse;
47248 : double abss;
47249 : double cosl;
47250 : double cosr;
47251 : double cs;
47252 : double eps;
47253 : double f;
47254 : double g;
47255 : double h;
47256 : double mu;
47257 : double oldcs;
47258 : double oldsn;
47259 : double r;
47260 : double shift;
47261 : double sigmn;
47262 : double sigmx;
47263 : double sinl;
47264 : double sinr;
47265 : double sll;
47266 : double smax;
47267 : double smin;
47268 : double sminl;
47269 : double sminoa;
47270 : double sn;
47271 : double thresh;
47272 : double tol;
47273 : double tolmul;
47274 : double unfl;
47275 : ae_vector work0;
47276 : ae_vector work1;
47277 : ae_vector work2;
47278 : ae_vector work3;
47279 : ae_int_t maxitr;
47280 : ae_bool matrixsplitflag;
47281 : ae_bool iterflag;
47282 : ae_vector utemp;
47283 : ae_vector vttemp;
47284 : ae_vector ctemp;
47285 : ae_vector etemp;
47286 : ae_matrix ut;
47287 : ae_bool fwddir;
47288 : double tmp;
47289 : ae_int_t mm1;
47290 : ae_int_t mm0;
47291 : ae_bool bchangedir;
47292 : ae_int_t uend;
47293 : ae_int_t cend;
47294 : ae_int_t vend;
47295 : ae_bool result;
47296 :
47297 0 : ae_frame_make(_state, &_frame_block);
47298 0 : memset(&_e, 0, sizeof(_e));
47299 0 : memset(&work0, 0, sizeof(work0));
47300 0 : memset(&work1, 0, sizeof(work1));
47301 0 : memset(&work2, 0, sizeof(work2));
47302 0 : memset(&work3, 0, sizeof(work3));
47303 0 : memset(&utemp, 0, sizeof(utemp));
47304 0 : memset(&vttemp, 0, sizeof(vttemp));
47305 0 : memset(&ctemp, 0, sizeof(ctemp));
47306 0 : memset(&etemp, 0, sizeof(etemp));
47307 0 : memset(&ut, 0, sizeof(ut));
47308 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
47309 0 : e = &_e;
47310 0 : ae_vector_init(&work0, 0, DT_REAL, _state, ae_true);
47311 0 : ae_vector_init(&work1, 0, DT_REAL, _state, ae_true);
47312 0 : ae_vector_init(&work2, 0, DT_REAL, _state, ae_true);
47313 0 : ae_vector_init(&work3, 0, DT_REAL, _state, ae_true);
47314 0 : ae_vector_init(&utemp, 0, DT_REAL, _state, ae_true);
47315 0 : ae_vector_init(&vttemp, 0, DT_REAL, _state, ae_true);
47316 0 : ae_vector_init(&ctemp, 0, DT_REAL, _state, ae_true);
47317 0 : ae_vector_init(&etemp, 0, DT_REAL, _state, ae_true);
47318 0 : ae_matrix_init(&ut, 0, 0, DT_REAL, _state, ae_true);
47319 :
47320 0 : result = ae_true;
47321 0 : if( n==0 )
47322 : {
47323 0 : ae_frame_leave(_state);
47324 0 : return result;
47325 : }
47326 0 : if( n==1 )
47327 : {
47328 0 : if( ae_fp_less(d->ptr.p_double[1],(double)(0)) )
47329 : {
47330 0 : d->ptr.p_double[1] = -d->ptr.p_double[1];
47331 0 : if( ncvt>0 )
47332 : {
47333 0 : ae_v_muld(&vt->ptr.pp_double[vstart][vstart], 1, ae_v_len(vstart,vstart+ncvt-1), -1);
47334 : }
47335 : }
47336 0 : ae_frame_leave(_state);
47337 0 : return result;
47338 : }
47339 :
47340 : /*
47341 : * these initializers are not really necessary,
47342 : * but without them compiler complains about uninitialized locals
47343 : */
47344 0 : ll = 0;
47345 0 : oldsn = (double)(0);
47346 :
47347 : /*
47348 : * init
47349 : */
47350 0 : ae_vector_set_length(&work0, n-1+1, _state);
47351 0 : ae_vector_set_length(&work1, n-1+1, _state);
47352 0 : ae_vector_set_length(&work2, n-1+1, _state);
47353 0 : ae_vector_set_length(&work3, n-1+1, _state);
47354 0 : uend = ustart+ae_maxint(nru-1, 0, _state);
47355 0 : vend = vstart+ae_maxint(ncvt-1, 0, _state);
47356 0 : cend = cstart+ae_maxint(ncc-1, 0, _state);
47357 0 : ae_vector_set_length(&utemp, uend+1, _state);
47358 0 : ae_vector_set_length(&vttemp, vend+1, _state);
47359 0 : ae_vector_set_length(&ctemp, cend+1, _state);
47360 0 : maxitr = 12;
47361 0 : fwddir = ae_true;
47362 0 : if( nru>0 )
47363 : {
47364 0 : ae_matrix_set_length(&ut, ustart+n, ustart+nru, _state);
47365 0 : rmatrixtranspose(nru, n, uu, ustart, ustart, &ut, ustart, ustart, _state);
47366 : }
47367 :
47368 : /*
47369 : * resize E from N-1 to N
47370 : */
47371 0 : ae_vector_set_length(&etemp, n+1, _state);
47372 0 : for(i=1; i<=n-1; i++)
47373 : {
47374 0 : etemp.ptr.p_double[i] = e->ptr.p_double[i];
47375 : }
47376 0 : ae_vector_set_length(e, n+1, _state);
47377 0 : for(i=1; i<=n-1; i++)
47378 : {
47379 0 : e->ptr.p_double[i] = etemp.ptr.p_double[i];
47380 : }
47381 0 : e->ptr.p_double[n] = (double)(0);
47382 0 : idir = 0;
47383 :
47384 : /*
47385 : * Get machine constants
47386 : */
47387 0 : eps = ae_machineepsilon;
47388 0 : unfl = ae_minrealnumber;
47389 :
47390 : /*
47391 : * If matrix lower bidiagonal, rotate to be upper bidiagonal
47392 : * by applying Givens rotations on the left
47393 : */
47394 0 : if( !isupper )
47395 : {
47396 0 : for(i=1; i<=n-1; i++)
47397 : {
47398 0 : generaterotation(d->ptr.p_double[i], e->ptr.p_double[i], &cs, &sn, &r, _state);
47399 0 : d->ptr.p_double[i] = r;
47400 0 : e->ptr.p_double[i] = sn*d->ptr.p_double[i+1];
47401 0 : d->ptr.p_double[i+1] = cs*d->ptr.p_double[i+1];
47402 0 : work0.ptr.p_double[i] = cs;
47403 0 : work1.ptr.p_double[i] = sn;
47404 : }
47405 :
47406 : /*
47407 : * Update singular vectors if desired
47408 : */
47409 0 : if( nru>0 )
47410 : {
47411 0 : applyrotationsfromtheleft(fwddir, 1+ustart-1, n+ustart-1, ustart, uend, &work0, &work1, &ut, &utemp, _state);
47412 : }
47413 0 : if( ncc>0 )
47414 : {
47415 0 : applyrotationsfromtheleft(fwddir, 1+cstart-1, n+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state);
47416 : }
47417 : }
47418 :
47419 : /*
47420 : * Compute singular values to relative accuracy TOL
47421 : * (By setting TOL to be negative, algorithm will compute
47422 : * singular values to absolute accuracy ABS(TOL)*norm(input matrix))
47423 : */
47424 0 : tolmul = ae_maxreal((double)(10), ae_minreal((double)(100), ae_pow(eps, -0.125, _state), _state), _state);
47425 0 : tol = tolmul*eps;
47426 :
47427 : /*
47428 : * Compute approximate maximum, minimum singular values
47429 : */
47430 0 : smax = (double)(0);
47431 0 : for(i=1; i<=n; i++)
47432 : {
47433 0 : smax = ae_maxreal(smax, ae_fabs(d->ptr.p_double[i], _state), _state);
47434 : }
47435 0 : for(i=1; i<=n-1; i++)
47436 : {
47437 0 : smax = ae_maxreal(smax, ae_fabs(e->ptr.p_double[i], _state), _state);
47438 : }
47439 0 : sminl = (double)(0);
47440 0 : if( ae_fp_greater_eq(tol,(double)(0)) )
47441 : {
47442 :
47443 : /*
47444 : * Relative accuracy desired
47445 : */
47446 0 : sminoa = ae_fabs(d->ptr.p_double[1], _state);
47447 0 : if( ae_fp_neq(sminoa,(double)(0)) )
47448 : {
47449 0 : mu = sminoa;
47450 0 : for(i=2; i<=n; i++)
47451 : {
47452 0 : mu = ae_fabs(d->ptr.p_double[i], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[i-1], _state)));
47453 0 : sminoa = ae_minreal(sminoa, mu, _state);
47454 0 : if( ae_fp_eq(sminoa,(double)(0)) )
47455 : {
47456 0 : break;
47457 : }
47458 : }
47459 : }
47460 0 : sminoa = sminoa/ae_sqrt((double)(n), _state);
47461 0 : thresh = ae_maxreal(tol*sminoa, maxitr*n*n*unfl, _state);
47462 : }
47463 : else
47464 : {
47465 :
47466 : /*
47467 : * Absolute accuracy desired
47468 : */
47469 0 : thresh = ae_maxreal(ae_fabs(tol, _state)*smax, maxitr*n*n*unfl, _state);
47470 : }
47471 :
47472 : /*
47473 : * Prepare for main iteration loop for the singular values
47474 : * (MAXIT is the maximum number of passes through the inner
47475 : * loop permitted before nonconvergence signalled.)
47476 : */
47477 0 : maxit = maxitr*n*n;
47478 0 : iter = 0;
47479 0 : oldll = -1;
47480 0 : oldm = -1;
47481 :
47482 : /*
47483 : * M points to last element of unconverged part of matrix
47484 : */
47485 0 : m = n;
47486 :
47487 : /*
47488 : * Begin main iteration loop
47489 : */
47490 : for(;;)
47491 : {
47492 :
47493 : /*
47494 : * Check for convergence or exceeding iteration count
47495 : */
47496 0 : if( m<=1 )
47497 : {
47498 0 : break;
47499 : }
47500 0 : if( iter>maxit )
47501 : {
47502 0 : result = ae_false;
47503 0 : ae_frame_leave(_state);
47504 0 : return result;
47505 : }
47506 :
47507 : /*
47508 : * Find diagonal block of matrix to work on
47509 : */
47510 0 : if( ae_fp_less(tol,(double)(0))&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[m], _state),thresh) )
47511 : {
47512 0 : d->ptr.p_double[m] = (double)(0);
47513 : }
47514 0 : smax = ae_fabs(d->ptr.p_double[m], _state);
47515 0 : smin = smax;
47516 0 : matrixsplitflag = ae_false;
47517 0 : for(lll=1; lll<=m-1; lll++)
47518 : {
47519 0 : ll = m-lll;
47520 0 : abss = ae_fabs(d->ptr.p_double[ll], _state);
47521 0 : abse = ae_fabs(e->ptr.p_double[ll], _state);
47522 0 : if( ae_fp_less(tol,(double)(0))&&ae_fp_less_eq(abss,thresh) )
47523 : {
47524 0 : d->ptr.p_double[ll] = (double)(0);
47525 : }
47526 0 : if( ae_fp_less_eq(abse,thresh) )
47527 : {
47528 0 : matrixsplitflag = ae_true;
47529 0 : break;
47530 : }
47531 0 : smin = ae_minreal(smin, abss, _state);
47532 0 : smax = ae_maxreal(smax, ae_maxreal(abss, abse, _state), _state);
47533 : }
47534 0 : if( !matrixsplitflag )
47535 : {
47536 0 : ll = 0;
47537 : }
47538 : else
47539 : {
47540 :
47541 : /*
47542 : * Matrix splits since E(LL) = 0
47543 : */
47544 0 : e->ptr.p_double[ll] = (double)(0);
47545 0 : if( ll==m-1 )
47546 : {
47547 :
47548 : /*
47549 : * Convergence of bottom singular value, return to top of loop
47550 : */
47551 0 : m = m-1;
47552 0 : continue;
47553 : }
47554 : }
47555 0 : ll = ll+1;
47556 :
47557 : /*
47558 : * E(LL) through E(M-1) are nonzero, E(LL-1) is zero
47559 : */
47560 0 : if( ll==m-1 )
47561 : {
47562 :
47563 : /*
47564 : * 2 by 2 block, handle separately
47565 : */
47566 0 : bdsvd_svdv2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &sigmn, &sigmx, &sinr, &cosr, &sinl, &cosl, _state);
47567 0 : d->ptr.p_double[m-1] = sigmx;
47568 0 : e->ptr.p_double[m-1] = (double)(0);
47569 0 : d->ptr.p_double[m] = sigmn;
47570 :
47571 : /*
47572 : * Compute singular vectors, if desired
47573 : */
47574 0 : if( ncvt>0 )
47575 : {
47576 0 : mm0 = m+(vstart-1);
47577 0 : mm1 = m-1+(vstart-1);
47578 0 : ae_v_moved(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), cosr);
47579 0 : ae_v_addd(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), sinr);
47580 0 : ae_v_muld(&vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), cosr);
47581 0 : ae_v_subd(&vt->ptr.pp_double[mm0][vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), sinr);
47582 0 : ae_v_move(&vt->ptr.pp_double[mm1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend));
47583 : }
47584 0 : if( nru>0 )
47585 : {
47586 0 : mm0 = m+ustart-1;
47587 0 : mm1 = m-1+ustart-1;
47588 0 : ae_v_moved(&utemp.ptr.p_double[ustart], 1, &ut.ptr.pp_double[mm1][ustart], 1, ae_v_len(ustart,uend), cosl);
47589 0 : ae_v_addd(&utemp.ptr.p_double[ustart], 1, &ut.ptr.pp_double[mm0][ustart], 1, ae_v_len(ustart,uend), sinl);
47590 0 : ae_v_muld(&ut.ptr.pp_double[mm0][ustart], 1, ae_v_len(ustart,uend), cosl);
47591 0 : ae_v_subd(&ut.ptr.pp_double[mm0][ustart], 1, &ut.ptr.pp_double[mm1][ustart], 1, ae_v_len(ustart,uend), sinl);
47592 0 : ae_v_move(&ut.ptr.pp_double[mm1][ustart], 1, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend));
47593 : }
47594 0 : if( ncc>0 )
47595 : {
47596 0 : mm0 = m+cstart-1;
47597 0 : mm1 = m-1+cstart-1;
47598 0 : ae_v_moved(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), cosl);
47599 0 : ae_v_addd(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), sinl);
47600 0 : ae_v_muld(&c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), cosl);
47601 0 : ae_v_subd(&c->ptr.pp_double[mm0][cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), sinl);
47602 0 : ae_v_move(&c->ptr.pp_double[mm1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend));
47603 : }
47604 0 : m = m-2;
47605 0 : continue;
47606 : }
47607 :
47608 : /*
47609 : * If working on new submatrix, choose shift direction
47610 : * (from larger end diagonal element towards smaller)
47611 : *
47612 : * Previously was
47613 : * "if (LL>OLDM) or (M<OLDLL) then"
47614 : * fixed thanks to Michael Rolle < m@rolle.name >
47615 : * Very strange that LAPACK still contains it.
47616 : */
47617 0 : bchangedir = ae_false;
47618 0 : if( idir==1&&ae_fp_less(ae_fabs(d->ptr.p_double[ll], _state),1.0E-3*ae_fabs(d->ptr.p_double[m], _state)) )
47619 : {
47620 0 : bchangedir = ae_true;
47621 : }
47622 0 : if( idir==2&&ae_fp_less(ae_fabs(d->ptr.p_double[m], _state),1.0E-3*ae_fabs(d->ptr.p_double[ll], _state)) )
47623 : {
47624 0 : bchangedir = ae_true;
47625 : }
47626 0 : if( (ll!=oldll||m!=oldm)||bchangedir )
47627 : {
47628 0 : if( ae_fp_greater_eq(ae_fabs(d->ptr.p_double[ll], _state),ae_fabs(d->ptr.p_double[m], _state)) )
47629 : {
47630 :
47631 : /*
47632 : * Chase bulge from top (big end) to bottom (small end)
47633 : */
47634 0 : idir = 1;
47635 : }
47636 : else
47637 : {
47638 :
47639 : /*
47640 : * Chase bulge from bottom (big end) to top (small end)
47641 : */
47642 0 : idir = 2;
47643 : }
47644 : }
47645 :
47646 : /*
47647 : * Apply convergence tests
47648 : */
47649 0 : if( idir==1 )
47650 : {
47651 :
47652 : /*
47653 : * Run convergence test in forward direction
47654 : * First apply standard test to bottom of matrix
47655 : */
47656 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[m], _state))||(ae_fp_less(tol,(double)(0))&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh)) )
47657 : {
47658 0 : e->ptr.p_double[m-1] = (double)(0);
47659 0 : continue;
47660 : }
47661 0 : if( ae_fp_greater_eq(tol,(double)(0)) )
47662 : {
47663 :
47664 : /*
47665 : * If relative accuracy desired,
47666 : * apply convergence criterion forward
47667 : */
47668 0 : mu = ae_fabs(d->ptr.p_double[ll], _state);
47669 0 : sminl = mu;
47670 0 : iterflag = ae_false;
47671 0 : for(lll=ll; lll<=m-1; lll++)
47672 : {
47673 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) )
47674 : {
47675 0 : e->ptr.p_double[lll] = (double)(0);
47676 0 : iterflag = ae_true;
47677 0 : break;
47678 : }
47679 0 : mu = ae_fabs(d->ptr.p_double[lll+1], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state)));
47680 0 : sminl = ae_minreal(sminl, mu, _state);
47681 : }
47682 0 : if( iterflag )
47683 : {
47684 0 : continue;
47685 : }
47686 : }
47687 : }
47688 : else
47689 : {
47690 :
47691 : /*
47692 : * Run convergence test in backward direction
47693 : * First apply standard test to top of matrix
47694 : */
47695 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[ll], _state))||(ae_fp_less(tol,(double)(0))&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh)) )
47696 : {
47697 0 : e->ptr.p_double[ll] = (double)(0);
47698 0 : continue;
47699 : }
47700 0 : if( ae_fp_greater_eq(tol,(double)(0)) )
47701 : {
47702 :
47703 : /*
47704 : * If relative accuracy desired,
47705 : * apply convergence criterion backward
47706 : */
47707 0 : mu = ae_fabs(d->ptr.p_double[m], _state);
47708 0 : sminl = mu;
47709 0 : iterflag = ae_false;
47710 0 : for(lll=m-1; lll>=ll; lll--)
47711 : {
47712 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) )
47713 : {
47714 0 : e->ptr.p_double[lll] = (double)(0);
47715 0 : iterflag = ae_true;
47716 0 : break;
47717 : }
47718 0 : mu = ae_fabs(d->ptr.p_double[lll], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state)));
47719 0 : sminl = ae_minreal(sminl, mu, _state);
47720 : }
47721 0 : if( iterflag )
47722 : {
47723 0 : continue;
47724 : }
47725 : }
47726 : }
47727 0 : oldll = ll;
47728 0 : oldm = m;
47729 :
47730 : /*
47731 : * Compute shift. First, test if shifting would ruin relative
47732 : * accuracy, and if so set the shift to zero.
47733 : */
47734 0 : if( ae_fp_greater_eq(tol,(double)(0))&&ae_fp_less_eq(n*tol*(sminl/smax),ae_maxreal(eps, 0.01*tol, _state)) )
47735 : {
47736 :
47737 : /*
47738 : * Use a zero shift to avoid loss of relative accuracy
47739 : */
47740 0 : shift = (double)(0);
47741 : }
47742 : else
47743 : {
47744 :
47745 : /*
47746 : * Compute the shift from 2-by-2 block at end of matrix
47747 : */
47748 0 : if( idir==1 )
47749 : {
47750 0 : sll = ae_fabs(d->ptr.p_double[ll], _state);
47751 0 : bdsvd_svd2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &shift, &r, _state);
47752 : }
47753 : else
47754 : {
47755 0 : sll = ae_fabs(d->ptr.p_double[m], _state);
47756 0 : bdsvd_svd2x2(d->ptr.p_double[ll], e->ptr.p_double[ll], d->ptr.p_double[ll+1], &shift, &r, _state);
47757 : }
47758 :
47759 : /*
47760 : * Test if shift negligible, and if so set to zero
47761 : */
47762 0 : if( ae_fp_greater(sll,(double)(0)) )
47763 : {
47764 0 : if( ae_fp_less(ae_sqr(shift/sll, _state),eps) )
47765 : {
47766 0 : shift = (double)(0);
47767 : }
47768 : }
47769 : }
47770 :
47771 : /*
47772 : * Increment iteration count
47773 : */
47774 0 : iter = iter+m-ll;
47775 :
47776 : /*
47777 : * If SHIFT = 0, do simplified QR iteration
47778 : */
47779 0 : if( ae_fp_eq(shift,(double)(0)) )
47780 : {
47781 0 : if( idir==1 )
47782 : {
47783 :
47784 : /*
47785 : * Chase bulge from top to bottom
47786 : * Save cosines and sines for later singular vector updates
47787 : */
47788 0 : cs = (double)(1);
47789 0 : oldcs = (double)(1);
47790 0 : for(i=ll; i<=m-1; i++)
47791 : {
47792 0 : generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i], &cs, &sn, &r, _state);
47793 0 : if( i>ll )
47794 : {
47795 0 : e->ptr.p_double[i-1] = oldsn*r;
47796 : }
47797 0 : generaterotation(oldcs*r, d->ptr.p_double[i+1]*sn, &oldcs, &oldsn, &tmp, _state);
47798 0 : d->ptr.p_double[i] = tmp;
47799 0 : work0.ptr.p_double[i-ll+1] = cs;
47800 0 : work1.ptr.p_double[i-ll+1] = sn;
47801 0 : work2.ptr.p_double[i-ll+1] = oldcs;
47802 0 : work3.ptr.p_double[i-ll+1] = oldsn;
47803 : }
47804 0 : h = d->ptr.p_double[m]*cs;
47805 0 : d->ptr.p_double[m] = h*oldcs;
47806 0 : e->ptr.p_double[m-1] = h*oldsn;
47807 :
47808 : /*
47809 : * Update singular vectors
47810 : */
47811 0 : if( ncvt>0 )
47812 : {
47813 0 : applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state);
47814 : }
47815 0 : if( nru>0 )
47816 : {
47817 0 : applyrotationsfromtheleft(fwddir, ll+ustart-1, m+ustart-1, ustart, uend, &work2, &work3, &ut, &utemp, _state);
47818 : }
47819 0 : if( ncc>0 )
47820 : {
47821 0 : applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state);
47822 : }
47823 :
47824 : /*
47825 : * Test convergence
47826 : */
47827 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) )
47828 : {
47829 0 : e->ptr.p_double[m-1] = (double)(0);
47830 : }
47831 : }
47832 : else
47833 : {
47834 :
47835 : /*
47836 : * Chase bulge from bottom to top
47837 : * Save cosines and sines for later singular vector updates
47838 : */
47839 0 : cs = (double)(1);
47840 0 : oldcs = (double)(1);
47841 0 : for(i=m; i>=ll+1; i--)
47842 : {
47843 0 : generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i-1], &cs, &sn, &r, _state);
47844 0 : if( i<m )
47845 : {
47846 0 : e->ptr.p_double[i] = oldsn*r;
47847 : }
47848 0 : generaterotation(oldcs*r, d->ptr.p_double[i-1]*sn, &oldcs, &oldsn, &tmp, _state);
47849 0 : d->ptr.p_double[i] = tmp;
47850 0 : work0.ptr.p_double[i-ll] = cs;
47851 0 : work1.ptr.p_double[i-ll] = -sn;
47852 0 : work2.ptr.p_double[i-ll] = oldcs;
47853 0 : work3.ptr.p_double[i-ll] = -oldsn;
47854 : }
47855 0 : h = d->ptr.p_double[ll]*cs;
47856 0 : d->ptr.p_double[ll] = h*oldcs;
47857 0 : e->ptr.p_double[ll] = h*oldsn;
47858 :
47859 : /*
47860 : * Update singular vectors
47861 : */
47862 0 : if( ncvt>0 )
47863 : {
47864 0 : applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state);
47865 : }
47866 0 : if( nru>0 )
47867 : {
47868 0 : applyrotationsfromtheleft(!fwddir, ll+ustart-1, m+ustart-1, ustart, uend, &work0, &work1, &ut, &utemp, _state);
47869 : }
47870 0 : if( ncc>0 )
47871 : {
47872 0 : applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state);
47873 : }
47874 :
47875 : /*
47876 : * Test convergence
47877 : */
47878 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) )
47879 : {
47880 0 : e->ptr.p_double[ll] = (double)(0);
47881 : }
47882 : }
47883 : }
47884 : else
47885 : {
47886 :
47887 : /*
47888 : * Use nonzero shift
47889 : */
47890 0 : if( idir==1 )
47891 : {
47892 :
47893 : /*
47894 : * Chase bulge from top to bottom
47895 : * Save cosines and sines for later singular vector updates
47896 : */
47897 0 : f = (ae_fabs(d->ptr.p_double[ll], _state)-shift)*(bdsvd_extsignbdsqr((double)(1), d->ptr.p_double[ll], _state)+shift/d->ptr.p_double[ll]);
47898 0 : g = e->ptr.p_double[ll];
47899 0 : for(i=ll; i<=m-1; i++)
47900 : {
47901 0 : generaterotation(f, g, &cosr, &sinr, &r, _state);
47902 0 : if( i>ll )
47903 : {
47904 0 : e->ptr.p_double[i-1] = r;
47905 : }
47906 0 : f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i];
47907 0 : e->ptr.p_double[i] = cosr*e->ptr.p_double[i]-sinr*d->ptr.p_double[i];
47908 0 : g = sinr*d->ptr.p_double[i+1];
47909 0 : d->ptr.p_double[i+1] = cosr*d->ptr.p_double[i+1];
47910 0 : generaterotation(f, g, &cosl, &sinl, &r, _state);
47911 0 : d->ptr.p_double[i] = r;
47912 0 : f = cosl*e->ptr.p_double[i]+sinl*d->ptr.p_double[i+1];
47913 0 : d->ptr.p_double[i+1] = cosl*d->ptr.p_double[i+1]-sinl*e->ptr.p_double[i];
47914 0 : if( i<m-1 )
47915 : {
47916 0 : g = sinl*e->ptr.p_double[i+1];
47917 0 : e->ptr.p_double[i+1] = cosl*e->ptr.p_double[i+1];
47918 : }
47919 0 : work0.ptr.p_double[i-ll+1] = cosr;
47920 0 : work1.ptr.p_double[i-ll+1] = sinr;
47921 0 : work2.ptr.p_double[i-ll+1] = cosl;
47922 0 : work3.ptr.p_double[i-ll+1] = sinl;
47923 : }
47924 0 : e->ptr.p_double[m-1] = f;
47925 :
47926 : /*
47927 : * Update singular vectors
47928 : */
47929 0 : if( ncvt>0 )
47930 : {
47931 0 : applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state);
47932 : }
47933 0 : if( nru>0 )
47934 : {
47935 0 : applyrotationsfromtheleft(fwddir, ll+ustart-1, m+ustart-1, ustart, uend, &work2, &work3, &ut, &utemp, _state);
47936 : }
47937 0 : if( ncc>0 )
47938 : {
47939 0 : applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state);
47940 : }
47941 :
47942 : /*
47943 : * Test convergence
47944 : */
47945 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) )
47946 : {
47947 0 : e->ptr.p_double[m-1] = (double)(0);
47948 : }
47949 : }
47950 : else
47951 : {
47952 :
47953 : /*
47954 : * Chase bulge from bottom to top
47955 : * Save cosines and sines for later singular vector updates
47956 : */
47957 0 : f = (ae_fabs(d->ptr.p_double[m], _state)-shift)*(bdsvd_extsignbdsqr((double)(1), d->ptr.p_double[m], _state)+shift/d->ptr.p_double[m]);
47958 0 : g = e->ptr.p_double[m-1];
47959 0 : for(i=m; i>=ll+1; i--)
47960 : {
47961 0 : generaterotation(f, g, &cosr, &sinr, &r, _state);
47962 0 : if( i<m )
47963 : {
47964 0 : e->ptr.p_double[i] = r;
47965 : }
47966 0 : f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i-1];
47967 0 : e->ptr.p_double[i-1] = cosr*e->ptr.p_double[i-1]-sinr*d->ptr.p_double[i];
47968 0 : g = sinr*d->ptr.p_double[i-1];
47969 0 : d->ptr.p_double[i-1] = cosr*d->ptr.p_double[i-1];
47970 0 : generaterotation(f, g, &cosl, &sinl, &r, _state);
47971 0 : d->ptr.p_double[i] = r;
47972 0 : f = cosl*e->ptr.p_double[i-1]+sinl*d->ptr.p_double[i-1];
47973 0 : d->ptr.p_double[i-1] = cosl*d->ptr.p_double[i-1]-sinl*e->ptr.p_double[i-1];
47974 0 : if( i>ll+1 )
47975 : {
47976 0 : g = sinl*e->ptr.p_double[i-2];
47977 0 : e->ptr.p_double[i-2] = cosl*e->ptr.p_double[i-2];
47978 : }
47979 0 : work0.ptr.p_double[i-ll] = cosr;
47980 0 : work1.ptr.p_double[i-ll] = -sinr;
47981 0 : work2.ptr.p_double[i-ll] = cosl;
47982 0 : work3.ptr.p_double[i-ll] = -sinl;
47983 : }
47984 0 : e->ptr.p_double[ll] = f;
47985 :
47986 : /*
47987 : * Test convergence
47988 : */
47989 0 : if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) )
47990 : {
47991 0 : e->ptr.p_double[ll] = (double)(0);
47992 : }
47993 :
47994 : /*
47995 : * Update singular vectors if desired
47996 : */
47997 0 : if( ncvt>0 )
47998 : {
47999 0 : applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state);
48000 : }
48001 0 : if( nru>0 )
48002 : {
48003 0 : applyrotationsfromtheleft(!fwddir, ll+ustart-1, m+ustart-1, ustart, uend, &work0, &work1, &ut, &utemp, _state);
48004 : }
48005 0 : if( ncc>0 )
48006 : {
48007 0 : applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state);
48008 : }
48009 : }
48010 : }
48011 :
48012 : /*
48013 : * QR iteration finished, go back and check convergence
48014 : */
48015 0 : continue;
48016 : }
48017 :
48018 : /*
48019 : * All singular values converged, so make them positive
48020 : */
48021 0 : for(i=1; i<=n; i++)
48022 : {
48023 0 : if( ae_fp_less(d->ptr.p_double[i],(double)(0)) )
48024 : {
48025 0 : d->ptr.p_double[i] = -d->ptr.p_double[i];
48026 :
48027 : /*
48028 : * Change sign of singular vectors, if desired
48029 : */
48030 0 : if( ncvt>0 )
48031 : {
48032 0 : ae_v_muld(&vt->ptr.pp_double[i+vstart-1][vstart], 1, ae_v_len(vstart,vend), -1);
48033 : }
48034 : }
48035 : }
48036 :
48037 : /*
48038 : * Sort the singular values into decreasing order (insertion sort on
48039 : * singular values, but only one transposition per singular vector)
48040 : */
48041 0 : for(i=1; i<=n-1; i++)
48042 : {
48043 :
48044 : /*
48045 : * Scan for smallest D(I)
48046 : */
48047 0 : isub = 1;
48048 0 : smin = d->ptr.p_double[1];
48049 0 : for(j=2; j<=n+1-i; j++)
48050 : {
48051 0 : if( ae_fp_less_eq(d->ptr.p_double[j],smin) )
48052 : {
48053 0 : isub = j;
48054 0 : smin = d->ptr.p_double[j];
48055 : }
48056 : }
48057 0 : if( isub!=n+1-i )
48058 : {
48059 :
48060 : /*
48061 : * Swap singular values and vectors
48062 : */
48063 0 : d->ptr.p_double[isub] = d->ptr.p_double[n+1-i];
48064 0 : d->ptr.p_double[n+1-i] = smin;
48065 0 : if( ncvt>0 )
48066 : {
48067 0 : j = n+1-i;
48068 0 : ae_v_move(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[isub+vstart-1][vstart], 1, ae_v_len(vstart,vend));
48069 0 : ae_v_move(&vt->ptr.pp_double[isub+vstart-1][vstart], 1, &vt->ptr.pp_double[j+vstart-1][vstart], 1, ae_v_len(vstart,vend));
48070 0 : ae_v_move(&vt->ptr.pp_double[j+vstart-1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend));
48071 : }
48072 0 : if( nru>0 )
48073 : {
48074 0 : j = n+1-i;
48075 0 : ae_v_move(&utemp.ptr.p_double[ustart], 1, &ut.ptr.pp_double[isub+ustart-1][ustart], 1, ae_v_len(ustart,uend));
48076 0 : ae_v_move(&ut.ptr.pp_double[isub+ustart-1][ustart], 1, &ut.ptr.pp_double[j+ustart-1][ustart], 1, ae_v_len(ustart,uend));
48077 0 : ae_v_move(&ut.ptr.pp_double[j+ustart-1][ustart], 1, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend));
48078 : }
48079 0 : if( ncc>0 )
48080 : {
48081 0 : j = n+1-i;
48082 0 : ae_v_move(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[isub+cstart-1][cstart], 1, ae_v_len(cstart,cend));
48083 0 : ae_v_move(&c->ptr.pp_double[isub+cstart-1][cstart], 1, &c->ptr.pp_double[j+cstart-1][cstart], 1, ae_v_len(cstart,cend));
48084 0 : ae_v_move(&c->ptr.pp_double[j+cstart-1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend));
48085 : }
48086 : }
48087 : }
48088 :
48089 : /*
48090 : * Copy U back from temporary storage
48091 : */
48092 0 : if( nru>0 )
48093 : {
48094 0 : rmatrixtranspose(n, nru, &ut, ustart, ustart, uu, ustart, ustart, _state);
48095 : }
48096 0 : ae_frame_leave(_state);
48097 0 : return result;
48098 : }
48099 :
48100 :
48101 0 : static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state)
48102 : {
48103 : double result;
48104 :
48105 :
48106 0 : if( ae_fp_greater_eq(b,(double)(0)) )
48107 : {
48108 0 : result = ae_fabs(a, _state);
48109 : }
48110 : else
48111 : {
48112 0 : result = -ae_fabs(a, _state);
48113 : }
48114 0 : return result;
48115 : }
48116 :
48117 :
48118 0 : static void bdsvd_svd2x2(double f,
48119 : double g,
48120 : double h,
48121 : double* ssmin,
48122 : double* ssmax,
48123 : ae_state *_state)
48124 : {
48125 : double aas;
48126 : double at;
48127 : double au;
48128 : double c;
48129 : double fa;
48130 : double fhmn;
48131 : double fhmx;
48132 : double ga;
48133 : double ha;
48134 :
48135 0 : *ssmin = 0;
48136 0 : *ssmax = 0;
48137 :
48138 0 : fa = ae_fabs(f, _state);
48139 0 : ga = ae_fabs(g, _state);
48140 0 : ha = ae_fabs(h, _state);
48141 0 : fhmn = ae_minreal(fa, ha, _state);
48142 0 : fhmx = ae_maxreal(fa, ha, _state);
48143 0 : if( ae_fp_eq(fhmn,(double)(0)) )
48144 : {
48145 0 : *ssmin = (double)(0);
48146 0 : if( ae_fp_eq(fhmx,(double)(0)) )
48147 : {
48148 0 : *ssmax = ga;
48149 : }
48150 : else
48151 : {
48152 0 : *ssmax = ae_maxreal(fhmx, ga, _state)*ae_sqrt(1+ae_sqr(ae_minreal(fhmx, ga, _state)/ae_maxreal(fhmx, ga, _state), _state), _state);
48153 : }
48154 : }
48155 : else
48156 : {
48157 0 : if( ae_fp_less(ga,fhmx) )
48158 : {
48159 0 : aas = 1+fhmn/fhmx;
48160 0 : at = (fhmx-fhmn)/fhmx;
48161 0 : au = ae_sqr(ga/fhmx, _state);
48162 0 : c = 2/(ae_sqrt(aas*aas+au, _state)+ae_sqrt(at*at+au, _state));
48163 0 : *ssmin = fhmn*c;
48164 0 : *ssmax = fhmx/c;
48165 : }
48166 : else
48167 : {
48168 0 : au = fhmx/ga;
48169 0 : if( ae_fp_eq(au,(double)(0)) )
48170 : {
48171 :
48172 : /*
48173 : * Avoid possible harmful underflow if exponent range
48174 : * asymmetric (true SSMIN may not underflow even if
48175 : * AU underflows)
48176 : */
48177 0 : *ssmin = fhmn*fhmx/ga;
48178 0 : *ssmax = ga;
48179 : }
48180 : else
48181 : {
48182 0 : aas = 1+fhmn/fhmx;
48183 0 : at = (fhmx-fhmn)/fhmx;
48184 0 : c = 1/(ae_sqrt(1+ae_sqr(aas*au, _state), _state)+ae_sqrt(1+ae_sqr(at*au, _state), _state));
48185 0 : *ssmin = fhmn*c*au;
48186 0 : *ssmin = *ssmin+(*ssmin);
48187 0 : *ssmax = ga/(c+c);
48188 : }
48189 : }
48190 : }
48191 0 : }
48192 :
48193 :
48194 0 : static void bdsvd_svdv2x2(double f,
48195 : double g,
48196 : double h,
48197 : double* ssmin,
48198 : double* ssmax,
48199 : double* snr,
48200 : double* csr,
48201 : double* snl,
48202 : double* csl,
48203 : ae_state *_state)
48204 : {
48205 : ae_bool gasmal;
48206 : ae_bool swp;
48207 : ae_int_t pmax;
48208 : double a;
48209 : double clt;
48210 : double crt;
48211 : double d;
48212 : double fa;
48213 : double ft;
48214 : double ga;
48215 : double gt;
48216 : double ha;
48217 : double ht;
48218 : double l;
48219 : double m;
48220 : double mm;
48221 : double r;
48222 : double s;
48223 : double slt;
48224 : double srt;
48225 : double t;
48226 : double temp;
48227 : double tsign;
48228 : double tt;
48229 : double v;
48230 :
48231 0 : *ssmin = 0;
48232 0 : *ssmax = 0;
48233 0 : *snr = 0;
48234 0 : *csr = 0;
48235 0 : *snl = 0;
48236 0 : *csl = 0;
48237 :
48238 0 : ft = f;
48239 0 : fa = ae_fabs(ft, _state);
48240 0 : ht = h;
48241 0 : ha = ae_fabs(h, _state);
48242 :
48243 : /*
48244 : * these initializers are not really necessary,
48245 : * but without them compiler complains about uninitialized locals
48246 : */
48247 0 : clt = (double)(0);
48248 0 : crt = (double)(0);
48249 0 : slt = (double)(0);
48250 0 : srt = (double)(0);
48251 0 : tsign = (double)(0);
48252 :
48253 : /*
48254 : * PMAX points to the maximum absolute element of matrix
48255 : * PMAX = 1 if F largest in absolute values
48256 : * PMAX = 2 if G largest in absolute values
48257 : * PMAX = 3 if H largest in absolute values
48258 : */
48259 0 : pmax = 1;
48260 0 : swp = ae_fp_greater(ha,fa);
48261 0 : if( swp )
48262 : {
48263 :
48264 : /*
48265 : * Now FA .ge. HA
48266 : */
48267 0 : pmax = 3;
48268 0 : temp = ft;
48269 0 : ft = ht;
48270 0 : ht = temp;
48271 0 : temp = fa;
48272 0 : fa = ha;
48273 0 : ha = temp;
48274 : }
48275 0 : gt = g;
48276 0 : ga = ae_fabs(gt, _state);
48277 0 : if( ae_fp_eq(ga,(double)(0)) )
48278 : {
48279 :
48280 : /*
48281 : * Diagonal matrix
48282 : */
48283 0 : *ssmin = ha;
48284 0 : *ssmax = fa;
48285 0 : clt = (double)(1);
48286 0 : crt = (double)(1);
48287 0 : slt = (double)(0);
48288 0 : srt = (double)(0);
48289 : }
48290 : else
48291 : {
48292 0 : gasmal = ae_true;
48293 0 : if( ae_fp_greater(ga,fa) )
48294 : {
48295 0 : pmax = 2;
48296 0 : if( ae_fp_less(fa/ga,ae_machineepsilon) )
48297 : {
48298 :
48299 : /*
48300 : * Case of very large GA
48301 : */
48302 0 : gasmal = ae_false;
48303 0 : *ssmax = ga;
48304 0 : if( ae_fp_greater(ha,(double)(1)) )
48305 : {
48306 0 : v = ga/ha;
48307 0 : *ssmin = fa/v;
48308 : }
48309 : else
48310 : {
48311 0 : v = fa/ga;
48312 0 : *ssmin = v*ha;
48313 : }
48314 0 : clt = (double)(1);
48315 0 : slt = ht/gt;
48316 0 : srt = (double)(1);
48317 0 : crt = ft/gt;
48318 : }
48319 : }
48320 0 : if( gasmal )
48321 : {
48322 :
48323 : /*
48324 : * Normal case
48325 : */
48326 0 : d = fa-ha;
48327 0 : if( ae_fp_eq(d,fa) )
48328 : {
48329 0 : l = (double)(1);
48330 : }
48331 : else
48332 : {
48333 0 : l = d/fa;
48334 : }
48335 0 : m = gt/ft;
48336 0 : t = 2-l;
48337 0 : mm = m*m;
48338 0 : tt = t*t;
48339 0 : s = ae_sqrt(tt+mm, _state);
48340 0 : if( ae_fp_eq(l,(double)(0)) )
48341 : {
48342 0 : r = ae_fabs(m, _state);
48343 : }
48344 : else
48345 : {
48346 0 : r = ae_sqrt(l*l+mm, _state);
48347 : }
48348 0 : a = 0.5*(s+r);
48349 0 : *ssmin = ha/a;
48350 0 : *ssmax = fa*a;
48351 0 : if( ae_fp_eq(mm,(double)(0)) )
48352 : {
48353 :
48354 : /*
48355 : * Note that M is very tiny
48356 : */
48357 0 : if( ae_fp_eq(l,(double)(0)) )
48358 : {
48359 0 : t = bdsvd_extsignbdsqr((double)(2), ft, _state)*bdsvd_extsignbdsqr((double)(1), gt, _state);
48360 : }
48361 : else
48362 : {
48363 0 : t = gt/bdsvd_extsignbdsqr(d, ft, _state)+m/t;
48364 : }
48365 : }
48366 : else
48367 : {
48368 0 : t = (m/(s+t)+m/(r+l))*(1+a);
48369 : }
48370 0 : l = ae_sqrt(t*t+4, _state);
48371 0 : crt = 2/l;
48372 0 : srt = t/l;
48373 0 : clt = (crt+srt*m)/a;
48374 0 : v = ht/ft;
48375 0 : slt = v*srt/a;
48376 : }
48377 : }
48378 0 : if( swp )
48379 : {
48380 0 : *csl = srt;
48381 0 : *snl = crt;
48382 0 : *csr = slt;
48383 0 : *snr = clt;
48384 : }
48385 : else
48386 : {
48387 0 : *csl = clt;
48388 0 : *snl = slt;
48389 0 : *csr = crt;
48390 0 : *snr = srt;
48391 : }
48392 :
48393 : /*
48394 : * Correct signs of SSMAX and SSMIN
48395 : */
48396 0 : if( pmax==1 )
48397 : {
48398 0 : tsign = bdsvd_extsignbdsqr((double)(1), *csr, _state)*bdsvd_extsignbdsqr((double)(1), *csl, _state)*bdsvd_extsignbdsqr((double)(1), f, _state);
48399 : }
48400 0 : if( pmax==2 )
48401 : {
48402 0 : tsign = bdsvd_extsignbdsqr((double)(1), *snr, _state)*bdsvd_extsignbdsqr((double)(1), *csl, _state)*bdsvd_extsignbdsqr((double)(1), g, _state);
48403 : }
48404 0 : if( pmax==3 )
48405 : {
48406 0 : tsign = bdsvd_extsignbdsqr((double)(1), *snr, _state)*bdsvd_extsignbdsqr((double)(1), *snl, _state)*bdsvd_extsignbdsqr((double)(1), h, _state);
48407 : }
48408 0 : *ssmax = bdsvd_extsignbdsqr(*ssmax, tsign, _state);
48409 0 : *ssmin = bdsvd_extsignbdsqr(*ssmin, tsign*bdsvd_extsignbdsqr((double)(1), f, _state)*bdsvd_extsignbdsqr((double)(1), h, _state), _state);
48410 0 : }
48411 :
48412 :
48413 : #endif
48414 : #if defined(AE_COMPILE_SVD) || !defined(AE_PARTIAL_BUILD)
48415 :
48416 :
48417 : /*************************************************************************
48418 : Singular value decomposition of a rectangular matrix.
48419 :
48420 : ! COMMERCIAL EDITION OF ALGLIB:
48421 : !
48422 : ! Commercial Edition of ALGLIB includes following important improvements
48423 : ! of this function:
48424 : ! * high-performance native backend with same C# interface (C# version)
48425 : ! * hardware vendor (Intel) implementations of linear algebra primitives
48426 : ! (C++ and C# versions, x86/x64 platform)
48427 : !
48428 : ! We recommend you to read 'Working with commercial version' section of
48429 : ! ALGLIB Reference Manual in order to find out how to use performance-
48430 : ! related features provided by commercial edition of ALGLIB.
48431 :
48432 : The algorithm calculates the singular value decomposition of a matrix of
48433 : size MxN: A = U * S * V^T
48434 :
48435 : The algorithm finds the singular values and, optionally, matrices U and V^T.
48436 : The algorithm can find both first min(M,N) columns of matrix U and rows of
48437 : matrix V^T (singular vectors), and matrices U and V^T wholly (of sizes MxM
48438 : and NxN respectively).
48439 :
48440 : Take into account that the subroutine does not return matrix V but V^T.
48441 :
48442 : Input parameters:
48443 : A - matrix to be decomposed.
48444 : Array whose indexes range within [0..M-1, 0..N-1].
48445 : M - number of rows in matrix A.
48446 : N - number of columns in matrix A.
48447 : UNeeded - 0, 1 or 2. See the description of the parameter U.
48448 : VTNeeded - 0, 1 or 2. See the description of the parameter VT.
48449 : AdditionalMemory -
48450 : If the parameter:
48451 : * equals 0, the algorithm doesn't use additional
48452 : memory (lower requirements, lower performance).
48453 : * equals 1, the algorithm uses additional
48454 : memory of size min(M,N)*min(M,N) of real numbers.
48455 : It often speeds up the algorithm.
48456 : * equals 2, the algorithm uses additional
48457 : memory of size M*min(M,N) of real numbers.
48458 : It allows to get a maximum performance.
48459 : The recommended value of the parameter is 2.
48460 :
48461 : Output parameters:
48462 : W - contains singular values in descending order.
48463 : U - if UNeeded=0, U isn't changed, the left singular vectors
48464 : are not calculated.
48465 : if Uneeded=1, U contains left singular vectors (first
48466 : min(M,N) columns of matrix U). Array whose indexes range
48467 : within [0..M-1, 0..Min(M,N)-1].
48468 : if UNeeded=2, U contains matrix U wholly. Array whose
48469 : indexes range within [0..M-1, 0..M-1].
48470 : VT - if VTNeeded=0, VT isn't changed, the right singular vectors
48471 : are not calculated.
48472 : if VTNeeded=1, VT contains right singular vectors (first
48473 : min(M,N) rows of matrix V^T). Array whose indexes range
48474 : within [0..min(M,N)-1, 0..N-1].
48475 : if VTNeeded=2, VT contains matrix V^T wholly. Array whose
48476 : indexes range within [0..N-1, 0..N-1].
48477 :
48478 : -- ALGLIB --
48479 : Copyright 2005 by Bochkanov Sergey
48480 : *************************************************************************/
48481 0 : ae_bool rmatrixsvd(/* Real */ ae_matrix* a,
48482 : ae_int_t m,
48483 : ae_int_t n,
48484 : ae_int_t uneeded,
48485 : ae_int_t vtneeded,
48486 : ae_int_t additionalmemory,
48487 : /* Real */ ae_vector* w,
48488 : /* Real */ ae_matrix* u,
48489 : /* Real */ ae_matrix* vt,
48490 : ae_state *_state)
48491 : {
48492 : ae_frame _frame_block;
48493 : ae_matrix _a;
48494 : ae_vector tauq;
48495 : ae_vector taup;
48496 : ae_vector tau;
48497 : ae_vector e;
48498 : ae_vector work;
48499 : ae_matrix t2;
48500 : ae_bool isupper;
48501 : ae_int_t minmn;
48502 : ae_int_t ncu;
48503 : ae_int_t nrvt;
48504 : ae_int_t nru;
48505 : ae_int_t ncvt;
48506 : ae_int_t i;
48507 : ae_int_t j;
48508 : ae_bool result;
48509 :
48510 0 : ae_frame_make(_state, &_frame_block);
48511 0 : memset(&_a, 0, sizeof(_a));
48512 0 : memset(&tauq, 0, sizeof(tauq));
48513 0 : memset(&taup, 0, sizeof(taup));
48514 0 : memset(&tau, 0, sizeof(tau));
48515 0 : memset(&e, 0, sizeof(e));
48516 0 : memset(&work, 0, sizeof(work));
48517 0 : memset(&t2, 0, sizeof(t2));
48518 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
48519 0 : a = &_a;
48520 0 : ae_vector_clear(w);
48521 0 : ae_matrix_clear(u);
48522 0 : ae_matrix_clear(vt);
48523 0 : ae_vector_init(&tauq, 0, DT_REAL, _state, ae_true);
48524 0 : ae_vector_init(&taup, 0, DT_REAL, _state, ae_true);
48525 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
48526 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
48527 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
48528 0 : ae_matrix_init(&t2, 0, 0, DT_REAL, _state, ae_true);
48529 :
48530 0 : result = ae_true;
48531 0 : if( m==0||n==0 )
48532 : {
48533 0 : ae_frame_leave(_state);
48534 0 : return result;
48535 : }
48536 0 : ae_assert(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!", _state);
48537 0 : ae_assert(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!", _state);
48538 0 : ae_assert(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!", _state);
48539 :
48540 : /*
48541 : * initialize
48542 : */
48543 0 : minmn = ae_minint(m, n, _state);
48544 0 : ae_vector_set_length(w, minmn+1, _state);
48545 0 : ncu = 0;
48546 0 : nru = 0;
48547 0 : if( uneeded==1 )
48548 : {
48549 0 : nru = m;
48550 0 : ncu = minmn;
48551 0 : ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state);
48552 : }
48553 0 : if( uneeded==2 )
48554 : {
48555 0 : nru = m;
48556 0 : ncu = m;
48557 0 : ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state);
48558 : }
48559 0 : nrvt = 0;
48560 0 : ncvt = 0;
48561 0 : if( vtneeded==1 )
48562 : {
48563 0 : nrvt = minmn;
48564 0 : ncvt = n;
48565 0 : ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state);
48566 : }
48567 0 : if( vtneeded==2 )
48568 : {
48569 0 : nrvt = n;
48570 0 : ncvt = n;
48571 0 : ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state);
48572 : }
48573 :
48574 : /*
48575 : * M much larger than N
48576 : * Use bidiagonal reduction with QR-decomposition
48577 : */
48578 0 : if( ae_fp_greater((double)(m),1.6*n) )
48579 : {
48580 0 : if( uneeded==0 )
48581 : {
48582 :
48583 : /*
48584 : * No left singular vectors to be computed
48585 : */
48586 0 : rmatrixqr(a, m, n, &tau, _state);
48587 0 : for(i=0; i<=n-1; i++)
48588 : {
48589 0 : for(j=0; j<=i-1; j++)
48590 : {
48591 0 : a->ptr.pp_double[i][j] = (double)(0);
48592 : }
48593 : }
48594 0 : rmatrixbd(a, n, n, &tauq, &taup, _state);
48595 0 : rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state);
48596 0 : rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state);
48597 0 : result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, a, 0, vt, ncvt, _state);
48598 0 : ae_frame_leave(_state);
48599 0 : return result;
48600 : }
48601 : else
48602 : {
48603 :
48604 : /*
48605 : * Left singular vectors (may be full matrix U) to be computed
48606 : */
48607 0 : rmatrixqr(a, m, n, &tau, _state);
48608 0 : rmatrixqrunpackq(a, m, n, &tau, ncu, u, _state);
48609 0 : for(i=0; i<=n-1; i++)
48610 : {
48611 0 : for(j=0; j<=i-1; j++)
48612 : {
48613 0 : a->ptr.pp_double[i][j] = (double)(0);
48614 : }
48615 : }
48616 0 : rmatrixbd(a, n, n, &tauq, &taup, _state);
48617 0 : rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state);
48618 0 : rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state);
48619 0 : if( additionalmemory<1 )
48620 : {
48621 :
48622 : /*
48623 : * No additional memory can be used
48624 : */
48625 0 : rmatrixbdmultiplybyq(a, n, n, &tauq, u, m, n, ae_true, ae_false, _state);
48626 0 : result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, m, a, 0, vt, ncvt, _state);
48627 : }
48628 : else
48629 : {
48630 :
48631 : /*
48632 : * Large U. Transforming intermediate matrix T2
48633 : */
48634 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
48635 0 : rmatrixbdunpackq(a, n, n, &tauq, n, &t2, _state);
48636 0 : copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state);
48637 0 : inplacetranspose(&t2, 0, n-1, 0, n-1, &work, _state);
48638 0 : result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, &t2, n, vt, ncvt, _state);
48639 0 : rmatrixgemm(m, n, n, 1.0, a, 0, 0, 0, &t2, 0, 0, 1, 0.0, u, 0, 0, _state);
48640 : }
48641 0 : ae_frame_leave(_state);
48642 0 : return result;
48643 : }
48644 : }
48645 :
48646 : /*
48647 : * N much larger than M
48648 : * Use bidiagonal reduction with LQ-decomposition
48649 : */
48650 0 : if( ae_fp_greater((double)(n),1.6*m) )
48651 : {
48652 0 : if( vtneeded==0 )
48653 : {
48654 :
48655 : /*
48656 : * No right singular vectors to be computed
48657 : */
48658 0 : rmatrixlq(a, m, n, &tau, _state);
48659 0 : for(i=0; i<=m-1; i++)
48660 : {
48661 0 : for(j=i+1; j<=m-1; j++)
48662 : {
48663 0 : a->ptr.pp_double[i][j] = (double)(0);
48664 : }
48665 : }
48666 0 : rmatrixbd(a, m, m, &tauq, &taup, _state);
48667 0 : rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state);
48668 0 : rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state);
48669 0 : ae_vector_set_length(&work, m+1, _state);
48670 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48671 0 : result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, 0, _state);
48672 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48673 0 : ae_frame_leave(_state);
48674 0 : return result;
48675 : }
48676 : else
48677 : {
48678 :
48679 : /*
48680 : * Right singular vectors (may be full matrix VT) to be computed
48681 : */
48682 0 : rmatrixlq(a, m, n, &tau, _state);
48683 0 : rmatrixlqunpackq(a, m, n, &tau, nrvt, vt, _state);
48684 0 : for(i=0; i<=m-1; i++)
48685 : {
48686 0 : for(j=i+1; j<=m-1; j++)
48687 : {
48688 0 : a->ptr.pp_double[i][j] = (double)(0);
48689 : }
48690 : }
48691 0 : rmatrixbd(a, m, m, &tauq, &taup, _state);
48692 0 : rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state);
48693 0 : rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state);
48694 0 : ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state);
48695 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48696 0 : if( additionalmemory<1 )
48697 : {
48698 :
48699 : /*
48700 : * No additional memory available
48701 : */
48702 0 : rmatrixbdmultiplybyp(a, m, m, &taup, vt, m, n, ae_false, ae_true, _state);
48703 0 : result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, n, _state);
48704 : }
48705 : else
48706 : {
48707 :
48708 : /*
48709 : * Large VT. Transforming intermediate matrix T2
48710 : */
48711 0 : rmatrixbdunpackpt(a, m, m, &taup, m, &t2, _state);
48712 0 : result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, &t2, m, _state);
48713 0 : copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state);
48714 0 : rmatrixgemm(m, n, m, 1.0, &t2, 0, 0, 0, a, 0, 0, 0, 0.0, vt, 0, 0, _state);
48715 : }
48716 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48717 0 : ae_frame_leave(_state);
48718 0 : return result;
48719 : }
48720 : }
48721 :
48722 : /*
48723 : * M<=N
48724 : * We can use inplace transposition of U to get rid of columnwise operations
48725 : */
48726 0 : if( m<=n )
48727 : {
48728 0 : rmatrixbd(a, m, n, &tauq, &taup, _state);
48729 0 : rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state);
48730 0 : rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state);
48731 0 : rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state);
48732 0 : ae_vector_set_length(&work, m+1, _state);
48733 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48734 0 : result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, a, 0, u, nru, vt, ncvt, _state);
48735 0 : inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state);
48736 0 : ae_frame_leave(_state);
48737 0 : return result;
48738 : }
48739 :
48740 : /*
48741 : * Simple bidiagonal reduction
48742 : */
48743 0 : rmatrixbd(a, m, n, &tauq, &taup, _state);
48744 0 : rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state);
48745 0 : rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state);
48746 0 : rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state);
48747 0 : if( additionalmemory<2||uneeded==0 )
48748 : {
48749 :
48750 : /*
48751 : * We cant use additional memory or there is no need in such operations
48752 : */
48753 0 : result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, nru, a, 0, vt, ncvt, _state);
48754 : }
48755 : else
48756 : {
48757 :
48758 : /*
48759 : * We can use additional memory
48760 : */
48761 0 : ae_matrix_set_length(&t2, minmn-1+1, m-1+1, _state);
48762 0 : copyandtranspose(u, 0, m-1, 0, minmn-1, &t2, 0, minmn-1, 0, m-1, _state);
48763 0 : result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, 0, &t2, m, vt, ncvt, _state);
48764 0 : copyandtranspose(&t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1, _state);
48765 : }
48766 0 : ae_frame_leave(_state);
48767 0 : return result;
48768 : }
48769 :
48770 :
48771 : #endif
48772 : #if defined(AE_COMPILE_NORMESTIMATOR) || !defined(AE_PARTIAL_BUILD)
48773 :
48774 :
48775 : /*************************************************************************
48776 : This procedure initializes matrix norm estimator.
48777 :
48778 : USAGE:
48779 : 1. User initializes algorithm state with NormEstimatorCreate() call
48780 : 2. User calls NormEstimatorEstimateSparse() (or NormEstimatorIteration())
48781 : 3. User calls NormEstimatorResults() to get solution.
48782 :
48783 : INPUT PARAMETERS:
48784 : M - number of rows in the matrix being estimated, M>0
48785 : N - number of columns in the matrix being estimated, N>0
48786 : NStart - number of random starting vectors
48787 : recommended value - at least 5.
48788 : NIts - number of iterations to do with best starting vector
48789 : recommended value - at least 5.
48790 :
48791 : OUTPUT PARAMETERS:
48792 : State - structure which stores algorithm state
48793 :
48794 :
48795 : NOTE: this algorithm is effectively deterministic, i.e. it always returns
48796 : same result when repeatedly called for the same matrix. In fact, algorithm
48797 : uses randomized starting vectors, but internal random numbers generator
48798 : always generates same sequence of the random values (it is a feature, not
48799 : bug).
48800 :
48801 : Algorithm can be made non-deterministic with NormEstimatorSetSeed(0) call.
48802 :
48803 : -- ALGLIB --
48804 : Copyright 06.12.2011 by Bochkanov Sergey
48805 : *************************************************************************/
48806 0 : void normestimatorcreate(ae_int_t m,
48807 : ae_int_t n,
48808 : ae_int_t nstart,
48809 : ae_int_t nits,
48810 : normestimatorstate* state,
48811 : ae_state *_state)
48812 : {
48813 :
48814 0 : _normestimatorstate_clear(state);
48815 :
48816 0 : ae_assert(m>0, "NormEstimatorCreate: M<=0", _state);
48817 0 : ae_assert(n>0, "NormEstimatorCreate: N<=0", _state);
48818 0 : ae_assert(nstart>0, "NormEstimatorCreate: NStart<=0", _state);
48819 0 : ae_assert(nits>0, "NormEstimatorCreate: NIts<=0", _state);
48820 0 : state->m = m;
48821 0 : state->n = n;
48822 0 : state->nstart = nstart;
48823 0 : state->nits = nits;
48824 0 : state->seedval = 11;
48825 0 : hqrndrandomize(&state->r, _state);
48826 0 : ae_vector_set_length(&state->x0, state->n, _state);
48827 0 : ae_vector_set_length(&state->t, state->m, _state);
48828 0 : ae_vector_set_length(&state->x1, state->n, _state);
48829 0 : ae_vector_set_length(&state->xbest, state->n, _state);
48830 0 : ae_vector_set_length(&state->x, ae_maxint(state->n, state->m, _state), _state);
48831 0 : ae_vector_set_length(&state->mv, state->m, _state);
48832 0 : ae_vector_set_length(&state->mtv, state->n, _state);
48833 0 : ae_vector_set_length(&state->rstate.ia, 3+1, _state);
48834 0 : ae_vector_set_length(&state->rstate.ra, 2+1, _state);
48835 0 : state->rstate.stage = -1;
48836 0 : }
48837 :
48838 :
48839 : /*************************************************************************
48840 : This function changes seed value used by algorithm. In some cases we need
48841 : deterministic processing, i.e. subsequent calls must return equal results,
48842 : in other cases we need non-deterministic algorithm which returns different
48843 : results for the same matrix on every pass.
48844 :
48845 : Setting zero seed will lead to non-deterministic algorithm, while non-zero
48846 : value will make our algorithm deterministic.
48847 :
48848 : INPUT PARAMETERS:
48849 : State - norm estimator state, must be initialized with a call
48850 : to NormEstimatorCreate()
48851 : SeedVal - seed value, >=0. Zero value = non-deterministic algo.
48852 :
48853 : -- ALGLIB --
48854 : Copyright 06.12.2011 by Bochkanov Sergey
48855 : *************************************************************************/
48856 0 : void normestimatorsetseed(normestimatorstate* state,
48857 : ae_int_t seedval,
48858 : ae_state *_state)
48859 : {
48860 :
48861 :
48862 0 : ae_assert(seedval>=0, "NormEstimatorSetSeed: SeedVal<0", _state);
48863 0 : state->seedval = seedval;
48864 0 : }
48865 :
48866 :
48867 : /*************************************************************************
48868 :
48869 : -- ALGLIB --
48870 : Copyright 06.12.2011 by Bochkanov Sergey
48871 : *************************************************************************/
48872 0 : ae_bool normestimatoriteration(normestimatorstate* state,
48873 : ae_state *_state)
48874 : {
48875 : ae_int_t n;
48876 : ae_int_t m;
48877 : ae_int_t i;
48878 : ae_int_t itcnt;
48879 : double v;
48880 : double growth;
48881 : double bestgrowth;
48882 : ae_bool result;
48883 :
48884 :
48885 :
48886 : /*
48887 : * Reverse communication preparations
48888 : * I know it looks ugly, but it works the same way
48889 : * anywhere from C++ to Python.
48890 : *
48891 : * This code initializes locals by:
48892 : * * random values determined during code
48893 : * generation - on first subroutine call
48894 : * * values from previous call - on subsequent calls
48895 : */
48896 0 : if( state->rstate.stage>=0 )
48897 : {
48898 0 : n = state->rstate.ia.ptr.p_int[0];
48899 0 : m = state->rstate.ia.ptr.p_int[1];
48900 0 : i = state->rstate.ia.ptr.p_int[2];
48901 0 : itcnt = state->rstate.ia.ptr.p_int[3];
48902 0 : v = state->rstate.ra.ptr.p_double[0];
48903 0 : growth = state->rstate.ra.ptr.p_double[1];
48904 0 : bestgrowth = state->rstate.ra.ptr.p_double[2];
48905 : }
48906 : else
48907 : {
48908 0 : n = 359;
48909 0 : m = -58;
48910 0 : i = -919;
48911 0 : itcnt = -909;
48912 0 : v = 81;
48913 0 : growth = 255;
48914 0 : bestgrowth = 74;
48915 : }
48916 0 : if( state->rstate.stage==0 )
48917 : {
48918 0 : goto lbl_0;
48919 : }
48920 0 : if( state->rstate.stage==1 )
48921 : {
48922 0 : goto lbl_1;
48923 : }
48924 0 : if( state->rstate.stage==2 )
48925 : {
48926 0 : goto lbl_2;
48927 : }
48928 0 : if( state->rstate.stage==3 )
48929 : {
48930 0 : goto lbl_3;
48931 : }
48932 :
48933 : /*
48934 : * Routine body
48935 : */
48936 0 : n = state->n;
48937 0 : m = state->m;
48938 0 : if( state->seedval>0 )
48939 : {
48940 0 : hqrndseed(state->seedval, state->seedval+2, &state->r, _state);
48941 : }
48942 0 : bestgrowth = (double)(0);
48943 0 : state->xbest.ptr.p_double[0] = (double)(1);
48944 0 : for(i=1; i<=n-1; i++)
48945 : {
48946 0 : state->xbest.ptr.p_double[i] = (double)(0);
48947 : }
48948 0 : itcnt = 0;
48949 0 : lbl_4:
48950 0 : if( itcnt>state->nstart-1 )
48951 : {
48952 0 : goto lbl_6;
48953 : }
48954 0 : do
48955 : {
48956 0 : v = (double)(0);
48957 0 : for(i=0; i<=n-1; i++)
48958 : {
48959 0 : state->x0.ptr.p_double[i] = hqrndnormal(&state->r, _state);
48960 0 : v = v+ae_sqr(state->x0.ptr.p_double[i], _state);
48961 : }
48962 : }
48963 0 : while(ae_fp_eq(v,(double)(0)));
48964 0 : v = 1/ae_sqrt(v, _state);
48965 0 : ae_v_muld(&state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1), v);
48966 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1));
48967 0 : state->needmv = ae_true;
48968 0 : state->needmtv = ae_false;
48969 0 : state->rstate.stage = 0;
48970 0 : goto lbl_rcomm;
48971 0 : lbl_0:
48972 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1));
48973 0 : state->needmv = ae_false;
48974 0 : state->needmtv = ae_true;
48975 0 : state->rstate.stage = 1;
48976 0 : goto lbl_rcomm;
48977 0 : lbl_1:
48978 0 : ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1));
48979 0 : v = (double)(0);
48980 0 : for(i=0; i<=n-1; i++)
48981 : {
48982 0 : v = v+ae_sqr(state->x1.ptr.p_double[i], _state);
48983 : }
48984 0 : growth = ae_sqrt(ae_sqrt(v, _state), _state);
48985 0 : if( ae_fp_greater(growth,bestgrowth) )
48986 : {
48987 0 : v = 1/ae_sqrt(v, _state);
48988 0 : ae_v_moved(&state->xbest.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v);
48989 0 : bestgrowth = growth;
48990 : }
48991 0 : itcnt = itcnt+1;
48992 0 : goto lbl_4;
48993 0 : lbl_6:
48994 0 : ae_v_move(&state->x0.ptr.p_double[0], 1, &state->xbest.ptr.p_double[0], 1, ae_v_len(0,n-1));
48995 0 : itcnt = 0;
48996 0 : lbl_7:
48997 0 : if( itcnt>state->nits-1 )
48998 : {
48999 0 : goto lbl_9;
49000 : }
49001 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1));
49002 0 : state->needmv = ae_true;
49003 0 : state->needmtv = ae_false;
49004 0 : state->rstate.stage = 2;
49005 0 : goto lbl_rcomm;
49006 0 : lbl_2:
49007 0 : ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1));
49008 0 : state->needmv = ae_false;
49009 0 : state->needmtv = ae_true;
49010 0 : state->rstate.stage = 3;
49011 0 : goto lbl_rcomm;
49012 0 : lbl_3:
49013 0 : ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1));
49014 0 : v = (double)(0);
49015 0 : for(i=0; i<=n-1; i++)
49016 : {
49017 0 : v = v+ae_sqr(state->x1.ptr.p_double[i], _state);
49018 : }
49019 0 : state->repnorm = ae_sqrt(ae_sqrt(v, _state), _state);
49020 0 : if( ae_fp_neq(v,(double)(0)) )
49021 : {
49022 0 : v = 1/ae_sqrt(v, _state);
49023 0 : ae_v_moved(&state->x0.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v);
49024 : }
49025 0 : itcnt = itcnt+1;
49026 0 : goto lbl_7;
49027 0 : lbl_9:
49028 0 : result = ae_false;
49029 0 : return result;
49030 :
49031 : /*
49032 : * Saving state
49033 : */
49034 0 : lbl_rcomm:
49035 0 : result = ae_true;
49036 0 : state->rstate.ia.ptr.p_int[0] = n;
49037 0 : state->rstate.ia.ptr.p_int[1] = m;
49038 0 : state->rstate.ia.ptr.p_int[2] = i;
49039 0 : state->rstate.ia.ptr.p_int[3] = itcnt;
49040 0 : state->rstate.ra.ptr.p_double[0] = v;
49041 0 : state->rstate.ra.ptr.p_double[1] = growth;
49042 0 : state->rstate.ra.ptr.p_double[2] = bestgrowth;
49043 0 : return result;
49044 : }
49045 :
49046 :
49047 : /*************************************************************************
49048 : This function estimates norm of the sparse M*N matrix A.
49049 :
49050 : INPUT PARAMETERS:
49051 : State - norm estimator state, must be initialized with a call
49052 : to NormEstimatorCreate()
49053 : A - sparse M*N matrix, must be converted to CRS format
49054 : prior to calling this function.
49055 :
49056 : After this function is over you can call NormEstimatorResults() to get
49057 : estimate of the norm(A).
49058 :
49059 : -- ALGLIB --
49060 : Copyright 06.12.2011 by Bochkanov Sergey
49061 : *************************************************************************/
49062 0 : void normestimatorestimatesparse(normestimatorstate* state,
49063 : sparsematrix* a,
49064 : ae_state *_state)
49065 : {
49066 :
49067 :
49068 0 : normestimatorrestart(state, _state);
49069 0 : while(normestimatoriteration(state, _state))
49070 : {
49071 0 : if( state->needmv )
49072 : {
49073 0 : sparsemv(a, &state->x, &state->mv, _state);
49074 0 : continue;
49075 : }
49076 0 : if( state->needmtv )
49077 : {
49078 0 : sparsemtv(a, &state->x, &state->mtv, _state);
49079 0 : continue;
49080 : }
49081 : }
49082 0 : }
49083 :
49084 :
49085 : /*************************************************************************
49086 : Matrix norm estimation results
49087 :
49088 : INPUT PARAMETERS:
49089 : State - algorithm state
49090 :
49091 : OUTPUT PARAMETERS:
49092 : Nrm - estimate of the matrix norm, Nrm>=0
49093 :
49094 : -- ALGLIB --
49095 : Copyright 06.12.2011 by Bochkanov Sergey
49096 : *************************************************************************/
49097 0 : void normestimatorresults(normestimatorstate* state,
49098 : double* nrm,
49099 : ae_state *_state)
49100 : {
49101 :
49102 0 : *nrm = 0;
49103 :
49104 0 : *nrm = state->repnorm;
49105 0 : }
49106 :
49107 :
49108 : /*************************************************************************
49109 : This function restarts estimator and prepares it for the next estimation
49110 : round.
49111 :
49112 : INPUT PARAMETERS:
49113 : State - algorithm state
49114 : -- ALGLIB --
49115 : Copyright 06.12.2011 by Bochkanov Sergey
49116 : *************************************************************************/
49117 0 : void normestimatorrestart(normestimatorstate* state, ae_state *_state)
49118 : {
49119 :
49120 :
49121 0 : ae_vector_set_length(&state->rstate.ia, 3+1, _state);
49122 0 : ae_vector_set_length(&state->rstate.ra, 2+1, _state);
49123 0 : state->rstate.stage = -1;
49124 0 : }
49125 :
49126 :
49127 0 : void _normestimatorstate_init(void* _p, ae_state *_state, ae_bool make_automatic)
49128 : {
49129 0 : normestimatorstate *p = (normestimatorstate*)_p;
49130 0 : ae_touch_ptr((void*)p);
49131 0 : ae_vector_init(&p->x0, 0, DT_REAL, _state, make_automatic);
49132 0 : ae_vector_init(&p->x1, 0, DT_REAL, _state, make_automatic);
49133 0 : ae_vector_init(&p->t, 0, DT_REAL, _state, make_automatic);
49134 0 : ae_vector_init(&p->xbest, 0, DT_REAL, _state, make_automatic);
49135 0 : _hqrndstate_init(&p->r, _state, make_automatic);
49136 0 : ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic);
49137 0 : ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic);
49138 0 : ae_vector_init(&p->mtv, 0, DT_REAL, _state, make_automatic);
49139 0 : _rcommstate_init(&p->rstate, _state, make_automatic);
49140 0 : }
49141 :
49142 :
49143 0 : void _normestimatorstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
49144 : {
49145 0 : normestimatorstate *dst = (normestimatorstate*)_dst;
49146 0 : normestimatorstate *src = (normestimatorstate*)_src;
49147 0 : dst->n = src->n;
49148 0 : dst->m = src->m;
49149 0 : dst->nstart = src->nstart;
49150 0 : dst->nits = src->nits;
49151 0 : dst->seedval = src->seedval;
49152 0 : ae_vector_init_copy(&dst->x0, &src->x0, _state, make_automatic);
49153 0 : ae_vector_init_copy(&dst->x1, &src->x1, _state, make_automatic);
49154 0 : ae_vector_init_copy(&dst->t, &src->t, _state, make_automatic);
49155 0 : ae_vector_init_copy(&dst->xbest, &src->xbest, _state, make_automatic);
49156 0 : _hqrndstate_init_copy(&dst->r, &src->r, _state, make_automatic);
49157 0 : ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic);
49158 0 : ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic);
49159 0 : ae_vector_init_copy(&dst->mtv, &src->mtv, _state, make_automatic);
49160 0 : dst->needmv = src->needmv;
49161 0 : dst->needmtv = src->needmtv;
49162 0 : dst->repnorm = src->repnorm;
49163 0 : _rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
49164 0 : }
49165 :
49166 :
49167 0 : void _normestimatorstate_clear(void* _p)
49168 : {
49169 0 : normestimatorstate *p = (normestimatorstate*)_p;
49170 0 : ae_touch_ptr((void*)p);
49171 0 : ae_vector_clear(&p->x0);
49172 0 : ae_vector_clear(&p->x1);
49173 0 : ae_vector_clear(&p->t);
49174 0 : ae_vector_clear(&p->xbest);
49175 0 : _hqrndstate_clear(&p->r);
49176 0 : ae_vector_clear(&p->x);
49177 0 : ae_vector_clear(&p->mv);
49178 0 : ae_vector_clear(&p->mtv);
49179 0 : _rcommstate_clear(&p->rstate);
49180 0 : }
49181 :
49182 :
49183 0 : void _normestimatorstate_destroy(void* _p)
49184 : {
49185 0 : normestimatorstate *p = (normestimatorstate*)_p;
49186 0 : ae_touch_ptr((void*)p);
49187 0 : ae_vector_destroy(&p->x0);
49188 0 : ae_vector_destroy(&p->x1);
49189 0 : ae_vector_destroy(&p->t);
49190 0 : ae_vector_destroy(&p->xbest);
49191 0 : _hqrndstate_destroy(&p->r);
49192 0 : ae_vector_destroy(&p->x);
49193 0 : ae_vector_destroy(&p->mv);
49194 0 : ae_vector_destroy(&p->mtv);
49195 0 : _rcommstate_destroy(&p->rstate);
49196 0 : }
49197 :
49198 :
49199 : #endif
49200 : #if defined(AE_COMPILE_HSSCHUR) || !defined(AE_PARTIAL_BUILD)
49201 :
49202 :
49203 0 : void rmatrixinternalschurdecomposition(/* Real */ ae_matrix* h,
49204 : ae_int_t n,
49205 : ae_int_t tneeded,
49206 : ae_int_t zneeded,
49207 : /* Real */ ae_vector* wr,
49208 : /* Real */ ae_vector* wi,
49209 : /* Real */ ae_matrix* z,
49210 : ae_int_t* info,
49211 : ae_state *_state)
49212 : {
49213 : ae_frame _frame_block;
49214 : ae_int_t i;
49215 : ae_int_t j;
49216 : ae_matrix h1;
49217 : ae_matrix z1;
49218 : ae_vector wr1;
49219 : ae_vector wi1;
49220 :
49221 0 : ae_frame_make(_state, &_frame_block);
49222 0 : memset(&h1, 0, sizeof(h1));
49223 0 : memset(&z1, 0, sizeof(z1));
49224 0 : memset(&wr1, 0, sizeof(wr1));
49225 0 : memset(&wi1, 0, sizeof(wi1));
49226 0 : ae_vector_clear(wr);
49227 0 : ae_vector_clear(wi);
49228 0 : *info = 0;
49229 0 : ae_matrix_init(&h1, 0, 0, DT_REAL, _state, ae_true);
49230 0 : ae_matrix_init(&z1, 0, 0, DT_REAL, _state, ae_true);
49231 0 : ae_vector_init(&wr1, 0, DT_REAL, _state, ae_true);
49232 0 : ae_vector_init(&wi1, 0, DT_REAL, _state, ae_true);
49233 :
49234 :
49235 : /*
49236 : * Allocate space
49237 : */
49238 0 : ae_vector_set_length(wr, n, _state);
49239 0 : ae_vector_set_length(wi, n, _state);
49240 0 : if( zneeded==2 )
49241 : {
49242 0 : rmatrixsetlengthatleast(z, n, n, _state);
49243 : }
49244 :
49245 : /*
49246 : * MKL version
49247 : */
49248 0 : if( rmatrixinternalschurdecompositionmkl(h, n, tneeded, zneeded, wr, wi, z, info, _state) )
49249 : {
49250 0 : ae_frame_leave(_state);
49251 0 : return;
49252 : }
49253 :
49254 : /*
49255 : * ALGLIB version
49256 : */
49257 0 : ae_matrix_set_length(&h1, n+1, n+1, _state);
49258 0 : for(i=0; i<=n-1; i++)
49259 : {
49260 0 : for(j=0; j<=n-1; j++)
49261 : {
49262 0 : h1.ptr.pp_double[1+i][1+j] = h->ptr.pp_double[i][j];
49263 : }
49264 : }
49265 0 : if( zneeded==1 )
49266 : {
49267 0 : ae_matrix_set_length(&z1, n+1, n+1, _state);
49268 0 : for(i=0; i<=n-1; i++)
49269 : {
49270 0 : for(j=0; j<=n-1; j++)
49271 : {
49272 0 : z1.ptr.pp_double[1+i][1+j] = z->ptr.pp_double[i][j];
49273 : }
49274 : }
49275 : }
49276 0 : internalschurdecomposition(&h1, n, tneeded, zneeded, &wr1, &wi1, &z1, info, _state);
49277 0 : for(i=0; i<=n-1; i++)
49278 : {
49279 0 : wr->ptr.p_double[i] = wr1.ptr.p_double[i+1];
49280 0 : wi->ptr.p_double[i] = wi1.ptr.p_double[i+1];
49281 : }
49282 0 : if( tneeded!=0 )
49283 : {
49284 0 : for(i=0; i<=n-1; i++)
49285 : {
49286 0 : for(j=0; j<=n-1; j++)
49287 : {
49288 0 : h->ptr.pp_double[i][j] = h1.ptr.pp_double[1+i][1+j];
49289 : }
49290 : }
49291 : }
49292 0 : if( zneeded!=0 )
49293 : {
49294 0 : rmatrixsetlengthatleast(z, n, n, _state);
49295 0 : for(i=0; i<=n-1; i++)
49296 : {
49297 0 : for(j=0; j<=n-1; j++)
49298 : {
49299 0 : z->ptr.pp_double[i][j] = z1.ptr.pp_double[1+i][1+j];
49300 : }
49301 : }
49302 : }
49303 0 : ae_frame_leave(_state);
49304 : }
49305 :
49306 :
49307 : /*************************************************************************
49308 : Subroutine performing the Schur decomposition of a matrix in upper
49309 : Hessenberg form using the QR algorithm with multiple shifts.
49310 :
49311 : The source matrix H is represented as S'*H*S = T, where H - matrix in
49312 : upper Hessenberg form, S - orthogonal matrix (Schur vectors), T - upper
49313 : quasi-triangular matrix (with blocks of sizes 1x1 and 2x2 on the main
49314 : diagonal).
49315 :
49316 : Input parameters:
49317 : H - matrix to be decomposed.
49318 : Array whose indexes range within [1..N, 1..N].
49319 : N - size of H, N>=0.
49320 :
49321 :
49322 : Output parameters:
49323 : H - contains the matrix T.
49324 : Array whose indexes range within [1..N, 1..N].
49325 : All elements below the blocks on the main diagonal are equal
49326 : to 0.
49327 : S - contains Schur vectors.
49328 : Array whose indexes range within [1..N, 1..N].
49329 :
49330 : Note 1:
49331 : The block structure of matrix T could be easily recognized: since all
49332 : the elements below the blocks are zeros, the elements a[i+1,i] which
49333 : are equal to 0 show the block border.
49334 :
49335 : Note 2:
49336 : the algorithm performance depends on the value of the internal
49337 : parameter NS of InternalSchurDecomposition subroutine which defines
49338 : the number of shifts in the QR algorithm (analog of the block width
49339 : in block matrix algorithms in linear algebra). If you require maximum
49340 : performance on your machine, it is recommended to adjust this
49341 : parameter manually.
49342 :
49343 : Result:
49344 : True, if the algorithm has converged and the parameters H and S contain
49345 : the result.
49346 : False, if the algorithm has not converged.
49347 :
49348 : Algorithm implemented on the basis of subroutine DHSEQR (LAPACK 3.0 library).
49349 : *************************************************************************/
49350 0 : ae_bool upperhessenbergschurdecomposition(/* Real */ ae_matrix* h,
49351 : ae_int_t n,
49352 : /* Real */ ae_matrix* s,
49353 : ae_state *_state)
49354 : {
49355 : ae_frame _frame_block;
49356 : ae_vector wi;
49357 : ae_vector wr;
49358 : ae_int_t info;
49359 : ae_bool result;
49360 :
49361 0 : ae_frame_make(_state, &_frame_block);
49362 0 : memset(&wi, 0, sizeof(wi));
49363 0 : memset(&wr, 0, sizeof(wr));
49364 0 : ae_matrix_clear(s);
49365 0 : ae_vector_init(&wi, 0, DT_REAL, _state, ae_true);
49366 0 : ae_vector_init(&wr, 0, DT_REAL, _state, ae_true);
49367 :
49368 0 : internalschurdecomposition(h, n, 1, 2, &wr, &wi, s, &info, _state);
49369 0 : result = info==0;
49370 0 : ae_frame_leave(_state);
49371 0 : return result;
49372 : }
49373 :
49374 :
49375 0 : void internalschurdecomposition(/* Real */ ae_matrix* h,
49376 : ae_int_t n,
49377 : ae_int_t tneeded,
49378 : ae_int_t zneeded,
49379 : /* Real */ ae_vector* wr,
49380 : /* Real */ ae_vector* wi,
49381 : /* Real */ ae_matrix* z,
49382 : ae_int_t* info,
49383 : ae_state *_state)
49384 : {
49385 : ae_frame _frame_block;
49386 : ae_vector work;
49387 : ae_int_t i;
49388 : ae_int_t i1;
49389 : ae_int_t i2;
49390 : ae_int_t ierr;
49391 : ae_int_t ii;
49392 : ae_int_t itemp;
49393 : ae_int_t itn;
49394 : ae_int_t its;
49395 : ae_int_t j;
49396 : ae_int_t k;
49397 : ae_int_t l;
49398 : ae_int_t maxb;
49399 : ae_int_t nr;
49400 : ae_int_t ns;
49401 : ae_int_t nv;
49402 : double absw;
49403 : double smlnum;
49404 : double tau;
49405 : double temp;
49406 : double tst1;
49407 : double ulp;
49408 : double unfl;
49409 : ae_matrix s;
49410 : ae_vector v;
49411 : ae_vector vv;
49412 : ae_vector workc1;
49413 : ae_vector works1;
49414 : ae_vector workv3;
49415 : ae_vector tmpwr;
49416 : ae_vector tmpwi;
49417 : ae_bool initz;
49418 : ae_bool wantt;
49419 : ae_bool wantz;
49420 : double cnst;
49421 : ae_bool failflag;
49422 : ae_int_t p1;
49423 : ae_int_t p2;
49424 : double vt;
49425 :
49426 0 : ae_frame_make(_state, &_frame_block);
49427 0 : memset(&work, 0, sizeof(work));
49428 0 : memset(&s, 0, sizeof(s));
49429 0 : memset(&v, 0, sizeof(v));
49430 0 : memset(&vv, 0, sizeof(vv));
49431 0 : memset(&workc1, 0, sizeof(workc1));
49432 0 : memset(&works1, 0, sizeof(works1));
49433 0 : memset(&workv3, 0, sizeof(workv3));
49434 0 : memset(&tmpwr, 0, sizeof(tmpwr));
49435 0 : memset(&tmpwi, 0, sizeof(tmpwi));
49436 0 : ae_vector_clear(wr);
49437 0 : ae_vector_clear(wi);
49438 0 : *info = 0;
49439 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
49440 0 : ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true);
49441 0 : ae_vector_init(&v, 0, DT_REAL, _state, ae_true);
49442 0 : ae_vector_init(&vv, 0, DT_REAL, _state, ae_true);
49443 0 : ae_vector_init(&workc1, 0, DT_REAL, _state, ae_true);
49444 0 : ae_vector_init(&works1, 0, DT_REAL, _state, ae_true);
49445 0 : ae_vector_init(&workv3, 0, DT_REAL, _state, ae_true);
49446 0 : ae_vector_init(&tmpwr, 0, DT_REAL, _state, ae_true);
49447 0 : ae_vector_init(&tmpwi, 0, DT_REAL, _state, ae_true);
49448 :
49449 :
49450 : /*
49451 : * Set the order of the multi-shift QR algorithm to be used.
49452 : * If you want to tune algorithm, change this values
49453 : */
49454 0 : ns = 12;
49455 0 : maxb = 50;
49456 :
49457 : /*
49458 : * Now 2 < NS <= MAXB < NH.
49459 : */
49460 0 : maxb = ae_maxint(3, maxb, _state);
49461 0 : ns = ae_minint(maxb, ns, _state);
49462 :
49463 : /*
49464 : * Initialize
49465 : */
49466 0 : cnst = 1.5;
49467 0 : ae_vector_set_length(&work, ae_maxint(n, 1, _state)+1, _state);
49468 0 : ae_matrix_set_length(&s, ns+1, ns+1, _state);
49469 0 : ae_vector_set_length(&v, ns+1+1, _state);
49470 0 : ae_vector_set_length(&vv, ns+1+1, _state);
49471 0 : ae_vector_set_length(wr, ae_maxint(n, 1, _state)+1, _state);
49472 0 : ae_vector_set_length(wi, ae_maxint(n, 1, _state)+1, _state);
49473 0 : ae_vector_set_length(&workc1, 1+1, _state);
49474 0 : ae_vector_set_length(&works1, 1+1, _state);
49475 0 : ae_vector_set_length(&workv3, 3+1, _state);
49476 0 : ae_vector_set_length(&tmpwr, ae_maxint(n, 1, _state)+1, _state);
49477 0 : ae_vector_set_length(&tmpwi, ae_maxint(n, 1, _state)+1, _state);
49478 0 : ae_assert(n>=0, "InternalSchurDecomposition: incorrect N!", _state);
49479 0 : ae_assert(tneeded==0||tneeded==1, "InternalSchurDecomposition: incorrect TNeeded!", _state);
49480 0 : ae_assert((zneeded==0||zneeded==1)||zneeded==2, "InternalSchurDecomposition: incorrect ZNeeded!", _state);
49481 0 : wantt = tneeded==1;
49482 0 : initz = zneeded==2;
49483 0 : wantz = zneeded!=0;
49484 0 : *info = 0;
49485 :
49486 : /*
49487 : * Initialize Z, if necessary
49488 : */
49489 0 : if( initz )
49490 : {
49491 0 : rmatrixsetlengthatleast(z, n+1, n+1, _state);
49492 0 : for(i=1; i<=n; i++)
49493 : {
49494 0 : for(j=1; j<=n; j++)
49495 : {
49496 0 : if( i==j )
49497 : {
49498 0 : z->ptr.pp_double[i][j] = (double)(1);
49499 : }
49500 : else
49501 : {
49502 0 : z->ptr.pp_double[i][j] = (double)(0);
49503 : }
49504 : }
49505 : }
49506 : }
49507 :
49508 : /*
49509 : * Quick return if possible
49510 : */
49511 0 : if( n==0 )
49512 : {
49513 0 : ae_frame_leave(_state);
49514 0 : return;
49515 : }
49516 0 : if( n==1 )
49517 : {
49518 0 : wr->ptr.p_double[1] = h->ptr.pp_double[1][1];
49519 0 : wi->ptr.p_double[1] = (double)(0);
49520 0 : ae_frame_leave(_state);
49521 0 : return;
49522 : }
49523 :
49524 : /*
49525 : * Set rows and columns 1 to N to zero below the first
49526 : * subdiagonal.
49527 : */
49528 0 : for(j=1; j<=n-2; j++)
49529 : {
49530 0 : for(i=j+2; i<=n; i++)
49531 : {
49532 0 : h->ptr.pp_double[i][j] = (double)(0);
49533 : }
49534 : }
49535 :
49536 : /*
49537 : * Test if N is sufficiently small
49538 : */
49539 0 : if( (ns<=2||ns>n)||maxb>=n )
49540 : {
49541 :
49542 : /*
49543 : * Use the standard double-shift algorithm
49544 : */
49545 0 : hsschur_internalauxschur(wantt, wantz, n, 1, n, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state);
49546 :
49547 : /*
49548 : * fill entries under diagonal blocks of T with zeros
49549 : */
49550 0 : if( wantt )
49551 : {
49552 0 : j = 1;
49553 0 : while(j<=n)
49554 : {
49555 0 : if( ae_fp_eq(wi->ptr.p_double[j],(double)(0)) )
49556 : {
49557 0 : for(i=j+1; i<=n; i++)
49558 : {
49559 0 : h->ptr.pp_double[i][j] = (double)(0);
49560 : }
49561 0 : j = j+1;
49562 : }
49563 : else
49564 : {
49565 0 : for(i=j+2; i<=n; i++)
49566 : {
49567 0 : h->ptr.pp_double[i][j] = (double)(0);
49568 0 : h->ptr.pp_double[i][j+1] = (double)(0);
49569 : }
49570 0 : j = j+2;
49571 : }
49572 : }
49573 : }
49574 0 : ae_frame_leave(_state);
49575 0 : return;
49576 : }
49577 0 : unfl = ae_minrealnumber;
49578 0 : ulp = 2*ae_machineepsilon;
49579 0 : smlnum = unfl*(n/ulp);
49580 :
49581 : /*
49582 : * I1 and I2 are the indices of the first row and last column of H
49583 : * to which transformations must be applied. If eigenvalues only are
49584 : * being computed, I1 and I2 are set inside the main loop.
49585 : */
49586 0 : i1 = 1;
49587 0 : i2 = n;
49588 :
49589 : /*
49590 : * ITN is the total number of multiple-shift QR iterations allowed.
49591 : */
49592 0 : itn = 30*n;
49593 :
49594 : /*
49595 : * The main loop begins here. I is the loop index and decreases from
49596 : * IHI to ILO in steps of at most MAXB. Each iteration of the loop
49597 : * works with the active submatrix in rows and columns L to I.
49598 : * Eigenvalues I+1 to IHI have already converged. Either L = ILO or
49599 : * H(L,L-1) is negligible so that the matrix splits.
49600 : */
49601 0 : i = n;
49602 : for(;;)
49603 : {
49604 0 : l = 1;
49605 0 : if( i<1 )
49606 : {
49607 :
49608 : /*
49609 : * fill entries under diagonal blocks of T with zeros
49610 : */
49611 0 : if( wantt )
49612 : {
49613 0 : j = 1;
49614 0 : while(j<=n)
49615 : {
49616 0 : if( ae_fp_eq(wi->ptr.p_double[j],(double)(0)) )
49617 : {
49618 0 : for(i=j+1; i<=n; i++)
49619 : {
49620 0 : h->ptr.pp_double[i][j] = (double)(0);
49621 : }
49622 0 : j = j+1;
49623 : }
49624 : else
49625 : {
49626 0 : for(i=j+2; i<=n; i++)
49627 : {
49628 0 : h->ptr.pp_double[i][j] = (double)(0);
49629 0 : h->ptr.pp_double[i][j+1] = (double)(0);
49630 : }
49631 0 : j = j+2;
49632 : }
49633 : }
49634 : }
49635 :
49636 : /*
49637 : * Exit
49638 : */
49639 0 : ae_frame_leave(_state);
49640 0 : return;
49641 : }
49642 :
49643 : /*
49644 : * Perform multiple-shift QR iterations on rows and columns ILO to I
49645 : * until a submatrix of order at most MAXB splits off at the bottom
49646 : * because a subdiagonal element has become negligible.
49647 : */
49648 0 : failflag = ae_true;
49649 0 : for(its=0; its<=itn; its++)
49650 : {
49651 :
49652 : /*
49653 : * Look for a single small subdiagonal element.
49654 : */
49655 0 : for(k=i; k>=l+1; k--)
49656 : {
49657 0 : tst1 = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state);
49658 0 : if( ae_fp_eq(tst1,(double)(0)) )
49659 : {
49660 0 : tst1 = upperhessenberg1norm(h, l, i, l, i, &work, _state);
49661 : }
49662 0 : if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ae_maxreal(ulp*tst1, smlnum, _state)) )
49663 : {
49664 0 : break;
49665 : }
49666 : }
49667 0 : l = k;
49668 0 : if( l>1 )
49669 : {
49670 :
49671 : /*
49672 : * H(L,L-1) is negligible.
49673 : */
49674 0 : h->ptr.pp_double[l][l-1] = (double)(0);
49675 : }
49676 :
49677 : /*
49678 : * Exit from loop if a submatrix of order <= MAXB has split off.
49679 : */
49680 0 : if( l>=i-maxb+1 )
49681 : {
49682 0 : failflag = ae_false;
49683 0 : break;
49684 : }
49685 :
49686 : /*
49687 : * Now the active submatrix is in rows and columns L to I. If
49688 : * eigenvalues only are being computed, only the active submatrix
49689 : * need be transformed.
49690 : */
49691 0 : if( its==20||its==30 )
49692 : {
49693 :
49694 : /*
49695 : * Exceptional shifts.
49696 : */
49697 0 : for(ii=i-ns+1; ii<=i; ii++)
49698 : {
49699 0 : wr->ptr.p_double[ii] = cnst*(ae_fabs(h->ptr.pp_double[ii][ii-1], _state)+ae_fabs(h->ptr.pp_double[ii][ii], _state));
49700 0 : wi->ptr.p_double[ii] = (double)(0);
49701 : }
49702 : }
49703 : else
49704 : {
49705 :
49706 : /*
49707 : * Use eigenvalues of trailing submatrix of order NS as shifts.
49708 : */
49709 0 : copymatrix(h, i-ns+1, i, i-ns+1, i, &s, 1, ns, 1, ns, _state);
49710 0 : hsschur_internalauxschur(ae_false, ae_false, ns, 1, ns, &s, &tmpwr, &tmpwi, 1, ns, z, &work, &workv3, &workc1, &works1, &ierr, _state);
49711 0 : for(p1=1; p1<=ns; p1++)
49712 : {
49713 0 : wr->ptr.p_double[i-ns+p1] = tmpwr.ptr.p_double[p1];
49714 0 : wi->ptr.p_double[i-ns+p1] = tmpwi.ptr.p_double[p1];
49715 : }
49716 0 : if( ierr>0 )
49717 : {
49718 :
49719 : /*
49720 : * If DLAHQR failed to compute all NS eigenvalues, use the
49721 : * unconverged diagonal elements as the remaining shifts.
49722 : */
49723 0 : for(ii=1; ii<=ierr; ii++)
49724 : {
49725 0 : wr->ptr.p_double[i-ns+ii] = s.ptr.pp_double[ii][ii];
49726 0 : wi->ptr.p_double[i-ns+ii] = (double)(0);
49727 : }
49728 : }
49729 : }
49730 :
49731 : /*
49732 : * Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns))
49733 : * where G is the Hessenberg submatrix H(L:I,L:I) and w is
49734 : * the vector of shifts (stored in WR and WI). The result is
49735 : * stored in the local array V.
49736 : */
49737 0 : v.ptr.p_double[1] = (double)(1);
49738 0 : for(ii=2; ii<=ns+1; ii++)
49739 : {
49740 0 : v.ptr.p_double[ii] = (double)(0);
49741 : }
49742 0 : nv = 1;
49743 0 : for(j=i-ns+1; j<=i; j++)
49744 : {
49745 0 : if( ae_fp_greater_eq(wi->ptr.p_double[j],(double)(0)) )
49746 : {
49747 0 : if( ae_fp_eq(wi->ptr.p_double[j],(double)(0)) )
49748 : {
49749 :
49750 : /*
49751 : * real shift
49752 : */
49753 0 : p1 = nv+1;
49754 0 : ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1));
49755 0 : matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &vv, 1, nv, 1.0, &v, 1, nv+1, -wr->ptr.p_double[j], _state);
49756 0 : nv = nv+1;
49757 : }
49758 : else
49759 : {
49760 0 : if( ae_fp_greater(wi->ptr.p_double[j],(double)(0)) )
49761 : {
49762 :
49763 : /*
49764 : * complex conjugate pair of shifts
49765 : */
49766 0 : p1 = nv+1;
49767 0 : ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1));
49768 0 : matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &v, 1, nv, 1.0, &vv, 1, nv+1, -2*wr->ptr.p_double[j], _state);
49769 0 : itemp = vectoridxabsmax(&vv, 1, nv+1, _state);
49770 0 : temp = 1/ae_maxreal(ae_fabs(vv.ptr.p_double[itemp], _state), smlnum, _state);
49771 0 : p1 = nv+1;
49772 0 : ae_v_muld(&vv.ptr.p_double[1], 1, ae_v_len(1,p1), temp);
49773 0 : absw = pythag2(wr->ptr.p_double[j], wi->ptr.p_double[j], _state);
49774 0 : temp = temp*absw*absw;
49775 0 : matrixvectormultiply(h, l, l+nv+1, l, l+nv, ae_false, &vv, 1, nv+1, 1.0, &v, 1, nv+2, temp, _state);
49776 0 : nv = nv+2;
49777 : }
49778 : }
49779 :
49780 : /*
49781 : * Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero,
49782 : * reset it to the unit vector.
49783 : */
49784 0 : itemp = vectoridxabsmax(&v, 1, nv, _state);
49785 0 : temp = ae_fabs(v.ptr.p_double[itemp], _state);
49786 0 : if( ae_fp_eq(temp,(double)(0)) )
49787 : {
49788 0 : v.ptr.p_double[1] = (double)(1);
49789 0 : for(ii=2; ii<=nv; ii++)
49790 : {
49791 0 : v.ptr.p_double[ii] = (double)(0);
49792 : }
49793 : }
49794 : else
49795 : {
49796 0 : temp = ae_maxreal(temp, smlnum, _state);
49797 0 : vt = 1/temp;
49798 0 : ae_v_muld(&v.ptr.p_double[1], 1, ae_v_len(1,nv), vt);
49799 : }
49800 : }
49801 : }
49802 :
49803 : /*
49804 : * Multiple-shift QR step
49805 : */
49806 0 : for(k=l; k<=i-1; k++)
49807 : {
49808 :
49809 : /*
49810 : * The first iteration of this loop determines a reflection G
49811 : * from the vector V and applies it from left and right to H,
49812 : * thus creating a nonzero bulge below the subdiagonal.
49813 : *
49814 : * Each subsequent iteration determines a reflection G to
49815 : * restore the Hessenberg form in the (K-1)th column, and thus
49816 : * chases the bulge one step toward the bottom of the active
49817 : * submatrix. NR is the order of G.
49818 : */
49819 0 : nr = ae_minint(ns+1, i-k+1, _state);
49820 0 : if( k>l )
49821 : {
49822 0 : p1 = k-1;
49823 0 : p2 = k+nr-1;
49824 0 : ae_v_move(&v.ptr.p_double[1], 1, &h->ptr.pp_double[k][p1], h->stride, ae_v_len(1,nr));
49825 0 : touchint(&p2, _state);
49826 : }
49827 0 : generatereflection(&v, nr, &tau, _state);
49828 0 : if( k>l )
49829 : {
49830 0 : h->ptr.pp_double[k][k-1] = v.ptr.p_double[1];
49831 0 : for(ii=k+1; ii<=i; ii++)
49832 : {
49833 0 : h->ptr.pp_double[ii][k-1] = (double)(0);
49834 : }
49835 : }
49836 0 : v.ptr.p_double[1] = (double)(1);
49837 :
49838 : /*
49839 : * Apply G from the left to transform the rows of the matrix in
49840 : * columns K to I2.
49841 : */
49842 0 : applyreflectionfromtheleft(h, tau, &v, k, k+nr-1, k, i2, &work, _state);
49843 :
49844 : /*
49845 : * Apply G from the right to transform the columns of the
49846 : * matrix in rows I1 to min(K+NR,I).
49847 : */
49848 0 : applyreflectionfromtheright(h, tau, &v, i1, ae_minint(k+nr, i, _state), k, k+nr-1, &work, _state);
49849 0 : if( wantz )
49850 : {
49851 :
49852 : /*
49853 : * Accumulate transformations in the matrix Z
49854 : */
49855 0 : applyreflectionfromtheright(z, tau, &v, 1, n, k, k+nr-1, &work, _state);
49856 : }
49857 : }
49858 : }
49859 :
49860 : /*
49861 : * Failure to converge in remaining number of iterations
49862 : */
49863 0 : if( failflag )
49864 : {
49865 0 : *info = i;
49866 0 : ae_frame_leave(_state);
49867 0 : return;
49868 : }
49869 :
49870 : /*
49871 : * A submatrix of order <= MAXB in rows and columns L to I has split
49872 : * off. Use the double-shift QR algorithm to handle it.
49873 : */
49874 0 : hsschur_internalauxschur(wantt, wantz, n, l, i, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state);
49875 0 : if( *info>0 )
49876 : {
49877 0 : ae_frame_leave(_state);
49878 0 : return;
49879 : }
49880 :
49881 : /*
49882 : * Decrement number of remaining iterations, and return to start of
49883 : * the main loop with a new value of I.
49884 : */
49885 0 : itn = itn-its;
49886 0 : i = l-1;
49887 :
49888 : /*
49889 : * Block below is never executed; it is necessary just to avoid
49890 : * "unreachable code" warning about automatically generated code.
49891 : *
49892 : * We just need a way to transfer control to the end of the function,
49893 : * even a fake way which is never actually traversed.
49894 : */
49895 0 : if( alwaysfalse(_state) )
49896 : {
49897 0 : ae_assert(ae_false, "Assertion failed", _state);
49898 0 : break;
49899 : }
49900 : }
49901 0 : ae_frame_leave(_state);
49902 : }
49903 :
49904 :
49905 : /*************************************************************************
49906 : Translation of DLAHQR from LAPACK.
49907 : *************************************************************************/
49908 0 : static void hsschur_internalauxschur(ae_bool wantt,
49909 : ae_bool wantz,
49910 : ae_int_t n,
49911 : ae_int_t ilo,
49912 : ae_int_t ihi,
49913 : /* Real */ ae_matrix* h,
49914 : /* Real */ ae_vector* wr,
49915 : /* Real */ ae_vector* wi,
49916 : ae_int_t iloz,
49917 : ae_int_t ihiz,
49918 : /* Real */ ae_matrix* z,
49919 : /* Real */ ae_vector* work,
49920 : /* Real */ ae_vector* workv3,
49921 : /* Real */ ae_vector* workc1,
49922 : /* Real */ ae_vector* works1,
49923 : ae_int_t* info,
49924 : ae_state *_state)
49925 : {
49926 : double safmin;
49927 : double tst;
49928 : double ab;
49929 : double ba;
49930 : double aa;
49931 : double bb;
49932 : double rt1r;
49933 : double rt1i;
49934 : double rt2r;
49935 : double rt2i;
49936 : double tr;
49937 : double det;
49938 : double rtdisc;
49939 : double h21s;
49940 : ae_int_t i;
49941 : ae_int_t i1;
49942 : ae_int_t i2;
49943 : ae_int_t itmax;
49944 : ae_int_t its;
49945 : ae_int_t j;
49946 : ae_int_t k;
49947 : ae_int_t l;
49948 : ae_int_t m;
49949 : ae_int_t nh;
49950 : ae_int_t nr;
49951 : ae_int_t nz;
49952 : double cs;
49953 : double h11;
49954 : double h12;
49955 : double h21;
49956 : double h22;
49957 : double s;
49958 : double smlnum;
49959 : double sn;
49960 : double sum;
49961 : double t1;
49962 : double t2;
49963 : double t3;
49964 : double v2;
49965 : double v3;
49966 : ae_bool failflag;
49967 : double dat1;
49968 : double dat2;
49969 : ae_int_t p1;
49970 : double him1im1;
49971 : double him1i;
49972 : double hiim1;
49973 : double hii;
49974 : double wrim1;
49975 : double wri;
49976 : double wiim1;
49977 : double wii;
49978 : double ulp;
49979 :
49980 0 : *info = 0;
49981 :
49982 0 : *info = 0;
49983 0 : dat1 = 0.75;
49984 0 : dat2 = -0.4375;
49985 :
49986 : /*
49987 : * Quick return if possible
49988 : */
49989 0 : if( n==0 )
49990 : {
49991 0 : return;
49992 : }
49993 0 : if( ilo==ihi )
49994 : {
49995 0 : wr->ptr.p_double[ilo] = h->ptr.pp_double[ilo][ilo];
49996 0 : wi->ptr.p_double[ilo] = (double)(0);
49997 0 : return;
49998 : }
49999 :
50000 : /*
50001 : * ==== clear out the trash ====
50002 : */
50003 0 : for(j=ilo; j<=ihi-3; j++)
50004 : {
50005 0 : h->ptr.pp_double[j+2][j] = (double)(0);
50006 0 : h->ptr.pp_double[j+3][j] = (double)(0);
50007 : }
50008 0 : if( ilo<=ihi-2 )
50009 : {
50010 0 : h->ptr.pp_double[ihi][ihi-2] = (double)(0);
50011 : }
50012 0 : nh = ihi-ilo+1;
50013 0 : nz = ihiz-iloz+1;
50014 :
50015 : /*
50016 : * Set machine-dependent constants for the stopping criterion.
50017 : */
50018 0 : safmin = ae_minrealnumber;
50019 0 : ulp = ae_machineepsilon;
50020 0 : smlnum = safmin*(nh/ulp);
50021 :
50022 : /*
50023 : * I1 and I2 are the indices of the first row and last column of H
50024 : * to which transformations must be applied. If eigenvalues only are
50025 : * being computed, I1 and I2 are set inside the main loop.
50026 : *
50027 : * Setting them to large negative value helps to debug possible errors
50028 : * due to uninitialized variables; also it helps to avoid compiler
50029 : * warnings.
50030 : */
50031 0 : i1 = -99999;
50032 0 : i2 = -99999;
50033 0 : if( wantt )
50034 : {
50035 0 : i1 = 1;
50036 0 : i2 = n;
50037 : }
50038 :
50039 : /*
50040 : * ITMAX is the total number of QR iterations allowed.
50041 : */
50042 0 : itmax = 30*ae_maxint(10, nh, _state);
50043 :
50044 : /*
50045 : * The main loop begins here. I is the loop index and decreases from
50046 : * IHI to ILO in steps of 1 or 2. Each iteration of the loop works
50047 : * with the active submatrix in rows and columns L to I.
50048 : * Eigenvalues I+1 to IHI have already converged. Either L = ILO or
50049 : * H(L,L-1) is negligible so that the matrix splits.
50050 : */
50051 0 : i = ihi;
50052 : for(;;)
50053 : {
50054 0 : l = ilo;
50055 0 : if( i<ilo )
50056 : {
50057 0 : return;
50058 : }
50059 :
50060 : /*
50061 : * Perform QR iterations on rows and columns ILO to I until a
50062 : * submatrix of order 1 or 2 splits off at the bottom because a
50063 : * subdiagonal element has become negligible.
50064 : */
50065 0 : failflag = ae_true;
50066 0 : for(its=0; its<=itmax; its++)
50067 : {
50068 :
50069 : /*
50070 : * Look for a single small subdiagonal element.
50071 : */
50072 0 : for(k=i; k>=l+1; k--)
50073 : {
50074 0 : if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),smlnum) )
50075 : {
50076 0 : break;
50077 : }
50078 0 : tst = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state);
50079 0 : if( ae_fp_eq(tst,(double)(0)) )
50080 : {
50081 0 : if( k-2>=ilo )
50082 : {
50083 0 : tst = tst+ae_fabs(h->ptr.pp_double[k-1][k-2], _state);
50084 : }
50085 0 : if( k+1<=ihi )
50086 : {
50087 0 : tst = tst+ae_fabs(h->ptr.pp_double[k+1][k], _state);
50088 : }
50089 : }
50090 :
50091 : /*
50092 : * ==== The following is a conservative small subdiagonal
50093 : * . deflation criterion due to Ahues & Tisseur (LAWN 122,
50094 : * . 1997). It has better mathematical foundation and
50095 : * . improves accuracy in some cases. ====
50096 : */
50097 0 : if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ulp*tst) )
50098 : {
50099 0 : ab = ae_maxreal(ae_fabs(h->ptr.pp_double[k][k-1], _state), ae_fabs(h->ptr.pp_double[k-1][k], _state), _state);
50100 0 : ba = ae_minreal(ae_fabs(h->ptr.pp_double[k][k-1], _state), ae_fabs(h->ptr.pp_double[k-1][k], _state), _state);
50101 0 : aa = ae_maxreal(ae_fabs(h->ptr.pp_double[k][k], _state), ae_fabs(h->ptr.pp_double[k-1][k-1]-h->ptr.pp_double[k][k], _state), _state);
50102 0 : bb = ae_minreal(ae_fabs(h->ptr.pp_double[k][k], _state), ae_fabs(h->ptr.pp_double[k-1][k-1]-h->ptr.pp_double[k][k], _state), _state);
50103 0 : s = aa+ab;
50104 0 : if( ae_fp_less_eq(ba*(ab/s),ae_maxreal(smlnum, ulp*(bb*(aa/s)), _state)) )
50105 : {
50106 0 : break;
50107 : }
50108 : }
50109 : }
50110 0 : l = k;
50111 0 : if( l>ilo )
50112 : {
50113 :
50114 : /*
50115 : * H(L,L-1) is negligible
50116 : */
50117 0 : h->ptr.pp_double[l][l-1] = (double)(0);
50118 : }
50119 :
50120 : /*
50121 : * Exit from loop if a submatrix of order 1 or 2 has split off.
50122 : */
50123 0 : if( l>=i-1 )
50124 : {
50125 0 : failflag = ae_false;
50126 0 : break;
50127 : }
50128 :
50129 : /*
50130 : * Now the active submatrix is in rows and columns L to I. If
50131 : * eigenvalues only are being computed, only the active submatrix
50132 : * need be transformed.
50133 : */
50134 0 : if( !wantt )
50135 : {
50136 0 : i1 = l;
50137 0 : i2 = i;
50138 : }
50139 :
50140 : /*
50141 : * Shifts
50142 : */
50143 0 : if( its==10 )
50144 : {
50145 :
50146 : /*
50147 : * Exceptional shift.
50148 : */
50149 0 : s = ae_fabs(h->ptr.pp_double[l+1][l], _state)+ae_fabs(h->ptr.pp_double[l+2][l+1], _state);
50150 0 : h11 = dat1*s+h->ptr.pp_double[l][l];
50151 0 : h12 = dat2*s;
50152 0 : h21 = s;
50153 0 : h22 = h11;
50154 : }
50155 : else
50156 : {
50157 0 : if( its==20 )
50158 : {
50159 :
50160 : /*
50161 : * Exceptional shift.
50162 : */
50163 0 : s = ae_fabs(h->ptr.pp_double[i][i-1], _state)+ae_fabs(h->ptr.pp_double[i-1][i-2], _state);
50164 0 : h11 = dat1*s+h->ptr.pp_double[i][i];
50165 0 : h12 = dat2*s;
50166 0 : h21 = s;
50167 0 : h22 = h11;
50168 : }
50169 : else
50170 : {
50171 :
50172 : /*
50173 : * Prepare to use Francis' double shift
50174 : * (i.e. 2nd degree generalized Rayleigh quotient)
50175 : */
50176 0 : h11 = h->ptr.pp_double[i-1][i-1];
50177 0 : h21 = h->ptr.pp_double[i][i-1];
50178 0 : h12 = h->ptr.pp_double[i-1][i];
50179 0 : h22 = h->ptr.pp_double[i][i];
50180 : }
50181 : }
50182 0 : s = ae_fabs(h11, _state)+ae_fabs(h12, _state)+ae_fabs(h21, _state)+ae_fabs(h22, _state);
50183 0 : if( ae_fp_eq(s,(double)(0)) )
50184 : {
50185 0 : rt1r = (double)(0);
50186 0 : rt1i = (double)(0);
50187 0 : rt2r = (double)(0);
50188 0 : rt2i = (double)(0);
50189 : }
50190 : else
50191 : {
50192 0 : h11 = h11/s;
50193 0 : h21 = h21/s;
50194 0 : h12 = h12/s;
50195 0 : h22 = h22/s;
50196 0 : tr = (h11+h22)/2;
50197 0 : det = (h11-tr)*(h22-tr)-h12*h21;
50198 0 : rtdisc = ae_sqrt(ae_fabs(det, _state), _state);
50199 0 : if( ae_fp_greater_eq(det,(double)(0)) )
50200 : {
50201 :
50202 : /*
50203 : * ==== complex conjugate shifts ====
50204 : */
50205 0 : rt1r = tr*s;
50206 0 : rt2r = rt1r;
50207 0 : rt1i = rtdisc*s;
50208 0 : rt2i = -rt1i;
50209 : }
50210 : else
50211 : {
50212 :
50213 : /*
50214 : * ==== real shifts (use only one of them) ====
50215 : */
50216 0 : rt1r = tr+rtdisc;
50217 0 : rt2r = tr-rtdisc;
50218 0 : if( ae_fp_less_eq(ae_fabs(rt1r-h22, _state),ae_fabs(rt2r-h22, _state)) )
50219 : {
50220 0 : rt1r = rt1r*s;
50221 0 : rt2r = rt1r;
50222 : }
50223 : else
50224 : {
50225 0 : rt2r = rt2r*s;
50226 0 : rt1r = rt2r;
50227 : }
50228 0 : rt1i = (double)(0);
50229 0 : rt2i = (double)(0);
50230 : }
50231 : }
50232 :
50233 : /*
50234 : * Look for two consecutive small subdiagonal elements.
50235 : */
50236 0 : for(m=i-2; m>=l; m--)
50237 : {
50238 :
50239 : /*
50240 : * Determine the effect of starting the double-shift QR
50241 : * iteration at row M, and see if this would make H(M,M-1)
50242 : * negligible. (The following uses scaling to avoid
50243 : * overflows and most underflows.)
50244 : */
50245 0 : h21s = h->ptr.pp_double[m+1][m];
50246 0 : s = ae_fabs(h->ptr.pp_double[m][m]-rt2r, _state)+ae_fabs(rt2i, _state)+ae_fabs(h21s, _state);
50247 0 : h21s = h->ptr.pp_double[m+1][m]/s;
50248 0 : workv3->ptr.p_double[1] = h21s*h->ptr.pp_double[m][m+1]+(h->ptr.pp_double[m][m]-rt1r)*((h->ptr.pp_double[m][m]-rt2r)/s)-rt1i*(rt2i/s);
50249 0 : workv3->ptr.p_double[2] = h21s*(h->ptr.pp_double[m][m]+h->ptr.pp_double[m+1][m+1]-rt1r-rt2r);
50250 0 : workv3->ptr.p_double[3] = h21s*h->ptr.pp_double[m+2][m+1];
50251 0 : s = ae_fabs(workv3->ptr.p_double[1], _state)+ae_fabs(workv3->ptr.p_double[2], _state)+ae_fabs(workv3->ptr.p_double[3], _state);
50252 0 : workv3->ptr.p_double[1] = workv3->ptr.p_double[1]/s;
50253 0 : workv3->ptr.p_double[2] = workv3->ptr.p_double[2]/s;
50254 0 : workv3->ptr.p_double[3] = workv3->ptr.p_double[3]/s;
50255 0 : if( m==l )
50256 : {
50257 0 : break;
50258 : }
50259 0 : if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[m][m-1], _state)*(ae_fabs(workv3->ptr.p_double[2], _state)+ae_fabs(workv3->ptr.p_double[3], _state)),ulp*ae_fabs(workv3->ptr.p_double[1], _state)*(ae_fabs(h->ptr.pp_double[m-1][m-1], _state)+ae_fabs(h->ptr.pp_double[m][m], _state)+ae_fabs(h->ptr.pp_double[m+1][m+1], _state))) )
50260 : {
50261 0 : break;
50262 : }
50263 : }
50264 :
50265 : /*
50266 : * Double-shift QR step
50267 : */
50268 0 : for(k=m; k<=i-1; k++)
50269 : {
50270 :
50271 : /*
50272 : * The first iteration of this loop determines a reflection G
50273 : * from the vector V and applies it from left and right to H,
50274 : * thus creating a nonzero bulge below the subdiagonal.
50275 : *
50276 : * Each subsequent iteration determines a reflection G to
50277 : * restore the Hessenberg form in the (K-1)th column, and thus
50278 : * chases the bulge one step toward the bottom of the active
50279 : * submatrix. NR is the order of G.
50280 : */
50281 0 : nr = ae_minint(3, i-k+1, _state);
50282 0 : if( k>m )
50283 : {
50284 0 : for(p1=1; p1<=nr; p1++)
50285 : {
50286 0 : workv3->ptr.p_double[p1] = h->ptr.pp_double[k+p1-1][k-1];
50287 : }
50288 : }
50289 0 : generatereflection(workv3, nr, &t1, _state);
50290 0 : if( k>m )
50291 : {
50292 0 : h->ptr.pp_double[k][k-1] = workv3->ptr.p_double[1];
50293 0 : h->ptr.pp_double[k+1][k-1] = (double)(0);
50294 0 : if( k<i-1 )
50295 : {
50296 0 : h->ptr.pp_double[k+2][k-1] = (double)(0);
50297 : }
50298 : }
50299 : else
50300 : {
50301 0 : if( m>l )
50302 : {
50303 :
50304 : /*
50305 : * ==== Use the following instead of
50306 : * H( K, K-1 ) = -H( K, K-1 ) to
50307 : * avoid a bug when v(2) and v(3)
50308 : * underflow. ====
50309 : */
50310 0 : h->ptr.pp_double[k][k-1] = h->ptr.pp_double[k][k-1]*(1-t1);
50311 : }
50312 : }
50313 0 : v2 = workv3->ptr.p_double[2];
50314 0 : t2 = t1*v2;
50315 0 : if( nr==3 )
50316 : {
50317 0 : v3 = workv3->ptr.p_double[3];
50318 0 : t3 = t1*v3;
50319 :
50320 : /*
50321 : * Apply G from the left to transform the rows of the matrix
50322 : * in columns K to I2.
50323 : */
50324 0 : for(j=k; j<=i2; j++)
50325 : {
50326 0 : sum = h->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j]+v3*h->ptr.pp_double[k+2][j];
50327 0 : h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1;
50328 0 : h->ptr.pp_double[k+1][j] = h->ptr.pp_double[k+1][j]-sum*t2;
50329 0 : h->ptr.pp_double[k+2][j] = h->ptr.pp_double[k+2][j]-sum*t3;
50330 : }
50331 :
50332 : /*
50333 : * Apply G from the right to transform the columns of the
50334 : * matrix in rows I1 to min(K+3,I).
50335 : */
50336 0 : for(j=i1; j<=ae_minint(k+3, i, _state); j++)
50337 : {
50338 0 : sum = h->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1]+v3*h->ptr.pp_double[j][k+2];
50339 0 : h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1;
50340 0 : h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2;
50341 0 : h->ptr.pp_double[j][k+2] = h->ptr.pp_double[j][k+2]-sum*t3;
50342 : }
50343 0 : if( wantz )
50344 : {
50345 :
50346 : /*
50347 : * Accumulate transformations in the matrix Z
50348 : */
50349 0 : for(j=iloz; j<=ihiz; j++)
50350 : {
50351 0 : sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1]+v3*z->ptr.pp_double[j][k+2];
50352 0 : z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1;
50353 0 : z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2;
50354 0 : z->ptr.pp_double[j][k+2] = z->ptr.pp_double[j][k+2]-sum*t3;
50355 : }
50356 : }
50357 : }
50358 : else
50359 : {
50360 0 : if( nr==2 )
50361 : {
50362 :
50363 : /*
50364 : * Apply G from the left to transform the rows of the matrix
50365 : * in columns K to I2.
50366 : */
50367 0 : for(j=k; j<=i2; j++)
50368 : {
50369 0 : sum = h->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j];
50370 0 : h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1;
50371 0 : h->ptr.pp_double[k+1][j] = h->ptr.pp_double[k+1][j]-sum*t2;
50372 : }
50373 :
50374 : /*
50375 : * Apply G from the right to transform the columns of the
50376 : * matrix in rows I1 to min(K+3,I).
50377 : */
50378 0 : for(j=i1; j<=i; j++)
50379 : {
50380 0 : sum = h->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1];
50381 0 : h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1;
50382 0 : h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2;
50383 : }
50384 0 : if( wantz )
50385 : {
50386 :
50387 : /*
50388 : * Accumulate transformations in the matrix Z
50389 : */
50390 0 : for(j=iloz; j<=ihiz; j++)
50391 : {
50392 0 : sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1];
50393 0 : z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1;
50394 0 : z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2;
50395 : }
50396 : }
50397 : }
50398 : }
50399 : }
50400 : }
50401 :
50402 : /*
50403 : * Failure to converge in remaining number of iterations
50404 : */
50405 0 : if( failflag )
50406 : {
50407 0 : *info = i;
50408 0 : return;
50409 : }
50410 :
50411 : /*
50412 : * Convergence
50413 : */
50414 0 : if( l==i )
50415 : {
50416 :
50417 : /*
50418 : * H(I,I-1) is negligible: one eigenvalue has converged.
50419 : */
50420 0 : wr->ptr.p_double[i] = h->ptr.pp_double[i][i];
50421 0 : wi->ptr.p_double[i] = (double)(0);
50422 : }
50423 : else
50424 : {
50425 0 : if( l==i-1 )
50426 : {
50427 :
50428 : /*
50429 : * H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
50430 : *
50431 : * Transform the 2-by-2 submatrix to standard Schur form,
50432 : * and compute and store the eigenvalues.
50433 : */
50434 0 : him1im1 = h->ptr.pp_double[i-1][i-1];
50435 0 : him1i = h->ptr.pp_double[i-1][i];
50436 0 : hiim1 = h->ptr.pp_double[i][i-1];
50437 0 : hii = h->ptr.pp_double[i][i];
50438 0 : hsschur_aux2x2schur(&him1im1, &him1i, &hiim1, &hii, &wrim1, &wiim1, &wri, &wii, &cs, &sn, _state);
50439 0 : wr->ptr.p_double[i-1] = wrim1;
50440 0 : wi->ptr.p_double[i-1] = wiim1;
50441 0 : wr->ptr.p_double[i] = wri;
50442 0 : wi->ptr.p_double[i] = wii;
50443 0 : h->ptr.pp_double[i-1][i-1] = him1im1;
50444 0 : h->ptr.pp_double[i-1][i] = him1i;
50445 0 : h->ptr.pp_double[i][i-1] = hiim1;
50446 0 : h->ptr.pp_double[i][i] = hii;
50447 0 : if( wantt )
50448 : {
50449 :
50450 : /*
50451 : * Apply the transformation to the rest of H.
50452 : */
50453 0 : if( i2>i )
50454 : {
50455 0 : workc1->ptr.p_double[1] = cs;
50456 0 : works1->ptr.p_double[1] = sn;
50457 0 : applyrotationsfromtheleft(ae_true, i-1, i, i+1, i2, workc1, works1, h, work, _state);
50458 : }
50459 0 : workc1->ptr.p_double[1] = cs;
50460 0 : works1->ptr.p_double[1] = sn;
50461 0 : applyrotationsfromtheright(ae_true, i1, i-2, i-1, i, workc1, works1, h, work, _state);
50462 : }
50463 0 : if( wantz )
50464 : {
50465 :
50466 : /*
50467 : * Apply the transformation to Z.
50468 : */
50469 0 : workc1->ptr.p_double[1] = cs;
50470 0 : works1->ptr.p_double[1] = sn;
50471 0 : applyrotationsfromtheright(ae_true, iloz, iloz+nz-1, i-1, i, workc1, works1, z, work, _state);
50472 : }
50473 : }
50474 : }
50475 :
50476 : /*
50477 : * return to start of the main loop with new value of I.
50478 : */
50479 0 : i = l-1;
50480 : }
50481 : }
50482 :
50483 :
50484 0 : static void hsschur_aux2x2schur(double* a,
50485 : double* b,
50486 : double* c,
50487 : double* d,
50488 : double* rt1r,
50489 : double* rt1i,
50490 : double* rt2r,
50491 : double* rt2i,
50492 : double* cs,
50493 : double* sn,
50494 : ae_state *_state)
50495 : {
50496 : double multpl;
50497 : double aa;
50498 : double bb;
50499 : double bcmax;
50500 : double bcmis;
50501 : double cc;
50502 : double cs1;
50503 : double dd;
50504 : double eps;
50505 : double p;
50506 : double sab;
50507 : double sac;
50508 : double scl;
50509 : double sigma;
50510 : double sn1;
50511 : double tau;
50512 : double temp;
50513 : double z;
50514 :
50515 0 : *rt1r = 0;
50516 0 : *rt1i = 0;
50517 0 : *rt2r = 0;
50518 0 : *rt2i = 0;
50519 0 : *cs = 0;
50520 0 : *sn = 0;
50521 :
50522 0 : multpl = 4.0;
50523 0 : eps = ae_machineepsilon;
50524 0 : if( ae_fp_eq(*c,(double)(0)) )
50525 : {
50526 0 : *cs = (double)(1);
50527 0 : *sn = (double)(0);
50528 : }
50529 : else
50530 : {
50531 0 : if( ae_fp_eq(*b,(double)(0)) )
50532 : {
50533 :
50534 : /*
50535 : * Swap rows and columns
50536 : */
50537 0 : *cs = (double)(0);
50538 0 : *sn = (double)(1);
50539 0 : temp = *d;
50540 0 : *d = *a;
50541 0 : *a = temp;
50542 0 : *b = -*c;
50543 0 : *c = (double)(0);
50544 : }
50545 : else
50546 : {
50547 0 : if( ae_fp_eq(*a-(*d),(double)(0))&&hsschur_extschursigntoone(*b, _state)!=hsschur_extschursigntoone(*c, _state) )
50548 : {
50549 0 : *cs = (double)(1);
50550 0 : *sn = (double)(0);
50551 : }
50552 : else
50553 : {
50554 0 : temp = *a-(*d);
50555 0 : p = 0.5*temp;
50556 0 : bcmax = ae_maxreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state);
50557 0 : bcmis = ae_minreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state)*hsschur_extschursigntoone(*b, _state)*hsschur_extschursigntoone(*c, _state);
50558 0 : scl = ae_maxreal(ae_fabs(p, _state), bcmax, _state);
50559 0 : z = p/scl*p+bcmax/scl*bcmis;
50560 :
50561 : /*
50562 : * If Z is of the order of the machine accuracy, postpone the
50563 : * decision on the nature of eigenvalues
50564 : */
50565 0 : if( ae_fp_greater_eq(z,multpl*eps) )
50566 : {
50567 :
50568 : /*
50569 : * Real eigenvalues. Compute A and D.
50570 : */
50571 0 : z = p+hsschur_extschursign(ae_sqrt(scl, _state)*ae_sqrt(z, _state), p, _state);
50572 0 : *a = *d+z;
50573 0 : *d = *d-bcmax/z*bcmis;
50574 :
50575 : /*
50576 : * Compute B and the rotation matrix
50577 : */
50578 0 : tau = pythag2(*c, z, _state);
50579 0 : *cs = z/tau;
50580 0 : *sn = *c/tau;
50581 0 : *b = *b-(*c);
50582 0 : *c = (double)(0);
50583 : }
50584 : else
50585 : {
50586 :
50587 : /*
50588 : * Complex eigenvalues, or real (almost) equal eigenvalues.
50589 : * Make diagonal elements equal.
50590 : */
50591 0 : sigma = *b+(*c);
50592 0 : tau = pythag2(sigma, temp, _state);
50593 0 : *cs = ae_sqrt(0.5*(1+ae_fabs(sigma, _state)/tau), _state);
50594 0 : *sn = -p/(tau*(*cs))*hsschur_extschursign((double)(1), sigma, _state);
50595 :
50596 : /*
50597 : * Compute [ AA BB ] = [ A B ] [ CS -SN ]
50598 : * [ CC DD ] [ C D ] [ SN CS ]
50599 : */
50600 0 : aa = *a*(*cs)+*b*(*sn);
50601 0 : bb = -*a*(*sn)+*b*(*cs);
50602 0 : cc = *c*(*cs)+*d*(*sn);
50603 0 : dd = -*c*(*sn)+*d*(*cs);
50604 :
50605 : /*
50606 : * Compute [ A B ] = [ CS SN ] [ AA BB ]
50607 : * [ C D ] [-SN CS ] [ CC DD ]
50608 : */
50609 0 : *a = aa*(*cs)+cc*(*sn);
50610 0 : *b = bb*(*cs)+dd*(*sn);
50611 0 : *c = -aa*(*sn)+cc*(*cs);
50612 0 : *d = -bb*(*sn)+dd*(*cs);
50613 0 : temp = 0.5*(*a+(*d));
50614 0 : *a = temp;
50615 0 : *d = temp;
50616 0 : if( ae_fp_neq(*c,(double)(0)) )
50617 : {
50618 0 : if( ae_fp_neq(*b,(double)(0)) )
50619 : {
50620 0 : if( hsschur_extschursigntoone(*b, _state)==hsschur_extschursigntoone(*c, _state) )
50621 : {
50622 :
50623 : /*
50624 : * Real eigenvalues: reduce to upper triangular form
50625 : */
50626 0 : sab = ae_sqrt(ae_fabs(*b, _state), _state);
50627 0 : sac = ae_sqrt(ae_fabs(*c, _state), _state);
50628 0 : p = hsschur_extschursign(sab*sac, *c, _state);
50629 0 : tau = 1/ae_sqrt(ae_fabs(*b+(*c), _state), _state);
50630 0 : *a = temp+p;
50631 0 : *d = temp-p;
50632 0 : *b = *b-(*c);
50633 0 : *c = (double)(0);
50634 0 : cs1 = sab*tau;
50635 0 : sn1 = sac*tau;
50636 0 : temp = *cs*cs1-*sn*sn1;
50637 0 : *sn = *cs*sn1+*sn*cs1;
50638 0 : *cs = temp;
50639 : }
50640 : }
50641 : else
50642 : {
50643 0 : *b = -*c;
50644 0 : *c = (double)(0);
50645 0 : temp = *cs;
50646 0 : *cs = -*sn;
50647 0 : *sn = temp;
50648 : }
50649 : }
50650 : }
50651 : }
50652 : }
50653 : }
50654 :
50655 : /*
50656 : * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
50657 : */
50658 0 : *rt1r = *a;
50659 0 : *rt2r = *d;
50660 0 : if( ae_fp_eq(*c,(double)(0)) )
50661 : {
50662 0 : *rt1i = (double)(0);
50663 0 : *rt2i = (double)(0);
50664 : }
50665 : else
50666 : {
50667 0 : *rt1i = ae_sqrt(ae_fabs(*b, _state), _state)*ae_sqrt(ae_fabs(*c, _state), _state);
50668 0 : *rt2i = -*rt1i;
50669 : }
50670 0 : }
50671 :
50672 :
50673 0 : static double hsschur_extschursign(double a, double b, ae_state *_state)
50674 : {
50675 : double result;
50676 :
50677 :
50678 0 : if( ae_fp_greater_eq(b,(double)(0)) )
50679 : {
50680 0 : result = ae_fabs(a, _state);
50681 : }
50682 : else
50683 : {
50684 0 : result = -ae_fabs(a, _state);
50685 : }
50686 0 : return result;
50687 : }
50688 :
50689 :
50690 0 : static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state)
50691 : {
50692 : ae_int_t result;
50693 :
50694 :
50695 0 : if( ae_fp_greater_eq(b,(double)(0)) )
50696 : {
50697 0 : result = 1;
50698 : }
50699 : else
50700 : {
50701 0 : result = -1;
50702 : }
50703 0 : return result;
50704 : }
50705 :
50706 :
50707 : #endif
50708 : #if defined(AE_COMPILE_EVD) || !defined(AE_PARTIAL_BUILD)
50709 :
50710 :
50711 : /*************************************************************************
50712 : This function initializes subspace iteration solver. This solver is used
50713 : to solve symmetric real eigenproblems where just a few (top K) eigenvalues
50714 : and corresponding eigenvectors is required.
50715 :
50716 : This solver can be significantly faster than complete EVD decomposition
50717 : in the following case:
50718 : * when only just a small fraction of top eigenpairs of dense matrix is
50719 : required. When K approaches N, this solver is slower than complete dense
50720 : EVD
50721 : * when problem matrix is sparse (and/or is not known explicitly, i.e. only
50722 : matrix-matrix product can be performed)
50723 :
50724 : USAGE (explicit dense/sparse matrix):
50725 : 1. User initializes algorithm state with eigsubspacecreate() call
50726 : 2. [optional] User tunes solver parameters by calling eigsubspacesetcond()
50727 : or other functions
50728 : 3. User calls eigsubspacesolvedense() or eigsubspacesolvesparse() methods,
50729 : which take algorithm state and 2D array or alglib.sparsematrix object.
50730 :
50731 : USAGE (out-of-core mode):
50732 : 1. User initializes algorithm state with eigsubspacecreate() call
50733 : 2. [optional] User tunes solver parameters by calling eigsubspacesetcond()
50734 : or other functions
50735 : 3. User activates out-of-core mode of the solver and repeatedly calls
50736 : communication functions in a loop like below:
50737 : > alglib.eigsubspaceoocstart(state)
50738 : > while alglib.eigsubspaceooccontinue(state) do
50739 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
50740 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
50741 : > [calculate Y=A*X, with X=R^NxM]
50742 : > alglib.eigsubspaceoocsendresult(state, in Y)
50743 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
50744 :
50745 : INPUT PARAMETERS:
50746 : N - problem dimensionality, N>0
50747 : K - number of top eigenvector to calculate, 0<K<=N.
50748 :
50749 : OUTPUT PARAMETERS:
50750 : State - structure which stores algorithm state
50751 :
50752 : NOTE: if you solve many similar EVD problems you may find it useful to
50753 : reuse previous subspace as warm-start point for new EVD problem. It
50754 : can be done with eigsubspacesetwarmstart() function.
50755 :
50756 : -- ALGLIB --
50757 : Copyright 16.01.2017 by Bochkanov Sergey
50758 : *************************************************************************/
50759 0 : void eigsubspacecreate(ae_int_t n,
50760 : ae_int_t k,
50761 : eigsubspacestate* state,
50762 : ae_state *_state)
50763 : {
50764 :
50765 0 : _eigsubspacestate_clear(state);
50766 :
50767 0 : ae_assert(n>0, "EigSubspaceCreate: N<=0", _state);
50768 0 : ae_assert(k>0, "EigSubspaceCreate: K<=0", _state);
50769 0 : ae_assert(k<=n, "EigSubspaceCreate: K>N", _state);
50770 0 : eigsubspacecreatebuf(n, k, state, _state);
50771 0 : }
50772 :
50773 :
50774 : /*************************************************************************
50775 : Buffered version of constructor which aims to reuse previously allocated
50776 : memory as much as possible.
50777 :
50778 : -- ALGLIB --
50779 : Copyright 16.01.2017 by Bochkanov Sergey
50780 : *************************************************************************/
50781 0 : void eigsubspacecreatebuf(ae_int_t n,
50782 : ae_int_t k,
50783 : eigsubspacestate* state,
50784 : ae_state *_state)
50785 : {
50786 :
50787 :
50788 0 : ae_assert(n>0, "EigSubspaceCreate: N<=0", _state);
50789 0 : ae_assert(k>0, "EigSubspaceCreate: K<=0", _state);
50790 0 : ae_assert(k<=n, "EigSubspaceCreate: K>N", _state);
50791 :
50792 : /*
50793 : * Initialize algorithm parameters
50794 : */
50795 0 : state->running = ae_false;
50796 0 : state->n = n;
50797 0 : state->k = k;
50798 0 : state->nwork = ae_minint(ae_maxint(2*k, 8, _state), n, _state);
50799 0 : state->eigenvectorsneeded = 1;
50800 0 : state->usewarmstart = ae_false;
50801 0 : state->firstcall = ae_true;
50802 0 : eigsubspacesetcond(state, 0.0, 0, _state);
50803 :
50804 : /*
50805 : * Allocate temporaries
50806 : */
50807 0 : rmatrixsetlengthatleast(&state->x, state->n, state->nwork, _state);
50808 0 : rmatrixsetlengthatleast(&state->ax, state->n, state->nwork, _state);
50809 0 : }
50810 :
50811 :
50812 : /*************************************************************************
50813 : This function sets stopping critera for the solver:
50814 : * error in eigenvector/value allowed by solver
50815 : * maximum number of iterations to perform
50816 :
50817 : INPUT PARAMETERS:
50818 : State - solver structure
50819 : Eps - eps>=0, with non-zero value used to tell solver that
50820 : it can stop after all eigenvalues converged with
50821 : error roughly proportional to eps*MAX(LAMBDA_MAX),
50822 : where LAMBDA_MAX is a maximum eigenvalue.
50823 : Zero value means that no check for precision is
50824 : performed.
50825 : MaxIts - maxits>=0, with non-zero value used to tell solver
50826 : that it can stop after maxits steps (no matter how
50827 : precise current estimate is)
50828 :
50829 : NOTE: passing eps=0 and maxits=0 results in automatic selection of
50830 : moderate eps as stopping criteria (1.0E-6 in current implementation,
50831 : but it may change without notice).
50832 :
50833 : NOTE: very small values of eps are possible (say, 1.0E-12), although the
50834 : larger problem you solve (N and/or K), the harder it is to find
50835 : precise eigenvectors because rounding errors tend to accumulate.
50836 :
50837 : NOTE: passing non-zero eps results in some performance penalty, roughly
50838 : equal to 2N*(2K)^2 FLOPs per iteration. These additional computations
50839 : are required in order to estimate current error in eigenvalues via
50840 : Rayleigh-Ritz process.
50841 : Most of this additional time is spent in construction of ~2Kx2K
50842 : symmetric subproblem whose eigenvalues are checked with exact
50843 : eigensolver.
50844 : This additional time is negligible if you search for eigenvalues of
50845 : the large dense matrix, but may become noticeable on highly sparse
50846 : EVD problems, where cost of matrix-matrix product is low.
50847 : If you set eps to exactly zero, Rayleigh-Ritz phase is completely
50848 : turned off.
50849 :
50850 : -- ALGLIB --
50851 : Copyright 16.01.2017 by Bochkanov Sergey
50852 : *************************************************************************/
50853 0 : void eigsubspacesetcond(eigsubspacestate* state,
50854 : double eps,
50855 : ae_int_t maxits,
50856 : ae_state *_state)
50857 : {
50858 :
50859 :
50860 0 : ae_assert(!state->running, "EigSubspaceSetCond: solver is already running", _state);
50861 0 : ae_assert(ae_isfinite(eps, _state)&&ae_fp_greater_eq(eps,(double)(0)), "EigSubspaceSetCond: Eps<0 or NAN/INF", _state);
50862 0 : ae_assert(maxits>=0, "EigSubspaceSetCond: MaxIts<0", _state);
50863 0 : if( ae_fp_eq(eps,(double)(0))&&maxits==0 )
50864 : {
50865 0 : eps = 1.0E-6;
50866 : }
50867 0 : state->eps = eps;
50868 0 : state->maxits = maxits;
50869 0 : }
50870 :
50871 :
50872 : /*************************************************************************
50873 : This function sets warm-start mode of the solver: next call to the solver
50874 : will reuse previous subspace as warm-start point. It can significantly
50875 : speed-up convergence when you solve many similar eigenproblems.
50876 :
50877 : INPUT PARAMETERS:
50878 : State - solver structure
50879 : UseWarmStart- either True or False
50880 :
50881 : -- ALGLIB --
50882 : Copyright 12.11.2017 by Bochkanov Sergey
50883 : *************************************************************************/
50884 0 : void eigsubspacesetwarmstart(eigsubspacestate* state,
50885 : ae_bool usewarmstart,
50886 : ae_state *_state)
50887 : {
50888 :
50889 :
50890 0 : ae_assert(!state->running, "EigSubspaceSetWarmStart: solver is already running", _state);
50891 0 : state->usewarmstart = usewarmstart;
50892 0 : }
50893 :
50894 :
50895 : /*************************************************************************
50896 : This function initiates out-of-core mode of subspace eigensolver. It
50897 : should be used in conjunction with other out-of-core-related functions of
50898 : this subspackage in a loop like below:
50899 :
50900 : > alglib.eigsubspaceoocstart(state)
50901 : > while alglib.eigsubspaceooccontinue(state) do
50902 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
50903 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
50904 : > [calculate Y=A*X, with X=R^NxM]
50905 : > alglib.eigsubspaceoocsendresult(state, in Y)
50906 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
50907 :
50908 : INPUT PARAMETERS:
50909 : State - solver object
50910 : MType - matrix type:
50911 : * 0 for real symmetric matrix (solver assumes that
50912 : matrix being processed is symmetric; symmetric
50913 : direct eigensolver is used for smaller subproblems
50914 : arising during solution of larger "full" task)
50915 : Future versions of ALGLIB may introduce support for
50916 : other matrix types; for now, only symmetric
50917 : eigenproblems are supported.
50918 :
50919 :
50920 : -- ALGLIB --
50921 : Copyright 16.01.2017 by Bochkanov Sergey
50922 : *************************************************************************/
50923 0 : void eigsubspaceoocstart(eigsubspacestate* state,
50924 : ae_int_t mtype,
50925 : ae_state *_state)
50926 : {
50927 :
50928 :
50929 0 : ae_assert(!state->running, "EigSubspaceStart: solver is already running", _state);
50930 0 : ae_assert(mtype==0, "EigSubspaceStart: incorrect mtype parameter", _state);
50931 0 : ae_vector_set_length(&state->rstate.ia, 7+1, _state);
50932 0 : ae_vector_set_length(&state->rstate.ra, 1+1, _state);
50933 0 : state->rstate.stage = -1;
50934 0 : evd_clearrfields(state, _state);
50935 0 : state->running = ae_true;
50936 0 : state->matrixtype = mtype;
50937 0 : }
50938 :
50939 :
50940 : /*************************************************************************
50941 : This function performs subspace iteration in the out-of-core mode. It
50942 : should be used in conjunction with other out-of-core-related functions of
50943 : this subspackage in a loop like below:
50944 :
50945 : > alglib.eigsubspaceoocstart(state)
50946 : > while alglib.eigsubspaceooccontinue(state) do
50947 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
50948 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
50949 : > [calculate Y=A*X, with X=R^NxM]
50950 : > alglib.eigsubspaceoocsendresult(state, in Y)
50951 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
50952 :
50953 :
50954 : -- ALGLIB --
50955 : Copyright 16.01.2017 by Bochkanov Sergey
50956 : *************************************************************************/
50957 0 : ae_bool eigsubspaceooccontinue(eigsubspacestate* state, ae_state *_state)
50958 : {
50959 : ae_bool result;
50960 :
50961 :
50962 0 : ae_assert(state->running, "EigSubspaceContinue: solver is not running", _state);
50963 0 : result = eigsubspaceiteration(state, _state);
50964 0 : state->running = result;
50965 0 : return result;
50966 : }
50967 :
50968 :
50969 : /*************************************************************************
50970 : This function is used to retrieve information about out-of-core request
50971 : sent by solver to user code: request type (current version of the solver
50972 : sends only requests for matrix-matrix products) and request size (size of
50973 : the matrices being multiplied).
50974 :
50975 : This function returns just request metrics; in order to get contents of
50976 : the matrices being multiplied, use eigsubspaceoocgetrequestdata().
50977 :
50978 : It should be used in conjunction with other out-of-core-related functions
50979 : of this subspackage in a loop like below:
50980 :
50981 : > alglib.eigsubspaceoocstart(state)
50982 : > while alglib.eigsubspaceooccontinue(state) do
50983 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
50984 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
50985 : > [calculate Y=A*X, with X=R^NxM]
50986 : > alglib.eigsubspaceoocsendresult(state, in Y)
50987 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
50988 :
50989 : INPUT PARAMETERS:
50990 : State - solver running in out-of-core mode
50991 :
50992 : OUTPUT PARAMETERS:
50993 : RequestType - type of the request to process:
50994 : * 0 - for matrix-matrix product A*X, with A being
50995 : NxN matrix whose eigenvalues/vectors are needed,
50996 : and X being NxREQUESTSIZE one which is returned
50997 : by the eigsubspaceoocgetrequestdata().
50998 : RequestSize - size of the X matrix (number of columns), usually
50999 : it is several times larger than number of vectors
51000 : K requested by user.
51001 :
51002 :
51003 : -- ALGLIB --
51004 : Copyright 16.01.2017 by Bochkanov Sergey
51005 : *************************************************************************/
51006 0 : void eigsubspaceoocgetrequestinfo(eigsubspacestate* state,
51007 : ae_int_t* requesttype,
51008 : ae_int_t* requestsize,
51009 : ae_state *_state)
51010 : {
51011 :
51012 0 : *requesttype = 0;
51013 0 : *requestsize = 0;
51014 :
51015 0 : ae_assert(state->running, "EigSubspaceOOCGetRequestInfo: solver is not running", _state);
51016 0 : *requesttype = state->requesttype;
51017 0 : *requestsize = state->requestsize;
51018 0 : }
51019 :
51020 :
51021 : /*************************************************************************
51022 : This function is used to retrieve information about out-of-core request
51023 : sent by solver to user code: matrix X (array[N,RequestSize) which have to
51024 : be multiplied by out-of-core matrix A in a product A*X.
51025 :
51026 : This function returns just request data; in order to get size of the data
51027 : prior to processing requestm, use eigsubspaceoocgetrequestinfo().
51028 :
51029 : It should be used in conjunction with other out-of-core-related functions
51030 : of this subspackage in a loop like below:
51031 :
51032 : > alglib.eigsubspaceoocstart(state)
51033 : > while alglib.eigsubspaceooccontinue(state) do
51034 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
51035 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
51036 : > [calculate Y=A*X, with X=R^NxM]
51037 : > alglib.eigsubspaceoocsendresult(state, in Y)
51038 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
51039 :
51040 : INPUT PARAMETERS:
51041 : State - solver running in out-of-core mode
51042 : X - possibly preallocated storage; reallocated if
51043 : needed, left unchanged, if large enough to store
51044 : request data.
51045 :
51046 : OUTPUT PARAMETERS:
51047 : X - array[N,RequestSize] or larger, leading rectangle
51048 : is filled with dense matrix X.
51049 :
51050 :
51051 : -- ALGLIB --
51052 : Copyright 16.01.2017 by Bochkanov Sergey
51053 : *************************************************************************/
51054 0 : void eigsubspaceoocgetrequestdata(eigsubspacestate* state,
51055 : /* Real */ ae_matrix* x,
51056 : ae_state *_state)
51057 : {
51058 : ae_int_t i;
51059 : ae_int_t j;
51060 :
51061 :
51062 0 : ae_assert(state->running, "EigSubspaceOOCGetRequestInfo: solver is not running", _state);
51063 0 : rmatrixsetlengthatleast(x, state->n, state->requestsize, _state);
51064 0 : for(i=0; i<=state->n-1; i++)
51065 : {
51066 0 : for(j=0; j<=state->requestsize-1; j++)
51067 : {
51068 0 : x->ptr.pp_double[i][j] = state->x.ptr.pp_double[i][j];
51069 : }
51070 : }
51071 0 : }
51072 :
51073 :
51074 : /*************************************************************************
51075 : This function is used to send user reply to out-of-core request sent by
51076 : solver. Usually it is product A*X for returned by solver matrix X.
51077 :
51078 : It should be used in conjunction with other out-of-core-related functions
51079 : of this subspackage in a loop like below:
51080 :
51081 : > alglib.eigsubspaceoocstart(state)
51082 : > while alglib.eigsubspaceooccontinue(state) do
51083 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
51084 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
51085 : > [calculate Y=A*X, with X=R^NxM]
51086 : > alglib.eigsubspaceoocsendresult(state, in Y)
51087 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
51088 :
51089 : INPUT PARAMETERS:
51090 : State - solver running in out-of-core mode
51091 : AX - array[N,RequestSize] or larger, leading rectangle
51092 : is filled with product A*X.
51093 :
51094 :
51095 : -- ALGLIB --
51096 : Copyright 16.01.2017 by Bochkanov Sergey
51097 : *************************************************************************/
51098 0 : void eigsubspaceoocsendresult(eigsubspacestate* state,
51099 : /* Real */ ae_matrix* ax,
51100 : ae_state *_state)
51101 : {
51102 : ae_int_t i;
51103 : ae_int_t j;
51104 :
51105 :
51106 0 : ae_assert(state->running, "EigSubspaceOOCGetRequestInfo: solver is not running", _state);
51107 0 : for(i=0; i<=state->n-1; i++)
51108 : {
51109 0 : for(j=0; j<=state->requestsize-1; j++)
51110 : {
51111 0 : state->ax.ptr.pp_double[i][j] = ax->ptr.pp_double[i][j];
51112 : }
51113 : }
51114 0 : }
51115 :
51116 :
51117 : /*************************************************************************
51118 : This function finalizes out-of-core mode of subspace eigensolver. It
51119 : should be used in conjunction with other out-of-core-related functions of
51120 : this subspackage in a loop like below:
51121 :
51122 : > alglib.eigsubspaceoocstart(state)
51123 : > while alglib.eigsubspaceooccontinue(state) do
51124 : > alglib.eigsubspaceoocgetrequestinfo(state, out RequestType, out M)
51125 : > alglib.eigsubspaceoocgetrequestdata(state, out X)
51126 : > [calculate Y=A*X, with X=R^NxM]
51127 : > alglib.eigsubspaceoocsendresult(state, in Y)
51128 : > alglib.eigsubspaceoocstop(state, out W, out Z, out Report)
51129 :
51130 : INPUT PARAMETERS:
51131 : State - solver state
51132 :
51133 : OUTPUT PARAMETERS:
51134 : W - array[K], depending on solver settings:
51135 : * top K eigenvalues ordered by descending - if
51136 : eigenvectors are returned in Z
51137 : * zeros - if invariant subspace is returned in Z
51138 : Z - array[N,K], depending on solver settings either:
51139 : * matrix of eigenvectors found
51140 : * orthogonal basis of K-dimensional invariant subspace
51141 : Rep - report with additional parameters
51142 :
51143 : -- ALGLIB --
51144 : Copyright 16.01.2017 by Bochkanov Sergey
51145 : *************************************************************************/
51146 0 : void eigsubspaceoocstop(eigsubspacestate* state,
51147 : /* Real */ ae_vector* w,
51148 : /* Real */ ae_matrix* z,
51149 : eigsubspacereport* rep,
51150 : ae_state *_state)
51151 : {
51152 : ae_int_t n;
51153 : ae_int_t k;
51154 : ae_int_t i;
51155 : ae_int_t j;
51156 :
51157 0 : ae_vector_clear(w);
51158 0 : ae_matrix_clear(z);
51159 0 : _eigsubspacereport_clear(rep);
51160 :
51161 0 : ae_assert(!state->running, "EigSubspaceStop: solver is still running", _state);
51162 0 : n = state->n;
51163 0 : k = state->k;
51164 0 : ae_vector_set_length(w, k, _state);
51165 0 : ae_matrix_set_length(z, n, k, _state);
51166 0 : for(i=0; i<=k-1; i++)
51167 : {
51168 0 : w->ptr.p_double[i] = state->rw.ptr.p_double[i];
51169 : }
51170 0 : for(i=0; i<=n-1; i++)
51171 : {
51172 0 : for(j=0; j<=k-1; j++)
51173 : {
51174 0 : z->ptr.pp_double[i][j] = state->rq.ptr.pp_double[i][j];
51175 : }
51176 : }
51177 0 : rep->iterationscount = state->repiterationscount;
51178 0 : }
51179 :
51180 :
51181 : /*************************************************************************
51182 : This function runs eigensolver for dense NxN symmetric matrix A, given by
51183 : upper or lower triangle.
51184 :
51185 : This function can not process nonsymmetric matrices.
51186 :
51187 : ! COMMERCIAL EDITION OF ALGLIB:
51188 : !
51189 : ! Commercial Edition of ALGLIB includes following important improvements
51190 : ! of this function:
51191 : ! * high-performance native backend with same C# interface (C# version)
51192 : ! * multithreading support (C++ and C# versions)
51193 : ! * hardware vendor (Intel) implementations of linear algebra primitives
51194 : ! (C++ and C# versions, x86/x64 platform)
51195 : !
51196 : ! We recommend you to read 'Working with commercial version' section of
51197 : ! ALGLIB Reference Manual in order to find out how to use performance-
51198 : ! related features provided by commercial edition of ALGLIB.
51199 :
51200 : INPUT PARAMETERS:
51201 : State - solver state
51202 : A - array[N,N], symmetric NxN matrix given by one of its
51203 : triangles
51204 : IsUpper - whether upper or lower triangle of A is given (the
51205 : other one is not referenced at all).
51206 :
51207 : OUTPUT PARAMETERS:
51208 : W - array[K], top K eigenvalues ordered by descending
51209 : of their absolute values
51210 : Z - array[N,K], matrix of eigenvectors found
51211 : Rep - report with additional parameters
51212 :
51213 : NOTE: internally this function allocates a copy of NxN dense A. You should
51214 : take it into account when working with very large matrices occupying
51215 : almost all RAM.
51216 :
51217 : -- ALGLIB --
51218 : Copyright 16.01.2017 by Bochkanov Sergey
51219 : *************************************************************************/
51220 0 : void eigsubspacesolvedenses(eigsubspacestate* state,
51221 : /* Real */ ae_matrix* a,
51222 : ae_bool isupper,
51223 : /* Real */ ae_vector* w,
51224 : /* Real */ ae_matrix* z,
51225 : eigsubspacereport* rep,
51226 : ae_state *_state)
51227 : {
51228 : ae_frame _frame_block;
51229 : ae_int_t n;
51230 : ae_int_t m;
51231 : ae_int_t i;
51232 : ae_int_t j;
51233 : ae_int_t k;
51234 : double v;
51235 : ae_matrix acopy;
51236 :
51237 0 : ae_frame_make(_state, &_frame_block);
51238 0 : memset(&acopy, 0, sizeof(acopy));
51239 0 : ae_vector_clear(w);
51240 0 : ae_matrix_clear(z);
51241 0 : _eigsubspacereport_clear(rep);
51242 0 : ae_matrix_init(&acopy, 0, 0, DT_REAL, _state, ae_true);
51243 :
51244 0 : ae_assert(!state->running, "EigSubspaceSolveDenseS: solver is still running", _state);
51245 0 : n = state->n;
51246 :
51247 : /*
51248 : * Allocate copy of A, copy one triangle to another
51249 : */
51250 0 : ae_matrix_set_length(&acopy, n, n, _state);
51251 0 : for(i=0; i<=n-1; i++)
51252 : {
51253 0 : for(j=i; j<=n-1; j++)
51254 : {
51255 0 : if( isupper )
51256 : {
51257 0 : v = a->ptr.pp_double[i][j];
51258 : }
51259 : else
51260 : {
51261 0 : v = a->ptr.pp_double[j][i];
51262 : }
51263 0 : acopy.ptr.pp_double[i][j] = v;
51264 0 : acopy.ptr.pp_double[j][i] = v;
51265 : }
51266 : }
51267 :
51268 : /*
51269 : * Start iterations
51270 : */
51271 0 : state->matrixtype = 0;
51272 0 : ae_vector_set_length(&state->rstate.ia, 7+1, _state);
51273 0 : ae_vector_set_length(&state->rstate.ra, 1+1, _state);
51274 0 : state->rstate.stage = -1;
51275 0 : evd_clearrfields(state, _state);
51276 0 : while(eigsubspaceiteration(state, _state))
51277 : {
51278 :
51279 : /*
51280 : * Calculate A*X with RMatrixGEMM
51281 : */
51282 0 : ae_assert(state->requesttype==0, "EigSubspaceSolveDense: integrity check failed", _state);
51283 0 : ae_assert(state->requestsize>0, "EigSubspaceSolveDense: integrity check failed", _state);
51284 0 : m = state->requestsize;
51285 0 : rmatrixgemm(n, m, n, 1.0, &acopy, 0, 0, 0, &state->x, 0, 0, 0, 0.0, &state->ax, 0, 0, _state);
51286 : }
51287 0 : k = state->k;
51288 0 : ae_vector_set_length(w, k, _state);
51289 0 : ae_matrix_set_length(z, n, k, _state);
51290 0 : for(i=0; i<=k-1; i++)
51291 : {
51292 0 : w->ptr.p_double[i] = state->rw.ptr.p_double[i];
51293 : }
51294 0 : for(i=0; i<=n-1; i++)
51295 : {
51296 0 : for(j=0; j<=k-1; j++)
51297 : {
51298 0 : z->ptr.pp_double[i][j] = state->rq.ptr.pp_double[i][j];
51299 : }
51300 : }
51301 0 : rep->iterationscount = state->repiterationscount;
51302 0 : ae_frame_leave(_state);
51303 0 : }
51304 :
51305 :
51306 : /*************************************************************************
51307 : This function runs eigensolver for dense NxN symmetric matrix A, given by
51308 : upper or lower triangle.
51309 :
51310 : This function can not process nonsymmetric matrices.
51311 :
51312 : INPUT PARAMETERS:
51313 : State - solver state
51314 : A - NxN symmetric matrix given by one of its triangles
51315 : IsUpper - whether upper or lower triangle of A is given (the
51316 : other one is not referenced at all).
51317 :
51318 : OUTPUT PARAMETERS:
51319 : W - array[K], top K eigenvalues ordered by descending
51320 : of their absolute values
51321 : Z - array[N,K], matrix of eigenvectors found
51322 : Rep - report with additional parameters
51323 :
51324 : -- ALGLIB --
51325 : Copyright 16.01.2017 by Bochkanov Sergey
51326 : *************************************************************************/
51327 0 : void eigsubspacesolvesparses(eigsubspacestate* state,
51328 : sparsematrix* a,
51329 : ae_bool isupper,
51330 : /* Real */ ae_vector* w,
51331 : /* Real */ ae_matrix* z,
51332 : eigsubspacereport* rep,
51333 : ae_state *_state)
51334 : {
51335 : ae_int_t n;
51336 : ae_int_t i;
51337 : ae_int_t j;
51338 : ae_int_t k;
51339 :
51340 0 : ae_vector_clear(w);
51341 0 : ae_matrix_clear(z);
51342 0 : _eigsubspacereport_clear(rep);
51343 :
51344 0 : ae_assert(!state->running, "EigSubspaceSolveSparseS: solver is still running", _state);
51345 0 : n = state->n;
51346 0 : state->matrixtype = 0;
51347 0 : ae_vector_set_length(&state->rstate.ia, 7+1, _state);
51348 0 : ae_vector_set_length(&state->rstate.ra, 1+1, _state);
51349 0 : state->rstate.stage = -1;
51350 0 : evd_clearrfields(state, _state);
51351 0 : while(eigsubspaceiteration(state, _state))
51352 : {
51353 0 : ae_assert(state->requesttype==0, "EigSubspaceSolveDense: integrity check failed", _state);
51354 0 : ae_assert(state->requestsize>0, "EigSubspaceSolveDense: integrity check failed", _state);
51355 0 : sparsesmm(a, isupper, &state->x, state->requestsize, &state->ax, _state);
51356 : }
51357 0 : k = state->k;
51358 0 : ae_vector_set_length(w, k, _state);
51359 0 : ae_matrix_set_length(z, n, k, _state);
51360 0 : for(i=0; i<=k-1; i++)
51361 : {
51362 0 : w->ptr.p_double[i] = state->rw.ptr.p_double[i];
51363 : }
51364 0 : for(i=0; i<=n-1; i++)
51365 : {
51366 0 : for(j=0; j<=k-1; j++)
51367 : {
51368 0 : z->ptr.pp_double[i][j] = state->rq.ptr.pp_double[i][j];
51369 : }
51370 : }
51371 0 : rep->iterationscount = state->repiterationscount;
51372 0 : }
51373 :
51374 :
51375 : /*************************************************************************
51376 : Internal r-comm function.
51377 :
51378 : -- ALGLIB --
51379 : Copyright 16.01.2017 by Bochkanov Sergey
51380 : *************************************************************************/
51381 0 : ae_bool eigsubspaceiteration(eigsubspacestate* state, ae_state *_state)
51382 : {
51383 : ae_int_t n;
51384 : ae_int_t nwork;
51385 : ae_int_t k;
51386 : ae_int_t cnt;
51387 : ae_int_t i;
51388 : ae_int_t i1;
51389 : ae_int_t j;
51390 : double vv;
51391 : double v;
51392 : ae_int_t convcnt;
51393 : ae_bool result;
51394 :
51395 :
51396 :
51397 : /*
51398 : * Reverse communication preparations
51399 : * I know it looks ugly, but it works the same way
51400 : * anywhere from C++ to Python.
51401 : *
51402 : * This code initializes locals by:
51403 : * * random values determined during code
51404 : * generation - on first subroutine call
51405 : * * values from previous call - on subsequent calls
51406 : */
51407 0 : if( state->rstate.stage>=0 )
51408 : {
51409 0 : n = state->rstate.ia.ptr.p_int[0];
51410 0 : nwork = state->rstate.ia.ptr.p_int[1];
51411 0 : k = state->rstate.ia.ptr.p_int[2];
51412 0 : cnt = state->rstate.ia.ptr.p_int[3];
51413 0 : i = state->rstate.ia.ptr.p_int[4];
51414 0 : i1 = state->rstate.ia.ptr.p_int[5];
51415 0 : j = state->rstate.ia.ptr.p_int[6];
51416 0 : convcnt = state->rstate.ia.ptr.p_int[7];
51417 0 : vv = state->rstate.ra.ptr.p_double[0];
51418 0 : v = state->rstate.ra.ptr.p_double[1];
51419 : }
51420 : else
51421 : {
51422 0 : n = 359;
51423 0 : nwork = -58;
51424 0 : k = -919;
51425 0 : cnt = -909;
51426 0 : i = 81;
51427 0 : i1 = 255;
51428 0 : j = 74;
51429 0 : convcnt = -788;
51430 0 : vv = 809;
51431 0 : v = 205;
51432 : }
51433 0 : if( state->rstate.stage==0 )
51434 : {
51435 0 : goto lbl_0;
51436 : }
51437 :
51438 : /*
51439 : * Routine body
51440 : */
51441 0 : n = state->n;
51442 0 : k = state->k;
51443 0 : nwork = state->nwork;
51444 :
51445 : /*
51446 : * Initialize RNG. Deterministic initialization (with fixed
51447 : * seed) is required because we need deterministic behavior
51448 : * of the entire solver.
51449 : */
51450 0 : hqrndseed(453, 463664, &state->rs, _state);
51451 :
51452 : /*
51453 : * Prepare iteration
51454 : * Initialize QNew with random orthogonal matrix (or reuse its previous value).
51455 : */
51456 0 : state->repiterationscount = 0;
51457 0 : rmatrixsetlengthatleast(&state->qcur, nwork, n, _state);
51458 0 : rmatrixsetlengthatleast(&state->qnew, nwork, n, _state);
51459 0 : rmatrixsetlengthatleast(&state->znew, nwork, n, _state);
51460 0 : rvectorsetlengthatleast(&state->wcur, nwork, _state);
51461 0 : rvectorsetlengthatleast(&state->wprev, nwork, _state);
51462 0 : rvectorsetlengthatleast(&state->wrank, nwork, _state);
51463 0 : rmatrixsetlengthatleast(&state->x, n, nwork, _state);
51464 0 : rmatrixsetlengthatleast(&state->ax, n, nwork, _state);
51465 0 : rmatrixsetlengthatleast(&state->rq, n, k, _state);
51466 0 : rvectorsetlengthatleast(&state->rw, k, _state);
51467 0 : rmatrixsetlengthatleast(&state->rz, nwork, k, _state);
51468 0 : rmatrixsetlengthatleast(&state->r, nwork, nwork, _state);
51469 0 : for(i=0; i<=nwork-1; i++)
51470 : {
51471 0 : state->wprev.ptr.p_double[i] = -1.0;
51472 : }
51473 0 : if( !state->usewarmstart||state->firstcall )
51474 : {
51475 :
51476 : /*
51477 : * Use Q0 (either no warm start request, or warm start was
51478 : * requested by user - but it is first call).
51479 : *
51480 : */
51481 0 : if( state->firstcall )
51482 : {
51483 :
51484 : /*
51485 : * First call, generate Q0
51486 : */
51487 0 : for(i=0; i<=nwork-1; i++)
51488 : {
51489 0 : for(j=0; j<=n-1; j++)
51490 : {
51491 0 : state->znew.ptr.pp_double[i][j] = hqrnduniformr(&state->rs, _state)-0.5;
51492 : }
51493 : }
51494 0 : rmatrixlq(&state->znew, nwork, n, &state->tau, _state);
51495 0 : rmatrixlqunpackq(&state->znew, nwork, n, &state->tau, nwork, &state->q0, _state);
51496 0 : state->firstcall = ae_false;
51497 : }
51498 0 : rmatrixcopy(nwork, n, &state->q0, 0, 0, &state->qnew, 0, 0, _state);
51499 : }
51500 :
51501 : /*
51502 : * Start iteration
51503 : */
51504 0 : state->repiterationscount = 0;
51505 0 : convcnt = 0;
51506 0 : lbl_1:
51507 0 : if( !((state->maxits==0||state->repiterationscount<state->maxits)&&convcnt<evd_stepswithintol) )
51508 : {
51509 0 : goto lbl_2;
51510 : }
51511 :
51512 : /*
51513 : * Update QCur := QNew
51514 : *
51515 : * Calculate A*Q'
51516 : */
51517 0 : rmatrixcopy(nwork, n, &state->qnew, 0, 0, &state->qcur, 0, 0, _state);
51518 0 : rmatrixtranspose(nwork, n, &state->qcur, 0, 0, &state->x, 0, 0, _state);
51519 0 : evd_clearrfields(state, _state);
51520 0 : state->requesttype = 0;
51521 0 : state->requestsize = nwork;
51522 0 : state->rstate.stage = 0;
51523 0 : goto lbl_rcomm;
51524 0 : lbl_0:
51525 :
51526 : /*
51527 : * Perform Rayleigh-Ritz step to estimate convergence of diagonal eigenvalues
51528 : */
51529 0 : if( ae_fp_greater(state->eps,(double)(0)) )
51530 : {
51531 0 : ae_assert(state->matrixtype==0, "integrity check failed", _state);
51532 0 : rmatrixsetlengthatleast(&state->r, nwork, nwork, _state);
51533 0 : rmatrixgemm(nwork, nwork, n, 1.0, &state->qcur, 0, 0, 0, &state->ax, 0, 0, 0, 0.0, &state->r, 0, 0, _state);
51534 0 : if( !smatrixevd(&state->r, nwork, 0, ae_true, &state->wcur, &state->dummy, _state) )
51535 : {
51536 0 : ae_assert(ae_false, "EigSubspace: direct eigensolver failed to converge", _state);
51537 : }
51538 0 : for(j=0; j<=nwork-1; j++)
51539 : {
51540 0 : state->wrank.ptr.p_double[j] = ae_fabs(state->wcur.ptr.p_double[j], _state);
51541 : }
51542 0 : rankxuntied(&state->wrank, nwork, &state->buf, _state);
51543 0 : v = (double)(0);
51544 0 : vv = (double)(0);
51545 0 : for(j=0; j<=nwork-1; j++)
51546 : {
51547 0 : if( ae_fp_greater_eq(state->wrank.ptr.p_double[j],(double)(nwork-k)) )
51548 : {
51549 0 : v = ae_maxreal(v, ae_fabs(state->wcur.ptr.p_double[j]-state->wprev.ptr.p_double[j], _state), _state);
51550 0 : vv = ae_maxreal(vv, ae_fabs(state->wcur.ptr.p_double[j], _state), _state);
51551 : }
51552 : }
51553 0 : if( ae_fp_eq(vv,(double)(0)) )
51554 : {
51555 0 : vv = (double)(1);
51556 : }
51557 0 : if( ae_fp_less_eq(v,state->eps*vv) )
51558 : {
51559 0 : inc(&convcnt, _state);
51560 : }
51561 : else
51562 : {
51563 0 : convcnt = 0;
51564 : }
51565 0 : for(j=0; j<=nwork-1; j++)
51566 : {
51567 0 : state->wprev.ptr.p_double[j] = state->wcur.ptr.p_double[j];
51568 : }
51569 : }
51570 :
51571 : /*
51572 : * QR renormalization and update of QNew
51573 : */
51574 0 : rmatrixtranspose(n, nwork, &state->ax, 0, 0, &state->znew, 0, 0, _state);
51575 0 : rmatrixlq(&state->znew, nwork, n, &state->tau, _state);
51576 0 : rmatrixlqunpackq(&state->znew, nwork, n, &state->tau, nwork, &state->qnew, _state);
51577 :
51578 : /*
51579 : * Update iteration index
51580 : */
51581 0 : state->repiterationscount = state->repiterationscount+1;
51582 0 : goto lbl_1;
51583 0 : lbl_2:
51584 :
51585 : /*
51586 : * Perform Rayleigh-Ritz step: find true eigenpairs in NWork-dimensional
51587 : * subspace.
51588 : */
51589 0 : ae_assert(state->matrixtype==0, "integrity check failed", _state);
51590 0 : ae_assert(state->eigenvectorsneeded==1, "Assertion failed", _state);
51591 0 : rmatrixgemm(nwork, nwork, n, 1.0, &state->qcur, 0, 0, 0, &state->ax, 0, 0, 0, 0.0, &state->r, 0, 0, _state);
51592 0 : if( !smatrixevd(&state->r, nwork, 1, ae_true, &state->tw, &state->tz, _state) )
51593 : {
51594 0 : ae_assert(ae_false, "EigSubspace: direct eigensolver failed to converge", _state);
51595 : }
51596 :
51597 : /*
51598 : * Reorder eigenpairs according to their absolute magnitude, select
51599 : * K top ones. This reordering algorithm is very inefficient and has
51600 : * O(NWork*K) running time, but it is still faster than other parts
51601 : * of the solver, so we may use it.
51602 : *
51603 : * Then, we transform RZ to RQ (full N-dimensional representation).
51604 : * After this part is done, RW and RQ contain solution.
51605 : */
51606 0 : for(j=0; j<=nwork-1; j++)
51607 : {
51608 0 : state->wrank.ptr.p_double[j] = ae_fabs(state->tw.ptr.p_double[j], _state);
51609 : }
51610 0 : rankxuntied(&state->wrank, nwork, &state->buf, _state);
51611 0 : cnt = 0;
51612 0 : for(i=nwork-1; i>=nwork-k; i--)
51613 : {
51614 0 : for(i1=0; i1<=nwork-1; i1++)
51615 : {
51616 0 : if( ae_fp_eq(state->wrank.ptr.p_double[i1],(double)(i)) )
51617 : {
51618 0 : ae_assert(cnt<k, "EigSubspace: integrity check failed", _state);
51619 0 : state->rw.ptr.p_double[cnt] = state->tw.ptr.p_double[i1];
51620 0 : for(j=0; j<=nwork-1; j++)
51621 : {
51622 0 : state->rz.ptr.pp_double[j][cnt] = state->tz.ptr.pp_double[j][i1];
51623 : }
51624 0 : cnt = cnt+1;
51625 : }
51626 : }
51627 : }
51628 0 : ae_assert(cnt==k, "EigSubspace: integrity check failed", _state);
51629 0 : rmatrixgemm(n, k, nwork, 1.0, &state->qcur, 0, 0, 1, &state->rz, 0, 0, 0, 0.0, &state->rq, 0, 0, _state);
51630 0 : result = ae_false;
51631 0 : return result;
51632 :
51633 : /*
51634 : * Saving state
51635 : */
51636 0 : lbl_rcomm:
51637 0 : result = ae_true;
51638 0 : state->rstate.ia.ptr.p_int[0] = n;
51639 0 : state->rstate.ia.ptr.p_int[1] = nwork;
51640 0 : state->rstate.ia.ptr.p_int[2] = k;
51641 0 : state->rstate.ia.ptr.p_int[3] = cnt;
51642 0 : state->rstate.ia.ptr.p_int[4] = i;
51643 0 : state->rstate.ia.ptr.p_int[5] = i1;
51644 0 : state->rstate.ia.ptr.p_int[6] = j;
51645 0 : state->rstate.ia.ptr.p_int[7] = convcnt;
51646 0 : state->rstate.ra.ptr.p_double[0] = vv;
51647 0 : state->rstate.ra.ptr.p_double[1] = v;
51648 0 : return result;
51649 : }
51650 :
51651 :
51652 : /*************************************************************************
51653 : Finding the eigenvalues and eigenvectors of a symmetric matrix
51654 :
51655 : The algorithm finds eigen pairs of a symmetric matrix by reducing it to
51656 : tridiagonal form and using the QL/QR algorithm.
51657 :
51658 : ! COMMERCIAL EDITION OF ALGLIB:
51659 : !
51660 : ! Commercial Edition of ALGLIB includes following important improvements
51661 : ! of this function:
51662 : ! * high-performance native backend with same C# interface (C# version)
51663 : ! * hardware vendor (Intel) implementations of linear algebra primitives
51664 : ! (C++ and C# versions, x86/x64 platform)
51665 : !
51666 : ! We recommend you to read 'Working with commercial version' section of
51667 : ! ALGLIB Reference Manual in order to find out how to use performance-
51668 : ! related features provided by commercial edition of ALGLIB.
51669 :
51670 : Input parameters:
51671 : A - symmetric matrix which is given by its upper or lower
51672 : triangular part.
51673 : Array whose indexes range within [0..N-1, 0..N-1].
51674 : N - size of matrix A.
51675 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
51676 : If ZNeeded is equal to:
51677 : * 0, the eigenvectors are not returned;
51678 : * 1, the eigenvectors are returned.
51679 : IsUpper - storage format.
51680 :
51681 : Output parameters:
51682 : D - eigenvalues in ascending order.
51683 : Array whose index ranges within [0..N-1].
51684 : Z - if ZNeeded is equal to:
51685 : * 0, Z hasn't changed;
51686 : * 1, Z contains the eigenvectors.
51687 : Array whose indexes range within [0..N-1, 0..N-1].
51688 : The eigenvectors are stored in the matrix columns.
51689 :
51690 : Result:
51691 : True, if the algorithm has converged.
51692 : False, if the algorithm hasn't converged (rare case).
51693 :
51694 : -- ALGLIB --
51695 : Copyright 2005-2008 by Bochkanov Sergey
51696 : *************************************************************************/
51697 0 : ae_bool smatrixevd(/* Real */ ae_matrix* a,
51698 : ae_int_t n,
51699 : ae_int_t zneeded,
51700 : ae_bool isupper,
51701 : /* Real */ ae_vector* d,
51702 : /* Real */ ae_matrix* z,
51703 : ae_state *_state)
51704 : {
51705 : ae_frame _frame_block;
51706 : ae_matrix _a;
51707 : ae_vector tau;
51708 : ae_vector e;
51709 : ae_bool result;
51710 :
51711 0 : ae_frame_make(_state, &_frame_block);
51712 0 : memset(&_a, 0, sizeof(_a));
51713 0 : memset(&tau, 0, sizeof(tau));
51714 0 : memset(&e, 0, sizeof(e));
51715 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
51716 0 : a = &_a;
51717 0 : ae_vector_clear(d);
51718 0 : ae_matrix_clear(z);
51719 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
51720 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
51721 :
51722 0 : ae_assert(zneeded==0||zneeded==1, "SMatrixEVD: incorrect ZNeeded", _state);
51723 0 : smatrixtd(a, n, isupper, &tau, d, &e, _state);
51724 0 : if( zneeded==1 )
51725 : {
51726 0 : smatrixtdunpackq(a, n, isupper, &tau, z, _state);
51727 : }
51728 0 : result = smatrixtdevd(d, &e, n, zneeded, z, _state);
51729 0 : ae_frame_leave(_state);
51730 0 : return result;
51731 : }
51732 :
51733 :
51734 : /*************************************************************************
51735 : Subroutine for finding the eigenvalues (and eigenvectors) of a symmetric
51736 : matrix in a given half open interval (A, B] by using a bisection and
51737 : inverse iteration
51738 :
51739 : ! COMMERCIAL EDITION OF ALGLIB:
51740 : !
51741 : ! Commercial Edition of ALGLIB includes following important improvements
51742 : ! of this function:
51743 : ! * high-performance native backend with same C# interface (C# version)
51744 : ! * hardware vendor (Intel) implementations of linear algebra primitives
51745 : ! (C++ and C# versions, x86/x64 platform)
51746 : !
51747 : ! We recommend you to read 'Working with commercial version' section of
51748 : ! ALGLIB Reference Manual in order to find out how to use performance-
51749 : ! related features provided by commercial edition of ALGLIB.
51750 :
51751 : Input parameters:
51752 : A - symmetric matrix which is given by its upper or lower
51753 : triangular part. Array [0..N-1, 0..N-1].
51754 : N - size of matrix A.
51755 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
51756 : If ZNeeded is equal to:
51757 : * 0, the eigenvectors are not returned;
51758 : * 1, the eigenvectors are returned.
51759 : IsUpperA - storage format of matrix A.
51760 : B1, B2 - half open interval (B1, B2] to search eigenvalues in.
51761 :
51762 : Output parameters:
51763 : M - number of eigenvalues found in a given half-interval (M>=0).
51764 : W - array of the eigenvalues found.
51765 : Array whose index ranges within [0..M-1].
51766 : Z - if ZNeeded is equal to:
51767 : * 0, Z hasn't changed;
51768 : * 1, Z contains eigenvectors.
51769 : Array whose indexes range within [0..N-1, 0..M-1].
51770 : The eigenvectors are stored in the matrix columns.
51771 :
51772 : Result:
51773 : True, if successful. M contains the number of eigenvalues in the given
51774 : half-interval (could be equal to 0), W contains the eigenvalues,
51775 : Z contains the eigenvectors (if needed).
51776 :
51777 : False, if the bisection method subroutine wasn't able to find the
51778 : eigenvalues in the given interval or if the inverse iteration subroutine
51779 : wasn't able to find all the corresponding eigenvectors.
51780 : In that case, the eigenvalues and eigenvectors are not returned,
51781 : M is equal to 0.
51782 :
51783 : -- ALGLIB --
51784 : Copyright 07.01.2006 by Bochkanov Sergey
51785 : *************************************************************************/
51786 0 : ae_bool smatrixevdr(/* Real */ ae_matrix* a,
51787 : ae_int_t n,
51788 : ae_int_t zneeded,
51789 : ae_bool isupper,
51790 : double b1,
51791 : double b2,
51792 : ae_int_t* m,
51793 : /* Real */ ae_vector* w,
51794 : /* Real */ ae_matrix* z,
51795 : ae_state *_state)
51796 : {
51797 : ae_frame _frame_block;
51798 : ae_matrix _a;
51799 : ae_vector tau;
51800 : ae_vector e;
51801 : ae_bool result;
51802 :
51803 0 : ae_frame_make(_state, &_frame_block);
51804 0 : memset(&_a, 0, sizeof(_a));
51805 0 : memset(&tau, 0, sizeof(tau));
51806 0 : memset(&e, 0, sizeof(e));
51807 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
51808 0 : a = &_a;
51809 0 : *m = 0;
51810 0 : ae_vector_clear(w);
51811 0 : ae_matrix_clear(z);
51812 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
51813 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
51814 :
51815 0 : ae_assert(zneeded==0||zneeded==1, "SMatrixTDEVDR: incorrect ZNeeded", _state);
51816 0 : smatrixtd(a, n, isupper, &tau, w, &e, _state);
51817 0 : if( zneeded==1 )
51818 : {
51819 0 : smatrixtdunpackq(a, n, isupper, &tau, z, _state);
51820 : }
51821 0 : result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, z, _state);
51822 0 : ae_frame_leave(_state);
51823 0 : return result;
51824 : }
51825 :
51826 :
51827 : /*************************************************************************
51828 : Subroutine for finding the eigenvalues and eigenvectors of a symmetric
51829 : matrix with given indexes by using bisection and inverse iteration methods.
51830 :
51831 : Input parameters:
51832 : A - symmetric matrix which is given by its upper or lower
51833 : triangular part. Array whose indexes range within [0..N-1, 0..N-1].
51834 : N - size of matrix A.
51835 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
51836 : If ZNeeded is equal to:
51837 : * 0, the eigenvectors are not returned;
51838 : * 1, the eigenvectors are returned.
51839 : IsUpperA - storage format of matrix A.
51840 : I1, I2 - index interval for searching (from I1 to I2).
51841 : 0 <= I1 <= I2 <= N-1.
51842 :
51843 : Output parameters:
51844 : W - array of the eigenvalues found.
51845 : Array whose index ranges within [0..I2-I1].
51846 : Z - if ZNeeded is equal to:
51847 : * 0, Z hasn't changed;
51848 : * 1, Z contains eigenvectors.
51849 : Array whose indexes range within [0..N-1, 0..I2-I1].
51850 : In that case, the eigenvectors are stored in the matrix columns.
51851 :
51852 : Result:
51853 : True, if successful. W contains the eigenvalues, Z contains the
51854 : eigenvectors (if needed).
51855 :
51856 : False, if the bisection method subroutine wasn't able to find the
51857 : eigenvalues in the given interval or if the inverse iteration subroutine
51858 : wasn't able to find all the corresponding eigenvectors.
51859 : In that case, the eigenvalues and eigenvectors are not returned.
51860 :
51861 : -- ALGLIB --
51862 : Copyright 07.01.2006 by Bochkanov Sergey
51863 : *************************************************************************/
51864 0 : ae_bool smatrixevdi(/* Real */ ae_matrix* a,
51865 : ae_int_t n,
51866 : ae_int_t zneeded,
51867 : ae_bool isupper,
51868 : ae_int_t i1,
51869 : ae_int_t i2,
51870 : /* Real */ ae_vector* w,
51871 : /* Real */ ae_matrix* z,
51872 : ae_state *_state)
51873 : {
51874 : ae_frame _frame_block;
51875 : ae_matrix _a;
51876 : ae_vector tau;
51877 : ae_vector e;
51878 : ae_bool result;
51879 :
51880 0 : ae_frame_make(_state, &_frame_block);
51881 0 : memset(&_a, 0, sizeof(_a));
51882 0 : memset(&tau, 0, sizeof(tau));
51883 0 : memset(&e, 0, sizeof(e));
51884 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
51885 0 : a = &_a;
51886 0 : ae_vector_clear(w);
51887 0 : ae_matrix_clear(z);
51888 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
51889 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
51890 :
51891 0 : ae_assert(zneeded==0||zneeded==1, "SMatrixEVDI: incorrect ZNeeded", _state);
51892 0 : smatrixtd(a, n, isupper, &tau, w, &e, _state);
51893 0 : if( zneeded==1 )
51894 : {
51895 0 : smatrixtdunpackq(a, n, isupper, &tau, z, _state);
51896 : }
51897 0 : result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, z, _state);
51898 0 : ae_frame_leave(_state);
51899 0 : return result;
51900 : }
51901 :
51902 :
51903 : /*************************************************************************
51904 : Finding the eigenvalues and eigenvectors of a Hermitian matrix
51905 :
51906 : The algorithm finds eigen pairs of a Hermitian matrix by reducing it to
51907 : real tridiagonal form and using the QL/QR algorithm.
51908 :
51909 : ! COMMERCIAL EDITION OF ALGLIB:
51910 : !
51911 : ! Commercial Edition of ALGLIB includes following important improvements
51912 : ! of this function:
51913 : ! * high-performance native backend with same C# interface (C# version)
51914 : ! * hardware vendor (Intel) implementations of linear algebra primitives
51915 : ! (C++ and C# versions, x86/x64 platform)
51916 : !
51917 : ! We recommend you to read 'Working with commercial version' section of
51918 : ! ALGLIB Reference Manual in order to find out how to use performance-
51919 : ! related features provided by commercial edition of ALGLIB.
51920 :
51921 : Input parameters:
51922 : A - Hermitian matrix which is given by its upper or lower
51923 : triangular part.
51924 : Array whose indexes range within [0..N-1, 0..N-1].
51925 : N - size of matrix A.
51926 : IsUpper - storage format.
51927 : ZNeeded - flag controlling whether the eigenvectors are needed or
51928 : not. If ZNeeded is equal to:
51929 : * 0, the eigenvectors are not returned;
51930 : * 1, the eigenvectors are returned.
51931 :
51932 : Output parameters:
51933 : D - eigenvalues in ascending order.
51934 : Array whose index ranges within [0..N-1].
51935 : Z - if ZNeeded is equal to:
51936 : * 0, Z hasn't changed;
51937 : * 1, Z contains the eigenvectors.
51938 : Array whose indexes range within [0..N-1, 0..N-1].
51939 : The eigenvectors are stored in the matrix columns.
51940 :
51941 : Result:
51942 : True, if the algorithm has converged.
51943 : False, if the algorithm hasn't converged (rare case).
51944 :
51945 : Note:
51946 : eigenvectors of Hermitian matrix are defined up to multiplication by
51947 : a complex number L, such that |L|=1.
51948 :
51949 : -- ALGLIB --
51950 : Copyright 2005, 23 March 2007 by Bochkanov Sergey
51951 : *************************************************************************/
51952 0 : ae_bool hmatrixevd(/* Complex */ ae_matrix* a,
51953 : ae_int_t n,
51954 : ae_int_t zneeded,
51955 : ae_bool isupper,
51956 : /* Real */ ae_vector* d,
51957 : /* Complex */ ae_matrix* z,
51958 : ae_state *_state)
51959 : {
51960 : ae_frame _frame_block;
51961 : ae_matrix _a;
51962 : ae_vector tau;
51963 : ae_vector e;
51964 : ae_matrix t;
51965 : ae_matrix qz;
51966 : ae_matrix q;
51967 : ae_int_t i;
51968 : ae_int_t j;
51969 : ae_bool result;
51970 :
51971 0 : ae_frame_make(_state, &_frame_block);
51972 0 : memset(&_a, 0, sizeof(_a));
51973 0 : memset(&tau, 0, sizeof(tau));
51974 0 : memset(&e, 0, sizeof(e));
51975 0 : memset(&t, 0, sizeof(t));
51976 0 : memset(&qz, 0, sizeof(qz));
51977 0 : memset(&q, 0, sizeof(q));
51978 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
51979 0 : a = &_a;
51980 0 : ae_vector_clear(d);
51981 0 : ae_matrix_clear(z);
51982 0 : ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true);
51983 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
51984 0 : ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true);
51985 0 : ae_matrix_init(&qz, 0, 0, DT_REAL, _state, ae_true);
51986 0 : ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true);
51987 :
51988 0 : ae_assert(zneeded==0||zneeded==1, "HermitianEVD: incorrect ZNeeded", _state);
51989 :
51990 : /*
51991 : * Reduce to tridiagonal form
51992 : */
51993 0 : hmatrixtd(a, n, isupper, &tau, d, &e, _state);
51994 0 : if( zneeded==1 )
51995 : {
51996 0 : hmatrixtdunpackq(a, n, isupper, &tau, &q, _state);
51997 0 : zneeded = 2;
51998 : }
51999 :
52000 : /*
52001 : * TDEVD
52002 : */
52003 0 : result = smatrixtdevd(d, &e, n, zneeded, &t, _state);
52004 :
52005 : /*
52006 : * Eigenvectors are needed
52007 : * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
52008 : */
52009 0 : if( result&&zneeded!=0 )
52010 : {
52011 0 : ae_matrix_set_length(z, n, n, _state);
52012 0 : ae_matrix_set_length(&qz, n, 2*n, _state);
52013 :
52014 : /*
52015 : * Calculate Re(Q)*T
52016 : */
52017 0 : for(i=0; i<=n-1; i++)
52018 : {
52019 0 : for(j=0; j<=n-1; j++)
52020 : {
52021 0 : qz.ptr.pp_double[i][j] = q.ptr.pp_complex[i][j].x;
52022 : }
52023 : }
52024 0 : rmatrixgemm(n, n, n, 1.0, &qz, 0, 0, 0, &t, 0, 0, 0, 0.0, &qz, 0, n, _state);
52025 0 : for(i=0; i<=n-1; i++)
52026 : {
52027 0 : for(j=0; j<=n-1; j++)
52028 : {
52029 0 : z->ptr.pp_complex[i][j].x = qz.ptr.pp_double[i][n+j];
52030 : }
52031 : }
52032 :
52033 : /*
52034 : * Calculate Im(Q)*T
52035 : */
52036 0 : for(i=0; i<=n-1; i++)
52037 : {
52038 0 : for(j=0; j<=n-1; j++)
52039 : {
52040 0 : qz.ptr.pp_double[i][j] = q.ptr.pp_complex[i][j].y;
52041 : }
52042 : }
52043 0 : rmatrixgemm(n, n, n, 1.0, &qz, 0, 0, 0, &t, 0, 0, 0, 0.0, &qz, 0, n, _state);
52044 0 : for(i=0; i<=n-1; i++)
52045 : {
52046 0 : for(j=0; j<=n-1; j++)
52047 : {
52048 0 : z->ptr.pp_complex[i][j].y = qz.ptr.pp_double[i][n+j];
52049 : }
52050 : }
52051 : }
52052 0 : ae_frame_leave(_state);
52053 0 : return result;
52054 : }
52055 :
52056 :
52057 : /*************************************************************************
52058 : Subroutine for finding the eigenvalues (and eigenvectors) of a Hermitian
52059 : matrix in a given half-interval (A, B] by using a bisection and inverse
52060 : iteration
52061 :
52062 : Input parameters:
52063 : A - Hermitian matrix which is given by its upper or lower
52064 : triangular part. Array whose indexes range within
52065 : [0..N-1, 0..N-1].
52066 : N - size of matrix A.
52067 : ZNeeded - flag controlling whether the eigenvectors are needed or
52068 : not. If ZNeeded is equal to:
52069 : * 0, the eigenvectors are not returned;
52070 : * 1, the eigenvectors are returned.
52071 : IsUpperA - storage format of matrix A.
52072 : B1, B2 - half-interval (B1, B2] to search eigenvalues in.
52073 :
52074 : Output parameters:
52075 : M - number of eigenvalues found in a given half-interval, M>=0
52076 : W - array of the eigenvalues found.
52077 : Array whose index ranges within [0..M-1].
52078 : Z - if ZNeeded is equal to:
52079 : * 0, Z hasn't changed;
52080 : * 1, Z contains eigenvectors.
52081 : Array whose indexes range within [0..N-1, 0..M-1].
52082 : The eigenvectors are stored in the matrix columns.
52083 :
52084 : Result:
52085 : True, if successful. M contains the number of eigenvalues in the given
52086 : half-interval (could be equal to 0), W contains the eigenvalues,
52087 : Z contains the eigenvectors (if needed).
52088 :
52089 : False, if the bisection method subroutine wasn't able to find the
52090 : eigenvalues in the given interval or if the inverse iteration
52091 : subroutine wasn't able to find all the corresponding eigenvectors.
52092 : In that case, the eigenvalues and eigenvectors are not returned, M is
52093 : equal to 0.
52094 :
52095 : Note:
52096 : eigen vectors of Hermitian matrix are defined up to multiplication by
52097 : a complex number L, such as |L|=1.
52098 :
52099 : -- ALGLIB --
52100 : Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey.
52101 : *************************************************************************/
52102 0 : ae_bool hmatrixevdr(/* Complex */ ae_matrix* a,
52103 : ae_int_t n,
52104 : ae_int_t zneeded,
52105 : ae_bool isupper,
52106 : double b1,
52107 : double b2,
52108 : ae_int_t* m,
52109 : /* Real */ ae_vector* w,
52110 : /* Complex */ ae_matrix* z,
52111 : ae_state *_state)
52112 : {
52113 : ae_frame _frame_block;
52114 : ae_matrix _a;
52115 : ae_matrix q;
52116 : ae_matrix t;
52117 : ae_vector tau;
52118 : ae_vector e;
52119 : ae_vector work;
52120 : ae_int_t i;
52121 : ae_int_t k;
52122 : double v;
52123 : ae_bool result;
52124 :
52125 0 : ae_frame_make(_state, &_frame_block);
52126 0 : memset(&_a, 0, sizeof(_a));
52127 0 : memset(&q, 0, sizeof(q));
52128 0 : memset(&t, 0, sizeof(t));
52129 0 : memset(&tau, 0, sizeof(tau));
52130 0 : memset(&e, 0, sizeof(e));
52131 0 : memset(&work, 0, sizeof(work));
52132 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
52133 0 : a = &_a;
52134 0 : *m = 0;
52135 0 : ae_vector_clear(w);
52136 0 : ae_matrix_clear(z);
52137 0 : ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true);
52138 0 : ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true);
52139 0 : ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true);
52140 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
52141 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
52142 :
52143 0 : ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsInInterval: incorrect ZNeeded", _state);
52144 :
52145 : /*
52146 : * Reduce to tridiagonal form
52147 : */
52148 0 : hmatrixtd(a, n, isupper, &tau, w, &e, _state);
52149 0 : if( zneeded==1 )
52150 : {
52151 0 : hmatrixtdunpackq(a, n, isupper, &tau, &q, _state);
52152 0 : zneeded = 2;
52153 : }
52154 :
52155 : /*
52156 : * Bisection and inverse iteration
52157 : */
52158 0 : result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, &t, _state);
52159 :
52160 : /*
52161 : * Eigenvectors are needed
52162 : * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
52163 : */
52164 0 : if( (result&&zneeded!=0)&&*m!=0 )
52165 : {
52166 0 : ae_vector_set_length(&work, *m-1+1, _state);
52167 0 : ae_matrix_set_length(z, n-1+1, *m-1+1, _state);
52168 0 : for(i=0; i<=n-1; i++)
52169 : {
52170 :
52171 : /*
52172 : * Calculate real part
52173 : */
52174 0 : for(k=0; k<=*m-1; k++)
52175 : {
52176 0 : work.ptr.p_double[k] = (double)(0);
52177 : }
52178 0 : for(k=0; k<=n-1; k++)
52179 : {
52180 0 : v = q.ptr.pp_complex[i][k].x;
52181 0 : ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v);
52182 : }
52183 0 : for(k=0; k<=*m-1; k++)
52184 : {
52185 0 : z->ptr.pp_complex[i][k].x = work.ptr.p_double[k];
52186 : }
52187 :
52188 : /*
52189 : * Calculate imaginary part
52190 : */
52191 0 : for(k=0; k<=*m-1; k++)
52192 : {
52193 0 : work.ptr.p_double[k] = (double)(0);
52194 : }
52195 0 : for(k=0; k<=n-1; k++)
52196 : {
52197 0 : v = q.ptr.pp_complex[i][k].y;
52198 0 : ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v);
52199 : }
52200 0 : for(k=0; k<=*m-1; k++)
52201 : {
52202 0 : z->ptr.pp_complex[i][k].y = work.ptr.p_double[k];
52203 : }
52204 : }
52205 : }
52206 0 : ae_frame_leave(_state);
52207 0 : return result;
52208 : }
52209 :
52210 :
52211 : /*************************************************************************
52212 : Subroutine for finding the eigenvalues and eigenvectors of a Hermitian
52213 : matrix with given indexes by using bisection and inverse iteration methods
52214 :
52215 : Input parameters:
52216 : A - Hermitian matrix which is given by its upper or lower
52217 : triangular part.
52218 : Array whose indexes range within [0..N-1, 0..N-1].
52219 : N - size of matrix A.
52220 : ZNeeded - flag controlling whether the eigenvectors are needed or
52221 : not. If ZNeeded is equal to:
52222 : * 0, the eigenvectors are not returned;
52223 : * 1, the eigenvectors are returned.
52224 : IsUpperA - storage format of matrix A.
52225 : I1, I2 - index interval for searching (from I1 to I2).
52226 : 0 <= I1 <= I2 <= N-1.
52227 :
52228 : Output parameters:
52229 : W - array of the eigenvalues found.
52230 : Array whose index ranges within [0..I2-I1].
52231 : Z - if ZNeeded is equal to:
52232 : * 0, Z hasn't changed;
52233 : * 1, Z contains eigenvectors.
52234 : Array whose indexes range within [0..N-1, 0..I2-I1].
52235 : In that case, the eigenvectors are stored in the matrix
52236 : columns.
52237 :
52238 : Result:
52239 : True, if successful. W contains the eigenvalues, Z contains the
52240 : eigenvectors (if needed).
52241 :
52242 : False, if the bisection method subroutine wasn't able to find the
52243 : eigenvalues in the given interval or if the inverse iteration
52244 : subroutine wasn't able to find all the corresponding eigenvectors.
52245 : In that case, the eigenvalues and eigenvectors are not returned.
52246 :
52247 : Note:
52248 : eigen vectors of Hermitian matrix are defined up to multiplication by
52249 : a complex number L, such as |L|=1.
52250 :
52251 : -- ALGLIB --
52252 : Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey.
52253 : *************************************************************************/
52254 0 : ae_bool hmatrixevdi(/* Complex */ ae_matrix* a,
52255 : ae_int_t n,
52256 : ae_int_t zneeded,
52257 : ae_bool isupper,
52258 : ae_int_t i1,
52259 : ae_int_t i2,
52260 : /* Real */ ae_vector* w,
52261 : /* Complex */ ae_matrix* z,
52262 : ae_state *_state)
52263 : {
52264 : ae_frame _frame_block;
52265 : ae_matrix _a;
52266 : ae_matrix q;
52267 : ae_matrix t;
52268 : ae_vector tau;
52269 : ae_vector e;
52270 : ae_vector work;
52271 : ae_int_t i;
52272 : ae_int_t k;
52273 : double v;
52274 : ae_int_t m;
52275 : ae_bool result;
52276 :
52277 0 : ae_frame_make(_state, &_frame_block);
52278 0 : memset(&_a, 0, sizeof(_a));
52279 0 : memset(&q, 0, sizeof(q));
52280 0 : memset(&t, 0, sizeof(t));
52281 0 : memset(&tau, 0, sizeof(tau));
52282 0 : memset(&e, 0, sizeof(e));
52283 0 : memset(&work, 0, sizeof(work));
52284 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
52285 0 : a = &_a;
52286 0 : ae_vector_clear(w);
52287 0 : ae_matrix_clear(z);
52288 0 : ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true);
52289 0 : ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true);
52290 0 : ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true);
52291 0 : ae_vector_init(&e, 0, DT_REAL, _state, ae_true);
52292 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
52293 :
52294 0 : ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsByIndexes: incorrect ZNeeded", _state);
52295 :
52296 : /*
52297 : * Reduce to tridiagonal form
52298 : */
52299 0 : hmatrixtd(a, n, isupper, &tau, w, &e, _state);
52300 0 : if( zneeded==1 )
52301 : {
52302 0 : hmatrixtdunpackq(a, n, isupper, &tau, &q, _state);
52303 0 : zneeded = 2;
52304 : }
52305 :
52306 : /*
52307 : * Bisection and inverse iteration
52308 : */
52309 0 : result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, &t, _state);
52310 :
52311 : /*
52312 : * Eigenvectors are needed
52313 : * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T
52314 : */
52315 0 : m = i2-i1+1;
52316 0 : if( result&&zneeded!=0 )
52317 : {
52318 0 : ae_vector_set_length(&work, m-1+1, _state);
52319 0 : ae_matrix_set_length(z, n-1+1, m-1+1, _state);
52320 0 : for(i=0; i<=n-1; i++)
52321 : {
52322 :
52323 : /*
52324 : * Calculate real part
52325 : */
52326 0 : for(k=0; k<=m-1; k++)
52327 : {
52328 0 : work.ptr.p_double[k] = (double)(0);
52329 : }
52330 0 : for(k=0; k<=n-1; k++)
52331 : {
52332 0 : v = q.ptr.pp_complex[i][k].x;
52333 0 : ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v);
52334 : }
52335 0 : for(k=0; k<=m-1; k++)
52336 : {
52337 0 : z->ptr.pp_complex[i][k].x = work.ptr.p_double[k];
52338 : }
52339 :
52340 : /*
52341 : * Calculate imaginary part
52342 : */
52343 0 : for(k=0; k<=m-1; k++)
52344 : {
52345 0 : work.ptr.p_double[k] = (double)(0);
52346 : }
52347 0 : for(k=0; k<=n-1; k++)
52348 : {
52349 0 : v = q.ptr.pp_complex[i][k].y;
52350 0 : ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v);
52351 : }
52352 0 : for(k=0; k<=m-1; k++)
52353 : {
52354 0 : z->ptr.pp_complex[i][k].y = work.ptr.p_double[k];
52355 : }
52356 : }
52357 : }
52358 0 : ae_frame_leave(_state);
52359 0 : return result;
52360 : }
52361 :
52362 :
52363 : /*************************************************************************
52364 : Finding the eigenvalues and eigenvectors of a tridiagonal symmetric matrix
52365 :
52366 : The algorithm finds the eigen pairs of a tridiagonal symmetric matrix by
52367 : using an QL/QR algorithm with implicit shifts.
52368 :
52369 : ! COMMERCIAL EDITION OF ALGLIB:
52370 : !
52371 : ! Commercial Edition of ALGLIB includes following important improvements
52372 : ! of this function:
52373 : ! * high-performance native backend with same C# interface (C# version)
52374 : ! * hardware vendor (Intel) implementations of linear algebra primitives
52375 : ! (C++ and C# versions, x86/x64 platform)
52376 : !
52377 : ! We recommend you to read 'Working with commercial version' section of
52378 : ! ALGLIB Reference Manual in order to find out how to use performance-
52379 : ! related features provided by commercial edition of ALGLIB.
52380 :
52381 : Input parameters:
52382 : D - the main diagonal of a tridiagonal matrix.
52383 : Array whose index ranges within [0..N-1].
52384 : E - the secondary diagonal of a tridiagonal matrix.
52385 : Array whose index ranges within [0..N-2].
52386 : N - size of matrix A.
52387 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
52388 : If ZNeeded is equal to:
52389 : * 0, the eigenvectors are not needed;
52390 : * 1, the eigenvectors of a tridiagonal matrix
52391 : are multiplied by the square matrix Z. It is used if the
52392 : tridiagonal matrix is obtained by the similarity
52393 : transformation of a symmetric matrix;
52394 : * 2, the eigenvectors of a tridiagonal matrix replace the
52395 : square matrix Z;
52396 : * 3, matrix Z contains the first row of the eigenvectors
52397 : matrix.
52398 : Z - if ZNeeded=1, Z contains the square matrix by which the
52399 : eigenvectors are multiplied.
52400 : Array whose indexes range within [0..N-1, 0..N-1].
52401 :
52402 : Output parameters:
52403 : D - eigenvalues in ascending order.
52404 : Array whose index ranges within [0..N-1].
52405 : Z - if ZNeeded is equal to:
52406 : * 0, Z hasn't changed;
52407 : * 1, Z contains the product of a given matrix (from the left)
52408 : and the eigenvectors matrix (from the right);
52409 : * 2, Z contains the eigenvectors.
52410 : * 3, Z contains the first row of the eigenvectors matrix.
52411 : If ZNeeded<3, Z is the array whose indexes range within [0..N-1, 0..N-1].
52412 : In that case, the eigenvectors are stored in the matrix columns.
52413 : If ZNeeded=3, Z is the array whose indexes range within [0..0, 0..N-1].
52414 :
52415 : Result:
52416 : True, if the algorithm has converged.
52417 : False, if the algorithm hasn't converged.
52418 :
52419 : -- LAPACK routine (version 3.0) --
52420 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
52421 : Courant Institute, Argonne National Lab, and Rice University
52422 : September 30, 1994
52423 : *************************************************************************/
52424 0 : ae_bool smatrixtdevd(/* Real */ ae_vector* d,
52425 : /* Real */ ae_vector* e,
52426 : ae_int_t n,
52427 : ae_int_t zneeded,
52428 : /* Real */ ae_matrix* z,
52429 : ae_state *_state)
52430 : {
52431 : ae_frame _frame_block;
52432 : ae_vector _e;
52433 : ae_vector d1;
52434 : ae_vector e1;
52435 : ae_vector ex;
52436 : ae_matrix z1;
52437 : ae_int_t i;
52438 : ae_int_t j;
52439 : ae_bool result;
52440 :
52441 0 : ae_frame_make(_state, &_frame_block);
52442 0 : memset(&_e, 0, sizeof(_e));
52443 0 : memset(&d1, 0, sizeof(d1));
52444 0 : memset(&e1, 0, sizeof(e1));
52445 0 : memset(&ex, 0, sizeof(ex));
52446 0 : memset(&z1, 0, sizeof(z1));
52447 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
52448 0 : e = &_e;
52449 0 : ae_vector_init(&d1, 0, DT_REAL, _state, ae_true);
52450 0 : ae_vector_init(&e1, 0, DT_REAL, _state, ae_true);
52451 0 : ae_vector_init(&ex, 0, DT_REAL, _state, ae_true);
52452 0 : ae_matrix_init(&z1, 0, 0, DT_REAL, _state, ae_true);
52453 :
52454 0 : ae_assert(n>=1, "SMatrixTDEVD: N<=0", _state);
52455 0 : ae_assert(zneeded>=0&&zneeded<=3, "SMatrixTDEVD: incorrect ZNeeded", _state);
52456 0 : result = ae_false;
52457 :
52458 : /*
52459 : * Preprocess Z: make ZNeeded equal to 0, 1 or 3.
52460 : * Ensure that memory for Z is allocated.
52461 : */
52462 0 : if( zneeded==2 )
52463 : {
52464 :
52465 : /*
52466 : * Load identity to Z
52467 : */
52468 0 : rmatrixsetlengthatleast(z, n, n, _state);
52469 0 : for(i=0; i<=n-1; i++)
52470 : {
52471 0 : for(j=0; j<=n-1; j++)
52472 : {
52473 0 : z->ptr.pp_double[i][j] = 0.0;
52474 : }
52475 0 : z->ptr.pp_double[i][i] = 1.0;
52476 : }
52477 0 : zneeded = 1;
52478 : }
52479 0 : if( zneeded==3 )
52480 : {
52481 :
52482 : /*
52483 : * Allocate memory
52484 : */
52485 0 : rmatrixsetlengthatleast(z, 1, n, _state);
52486 : }
52487 :
52488 : /*
52489 : * Try to solve problem with MKL
52490 : */
52491 0 : ae_vector_set_length(&ex, n, _state);
52492 0 : for(i=0; i<=n-2; i++)
52493 : {
52494 0 : ex.ptr.p_double[i] = e->ptr.p_double[i];
52495 : }
52496 0 : if( smatrixtdevdmkl(d, &ex, n, zneeded, z, &result, _state) )
52497 : {
52498 0 : ae_frame_leave(_state);
52499 0 : return result;
52500 : }
52501 :
52502 : /*
52503 : * Prepare 1-based task
52504 : */
52505 0 : ae_vector_set_length(&d1, n+1, _state);
52506 0 : ae_vector_set_length(&e1, n+1, _state);
52507 0 : ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n));
52508 0 : if( n>1 )
52509 : {
52510 0 : ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1));
52511 : }
52512 0 : if( zneeded==1 )
52513 : {
52514 0 : ae_matrix_set_length(&z1, n+1, n+1, _state);
52515 0 : for(i=1; i<=n; i++)
52516 : {
52517 0 : ae_v_move(&z1.ptr.pp_double[i][1], 1, &z->ptr.pp_double[i-1][0], 1, ae_v_len(1,n));
52518 : }
52519 : }
52520 :
52521 : /*
52522 : * Solve 1-based task
52523 : */
52524 0 : result = evd_tridiagonalevd(&d1, &e1, n, zneeded, &z1, _state);
52525 0 : if( !result )
52526 : {
52527 0 : ae_frame_leave(_state);
52528 0 : return result;
52529 : }
52530 :
52531 : /*
52532 : * Convert back to 0-based result
52533 : */
52534 0 : ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1));
52535 0 : if( zneeded!=0 )
52536 : {
52537 0 : if( zneeded==1 )
52538 : {
52539 0 : for(i=1; i<=n; i++)
52540 : {
52541 0 : ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1));
52542 : }
52543 0 : ae_frame_leave(_state);
52544 0 : return result;
52545 : }
52546 0 : if( zneeded==2 )
52547 : {
52548 0 : ae_matrix_set_length(z, n-1+1, n-1+1, _state);
52549 0 : for(i=1; i<=n; i++)
52550 : {
52551 0 : ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1));
52552 : }
52553 0 : ae_frame_leave(_state);
52554 0 : return result;
52555 : }
52556 0 : if( zneeded==3 )
52557 : {
52558 0 : ae_matrix_set_length(z, 0+1, n-1+1, _state);
52559 0 : ae_v_move(&z->ptr.pp_double[0][0], 1, &z1.ptr.pp_double[1][1], 1, ae_v_len(0,n-1));
52560 0 : ae_frame_leave(_state);
52561 0 : return result;
52562 : }
52563 0 : ae_assert(ae_false, "SMatrixTDEVD: Incorrect ZNeeded!", _state);
52564 : }
52565 0 : ae_frame_leave(_state);
52566 0 : return result;
52567 : }
52568 :
52569 :
52570 : /*************************************************************************
52571 : Subroutine for finding the tridiagonal matrix eigenvalues/vectors in a
52572 : given half-interval (A, B] by using bisection and inverse iteration.
52573 :
52574 : Input parameters:
52575 : D - the main diagonal of a tridiagonal matrix.
52576 : Array whose index ranges within [0..N-1].
52577 : E - the secondary diagonal of a tridiagonal matrix.
52578 : Array whose index ranges within [0..N-2].
52579 : N - size of matrix, N>=0.
52580 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
52581 : If ZNeeded is equal to:
52582 : * 0, the eigenvectors are not needed;
52583 : * 1, the eigenvectors of a tridiagonal matrix are multiplied
52584 : by the square matrix Z. It is used if the tridiagonal
52585 : matrix is obtained by the similarity transformation
52586 : of a symmetric matrix.
52587 : * 2, the eigenvectors of a tridiagonal matrix replace matrix Z.
52588 : A, B - half-interval (A, B] to search eigenvalues in.
52589 : Z - if ZNeeded is equal to:
52590 : * 0, Z isn't used and remains unchanged;
52591 : * 1, Z contains the square matrix (array whose indexes range
52592 : within [0..N-1, 0..N-1]) which reduces the given symmetric
52593 : matrix to tridiagonal form;
52594 : * 2, Z isn't used (but changed on the exit).
52595 :
52596 : Output parameters:
52597 : D - array of the eigenvalues found.
52598 : Array whose index ranges within [0..M-1].
52599 : M - number of eigenvalues found in the given half-interval (M>=0).
52600 : Z - if ZNeeded is equal to:
52601 : * 0, doesn't contain any information;
52602 : * 1, contains the product of a given NxN matrix Z (from the
52603 : left) and NxM matrix of the eigenvectors found (from the
52604 : right). Array whose indexes range within [0..N-1, 0..M-1].
52605 : * 2, contains the matrix of the eigenvectors found.
52606 : Array whose indexes range within [0..N-1, 0..M-1].
52607 :
52608 : Result:
52609 :
52610 : True, if successful. In that case, M contains the number of eigenvalues
52611 : in the given half-interval (could be equal to 0), D contains the eigenvalues,
52612 : Z contains the eigenvectors (if needed).
52613 : It should be noted that the subroutine changes the size of arrays D and Z.
52614 :
52615 : False, if the bisection method subroutine wasn't able to find the
52616 : eigenvalues in the given interval or if the inverse iteration subroutine
52617 : wasn't able to find all the corresponding eigenvectors. In that case,
52618 : the eigenvalues and eigenvectors are not returned, M is equal to 0.
52619 :
52620 : -- ALGLIB --
52621 : Copyright 31.03.2008 by Bochkanov Sergey
52622 : *************************************************************************/
52623 0 : ae_bool smatrixtdevdr(/* Real */ ae_vector* d,
52624 : /* Real */ ae_vector* e,
52625 : ae_int_t n,
52626 : ae_int_t zneeded,
52627 : double a,
52628 : double b,
52629 : ae_int_t* m,
52630 : /* Real */ ae_matrix* z,
52631 : ae_state *_state)
52632 : {
52633 : ae_frame _frame_block;
52634 : ae_int_t errorcode;
52635 : ae_int_t nsplit;
52636 : ae_int_t i;
52637 : ae_int_t j;
52638 : ae_int_t k;
52639 : ae_int_t cr;
52640 : ae_vector iblock;
52641 : ae_vector isplit;
52642 : ae_vector ifail;
52643 : ae_vector d1;
52644 : ae_vector e1;
52645 : ae_vector w;
52646 : ae_matrix z2;
52647 : ae_matrix z3;
52648 : double v;
52649 : ae_bool result;
52650 :
52651 0 : ae_frame_make(_state, &_frame_block);
52652 0 : memset(&iblock, 0, sizeof(iblock));
52653 0 : memset(&isplit, 0, sizeof(isplit));
52654 0 : memset(&ifail, 0, sizeof(ifail));
52655 0 : memset(&d1, 0, sizeof(d1));
52656 0 : memset(&e1, 0, sizeof(e1));
52657 0 : memset(&w, 0, sizeof(w));
52658 0 : memset(&z2, 0, sizeof(z2));
52659 0 : memset(&z3, 0, sizeof(z3));
52660 0 : *m = 0;
52661 0 : ae_vector_init(&iblock, 0, DT_INT, _state, ae_true);
52662 0 : ae_vector_init(&isplit, 0, DT_INT, _state, ae_true);
52663 0 : ae_vector_init(&ifail, 0, DT_INT, _state, ae_true);
52664 0 : ae_vector_init(&d1, 0, DT_REAL, _state, ae_true);
52665 0 : ae_vector_init(&e1, 0, DT_REAL, _state, ae_true);
52666 0 : ae_vector_init(&w, 0, DT_REAL, _state, ae_true);
52667 0 : ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true);
52668 0 : ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true);
52669 :
52670 0 : ae_assert(zneeded>=0&&zneeded<=2, "SMatrixTDEVDR: incorrect ZNeeded!", _state);
52671 :
52672 : /*
52673 : * Special cases
52674 : */
52675 0 : if( ae_fp_less_eq(b,a) )
52676 : {
52677 0 : *m = 0;
52678 0 : result = ae_true;
52679 0 : ae_frame_leave(_state);
52680 0 : return result;
52681 : }
52682 0 : if( n<=0 )
52683 : {
52684 0 : *m = 0;
52685 0 : result = ae_true;
52686 0 : ae_frame_leave(_state);
52687 0 : return result;
52688 : }
52689 :
52690 : /*
52691 : * Copy D,E to D1, E1
52692 : */
52693 0 : ae_vector_set_length(&d1, n+1, _state);
52694 0 : ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n));
52695 0 : if( n>1 )
52696 : {
52697 0 : ae_vector_set_length(&e1, n-1+1, _state);
52698 0 : ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1));
52699 : }
52700 :
52701 : /*
52702 : * No eigen vectors
52703 : */
52704 0 : if( zneeded==0 )
52705 : {
52706 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 1, a, b, 0, 0, (double)(-1), &w, m, &nsplit, &iblock, &isplit, &errorcode, _state);
52707 0 : if( !result||*m==0 )
52708 : {
52709 0 : *m = 0;
52710 0 : ae_frame_leave(_state);
52711 0 : return result;
52712 : }
52713 0 : ae_vector_set_length(d, *m-1+1, _state);
52714 0 : ae_v_move(&d->ptr.p_double[0], 1, &w.ptr.p_double[1], 1, ae_v_len(0,*m-1));
52715 0 : ae_frame_leave(_state);
52716 0 : return result;
52717 : }
52718 :
52719 : /*
52720 : * Eigen vectors are multiplied by Z
52721 : */
52722 0 : if( zneeded==1 )
52723 : {
52724 :
52725 : /*
52726 : * Find eigen pairs
52727 : */
52728 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, (double)(-1), &w, m, &nsplit, &iblock, &isplit, &errorcode, _state);
52729 0 : if( !result||*m==0 )
52730 : {
52731 0 : *m = 0;
52732 0 : ae_frame_leave(_state);
52733 0 : return result;
52734 : }
52735 0 : evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state);
52736 0 : if( cr!=0 )
52737 : {
52738 0 : *m = 0;
52739 0 : result = ae_false;
52740 0 : ae_frame_leave(_state);
52741 0 : return result;
52742 : }
52743 :
52744 : /*
52745 : * Sort eigen values and vectors
52746 : */
52747 0 : for(i=1; i<=*m; i++)
52748 : {
52749 0 : k = i;
52750 0 : for(j=i; j<=*m; j++)
52751 : {
52752 0 : if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) )
52753 : {
52754 0 : k = j;
52755 : }
52756 : }
52757 0 : v = w.ptr.p_double[i];
52758 0 : w.ptr.p_double[i] = w.ptr.p_double[k];
52759 0 : w.ptr.p_double[k] = v;
52760 0 : for(j=1; j<=n; j++)
52761 : {
52762 0 : v = z2.ptr.pp_double[j][i];
52763 0 : z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k];
52764 0 : z2.ptr.pp_double[j][k] = v;
52765 : }
52766 : }
52767 :
52768 : /*
52769 : * Transform Z2 and overwrite Z
52770 : */
52771 0 : ae_matrix_set_length(&z3, *m+1, n+1, _state);
52772 0 : for(i=1; i<=*m; i++)
52773 : {
52774 0 : ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n));
52775 : }
52776 0 : for(i=1; i<=n; i++)
52777 : {
52778 0 : for(j=1; j<=*m; j++)
52779 : {
52780 0 : v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1));
52781 0 : z2.ptr.pp_double[i][j] = v;
52782 : }
52783 : }
52784 0 : ae_matrix_set_length(z, n-1+1, *m-1+1, _state);
52785 0 : for(i=1; i<=*m; i++)
52786 : {
52787 0 : ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1));
52788 : }
52789 :
52790 : /*
52791 : * Store W
52792 : */
52793 0 : ae_vector_set_length(d, *m-1+1, _state);
52794 0 : for(i=1; i<=*m; i++)
52795 : {
52796 0 : d->ptr.p_double[i-1] = w.ptr.p_double[i];
52797 : }
52798 0 : ae_frame_leave(_state);
52799 0 : return result;
52800 : }
52801 :
52802 : /*
52803 : * Eigen vectors are stored in Z
52804 : */
52805 0 : if( zneeded==2 )
52806 : {
52807 :
52808 : /*
52809 : * Find eigen pairs
52810 : */
52811 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, (double)(-1), &w, m, &nsplit, &iblock, &isplit, &errorcode, _state);
52812 0 : if( !result||*m==0 )
52813 : {
52814 0 : *m = 0;
52815 0 : ae_frame_leave(_state);
52816 0 : return result;
52817 : }
52818 0 : evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state);
52819 0 : if( cr!=0 )
52820 : {
52821 0 : *m = 0;
52822 0 : result = ae_false;
52823 0 : ae_frame_leave(_state);
52824 0 : return result;
52825 : }
52826 :
52827 : /*
52828 : * Sort eigen values and vectors
52829 : */
52830 0 : for(i=1; i<=*m; i++)
52831 : {
52832 0 : k = i;
52833 0 : for(j=i; j<=*m; j++)
52834 : {
52835 0 : if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) )
52836 : {
52837 0 : k = j;
52838 : }
52839 : }
52840 0 : v = w.ptr.p_double[i];
52841 0 : w.ptr.p_double[i] = w.ptr.p_double[k];
52842 0 : w.ptr.p_double[k] = v;
52843 0 : for(j=1; j<=n; j++)
52844 : {
52845 0 : v = z2.ptr.pp_double[j][i];
52846 0 : z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k];
52847 0 : z2.ptr.pp_double[j][k] = v;
52848 : }
52849 : }
52850 :
52851 : /*
52852 : * Store W
52853 : */
52854 0 : ae_vector_set_length(d, *m-1+1, _state);
52855 0 : for(i=1; i<=*m; i++)
52856 : {
52857 0 : d->ptr.p_double[i-1] = w.ptr.p_double[i];
52858 : }
52859 0 : ae_matrix_set_length(z, n-1+1, *m-1+1, _state);
52860 0 : for(i=1; i<=*m; i++)
52861 : {
52862 0 : ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1));
52863 : }
52864 0 : ae_frame_leave(_state);
52865 0 : return result;
52866 : }
52867 0 : result = ae_false;
52868 0 : ae_frame_leave(_state);
52869 0 : return result;
52870 : }
52871 :
52872 :
52873 : /*************************************************************************
52874 : Subroutine for finding tridiagonal matrix eigenvalues/vectors with given
52875 : indexes (in ascending order) by using the bisection and inverse iteraion.
52876 :
52877 : Input parameters:
52878 : D - the main diagonal of a tridiagonal matrix.
52879 : Array whose index ranges within [0..N-1].
52880 : E - the secondary diagonal of a tridiagonal matrix.
52881 : Array whose index ranges within [0..N-2].
52882 : N - size of matrix. N>=0.
52883 : ZNeeded - flag controlling whether the eigenvectors are needed or not.
52884 : If ZNeeded is equal to:
52885 : * 0, the eigenvectors are not needed;
52886 : * 1, the eigenvectors of a tridiagonal matrix are multiplied
52887 : by the square matrix Z. It is used if the
52888 : tridiagonal matrix is obtained by the similarity transformation
52889 : of a symmetric matrix.
52890 : * 2, the eigenvectors of a tridiagonal matrix replace
52891 : matrix Z.
52892 : I1, I2 - index interval for searching (from I1 to I2).
52893 : 0 <= I1 <= I2 <= N-1.
52894 : Z - if ZNeeded is equal to:
52895 : * 0, Z isn't used and remains unchanged;
52896 : * 1, Z contains the square matrix (array whose indexes range within [0..N-1, 0..N-1])
52897 : which reduces the given symmetric matrix to tridiagonal form;
52898 : * 2, Z isn't used (but changed on the exit).
52899 :
52900 : Output parameters:
52901 : D - array of the eigenvalues found.
52902 : Array whose index ranges within [0..I2-I1].
52903 : Z - if ZNeeded is equal to:
52904 : * 0, doesn't contain any information;
52905 : * 1, contains the product of a given NxN matrix Z (from the left) and
52906 : Nx(I2-I1) matrix of the eigenvectors found (from the right).
52907 : Array whose indexes range within [0..N-1, 0..I2-I1].
52908 : * 2, contains the matrix of the eigenvalues found.
52909 : Array whose indexes range within [0..N-1, 0..I2-I1].
52910 :
52911 :
52912 : Result:
52913 :
52914 : True, if successful. In that case, D contains the eigenvalues,
52915 : Z contains the eigenvectors (if needed).
52916 : It should be noted that the subroutine changes the size of arrays D and Z.
52917 :
52918 : False, if the bisection method subroutine wasn't able to find the eigenvalues
52919 : in the given interval or if the inverse iteration subroutine wasn't able
52920 : to find all the corresponding eigenvectors. In that case, the eigenvalues
52921 : and eigenvectors are not returned.
52922 :
52923 : -- ALGLIB --
52924 : Copyright 25.12.2005 by Bochkanov Sergey
52925 : *************************************************************************/
52926 0 : ae_bool smatrixtdevdi(/* Real */ ae_vector* d,
52927 : /* Real */ ae_vector* e,
52928 : ae_int_t n,
52929 : ae_int_t zneeded,
52930 : ae_int_t i1,
52931 : ae_int_t i2,
52932 : /* Real */ ae_matrix* z,
52933 : ae_state *_state)
52934 : {
52935 : ae_frame _frame_block;
52936 : ae_int_t errorcode;
52937 : ae_int_t nsplit;
52938 : ae_int_t i;
52939 : ae_int_t j;
52940 : ae_int_t k;
52941 : ae_int_t m;
52942 : ae_int_t cr;
52943 : ae_vector iblock;
52944 : ae_vector isplit;
52945 : ae_vector ifail;
52946 : ae_vector w;
52947 : ae_vector d1;
52948 : ae_vector e1;
52949 : ae_matrix z2;
52950 : ae_matrix z3;
52951 : double v;
52952 : ae_bool result;
52953 :
52954 0 : ae_frame_make(_state, &_frame_block);
52955 0 : memset(&iblock, 0, sizeof(iblock));
52956 0 : memset(&isplit, 0, sizeof(isplit));
52957 0 : memset(&ifail, 0, sizeof(ifail));
52958 0 : memset(&w, 0, sizeof(w));
52959 0 : memset(&d1, 0, sizeof(d1));
52960 0 : memset(&e1, 0, sizeof(e1));
52961 0 : memset(&z2, 0, sizeof(z2));
52962 0 : memset(&z3, 0, sizeof(z3));
52963 0 : ae_vector_init(&iblock, 0, DT_INT, _state, ae_true);
52964 0 : ae_vector_init(&isplit, 0, DT_INT, _state, ae_true);
52965 0 : ae_vector_init(&ifail, 0, DT_INT, _state, ae_true);
52966 0 : ae_vector_init(&w, 0, DT_REAL, _state, ae_true);
52967 0 : ae_vector_init(&d1, 0, DT_REAL, _state, ae_true);
52968 0 : ae_vector_init(&e1, 0, DT_REAL, _state, ae_true);
52969 0 : ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true);
52970 0 : ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true);
52971 :
52972 0 : ae_assert((0<=i1&&i1<=i2)&&i2<n, "SMatrixTDEVDI: incorrect I1/I2!", _state);
52973 :
52974 : /*
52975 : * Copy D,E to D1, E1
52976 : */
52977 0 : ae_vector_set_length(&d1, n+1, _state);
52978 0 : ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n));
52979 0 : if( n>1 )
52980 : {
52981 0 : ae_vector_set_length(&e1, n-1+1, _state);
52982 0 : ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1));
52983 : }
52984 :
52985 : /*
52986 : * No eigen vectors
52987 : */
52988 0 : if( zneeded==0 )
52989 : {
52990 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 1, (double)(0), (double)(0), i1+1, i2+1, (double)(-1), &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state);
52991 0 : if( !result )
52992 : {
52993 0 : ae_frame_leave(_state);
52994 0 : return result;
52995 : }
52996 0 : if( m!=i2-i1+1 )
52997 : {
52998 0 : result = ae_false;
52999 0 : ae_frame_leave(_state);
53000 0 : return result;
53001 : }
53002 0 : ae_vector_set_length(d, m-1+1, _state);
53003 0 : for(i=1; i<=m; i++)
53004 : {
53005 0 : d->ptr.p_double[i-1] = w.ptr.p_double[i];
53006 : }
53007 0 : ae_frame_leave(_state);
53008 0 : return result;
53009 : }
53010 :
53011 : /*
53012 : * Eigen vectors are multiplied by Z
53013 : */
53014 0 : if( zneeded==1 )
53015 : {
53016 :
53017 : /*
53018 : * Find eigen pairs
53019 : */
53020 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, (double)(0), (double)(0), i1+1, i2+1, (double)(-1), &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state);
53021 0 : if( !result )
53022 : {
53023 0 : ae_frame_leave(_state);
53024 0 : return result;
53025 : }
53026 0 : if( m!=i2-i1+1 )
53027 : {
53028 0 : result = ae_false;
53029 0 : ae_frame_leave(_state);
53030 0 : return result;
53031 : }
53032 0 : evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state);
53033 0 : if( cr!=0 )
53034 : {
53035 0 : result = ae_false;
53036 0 : ae_frame_leave(_state);
53037 0 : return result;
53038 : }
53039 :
53040 : /*
53041 : * Sort eigen values and vectors
53042 : */
53043 0 : for(i=1; i<=m; i++)
53044 : {
53045 0 : k = i;
53046 0 : for(j=i; j<=m; j++)
53047 : {
53048 0 : if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) )
53049 : {
53050 0 : k = j;
53051 : }
53052 : }
53053 0 : v = w.ptr.p_double[i];
53054 0 : w.ptr.p_double[i] = w.ptr.p_double[k];
53055 0 : w.ptr.p_double[k] = v;
53056 0 : for(j=1; j<=n; j++)
53057 : {
53058 0 : v = z2.ptr.pp_double[j][i];
53059 0 : z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k];
53060 0 : z2.ptr.pp_double[j][k] = v;
53061 : }
53062 : }
53063 :
53064 : /*
53065 : * Transform Z2 and overwrite Z
53066 : */
53067 0 : ae_matrix_set_length(&z3, m+1, n+1, _state);
53068 0 : for(i=1; i<=m; i++)
53069 : {
53070 0 : ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n));
53071 : }
53072 0 : for(i=1; i<=n; i++)
53073 : {
53074 0 : for(j=1; j<=m; j++)
53075 : {
53076 0 : v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1));
53077 0 : z2.ptr.pp_double[i][j] = v;
53078 : }
53079 : }
53080 0 : ae_matrix_set_length(z, n-1+1, m-1+1, _state);
53081 0 : for(i=1; i<=m; i++)
53082 : {
53083 0 : ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1));
53084 : }
53085 :
53086 : /*
53087 : * Store W
53088 : */
53089 0 : ae_vector_set_length(d, m-1+1, _state);
53090 0 : for(i=1; i<=m; i++)
53091 : {
53092 0 : d->ptr.p_double[i-1] = w.ptr.p_double[i];
53093 : }
53094 0 : ae_frame_leave(_state);
53095 0 : return result;
53096 : }
53097 :
53098 : /*
53099 : * Eigen vectors are stored in Z
53100 : */
53101 0 : if( zneeded==2 )
53102 : {
53103 :
53104 : /*
53105 : * Find eigen pairs
53106 : */
53107 0 : result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, (double)(0), (double)(0), i1+1, i2+1, (double)(-1), &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state);
53108 0 : if( !result )
53109 : {
53110 0 : ae_frame_leave(_state);
53111 0 : return result;
53112 : }
53113 0 : if( m!=i2-i1+1 )
53114 : {
53115 0 : result = ae_false;
53116 0 : ae_frame_leave(_state);
53117 0 : return result;
53118 : }
53119 0 : evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state);
53120 0 : if( cr!=0 )
53121 : {
53122 0 : result = ae_false;
53123 0 : ae_frame_leave(_state);
53124 0 : return result;
53125 : }
53126 :
53127 : /*
53128 : * Sort eigen values and vectors
53129 : */
53130 0 : for(i=1; i<=m; i++)
53131 : {
53132 0 : k = i;
53133 0 : for(j=i; j<=m; j++)
53134 : {
53135 0 : if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) )
53136 : {
53137 0 : k = j;
53138 : }
53139 : }
53140 0 : v = w.ptr.p_double[i];
53141 0 : w.ptr.p_double[i] = w.ptr.p_double[k];
53142 0 : w.ptr.p_double[k] = v;
53143 0 : for(j=1; j<=n; j++)
53144 : {
53145 0 : v = z2.ptr.pp_double[j][i];
53146 0 : z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k];
53147 0 : z2.ptr.pp_double[j][k] = v;
53148 : }
53149 : }
53150 :
53151 : /*
53152 : * Store Z
53153 : */
53154 0 : ae_matrix_set_length(z, n-1+1, m-1+1, _state);
53155 0 : for(i=1; i<=m; i++)
53156 : {
53157 0 : ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1));
53158 : }
53159 :
53160 : /*
53161 : * Store W
53162 : */
53163 0 : ae_vector_set_length(d, m-1+1, _state);
53164 0 : for(i=1; i<=m; i++)
53165 : {
53166 0 : d->ptr.p_double[i-1] = w.ptr.p_double[i];
53167 : }
53168 0 : ae_frame_leave(_state);
53169 0 : return result;
53170 : }
53171 0 : result = ae_false;
53172 0 : ae_frame_leave(_state);
53173 0 : return result;
53174 : }
53175 :
53176 :
53177 : /*************************************************************************
53178 : Finding eigenvalues and eigenvectors of a general (unsymmetric) matrix
53179 :
53180 : ! COMMERCIAL EDITION OF ALGLIB:
53181 : !
53182 : ! Commercial Edition of ALGLIB includes following important improvements
53183 : ! of this function:
53184 : ! * high-performance native backend with same C# interface (C# version)
53185 : ! * hardware vendor (Intel) implementations of linear algebra primitives
53186 : ! (C++ and C# versions, x86/x64 platform)
53187 : !
53188 : ! We recommend you to read 'Working with commercial version' section of
53189 : ! ALGLIB Reference Manual in order to find out how to use performance-
53190 : ! related features provided by commercial edition of ALGLIB.
53191 :
53192 : The algorithm finds eigenvalues and eigenvectors of a general matrix by
53193 : using the QR algorithm with multiple shifts. The algorithm can find
53194 : eigenvalues and both left and right eigenvectors.
53195 :
53196 : The right eigenvector is a vector x such that A*x = w*x, and the left
53197 : eigenvector is a vector y such that y'*A = w*y' (here y' implies a complex
53198 : conjugate transposition of vector y).
53199 :
53200 : Input parameters:
53201 : A - matrix. Array whose indexes range within [0..N-1, 0..N-1].
53202 : N - size of matrix A.
53203 : VNeeded - flag controlling whether eigenvectors are needed or not.
53204 : If VNeeded is equal to:
53205 : * 0, eigenvectors are not returned;
53206 : * 1, right eigenvectors are returned;
53207 : * 2, left eigenvectors are returned;
53208 : * 3, both left and right eigenvectors are returned.
53209 :
53210 : Output parameters:
53211 : WR - real parts of eigenvalues.
53212 : Array whose index ranges within [0..N-1].
53213 : WR - imaginary parts of eigenvalues.
53214 : Array whose index ranges within [0..N-1].
53215 : VL, VR - arrays of left and right eigenvectors (if they are needed).
53216 : If WI[i]=0, the respective eigenvalue is a real number,
53217 : and it corresponds to the column number I of matrices VL/VR.
53218 : If WI[i]>0, we have a pair of complex conjugate numbers with
53219 : positive and negative imaginary parts:
53220 : the first eigenvalue WR[i] + sqrt(-1)*WI[i];
53221 : the second eigenvalue WR[i+1] + sqrt(-1)*WI[i+1];
53222 : WI[i]>0
53223 : WI[i+1] = -WI[i] < 0
53224 : In that case, the eigenvector corresponding to the first
53225 : eigenvalue is located in i and i+1 columns of matrices
53226 : VL/VR (the column number i contains the real part, and the
53227 : column number i+1 contains the imaginary part), and the vector
53228 : corresponding to the second eigenvalue is a complex conjugate to
53229 : the first vector.
53230 : Arrays whose indexes range within [0..N-1, 0..N-1].
53231 :
53232 : Result:
53233 : True, if the algorithm has converged.
53234 : False, if the algorithm has not converged.
53235 :
53236 : Note 1:
53237 : Some users may ask the following question: what if WI[N-1]>0?
53238 : WI[N] must contain an eigenvalue which is complex conjugate to the
53239 : N-th eigenvalue, but the array has only size N?
53240 : The answer is as follows: such a situation cannot occur because the
53241 : algorithm finds a pairs of eigenvalues, therefore, if WI[i]>0, I is
53242 : strictly less than N-1.
53243 :
53244 : Note 2:
53245 : The algorithm performance depends on the value of the internal parameter
53246 : NS of the InternalSchurDecomposition subroutine which defines the number
53247 : of shifts in the QR algorithm (similarly to the block width in block-matrix
53248 : algorithms of linear algebra). If you require maximum performance
53249 : on your machine, it is recommended to adjust this parameter manually.
53250 :
53251 :
53252 : See also the InternalTREVC subroutine.
53253 :
53254 : The algorithm is based on the LAPACK 3.0 library.
53255 : *************************************************************************/
53256 0 : ae_bool rmatrixevd(/* Real */ ae_matrix* a,
53257 : ae_int_t n,
53258 : ae_int_t vneeded,
53259 : /* Real */ ae_vector* wr,
53260 : /* Real */ ae_vector* wi,
53261 : /* Real */ ae_matrix* vl,
53262 : /* Real */ ae_matrix* vr,
53263 : ae_state *_state)
53264 : {
53265 : ae_frame _frame_block;
53266 : ae_matrix _a;
53267 : ae_matrix a1;
53268 : ae_matrix vl1;
53269 : ae_matrix vr1;
53270 : ae_matrix s1;
53271 : ae_matrix s;
53272 : ae_matrix dummy;
53273 : ae_vector wr1;
53274 : ae_vector wi1;
53275 : ae_vector tau;
53276 : ae_int_t i;
53277 : ae_int_t info;
53278 : ae_vector sel1;
53279 : ae_int_t m1;
53280 : ae_bool result;
53281 :
53282 0 : ae_frame_make(_state, &_frame_block);
53283 0 : memset(&_a, 0, sizeof(_a));
53284 0 : memset(&a1, 0, sizeof(a1));
53285 0 : memset(&vl1, 0, sizeof(vl1));
53286 0 : memset(&vr1, 0, sizeof(vr1));
53287 0 : memset(&s1, 0, sizeof(s1));
53288 0 : memset(&s, 0, sizeof(s));
53289 0 : memset(&dummy, 0, sizeof(dummy));
53290 0 : memset(&wr1, 0, sizeof(wr1));
53291 0 : memset(&wi1, 0, sizeof(wi1));
53292 0 : memset(&tau, 0, sizeof(tau));
53293 0 : memset(&sel1, 0, sizeof(sel1));
53294 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
53295 0 : a = &_a;
53296 0 : ae_vector_clear(wr);
53297 0 : ae_vector_clear(wi);
53298 0 : ae_matrix_clear(vl);
53299 0 : ae_matrix_clear(vr);
53300 0 : ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true);
53301 0 : ae_matrix_init(&vl1, 0, 0, DT_REAL, _state, ae_true);
53302 0 : ae_matrix_init(&vr1, 0, 0, DT_REAL, _state, ae_true);
53303 0 : ae_matrix_init(&s1, 0, 0, DT_REAL, _state, ae_true);
53304 0 : ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true);
53305 0 : ae_matrix_init(&dummy, 0, 0, DT_REAL, _state, ae_true);
53306 0 : ae_vector_init(&wr1, 0, DT_REAL, _state, ae_true);
53307 0 : ae_vector_init(&wi1, 0, DT_REAL, _state, ae_true);
53308 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
53309 0 : ae_vector_init(&sel1, 0, DT_BOOL, _state, ae_true);
53310 :
53311 0 : ae_assert(vneeded>=0&&vneeded<=3, "RMatrixEVD: incorrect VNeeded!", _state);
53312 0 : if( vneeded==0 )
53313 : {
53314 :
53315 : /*
53316 : * Eigen values only
53317 : */
53318 0 : rmatrixhessenberg(a, n, &tau, _state);
53319 0 : rmatrixinternalschurdecomposition(a, n, 0, 0, wr, wi, &dummy, &info, _state);
53320 0 : result = info==0;
53321 0 : ae_frame_leave(_state);
53322 0 : return result;
53323 : }
53324 :
53325 : /*
53326 : * Eigen values and vectors
53327 : */
53328 0 : rmatrixhessenberg(a, n, &tau, _state);
53329 0 : rmatrixhessenbergunpackq(a, n, &tau, &s, _state);
53330 0 : rmatrixinternalschurdecomposition(a, n, 1, 1, wr, wi, &s, &info, _state);
53331 0 : result = info==0;
53332 0 : if( !result )
53333 : {
53334 0 : ae_frame_leave(_state);
53335 0 : return result;
53336 : }
53337 0 : if( vneeded==1||vneeded==3 )
53338 : {
53339 0 : ae_matrix_set_length(vr, n, n, _state);
53340 0 : for(i=0; i<=n-1; i++)
53341 : {
53342 0 : ae_v_move(&vr->ptr.pp_double[i][0], 1, &s.ptr.pp_double[i][0], 1, ae_v_len(0,n-1));
53343 : }
53344 : }
53345 0 : if( vneeded==2||vneeded==3 )
53346 : {
53347 0 : ae_matrix_set_length(vl, n, n, _state);
53348 0 : for(i=0; i<=n-1; i++)
53349 : {
53350 0 : ae_v_move(&vl->ptr.pp_double[i][0], 1, &s.ptr.pp_double[i][0], 1, ae_v_len(0,n-1));
53351 : }
53352 : }
53353 0 : evd_rmatrixinternaltrevc(a, n, vneeded, 1, &sel1, vl, vr, &m1, &info, _state);
53354 0 : result = info==0;
53355 0 : ae_frame_leave(_state);
53356 0 : return result;
53357 : }
53358 :
53359 :
53360 : /*************************************************************************
53361 : Clears request fileds (to be sure that we don't forgot to clear something)
53362 : *************************************************************************/
53363 0 : static void evd_clearrfields(eigsubspacestate* state, ae_state *_state)
53364 : {
53365 :
53366 :
53367 0 : state->requesttype = -1;
53368 0 : state->requestsize = -1;
53369 0 : }
53370 :
53371 :
53372 0 : static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d,
53373 : /* Real */ ae_vector* e,
53374 : ae_int_t n,
53375 : ae_int_t zneeded,
53376 : /* Real */ ae_matrix* z,
53377 : ae_state *_state)
53378 : {
53379 : ae_frame _frame_block;
53380 : ae_vector _e;
53381 : ae_int_t maxit;
53382 : ae_int_t i;
53383 : ae_int_t ii;
53384 : ae_int_t iscale;
53385 : ae_int_t j;
53386 : ae_int_t jtot;
53387 : ae_int_t k;
53388 : ae_int_t t;
53389 : ae_int_t l;
53390 : ae_int_t l1;
53391 : ae_int_t lend;
53392 : ae_int_t lendm1;
53393 : ae_int_t lendp1;
53394 : ae_int_t lendsv;
53395 : ae_int_t lm1;
53396 : ae_int_t lsv;
53397 : ae_int_t m;
53398 : ae_int_t mm1;
53399 : ae_int_t nm1;
53400 : ae_int_t nmaxit;
53401 : ae_int_t tmpint;
53402 : double anorm;
53403 : double b;
53404 : double c;
53405 : double eps;
53406 : double eps2;
53407 : double f;
53408 : double g;
53409 : double p;
53410 : double r;
53411 : double rt1;
53412 : double rt2;
53413 : double s;
53414 : double safmax;
53415 : double safmin;
53416 : double ssfmax;
53417 : double ssfmin;
53418 : double tst;
53419 : double tmp;
53420 : ae_vector work1;
53421 : ae_vector work2;
53422 : ae_vector workc;
53423 : ae_vector works;
53424 : ae_vector wtemp;
53425 : ae_bool gotoflag;
53426 : ae_int_t zrows;
53427 : ae_bool wastranspose;
53428 : ae_bool result;
53429 :
53430 0 : ae_frame_make(_state, &_frame_block);
53431 0 : memset(&_e, 0, sizeof(_e));
53432 0 : memset(&work1, 0, sizeof(work1));
53433 0 : memset(&work2, 0, sizeof(work2));
53434 0 : memset(&workc, 0, sizeof(workc));
53435 0 : memset(&works, 0, sizeof(works));
53436 0 : memset(&wtemp, 0, sizeof(wtemp));
53437 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
53438 0 : e = &_e;
53439 0 : ae_vector_init(&work1, 0, DT_REAL, _state, ae_true);
53440 0 : ae_vector_init(&work2, 0, DT_REAL, _state, ae_true);
53441 0 : ae_vector_init(&workc, 0, DT_REAL, _state, ae_true);
53442 0 : ae_vector_init(&works, 0, DT_REAL, _state, ae_true);
53443 0 : ae_vector_init(&wtemp, 0, DT_REAL, _state, ae_true);
53444 :
53445 0 : ae_assert(zneeded>=0&&zneeded<=3, "TridiagonalEVD: Incorrent ZNeeded", _state);
53446 :
53447 : /*
53448 : * Quick return if possible
53449 : */
53450 0 : if( zneeded<0||zneeded>3 )
53451 : {
53452 0 : result = ae_false;
53453 0 : ae_frame_leave(_state);
53454 0 : return result;
53455 : }
53456 0 : result = ae_true;
53457 0 : if( n==0 )
53458 : {
53459 0 : ae_frame_leave(_state);
53460 0 : return result;
53461 : }
53462 0 : if( n==1 )
53463 : {
53464 0 : if( zneeded==2||zneeded==3 )
53465 : {
53466 0 : ae_matrix_set_length(z, 1+1, 1+1, _state);
53467 0 : z->ptr.pp_double[1][1] = (double)(1);
53468 : }
53469 0 : ae_frame_leave(_state);
53470 0 : return result;
53471 : }
53472 0 : maxit = 30;
53473 :
53474 : /*
53475 : * Initialize arrays
53476 : */
53477 0 : ae_vector_set_length(&wtemp, n+1, _state);
53478 0 : ae_vector_set_length(&work1, n-1+1, _state);
53479 0 : ae_vector_set_length(&work2, n-1+1, _state);
53480 0 : ae_vector_set_length(&workc, n+1, _state);
53481 0 : ae_vector_set_length(&works, n+1, _state);
53482 :
53483 : /*
53484 : * Determine the unit roundoff and over/underflow thresholds.
53485 : */
53486 0 : eps = ae_machineepsilon;
53487 0 : eps2 = ae_sqr(eps, _state);
53488 0 : safmin = ae_minrealnumber;
53489 0 : safmax = ae_maxrealnumber;
53490 0 : ssfmax = ae_sqrt(safmax, _state)/3;
53491 0 : ssfmin = ae_sqrt(safmin, _state)/eps2;
53492 :
53493 : /*
53494 : * Prepare Z
53495 : *
53496 : * Here we are using transposition to get rid of column operations
53497 : *
53498 : */
53499 0 : wastranspose = ae_false;
53500 0 : zrows = 0;
53501 0 : if( zneeded==1 )
53502 : {
53503 0 : zrows = n;
53504 : }
53505 0 : if( zneeded==2 )
53506 : {
53507 0 : zrows = n;
53508 : }
53509 0 : if( zneeded==3 )
53510 : {
53511 0 : zrows = 1;
53512 : }
53513 0 : if( zneeded==1 )
53514 : {
53515 0 : wastranspose = ae_true;
53516 0 : inplacetranspose(z, 1, n, 1, n, &wtemp, _state);
53517 : }
53518 0 : if( zneeded==2 )
53519 : {
53520 0 : wastranspose = ae_true;
53521 0 : ae_matrix_set_length(z, n+1, n+1, _state);
53522 0 : for(i=1; i<=n; i++)
53523 : {
53524 0 : for(j=1; j<=n; j++)
53525 : {
53526 0 : if( i==j )
53527 : {
53528 0 : z->ptr.pp_double[i][j] = (double)(1);
53529 : }
53530 : else
53531 : {
53532 0 : z->ptr.pp_double[i][j] = (double)(0);
53533 : }
53534 : }
53535 : }
53536 : }
53537 0 : if( zneeded==3 )
53538 : {
53539 0 : wastranspose = ae_false;
53540 0 : ae_matrix_set_length(z, 1+1, n+1, _state);
53541 0 : for(j=1; j<=n; j++)
53542 : {
53543 0 : if( j==1 )
53544 : {
53545 0 : z->ptr.pp_double[1][j] = (double)(1);
53546 : }
53547 : else
53548 : {
53549 0 : z->ptr.pp_double[1][j] = (double)(0);
53550 : }
53551 : }
53552 : }
53553 0 : nmaxit = n*maxit;
53554 0 : jtot = 0;
53555 :
53556 : /*
53557 : * Determine where the matrix splits and choose QL or QR iteration
53558 : * for each block, according to whether top or bottom diagonal
53559 : * element is smaller.
53560 : */
53561 0 : l1 = 1;
53562 0 : nm1 = n-1;
53563 : for(;;)
53564 : {
53565 0 : if( l1>n )
53566 : {
53567 0 : break;
53568 : }
53569 0 : if( l1>1 )
53570 : {
53571 0 : e->ptr.p_double[l1-1] = (double)(0);
53572 : }
53573 0 : gotoflag = ae_false;
53574 0 : m = l1;
53575 0 : if( l1<=nm1 )
53576 : {
53577 0 : for(m=l1; m<=nm1; m++)
53578 : {
53579 0 : tst = ae_fabs(e->ptr.p_double[m], _state);
53580 0 : if( ae_fp_eq(tst,(double)(0)) )
53581 : {
53582 0 : gotoflag = ae_true;
53583 0 : break;
53584 : }
53585 0 : if( ae_fp_less_eq(tst,ae_sqrt(ae_fabs(d->ptr.p_double[m], _state), _state)*ae_sqrt(ae_fabs(d->ptr.p_double[m+1], _state), _state)*eps) )
53586 : {
53587 0 : e->ptr.p_double[m] = (double)(0);
53588 0 : gotoflag = ae_true;
53589 0 : break;
53590 : }
53591 : }
53592 : }
53593 0 : if( !gotoflag )
53594 : {
53595 0 : m = n;
53596 : }
53597 :
53598 : /*
53599 : * label 30:
53600 : */
53601 0 : l = l1;
53602 0 : lsv = l;
53603 0 : lend = m;
53604 0 : lendsv = lend;
53605 0 : l1 = m+1;
53606 0 : if( lend==l )
53607 : {
53608 0 : continue;
53609 : }
53610 :
53611 : /*
53612 : * Scale submatrix in rows and columns L to LEND
53613 : */
53614 0 : if( l==lend )
53615 : {
53616 0 : anorm = ae_fabs(d->ptr.p_double[l], _state);
53617 : }
53618 : else
53619 : {
53620 0 : anorm = ae_maxreal(ae_fabs(d->ptr.p_double[l], _state)+ae_fabs(e->ptr.p_double[l], _state), ae_fabs(e->ptr.p_double[lend-1], _state)+ae_fabs(d->ptr.p_double[lend], _state), _state);
53621 0 : for(i=l+1; i<=lend-1; i++)
53622 : {
53623 0 : anorm = ae_maxreal(anorm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state), _state);
53624 : }
53625 : }
53626 0 : iscale = 0;
53627 0 : if( ae_fp_eq(anorm,(double)(0)) )
53628 : {
53629 0 : continue;
53630 : }
53631 0 : if( ae_fp_greater(anorm,ssfmax) )
53632 : {
53633 0 : iscale = 1;
53634 0 : tmp = ssfmax/anorm;
53635 0 : tmpint = lend-1;
53636 0 : ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp);
53637 0 : ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp);
53638 : }
53639 0 : if( ae_fp_less(anorm,ssfmin) )
53640 : {
53641 0 : iscale = 2;
53642 0 : tmp = ssfmin/anorm;
53643 0 : tmpint = lend-1;
53644 0 : ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp);
53645 0 : ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp);
53646 : }
53647 :
53648 : /*
53649 : * Choose between QL and QR iteration
53650 : */
53651 0 : if( ae_fp_less(ae_fabs(d->ptr.p_double[lend], _state),ae_fabs(d->ptr.p_double[l], _state)) )
53652 : {
53653 0 : lend = lsv;
53654 0 : l = lendsv;
53655 : }
53656 0 : if( lend>l )
53657 : {
53658 :
53659 : /*
53660 : * QL Iteration
53661 : *
53662 : * Look for small subdiagonal element.
53663 : */
53664 : for(;;)
53665 : {
53666 0 : gotoflag = ae_false;
53667 0 : if( l!=lend )
53668 : {
53669 0 : lendm1 = lend-1;
53670 0 : for(m=l; m<=lendm1; m++)
53671 : {
53672 0 : tst = ae_sqr(ae_fabs(e->ptr.p_double[m], _state), _state);
53673 0 : if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m+1], _state)+safmin) )
53674 : {
53675 0 : gotoflag = ae_true;
53676 0 : break;
53677 : }
53678 : }
53679 : }
53680 0 : if( !gotoflag )
53681 : {
53682 0 : m = lend;
53683 : }
53684 0 : if( m<lend )
53685 : {
53686 0 : e->ptr.p_double[m] = (double)(0);
53687 : }
53688 0 : p = d->ptr.p_double[l];
53689 0 : if( m!=l )
53690 : {
53691 :
53692 : /*
53693 : * If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
53694 : * to compute its eigensystem.
53695 : */
53696 0 : if( m==l+1 )
53697 : {
53698 0 : if( zneeded>0 )
53699 : {
53700 0 : evd_tdevdev2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, &c, &s, _state);
53701 0 : work1.ptr.p_double[l] = c;
53702 0 : work2.ptr.p_double[l] = s;
53703 0 : workc.ptr.p_double[1] = work1.ptr.p_double[l];
53704 0 : works.ptr.p_double[1] = work2.ptr.p_double[l];
53705 0 : if( !wastranspose )
53706 : {
53707 0 : applyrotationsfromtheright(ae_false, 1, zrows, l, l+1, &workc, &works, z, &wtemp, _state);
53708 : }
53709 : else
53710 : {
53711 0 : applyrotationsfromtheleft(ae_false, l, l+1, 1, zrows, &workc, &works, z, &wtemp, _state);
53712 : }
53713 : }
53714 : else
53715 : {
53716 0 : evd_tdevde2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, _state);
53717 : }
53718 0 : d->ptr.p_double[l] = rt1;
53719 0 : d->ptr.p_double[l+1] = rt2;
53720 0 : e->ptr.p_double[l] = (double)(0);
53721 0 : l = l+2;
53722 0 : if( l<=lend )
53723 : {
53724 0 : continue;
53725 : }
53726 :
53727 : /*
53728 : * GOTO 140
53729 : */
53730 0 : break;
53731 : }
53732 0 : if( jtot==nmaxit )
53733 : {
53734 :
53735 : /*
53736 : * GOTO 140
53737 : */
53738 0 : break;
53739 : }
53740 0 : jtot = jtot+1;
53741 :
53742 : /*
53743 : * Form shift.
53744 : */
53745 0 : g = (d->ptr.p_double[l+1]-p)/(2*e->ptr.p_double[l]);
53746 0 : r = evd_tdevdpythag(g, (double)(1), _state);
53747 0 : g = d->ptr.p_double[m]-p+e->ptr.p_double[l]/(g+evd_tdevdextsign(r, g, _state));
53748 0 : s = (double)(1);
53749 0 : c = (double)(1);
53750 0 : p = (double)(0);
53751 :
53752 : /*
53753 : * Inner loop
53754 : */
53755 0 : mm1 = m-1;
53756 0 : for(i=mm1; i>=l; i--)
53757 : {
53758 0 : f = s*e->ptr.p_double[i];
53759 0 : b = c*e->ptr.p_double[i];
53760 0 : generaterotation(g, f, &c, &s, &r, _state);
53761 0 : if( i!=m-1 )
53762 : {
53763 0 : e->ptr.p_double[i+1] = r;
53764 : }
53765 0 : g = d->ptr.p_double[i+1]-p;
53766 0 : r = (d->ptr.p_double[i]-g)*s+2*c*b;
53767 0 : p = s*r;
53768 0 : d->ptr.p_double[i+1] = g+p;
53769 0 : g = c*r-b;
53770 :
53771 : /*
53772 : * If eigenvectors are desired, then save rotations.
53773 : */
53774 0 : if( zneeded>0 )
53775 : {
53776 0 : work1.ptr.p_double[i] = c;
53777 0 : work2.ptr.p_double[i] = -s;
53778 : }
53779 : }
53780 :
53781 : /*
53782 : * If eigenvectors are desired, then apply saved rotations.
53783 : */
53784 0 : if( zneeded>0 )
53785 : {
53786 0 : for(i=l; i<=m-1; i++)
53787 : {
53788 0 : workc.ptr.p_double[i-l+1] = work1.ptr.p_double[i];
53789 0 : works.ptr.p_double[i-l+1] = work2.ptr.p_double[i];
53790 : }
53791 0 : if( !wastranspose )
53792 : {
53793 0 : applyrotationsfromtheright(ae_false, 1, zrows, l, m, &workc, &works, z, &wtemp, _state);
53794 : }
53795 : else
53796 : {
53797 0 : applyrotationsfromtheleft(ae_false, l, m, 1, zrows, &workc, &works, z, &wtemp, _state);
53798 : }
53799 : }
53800 0 : d->ptr.p_double[l] = d->ptr.p_double[l]-p;
53801 0 : e->ptr.p_double[l] = g;
53802 0 : continue;
53803 : }
53804 :
53805 : /*
53806 : * Eigenvalue found.
53807 : */
53808 0 : d->ptr.p_double[l] = p;
53809 0 : l = l+1;
53810 0 : if( l<=lend )
53811 : {
53812 0 : continue;
53813 : }
53814 0 : break;
53815 : }
53816 : }
53817 : else
53818 : {
53819 :
53820 : /*
53821 : * QR Iteration
53822 : *
53823 : * Look for small superdiagonal element.
53824 : */
53825 : for(;;)
53826 : {
53827 0 : gotoflag = ae_false;
53828 0 : if( l!=lend )
53829 : {
53830 0 : lendp1 = lend+1;
53831 0 : for(m=l; m>=lendp1; m--)
53832 : {
53833 0 : tst = ae_sqr(ae_fabs(e->ptr.p_double[m-1], _state), _state);
53834 0 : if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m-1], _state)+safmin) )
53835 : {
53836 0 : gotoflag = ae_true;
53837 0 : break;
53838 : }
53839 : }
53840 : }
53841 0 : if( !gotoflag )
53842 : {
53843 0 : m = lend;
53844 : }
53845 0 : if( m>lend )
53846 : {
53847 0 : e->ptr.p_double[m-1] = (double)(0);
53848 : }
53849 0 : p = d->ptr.p_double[l];
53850 0 : if( m!=l )
53851 : {
53852 :
53853 : /*
53854 : * If remaining matrix is 2-by-2, use DLAE2 or SLAEV2
53855 : * to compute its eigensystem.
53856 : */
53857 0 : if( m==l-1 )
53858 : {
53859 0 : if( zneeded>0 )
53860 : {
53861 0 : evd_tdevdev2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, &c, &s, _state);
53862 0 : work1.ptr.p_double[m] = c;
53863 0 : work2.ptr.p_double[m] = s;
53864 0 : workc.ptr.p_double[1] = c;
53865 0 : works.ptr.p_double[1] = s;
53866 0 : if( !wastranspose )
53867 : {
53868 0 : applyrotationsfromtheright(ae_true, 1, zrows, l-1, l, &workc, &works, z, &wtemp, _state);
53869 : }
53870 : else
53871 : {
53872 0 : applyrotationsfromtheleft(ae_true, l-1, l, 1, zrows, &workc, &works, z, &wtemp, _state);
53873 : }
53874 : }
53875 : else
53876 : {
53877 0 : evd_tdevde2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, _state);
53878 : }
53879 0 : d->ptr.p_double[l-1] = rt1;
53880 0 : d->ptr.p_double[l] = rt2;
53881 0 : e->ptr.p_double[l-1] = (double)(0);
53882 0 : l = l-2;
53883 0 : if( l>=lend )
53884 : {
53885 0 : continue;
53886 : }
53887 0 : break;
53888 : }
53889 0 : if( jtot==nmaxit )
53890 : {
53891 0 : break;
53892 : }
53893 0 : jtot = jtot+1;
53894 :
53895 : /*
53896 : * Form shift.
53897 : */
53898 0 : g = (d->ptr.p_double[l-1]-p)/(2*e->ptr.p_double[l-1]);
53899 0 : r = evd_tdevdpythag(g, (double)(1), _state);
53900 0 : g = d->ptr.p_double[m]-p+e->ptr.p_double[l-1]/(g+evd_tdevdextsign(r, g, _state));
53901 0 : s = (double)(1);
53902 0 : c = (double)(1);
53903 0 : p = (double)(0);
53904 :
53905 : /*
53906 : * Inner loop
53907 : */
53908 0 : lm1 = l-1;
53909 0 : for(i=m; i<=lm1; i++)
53910 : {
53911 0 : f = s*e->ptr.p_double[i];
53912 0 : b = c*e->ptr.p_double[i];
53913 0 : generaterotation(g, f, &c, &s, &r, _state);
53914 0 : if( i!=m )
53915 : {
53916 0 : e->ptr.p_double[i-1] = r;
53917 : }
53918 0 : g = d->ptr.p_double[i]-p;
53919 0 : r = (d->ptr.p_double[i+1]-g)*s+2*c*b;
53920 0 : p = s*r;
53921 0 : d->ptr.p_double[i] = g+p;
53922 0 : g = c*r-b;
53923 :
53924 : /*
53925 : * If eigenvectors are desired, then save rotations.
53926 : */
53927 0 : if( zneeded>0 )
53928 : {
53929 0 : work1.ptr.p_double[i] = c;
53930 0 : work2.ptr.p_double[i] = s;
53931 : }
53932 : }
53933 :
53934 : /*
53935 : * If eigenvectors are desired, then apply saved rotations.
53936 : */
53937 0 : if( zneeded>0 )
53938 : {
53939 0 : for(i=m; i<=l-1; i++)
53940 : {
53941 0 : workc.ptr.p_double[i-m+1] = work1.ptr.p_double[i];
53942 0 : works.ptr.p_double[i-m+1] = work2.ptr.p_double[i];
53943 : }
53944 0 : if( !wastranspose )
53945 : {
53946 0 : applyrotationsfromtheright(ae_true, 1, zrows, m, l, &workc, &works, z, &wtemp, _state);
53947 : }
53948 : else
53949 : {
53950 0 : applyrotationsfromtheleft(ae_true, m, l, 1, zrows, &workc, &works, z, &wtemp, _state);
53951 : }
53952 : }
53953 0 : d->ptr.p_double[l] = d->ptr.p_double[l]-p;
53954 0 : e->ptr.p_double[lm1] = g;
53955 0 : continue;
53956 : }
53957 :
53958 : /*
53959 : * Eigenvalue found.
53960 : */
53961 0 : d->ptr.p_double[l] = p;
53962 0 : l = l-1;
53963 0 : if( l>=lend )
53964 : {
53965 0 : continue;
53966 : }
53967 0 : break;
53968 : }
53969 : }
53970 :
53971 : /*
53972 : * Undo scaling if necessary
53973 : */
53974 0 : if( iscale==1 )
53975 : {
53976 0 : tmp = anorm/ssfmax;
53977 0 : tmpint = lendsv-1;
53978 0 : ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp);
53979 0 : ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp);
53980 : }
53981 0 : if( iscale==2 )
53982 : {
53983 0 : tmp = anorm/ssfmin;
53984 0 : tmpint = lendsv-1;
53985 0 : ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp);
53986 0 : ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp);
53987 : }
53988 :
53989 : /*
53990 : * Check for no convergence to an eigenvalue after a total
53991 : * of N*MAXIT iterations.
53992 : */
53993 0 : if( jtot>=nmaxit )
53994 : {
53995 0 : result = ae_false;
53996 0 : if( wastranspose )
53997 : {
53998 0 : inplacetranspose(z, 1, n, 1, n, &wtemp, _state);
53999 : }
54000 0 : ae_frame_leave(_state);
54001 0 : return result;
54002 : }
54003 : }
54004 :
54005 : /*
54006 : * Order eigenvalues and eigenvectors.
54007 : */
54008 0 : if( zneeded==0 )
54009 : {
54010 :
54011 : /*
54012 : * Sort
54013 : */
54014 0 : if( n==1 )
54015 : {
54016 0 : ae_frame_leave(_state);
54017 0 : return result;
54018 : }
54019 0 : if( n==2 )
54020 : {
54021 0 : if( ae_fp_greater(d->ptr.p_double[1],d->ptr.p_double[2]) )
54022 : {
54023 0 : tmp = d->ptr.p_double[1];
54024 0 : d->ptr.p_double[1] = d->ptr.p_double[2];
54025 0 : d->ptr.p_double[2] = tmp;
54026 : }
54027 0 : ae_frame_leave(_state);
54028 0 : return result;
54029 : }
54030 0 : i = 2;
54031 0 : do
54032 : {
54033 0 : t = i;
54034 0 : while(t!=1)
54035 : {
54036 0 : k = t/2;
54037 0 : if( ae_fp_greater_eq(d->ptr.p_double[k],d->ptr.p_double[t]) )
54038 : {
54039 0 : t = 1;
54040 : }
54041 : else
54042 : {
54043 0 : tmp = d->ptr.p_double[k];
54044 0 : d->ptr.p_double[k] = d->ptr.p_double[t];
54045 0 : d->ptr.p_double[t] = tmp;
54046 0 : t = k;
54047 : }
54048 : }
54049 0 : i = i+1;
54050 : }
54051 0 : while(i<=n);
54052 0 : i = n-1;
54053 0 : do
54054 : {
54055 0 : tmp = d->ptr.p_double[i+1];
54056 0 : d->ptr.p_double[i+1] = d->ptr.p_double[1];
54057 0 : d->ptr.p_double[1] = tmp;
54058 0 : t = 1;
54059 0 : while(t!=0)
54060 : {
54061 0 : k = 2*t;
54062 0 : if( k>i )
54063 : {
54064 0 : t = 0;
54065 : }
54066 : else
54067 : {
54068 0 : if( k<i )
54069 : {
54070 0 : if( ae_fp_greater(d->ptr.p_double[k+1],d->ptr.p_double[k]) )
54071 : {
54072 0 : k = k+1;
54073 : }
54074 : }
54075 0 : if( ae_fp_greater_eq(d->ptr.p_double[t],d->ptr.p_double[k]) )
54076 : {
54077 0 : t = 0;
54078 : }
54079 : else
54080 : {
54081 0 : tmp = d->ptr.p_double[k];
54082 0 : d->ptr.p_double[k] = d->ptr.p_double[t];
54083 0 : d->ptr.p_double[t] = tmp;
54084 0 : t = k;
54085 : }
54086 : }
54087 : }
54088 0 : i = i-1;
54089 : }
54090 0 : while(i>=1);
54091 : }
54092 : else
54093 : {
54094 :
54095 : /*
54096 : * Use Selection Sort to minimize swaps of eigenvectors
54097 : */
54098 0 : for(ii=2; ii<=n; ii++)
54099 : {
54100 0 : i = ii-1;
54101 0 : k = i;
54102 0 : p = d->ptr.p_double[i];
54103 0 : for(j=ii; j<=n; j++)
54104 : {
54105 0 : if( ae_fp_less(d->ptr.p_double[j],p) )
54106 : {
54107 0 : k = j;
54108 0 : p = d->ptr.p_double[j];
54109 : }
54110 : }
54111 0 : if( k!=i )
54112 : {
54113 0 : d->ptr.p_double[k] = d->ptr.p_double[i];
54114 0 : d->ptr.p_double[i] = p;
54115 0 : if( wastranspose )
54116 : {
54117 0 : ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[i][1], 1, ae_v_len(1,n));
54118 0 : ae_v_move(&z->ptr.pp_double[i][1], 1, &z->ptr.pp_double[k][1], 1, ae_v_len(1,n));
54119 0 : ae_v_move(&z->ptr.pp_double[k][1], 1, &wtemp.ptr.p_double[1], 1, ae_v_len(1,n));
54120 : }
54121 : else
54122 : {
54123 0 : ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[1][i], z->stride, ae_v_len(1,zrows));
54124 0 : ae_v_move(&z->ptr.pp_double[1][i], z->stride, &z->ptr.pp_double[1][k], z->stride, ae_v_len(1,zrows));
54125 0 : ae_v_move(&z->ptr.pp_double[1][k], z->stride, &wtemp.ptr.p_double[1], 1, ae_v_len(1,zrows));
54126 : }
54127 : }
54128 : }
54129 0 : if( wastranspose )
54130 : {
54131 0 : inplacetranspose(z, 1, n, 1, n, &wtemp, _state);
54132 : }
54133 : }
54134 0 : ae_frame_leave(_state);
54135 0 : return result;
54136 : }
54137 :
54138 :
54139 : /*************************************************************************
54140 : DLAE2 computes the eigenvalues of a 2-by-2 symmetric matrix
54141 : [ A B ]
54142 : [ B C ].
54143 : On return, RT1 is the eigenvalue of larger absolute value, and RT2
54144 : is the eigenvalue of smaller absolute value.
54145 :
54146 : -- LAPACK auxiliary routine (version 3.0) --
54147 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
54148 : Courant Institute, Argonne National Lab, and Rice University
54149 : October 31, 1992
54150 : *************************************************************************/
54151 0 : static void evd_tdevde2(double a,
54152 : double b,
54153 : double c,
54154 : double* rt1,
54155 : double* rt2,
54156 : ae_state *_state)
54157 : {
54158 : double ab;
54159 : double acmn;
54160 : double acmx;
54161 : double adf;
54162 : double df;
54163 : double rt;
54164 : double sm;
54165 : double tb;
54166 :
54167 0 : *rt1 = 0;
54168 0 : *rt2 = 0;
54169 :
54170 0 : sm = a+c;
54171 0 : df = a-c;
54172 0 : adf = ae_fabs(df, _state);
54173 0 : tb = b+b;
54174 0 : ab = ae_fabs(tb, _state);
54175 0 : if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) )
54176 : {
54177 0 : acmx = a;
54178 0 : acmn = c;
54179 : }
54180 : else
54181 : {
54182 0 : acmx = c;
54183 0 : acmn = a;
54184 : }
54185 0 : if( ae_fp_greater(adf,ab) )
54186 : {
54187 0 : rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state);
54188 : }
54189 : else
54190 : {
54191 0 : if( ae_fp_less(adf,ab) )
54192 : {
54193 0 : rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state);
54194 : }
54195 : else
54196 : {
54197 :
54198 : /*
54199 : * Includes case AB=ADF=0
54200 : */
54201 0 : rt = ab*ae_sqrt((double)(2), _state);
54202 : }
54203 : }
54204 0 : if( ae_fp_less(sm,(double)(0)) )
54205 : {
54206 0 : *rt1 = 0.5*(sm-rt);
54207 :
54208 : /*
54209 : * Order of execution important.
54210 : * To get fully accurate smaller eigenvalue,
54211 : * next line needs to be executed in higher precision.
54212 : */
54213 0 : *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b;
54214 : }
54215 : else
54216 : {
54217 0 : if( ae_fp_greater(sm,(double)(0)) )
54218 : {
54219 0 : *rt1 = 0.5*(sm+rt);
54220 :
54221 : /*
54222 : * Order of execution important.
54223 : * To get fully accurate smaller eigenvalue,
54224 : * next line needs to be executed in higher precision.
54225 : */
54226 0 : *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b;
54227 : }
54228 : else
54229 : {
54230 :
54231 : /*
54232 : * Includes case RT1 = RT2 = 0
54233 : */
54234 0 : *rt1 = 0.5*rt;
54235 0 : *rt2 = -0.5*rt;
54236 : }
54237 : }
54238 0 : }
54239 :
54240 :
54241 : /*************************************************************************
54242 : DLAEV2 computes the eigendecomposition of a 2-by-2 symmetric matrix
54243 :
54244 : [ A B ]
54245 : [ B C ].
54246 :
54247 : On return, RT1 is the eigenvalue of larger absolute value, RT2 is the
54248 : eigenvalue of smaller absolute value, and (CS1,SN1) is the unit right
54249 : eigenvector for RT1, giving the decomposition
54250 :
54251 : [ CS1 SN1 ] [ A B ] [ CS1 -SN1 ] = [ RT1 0 ]
54252 : [-SN1 CS1 ] [ B C ] [ SN1 CS1 ] [ 0 RT2 ].
54253 :
54254 :
54255 : -- LAPACK auxiliary routine (version 3.0) --
54256 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
54257 : Courant Institute, Argonne National Lab, and Rice University
54258 : October 31, 1992
54259 : *************************************************************************/
54260 0 : static void evd_tdevdev2(double a,
54261 : double b,
54262 : double c,
54263 : double* rt1,
54264 : double* rt2,
54265 : double* cs1,
54266 : double* sn1,
54267 : ae_state *_state)
54268 : {
54269 : ae_int_t sgn1;
54270 : ae_int_t sgn2;
54271 : double ab;
54272 : double acmn;
54273 : double acmx;
54274 : double acs;
54275 : double adf;
54276 : double cs;
54277 : double ct;
54278 : double df;
54279 : double rt;
54280 : double sm;
54281 : double tb;
54282 : double tn;
54283 :
54284 0 : *rt1 = 0;
54285 0 : *rt2 = 0;
54286 0 : *cs1 = 0;
54287 0 : *sn1 = 0;
54288 :
54289 :
54290 : /*
54291 : * Compute the eigenvalues
54292 : */
54293 0 : sm = a+c;
54294 0 : df = a-c;
54295 0 : adf = ae_fabs(df, _state);
54296 0 : tb = b+b;
54297 0 : ab = ae_fabs(tb, _state);
54298 0 : if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) )
54299 : {
54300 0 : acmx = a;
54301 0 : acmn = c;
54302 : }
54303 : else
54304 : {
54305 0 : acmx = c;
54306 0 : acmn = a;
54307 : }
54308 0 : if( ae_fp_greater(adf,ab) )
54309 : {
54310 0 : rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state);
54311 : }
54312 : else
54313 : {
54314 0 : if( ae_fp_less(adf,ab) )
54315 : {
54316 0 : rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state);
54317 : }
54318 : else
54319 : {
54320 :
54321 : /*
54322 : * Includes case AB=ADF=0
54323 : */
54324 0 : rt = ab*ae_sqrt((double)(2), _state);
54325 : }
54326 : }
54327 0 : if( ae_fp_less(sm,(double)(0)) )
54328 : {
54329 0 : *rt1 = 0.5*(sm-rt);
54330 0 : sgn1 = -1;
54331 :
54332 : /*
54333 : * Order of execution important.
54334 : * To get fully accurate smaller eigenvalue,
54335 : * next line needs to be executed in higher precision.
54336 : */
54337 0 : *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b;
54338 : }
54339 : else
54340 : {
54341 0 : if( ae_fp_greater(sm,(double)(0)) )
54342 : {
54343 0 : *rt1 = 0.5*(sm+rt);
54344 0 : sgn1 = 1;
54345 :
54346 : /*
54347 : * Order of execution important.
54348 : * To get fully accurate smaller eigenvalue,
54349 : * next line needs to be executed in higher precision.
54350 : */
54351 0 : *rt2 = acmx/(*rt1)*acmn-b/(*rt1)*b;
54352 : }
54353 : else
54354 : {
54355 :
54356 : /*
54357 : * Includes case RT1 = RT2 = 0
54358 : */
54359 0 : *rt1 = 0.5*rt;
54360 0 : *rt2 = -0.5*rt;
54361 0 : sgn1 = 1;
54362 : }
54363 : }
54364 :
54365 : /*
54366 : * Compute the eigenvector
54367 : */
54368 0 : if( ae_fp_greater_eq(df,(double)(0)) )
54369 : {
54370 0 : cs = df+rt;
54371 0 : sgn2 = 1;
54372 : }
54373 : else
54374 : {
54375 0 : cs = df-rt;
54376 0 : sgn2 = -1;
54377 : }
54378 0 : acs = ae_fabs(cs, _state);
54379 0 : if( ae_fp_greater(acs,ab) )
54380 : {
54381 0 : ct = -tb/cs;
54382 0 : *sn1 = 1/ae_sqrt(1+ct*ct, _state);
54383 0 : *cs1 = ct*(*sn1);
54384 : }
54385 : else
54386 : {
54387 0 : if( ae_fp_eq(ab,(double)(0)) )
54388 : {
54389 0 : *cs1 = (double)(1);
54390 0 : *sn1 = (double)(0);
54391 : }
54392 : else
54393 : {
54394 0 : tn = -cs/tb;
54395 0 : *cs1 = 1/ae_sqrt(1+tn*tn, _state);
54396 0 : *sn1 = tn*(*cs1);
54397 : }
54398 : }
54399 0 : if( sgn1==sgn2 )
54400 : {
54401 0 : tn = *cs1;
54402 0 : *cs1 = -*sn1;
54403 0 : *sn1 = tn;
54404 : }
54405 0 : }
54406 :
54407 :
54408 : /*************************************************************************
54409 : Internal routine
54410 : *************************************************************************/
54411 0 : static double evd_tdevdpythag(double a, double b, ae_state *_state)
54412 : {
54413 : double result;
54414 :
54415 :
54416 0 : if( ae_fp_less(ae_fabs(a, _state),ae_fabs(b, _state)) )
54417 : {
54418 0 : result = ae_fabs(b, _state)*ae_sqrt(1+ae_sqr(a/b, _state), _state);
54419 : }
54420 : else
54421 : {
54422 0 : result = ae_fabs(a, _state)*ae_sqrt(1+ae_sqr(b/a, _state), _state);
54423 : }
54424 0 : return result;
54425 : }
54426 :
54427 :
54428 : /*************************************************************************
54429 : Internal routine
54430 : *************************************************************************/
54431 0 : static double evd_tdevdextsign(double a, double b, ae_state *_state)
54432 : {
54433 : double result;
54434 :
54435 :
54436 0 : if( ae_fp_greater_eq(b,(double)(0)) )
54437 : {
54438 0 : result = ae_fabs(a, _state);
54439 : }
54440 : else
54441 : {
54442 0 : result = -ae_fabs(a, _state);
54443 : }
54444 0 : return result;
54445 : }
54446 :
54447 :
54448 0 : static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d,
54449 : /* Real */ ae_vector* e,
54450 : ae_int_t n,
54451 : ae_int_t irange,
54452 : ae_int_t iorder,
54453 : double vl,
54454 : double vu,
54455 : ae_int_t il,
54456 : ae_int_t iu,
54457 : double abstol,
54458 : /* Real */ ae_vector* w,
54459 : ae_int_t* m,
54460 : ae_int_t* nsplit,
54461 : /* Integer */ ae_vector* iblock,
54462 : /* Integer */ ae_vector* isplit,
54463 : ae_int_t* errorcode,
54464 : ae_state *_state)
54465 : {
54466 : ae_frame _frame_block;
54467 : ae_vector _d;
54468 : ae_vector _e;
54469 : double fudge;
54470 : double relfac;
54471 : ae_bool ncnvrg;
54472 : ae_bool toofew;
54473 : ae_int_t ib;
54474 : ae_int_t ibegin;
54475 : ae_int_t idiscl;
54476 : ae_int_t idiscu;
54477 : ae_int_t ie;
54478 : ae_int_t iend;
54479 : ae_int_t iinfo;
54480 : ae_int_t im;
54481 : ae_int_t iin;
54482 : ae_int_t ioff;
54483 : ae_int_t iout;
54484 : ae_int_t itmax;
54485 : ae_int_t iw;
54486 : ae_int_t iwoff;
54487 : ae_int_t j;
54488 : ae_int_t itmp1;
54489 : ae_int_t jb;
54490 : ae_int_t jdisc;
54491 : ae_int_t je;
54492 : ae_int_t nwl;
54493 : ae_int_t nwu;
54494 : double atoli;
54495 : double bnorm;
54496 : double gl;
54497 : double gu;
54498 : double pivmin;
54499 : double rtoli;
54500 : double safemn;
54501 : double tmp1;
54502 : double tmp2;
54503 : double tnorm;
54504 : double ulp;
54505 : double wkill;
54506 : double wl;
54507 : double wlu;
54508 : double wu;
54509 : double wul;
54510 : double scalefactor;
54511 : double t;
54512 : ae_vector idumma;
54513 : ae_vector work;
54514 : ae_vector iwork;
54515 : ae_vector ia1s2;
54516 : ae_vector ra1s2;
54517 : ae_matrix ra1s2x2;
54518 : ae_matrix ia1s2x2;
54519 : ae_vector ra1siin;
54520 : ae_vector ra2siin;
54521 : ae_vector ra3siin;
54522 : ae_vector ra4siin;
54523 : ae_matrix ra1siinx2;
54524 : ae_matrix ia1siinx2;
54525 : ae_vector iworkspace;
54526 : ae_vector rworkspace;
54527 : ae_int_t tmpi;
54528 : ae_bool result;
54529 :
54530 0 : ae_frame_make(_state, &_frame_block);
54531 0 : memset(&_d, 0, sizeof(_d));
54532 0 : memset(&_e, 0, sizeof(_e));
54533 0 : memset(&idumma, 0, sizeof(idumma));
54534 0 : memset(&work, 0, sizeof(work));
54535 0 : memset(&iwork, 0, sizeof(iwork));
54536 0 : memset(&ia1s2, 0, sizeof(ia1s2));
54537 0 : memset(&ra1s2, 0, sizeof(ra1s2));
54538 0 : memset(&ra1s2x2, 0, sizeof(ra1s2x2));
54539 0 : memset(&ia1s2x2, 0, sizeof(ia1s2x2));
54540 0 : memset(&ra1siin, 0, sizeof(ra1siin));
54541 0 : memset(&ra2siin, 0, sizeof(ra2siin));
54542 0 : memset(&ra3siin, 0, sizeof(ra3siin));
54543 0 : memset(&ra4siin, 0, sizeof(ra4siin));
54544 0 : memset(&ra1siinx2, 0, sizeof(ra1siinx2));
54545 0 : memset(&ia1siinx2, 0, sizeof(ia1siinx2));
54546 0 : memset(&iworkspace, 0, sizeof(iworkspace));
54547 0 : memset(&rworkspace, 0, sizeof(rworkspace));
54548 0 : ae_vector_init_copy(&_d, d, _state, ae_true);
54549 0 : d = &_d;
54550 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
54551 0 : e = &_e;
54552 0 : ae_vector_clear(w);
54553 0 : *m = 0;
54554 0 : *nsplit = 0;
54555 0 : ae_vector_clear(iblock);
54556 0 : ae_vector_clear(isplit);
54557 0 : *errorcode = 0;
54558 0 : ae_vector_init(&idumma, 0, DT_INT, _state, ae_true);
54559 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
54560 0 : ae_vector_init(&iwork, 0, DT_INT, _state, ae_true);
54561 0 : ae_vector_init(&ia1s2, 0, DT_INT, _state, ae_true);
54562 0 : ae_vector_init(&ra1s2, 0, DT_REAL, _state, ae_true);
54563 0 : ae_matrix_init(&ra1s2x2, 0, 0, DT_REAL, _state, ae_true);
54564 0 : ae_matrix_init(&ia1s2x2, 0, 0, DT_INT, _state, ae_true);
54565 0 : ae_vector_init(&ra1siin, 0, DT_REAL, _state, ae_true);
54566 0 : ae_vector_init(&ra2siin, 0, DT_REAL, _state, ae_true);
54567 0 : ae_vector_init(&ra3siin, 0, DT_REAL, _state, ae_true);
54568 0 : ae_vector_init(&ra4siin, 0, DT_REAL, _state, ae_true);
54569 0 : ae_matrix_init(&ra1siinx2, 0, 0, DT_REAL, _state, ae_true);
54570 0 : ae_matrix_init(&ia1siinx2, 0, 0, DT_INT, _state, ae_true);
54571 0 : ae_vector_init(&iworkspace, 0, DT_INT, _state, ae_true);
54572 0 : ae_vector_init(&rworkspace, 0, DT_REAL, _state, ae_true);
54573 :
54574 :
54575 : /*
54576 : * Quick return if possible
54577 : */
54578 0 : *m = 0;
54579 0 : if( n==0 )
54580 : {
54581 0 : result = ae_true;
54582 0 : ae_frame_leave(_state);
54583 0 : return result;
54584 : }
54585 :
54586 : /*
54587 : * Get machine constants
54588 : * NB is the minimum vector length for vector bisection, or 0
54589 : * if only scalar is to be done.
54590 : */
54591 0 : fudge = (double)(2);
54592 0 : relfac = (double)(2);
54593 0 : safemn = ae_minrealnumber;
54594 0 : ulp = 2*ae_machineepsilon;
54595 0 : rtoli = ulp*relfac;
54596 0 : ae_vector_set_length(&idumma, 1+1, _state);
54597 0 : ae_vector_set_length(&work, 4*n+1, _state);
54598 0 : ae_vector_set_length(&iwork, 3*n+1, _state);
54599 0 : ae_vector_set_length(w, n+1, _state);
54600 0 : ae_vector_set_length(iblock, n+1, _state);
54601 0 : ae_vector_set_length(isplit, n+1, _state);
54602 0 : ae_vector_set_length(&ia1s2, 2+1, _state);
54603 0 : ae_vector_set_length(&ra1s2, 2+1, _state);
54604 0 : ae_matrix_set_length(&ra1s2x2, 2+1, 2+1, _state);
54605 0 : ae_matrix_set_length(&ia1s2x2, 2+1, 2+1, _state);
54606 0 : ae_vector_set_length(&ra1siin, n+1, _state);
54607 0 : ae_vector_set_length(&ra2siin, n+1, _state);
54608 0 : ae_vector_set_length(&ra3siin, n+1, _state);
54609 0 : ae_vector_set_length(&ra4siin, n+1, _state);
54610 0 : ae_matrix_set_length(&ra1siinx2, n+1, 2+1, _state);
54611 0 : ae_matrix_set_length(&ia1siinx2, n+1, 2+1, _state);
54612 0 : ae_vector_set_length(&iworkspace, n+1, _state);
54613 0 : ae_vector_set_length(&rworkspace, n+1, _state);
54614 :
54615 : /*
54616 : * these initializers are not really necessary,
54617 : * but without them compiler complains about uninitialized locals
54618 : */
54619 0 : wlu = (double)(0);
54620 0 : wul = (double)(0);
54621 :
54622 : /*
54623 : * Check for Errors
54624 : */
54625 0 : result = ae_false;
54626 0 : *errorcode = 0;
54627 0 : if( irange<=0||irange>=4 )
54628 : {
54629 0 : *errorcode = -4;
54630 : }
54631 0 : if( iorder<=0||iorder>=3 )
54632 : {
54633 0 : *errorcode = -5;
54634 : }
54635 0 : if( n<0 )
54636 : {
54637 0 : *errorcode = -3;
54638 : }
54639 0 : if( irange==2&&ae_fp_greater_eq(vl,vu) )
54640 : {
54641 0 : *errorcode = -6;
54642 : }
54643 0 : if( irange==3&&(il<1||il>ae_maxint(1, n, _state)) )
54644 : {
54645 0 : *errorcode = -8;
54646 : }
54647 0 : if( irange==3&&(iu<ae_minint(n, il, _state)||iu>n) )
54648 : {
54649 0 : *errorcode = -9;
54650 : }
54651 0 : if( *errorcode!=0 )
54652 : {
54653 0 : ae_frame_leave(_state);
54654 0 : return result;
54655 : }
54656 :
54657 : /*
54658 : * Initialize error flags
54659 : */
54660 0 : ncnvrg = ae_false;
54661 0 : toofew = ae_false;
54662 :
54663 : /*
54664 : * Simplifications:
54665 : */
54666 0 : if( (irange==3&&il==1)&&iu==n )
54667 : {
54668 0 : irange = 1;
54669 : }
54670 :
54671 : /*
54672 : * Special Case when N=1
54673 : */
54674 0 : if( n==1 )
54675 : {
54676 0 : *nsplit = 1;
54677 0 : isplit->ptr.p_int[1] = 1;
54678 0 : if( irange==2&&(ae_fp_greater_eq(vl,d->ptr.p_double[1])||ae_fp_less(vu,d->ptr.p_double[1])) )
54679 : {
54680 0 : *m = 0;
54681 : }
54682 : else
54683 : {
54684 0 : w->ptr.p_double[1] = d->ptr.p_double[1];
54685 0 : iblock->ptr.p_int[1] = 1;
54686 0 : *m = 1;
54687 : }
54688 0 : result = ae_true;
54689 0 : ae_frame_leave(_state);
54690 0 : return result;
54691 : }
54692 :
54693 : /*
54694 : * Scaling
54695 : */
54696 0 : t = ae_fabs(d->ptr.p_double[n], _state);
54697 0 : for(j=1; j<=n-1; j++)
54698 : {
54699 0 : t = ae_maxreal(t, ae_fabs(d->ptr.p_double[j], _state), _state);
54700 0 : t = ae_maxreal(t, ae_fabs(e->ptr.p_double[j], _state), _state);
54701 : }
54702 0 : scalefactor = (double)(1);
54703 0 : if( ae_fp_neq(t,(double)(0)) )
54704 : {
54705 0 : if( ae_fp_greater(t,ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state)*ae_sqrt(ae_maxrealnumber, _state)) )
54706 : {
54707 0 : scalefactor = t;
54708 : }
54709 0 : if( ae_fp_less(t,ae_sqrt(ae_sqrt(ae_maxrealnumber, _state), _state)*ae_sqrt(ae_minrealnumber, _state)) )
54710 : {
54711 0 : scalefactor = t;
54712 : }
54713 0 : for(j=1; j<=n-1; j++)
54714 : {
54715 0 : d->ptr.p_double[j] = d->ptr.p_double[j]/scalefactor;
54716 0 : e->ptr.p_double[j] = e->ptr.p_double[j]/scalefactor;
54717 : }
54718 0 : d->ptr.p_double[n] = d->ptr.p_double[n]/scalefactor;
54719 : }
54720 :
54721 : /*
54722 : * Compute Splitting Points
54723 : */
54724 0 : *nsplit = 1;
54725 0 : work.ptr.p_double[n] = (double)(0);
54726 0 : pivmin = (double)(1);
54727 0 : for(j=2; j<=n; j++)
54728 : {
54729 0 : tmp1 = ae_sqr(e->ptr.p_double[j-1], _state);
54730 0 : if( ae_fp_greater(ae_fabs(d->ptr.p_double[j]*d->ptr.p_double[j-1], _state)*ae_sqr(ulp, _state)+safemn,tmp1) )
54731 : {
54732 0 : isplit->ptr.p_int[*nsplit] = j-1;
54733 0 : *nsplit = *nsplit+1;
54734 0 : work.ptr.p_double[j-1] = (double)(0);
54735 : }
54736 : else
54737 : {
54738 0 : work.ptr.p_double[j-1] = tmp1;
54739 0 : pivmin = ae_maxreal(pivmin, tmp1, _state);
54740 : }
54741 : }
54742 0 : isplit->ptr.p_int[*nsplit] = n;
54743 0 : pivmin = pivmin*safemn;
54744 :
54745 : /*
54746 : * Compute Interval and ATOLI
54747 : */
54748 0 : if( irange==3 )
54749 : {
54750 :
54751 : /*
54752 : * RANGE='I': Compute the interval containing eigenvalues
54753 : * IL through IU.
54754 : *
54755 : * Compute Gershgorin interval for entire (split) matrix
54756 : * and use it as the initial interval
54757 : */
54758 0 : gu = d->ptr.p_double[1];
54759 0 : gl = d->ptr.p_double[1];
54760 0 : tmp1 = (double)(0);
54761 0 : for(j=1; j<=n-1; j++)
54762 : {
54763 0 : tmp2 = ae_sqrt(work.ptr.p_double[j], _state);
54764 0 : gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state);
54765 0 : gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state);
54766 0 : tmp1 = tmp2;
54767 : }
54768 0 : gu = ae_maxreal(gu, d->ptr.p_double[n]+tmp1, _state);
54769 0 : gl = ae_minreal(gl, d->ptr.p_double[n]-tmp1, _state);
54770 0 : tnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state);
54771 0 : gl = gl-fudge*tnorm*ulp*n-fudge*2*pivmin;
54772 0 : gu = gu+fudge*tnorm*ulp*n+fudge*pivmin;
54773 :
54774 : /*
54775 : * Compute Iteration parameters
54776 : */
54777 0 : itmax = ae_iceil((ae_log(tnorm+pivmin, _state)-ae_log(pivmin, _state))/ae_log((double)(2), _state), _state)+2;
54778 0 : if( ae_fp_less_eq(abstol,(double)(0)) )
54779 : {
54780 0 : atoli = ulp*tnorm;
54781 : }
54782 : else
54783 : {
54784 0 : atoli = abstol;
54785 : }
54786 0 : work.ptr.p_double[n+1] = gl;
54787 0 : work.ptr.p_double[n+2] = gl;
54788 0 : work.ptr.p_double[n+3] = gu;
54789 0 : work.ptr.p_double[n+4] = gu;
54790 0 : work.ptr.p_double[n+5] = gl;
54791 0 : work.ptr.p_double[n+6] = gu;
54792 0 : iwork.ptr.p_int[1] = -1;
54793 0 : iwork.ptr.p_int[2] = -1;
54794 0 : iwork.ptr.p_int[3] = n+1;
54795 0 : iwork.ptr.p_int[4] = n+1;
54796 0 : iwork.ptr.p_int[5] = il-1;
54797 0 : iwork.ptr.p_int[6] = iu;
54798 :
54799 : /*
54800 : * Calling DLAEBZ
54801 : *
54802 : * DLAEBZ( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN, D, E,
54803 : * WORK, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
54804 : * IWORK, W, IBLOCK, IINFO )
54805 : */
54806 0 : ia1s2.ptr.p_int[1] = iwork.ptr.p_int[5];
54807 0 : ia1s2.ptr.p_int[2] = iwork.ptr.p_int[6];
54808 0 : ra1s2.ptr.p_double[1] = work.ptr.p_double[n+5];
54809 0 : ra1s2.ptr.p_double[2] = work.ptr.p_double[n+6];
54810 0 : ra1s2x2.ptr.pp_double[1][1] = work.ptr.p_double[n+1];
54811 0 : ra1s2x2.ptr.pp_double[2][1] = work.ptr.p_double[n+2];
54812 0 : ra1s2x2.ptr.pp_double[1][2] = work.ptr.p_double[n+3];
54813 0 : ra1s2x2.ptr.pp_double[2][2] = work.ptr.p_double[n+4];
54814 0 : ia1s2x2.ptr.pp_int[1][1] = iwork.ptr.p_int[1];
54815 0 : ia1s2x2.ptr.pp_int[2][1] = iwork.ptr.p_int[2];
54816 0 : ia1s2x2.ptr.pp_int[1][2] = iwork.ptr.p_int[3];
54817 0 : ia1s2x2.ptr.pp_int[2][2] = iwork.ptr.p_int[4];
54818 0 : evd_internaldlaebz(3, itmax, n, 2, 2, atoli, rtoli, pivmin, d, e, &work, &ia1s2, &ra1s2x2, &ra1s2, &iout, &ia1s2x2, w, iblock, &iinfo, _state);
54819 0 : iwork.ptr.p_int[5] = ia1s2.ptr.p_int[1];
54820 0 : iwork.ptr.p_int[6] = ia1s2.ptr.p_int[2];
54821 0 : work.ptr.p_double[n+5] = ra1s2.ptr.p_double[1];
54822 0 : work.ptr.p_double[n+6] = ra1s2.ptr.p_double[2];
54823 0 : work.ptr.p_double[n+1] = ra1s2x2.ptr.pp_double[1][1];
54824 0 : work.ptr.p_double[n+2] = ra1s2x2.ptr.pp_double[2][1];
54825 0 : work.ptr.p_double[n+3] = ra1s2x2.ptr.pp_double[1][2];
54826 0 : work.ptr.p_double[n+4] = ra1s2x2.ptr.pp_double[2][2];
54827 0 : iwork.ptr.p_int[1] = ia1s2x2.ptr.pp_int[1][1];
54828 0 : iwork.ptr.p_int[2] = ia1s2x2.ptr.pp_int[2][1];
54829 0 : iwork.ptr.p_int[3] = ia1s2x2.ptr.pp_int[1][2];
54830 0 : iwork.ptr.p_int[4] = ia1s2x2.ptr.pp_int[2][2];
54831 0 : if( iwork.ptr.p_int[6]==iu )
54832 : {
54833 0 : wl = work.ptr.p_double[n+1];
54834 0 : wlu = work.ptr.p_double[n+3];
54835 0 : nwl = iwork.ptr.p_int[1];
54836 0 : wu = work.ptr.p_double[n+4];
54837 0 : wul = work.ptr.p_double[n+2];
54838 0 : nwu = iwork.ptr.p_int[4];
54839 : }
54840 : else
54841 : {
54842 0 : wl = work.ptr.p_double[n+2];
54843 0 : wlu = work.ptr.p_double[n+4];
54844 0 : nwl = iwork.ptr.p_int[2];
54845 0 : wu = work.ptr.p_double[n+3];
54846 0 : wul = work.ptr.p_double[n+1];
54847 0 : nwu = iwork.ptr.p_int[3];
54848 : }
54849 0 : if( ((nwl<0||nwl>=n)||nwu<1)||nwu>n )
54850 : {
54851 0 : *errorcode = 4;
54852 0 : result = ae_false;
54853 0 : ae_frame_leave(_state);
54854 0 : return result;
54855 : }
54856 : }
54857 : else
54858 : {
54859 :
54860 : /*
54861 : * RANGE='A' or 'V' -- Set ATOLI
54862 : */
54863 0 : tnorm = ae_maxreal(ae_fabs(d->ptr.p_double[1], _state)+ae_fabs(e->ptr.p_double[1], _state), ae_fabs(d->ptr.p_double[n], _state)+ae_fabs(e->ptr.p_double[n-1], _state), _state);
54864 0 : for(j=2; j<=n-1; j++)
54865 : {
54866 0 : tnorm = ae_maxreal(tnorm, ae_fabs(d->ptr.p_double[j], _state)+ae_fabs(e->ptr.p_double[j-1], _state)+ae_fabs(e->ptr.p_double[j], _state), _state);
54867 : }
54868 0 : if( ae_fp_less_eq(abstol,(double)(0)) )
54869 : {
54870 0 : atoli = ulp*tnorm;
54871 : }
54872 : else
54873 : {
54874 0 : atoli = abstol;
54875 : }
54876 0 : if( irange==2 )
54877 : {
54878 0 : wl = vl;
54879 0 : wu = vu;
54880 : }
54881 : else
54882 : {
54883 0 : wl = (double)(0);
54884 0 : wu = (double)(0);
54885 : }
54886 : }
54887 :
54888 : /*
54889 : * Find Eigenvalues -- Loop Over Blocks and recompute NWL and NWU.
54890 : * NWL accumulates the number of eigenvalues .le. WL,
54891 : * NWU accumulates the number of eigenvalues .le. WU
54892 : */
54893 0 : *m = 0;
54894 0 : iend = 0;
54895 0 : *errorcode = 0;
54896 0 : nwl = 0;
54897 0 : nwu = 0;
54898 0 : for(jb=1; jb<=*nsplit; jb++)
54899 : {
54900 0 : ioff = iend;
54901 0 : ibegin = ioff+1;
54902 0 : iend = isplit->ptr.p_int[jb];
54903 0 : iin = iend-ioff;
54904 0 : if( iin==1 )
54905 : {
54906 :
54907 : /*
54908 : * Special Case -- IIN=1
54909 : */
54910 0 : if( irange==1||ae_fp_greater_eq(wl,d->ptr.p_double[ibegin]-pivmin) )
54911 : {
54912 0 : nwl = nwl+1;
54913 : }
54914 0 : if( irange==1||ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin) )
54915 : {
54916 0 : nwu = nwu+1;
54917 : }
54918 0 : if( irange==1||(ae_fp_less(wl,d->ptr.p_double[ibegin]-pivmin)&&ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin)) )
54919 : {
54920 0 : *m = *m+1;
54921 0 : w->ptr.p_double[*m] = d->ptr.p_double[ibegin];
54922 0 : iblock->ptr.p_int[*m] = jb;
54923 : }
54924 : }
54925 : else
54926 : {
54927 :
54928 : /*
54929 : * General Case -- IIN > 1
54930 : *
54931 : * Compute Gershgorin Interval
54932 : * and use it as the initial interval
54933 : */
54934 0 : gu = d->ptr.p_double[ibegin];
54935 0 : gl = d->ptr.p_double[ibegin];
54936 0 : tmp1 = (double)(0);
54937 0 : for(j=ibegin; j<=iend-1; j++)
54938 : {
54939 0 : tmp2 = ae_fabs(e->ptr.p_double[j], _state);
54940 0 : gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state);
54941 0 : gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state);
54942 0 : tmp1 = tmp2;
54943 : }
54944 0 : gu = ae_maxreal(gu, d->ptr.p_double[iend]+tmp1, _state);
54945 0 : gl = ae_minreal(gl, d->ptr.p_double[iend]-tmp1, _state);
54946 0 : bnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state);
54947 0 : gl = gl-fudge*bnorm*ulp*iin-fudge*pivmin;
54948 0 : gu = gu+fudge*bnorm*ulp*iin+fudge*pivmin;
54949 :
54950 : /*
54951 : * Compute ATOLI for the current submatrix
54952 : */
54953 0 : if( ae_fp_less_eq(abstol,(double)(0)) )
54954 : {
54955 0 : atoli = ulp*ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state);
54956 : }
54957 : else
54958 : {
54959 0 : atoli = abstol;
54960 : }
54961 0 : if( irange>1 )
54962 : {
54963 0 : if( ae_fp_less(gu,wl) )
54964 : {
54965 0 : nwl = nwl+iin;
54966 0 : nwu = nwu+iin;
54967 0 : continue;
54968 : }
54969 0 : gl = ae_maxreal(gl, wl, _state);
54970 0 : gu = ae_minreal(gu, wu, _state);
54971 0 : if( ae_fp_greater_eq(gl,gu) )
54972 : {
54973 0 : continue;
54974 : }
54975 : }
54976 :
54977 : /*
54978 : * Set Up Initial Interval
54979 : */
54980 0 : work.ptr.p_double[n+1] = gl;
54981 0 : work.ptr.p_double[n+iin+1] = gu;
54982 :
54983 : /*
54984 : * Calling DLAEBZ
54985 : *
54986 : * CALL DLAEBZ( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
54987 : * D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
54988 : * IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
54989 : * IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
54990 : */
54991 0 : for(tmpi=1; tmpi<=iin; tmpi++)
54992 : {
54993 0 : ra1siin.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi];
54994 0 : if( ibegin-1+tmpi<n )
54995 : {
54996 0 : ra2siin.ptr.p_double[tmpi] = e->ptr.p_double[ibegin-1+tmpi];
54997 : }
54998 0 : ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi];
54999 0 : ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi];
55000 0 : ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin];
55001 0 : ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi];
55002 0 : rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi];
55003 0 : iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi];
55004 0 : ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi];
55005 0 : ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin];
55006 : }
55007 0 : evd_internaldlaebz(1, 0, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &im, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state);
55008 0 : for(tmpi=1; tmpi<=iin; tmpi++)
55009 : {
55010 0 : work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1];
55011 0 : work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2];
55012 0 : work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi];
55013 0 : w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi];
55014 0 : iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi];
55015 0 : iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1];
55016 0 : iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[tmpi][2];
55017 : }
55018 0 : nwl = nwl+iwork.ptr.p_int[1];
55019 0 : nwu = nwu+iwork.ptr.p_int[iin+1];
55020 0 : iwoff = *m-iwork.ptr.p_int[1];
55021 :
55022 : /*
55023 : * Compute Eigenvalues
55024 : */
55025 0 : itmax = ae_iceil((ae_log(gu-gl+pivmin, _state)-ae_log(pivmin, _state))/ae_log((double)(2), _state), _state)+2;
55026 :
55027 : /*
55028 : * Calling DLAEBZ
55029 : *
55030 : *CALL DLAEBZ( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
55031 : * D( IBEGIN ), E( IBEGIN ), WORK( IBEGIN ),
55032 : * IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
55033 : * IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
55034 : */
55035 0 : for(tmpi=1; tmpi<=iin; tmpi++)
55036 : {
55037 0 : ra1siin.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi];
55038 0 : if( ibegin-1+tmpi<n )
55039 : {
55040 0 : ra2siin.ptr.p_double[tmpi] = e->ptr.p_double[ibegin-1+tmpi];
55041 : }
55042 0 : ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi];
55043 0 : ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi];
55044 0 : ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin];
55045 0 : ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi];
55046 0 : rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi];
55047 0 : iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi];
55048 0 : ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi];
55049 0 : ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin];
55050 : }
55051 0 : evd_internaldlaebz(2, itmax, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &iout, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state);
55052 0 : for(tmpi=1; tmpi<=iin; tmpi++)
55053 : {
55054 0 : work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1];
55055 0 : work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2];
55056 0 : work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi];
55057 0 : w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi];
55058 0 : iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi];
55059 0 : iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1];
55060 0 : iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[tmpi][2];
55061 : }
55062 :
55063 : /*
55064 : * Copy Eigenvalues Into W and IBLOCK
55065 : * Use -JB for block number for unconverged eigenvalues.
55066 : */
55067 0 : for(j=1; j<=iout; j++)
55068 : {
55069 0 : tmp1 = 0.5*(work.ptr.p_double[j+n]+work.ptr.p_double[j+iin+n]);
55070 :
55071 : /*
55072 : * Flag non-convergence.
55073 : */
55074 0 : if( j>iout-iinfo )
55075 : {
55076 0 : ncnvrg = ae_true;
55077 0 : ib = -jb;
55078 : }
55079 : else
55080 : {
55081 0 : ib = jb;
55082 : }
55083 0 : for(je=iwork.ptr.p_int[j]+1+iwoff; je<=iwork.ptr.p_int[j+iin]+iwoff; je++)
55084 : {
55085 0 : w->ptr.p_double[je] = tmp1;
55086 0 : iblock->ptr.p_int[je] = ib;
55087 : }
55088 : }
55089 0 : *m = *m+im;
55090 : }
55091 : }
55092 :
55093 : /*
55094 : * If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
55095 : * If NWL+1 < IL or NWU > IU, discard extra eigenvalues.
55096 : */
55097 0 : if( irange==3 )
55098 : {
55099 0 : im = 0;
55100 0 : idiscl = il-1-nwl;
55101 0 : idiscu = nwu-iu;
55102 0 : if( idiscl>0||idiscu>0 )
55103 : {
55104 0 : for(je=1; je<=*m; je++)
55105 : {
55106 0 : if( ae_fp_less_eq(w->ptr.p_double[je],wlu)&&idiscl>0 )
55107 : {
55108 0 : idiscl = idiscl-1;
55109 : }
55110 : else
55111 : {
55112 0 : if( ae_fp_greater_eq(w->ptr.p_double[je],wul)&&idiscu>0 )
55113 : {
55114 0 : idiscu = idiscu-1;
55115 : }
55116 : else
55117 : {
55118 0 : im = im+1;
55119 0 : w->ptr.p_double[im] = w->ptr.p_double[je];
55120 0 : iblock->ptr.p_int[im] = iblock->ptr.p_int[je];
55121 : }
55122 : }
55123 : }
55124 0 : *m = im;
55125 : }
55126 0 : if( idiscl>0||idiscu>0 )
55127 : {
55128 :
55129 : /*
55130 : * Code to deal with effects of bad arithmetic:
55131 : * Some low eigenvalues to be discarded are not in (WL,WLU],
55132 : * or high eigenvalues to be discarded are not in (WUL,WU]
55133 : * so just kill off the smallest IDISCL/largest IDISCU
55134 : * eigenvalues, by simply finding the smallest/largest
55135 : * eigenvalue(s).
55136 : *
55137 : * (If N(w) is monotone non-decreasing, this should never
55138 : * happen.)
55139 : */
55140 0 : if( idiscl>0 )
55141 : {
55142 0 : wkill = wu;
55143 0 : for(jdisc=1; jdisc<=idiscl; jdisc++)
55144 : {
55145 0 : iw = 0;
55146 0 : for(je=1; je<=*m; je++)
55147 : {
55148 0 : if( iblock->ptr.p_int[je]!=0&&(ae_fp_less(w->ptr.p_double[je],wkill)||iw==0) )
55149 : {
55150 0 : iw = je;
55151 0 : wkill = w->ptr.p_double[je];
55152 : }
55153 : }
55154 0 : iblock->ptr.p_int[iw] = 0;
55155 : }
55156 : }
55157 0 : if( idiscu>0 )
55158 : {
55159 0 : wkill = wl;
55160 0 : for(jdisc=1; jdisc<=idiscu; jdisc++)
55161 : {
55162 0 : iw = 0;
55163 0 : for(je=1; je<=*m; je++)
55164 : {
55165 0 : if( iblock->ptr.p_int[je]!=0&&(ae_fp_greater(w->ptr.p_double[je],wkill)||iw==0) )
55166 : {
55167 0 : iw = je;
55168 0 : wkill = w->ptr.p_double[je];
55169 : }
55170 : }
55171 0 : iblock->ptr.p_int[iw] = 0;
55172 : }
55173 : }
55174 0 : im = 0;
55175 0 : for(je=1; je<=*m; je++)
55176 : {
55177 0 : if( iblock->ptr.p_int[je]!=0 )
55178 : {
55179 0 : im = im+1;
55180 0 : w->ptr.p_double[im] = w->ptr.p_double[je];
55181 0 : iblock->ptr.p_int[im] = iblock->ptr.p_int[je];
55182 : }
55183 : }
55184 0 : *m = im;
55185 : }
55186 0 : if( idiscl<0||idiscu<0 )
55187 : {
55188 0 : toofew = ae_true;
55189 : }
55190 : }
55191 :
55192 : /*
55193 : * If ORDER='B', do nothing -- the eigenvalues are already sorted
55194 : * by block.
55195 : * If ORDER='E', sort the eigenvalues from smallest to largest
55196 : */
55197 0 : if( iorder==1&&*nsplit>1 )
55198 : {
55199 0 : for(je=1; je<=*m-1; je++)
55200 : {
55201 0 : ie = 0;
55202 0 : tmp1 = w->ptr.p_double[je];
55203 0 : for(j=je+1; j<=*m; j++)
55204 : {
55205 0 : if( ae_fp_less(w->ptr.p_double[j],tmp1) )
55206 : {
55207 0 : ie = j;
55208 0 : tmp1 = w->ptr.p_double[j];
55209 : }
55210 : }
55211 0 : if( ie!=0 )
55212 : {
55213 0 : itmp1 = iblock->ptr.p_int[ie];
55214 0 : w->ptr.p_double[ie] = w->ptr.p_double[je];
55215 0 : iblock->ptr.p_int[ie] = iblock->ptr.p_int[je];
55216 0 : w->ptr.p_double[je] = tmp1;
55217 0 : iblock->ptr.p_int[je] = itmp1;
55218 : }
55219 : }
55220 : }
55221 0 : for(j=1; j<=*m; j++)
55222 : {
55223 0 : w->ptr.p_double[j] = w->ptr.p_double[j]*scalefactor;
55224 : }
55225 0 : *errorcode = 0;
55226 0 : if( ncnvrg )
55227 : {
55228 0 : *errorcode = *errorcode+1;
55229 : }
55230 0 : if( toofew )
55231 : {
55232 0 : *errorcode = *errorcode+2;
55233 : }
55234 0 : result = *errorcode==0;
55235 0 : ae_frame_leave(_state);
55236 0 : return result;
55237 : }
55238 :
55239 :
55240 0 : static void evd_internaldstein(ae_int_t n,
55241 : /* Real */ ae_vector* d,
55242 : /* Real */ ae_vector* e,
55243 : ae_int_t m,
55244 : /* Real */ ae_vector* w,
55245 : /* Integer */ ae_vector* iblock,
55246 : /* Integer */ ae_vector* isplit,
55247 : /* Real */ ae_matrix* z,
55248 : /* Integer */ ae_vector* ifail,
55249 : ae_int_t* info,
55250 : ae_state *_state)
55251 : {
55252 : ae_frame _frame_block;
55253 : ae_vector _e;
55254 : ae_vector _w;
55255 : ae_int_t maxits;
55256 : ae_int_t extra;
55257 : ae_int_t b1;
55258 : ae_int_t blksiz;
55259 : ae_int_t bn;
55260 : ae_int_t gpind;
55261 : ae_int_t i;
55262 : ae_int_t iinfo;
55263 : ae_int_t its;
55264 : ae_int_t j;
55265 : ae_int_t j1;
55266 : ae_int_t jblk;
55267 : ae_int_t jmax;
55268 : ae_int_t nblk;
55269 : ae_int_t nrmchk;
55270 : double dtpcrt;
55271 : double eps;
55272 : double eps1;
55273 : double nrm;
55274 : double onenrm;
55275 : double ortol;
55276 : double pertol;
55277 : double scl;
55278 : double sep;
55279 : double tol;
55280 : double xj;
55281 : double xjm;
55282 : double ztr;
55283 : ae_vector work1;
55284 : ae_vector work2;
55285 : ae_vector work3;
55286 : ae_vector work4;
55287 : ae_vector work5;
55288 : ae_vector iwork;
55289 : ae_bool tmpcriterion;
55290 : ae_int_t ti;
55291 : ae_int_t i1;
55292 : ae_int_t i2;
55293 : double v;
55294 : hqrndstate rs;
55295 :
55296 0 : ae_frame_make(_state, &_frame_block);
55297 0 : memset(&_e, 0, sizeof(_e));
55298 0 : memset(&_w, 0, sizeof(_w));
55299 0 : memset(&work1, 0, sizeof(work1));
55300 0 : memset(&work2, 0, sizeof(work2));
55301 0 : memset(&work3, 0, sizeof(work3));
55302 0 : memset(&work4, 0, sizeof(work4));
55303 0 : memset(&work5, 0, sizeof(work5));
55304 0 : memset(&iwork, 0, sizeof(iwork));
55305 0 : memset(&rs, 0, sizeof(rs));
55306 0 : ae_vector_init_copy(&_e, e, _state, ae_true);
55307 0 : e = &_e;
55308 0 : ae_vector_init_copy(&_w, w, _state, ae_true);
55309 0 : w = &_w;
55310 0 : ae_matrix_clear(z);
55311 0 : ae_vector_clear(ifail);
55312 0 : *info = 0;
55313 0 : ae_vector_init(&work1, 0, DT_REAL, _state, ae_true);
55314 0 : ae_vector_init(&work2, 0, DT_REAL, _state, ae_true);
55315 0 : ae_vector_init(&work3, 0, DT_REAL, _state, ae_true);
55316 0 : ae_vector_init(&work4, 0, DT_REAL, _state, ae_true);
55317 0 : ae_vector_init(&work5, 0, DT_REAL, _state, ae_true);
55318 0 : ae_vector_init(&iwork, 0, DT_INT, _state, ae_true);
55319 0 : _hqrndstate_init(&rs, _state, ae_true);
55320 :
55321 0 : hqrndseed(346436, 2434, &rs, _state);
55322 0 : maxits = 5;
55323 0 : extra = 2;
55324 0 : ae_vector_set_length(&work1, ae_maxint(n, 1, _state)+1, _state);
55325 0 : ae_vector_set_length(&work2, ae_maxint(n-1, 1, _state)+1, _state);
55326 0 : ae_vector_set_length(&work3, ae_maxint(n, 1, _state)+1, _state);
55327 0 : ae_vector_set_length(&work4, ae_maxint(n, 1, _state)+1, _state);
55328 0 : ae_vector_set_length(&work5, ae_maxint(n, 1, _state)+1, _state);
55329 0 : ae_vector_set_length(&iwork, ae_maxint(n, 1, _state)+1, _state);
55330 0 : ae_vector_set_length(ifail, ae_maxint(m, 1, _state)+1, _state);
55331 0 : ae_matrix_set_length(z, ae_maxint(n, 1, _state)+1, ae_maxint(m, 1, _state)+1, _state);
55332 :
55333 : /*
55334 : * these initializers are not really necessary,
55335 : * but without them compiler complains about uninitialized locals
55336 : */
55337 0 : gpind = 0;
55338 0 : onenrm = (double)(0);
55339 0 : ortol = (double)(0);
55340 0 : dtpcrt = (double)(0);
55341 0 : xjm = (double)(0);
55342 :
55343 : /*
55344 : * Test the input parameters.
55345 : */
55346 0 : *info = 0;
55347 0 : for(i=1; i<=m; i++)
55348 : {
55349 0 : ifail->ptr.p_int[i] = 0;
55350 : }
55351 0 : if( n<0 )
55352 : {
55353 0 : *info = -1;
55354 0 : ae_frame_leave(_state);
55355 0 : return;
55356 : }
55357 0 : if( m<0||m>n )
55358 : {
55359 0 : *info = -4;
55360 0 : ae_frame_leave(_state);
55361 0 : return;
55362 : }
55363 0 : for(j=2; j<=m; j++)
55364 : {
55365 0 : if( iblock->ptr.p_int[j]<iblock->ptr.p_int[j-1] )
55366 : {
55367 0 : *info = -6;
55368 0 : break;
55369 : }
55370 0 : if( iblock->ptr.p_int[j]==iblock->ptr.p_int[j-1]&&ae_fp_less(w->ptr.p_double[j],w->ptr.p_double[j-1]) )
55371 : {
55372 0 : *info = -5;
55373 0 : break;
55374 : }
55375 : }
55376 0 : if( *info!=0 )
55377 : {
55378 0 : ae_frame_leave(_state);
55379 0 : return;
55380 : }
55381 :
55382 : /*
55383 : * Quick return if possible
55384 : */
55385 0 : if( n==0||m==0 )
55386 : {
55387 0 : ae_frame_leave(_state);
55388 0 : return;
55389 : }
55390 0 : if( n==1 )
55391 : {
55392 0 : z->ptr.pp_double[1][1] = (double)(1);
55393 0 : ae_frame_leave(_state);
55394 0 : return;
55395 : }
55396 :
55397 : /*
55398 : * Some preparations
55399 : */
55400 0 : ti = n-1;
55401 0 : ae_v_move(&work1.ptr.p_double[1], 1, &e->ptr.p_double[1], 1, ae_v_len(1,ti));
55402 0 : ae_vector_set_length(e, n+1, _state);
55403 0 : ae_v_move(&e->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,ti));
55404 0 : ae_v_move(&work1.ptr.p_double[1], 1, &w->ptr.p_double[1], 1, ae_v_len(1,m));
55405 0 : ae_vector_set_length(w, n+1, _state);
55406 0 : ae_v_move(&w->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,m));
55407 :
55408 : /*
55409 : * Get machine constants.
55410 : */
55411 0 : eps = ae_machineepsilon;
55412 :
55413 : /*
55414 : * Compute eigenvectors of matrix blocks.
55415 : */
55416 0 : j1 = 1;
55417 0 : for(nblk=1; nblk<=iblock->ptr.p_int[m]; nblk++)
55418 : {
55419 :
55420 : /*
55421 : * Find starting and ending indices of block nblk.
55422 : */
55423 0 : if( nblk==1 )
55424 : {
55425 0 : b1 = 1;
55426 : }
55427 : else
55428 : {
55429 0 : b1 = isplit->ptr.p_int[nblk-1]+1;
55430 : }
55431 0 : bn = isplit->ptr.p_int[nblk];
55432 0 : blksiz = bn-b1+1;
55433 0 : if( blksiz!=1 )
55434 : {
55435 :
55436 : /*
55437 : * Compute reorthogonalization criterion and stopping criterion.
55438 : */
55439 0 : gpind = b1;
55440 0 : onenrm = ae_fabs(d->ptr.p_double[b1], _state)+ae_fabs(e->ptr.p_double[b1], _state);
55441 0 : onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[bn], _state)+ae_fabs(e->ptr.p_double[bn-1], _state), _state);
55442 0 : for(i=b1+1; i<=bn-1; i++)
55443 : {
55444 0 : onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state)+ae_fabs(e->ptr.p_double[i], _state), _state);
55445 : }
55446 0 : ortol = 0.001*onenrm;
55447 0 : dtpcrt = ae_sqrt(0.1/blksiz, _state);
55448 : }
55449 :
55450 : /*
55451 : * Loop through eigenvalues of block nblk.
55452 : */
55453 0 : jblk = 0;
55454 0 : for(j=j1; j<=m; j++)
55455 : {
55456 0 : if( iblock->ptr.p_int[j]!=nblk )
55457 : {
55458 0 : j1 = j;
55459 0 : break;
55460 : }
55461 0 : jblk = jblk+1;
55462 0 : xj = w->ptr.p_double[j];
55463 0 : if( blksiz==1 )
55464 : {
55465 :
55466 : /*
55467 : * Skip all the work if the block size is one.
55468 : */
55469 0 : work1.ptr.p_double[1] = (double)(1);
55470 : }
55471 : else
55472 : {
55473 :
55474 : /*
55475 : * If eigenvalues j and j-1 are too close, add a relatively
55476 : * small perturbation.
55477 : */
55478 0 : if( jblk>1 )
55479 : {
55480 0 : eps1 = ae_fabs(eps*xj, _state);
55481 0 : pertol = 10*eps1;
55482 0 : sep = xj-xjm;
55483 0 : if( ae_fp_less(sep,pertol) )
55484 : {
55485 0 : xj = xjm+pertol;
55486 : }
55487 : }
55488 0 : its = 0;
55489 0 : nrmchk = 0;
55490 :
55491 : /*
55492 : * Get random starting vector.
55493 : */
55494 0 : for(ti=1; ti<=blksiz; ti++)
55495 : {
55496 0 : work1.ptr.p_double[ti] = 2*hqrnduniformr(&rs, _state)-1;
55497 : }
55498 :
55499 : /*
55500 : * Copy the matrix T so it won't be destroyed in factorization.
55501 : */
55502 0 : for(ti=1; ti<=blksiz-1; ti++)
55503 : {
55504 0 : work2.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1];
55505 0 : work3.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1];
55506 0 : work4.ptr.p_double[ti] = d->ptr.p_double[b1+ti-1];
55507 : }
55508 0 : work4.ptr.p_double[blksiz] = d->ptr.p_double[b1+blksiz-1];
55509 :
55510 : /*
55511 : * Compute LU factors with partial pivoting ( PT = LU )
55512 : */
55513 0 : tol = (double)(0);
55514 0 : evd_tdininternaldlagtf(blksiz, &work4, xj, &work2, &work3, tol, &work5, &iwork, &iinfo, _state);
55515 :
55516 : /*
55517 : * Update iteration count.
55518 : */
55519 0 : do
55520 : {
55521 0 : its = its+1;
55522 0 : if( its>maxits )
55523 : {
55524 :
55525 : /*
55526 : * If stopping criterion was not satisfied, update info and
55527 : * store eigenvector number in array ifail.
55528 : */
55529 0 : *info = *info+1;
55530 0 : ifail->ptr.p_int[*info] = j;
55531 0 : break;
55532 : }
55533 :
55534 : /*
55535 : * Normalize and scale the righthand side vector Pb.
55536 : */
55537 0 : v = (double)(0);
55538 0 : for(ti=1; ti<=blksiz; ti++)
55539 : {
55540 0 : v = v+ae_fabs(work1.ptr.p_double[ti], _state);
55541 : }
55542 0 : scl = blksiz*onenrm*ae_maxreal(eps, ae_fabs(work4.ptr.p_double[blksiz], _state), _state)/v;
55543 0 : ae_v_muld(&work1.ptr.p_double[1], 1, ae_v_len(1,blksiz), scl);
55544 :
55545 : /*
55546 : * Solve the system LU = Pb.
55547 : */
55548 0 : evd_tdininternaldlagts(blksiz, &work4, &work2, &work3, &work5, &iwork, &work1, &tol, &iinfo, _state);
55549 :
55550 : /*
55551 : * Reorthogonalize by modified Gram-Schmidt if eigenvalues are
55552 : * close enough.
55553 : */
55554 0 : if( jblk!=1 )
55555 : {
55556 0 : if( ae_fp_greater(ae_fabs(xj-xjm, _state),ortol) )
55557 : {
55558 0 : gpind = j;
55559 : }
55560 0 : if( gpind!=j )
55561 : {
55562 0 : for(i=gpind; i<=j-1; i++)
55563 : {
55564 0 : i1 = b1;
55565 0 : i2 = b1+blksiz-1;
55566 0 : ztr = ae_v_dotproduct(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz));
55567 0 : ae_v_subd(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz), ztr);
55568 0 : touchint(&i2, _state);
55569 : }
55570 : }
55571 : }
55572 :
55573 : /*
55574 : * Check the infinity norm of the iterate.
55575 : */
55576 0 : jmax = vectoridxabsmax(&work1, 1, blksiz, _state);
55577 0 : nrm = ae_fabs(work1.ptr.p_double[jmax], _state);
55578 :
55579 : /*
55580 : * Continue for additional iterations after norm reaches
55581 : * stopping criterion.
55582 : */
55583 0 : tmpcriterion = ae_false;
55584 0 : if( ae_fp_less(nrm,dtpcrt) )
55585 : {
55586 0 : tmpcriterion = ae_true;
55587 : }
55588 : else
55589 : {
55590 0 : nrmchk = nrmchk+1;
55591 0 : if( nrmchk<extra+1 )
55592 : {
55593 0 : tmpcriterion = ae_true;
55594 : }
55595 : }
55596 : }
55597 : while(tmpcriterion);
55598 :
55599 : /*
55600 : * Accept iterate as jth eigenvector.
55601 : */
55602 0 : scl = 1/vectornorm2(&work1, 1, blksiz, _state);
55603 0 : jmax = vectoridxabsmax(&work1, 1, blksiz, _state);
55604 0 : if( ae_fp_less(work1.ptr.p_double[jmax],(double)(0)) )
55605 : {
55606 0 : scl = -scl;
55607 : }
55608 0 : ae_v_muld(&work1.ptr.p_double[1], 1, ae_v_len(1,blksiz), scl);
55609 : }
55610 0 : for(i=1; i<=n; i++)
55611 : {
55612 0 : z->ptr.pp_double[i][j] = (double)(0);
55613 : }
55614 0 : for(i=1; i<=blksiz; i++)
55615 : {
55616 0 : z->ptr.pp_double[b1+i-1][j] = work1.ptr.p_double[i];
55617 : }
55618 :
55619 : /*
55620 : * Save the shift to check eigenvalue spacing at next
55621 : * iteration.
55622 : */
55623 0 : xjm = xj;
55624 : }
55625 : }
55626 0 : ae_frame_leave(_state);
55627 : }
55628 :
55629 :
55630 0 : static void evd_tdininternaldlagtf(ae_int_t n,
55631 : /* Real */ ae_vector* a,
55632 : double lambdav,
55633 : /* Real */ ae_vector* b,
55634 : /* Real */ ae_vector* c,
55635 : double tol,
55636 : /* Real */ ae_vector* d,
55637 : /* Integer */ ae_vector* iin,
55638 : ae_int_t* info,
55639 : ae_state *_state)
55640 : {
55641 : ae_int_t k;
55642 : double eps;
55643 : double mult;
55644 : double piv1;
55645 : double piv2;
55646 : double scale1;
55647 : double scale2;
55648 : double temp;
55649 : double tl;
55650 :
55651 0 : *info = 0;
55652 :
55653 0 : *info = 0;
55654 0 : if( n<0 )
55655 : {
55656 0 : *info = -1;
55657 0 : return;
55658 : }
55659 0 : if( n==0 )
55660 : {
55661 0 : return;
55662 : }
55663 0 : a->ptr.p_double[1] = a->ptr.p_double[1]-lambdav;
55664 0 : iin->ptr.p_int[n] = 0;
55665 0 : if( n==1 )
55666 : {
55667 0 : if( ae_fp_eq(a->ptr.p_double[1],(double)(0)) )
55668 : {
55669 0 : iin->ptr.p_int[1] = 1;
55670 : }
55671 0 : return;
55672 : }
55673 0 : eps = ae_machineepsilon;
55674 0 : tl = ae_maxreal(tol, eps, _state);
55675 0 : scale1 = ae_fabs(a->ptr.p_double[1], _state)+ae_fabs(b->ptr.p_double[1], _state);
55676 0 : for(k=1; k<=n-1; k++)
55677 : {
55678 0 : a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-lambdav;
55679 0 : scale2 = ae_fabs(c->ptr.p_double[k], _state)+ae_fabs(a->ptr.p_double[k+1], _state);
55680 0 : if( k<n-1 )
55681 : {
55682 0 : scale2 = scale2+ae_fabs(b->ptr.p_double[k+1], _state);
55683 : }
55684 0 : if( ae_fp_eq(a->ptr.p_double[k],(double)(0)) )
55685 : {
55686 0 : piv1 = (double)(0);
55687 : }
55688 : else
55689 : {
55690 0 : piv1 = ae_fabs(a->ptr.p_double[k], _state)/scale1;
55691 : }
55692 0 : if( ae_fp_eq(c->ptr.p_double[k],(double)(0)) )
55693 : {
55694 0 : iin->ptr.p_int[k] = 0;
55695 0 : piv2 = (double)(0);
55696 0 : scale1 = scale2;
55697 0 : if( k<n-1 )
55698 : {
55699 0 : d->ptr.p_double[k] = (double)(0);
55700 : }
55701 : }
55702 : else
55703 : {
55704 0 : piv2 = ae_fabs(c->ptr.p_double[k], _state)/scale2;
55705 0 : if( ae_fp_less_eq(piv2,piv1) )
55706 : {
55707 0 : iin->ptr.p_int[k] = 0;
55708 0 : scale1 = scale2;
55709 0 : c->ptr.p_double[k] = c->ptr.p_double[k]/a->ptr.p_double[k];
55710 0 : a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-c->ptr.p_double[k]*b->ptr.p_double[k];
55711 0 : if( k<n-1 )
55712 : {
55713 0 : d->ptr.p_double[k] = (double)(0);
55714 : }
55715 : }
55716 : else
55717 : {
55718 0 : iin->ptr.p_int[k] = 1;
55719 0 : mult = a->ptr.p_double[k]/c->ptr.p_double[k];
55720 0 : a->ptr.p_double[k] = c->ptr.p_double[k];
55721 0 : temp = a->ptr.p_double[k+1];
55722 0 : a->ptr.p_double[k+1] = b->ptr.p_double[k]-mult*temp;
55723 0 : if( k<n-1 )
55724 : {
55725 0 : d->ptr.p_double[k] = b->ptr.p_double[k+1];
55726 0 : b->ptr.p_double[k+1] = -mult*d->ptr.p_double[k];
55727 : }
55728 0 : b->ptr.p_double[k] = temp;
55729 0 : c->ptr.p_double[k] = mult;
55730 : }
55731 : }
55732 0 : if( ae_fp_less_eq(ae_maxreal(piv1, piv2, _state),tl)&&iin->ptr.p_int[n]==0 )
55733 : {
55734 0 : iin->ptr.p_int[n] = k;
55735 : }
55736 : }
55737 0 : if( ae_fp_less_eq(ae_fabs(a->ptr.p_double[n], _state),scale1*tl)&&iin->ptr.p_int[n]==0 )
55738 : {
55739 0 : iin->ptr.p_int[n] = n;
55740 : }
55741 : }
55742 :
55743 :
55744 0 : static void evd_tdininternaldlagts(ae_int_t n,
55745 : /* Real */ ae_vector* a,
55746 : /* Real */ ae_vector* b,
55747 : /* Real */ ae_vector* c,
55748 : /* Real */ ae_vector* d,
55749 : /* Integer */ ae_vector* iin,
55750 : /* Real */ ae_vector* y,
55751 : double* tol,
55752 : ae_int_t* info,
55753 : ae_state *_state)
55754 : {
55755 : ae_int_t k;
55756 : double absak;
55757 : double ak;
55758 : double bignum;
55759 : double eps;
55760 : double pert;
55761 : double sfmin;
55762 : double temp;
55763 :
55764 0 : *info = 0;
55765 :
55766 0 : *info = 0;
55767 0 : if( n<0 )
55768 : {
55769 0 : *info = -1;
55770 0 : return;
55771 : }
55772 0 : if( n==0 )
55773 : {
55774 0 : return;
55775 : }
55776 0 : eps = ae_machineepsilon;
55777 0 : sfmin = ae_minrealnumber;
55778 0 : bignum = 1/sfmin;
55779 0 : if( ae_fp_less_eq(*tol,(double)(0)) )
55780 : {
55781 0 : *tol = ae_fabs(a->ptr.p_double[1], _state);
55782 0 : if( n>1 )
55783 : {
55784 0 : *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[2], _state), ae_fabs(b->ptr.p_double[1], _state), _state), _state);
55785 : }
55786 0 : for(k=3; k<=n; k++)
55787 : {
55788 0 : *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[k], _state), ae_maxreal(ae_fabs(b->ptr.p_double[k-1], _state), ae_fabs(d->ptr.p_double[k-2], _state), _state), _state), _state);
55789 : }
55790 0 : *tol = *tol*eps;
55791 0 : if( ae_fp_eq(*tol,(double)(0)) )
55792 : {
55793 0 : *tol = eps;
55794 : }
55795 : }
55796 0 : for(k=2; k<=n; k++)
55797 : {
55798 0 : if( iin->ptr.p_int[k-1]==0 )
55799 : {
55800 0 : y->ptr.p_double[k] = y->ptr.p_double[k]-c->ptr.p_double[k-1]*y->ptr.p_double[k-1];
55801 : }
55802 : else
55803 : {
55804 0 : temp = y->ptr.p_double[k-1];
55805 0 : y->ptr.p_double[k-1] = y->ptr.p_double[k];
55806 0 : y->ptr.p_double[k] = temp-c->ptr.p_double[k-1]*y->ptr.p_double[k];
55807 : }
55808 : }
55809 0 : for(k=n; k>=1; k--)
55810 : {
55811 0 : if( k<=n-2 )
55812 : {
55813 0 : temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1]-d->ptr.p_double[k]*y->ptr.p_double[k+2];
55814 : }
55815 : else
55816 : {
55817 0 : if( k==n-1 )
55818 : {
55819 0 : temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1];
55820 : }
55821 : else
55822 : {
55823 0 : temp = y->ptr.p_double[k];
55824 : }
55825 : }
55826 0 : ak = a->ptr.p_double[k];
55827 0 : pert = ae_fabs(*tol, _state);
55828 0 : if( ae_fp_less(ak,(double)(0)) )
55829 : {
55830 0 : pert = -pert;
55831 : }
55832 : for(;;)
55833 : {
55834 0 : absak = ae_fabs(ak, _state);
55835 0 : if( ae_fp_less(absak,(double)(1)) )
55836 : {
55837 0 : if( ae_fp_less(absak,sfmin) )
55838 : {
55839 0 : if( ae_fp_eq(absak,(double)(0))||ae_fp_greater(ae_fabs(temp, _state)*sfmin,absak) )
55840 : {
55841 0 : ak = ak+pert;
55842 0 : pert = 2*pert;
55843 0 : continue;
55844 : }
55845 : else
55846 : {
55847 0 : temp = temp*bignum;
55848 0 : ak = ak*bignum;
55849 : }
55850 : }
55851 : else
55852 : {
55853 0 : if( ae_fp_greater(ae_fabs(temp, _state),absak*bignum) )
55854 : {
55855 0 : ak = ak+pert;
55856 0 : pert = 2*pert;
55857 0 : continue;
55858 : }
55859 : }
55860 : }
55861 0 : break;
55862 : }
55863 0 : y->ptr.p_double[k] = temp/ak;
55864 : }
55865 : }
55866 :
55867 :
55868 0 : static void evd_internaldlaebz(ae_int_t ijob,
55869 : ae_int_t nitmax,
55870 : ae_int_t n,
55871 : ae_int_t mmax,
55872 : ae_int_t minp,
55873 : double abstol,
55874 : double reltol,
55875 : double pivmin,
55876 : /* Real */ ae_vector* d,
55877 : /* Real */ ae_vector* e,
55878 : /* Real */ ae_vector* e2,
55879 : /* Integer */ ae_vector* nval,
55880 : /* Real */ ae_matrix* ab,
55881 : /* Real */ ae_vector* c,
55882 : ae_int_t* mout,
55883 : /* Integer */ ae_matrix* nab,
55884 : /* Real */ ae_vector* work,
55885 : /* Integer */ ae_vector* iwork,
55886 : ae_int_t* info,
55887 : ae_state *_state)
55888 : {
55889 : ae_int_t itmp1;
55890 : ae_int_t itmp2;
55891 : ae_int_t j;
55892 : ae_int_t ji;
55893 : ae_int_t jit;
55894 : ae_int_t jp;
55895 : ae_int_t kf;
55896 : ae_int_t kfnew;
55897 : ae_int_t kl;
55898 : ae_int_t klnew;
55899 : double tmp1;
55900 : double tmp2;
55901 :
55902 0 : *mout = 0;
55903 0 : *info = 0;
55904 :
55905 0 : *info = 0;
55906 0 : if( ijob<1||ijob>3 )
55907 : {
55908 0 : *info = -1;
55909 0 : return;
55910 : }
55911 :
55912 : /*
55913 : * Initialize NAB
55914 : */
55915 0 : if( ijob==1 )
55916 : {
55917 :
55918 : /*
55919 : * Compute the number of eigenvalues in the initial intervals.
55920 : */
55921 0 : *mout = 0;
55922 :
55923 : /*
55924 : *DIR$ NOVECTOR
55925 : */
55926 0 : for(ji=1; ji<=minp; ji++)
55927 : {
55928 0 : for(jp=1; jp<=2; jp++)
55929 : {
55930 0 : tmp1 = d->ptr.p_double[1]-ab->ptr.pp_double[ji][jp];
55931 0 : if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) )
55932 : {
55933 0 : tmp1 = -pivmin;
55934 : }
55935 0 : nab->ptr.pp_int[ji][jp] = 0;
55936 0 : if( ae_fp_less_eq(tmp1,(double)(0)) )
55937 : {
55938 0 : nab->ptr.pp_int[ji][jp] = 1;
55939 : }
55940 0 : for(j=2; j<=n; j++)
55941 : {
55942 0 : tmp1 = d->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp1-ab->ptr.pp_double[ji][jp];
55943 0 : if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) )
55944 : {
55945 0 : tmp1 = -pivmin;
55946 : }
55947 0 : if( ae_fp_less_eq(tmp1,(double)(0)) )
55948 : {
55949 0 : nab->ptr.pp_int[ji][jp] = nab->ptr.pp_int[ji][jp]+1;
55950 : }
55951 : }
55952 : }
55953 0 : *mout = *mout+nab->ptr.pp_int[ji][2]-nab->ptr.pp_int[ji][1];
55954 : }
55955 0 : return;
55956 : }
55957 :
55958 : /*
55959 : * Initialize for loop
55960 : *
55961 : * KF and KL have the following meaning:
55962 : * Intervals 1,...,KF-1 have converged.
55963 : * Intervals KF,...,KL still need to be refined.
55964 : */
55965 0 : kf = 1;
55966 0 : kl = minp;
55967 :
55968 : /*
55969 : * If IJOB=2, initialize C.
55970 : * If IJOB=3, use the user-supplied starting point.
55971 : */
55972 0 : if( ijob==2 )
55973 : {
55974 0 : for(ji=1; ji<=minp; ji++)
55975 : {
55976 0 : c->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[ji][2]);
55977 : }
55978 : }
55979 :
55980 : /*
55981 : * Iteration loop
55982 : */
55983 0 : for(jit=1; jit<=nitmax; jit++)
55984 : {
55985 :
55986 : /*
55987 : * Loop over intervals
55988 : *
55989 : *
55990 : * Serial Version of the loop
55991 : */
55992 0 : klnew = kl;
55993 0 : for(ji=kf; ji<=kl; ji++)
55994 : {
55995 :
55996 : /*
55997 : * Compute N(w), the number of eigenvalues less than w
55998 : */
55999 0 : tmp1 = c->ptr.p_double[ji];
56000 0 : tmp2 = d->ptr.p_double[1]-tmp1;
56001 0 : itmp1 = 0;
56002 0 : if( ae_fp_less_eq(tmp2,pivmin) )
56003 : {
56004 0 : itmp1 = 1;
56005 0 : tmp2 = ae_minreal(tmp2, -pivmin, _state);
56006 : }
56007 :
56008 : /*
56009 : * A series of compiler directives to defeat vectorization
56010 : * for the next loop
56011 : *
56012 : **$PL$ CMCHAR=' '
56013 : *CDIR$ NEXTSCALAR
56014 : *C$DIR SCALAR
56015 : *CDIR$ NEXT SCALAR
56016 : *CVD$L NOVECTOR
56017 : *CDEC$ NOVECTOR
56018 : *CVD$ NOVECTOR
56019 : **VDIR NOVECTOR
56020 : **VOCL LOOP,SCALAR
56021 : *CIBM PREFER SCALAR
56022 : **$PL$ CMCHAR='*'
56023 : */
56024 0 : for(j=2; j<=n; j++)
56025 : {
56026 0 : tmp2 = d->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp2-tmp1;
56027 0 : if( ae_fp_less_eq(tmp2,pivmin) )
56028 : {
56029 0 : itmp1 = itmp1+1;
56030 0 : tmp2 = ae_minreal(tmp2, -pivmin, _state);
56031 : }
56032 : }
56033 0 : if( ijob<=2 )
56034 : {
56035 :
56036 : /*
56037 : * IJOB=2: Choose all intervals containing eigenvalues.
56038 : *
56039 : * Insure that N(w) is monotone
56040 : */
56041 0 : itmp1 = ae_minint(nab->ptr.pp_int[ji][2], ae_maxint(nab->ptr.pp_int[ji][1], itmp1, _state), _state);
56042 :
56043 : /*
56044 : * Update the Queue -- add intervals if both halves
56045 : * contain eigenvalues.
56046 : */
56047 0 : if( itmp1==nab->ptr.pp_int[ji][2] )
56048 : {
56049 :
56050 : /*
56051 : * No eigenvalue in the upper interval:
56052 : * just use the lower interval.
56053 : */
56054 0 : ab->ptr.pp_double[ji][2] = tmp1;
56055 : }
56056 : else
56057 : {
56058 0 : if( itmp1==nab->ptr.pp_int[ji][1] )
56059 : {
56060 :
56061 : /*
56062 : * No eigenvalue in the lower interval:
56063 : * just use the upper interval.
56064 : */
56065 0 : ab->ptr.pp_double[ji][1] = tmp1;
56066 : }
56067 : else
56068 : {
56069 0 : if( klnew<mmax )
56070 : {
56071 :
56072 : /*
56073 : * Eigenvalue in both intervals -- add upper to queue.
56074 : */
56075 0 : klnew = klnew+1;
56076 0 : ab->ptr.pp_double[klnew][2] = ab->ptr.pp_double[ji][2];
56077 0 : nab->ptr.pp_int[klnew][2] = nab->ptr.pp_int[ji][2];
56078 0 : ab->ptr.pp_double[klnew][1] = tmp1;
56079 0 : nab->ptr.pp_int[klnew][1] = itmp1;
56080 0 : ab->ptr.pp_double[ji][2] = tmp1;
56081 0 : nab->ptr.pp_int[ji][2] = itmp1;
56082 : }
56083 : else
56084 : {
56085 0 : *info = mmax+1;
56086 0 : return;
56087 : }
56088 : }
56089 : }
56090 : }
56091 : else
56092 : {
56093 :
56094 : /*
56095 : * IJOB=3: Binary search. Keep only the interval
56096 : * containing w s.t. N(w) = NVAL
56097 : */
56098 0 : if( itmp1<=nval->ptr.p_int[ji] )
56099 : {
56100 0 : ab->ptr.pp_double[ji][1] = tmp1;
56101 0 : nab->ptr.pp_int[ji][1] = itmp1;
56102 : }
56103 0 : if( itmp1>=nval->ptr.p_int[ji] )
56104 : {
56105 0 : ab->ptr.pp_double[ji][2] = tmp1;
56106 0 : nab->ptr.pp_int[ji][2] = itmp1;
56107 : }
56108 : }
56109 : }
56110 0 : kl = klnew;
56111 :
56112 : /*
56113 : * Check for convergence
56114 : */
56115 0 : kfnew = kf;
56116 0 : for(ji=kf; ji<=kl; ji++)
56117 : {
56118 0 : tmp1 = ae_fabs(ab->ptr.pp_double[ji][2]-ab->ptr.pp_double[ji][1], _state);
56119 0 : tmp2 = ae_maxreal(ae_fabs(ab->ptr.pp_double[ji][2], _state), ae_fabs(ab->ptr.pp_double[ji][1], _state), _state);
56120 0 : if( ae_fp_less(tmp1,ae_maxreal(abstol, ae_maxreal(pivmin, reltol*tmp2, _state), _state))||nab->ptr.pp_int[ji][1]>=nab->ptr.pp_int[ji][2] )
56121 : {
56122 :
56123 : /*
56124 : * Converged -- Swap with position KFNEW,
56125 : * then increment KFNEW
56126 : */
56127 0 : if( ji>kfnew )
56128 : {
56129 0 : tmp1 = ab->ptr.pp_double[ji][1];
56130 0 : tmp2 = ab->ptr.pp_double[ji][2];
56131 0 : itmp1 = nab->ptr.pp_int[ji][1];
56132 0 : itmp2 = nab->ptr.pp_int[ji][2];
56133 0 : ab->ptr.pp_double[ji][1] = ab->ptr.pp_double[kfnew][1];
56134 0 : ab->ptr.pp_double[ji][2] = ab->ptr.pp_double[kfnew][2];
56135 0 : nab->ptr.pp_int[ji][1] = nab->ptr.pp_int[kfnew][1];
56136 0 : nab->ptr.pp_int[ji][2] = nab->ptr.pp_int[kfnew][2];
56137 0 : ab->ptr.pp_double[kfnew][1] = tmp1;
56138 0 : ab->ptr.pp_double[kfnew][2] = tmp2;
56139 0 : nab->ptr.pp_int[kfnew][1] = itmp1;
56140 0 : nab->ptr.pp_int[kfnew][2] = itmp2;
56141 0 : if( ijob==3 )
56142 : {
56143 0 : itmp1 = nval->ptr.p_int[ji];
56144 0 : nval->ptr.p_int[ji] = nval->ptr.p_int[kfnew];
56145 0 : nval->ptr.p_int[kfnew] = itmp1;
56146 : }
56147 : }
56148 0 : kfnew = kfnew+1;
56149 : }
56150 : }
56151 0 : kf = kfnew;
56152 :
56153 : /*
56154 : * Choose Midpoints
56155 : */
56156 0 : for(ji=kf; ji<=kl; ji++)
56157 : {
56158 0 : c->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[ji][2]);
56159 : }
56160 :
56161 : /*
56162 : * If no more intervals to refine, quit.
56163 : */
56164 0 : if( kf>kl )
56165 : {
56166 0 : break;
56167 : }
56168 : }
56169 :
56170 : /*
56171 : * Converged
56172 : */
56173 0 : *info = ae_maxint(kl+1-kf, 0, _state);
56174 0 : *mout = kl;
56175 : }
56176 :
56177 :
56178 : /*************************************************************************
56179 : Internal subroutine
56180 :
56181 : -- LAPACK routine (version 3.0) --
56182 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
56183 : Courant Institute, Argonne National Lab, and Rice University
56184 : June 30, 1999
56185 : *************************************************************************/
56186 0 : static void evd_rmatrixinternaltrevc(/* Real */ ae_matrix* t,
56187 : ae_int_t n,
56188 : ae_int_t side,
56189 : ae_int_t howmny,
56190 : /* Boolean */ ae_vector* vselect,
56191 : /* Real */ ae_matrix* vl,
56192 : /* Real */ ae_matrix* vr,
56193 : ae_int_t* m,
56194 : ae_int_t* info,
56195 : ae_state *_state)
56196 : {
56197 : ae_frame _frame_block;
56198 : ae_vector _vselect;
56199 : ae_int_t i;
56200 : ae_int_t j;
56201 : ae_matrix t1;
56202 : ae_matrix vl1;
56203 : ae_matrix vr1;
56204 : ae_vector vselect1;
56205 :
56206 0 : ae_frame_make(_state, &_frame_block);
56207 0 : memset(&_vselect, 0, sizeof(_vselect));
56208 0 : memset(&t1, 0, sizeof(t1));
56209 0 : memset(&vl1, 0, sizeof(vl1));
56210 0 : memset(&vr1, 0, sizeof(vr1));
56211 0 : memset(&vselect1, 0, sizeof(vselect1));
56212 0 : ae_vector_init_copy(&_vselect, vselect, _state, ae_true);
56213 0 : vselect = &_vselect;
56214 0 : *m = 0;
56215 0 : *info = 0;
56216 0 : ae_matrix_init(&t1, 0, 0, DT_REAL, _state, ae_true);
56217 0 : ae_matrix_init(&vl1, 0, 0, DT_REAL, _state, ae_true);
56218 0 : ae_matrix_init(&vr1, 0, 0, DT_REAL, _state, ae_true);
56219 0 : ae_vector_init(&vselect1, 0, DT_BOOL, _state, ae_true);
56220 :
56221 :
56222 : /*
56223 : * Allocate VL/VR, if needed
56224 : */
56225 0 : if( howmny==2||howmny==3 )
56226 : {
56227 0 : if( side==1||side==3 )
56228 : {
56229 0 : rmatrixsetlengthatleast(vr, n, n, _state);
56230 : }
56231 0 : if( side==2||side==3 )
56232 : {
56233 0 : rmatrixsetlengthatleast(vl, n, n, _state);
56234 : }
56235 : }
56236 :
56237 : /*
56238 : * Try to use MKL kernel
56239 : */
56240 0 : if( rmatrixinternaltrevcmkl(t, n, side, howmny, vl, vr, m, info, _state) )
56241 : {
56242 0 : ae_frame_leave(_state);
56243 0 : return;
56244 : }
56245 :
56246 : /*
56247 : * ALGLIB version
56248 : */
56249 0 : ae_matrix_set_length(&t1, n+1, n+1, _state);
56250 0 : for(i=0; i<=n-1; i++)
56251 : {
56252 0 : for(j=0; j<=n-1; j++)
56253 : {
56254 0 : t1.ptr.pp_double[i+1][j+1] = t->ptr.pp_double[i][j];
56255 : }
56256 : }
56257 0 : if( howmny==3 )
56258 : {
56259 0 : ae_vector_set_length(&vselect1, n+1, _state);
56260 0 : for(i=0; i<=n-1; i++)
56261 : {
56262 0 : vselect1.ptr.p_bool[1+i] = vselect->ptr.p_bool[i];
56263 : }
56264 : }
56265 0 : if( (side==2||side==3)&&howmny==1 )
56266 : {
56267 0 : ae_matrix_set_length(&vl1, n+1, n+1, _state);
56268 0 : for(i=0; i<=n-1; i++)
56269 : {
56270 0 : for(j=0; j<=n-1; j++)
56271 : {
56272 0 : vl1.ptr.pp_double[i+1][j+1] = vl->ptr.pp_double[i][j];
56273 : }
56274 : }
56275 : }
56276 0 : if( (side==1||side==3)&&howmny==1 )
56277 : {
56278 0 : ae_matrix_set_length(&vr1, n+1, n+1, _state);
56279 0 : for(i=0; i<=n-1; i++)
56280 : {
56281 0 : for(j=0; j<=n-1; j++)
56282 : {
56283 0 : vr1.ptr.pp_double[i+1][j+1] = vr->ptr.pp_double[i][j];
56284 : }
56285 : }
56286 : }
56287 0 : evd_internaltrevc(&t1, n, side, howmny, &vselect1, &vl1, &vr1, m, info, _state);
56288 0 : if( side!=1 )
56289 : {
56290 0 : rmatrixsetlengthatleast(vl, n, n, _state);
56291 0 : for(i=0; i<=n-1; i++)
56292 : {
56293 0 : for(j=0; j<=n-1; j++)
56294 : {
56295 0 : vl->ptr.pp_double[i][j] = vl1.ptr.pp_double[i+1][j+1];
56296 : }
56297 : }
56298 : }
56299 0 : if( side!=2 )
56300 : {
56301 0 : rmatrixsetlengthatleast(vr, n, n, _state);
56302 0 : for(i=0; i<=n-1; i++)
56303 : {
56304 0 : for(j=0; j<=n-1; j++)
56305 : {
56306 0 : vr->ptr.pp_double[i][j] = vr1.ptr.pp_double[i+1][j+1];
56307 : }
56308 : }
56309 : }
56310 0 : ae_frame_leave(_state);
56311 : }
56312 :
56313 :
56314 : /*************************************************************************
56315 : Internal subroutine
56316 :
56317 : -- LAPACK routine (version 3.0) --
56318 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
56319 : Courant Institute, Argonne National Lab, and Rice University
56320 : June 30, 1999
56321 : *************************************************************************/
56322 0 : static void evd_internaltrevc(/* Real */ ae_matrix* t,
56323 : ae_int_t n,
56324 : ae_int_t side,
56325 : ae_int_t howmny,
56326 : /* Boolean */ ae_vector* vselect,
56327 : /* Real */ ae_matrix* vl,
56328 : /* Real */ ae_matrix* vr,
56329 : ae_int_t* m,
56330 : ae_int_t* info,
56331 : ae_state *_state)
56332 : {
56333 : ae_frame _frame_block;
56334 : ae_vector _vselect;
56335 : ae_bool allv;
56336 : ae_bool bothv;
56337 : ae_bool leftv;
56338 : ae_bool over;
56339 : ae_bool pair;
56340 : ae_bool rightv;
56341 : ae_bool somev;
56342 : ae_int_t i;
56343 : ae_int_t ierr;
56344 : ae_int_t ii;
56345 : ae_int_t ip;
56346 : ae_int_t iis;
56347 : ae_int_t j;
56348 : ae_int_t j1;
56349 : ae_int_t j2;
56350 : ae_int_t jnxt;
56351 : ae_int_t k;
56352 : ae_int_t ki;
56353 : ae_int_t n2;
56354 : double beta;
56355 : double bignum;
56356 : double emax;
56357 : double rec;
56358 : double remax;
56359 : double scl;
56360 : double smin;
56361 : double smlnum;
56362 : double ulp;
56363 : double unfl;
56364 : double vcrit;
56365 : double vmax;
56366 : double wi;
56367 : double wr;
56368 : double xnorm;
56369 : ae_matrix x;
56370 : ae_vector work;
56371 : ae_vector temp;
56372 : ae_matrix temp11;
56373 : ae_matrix temp22;
56374 : ae_matrix temp11b;
56375 : ae_matrix temp21b;
56376 : ae_matrix temp12b;
56377 : ae_matrix temp22b;
56378 : ae_bool skipflag;
56379 : ae_int_t k1;
56380 : ae_int_t k2;
56381 : ae_int_t k3;
56382 : ae_int_t k4;
56383 : double vt;
56384 : ae_vector rswap4;
56385 : ae_vector zswap4;
56386 : ae_matrix ipivot44;
56387 : ae_vector civ4;
56388 : ae_vector crv4;
56389 :
56390 0 : ae_frame_make(_state, &_frame_block);
56391 0 : memset(&_vselect, 0, sizeof(_vselect));
56392 0 : memset(&x, 0, sizeof(x));
56393 0 : memset(&work, 0, sizeof(work));
56394 0 : memset(&temp, 0, sizeof(temp));
56395 0 : memset(&temp11, 0, sizeof(temp11));
56396 0 : memset(&temp22, 0, sizeof(temp22));
56397 0 : memset(&temp11b, 0, sizeof(temp11b));
56398 0 : memset(&temp21b, 0, sizeof(temp21b));
56399 0 : memset(&temp12b, 0, sizeof(temp12b));
56400 0 : memset(&temp22b, 0, sizeof(temp22b));
56401 0 : memset(&rswap4, 0, sizeof(rswap4));
56402 0 : memset(&zswap4, 0, sizeof(zswap4));
56403 0 : memset(&ipivot44, 0, sizeof(ipivot44));
56404 0 : memset(&civ4, 0, sizeof(civ4));
56405 0 : memset(&crv4, 0, sizeof(crv4));
56406 0 : ae_vector_init_copy(&_vselect, vselect, _state, ae_true);
56407 0 : vselect = &_vselect;
56408 0 : *m = 0;
56409 0 : *info = 0;
56410 0 : ae_matrix_init(&x, 0, 0, DT_REAL, _state, ae_true);
56411 0 : ae_vector_init(&work, 0, DT_REAL, _state, ae_true);
56412 0 : ae_vector_init(&temp, 0, DT_REAL, _state, ae_true);
56413 0 : ae_matrix_init(&temp11, 0, 0, DT_REAL, _state, ae_true);
56414 0 : ae_matrix_init(&temp22, 0, 0, DT_REAL, _state, ae_true);
56415 0 : ae_matrix_init(&temp11b, 0, 0, DT_REAL, _state, ae_true);
56416 0 : ae_matrix_init(&temp21b, 0, 0, DT_REAL, _state, ae_true);
56417 0 : ae_matrix_init(&temp12b, 0, 0, DT_REAL, _state, ae_true);
56418 0 : ae_matrix_init(&temp22b, 0, 0, DT_REAL, _state, ae_true);
56419 0 : ae_vector_init(&rswap4, 0, DT_BOOL, _state, ae_true);
56420 0 : ae_vector_init(&zswap4, 0, DT_BOOL, _state, ae_true);
56421 0 : ae_matrix_init(&ipivot44, 0, 0, DT_INT, _state, ae_true);
56422 0 : ae_vector_init(&civ4, 0, DT_REAL, _state, ae_true);
56423 0 : ae_vector_init(&crv4, 0, DT_REAL, _state, ae_true);
56424 :
56425 0 : ae_matrix_set_length(&x, 2+1, 2+1, _state);
56426 0 : ae_matrix_set_length(&temp11, 1+1, 1+1, _state);
56427 0 : ae_matrix_set_length(&temp11b, 1+1, 1+1, _state);
56428 0 : ae_matrix_set_length(&temp21b, 2+1, 1+1, _state);
56429 0 : ae_matrix_set_length(&temp12b, 1+1, 2+1, _state);
56430 0 : ae_matrix_set_length(&temp22b, 2+1, 2+1, _state);
56431 0 : ae_matrix_set_length(&temp22, 2+1, 2+1, _state);
56432 0 : ae_vector_set_length(&work, 3*n+1, _state);
56433 0 : ae_vector_set_length(&temp, n+1, _state);
56434 0 : ae_vector_set_length(&rswap4, 4+1, _state);
56435 0 : ae_vector_set_length(&zswap4, 4+1, _state);
56436 0 : ae_matrix_set_length(&ipivot44, 4+1, 4+1, _state);
56437 0 : ae_vector_set_length(&civ4, 4+1, _state);
56438 0 : ae_vector_set_length(&crv4, 4+1, _state);
56439 0 : if( howmny!=1 )
56440 : {
56441 0 : if( side==1||side==3 )
56442 : {
56443 0 : ae_matrix_set_length(vr, n+1, n+1, _state);
56444 : }
56445 0 : if( side==2||side==3 )
56446 : {
56447 0 : ae_matrix_set_length(vl, n+1, n+1, _state);
56448 : }
56449 : }
56450 :
56451 : /*
56452 : * Decode and test the input parameters
56453 : */
56454 0 : bothv = side==3;
56455 0 : rightv = side==1||bothv;
56456 0 : leftv = side==2||bothv;
56457 0 : allv = howmny==2;
56458 0 : over = howmny==1;
56459 0 : somev = howmny==3;
56460 0 : *info = 0;
56461 0 : if( n<0 )
56462 : {
56463 0 : *info = -2;
56464 0 : ae_frame_leave(_state);
56465 0 : return;
56466 : }
56467 0 : if( !rightv&&!leftv )
56468 : {
56469 0 : *info = -3;
56470 0 : ae_frame_leave(_state);
56471 0 : return;
56472 : }
56473 0 : if( (!allv&&!over)&&!somev )
56474 : {
56475 0 : *info = -4;
56476 0 : ae_frame_leave(_state);
56477 0 : return;
56478 : }
56479 :
56480 : /*
56481 : * Set M to the number of columns required to store the selected
56482 : * eigenvectors, standardize the array SELECT if necessary, and
56483 : * test MM.
56484 : */
56485 0 : if( somev )
56486 : {
56487 0 : *m = 0;
56488 0 : pair = ae_false;
56489 0 : for(j=1; j<=n; j++)
56490 : {
56491 0 : if( pair )
56492 : {
56493 0 : pair = ae_false;
56494 0 : vselect->ptr.p_bool[j] = ae_false;
56495 : }
56496 : else
56497 : {
56498 0 : if( j<n )
56499 : {
56500 0 : if( ae_fp_eq(t->ptr.pp_double[j+1][j],(double)(0)) )
56501 : {
56502 0 : if( vselect->ptr.p_bool[j] )
56503 : {
56504 0 : *m = *m+1;
56505 : }
56506 : }
56507 : else
56508 : {
56509 0 : pair = ae_true;
56510 0 : if( vselect->ptr.p_bool[j]||vselect->ptr.p_bool[j+1] )
56511 : {
56512 0 : vselect->ptr.p_bool[j] = ae_true;
56513 0 : *m = *m+2;
56514 : }
56515 : }
56516 : }
56517 : else
56518 : {
56519 0 : if( vselect->ptr.p_bool[n] )
56520 : {
56521 0 : *m = *m+1;
56522 : }
56523 : }
56524 : }
56525 : }
56526 : }
56527 : else
56528 : {
56529 0 : *m = n;
56530 : }
56531 :
56532 : /*
56533 : * Quick return if possible.
56534 : */
56535 0 : if( n==0 )
56536 : {
56537 0 : ae_frame_leave(_state);
56538 0 : return;
56539 : }
56540 :
56541 : /*
56542 : * Set the constants to control overflow.
56543 : */
56544 0 : unfl = ae_minrealnumber;
56545 0 : ulp = ae_machineepsilon;
56546 0 : smlnum = unfl*(n/ulp);
56547 0 : bignum = (1-ulp)/smlnum;
56548 :
56549 : /*
56550 : * Compute 1-norm of each column of strictly upper triangular
56551 : * part of T to control overflow in triangular solver.
56552 : */
56553 0 : work.ptr.p_double[1] = (double)(0);
56554 0 : for(j=2; j<=n; j++)
56555 : {
56556 0 : work.ptr.p_double[j] = (double)(0);
56557 0 : for(i=1; i<=j-1; i++)
56558 : {
56559 0 : work.ptr.p_double[j] = work.ptr.p_double[j]+ae_fabs(t->ptr.pp_double[i][j], _state);
56560 : }
56561 : }
56562 :
56563 : /*
56564 : * Index IP is used to specify the real or complex eigenvalue:
56565 : * IP = 0, real eigenvalue,
56566 : * 1, first of conjugate complex pair: (wr,wi)
56567 : * -1, second of conjugate complex pair: (wr,wi)
56568 : */
56569 0 : n2 = 2*n;
56570 0 : if( rightv )
56571 : {
56572 :
56573 : /*
56574 : * Compute right eigenvectors.
56575 : */
56576 0 : ip = 0;
56577 0 : iis = *m;
56578 0 : for(ki=n; ki>=1; ki--)
56579 : {
56580 0 : skipflag = ae_false;
56581 0 : if( ip==1 )
56582 : {
56583 0 : skipflag = ae_true;
56584 : }
56585 : else
56586 : {
56587 0 : if( ki!=1 )
56588 : {
56589 0 : if( ae_fp_neq(t->ptr.pp_double[ki][ki-1],(double)(0)) )
56590 : {
56591 0 : ip = -1;
56592 : }
56593 : }
56594 0 : if( somev )
56595 : {
56596 0 : if( ip==0 )
56597 : {
56598 0 : if( !vselect->ptr.p_bool[ki] )
56599 : {
56600 0 : skipflag = ae_true;
56601 : }
56602 : }
56603 : else
56604 : {
56605 0 : if( !vselect->ptr.p_bool[ki-1] )
56606 : {
56607 0 : skipflag = ae_true;
56608 : }
56609 : }
56610 : }
56611 : }
56612 0 : if( !skipflag )
56613 : {
56614 :
56615 : /*
56616 : * Compute the KI-th eigenvalue (WR,WI).
56617 : */
56618 0 : wr = t->ptr.pp_double[ki][ki];
56619 0 : wi = (double)(0);
56620 0 : if( ip!=0 )
56621 : {
56622 0 : wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki-1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki-1][ki], _state), _state);
56623 : }
56624 0 : smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state);
56625 0 : if( ip==0 )
56626 : {
56627 :
56628 : /*
56629 : * Real right eigenvector
56630 : */
56631 0 : work.ptr.p_double[ki+n] = (double)(1);
56632 :
56633 : /*
56634 : * Form right-hand side
56635 : */
56636 0 : for(k=1; k<=ki-1; k++)
56637 : {
56638 0 : work.ptr.p_double[k+n] = -t->ptr.pp_double[k][ki];
56639 : }
56640 :
56641 : /*
56642 : * Solve the upper quasi-triangular system:
56643 : * (T(1:KI-1,1:KI-1) - WR)*X = SCALE*WORK.
56644 : */
56645 0 : jnxt = ki-1;
56646 0 : for(j=ki-1; j>=1; j--)
56647 : {
56648 0 : if( j>jnxt )
56649 : {
56650 0 : continue;
56651 : }
56652 0 : j1 = j;
56653 0 : j2 = j;
56654 0 : jnxt = j-1;
56655 0 : if( j>1 )
56656 : {
56657 0 : if( ae_fp_neq(t->ptr.pp_double[j][j-1],(double)(0)) )
56658 : {
56659 0 : j1 = j-1;
56660 0 : jnxt = j-2;
56661 : }
56662 : }
56663 0 : if( j1==j2 )
56664 : {
56665 :
56666 : /*
56667 : * 1-by-1 diagonal block
56668 : */
56669 0 : temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
56670 0 : temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
56671 0 : evd_internalhsevdlaln2(ae_false, 1, 1, smin, (double)(1), &temp11, 1.0, 1.0, &temp11b, wr, 0.0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
56672 :
56673 : /*
56674 : * Scale X(1,1) to avoid overflow when updating
56675 : * the right-hand side.
56676 : */
56677 0 : if( ae_fp_greater(xnorm,(double)(1)) )
56678 : {
56679 0 : if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) )
56680 : {
56681 0 : x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm;
56682 0 : scl = scl/xnorm;
56683 : }
56684 : }
56685 :
56686 : /*
56687 : * Scale if necessary
56688 : */
56689 0 : if( ae_fp_neq(scl,(double)(1)) )
56690 : {
56691 0 : k1 = n+1;
56692 0 : k2 = n+ki;
56693 0 : ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl);
56694 : }
56695 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
56696 :
56697 : /*
56698 : * Update right-hand side
56699 : */
56700 0 : k1 = 1+n;
56701 0 : k2 = j-1+n;
56702 0 : k3 = j-1;
56703 0 : vt = -x.ptr.pp_double[1][1];
56704 0 : ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt);
56705 : }
56706 : else
56707 : {
56708 :
56709 : /*
56710 : * 2-by-2 diagonal block
56711 : */
56712 0 : temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1];
56713 0 : temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j];
56714 0 : temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1];
56715 0 : temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j];
56716 0 : temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n];
56717 0 : temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+n];
56718 0 : evd_internalhsevdlaln2(ae_false, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, (double)(0), &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
56719 :
56720 : /*
56721 : * Scale X(1,1) and X(2,1) to avoid overflow when
56722 : * updating the right-hand side.
56723 : */
56724 0 : if( ae_fp_greater(xnorm,(double)(1)) )
56725 : {
56726 0 : beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state);
56727 0 : if( ae_fp_greater(beta,bignum/xnorm) )
56728 : {
56729 0 : x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm;
56730 0 : x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]/xnorm;
56731 0 : scl = scl/xnorm;
56732 : }
56733 : }
56734 :
56735 : /*
56736 : * Scale if necessary
56737 : */
56738 0 : if( ae_fp_neq(scl,(double)(1)) )
56739 : {
56740 0 : k1 = 1+n;
56741 0 : k2 = ki+n;
56742 0 : ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl);
56743 : }
56744 0 : work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1];
56745 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[2][1];
56746 :
56747 : /*
56748 : * Update right-hand side
56749 : */
56750 0 : k1 = 1+n;
56751 0 : k2 = j-2+n;
56752 0 : k3 = j-2;
56753 0 : k4 = j-1;
56754 0 : vt = -x.ptr.pp_double[1][1];
56755 0 : ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][k4], t->stride, ae_v_len(k1,k2), vt);
56756 0 : vt = -x.ptr.pp_double[2][1];
56757 0 : ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt);
56758 : }
56759 : }
56760 :
56761 : /*
56762 : * Copy the vector x or Q*x to VR and normalize.
56763 : */
56764 0 : if( !over )
56765 : {
56766 0 : k1 = 1+n;
56767 0 : k2 = ki+n;
56768 0 : ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[k1], 1, ae_v_len(1,ki));
56769 0 : ii = columnidxabsmax(vr, 1, ki, iis, _state);
56770 0 : remax = 1/ae_fabs(vr->ptr.pp_double[ii][iis], _state);
56771 0 : ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax);
56772 0 : for(k=ki+1; k<=n; k++)
56773 : {
56774 0 : vr->ptr.pp_double[k][iis] = (double)(0);
56775 : }
56776 : }
56777 : else
56778 : {
56779 0 : if( ki>1 )
56780 : {
56781 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n));
56782 0 : matrixvectormultiply(vr, 1, n, 1, ki-1, ae_false, &work, 1+n, ki-1+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state);
56783 0 : ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
56784 : }
56785 0 : ii = columnidxabsmax(vr, 1, n, ki, _state);
56786 0 : remax = 1/ae_fabs(vr->ptr.pp_double[ii][ki], _state);
56787 0 : ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), remax);
56788 : }
56789 : }
56790 : else
56791 : {
56792 :
56793 : /*
56794 : * Complex right eigenvector.
56795 : *
56796 : * Initial solve
56797 : * [ (T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I* WI)]*X = 0.
56798 : * [ (T(KI,KI-1) T(KI,KI) ) ]
56799 : */
56800 0 : if( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki-1][ki], _state),ae_fabs(t->ptr.pp_double[ki][ki-1], _state)) )
56801 : {
56802 0 : work.ptr.p_double[ki-1+n] = (double)(1);
56803 0 : work.ptr.p_double[ki+n2] = wi/t->ptr.pp_double[ki-1][ki];
56804 : }
56805 : else
56806 : {
56807 0 : work.ptr.p_double[ki-1+n] = -wi/t->ptr.pp_double[ki][ki-1];
56808 0 : work.ptr.p_double[ki+n2] = (double)(1);
56809 : }
56810 0 : work.ptr.p_double[ki+n] = (double)(0);
56811 0 : work.ptr.p_double[ki-1+n2] = (double)(0);
56812 :
56813 : /*
56814 : * Form right-hand side
56815 : */
56816 0 : for(k=1; k<=ki-2; k++)
56817 : {
56818 0 : work.ptr.p_double[k+n] = -work.ptr.p_double[ki-1+n]*t->ptr.pp_double[k][ki-1];
56819 0 : work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+n2]*t->ptr.pp_double[k][ki];
56820 : }
56821 :
56822 : /*
56823 : * Solve upper quasi-triangular system:
56824 : * (T(1:KI-2,1:KI-2) - (WR+i*WI))*X = SCALE*(WORK+i*WORK2)
56825 : */
56826 0 : jnxt = ki-2;
56827 0 : for(j=ki-2; j>=1; j--)
56828 : {
56829 0 : if( j>jnxt )
56830 : {
56831 0 : continue;
56832 : }
56833 0 : j1 = j;
56834 0 : j2 = j;
56835 0 : jnxt = j-1;
56836 0 : if( j>1 )
56837 : {
56838 0 : if( ae_fp_neq(t->ptr.pp_double[j][j-1],(double)(0)) )
56839 : {
56840 0 : j1 = j-1;
56841 0 : jnxt = j-2;
56842 : }
56843 : }
56844 0 : if( j1==j2 )
56845 : {
56846 :
56847 : /*
56848 : * 1-by-1 diagonal block
56849 : */
56850 0 : temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
56851 0 : temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
56852 0 : temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n];
56853 0 : evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
56854 :
56855 : /*
56856 : * Scale X(1,1) and X(1,2) to avoid overflow when
56857 : * updating the right-hand side.
56858 : */
56859 0 : if( ae_fp_greater(xnorm,(double)(1)) )
56860 : {
56861 0 : if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) )
56862 : {
56863 0 : x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm;
56864 0 : x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]/xnorm;
56865 0 : scl = scl/xnorm;
56866 : }
56867 : }
56868 :
56869 : /*
56870 : * Scale if necessary
56871 : */
56872 0 : if( ae_fp_neq(scl,(double)(1)) )
56873 : {
56874 0 : k1 = 1+n;
56875 0 : k2 = ki+n;
56876 0 : ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl);
56877 0 : k1 = 1+n2;
56878 0 : k2 = ki+n2;
56879 0 : ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl);
56880 : }
56881 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
56882 0 : work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2];
56883 :
56884 : /*
56885 : * Update the right-hand side
56886 : */
56887 0 : k1 = 1+n;
56888 0 : k2 = j-1+n;
56889 0 : k3 = 1;
56890 0 : k4 = j-1;
56891 0 : vt = -x.ptr.pp_double[1][1];
56892 0 : ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt);
56893 0 : k1 = 1+n2;
56894 0 : k2 = j-1+n2;
56895 0 : k3 = 1;
56896 0 : k4 = j-1;
56897 0 : vt = -x.ptr.pp_double[1][2];
56898 0 : ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt);
56899 : }
56900 : else
56901 : {
56902 :
56903 : /*
56904 : * 2-by-2 diagonal block
56905 : */
56906 0 : temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1];
56907 0 : temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j];
56908 0 : temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1];
56909 0 : temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j];
56910 0 : temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n];
56911 0 : temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j-1+n+n];
56912 0 : temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+n];
56913 0 : temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+n+n];
56914 0 : evd_internalhsevdlaln2(ae_false, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
56915 :
56916 : /*
56917 : * Scale X to avoid overflow when updating
56918 : * the right-hand side.
56919 : */
56920 0 : if( ae_fp_greater(xnorm,(double)(1)) )
56921 : {
56922 0 : beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state);
56923 0 : if( ae_fp_greater(beta,bignum/xnorm) )
56924 : {
56925 0 : rec = 1/xnorm;
56926 0 : x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]*rec;
56927 0 : x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]*rec;
56928 0 : x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]*rec;
56929 0 : x.ptr.pp_double[2][2] = x.ptr.pp_double[2][2]*rec;
56930 0 : scl = scl*rec;
56931 : }
56932 : }
56933 :
56934 : /*
56935 : * Scale if necessary
56936 : */
56937 0 : if( ae_fp_neq(scl,(double)(1)) )
56938 : {
56939 0 : ae_v_muld(&work.ptr.p_double[1+n], 1, ae_v_len(1+n,ki+n), scl);
56940 0 : ae_v_muld(&work.ptr.p_double[1+n2], 1, ae_v_len(1+n2,ki+n2), scl);
56941 : }
56942 0 : work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1];
56943 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[2][1];
56944 0 : work.ptr.p_double[j-1+n2] = x.ptr.pp_double[1][2];
56945 0 : work.ptr.p_double[j+n2] = x.ptr.pp_double[2][2];
56946 :
56947 : /*
56948 : * Update the right-hand side
56949 : */
56950 0 : vt = -x.ptr.pp_double[1][1];
56951 0 : ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n+1,n+j-2), vt);
56952 0 : vt = -x.ptr.pp_double[2][1];
56953 0 : ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n+1,n+j-2), vt);
56954 0 : vt = -x.ptr.pp_double[1][2];
56955 0 : ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n2+1,n2+j-2), vt);
56956 0 : vt = -x.ptr.pp_double[2][2];
56957 0 : ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n2+1,n2+j-2), vt);
56958 : }
56959 : }
56960 :
56961 : /*
56962 : * Copy the vector x or Q*x to VR and normalize.
56963 : */
56964 0 : if( !over )
56965 : {
56966 0 : ae_v_move(&vr->ptr.pp_double[1][iis-1], vr->stride, &work.ptr.p_double[n+1], 1, ae_v_len(1,ki));
56967 0 : ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[n2+1], 1, ae_v_len(1,ki));
56968 0 : emax = (double)(0);
56969 0 : for(k=1; k<=ki; k++)
56970 : {
56971 0 : emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][iis-1], _state)+ae_fabs(vr->ptr.pp_double[k][iis], _state), _state);
56972 : }
56973 0 : remax = 1/emax;
56974 0 : ae_v_muld(&vr->ptr.pp_double[1][iis-1], vr->stride, ae_v_len(1,ki), remax);
56975 0 : ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax);
56976 0 : for(k=ki+1; k<=n; k++)
56977 : {
56978 0 : vr->ptr.pp_double[k][iis-1] = (double)(0);
56979 0 : vr->ptr.pp_double[k][iis] = (double)(0);
56980 : }
56981 : }
56982 : else
56983 : {
56984 0 : if( ki>2 )
56985 : {
56986 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n));
56987 0 : matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n, ki-2+n, 1.0, &temp, 1, n, work.ptr.p_double[ki-1+n], _state);
56988 0 : ae_v_move(&vr->ptr.pp_double[1][ki-1], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
56989 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n));
56990 0 : matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n2, ki-2+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+n2], _state);
56991 0 : ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
56992 : }
56993 : else
56994 : {
56995 0 : vt = work.ptr.p_double[ki-1+n];
56996 0 : ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), vt);
56997 0 : vt = work.ptr.p_double[ki+n2];
56998 0 : ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), vt);
56999 : }
57000 0 : emax = (double)(0);
57001 0 : for(k=1; k<=n; k++)
57002 : {
57003 0 : emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][ki-1], _state)+ae_fabs(vr->ptr.pp_double[k][ki], _state), _state);
57004 : }
57005 0 : remax = 1/emax;
57006 0 : ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), remax);
57007 0 : ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), remax);
57008 : }
57009 : }
57010 0 : iis = iis-1;
57011 0 : if( ip!=0 )
57012 : {
57013 0 : iis = iis-1;
57014 : }
57015 : }
57016 0 : if( ip==1 )
57017 : {
57018 0 : ip = 0;
57019 : }
57020 0 : if( ip==-1 )
57021 : {
57022 0 : ip = 1;
57023 : }
57024 : }
57025 : }
57026 0 : if( leftv )
57027 : {
57028 :
57029 : /*
57030 : * Compute left eigenvectors.
57031 : */
57032 0 : ip = 0;
57033 0 : iis = 1;
57034 0 : for(ki=1; ki<=n; ki++)
57035 : {
57036 0 : skipflag = ae_false;
57037 0 : if( ip==-1 )
57038 : {
57039 0 : skipflag = ae_true;
57040 : }
57041 : else
57042 : {
57043 0 : if( ki!=n )
57044 : {
57045 0 : if( ae_fp_neq(t->ptr.pp_double[ki+1][ki],(double)(0)) )
57046 : {
57047 0 : ip = 1;
57048 : }
57049 : }
57050 0 : if( somev )
57051 : {
57052 0 : if( !vselect->ptr.p_bool[ki] )
57053 : {
57054 0 : skipflag = ae_true;
57055 : }
57056 : }
57057 : }
57058 0 : if( !skipflag )
57059 : {
57060 :
57061 : /*
57062 : * Compute the KI-th eigenvalue (WR,WI).
57063 : */
57064 0 : wr = t->ptr.pp_double[ki][ki];
57065 0 : wi = (double)(0);
57066 0 : if( ip!=0 )
57067 : {
57068 0 : wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki+1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki+1][ki], _state), _state);
57069 : }
57070 0 : smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state);
57071 0 : if( ip==0 )
57072 : {
57073 :
57074 : /*
57075 : * Real left eigenvector.
57076 : */
57077 0 : work.ptr.p_double[ki+n] = (double)(1);
57078 :
57079 : /*
57080 : * Form right-hand side
57081 : */
57082 0 : for(k=ki+1; k<=n; k++)
57083 : {
57084 0 : work.ptr.p_double[k+n] = -t->ptr.pp_double[ki][k];
57085 : }
57086 :
57087 : /*
57088 : * Solve the quasi-triangular system:
57089 : * (T(KI+1:N,KI+1:N) - WR)'*X = SCALE*WORK
57090 : */
57091 0 : vmax = (double)(1);
57092 0 : vcrit = bignum;
57093 0 : jnxt = ki+1;
57094 0 : for(j=ki+1; j<=n; j++)
57095 : {
57096 0 : if( j<jnxt )
57097 : {
57098 0 : continue;
57099 : }
57100 0 : j1 = j;
57101 0 : j2 = j;
57102 0 : jnxt = j+1;
57103 0 : if( j<n )
57104 : {
57105 0 : if( ae_fp_neq(t->ptr.pp_double[j+1][j],(double)(0)) )
57106 : {
57107 0 : j2 = j+1;
57108 0 : jnxt = j+2;
57109 : }
57110 : }
57111 0 : if( j1==j2 )
57112 : {
57113 :
57114 : /*
57115 : * 1-by-1 diagonal block
57116 : *
57117 : * Scale if necessary to avoid overflow when forming
57118 : * the right-hand side.
57119 : */
57120 0 : if( ae_fp_greater(work.ptr.p_double[j],vcrit) )
57121 : {
57122 0 : rec = 1/vmax;
57123 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec);
57124 0 : vmax = (double)(1);
57125 0 : vcrit = bignum;
57126 : }
57127 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1));
57128 0 : work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt;
57129 :
57130 : /*
57131 : * Solve (T(J,J)-WR)'*X = WORK
57132 : */
57133 0 : temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
57134 0 : temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
57135 0 : evd_internalhsevdlaln2(ae_false, 1, 1, smin, 1.0, &temp11, 1.0, 1.0, &temp11b, wr, (double)(0), &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
57136 :
57137 : /*
57138 : * Scale if necessary
57139 : */
57140 0 : if( ae_fp_neq(scl,(double)(1)) )
57141 : {
57142 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl);
57143 : }
57144 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
57145 0 : vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), vmax, _state);
57146 0 : vcrit = bignum/vmax;
57147 : }
57148 : else
57149 : {
57150 :
57151 : /*
57152 : * 2-by-2 diagonal block
57153 : *
57154 : * Scale if necessary to avoid overflow when forming
57155 : * the right-hand side.
57156 : */
57157 0 : beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state);
57158 0 : if( ae_fp_greater(beta,vcrit) )
57159 : {
57160 0 : rec = 1/vmax;
57161 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec);
57162 0 : vmax = (double)(1);
57163 0 : vcrit = bignum;
57164 : }
57165 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1));
57166 0 : work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt;
57167 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j+1], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1));
57168 0 : work.ptr.p_double[j+1+n] = work.ptr.p_double[j+1+n]-vt;
57169 :
57170 : /*
57171 : * Solve
57172 : * [T(J,J)-WR T(J,J+1) ]'* X = SCALE*( WORK1 )
57173 : * [T(J+1,J) T(J+1,J+1)-WR] ( WORK2 )
57174 : */
57175 0 : temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
57176 0 : temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1];
57177 0 : temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j];
57178 0 : temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1];
57179 0 : temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
57180 0 : temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n];
57181 0 : evd_internalhsevdlaln2(ae_true, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, (double)(0), &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
57182 :
57183 : /*
57184 : * Scale if necessary
57185 : */
57186 0 : if( ae_fp_neq(scl,(double)(1)) )
57187 : {
57188 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl);
57189 : }
57190 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
57191 0 : work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1];
57192 0 : vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+1+n], _state), vmax, _state), _state);
57193 0 : vcrit = bignum/vmax;
57194 : }
57195 : }
57196 :
57197 : /*
57198 : * Copy the vector x or Q*x to VL and normalize.
57199 : */
57200 0 : if( !over )
57201 : {
57202 0 : ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n));
57203 0 : ii = columnidxabsmax(vl, ki, n, iis, _state);
57204 0 : remax = 1/ae_fabs(vl->ptr.pp_double[ii][iis], _state);
57205 0 : ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax);
57206 0 : for(k=1; k<=ki-1; k++)
57207 : {
57208 0 : vl->ptr.pp_double[k][iis] = (double)(0);
57209 : }
57210 : }
57211 : else
57212 : {
57213 0 : if( ki<n )
57214 : {
57215 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n));
57216 0 : matrixvectormultiply(vl, 1, n, ki+1, n, ae_false, &work, ki+1+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state);
57217 0 : ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
57218 : }
57219 0 : ii = columnidxabsmax(vl, 1, n, ki, _state);
57220 0 : remax = 1/ae_fabs(vl->ptr.pp_double[ii][ki], _state);
57221 0 : ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), remax);
57222 : }
57223 : }
57224 : else
57225 : {
57226 :
57227 : /*
57228 : * Complex left eigenvector.
57229 : *
57230 : * Initial solve:
57231 : * ((T(KI,KI) T(KI,KI+1) )' - (WR - I* WI))*X = 0.
57232 : * ((T(KI+1,KI) T(KI+1,KI+1)) )
57233 : */
57234 0 : if( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki][ki+1], _state),ae_fabs(t->ptr.pp_double[ki+1][ki], _state)) )
57235 : {
57236 0 : work.ptr.p_double[ki+n] = wi/t->ptr.pp_double[ki][ki+1];
57237 0 : work.ptr.p_double[ki+1+n2] = (double)(1);
57238 : }
57239 : else
57240 : {
57241 0 : work.ptr.p_double[ki+n] = (double)(1);
57242 0 : work.ptr.p_double[ki+1+n2] = -wi/t->ptr.pp_double[ki+1][ki];
57243 : }
57244 0 : work.ptr.p_double[ki+1+n] = (double)(0);
57245 0 : work.ptr.p_double[ki+n2] = (double)(0);
57246 :
57247 : /*
57248 : * Form right-hand side
57249 : */
57250 0 : for(k=ki+2; k<=n; k++)
57251 : {
57252 0 : work.ptr.p_double[k+n] = -work.ptr.p_double[ki+n]*t->ptr.pp_double[ki][k];
57253 0 : work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+1+n2]*t->ptr.pp_double[ki+1][k];
57254 : }
57255 :
57256 : /*
57257 : * Solve complex quasi-triangular system:
57258 : * ( T(KI+2,N:KI+2,N) - (WR-i*WI) )*X = WORK1+i*WORK2
57259 : */
57260 0 : vmax = (double)(1);
57261 0 : vcrit = bignum;
57262 0 : jnxt = ki+2;
57263 0 : for(j=ki+2; j<=n; j++)
57264 : {
57265 0 : if( j<jnxt )
57266 : {
57267 0 : continue;
57268 : }
57269 0 : j1 = j;
57270 0 : j2 = j;
57271 0 : jnxt = j+1;
57272 0 : if( j<n )
57273 : {
57274 0 : if( ae_fp_neq(t->ptr.pp_double[j+1][j],(double)(0)) )
57275 : {
57276 0 : j2 = j+1;
57277 0 : jnxt = j+2;
57278 : }
57279 : }
57280 0 : if( j1==j2 )
57281 : {
57282 :
57283 : /*
57284 : * 1-by-1 diagonal block
57285 : *
57286 : * Scale if necessary to avoid overflow when
57287 : * forming the right-hand side elements.
57288 : */
57289 0 : if( ae_fp_greater(work.ptr.p_double[j],vcrit) )
57290 : {
57291 0 : rec = 1/vmax;
57292 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec);
57293 0 : ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec);
57294 0 : vmax = (double)(1);
57295 0 : vcrit = bignum;
57296 : }
57297 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1));
57298 0 : work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt;
57299 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1));
57300 0 : work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt;
57301 :
57302 : /*
57303 : * Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2
57304 : */
57305 0 : temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
57306 0 : temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
57307 0 : temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n];
57308 0 : evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
57309 :
57310 : /*
57311 : * Scale if necessary
57312 : */
57313 0 : if( ae_fp_neq(scl,(double)(1)) )
57314 : {
57315 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl);
57316 0 : ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl);
57317 : }
57318 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
57319 0 : work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2];
57320 0 : vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+n2], _state), vmax, _state), _state);
57321 0 : vcrit = bignum/vmax;
57322 : }
57323 : else
57324 : {
57325 :
57326 : /*
57327 : * 2-by-2 diagonal block
57328 : *
57329 : * Scale if necessary to avoid overflow when forming
57330 : * the right-hand side elements.
57331 : */
57332 0 : beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state);
57333 0 : if( ae_fp_greater(beta,vcrit) )
57334 : {
57335 0 : rec = 1/vmax;
57336 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec);
57337 0 : ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec);
57338 0 : vmax = (double)(1);
57339 0 : vcrit = bignum;
57340 : }
57341 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1));
57342 0 : work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt;
57343 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1));
57344 0 : work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt;
57345 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1));
57346 0 : work.ptr.p_double[j+1+n] = work.ptr.p_double[j+1+n]-vt;
57347 0 : vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1));
57348 0 : work.ptr.p_double[j+1+n2] = work.ptr.p_double[j+1+n2]-vt;
57349 :
57350 : /*
57351 : * Solve 2-by-2 complex linear equation
57352 : * ([T(j,j) T(j,j+1) ]'-(wr-i*wi)*I)*X = SCALE*B
57353 : * ([T(j+1,j) T(j+1,j+1)] )
57354 : */
57355 0 : temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j][j];
57356 0 : temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1];
57357 0 : temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j];
57358 0 : temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1];
57359 0 : temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j+n];
57360 0 : temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n];
57361 0 : temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n];
57362 0 : temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+1+n+n];
57363 0 : evd_internalhsevdlaln2(ae_true, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state);
57364 :
57365 : /*
57366 : * Scale if necessary
57367 : */
57368 0 : if( ae_fp_neq(scl,(double)(1)) )
57369 : {
57370 0 : ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl);
57371 0 : ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl);
57372 : }
57373 0 : work.ptr.p_double[j+n] = x.ptr.pp_double[1][1];
57374 0 : work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2];
57375 0 : work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1];
57376 0 : work.ptr.p_double[j+1+n2] = x.ptr.pp_double[2][2];
57377 0 : vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][1], _state), vmax, _state);
57378 0 : vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][2], _state), vmax, _state);
57379 0 : vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][1], _state), vmax, _state);
57380 0 : vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][2], _state), vmax, _state);
57381 0 : vcrit = bignum/vmax;
57382 : }
57383 : }
57384 :
57385 : /*
57386 : * Copy the vector x or Q*x to VL and normalize.
57387 : */
57388 0 : if( !over )
57389 : {
57390 0 : ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n));
57391 0 : ae_v_move(&vl->ptr.pp_double[ki][iis+1], vl->stride, &work.ptr.p_double[ki+n2], 1, ae_v_len(ki,n));
57392 0 : emax = (double)(0);
57393 0 : for(k=ki; k<=n; k++)
57394 : {
57395 0 : emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][iis], _state)+ae_fabs(vl->ptr.pp_double[k][iis+1], _state), _state);
57396 : }
57397 0 : remax = 1/emax;
57398 0 : ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax);
57399 0 : ae_v_muld(&vl->ptr.pp_double[ki][iis+1], vl->stride, ae_v_len(ki,n), remax);
57400 0 : for(k=1; k<=ki-1; k++)
57401 : {
57402 0 : vl->ptr.pp_double[k][iis] = (double)(0);
57403 0 : vl->ptr.pp_double[k][iis+1] = (double)(0);
57404 : }
57405 : }
57406 : else
57407 : {
57408 0 : if( ki<n-1 )
57409 : {
57410 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n));
57411 0 : matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state);
57412 0 : ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
57413 0 : ae_v_move(&temp.ptr.p_double[1], 1, &vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n));
57414 0 : matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n2, n+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+1+n2], _state);
57415 0 : ae_v_move(&vl->ptr.pp_double[1][ki+1], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n));
57416 : }
57417 : else
57418 : {
57419 0 : vt = work.ptr.p_double[ki+n];
57420 0 : ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), vt);
57421 0 : vt = work.ptr.p_double[ki+1+n2];
57422 0 : ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), vt);
57423 : }
57424 0 : emax = (double)(0);
57425 0 : for(k=1; k<=n; k++)
57426 : {
57427 0 : emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][ki], _state)+ae_fabs(vl->ptr.pp_double[k][ki+1], _state), _state);
57428 : }
57429 0 : remax = 1/emax;
57430 0 : ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), remax);
57431 0 : ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), remax);
57432 : }
57433 : }
57434 0 : iis = iis+1;
57435 0 : if( ip!=0 )
57436 : {
57437 0 : iis = iis+1;
57438 : }
57439 : }
57440 0 : if( ip==-1 )
57441 : {
57442 0 : ip = 0;
57443 : }
57444 0 : if( ip==1 )
57445 : {
57446 0 : ip = -1;
57447 : }
57448 : }
57449 : }
57450 0 : ae_frame_leave(_state);
57451 : }
57452 :
57453 :
57454 : /*************************************************************************
57455 : DLALN2 solves a system of the form (ca A - w D ) X = s B
57456 : or (ca A' - w D) X = s B with possible scaling ("s") and
57457 : perturbation of A. (A' means A-transpose.)
57458 :
57459 : A is an NA x NA real matrix, ca is a real scalar, D is an NA x NA
57460 : real diagonal matrix, w is a real or complex value, and X and B are
57461 : NA x 1 matrices -- real if w is real, complex if w is complex. NA
57462 : may be 1 or 2.
57463 :
57464 : If w is complex, X and B are represented as NA x 2 matrices,
57465 : the first column of each being the real part and the second
57466 : being the imaginary part.
57467 :
57468 : "s" is a scaling factor (.LE. 1), computed by DLALN2, which is
57469 : so chosen that X can be computed without overflow. X is further
57470 : scaled if necessary to assure that norm(ca A - w D)*norm(X) is less
57471 : than overflow.
57472 :
57473 : If both singular values of (ca A - w D) are less than SMIN,
57474 : SMIN*identity will be used instead of (ca A - w D). If only one
57475 : singular value is less than SMIN, one element of (ca A - w D) will be
57476 : perturbed enough to make the smallest singular value roughly SMIN.
57477 : If both singular values are at least SMIN, (ca A - w D) will not be
57478 : perturbed. In any case, the perturbation will be at most some small
57479 : multiple of max( SMIN, ulp*norm(ca A - w D) ). The singular values
57480 : are computed by infinity-norm approximations, and thus will only be
57481 : correct to a factor of 2 or so.
57482 :
57483 : Note: all input quantities are assumed to be smaller than overflow
57484 : by a reasonable factor. (See BIGNUM.)
57485 :
57486 : -- LAPACK auxiliary routine (version 3.0) --
57487 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
57488 : Courant Institute, Argonne National Lab, and Rice University
57489 : October 31, 1992
57490 : *************************************************************************/
57491 0 : static void evd_internalhsevdlaln2(ae_bool ltrans,
57492 : ae_int_t na,
57493 : ae_int_t nw,
57494 : double smin,
57495 : double ca,
57496 : /* Real */ ae_matrix* a,
57497 : double d1,
57498 : double d2,
57499 : /* Real */ ae_matrix* b,
57500 : double wr,
57501 : double wi,
57502 : /* Boolean */ ae_vector* rswap4,
57503 : /* Boolean */ ae_vector* zswap4,
57504 : /* Integer */ ae_matrix* ipivot44,
57505 : /* Real */ ae_vector* civ4,
57506 : /* Real */ ae_vector* crv4,
57507 : /* Real */ ae_matrix* x,
57508 : double* scl,
57509 : double* xnorm,
57510 : ae_int_t* info,
57511 : ae_state *_state)
57512 : {
57513 : ae_int_t icmax;
57514 : ae_int_t j;
57515 : double bbnd;
57516 : double bi1;
57517 : double bi2;
57518 : double bignum;
57519 : double bnorm;
57520 : double br1;
57521 : double br2;
57522 : double ci21;
57523 : double ci22;
57524 : double cmax;
57525 : double cnorm;
57526 : double cr21;
57527 : double cr22;
57528 : double csi;
57529 : double csr;
57530 : double li21;
57531 : double lr21;
57532 : double smini;
57533 : double smlnum;
57534 : double temp;
57535 : double u22abs;
57536 : double ui11;
57537 : double ui11r;
57538 : double ui12;
57539 : double ui12s;
57540 : double ui22;
57541 : double ur11;
57542 : double ur11r;
57543 : double ur12;
57544 : double ur12s;
57545 : double ur22;
57546 : double xi1;
57547 : double xi2;
57548 : double xr1;
57549 : double xr2;
57550 : double tmp1;
57551 : double tmp2;
57552 :
57553 0 : *scl = 0;
57554 0 : *xnorm = 0;
57555 0 : *info = 0;
57556 :
57557 0 : zswap4->ptr.p_bool[1] = ae_false;
57558 0 : zswap4->ptr.p_bool[2] = ae_false;
57559 0 : zswap4->ptr.p_bool[3] = ae_true;
57560 0 : zswap4->ptr.p_bool[4] = ae_true;
57561 0 : rswap4->ptr.p_bool[1] = ae_false;
57562 0 : rswap4->ptr.p_bool[2] = ae_true;
57563 0 : rswap4->ptr.p_bool[3] = ae_false;
57564 0 : rswap4->ptr.p_bool[4] = ae_true;
57565 0 : ipivot44->ptr.pp_int[1][1] = 1;
57566 0 : ipivot44->ptr.pp_int[2][1] = 2;
57567 0 : ipivot44->ptr.pp_int[3][1] = 3;
57568 0 : ipivot44->ptr.pp_int[4][1] = 4;
57569 0 : ipivot44->ptr.pp_int[1][2] = 2;
57570 0 : ipivot44->ptr.pp_int[2][2] = 1;
57571 0 : ipivot44->ptr.pp_int[3][2] = 4;
57572 0 : ipivot44->ptr.pp_int[4][2] = 3;
57573 0 : ipivot44->ptr.pp_int[1][3] = 3;
57574 0 : ipivot44->ptr.pp_int[2][3] = 4;
57575 0 : ipivot44->ptr.pp_int[3][3] = 1;
57576 0 : ipivot44->ptr.pp_int[4][3] = 2;
57577 0 : ipivot44->ptr.pp_int[1][4] = 4;
57578 0 : ipivot44->ptr.pp_int[2][4] = 3;
57579 0 : ipivot44->ptr.pp_int[3][4] = 2;
57580 0 : ipivot44->ptr.pp_int[4][4] = 1;
57581 0 : smlnum = 2*ae_minrealnumber;
57582 0 : bignum = 1/smlnum;
57583 0 : smini = ae_maxreal(smin, smlnum, _state);
57584 :
57585 : /*
57586 : * Don't check for input errors
57587 : */
57588 0 : *info = 0;
57589 :
57590 : /*
57591 : * Standard Initializations
57592 : */
57593 0 : *scl = (double)(1);
57594 0 : if( na==1 )
57595 : {
57596 :
57597 : /*
57598 : * 1 x 1 (i.e., scalar) system C X = B
57599 : */
57600 0 : if( nw==1 )
57601 : {
57602 :
57603 : /*
57604 : * Real 1x1 system.
57605 : *
57606 : * C = ca A - w D
57607 : */
57608 0 : csr = ca*a->ptr.pp_double[1][1]-wr*d1;
57609 0 : cnorm = ae_fabs(csr, _state);
57610 :
57611 : /*
57612 : * If | C | < SMINI, use C = SMINI
57613 : */
57614 0 : if( ae_fp_less(cnorm,smini) )
57615 : {
57616 0 : csr = smini;
57617 0 : cnorm = smini;
57618 0 : *info = 1;
57619 : }
57620 :
57621 : /*
57622 : * Check scaling for X = B / C
57623 : */
57624 0 : bnorm = ae_fabs(b->ptr.pp_double[1][1], _state);
57625 0 : if( ae_fp_less(cnorm,(double)(1))&&ae_fp_greater(bnorm,(double)(1)) )
57626 : {
57627 0 : if( ae_fp_greater(bnorm,bignum*cnorm) )
57628 : {
57629 0 : *scl = 1/bnorm;
57630 : }
57631 : }
57632 :
57633 : /*
57634 : * Compute X
57635 : */
57636 0 : x->ptr.pp_double[1][1] = b->ptr.pp_double[1][1]*(*scl)/csr;
57637 0 : *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state);
57638 : }
57639 : else
57640 : {
57641 :
57642 : /*
57643 : * Complex 1x1 system (w is complex)
57644 : *
57645 : * C = ca A - w D
57646 : */
57647 0 : csr = ca*a->ptr.pp_double[1][1]-wr*d1;
57648 0 : csi = -wi*d1;
57649 0 : cnorm = ae_fabs(csr, _state)+ae_fabs(csi, _state);
57650 :
57651 : /*
57652 : * If | C | < SMINI, use C = SMINI
57653 : */
57654 0 : if( ae_fp_less(cnorm,smini) )
57655 : {
57656 0 : csr = smini;
57657 0 : csi = (double)(0);
57658 0 : cnorm = smini;
57659 0 : *info = 1;
57660 : }
57661 :
57662 : /*
57663 : * Check scaling for X = B / C
57664 : */
57665 0 : bnorm = ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state);
57666 0 : if( ae_fp_less(cnorm,(double)(1))&&ae_fp_greater(bnorm,(double)(1)) )
57667 : {
57668 0 : if( ae_fp_greater(bnorm,bignum*cnorm) )
57669 : {
57670 0 : *scl = 1/bnorm;
57671 : }
57672 : }
57673 :
57674 : /*
57675 : * Compute X
57676 : */
57677 0 : evd_internalhsevdladiv(*scl*b->ptr.pp_double[1][1], *scl*b->ptr.pp_double[1][2], csr, csi, &tmp1, &tmp2, _state);
57678 0 : x->ptr.pp_double[1][1] = tmp1;
57679 0 : x->ptr.pp_double[1][2] = tmp2;
57680 0 : *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state)+ae_fabs(x->ptr.pp_double[1][2], _state);
57681 : }
57682 : }
57683 : else
57684 : {
57685 :
57686 : /*
57687 : * 2x2 System
57688 : *
57689 : * Compute the real part of C = ca A - w D (or ca A' - w D )
57690 : */
57691 0 : crv4->ptr.p_double[1+0] = ca*a->ptr.pp_double[1][1]-wr*d1;
57692 0 : crv4->ptr.p_double[2+2] = ca*a->ptr.pp_double[2][2]-wr*d2;
57693 0 : if( ltrans )
57694 : {
57695 0 : crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[2][1];
57696 0 : crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[1][2];
57697 : }
57698 : else
57699 : {
57700 0 : crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[2][1];
57701 0 : crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[1][2];
57702 : }
57703 0 : if( nw==1 )
57704 : {
57705 :
57706 : /*
57707 : * Real 2x2 system (w is real)
57708 : *
57709 : * Find the largest element in C
57710 : */
57711 0 : cmax = (double)(0);
57712 0 : icmax = 0;
57713 0 : for(j=1; j<=4; j++)
57714 : {
57715 0 : if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state),cmax) )
57716 : {
57717 0 : cmax = ae_fabs(crv4->ptr.p_double[j], _state);
57718 0 : icmax = j;
57719 : }
57720 : }
57721 :
57722 : /*
57723 : * If norm(C) < SMINI, use SMINI*identity.
57724 : */
57725 0 : if( ae_fp_less(cmax,smini) )
57726 : {
57727 0 : bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state), ae_fabs(b->ptr.pp_double[2][1], _state), _state);
57728 0 : if( ae_fp_less(smini,(double)(1))&&ae_fp_greater(bnorm,(double)(1)) )
57729 : {
57730 0 : if( ae_fp_greater(bnorm,bignum*smini) )
57731 : {
57732 0 : *scl = 1/bnorm;
57733 : }
57734 : }
57735 0 : temp = *scl/smini;
57736 0 : x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1];
57737 0 : x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1];
57738 0 : *xnorm = temp*bnorm;
57739 0 : *info = 1;
57740 0 : return;
57741 : }
57742 :
57743 : /*
57744 : * Gaussian elimination with complete pivoting.
57745 : */
57746 0 : ur11 = crv4->ptr.p_double[icmax];
57747 0 : cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]];
57748 0 : ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]];
57749 0 : cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]];
57750 0 : ur11r = 1/ur11;
57751 0 : lr21 = ur11r*cr21;
57752 0 : ur22 = cr22-ur12*lr21;
57753 :
57754 : /*
57755 : * If smaller pivot < SMINI, use SMINI
57756 : */
57757 0 : if( ae_fp_less(ae_fabs(ur22, _state),smini) )
57758 : {
57759 0 : ur22 = smini;
57760 0 : *info = 1;
57761 : }
57762 0 : if( rswap4->ptr.p_bool[icmax] )
57763 : {
57764 0 : br1 = b->ptr.pp_double[2][1];
57765 0 : br2 = b->ptr.pp_double[1][1];
57766 : }
57767 : else
57768 : {
57769 0 : br1 = b->ptr.pp_double[1][1];
57770 0 : br2 = b->ptr.pp_double[2][1];
57771 : }
57772 0 : br2 = br2-lr21*br1;
57773 0 : bbnd = ae_maxreal(ae_fabs(br1*(ur22*ur11r), _state), ae_fabs(br2, _state), _state);
57774 0 : if( ae_fp_greater(bbnd,(double)(1))&&ae_fp_less(ae_fabs(ur22, _state),(double)(1)) )
57775 : {
57776 0 : if( ae_fp_greater_eq(bbnd,bignum*ae_fabs(ur22, _state)) )
57777 : {
57778 0 : *scl = 1/bbnd;
57779 : }
57780 : }
57781 0 : xr2 = br2*(*scl)/ur22;
57782 0 : xr1 = *scl*br1*ur11r-xr2*(ur11r*ur12);
57783 0 : if( zswap4->ptr.p_bool[icmax] )
57784 : {
57785 0 : x->ptr.pp_double[1][1] = xr2;
57786 0 : x->ptr.pp_double[2][1] = xr1;
57787 : }
57788 : else
57789 : {
57790 0 : x->ptr.pp_double[1][1] = xr1;
57791 0 : x->ptr.pp_double[2][1] = xr2;
57792 : }
57793 0 : *xnorm = ae_maxreal(ae_fabs(xr1, _state), ae_fabs(xr2, _state), _state);
57794 :
57795 : /*
57796 : * Further scaling if norm(A) norm(X) > overflow
57797 : */
57798 0 : if( ae_fp_greater(*xnorm,(double)(1))&&ae_fp_greater(cmax,(double)(1)) )
57799 : {
57800 0 : if( ae_fp_greater(*xnorm,bignum/cmax) )
57801 : {
57802 0 : temp = cmax/bignum;
57803 0 : x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1];
57804 0 : x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1];
57805 0 : *xnorm = temp*(*xnorm);
57806 0 : *scl = temp*(*scl);
57807 : }
57808 : }
57809 : }
57810 : else
57811 : {
57812 :
57813 : /*
57814 : * Complex 2x2 system (w is complex)
57815 : *
57816 : * Find the largest element in C
57817 : */
57818 0 : civ4->ptr.p_double[1+0] = -wi*d1;
57819 0 : civ4->ptr.p_double[2+0] = (double)(0);
57820 0 : civ4->ptr.p_double[1+2] = (double)(0);
57821 0 : civ4->ptr.p_double[2+2] = -wi*d2;
57822 0 : cmax = (double)(0);
57823 0 : icmax = 0;
57824 0 : for(j=1; j<=4; j++)
57825 : {
57826 0 : if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state),cmax) )
57827 : {
57828 0 : cmax = ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state);
57829 0 : icmax = j;
57830 : }
57831 : }
57832 :
57833 : /*
57834 : * If norm(C) < SMINI, use SMINI*identity.
57835 : */
57836 0 : if( ae_fp_less(cmax,smini) )
57837 : {
57838 0 : bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state), ae_fabs(b->ptr.pp_double[2][1], _state)+ae_fabs(b->ptr.pp_double[2][2], _state), _state);
57839 0 : if( ae_fp_less(smini,(double)(1))&&ae_fp_greater(bnorm,(double)(1)) )
57840 : {
57841 0 : if( ae_fp_greater(bnorm,bignum*smini) )
57842 : {
57843 0 : *scl = 1/bnorm;
57844 : }
57845 : }
57846 0 : temp = *scl/smini;
57847 0 : x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1];
57848 0 : x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1];
57849 0 : x->ptr.pp_double[1][2] = temp*b->ptr.pp_double[1][2];
57850 0 : x->ptr.pp_double[2][2] = temp*b->ptr.pp_double[2][2];
57851 0 : *xnorm = temp*bnorm;
57852 0 : *info = 1;
57853 0 : return;
57854 : }
57855 :
57856 : /*
57857 : * Gaussian elimination with complete pivoting.
57858 : */
57859 0 : ur11 = crv4->ptr.p_double[icmax];
57860 0 : ui11 = civ4->ptr.p_double[icmax];
57861 0 : cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]];
57862 0 : ci21 = civ4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]];
57863 0 : ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]];
57864 0 : ui12 = civ4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]];
57865 0 : cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]];
57866 0 : ci22 = civ4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]];
57867 0 : if( icmax==1||icmax==4 )
57868 : {
57869 :
57870 : /*
57871 : * Code when off-diagonals of pivoted C are real
57872 : */
57873 0 : if( ae_fp_greater(ae_fabs(ur11, _state),ae_fabs(ui11, _state)) )
57874 : {
57875 0 : temp = ui11/ur11;
57876 0 : ur11r = 1/(ur11*(1+ae_sqr(temp, _state)));
57877 0 : ui11r = -temp*ur11r;
57878 : }
57879 : else
57880 : {
57881 0 : temp = ur11/ui11;
57882 0 : ui11r = -1/(ui11*(1+ae_sqr(temp, _state)));
57883 0 : ur11r = -temp*ui11r;
57884 : }
57885 0 : lr21 = cr21*ur11r;
57886 0 : li21 = cr21*ui11r;
57887 0 : ur12s = ur12*ur11r;
57888 0 : ui12s = ur12*ui11r;
57889 0 : ur22 = cr22-ur12*lr21;
57890 0 : ui22 = ci22-ur12*li21;
57891 : }
57892 : else
57893 : {
57894 :
57895 : /*
57896 : * Code when diagonals of pivoted C are real
57897 : */
57898 0 : ur11r = 1/ur11;
57899 0 : ui11r = (double)(0);
57900 0 : lr21 = cr21*ur11r;
57901 0 : li21 = ci21*ur11r;
57902 0 : ur12s = ur12*ur11r;
57903 0 : ui12s = ui12*ur11r;
57904 0 : ur22 = cr22-ur12*lr21+ui12*li21;
57905 0 : ui22 = -ur12*li21-ui12*lr21;
57906 : }
57907 0 : u22abs = ae_fabs(ur22, _state)+ae_fabs(ui22, _state);
57908 :
57909 : /*
57910 : * If smaller pivot < SMINI, use SMINI
57911 : */
57912 0 : if( ae_fp_less(u22abs,smini) )
57913 : {
57914 0 : ur22 = smini;
57915 0 : ui22 = (double)(0);
57916 0 : *info = 1;
57917 : }
57918 0 : if( rswap4->ptr.p_bool[icmax] )
57919 : {
57920 0 : br2 = b->ptr.pp_double[1][1];
57921 0 : br1 = b->ptr.pp_double[2][1];
57922 0 : bi2 = b->ptr.pp_double[1][2];
57923 0 : bi1 = b->ptr.pp_double[2][2];
57924 : }
57925 : else
57926 : {
57927 0 : br1 = b->ptr.pp_double[1][1];
57928 0 : br2 = b->ptr.pp_double[2][1];
57929 0 : bi1 = b->ptr.pp_double[1][2];
57930 0 : bi2 = b->ptr.pp_double[2][2];
57931 : }
57932 0 : br2 = br2-lr21*br1+li21*bi1;
57933 0 : bi2 = bi2-li21*br1-lr21*bi1;
57934 0 : bbnd = ae_maxreal((ae_fabs(br1, _state)+ae_fabs(bi1, _state))*(u22abs*(ae_fabs(ur11r, _state)+ae_fabs(ui11r, _state))), ae_fabs(br2, _state)+ae_fabs(bi2, _state), _state);
57935 0 : if( ae_fp_greater(bbnd,(double)(1))&&ae_fp_less(u22abs,(double)(1)) )
57936 : {
57937 0 : if( ae_fp_greater_eq(bbnd,bignum*u22abs) )
57938 : {
57939 0 : *scl = 1/bbnd;
57940 0 : br1 = *scl*br1;
57941 0 : bi1 = *scl*bi1;
57942 0 : br2 = *scl*br2;
57943 0 : bi2 = *scl*bi2;
57944 : }
57945 : }
57946 0 : evd_internalhsevdladiv(br2, bi2, ur22, ui22, &xr2, &xi2, _state);
57947 0 : xr1 = ur11r*br1-ui11r*bi1-ur12s*xr2+ui12s*xi2;
57948 0 : xi1 = ui11r*br1+ur11r*bi1-ui12s*xr2-ur12s*xi2;
57949 0 : if( zswap4->ptr.p_bool[icmax] )
57950 : {
57951 0 : x->ptr.pp_double[1][1] = xr2;
57952 0 : x->ptr.pp_double[2][1] = xr1;
57953 0 : x->ptr.pp_double[1][2] = xi2;
57954 0 : x->ptr.pp_double[2][2] = xi1;
57955 : }
57956 : else
57957 : {
57958 0 : x->ptr.pp_double[1][1] = xr1;
57959 0 : x->ptr.pp_double[2][1] = xr2;
57960 0 : x->ptr.pp_double[1][2] = xi1;
57961 0 : x->ptr.pp_double[2][2] = xi2;
57962 : }
57963 0 : *xnorm = ae_maxreal(ae_fabs(xr1, _state)+ae_fabs(xi1, _state), ae_fabs(xr2, _state)+ae_fabs(xi2, _state), _state);
57964 :
57965 : /*
57966 : * Further scaling if norm(A) norm(X) > overflow
57967 : */
57968 0 : if( ae_fp_greater(*xnorm,(double)(1))&&ae_fp_greater(cmax,(double)(1)) )
57969 : {
57970 0 : if( ae_fp_greater(*xnorm,bignum/cmax) )
57971 : {
57972 0 : temp = cmax/bignum;
57973 0 : x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1];
57974 0 : x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1];
57975 0 : x->ptr.pp_double[1][2] = temp*x->ptr.pp_double[1][2];
57976 0 : x->ptr.pp_double[2][2] = temp*x->ptr.pp_double[2][2];
57977 0 : *xnorm = temp*(*xnorm);
57978 0 : *scl = temp*(*scl);
57979 : }
57980 : }
57981 : }
57982 : }
57983 : }
57984 :
57985 :
57986 : /*************************************************************************
57987 : performs complex division in real arithmetic
57988 :
57989 : a + i*b
57990 : p + i*q = ---------
57991 : c + i*d
57992 :
57993 : The algorithm is due to Robert L. Smith and can be found
57994 : in D. Knuth, The art of Computer Programming, Vol.2, p.195
57995 :
57996 : -- LAPACK auxiliary routine (version 3.0) --
57997 : Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
57998 : Courant Institute, Argonne National Lab, and Rice University
57999 : October 31, 1992
58000 : *************************************************************************/
58001 0 : static void evd_internalhsevdladiv(double a,
58002 : double b,
58003 : double c,
58004 : double d,
58005 : double* p,
58006 : double* q,
58007 : ae_state *_state)
58008 : {
58009 : double e;
58010 : double f;
58011 :
58012 0 : *p = 0;
58013 0 : *q = 0;
58014 :
58015 0 : if( ae_fp_less(ae_fabs(d, _state),ae_fabs(c, _state)) )
58016 : {
58017 0 : e = d/c;
58018 0 : f = c+d*e;
58019 0 : *p = (a+b*e)/f;
58020 0 : *q = (b-a*e)/f;
58021 : }
58022 : else
58023 : {
58024 0 : e = c/d;
58025 0 : f = d+c*e;
58026 0 : *p = (b+a*e)/f;
58027 0 : *q = (-a+b*e)/f;
58028 : }
58029 0 : }
58030 :
58031 :
58032 0 : void _eigsubspacestate_init(void* _p, ae_state *_state, ae_bool make_automatic)
58033 : {
58034 0 : eigsubspacestate *p = (eigsubspacestate*)_p;
58035 0 : ae_touch_ptr((void*)p);
58036 0 : _hqrndstate_init(&p->rs, _state, make_automatic);
58037 0 : ae_vector_init(&p->tau, 0, DT_REAL, _state, make_automatic);
58038 0 : ae_matrix_init(&p->q0, 0, 0, DT_REAL, _state, make_automatic);
58039 0 : ae_matrix_init(&p->qcur, 0, 0, DT_REAL, _state, make_automatic);
58040 0 : ae_matrix_init(&p->qnew, 0, 0, DT_REAL, _state, make_automatic);
58041 0 : ae_matrix_init(&p->znew, 0, 0, DT_REAL, _state, make_automatic);
58042 0 : ae_matrix_init(&p->r, 0, 0, DT_REAL, _state, make_automatic);
58043 0 : ae_matrix_init(&p->rz, 0, 0, DT_REAL, _state, make_automatic);
58044 0 : ae_matrix_init(&p->tz, 0, 0, DT_REAL, _state, make_automatic);
58045 0 : ae_matrix_init(&p->rq, 0, 0, DT_REAL, _state, make_automatic);
58046 0 : ae_matrix_init(&p->dummy, 0, 0, DT_REAL, _state, make_automatic);
58047 0 : ae_vector_init(&p->rw, 0, DT_REAL, _state, make_automatic);
58048 0 : ae_vector_init(&p->tw, 0, DT_REAL, _state, make_automatic);
58049 0 : ae_vector_init(&p->wcur, 0, DT_REAL, _state, make_automatic);
58050 0 : ae_vector_init(&p->wprev, 0, DT_REAL, _state, make_automatic);
58051 0 : ae_vector_init(&p->wrank, 0, DT_REAL, _state, make_automatic);
58052 0 : _apbuffers_init(&p->buf, _state, make_automatic);
58053 0 : ae_matrix_init(&p->x, 0, 0, DT_REAL, _state, make_automatic);
58054 0 : ae_matrix_init(&p->ax, 0, 0, DT_REAL, _state, make_automatic);
58055 0 : _rcommstate_init(&p->rstate, _state, make_automatic);
58056 0 : }
58057 :
58058 :
58059 0 : void _eigsubspacestate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
58060 : {
58061 0 : eigsubspacestate *dst = (eigsubspacestate*)_dst;
58062 0 : eigsubspacestate *src = (eigsubspacestate*)_src;
58063 0 : dst->n = src->n;
58064 0 : dst->k = src->k;
58065 0 : dst->nwork = src->nwork;
58066 0 : dst->maxits = src->maxits;
58067 0 : dst->eps = src->eps;
58068 0 : dst->eigenvectorsneeded = src->eigenvectorsneeded;
58069 0 : dst->matrixtype = src->matrixtype;
58070 0 : dst->usewarmstart = src->usewarmstart;
58071 0 : dst->firstcall = src->firstcall;
58072 0 : _hqrndstate_init_copy(&dst->rs, &src->rs, _state, make_automatic);
58073 0 : dst->running = src->running;
58074 0 : ae_vector_init_copy(&dst->tau, &src->tau, _state, make_automatic);
58075 0 : ae_matrix_init_copy(&dst->q0, &src->q0, _state, make_automatic);
58076 0 : ae_matrix_init_copy(&dst->qcur, &src->qcur, _state, make_automatic);
58077 0 : ae_matrix_init_copy(&dst->qnew, &src->qnew, _state, make_automatic);
58078 0 : ae_matrix_init_copy(&dst->znew, &src->znew, _state, make_automatic);
58079 0 : ae_matrix_init_copy(&dst->r, &src->r, _state, make_automatic);
58080 0 : ae_matrix_init_copy(&dst->rz, &src->rz, _state, make_automatic);
58081 0 : ae_matrix_init_copy(&dst->tz, &src->tz, _state, make_automatic);
58082 0 : ae_matrix_init_copy(&dst->rq, &src->rq, _state, make_automatic);
58083 0 : ae_matrix_init_copy(&dst->dummy, &src->dummy, _state, make_automatic);
58084 0 : ae_vector_init_copy(&dst->rw, &src->rw, _state, make_automatic);
58085 0 : ae_vector_init_copy(&dst->tw, &src->tw, _state, make_automatic);
58086 0 : ae_vector_init_copy(&dst->wcur, &src->wcur, _state, make_automatic);
58087 0 : ae_vector_init_copy(&dst->wprev, &src->wprev, _state, make_automatic);
58088 0 : ae_vector_init_copy(&dst->wrank, &src->wrank, _state, make_automatic);
58089 0 : _apbuffers_init_copy(&dst->buf, &src->buf, _state, make_automatic);
58090 0 : ae_matrix_init_copy(&dst->x, &src->x, _state, make_automatic);
58091 0 : ae_matrix_init_copy(&dst->ax, &src->ax, _state, make_automatic);
58092 0 : dst->requesttype = src->requesttype;
58093 0 : dst->requestsize = src->requestsize;
58094 0 : dst->repiterationscount = src->repiterationscount;
58095 0 : _rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic);
58096 0 : }
58097 :
58098 :
58099 0 : void _eigsubspacestate_clear(void* _p)
58100 : {
58101 0 : eigsubspacestate *p = (eigsubspacestate*)_p;
58102 0 : ae_touch_ptr((void*)p);
58103 0 : _hqrndstate_clear(&p->rs);
58104 0 : ae_vector_clear(&p->tau);
58105 0 : ae_matrix_clear(&p->q0);
58106 0 : ae_matrix_clear(&p->qcur);
58107 0 : ae_matrix_clear(&p->qnew);
58108 0 : ae_matrix_clear(&p->znew);
58109 0 : ae_matrix_clear(&p->r);
58110 0 : ae_matrix_clear(&p->rz);
58111 0 : ae_matrix_clear(&p->tz);
58112 0 : ae_matrix_clear(&p->rq);
58113 0 : ae_matrix_clear(&p->dummy);
58114 0 : ae_vector_clear(&p->rw);
58115 0 : ae_vector_clear(&p->tw);
58116 0 : ae_vector_clear(&p->wcur);
58117 0 : ae_vector_clear(&p->wprev);
58118 0 : ae_vector_clear(&p->wrank);
58119 0 : _apbuffers_clear(&p->buf);
58120 0 : ae_matrix_clear(&p->x);
58121 0 : ae_matrix_clear(&p->ax);
58122 0 : _rcommstate_clear(&p->rstate);
58123 0 : }
58124 :
58125 :
58126 0 : void _eigsubspacestate_destroy(void* _p)
58127 : {
58128 0 : eigsubspacestate *p = (eigsubspacestate*)_p;
58129 0 : ae_touch_ptr((void*)p);
58130 0 : _hqrndstate_destroy(&p->rs);
58131 0 : ae_vector_destroy(&p->tau);
58132 0 : ae_matrix_destroy(&p->q0);
58133 0 : ae_matrix_destroy(&p->qcur);
58134 0 : ae_matrix_destroy(&p->qnew);
58135 0 : ae_matrix_destroy(&p->znew);
58136 0 : ae_matrix_destroy(&p->r);
58137 0 : ae_matrix_destroy(&p->rz);
58138 0 : ae_matrix_destroy(&p->tz);
58139 0 : ae_matrix_destroy(&p->rq);
58140 0 : ae_matrix_destroy(&p->dummy);
58141 0 : ae_vector_destroy(&p->rw);
58142 0 : ae_vector_destroy(&p->tw);
58143 0 : ae_vector_destroy(&p->wcur);
58144 0 : ae_vector_destroy(&p->wprev);
58145 0 : ae_vector_destroy(&p->wrank);
58146 0 : _apbuffers_destroy(&p->buf);
58147 0 : ae_matrix_destroy(&p->x);
58148 0 : ae_matrix_destroy(&p->ax);
58149 0 : _rcommstate_destroy(&p->rstate);
58150 0 : }
58151 :
58152 :
58153 0 : void _eigsubspacereport_init(void* _p, ae_state *_state, ae_bool make_automatic)
58154 : {
58155 0 : eigsubspacereport *p = (eigsubspacereport*)_p;
58156 0 : ae_touch_ptr((void*)p);
58157 0 : }
58158 :
58159 :
58160 0 : void _eigsubspacereport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic)
58161 : {
58162 0 : eigsubspacereport *dst = (eigsubspacereport*)_dst;
58163 0 : eigsubspacereport *src = (eigsubspacereport*)_src;
58164 0 : dst->iterationscount = src->iterationscount;
58165 0 : }
58166 :
58167 :
58168 0 : void _eigsubspacereport_clear(void* _p)
58169 : {
58170 0 : eigsubspacereport *p = (eigsubspacereport*)_p;
58171 0 : ae_touch_ptr((void*)p);
58172 0 : }
58173 :
58174 :
58175 0 : void _eigsubspacereport_destroy(void* _p)
58176 : {
58177 0 : eigsubspacereport *p = (eigsubspacereport*)_p;
58178 0 : ae_touch_ptr((void*)p);
58179 0 : }
58180 :
58181 :
58182 : #endif
58183 : #if defined(AE_COMPILE_SCHUR) || !defined(AE_PARTIAL_BUILD)
58184 :
58185 :
58186 : /*************************************************************************
58187 : Subroutine performing the Schur decomposition of a general matrix by using
58188 : the QR algorithm with multiple shifts.
58189 :
58190 : COMMERCIAL EDITION OF ALGLIB:
58191 :
58192 : ! Commercial version of ALGLIB includes one important improvement of
58193 : ! this function, which can be used from C++ and C#:
58194 : ! * Intel MKL support (lightweight Intel MKL is shipped with ALGLIB)
58195 : !
58196 : ! Intel MKL gives approximately constant (with respect to number of
58197 : ! worker threads) acceleration factor which depends on CPU being used,
58198 : ! problem size and "baseline" ALGLIB edition which is used for
58199 : ! comparison.
58200 : !
58201 : ! Multithreaded acceleration is NOT supported for this function.
58202 : !
58203 : ! We recommend you to read 'Working with commercial version' section of
58204 : ! ALGLIB Reference Manual in order to find out how to use performance-
58205 : ! related features provided by commercial edition of ALGLIB.
58206 :
58207 : The source matrix A is represented as S'*A*S = T, where S is an orthogonal
58208 : matrix (Schur vectors), T - upper quasi-triangular matrix (with blocks of
58209 : sizes 1x1 and 2x2 on the main diagonal).
58210 :
58211 : Input parameters:
58212 : A - matrix to be decomposed.
58213 : Array whose indexes range within [0..N-1, 0..N-1].
58214 : N - size of A, N>=0.
58215 :
58216 :
58217 : Output parameters:
58218 : A - contains matrix T.
58219 : Array whose indexes range within [0..N-1, 0..N-1].
58220 : S - contains Schur vectors.
58221 : Array whose indexes range within [0..N-1, 0..N-1].
58222 :
58223 : Note 1:
58224 : The block structure of matrix T can be easily recognized: since all
58225 : the elements below the blocks are zeros, the elements a[i+1,i] which
58226 : are equal to 0 show the block border.
58227 :
58228 : Note 2:
58229 : The algorithm performance depends on the value of the internal parameter
58230 : NS of the InternalSchurDecomposition subroutine which defines the number
58231 : of shifts in the QR algorithm (similarly to the block width in block-matrix
58232 : algorithms in linear algebra). If you require maximum performance on
58233 : your machine, it is recommended to adjust this parameter manually.
58234 :
58235 : Result:
58236 : True,
58237 : if the algorithm has converged and parameters A and S contain the result.
58238 : False,
58239 : if the algorithm has not converged.
58240 :
58241 : Algorithm implemented on the basis of the DHSEQR subroutine (LAPACK 3.0 library).
58242 : *************************************************************************/
58243 0 : ae_bool rmatrixschur(/* Real */ ae_matrix* a,
58244 : ae_int_t n,
58245 : /* Real */ ae_matrix* s,
58246 : ae_state *_state)
58247 : {
58248 : ae_frame _frame_block;
58249 : ae_vector tau;
58250 : ae_vector wi;
58251 : ae_vector wr;
58252 : ae_int_t info;
58253 : ae_bool result;
58254 :
58255 0 : ae_frame_make(_state, &_frame_block);
58256 0 : memset(&tau, 0, sizeof(tau));
58257 0 : memset(&wi, 0, sizeof(wi));
58258 0 : memset(&wr, 0, sizeof(wr));
58259 0 : ae_matrix_clear(s);
58260 0 : ae_vector_init(&tau, 0, DT_REAL, _state, ae_true);
58261 0 : ae_vector_init(&wi, 0, DT_REAL, _state, ae_true);
58262 0 : ae_vector_init(&wr, 0, DT_REAL, _state, ae_true);
58263 :
58264 :
58265 : /*
58266 : * Upper Hessenberg form of the 0-based matrix
58267 : */
58268 0 : rmatrixhessenberg(a, n, &tau, _state);
58269 0 : rmatrixhessenbergunpackq(a, n, &tau, s, _state);
58270 :
58271 : /*
58272 : * Schur decomposition
58273 : */
58274 0 : rmatrixinternalschurdecomposition(a, n, 1, 1, &wr, &wi, s, &info, _state);
58275 0 : result = info==0;
58276 0 : ae_frame_leave(_state);
58277 0 : return result;
58278 : }
58279 :
58280 :
58281 : #endif
58282 : #if defined(AE_COMPILE_SPDGEVD) || !defined(AE_PARTIAL_BUILD)
58283 :
58284 :
58285 : /*************************************************************************
58286 : Algorithm for solving the following generalized symmetric positive-definite
58287 : eigenproblem:
58288 : A*x = lambda*B*x (1) or
58289 : A*B*x = lambda*x (2) or
58290 : B*A*x = lambda*x (3).
58291 : where A is a symmetric matrix, B - symmetric positive-definite matrix.
58292 : The problem is solved by reducing it to an ordinary symmetric eigenvalue
58293 : problem.
58294 :
58295 : Input parameters:
58296 : A - symmetric matrix which is given by its upper or lower
58297 : triangular part.
58298 : Array whose indexes range within [0..N-1, 0..N-1].
58299 : N - size of matrices A and B.
58300 : IsUpperA - storage format of matrix A.
58301 : B - symmetric positive-definite matrix which is given by
58302 : its upper or lower triangular part.
58303 : Array whose indexes range within [0..N-1, 0..N-1].
58304 : IsUpperB - storage format of matrix B.
58305 : ZNeeded - if ZNeeded is equal to:
58306 : * 0, the eigenvectors are not returned;
58307 : * 1, the eigenvectors are returned.
58308 : ProblemType - if ProblemType is equal to:
58309 : * 1, the following problem is solved: A*x = lambda*B*x;
58310 : * 2, the following problem is solved: A*B*x = lambda*x;
58311 : * 3, the following problem is solved: B*A*x = lambda*x.
58312 :
58313 : Output parameters:
58314 : D - eigenvalues in ascending order.
58315 : Array whose index ranges within [0..N-1].
58316 : Z - if ZNeeded is equal to:
58317 : * 0, Z hasn't changed;
58318 : * 1, Z contains eigenvectors.
58319 : Array whose indexes range within [0..N-1, 0..N-1].
58320 : The eigenvectors are stored in matrix columns. It should
58321 : be noted that the eigenvectors in such problems do not
58322 : form an orthogonal system.
58323 :
58324 : Result:
58325 : True, if the problem was solved successfully.
58326 : False, if the error occurred during the Cholesky decomposition of matrix
58327 : B (the matrix isn't positive-definite) or during the work of the iterative
58328 : algorithm for solving the symmetric eigenproblem.
58329 :
58330 : See also the GeneralizedSymmetricDefiniteEVDReduce subroutine.
58331 :
58332 : -- ALGLIB --
58333 : Copyright 1.28.2006 by Bochkanov Sergey
58334 : *************************************************************************/
58335 0 : ae_bool smatrixgevd(/* Real */ ae_matrix* a,
58336 : ae_int_t n,
58337 : ae_bool isuppera,
58338 : /* Real */ ae_matrix* b,
58339 : ae_bool isupperb,
58340 : ae_int_t zneeded,
58341 : ae_int_t problemtype,
58342 : /* Real */ ae_vector* d,
58343 : /* Real */ ae_matrix* z,
58344 : ae_state *_state)
58345 : {
58346 : ae_frame _frame_block;
58347 : ae_matrix _a;
58348 : ae_matrix r;
58349 : ae_matrix t;
58350 : ae_bool isupperr;
58351 : ae_int_t j1;
58352 : ae_int_t j2;
58353 : ae_int_t j1inc;
58354 : ae_int_t j2inc;
58355 : ae_int_t i;
58356 : ae_int_t j;
58357 : double v;
58358 : ae_bool result;
58359 :
58360 0 : ae_frame_make(_state, &_frame_block);
58361 0 : memset(&_a, 0, sizeof(_a));
58362 0 : memset(&r, 0, sizeof(r));
58363 0 : memset(&t, 0, sizeof(t));
58364 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
58365 0 : a = &_a;
58366 0 : ae_vector_clear(d);
58367 0 : ae_matrix_clear(z);
58368 0 : ae_matrix_init(&r, 0, 0, DT_REAL, _state, ae_true);
58369 0 : ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true);
58370 :
58371 :
58372 : /*
58373 : * Reduce and solve
58374 : */
58375 0 : result = smatrixgevdreduce(a, n, isuppera, b, isupperb, problemtype, &r, &isupperr, _state);
58376 0 : if( !result )
58377 : {
58378 0 : ae_frame_leave(_state);
58379 0 : return result;
58380 : }
58381 0 : result = smatrixevd(a, n, zneeded, isuppera, d, &t, _state);
58382 0 : if( !result )
58383 : {
58384 0 : ae_frame_leave(_state);
58385 0 : return result;
58386 : }
58387 :
58388 : /*
58389 : * Transform eigenvectors if needed
58390 : */
58391 0 : if( zneeded!=0 )
58392 : {
58393 :
58394 : /*
58395 : * fill Z with zeros
58396 : */
58397 0 : ae_matrix_set_length(z, n-1+1, n-1+1, _state);
58398 0 : for(j=0; j<=n-1; j++)
58399 : {
58400 0 : z->ptr.pp_double[0][j] = 0.0;
58401 : }
58402 0 : for(i=1; i<=n-1; i++)
58403 : {
58404 0 : ae_v_move(&z->ptr.pp_double[i][0], 1, &z->ptr.pp_double[0][0], 1, ae_v_len(0,n-1));
58405 : }
58406 :
58407 : /*
58408 : * Setup R properties
58409 : */
58410 0 : if( isupperr )
58411 : {
58412 0 : j1 = 0;
58413 0 : j2 = n-1;
58414 0 : j1inc = 1;
58415 0 : j2inc = 0;
58416 : }
58417 : else
58418 : {
58419 0 : j1 = 0;
58420 0 : j2 = 0;
58421 0 : j1inc = 0;
58422 0 : j2inc = 1;
58423 : }
58424 :
58425 : /*
58426 : * Calculate R*Z
58427 : */
58428 0 : for(i=0; i<=n-1; i++)
58429 : {
58430 0 : for(j=j1; j<=j2; j++)
58431 : {
58432 0 : v = r.ptr.pp_double[i][j];
58433 0 : ae_v_addd(&z->ptr.pp_double[i][0], 1, &t.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), v);
58434 : }
58435 0 : j1 = j1+j1inc;
58436 0 : j2 = j2+j2inc;
58437 : }
58438 : }
58439 0 : ae_frame_leave(_state);
58440 0 : return result;
58441 : }
58442 :
58443 :
58444 : /*************************************************************************
58445 : Algorithm for reduction of the following generalized symmetric positive-
58446 : definite eigenvalue problem:
58447 : A*x = lambda*B*x (1) or
58448 : A*B*x = lambda*x (2) or
58449 : B*A*x = lambda*x (3)
58450 : to the symmetric eigenvalues problem C*y = lambda*y (eigenvalues of this and
58451 : the given problems are the same, and the eigenvectors of the given problem
58452 : could be obtained by multiplying the obtained eigenvectors by the
58453 : transformation matrix x = R*y).
58454 :
58455 : Here A is a symmetric matrix, B - symmetric positive-definite matrix.
58456 :
58457 : Input parameters:
58458 : A - symmetric matrix which is given by its upper or lower
58459 : triangular part.
58460 : Array whose indexes range within [0..N-1, 0..N-1].
58461 : N - size of matrices A and B.
58462 : IsUpperA - storage format of matrix A.
58463 : B - symmetric positive-definite matrix which is given by
58464 : its upper or lower triangular part.
58465 : Array whose indexes range within [0..N-1, 0..N-1].
58466 : IsUpperB - storage format of matrix B.
58467 : ProblemType - if ProblemType is equal to:
58468 : * 1, the following problem is solved: A*x = lambda*B*x;
58469 : * 2, the following problem is solved: A*B*x = lambda*x;
58470 : * 3, the following problem is solved: B*A*x = lambda*x.
58471 :
58472 : Output parameters:
58473 : A - symmetric matrix which is given by its upper or lower
58474 : triangle depending on IsUpperA. Contains matrix C.
58475 : Array whose indexes range within [0..N-1, 0..N-1].
58476 : R - upper triangular or low triangular transformation matrix
58477 : which is used to obtain the eigenvectors of a given problem
58478 : as the product of eigenvectors of C (from the right) and
58479 : matrix R (from the left). If the matrix is upper
58480 : triangular, the elements below the main diagonal
58481 : are equal to 0 (and vice versa). Thus, we can perform
58482 : the multiplication without taking into account the
58483 : internal structure (which is an easier though less
58484 : effective way).
58485 : Array whose indexes range within [0..N-1, 0..N-1].
58486 : IsUpperR - type of matrix R (upper or lower triangular).
58487 :
58488 : Result:
58489 : True, if the problem was reduced successfully.
58490 : False, if the error occurred during the Cholesky decomposition of
58491 : matrix B (the matrix is not positive-definite).
58492 :
58493 : -- ALGLIB --
58494 : Copyright 1.28.2006 by Bochkanov Sergey
58495 : *************************************************************************/
58496 0 : ae_bool smatrixgevdreduce(/* Real */ ae_matrix* a,
58497 : ae_int_t n,
58498 : ae_bool isuppera,
58499 : /* Real */ ae_matrix* b,
58500 : ae_bool isupperb,
58501 : ae_int_t problemtype,
58502 : /* Real */ ae_matrix* r,
58503 : ae_bool* isupperr,
58504 : ae_state *_state)
58505 : {
58506 : ae_frame _frame_block;
58507 : ae_matrix t;
58508 : ae_vector w1;
58509 : ae_vector w2;
58510 : ae_vector w3;
58511 : ae_int_t i;
58512 : ae_int_t j;
58513 : double v;
58514 : matinvreport rep;
58515 : ae_int_t info;
58516 : ae_bool result;
58517 :
58518 0 : ae_frame_make(_state, &_frame_block);
58519 0 : memset(&t, 0, sizeof(t));
58520 0 : memset(&w1, 0, sizeof(w1));
58521 0 : memset(&w2, 0, sizeof(w2));
58522 0 : memset(&w3, 0, sizeof(w3));
58523 0 : memset(&rep, 0, sizeof(rep));
58524 0 : ae_matrix_clear(r);
58525 0 : *isupperr = ae_false;
58526 0 : ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true);
58527 0 : ae_vector_init(&w1, 0, DT_REAL, _state, ae_true);
58528 0 : ae_vector_init(&w2, 0, DT_REAL, _state, ae_true);
58529 0 : ae_vector_init(&w3, 0, DT_REAL, _state, ae_true);
58530 0 : _matinvreport_init(&rep, _state, ae_true);
58531 :
58532 0 : ae_assert(n>0, "SMatrixGEVDReduce: N<=0!", _state);
58533 0 : ae_assert((problemtype==1||problemtype==2)||problemtype==3, "SMatrixGEVDReduce: incorrect ProblemType!", _state);
58534 0 : result = ae_true;
58535 :
58536 : /*
58537 : * Problem 1: A*x = lambda*B*x
58538 : *
58539 : * Reducing to:
58540 : * C*y = lambda*y
58541 : * C = L^(-1) * A * L^(-T)
58542 : * x = L^(-T) * y
58543 : */
58544 0 : if( problemtype==1 )
58545 : {
58546 :
58547 : /*
58548 : * Factorize B in T: B = LL'
58549 : */
58550 0 : ae_matrix_set_length(&t, n-1+1, n-1+1, _state);
58551 0 : if( isupperb )
58552 : {
58553 0 : for(i=0; i<=n-1; i++)
58554 : {
58555 0 : ae_v_move(&t.ptr.pp_double[i][i], t.stride, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1));
58556 : }
58557 : }
58558 : else
58559 : {
58560 0 : for(i=0; i<=n-1; i++)
58561 : {
58562 0 : ae_v_move(&t.ptr.pp_double[i][0], 1, &b->ptr.pp_double[i][0], 1, ae_v_len(0,i));
58563 : }
58564 : }
58565 0 : if( !spdmatrixcholesky(&t, n, ae_false, _state) )
58566 : {
58567 0 : result = ae_false;
58568 0 : ae_frame_leave(_state);
58569 0 : return result;
58570 : }
58571 :
58572 : /*
58573 : * Invert L in T
58574 : */
58575 0 : rmatrixtrinverse(&t, n, ae_false, ae_false, &info, &rep, _state);
58576 0 : if( info<=0 )
58577 : {
58578 0 : result = ae_false;
58579 0 : ae_frame_leave(_state);
58580 0 : return result;
58581 : }
58582 :
58583 : /*
58584 : * Build L^(-1) * A * L^(-T) in R
58585 : */
58586 0 : ae_vector_set_length(&w1, n+1, _state);
58587 0 : ae_vector_set_length(&w2, n+1, _state);
58588 0 : ae_matrix_set_length(r, n-1+1, n-1+1, _state);
58589 0 : for(j=1; j<=n; j++)
58590 : {
58591 :
58592 : /*
58593 : * Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T))
58594 : */
58595 0 : ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][0], 1, ae_v_len(1,j));
58596 0 : symmetricmatrixvectormultiply(a, isuppera, 0, j-1, &w1, 1.0, &w2, _state);
58597 0 : if( isuppera )
58598 : {
58599 0 : matrixvectormultiply(a, 0, j-1, j, n-1, ae_true, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state);
58600 : }
58601 : else
58602 : {
58603 0 : matrixvectormultiply(a, j, n-1, 0, j-1, ae_false, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state);
58604 : }
58605 :
58606 : /*
58607 : * Form l(i)*w2 (here l(i) is i-th row of L^(-1))
58608 : */
58609 0 : for(i=1; i<=n; i++)
58610 : {
58611 0 : v = ae_v_dotproduct(&t.ptr.pp_double[i-1][0], 1, &w2.ptr.p_double[1], 1, ae_v_len(0,i-1));
58612 0 : r->ptr.pp_double[i-1][j-1] = v;
58613 : }
58614 : }
58615 :
58616 : /*
58617 : * Copy R to A
58618 : */
58619 0 : for(i=0; i<=n-1; i++)
58620 : {
58621 0 : ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1));
58622 : }
58623 :
58624 : /*
58625 : * Copy L^(-1) from T to R and transpose
58626 : */
58627 0 : *isupperr = ae_true;
58628 0 : for(i=0; i<=n-1; i++)
58629 : {
58630 0 : for(j=0; j<=i-1; j++)
58631 : {
58632 0 : r->ptr.pp_double[i][j] = (double)(0);
58633 : }
58634 : }
58635 0 : for(i=0; i<=n-1; i++)
58636 : {
58637 0 : ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], t.stride, ae_v_len(i,n-1));
58638 : }
58639 0 : ae_frame_leave(_state);
58640 0 : return result;
58641 : }
58642 :
58643 : /*
58644 : * Problem 2: A*B*x = lambda*x
58645 : * or
58646 : * problem 3: B*A*x = lambda*x
58647 : *
58648 : * Reducing to:
58649 : * C*y = lambda*y
58650 : * C = U * A * U'
58651 : * B = U'* U
58652 : */
58653 0 : if( problemtype==2||problemtype==3 )
58654 : {
58655 :
58656 : /*
58657 : * Factorize B in T: B = U'*U
58658 : */
58659 0 : ae_matrix_set_length(&t, n-1+1, n-1+1, _state);
58660 0 : if( isupperb )
58661 : {
58662 0 : for(i=0; i<=n-1; i++)
58663 : {
58664 0 : ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1));
58665 : }
58666 : }
58667 : else
58668 : {
58669 0 : for(i=0; i<=n-1; i++)
58670 : {
58671 0 : ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], b->stride, ae_v_len(i,n-1));
58672 : }
58673 : }
58674 0 : if( !spdmatrixcholesky(&t, n, ae_true, _state) )
58675 : {
58676 0 : result = ae_false;
58677 0 : ae_frame_leave(_state);
58678 0 : return result;
58679 : }
58680 :
58681 : /*
58682 : * Build U * A * U' in R
58683 : */
58684 0 : ae_vector_set_length(&w1, n+1, _state);
58685 0 : ae_vector_set_length(&w2, n+1, _state);
58686 0 : ae_vector_set_length(&w3, n+1, _state);
58687 0 : ae_matrix_set_length(r, n-1+1, n-1+1, _state);
58688 0 : for(j=1; j<=n; j++)
58689 : {
58690 :
58691 : /*
58692 : * Form w2 = A * u'(j) (here u'(j) is j-th column of U')
58693 : */
58694 0 : ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(1,n-j+1));
58695 0 : symmetricmatrixvectormultiply(a, isuppera, j-1, n-1, &w1, 1.0, &w3, _state);
58696 0 : ae_v_move(&w2.ptr.p_double[j], 1, &w3.ptr.p_double[1], 1, ae_v_len(j,n));
58697 0 : ae_v_move(&w1.ptr.p_double[j], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(j,n));
58698 0 : if( isuppera )
58699 : {
58700 0 : matrixvectormultiply(a, 0, j-2, j-1, n-1, ae_false, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state);
58701 : }
58702 : else
58703 : {
58704 0 : matrixvectormultiply(a, j-1, n-1, 0, j-2, ae_true, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state);
58705 : }
58706 :
58707 : /*
58708 : * Form u(i)*w2 (here u(i) is i-th row of U)
58709 : */
58710 0 : for(i=1; i<=n; i++)
58711 : {
58712 0 : v = ae_v_dotproduct(&t.ptr.pp_double[i-1][i-1], 1, &w2.ptr.p_double[i], 1, ae_v_len(i-1,n-1));
58713 0 : r->ptr.pp_double[i-1][j-1] = v;
58714 : }
58715 : }
58716 :
58717 : /*
58718 : * Copy R to A
58719 : */
58720 0 : for(i=0; i<=n-1; i++)
58721 : {
58722 0 : ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1));
58723 : }
58724 0 : if( problemtype==2 )
58725 : {
58726 :
58727 : /*
58728 : * Invert U in T
58729 : */
58730 0 : rmatrixtrinverse(&t, n, ae_true, ae_false, &info, &rep, _state);
58731 0 : if( info<=0 )
58732 : {
58733 0 : result = ae_false;
58734 0 : ae_frame_leave(_state);
58735 0 : return result;
58736 : }
58737 :
58738 : /*
58739 : * Copy U^-1 from T to R
58740 : */
58741 0 : *isupperr = ae_true;
58742 0 : for(i=0; i<=n-1; i++)
58743 : {
58744 0 : for(j=0; j<=i-1; j++)
58745 : {
58746 0 : r->ptr.pp_double[i][j] = (double)(0);
58747 : }
58748 : }
58749 0 : for(i=0; i<=n-1; i++)
58750 : {
58751 0 : ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1));
58752 : }
58753 : }
58754 : else
58755 : {
58756 :
58757 : /*
58758 : * Copy U from T to R and transpose
58759 : */
58760 0 : *isupperr = ae_false;
58761 0 : for(i=0; i<=n-1; i++)
58762 : {
58763 0 : for(j=i+1; j<=n-1; j++)
58764 : {
58765 0 : r->ptr.pp_double[i][j] = (double)(0);
58766 : }
58767 : }
58768 0 : for(i=0; i<=n-1; i++)
58769 : {
58770 0 : ae_v_move(&r->ptr.pp_double[i][i], r->stride, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1));
58771 : }
58772 : }
58773 : }
58774 0 : ae_frame_leave(_state);
58775 0 : return result;
58776 : }
58777 :
58778 :
58779 : #endif
58780 : #if defined(AE_COMPILE_INVERSEUPDATE) || !defined(AE_PARTIAL_BUILD)
58781 :
58782 :
58783 : /*************************************************************************
58784 : Inverse matrix update by the Sherman-Morrison formula
58785 :
58786 : The algorithm updates matrix A^-1 when adding a number to an element
58787 : of matrix A.
58788 :
58789 : Input parameters:
58790 : InvA - inverse of matrix A.
58791 : Array whose indexes range within [0..N-1, 0..N-1].
58792 : N - size of matrix A.
58793 : UpdRow - row where the element to be updated is stored.
58794 : UpdColumn - column where the element to be updated is stored.
58795 : UpdVal - a number to be added to the element.
58796 :
58797 :
58798 : Output parameters:
58799 : InvA - inverse of modified matrix A.
58800 :
58801 : -- ALGLIB --
58802 : Copyright 2005 by Bochkanov Sergey
58803 : *************************************************************************/
58804 0 : void rmatrixinvupdatesimple(/* Real */ ae_matrix* inva,
58805 : ae_int_t n,
58806 : ae_int_t updrow,
58807 : ae_int_t updcolumn,
58808 : double updval,
58809 : ae_state *_state)
58810 : {
58811 : ae_frame _frame_block;
58812 : ae_vector t1;
58813 : ae_vector t2;
58814 : ae_int_t i;
58815 : double lambdav;
58816 : double vt;
58817 :
58818 0 : ae_frame_make(_state, &_frame_block);
58819 0 : memset(&t1, 0, sizeof(t1));
58820 0 : memset(&t2, 0, sizeof(t2));
58821 0 : ae_vector_init(&t1, 0, DT_REAL, _state, ae_true);
58822 0 : ae_vector_init(&t2, 0, DT_REAL, _state, ae_true);
58823 :
58824 0 : ae_assert(updrow>=0&&updrow<n, "RMatrixInvUpdateSimple: incorrect UpdRow!", _state);
58825 0 : ae_assert(updcolumn>=0&&updcolumn<n, "RMatrixInvUpdateSimple: incorrect UpdColumn!", _state);
58826 0 : ae_vector_set_length(&t1, n-1+1, _state);
58827 0 : ae_vector_set_length(&t2, n-1+1, _state);
58828 :
58829 : /*
58830 : * T1 = InvA * U
58831 : */
58832 0 : ae_v_move(&t1.ptr.p_double[0], 1, &inva->ptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1));
58833 :
58834 : /*
58835 : * T2 = v*InvA
58836 : */
58837 0 : ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1));
58838 :
58839 : /*
58840 : * Lambda = v * InvA * U
58841 : */
58842 0 : lambdav = updval*inva->ptr.pp_double[updcolumn][updrow];
58843 :
58844 : /*
58845 : * InvA = InvA - correction
58846 : */
58847 0 : for(i=0; i<=n-1; i++)
58848 : {
58849 0 : vt = updval*t1.ptr.p_double[i];
58850 0 : vt = vt/(1+lambdav);
58851 0 : ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt);
58852 : }
58853 0 : ae_frame_leave(_state);
58854 0 : }
58855 :
58856 :
58857 : /*************************************************************************
58858 : Inverse matrix update by the Sherman-Morrison formula
58859 :
58860 : The algorithm updates matrix A^-1 when adding a vector to a row
58861 : of matrix A.
58862 :
58863 : Input parameters:
58864 : InvA - inverse of matrix A.
58865 : Array whose indexes range within [0..N-1, 0..N-1].
58866 : N - size of matrix A.
58867 : UpdRow - the row of A whose vector V was added.
58868 : 0 <= Row <= N-1
58869 : V - the vector to be added to a row.
58870 : Array whose index ranges within [0..N-1].
58871 :
58872 : Output parameters:
58873 : InvA - inverse of modified matrix A.
58874 :
58875 : -- ALGLIB --
58876 : Copyright 2005 by Bochkanov Sergey
58877 : *************************************************************************/
58878 0 : void rmatrixinvupdaterow(/* Real */ ae_matrix* inva,
58879 : ae_int_t n,
58880 : ae_int_t updrow,
58881 : /* Real */ ae_vector* v,
58882 : ae_state *_state)
58883 : {
58884 : ae_frame _frame_block;
58885 : ae_vector t1;
58886 : ae_vector t2;
58887 : ae_int_t i;
58888 : ae_int_t j;
58889 : double lambdav;
58890 : double vt;
58891 :
58892 0 : ae_frame_make(_state, &_frame_block);
58893 0 : memset(&t1, 0, sizeof(t1));
58894 0 : memset(&t2, 0, sizeof(t2));
58895 0 : ae_vector_init(&t1, 0, DT_REAL, _state, ae_true);
58896 0 : ae_vector_init(&t2, 0, DT_REAL, _state, ae_true);
58897 :
58898 0 : ae_vector_set_length(&t1, n-1+1, _state);
58899 0 : ae_vector_set_length(&t2, n-1+1, _state);
58900 :
58901 : /*
58902 : * T1 = InvA * U
58903 : */
58904 0 : ae_v_move(&t1.ptr.p_double[0], 1, &inva->ptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1));
58905 :
58906 : /*
58907 : * T2 = v*InvA
58908 : * Lambda = v * InvA * U
58909 : */
58910 0 : for(j=0; j<=n-1; j++)
58911 : {
58912 0 : vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1));
58913 0 : t2.ptr.p_double[j] = vt;
58914 : }
58915 0 : lambdav = t2.ptr.p_double[updrow];
58916 :
58917 : /*
58918 : * InvA = InvA - correction
58919 : */
58920 0 : for(i=0; i<=n-1; i++)
58921 : {
58922 0 : vt = t1.ptr.p_double[i]/(1+lambdav);
58923 0 : ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt);
58924 : }
58925 0 : ae_frame_leave(_state);
58926 0 : }
58927 :
58928 :
58929 : /*************************************************************************
58930 : Inverse matrix update by the Sherman-Morrison formula
58931 :
58932 : The algorithm updates matrix A^-1 when adding a vector to a column
58933 : of matrix A.
58934 :
58935 : Input parameters:
58936 : InvA - inverse of matrix A.
58937 : Array whose indexes range within [0..N-1, 0..N-1].
58938 : N - size of matrix A.
58939 : UpdColumn - the column of A whose vector U was added.
58940 : 0 <= UpdColumn <= N-1
58941 : U - the vector to be added to a column.
58942 : Array whose index ranges within [0..N-1].
58943 :
58944 : Output parameters:
58945 : InvA - inverse of modified matrix A.
58946 :
58947 : -- ALGLIB --
58948 : Copyright 2005 by Bochkanov Sergey
58949 : *************************************************************************/
58950 0 : void rmatrixinvupdatecolumn(/* Real */ ae_matrix* inva,
58951 : ae_int_t n,
58952 : ae_int_t updcolumn,
58953 : /* Real */ ae_vector* u,
58954 : ae_state *_state)
58955 : {
58956 : ae_frame _frame_block;
58957 : ae_vector t1;
58958 : ae_vector t2;
58959 : ae_int_t i;
58960 : double lambdav;
58961 : double vt;
58962 :
58963 0 : ae_frame_make(_state, &_frame_block);
58964 0 : memset(&t1, 0, sizeof(t1));
58965 0 : memset(&t2, 0, sizeof(t2));
58966 0 : ae_vector_init(&t1, 0, DT_REAL, _state, ae_true);
58967 0 : ae_vector_init(&t2, 0, DT_REAL, _state, ae_true);
58968 :
58969 0 : ae_vector_set_length(&t1, n-1+1, _state);
58970 0 : ae_vector_set_length(&t2, n-1+1, _state);
58971 :
58972 : /*
58973 : * T1 = InvA * U
58974 : * Lambda = v * InvA * U
58975 : */
58976 0 : for(i=0; i<=n-1; i++)
58977 : {
58978 0 : vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1));
58979 0 : t1.ptr.p_double[i] = vt;
58980 : }
58981 0 : lambdav = t1.ptr.p_double[updcolumn];
58982 :
58983 : /*
58984 : * T2 = v*InvA
58985 : */
58986 0 : ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1));
58987 :
58988 : /*
58989 : * InvA = InvA - correction
58990 : */
58991 0 : for(i=0; i<=n-1; i++)
58992 : {
58993 0 : vt = t1.ptr.p_double[i]/(1+lambdav);
58994 0 : ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt);
58995 : }
58996 0 : ae_frame_leave(_state);
58997 0 : }
58998 :
58999 :
59000 : /*************************************************************************
59001 : Inverse matrix update by the Sherman-Morrison formula
59002 :
59003 : The algorithm computes the inverse of matrix A+u*v' by using the given matrix
59004 : A^-1 and the vectors u and v.
59005 :
59006 : Input parameters:
59007 : InvA - inverse of matrix A.
59008 : Array whose indexes range within [0..N-1, 0..N-1].
59009 : N - size of matrix A.
59010 : U - the vector modifying the matrix.
59011 : Array whose index ranges within [0..N-1].
59012 : V - the vector modifying the matrix.
59013 : Array whose index ranges within [0..N-1].
59014 :
59015 : Output parameters:
59016 : InvA - inverse of matrix A + u*v'.
59017 :
59018 : -- ALGLIB --
59019 : Copyright 2005 by Bochkanov Sergey
59020 : *************************************************************************/
59021 0 : void rmatrixinvupdateuv(/* Real */ ae_matrix* inva,
59022 : ae_int_t n,
59023 : /* Real */ ae_vector* u,
59024 : /* Real */ ae_vector* v,
59025 : ae_state *_state)
59026 : {
59027 : ae_frame _frame_block;
59028 : ae_vector t1;
59029 : ae_vector t2;
59030 : ae_int_t i;
59031 : ae_int_t j;
59032 : double lambdav;
59033 : double vt;
59034 :
59035 0 : ae_frame_make(_state, &_frame_block);
59036 0 : memset(&t1, 0, sizeof(t1));
59037 0 : memset(&t2, 0, sizeof(t2));
59038 0 : ae_vector_init(&t1, 0, DT_REAL, _state, ae_true);
59039 0 : ae_vector_init(&t2, 0, DT_REAL, _state, ae_true);
59040 :
59041 0 : ae_vector_set_length(&t1, n-1+1, _state);
59042 0 : ae_vector_set_length(&t2, n-1+1, _state);
59043 :
59044 : /*
59045 : * T1 = InvA * U
59046 : * Lambda = v * T1
59047 : */
59048 0 : for(i=0; i<=n-1; i++)
59049 : {
59050 0 : vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1));
59051 0 : t1.ptr.p_double[i] = vt;
59052 : }
59053 0 : lambdav = ae_v_dotproduct(&v->ptr.p_double[0], 1, &t1.ptr.p_double[0], 1, ae_v_len(0,n-1));
59054 :
59055 : /*
59056 : * T2 = v*InvA
59057 : */
59058 0 : for(j=0; j<=n-1; j++)
59059 : {
59060 0 : vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1));
59061 0 : t2.ptr.p_double[j] = vt;
59062 : }
59063 :
59064 : /*
59065 : * InvA = InvA - correction
59066 : */
59067 0 : for(i=0; i<=n-1; i++)
59068 : {
59069 0 : vt = t1.ptr.p_double[i]/(1+lambdav);
59070 0 : ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt);
59071 : }
59072 0 : ae_frame_leave(_state);
59073 0 : }
59074 :
59075 :
59076 : #endif
59077 : #if defined(AE_COMPILE_MATDET) || !defined(AE_PARTIAL_BUILD)
59078 :
59079 :
59080 : /*************************************************************************
59081 : Determinant calculation of the matrix given by its LU decomposition.
59082 :
59083 : Input parameters:
59084 : A - LU decomposition of the matrix (output of
59085 : RMatrixLU subroutine).
59086 : Pivots - table of permutations which were made during
59087 : the LU decomposition.
59088 : Output of RMatrixLU subroutine.
59089 : N - (optional) size of matrix A:
59090 : * if given, only principal NxN submatrix is processed and
59091 : overwritten. other elements are unchanged.
59092 : * if not given, automatically determined from matrix size
59093 : (A must be square matrix)
59094 :
59095 : Result: matrix determinant.
59096 :
59097 : -- ALGLIB --
59098 : Copyright 2005 by Bochkanov Sergey
59099 : *************************************************************************/
59100 0 : double rmatrixludet(/* Real */ ae_matrix* a,
59101 : /* Integer */ ae_vector* pivots,
59102 : ae_int_t n,
59103 : ae_state *_state)
59104 : {
59105 : ae_int_t i;
59106 : ae_int_t s;
59107 : double result;
59108 :
59109 :
59110 0 : ae_assert(n>=1, "RMatrixLUDet: N<1!", _state);
59111 0 : ae_assert(pivots->cnt>=n, "RMatrixLUDet: Pivots array is too short!", _state);
59112 0 : ae_assert(a->rows>=n, "RMatrixLUDet: rows(A)<N!", _state);
59113 0 : ae_assert(a->cols>=n, "RMatrixLUDet: cols(A)<N!", _state);
59114 0 : ae_assert(apservisfinitematrix(a, n, n, _state), "RMatrixLUDet: A contains infinite or NaN values!", _state);
59115 0 : result = (double)(1);
59116 0 : s = 1;
59117 0 : for(i=0; i<=n-1; i++)
59118 : {
59119 0 : result = result*a->ptr.pp_double[i][i];
59120 0 : if( pivots->ptr.p_int[i]!=i )
59121 : {
59122 0 : s = -s;
59123 : }
59124 : }
59125 0 : result = result*s;
59126 0 : return result;
59127 : }
59128 :
59129 :
59130 : /*************************************************************************
59131 : Calculation of the determinant of a general matrix
59132 :
59133 : Input parameters:
59134 : A - matrix, array[0..N-1, 0..N-1]
59135 : N - (optional) size of matrix A:
59136 : * if given, only principal NxN submatrix is processed and
59137 : overwritten. other elements are unchanged.
59138 : * if not given, automatically determined from matrix size
59139 : (A must be square matrix)
59140 :
59141 : Result: determinant of matrix A.
59142 :
59143 : -- ALGLIB --
59144 : Copyright 2005 by Bochkanov Sergey
59145 : *************************************************************************/
59146 0 : double rmatrixdet(/* Real */ ae_matrix* a,
59147 : ae_int_t n,
59148 : ae_state *_state)
59149 : {
59150 : ae_frame _frame_block;
59151 : ae_matrix _a;
59152 : ae_vector pivots;
59153 : double result;
59154 :
59155 0 : ae_frame_make(_state, &_frame_block);
59156 0 : memset(&_a, 0, sizeof(_a));
59157 0 : memset(&pivots, 0, sizeof(pivots));
59158 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
59159 0 : a = &_a;
59160 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
59161 :
59162 0 : ae_assert(n>=1, "RMatrixDet: N<1!", _state);
59163 0 : ae_assert(a->rows>=n, "RMatrixDet: rows(A)<N!", _state);
59164 0 : ae_assert(a->cols>=n, "RMatrixDet: cols(A)<N!", _state);
59165 0 : ae_assert(apservisfinitematrix(a, n, n, _state), "RMatrixDet: A contains infinite or NaN values!", _state);
59166 0 : rmatrixlu(a, n, n, &pivots, _state);
59167 0 : result = rmatrixludet(a, &pivots, n, _state);
59168 0 : ae_frame_leave(_state);
59169 0 : return result;
59170 : }
59171 :
59172 :
59173 : /*************************************************************************
59174 : Determinant calculation of the matrix given by its LU decomposition.
59175 :
59176 : Input parameters:
59177 : A - LU decomposition of the matrix (output of
59178 : RMatrixLU subroutine).
59179 : Pivots - table of permutations which were made during
59180 : the LU decomposition.
59181 : Output of RMatrixLU subroutine.
59182 : N - (optional) size of matrix A:
59183 : * if given, only principal NxN submatrix is processed and
59184 : overwritten. other elements are unchanged.
59185 : * if not given, automatically determined from matrix size
59186 : (A must be square matrix)
59187 :
59188 : Result: matrix determinant.
59189 :
59190 : -- ALGLIB --
59191 : Copyright 2005 by Bochkanov Sergey
59192 : *************************************************************************/
59193 0 : ae_complex cmatrixludet(/* Complex */ ae_matrix* a,
59194 : /* Integer */ ae_vector* pivots,
59195 : ae_int_t n,
59196 : ae_state *_state)
59197 : {
59198 : ae_int_t i;
59199 : ae_int_t s;
59200 : ae_complex result;
59201 :
59202 :
59203 0 : ae_assert(n>=1, "CMatrixLUDet: N<1!", _state);
59204 0 : ae_assert(pivots->cnt>=n, "CMatrixLUDet: Pivots array is too short!", _state);
59205 0 : ae_assert(a->rows>=n, "CMatrixLUDet: rows(A)<N!", _state);
59206 0 : ae_assert(a->cols>=n, "CMatrixLUDet: cols(A)<N!", _state);
59207 0 : ae_assert(apservisfinitecmatrix(a, n, n, _state), "CMatrixLUDet: A contains infinite or NaN values!", _state);
59208 0 : result = ae_complex_from_i(1);
59209 0 : s = 1;
59210 0 : for(i=0; i<=n-1; i++)
59211 : {
59212 0 : result = ae_c_mul(result,a->ptr.pp_complex[i][i]);
59213 0 : if( pivots->ptr.p_int[i]!=i )
59214 : {
59215 0 : s = -s;
59216 : }
59217 : }
59218 0 : result = ae_c_mul_d(result,(double)(s));
59219 0 : return result;
59220 : }
59221 :
59222 :
59223 : /*************************************************************************
59224 : Calculation of the determinant of a general matrix
59225 :
59226 : Input parameters:
59227 : A - matrix, array[0..N-1, 0..N-1]
59228 : N - (optional) size of matrix A:
59229 : * if given, only principal NxN submatrix is processed and
59230 : overwritten. other elements are unchanged.
59231 : * if not given, automatically determined from matrix size
59232 : (A must be square matrix)
59233 :
59234 : Result: determinant of matrix A.
59235 :
59236 : -- ALGLIB --
59237 : Copyright 2005 by Bochkanov Sergey
59238 : *************************************************************************/
59239 0 : ae_complex cmatrixdet(/* Complex */ ae_matrix* a,
59240 : ae_int_t n,
59241 : ae_state *_state)
59242 : {
59243 : ae_frame _frame_block;
59244 : ae_matrix _a;
59245 : ae_vector pivots;
59246 : ae_complex result;
59247 :
59248 0 : ae_frame_make(_state, &_frame_block);
59249 0 : memset(&_a, 0, sizeof(_a));
59250 0 : memset(&pivots, 0, sizeof(pivots));
59251 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
59252 0 : a = &_a;
59253 0 : ae_vector_init(&pivots, 0, DT_INT, _state, ae_true);
59254 :
59255 0 : ae_assert(n>=1, "CMatrixDet: N<1!", _state);
59256 0 : ae_assert(a->rows>=n, "CMatrixDet: rows(A)<N!", _state);
59257 0 : ae_assert(a->cols>=n, "CMatrixDet: cols(A)<N!", _state);
59258 0 : ae_assert(apservisfinitecmatrix(a, n, n, _state), "CMatrixDet: A contains infinite or NaN values!", _state);
59259 0 : cmatrixlu(a, n, n, &pivots, _state);
59260 0 : result = cmatrixludet(a, &pivots, n, _state);
59261 0 : ae_frame_leave(_state);
59262 0 : return result;
59263 : }
59264 :
59265 :
59266 : /*************************************************************************
59267 : Determinant calculation of the matrix given by the Cholesky decomposition.
59268 :
59269 : Input parameters:
59270 : A - Cholesky decomposition,
59271 : output of SMatrixCholesky subroutine.
59272 : N - (optional) size of matrix A:
59273 : * if given, only principal NxN submatrix is processed and
59274 : overwritten. other elements are unchanged.
59275 : * if not given, automatically determined from matrix size
59276 : (A must be square matrix)
59277 :
59278 : As the determinant is equal to the product of squares of diagonal elements,
59279 : it's not necessary to specify which triangle - lower or upper - the matrix
59280 : is stored in.
59281 :
59282 : Result:
59283 : matrix determinant.
59284 :
59285 : -- ALGLIB --
59286 : Copyright 2005-2008 by Bochkanov Sergey
59287 : *************************************************************************/
59288 0 : double spdmatrixcholeskydet(/* Real */ ae_matrix* a,
59289 : ae_int_t n,
59290 : ae_state *_state)
59291 : {
59292 : ae_int_t i;
59293 : ae_bool f;
59294 : double result;
59295 :
59296 :
59297 0 : ae_assert(n>=1, "SPDMatrixCholeskyDet: N<1!", _state);
59298 0 : ae_assert(a->rows>=n, "SPDMatrixCholeskyDet: rows(A)<N!", _state);
59299 0 : ae_assert(a->cols>=n, "SPDMatrixCholeskyDet: cols(A)<N!", _state);
59300 0 : f = ae_true;
59301 0 : for(i=0; i<=n-1; i++)
59302 : {
59303 0 : f = f&&ae_isfinite(a->ptr.pp_double[i][i], _state);
59304 : }
59305 0 : ae_assert(f, "SPDMatrixCholeskyDet: A contains infinite or NaN values!", _state);
59306 0 : result = (double)(1);
59307 0 : for(i=0; i<=n-1; i++)
59308 : {
59309 0 : result = result*ae_sqr(a->ptr.pp_double[i][i], _state);
59310 : }
59311 0 : return result;
59312 : }
59313 :
59314 :
59315 : /*************************************************************************
59316 : Determinant calculation of the symmetric positive definite matrix.
59317 :
59318 : Input parameters:
59319 : A - matrix. Array with elements [0..N-1, 0..N-1].
59320 : N - (optional) size of matrix A:
59321 : * if given, only principal NxN submatrix is processed and
59322 : overwritten. other elements are unchanged.
59323 : * if not given, automatically determined from matrix size
59324 : (A must be square matrix)
59325 : IsUpper - (optional) storage type:
59326 : * if True, symmetric matrix A is given by its upper
59327 : triangle, and the lower triangle isn't used/changed by
59328 : function
59329 : * if False, symmetric matrix A is given by its lower
59330 : triangle, and the upper triangle isn't used/changed by
59331 : function
59332 : * if not given, both lower and upper triangles must be
59333 : filled.
59334 :
59335 : Result:
59336 : determinant of matrix A.
59337 : If matrix A is not positive definite, exception is thrown.
59338 :
59339 : -- ALGLIB --
59340 : Copyright 2005-2008 by Bochkanov Sergey
59341 : *************************************************************************/
59342 0 : double spdmatrixdet(/* Real */ ae_matrix* a,
59343 : ae_int_t n,
59344 : ae_bool isupper,
59345 : ae_state *_state)
59346 : {
59347 : ae_frame _frame_block;
59348 : ae_matrix _a;
59349 : ae_bool b;
59350 : double result;
59351 :
59352 0 : ae_frame_make(_state, &_frame_block);
59353 0 : memset(&_a, 0, sizeof(_a));
59354 0 : ae_matrix_init_copy(&_a, a, _state, ae_true);
59355 0 : a = &_a;
59356 :
59357 0 : ae_assert(n>=1, "SPDMatrixDet: N<1!", _state);
59358 0 : ae_assert(a->rows>=n, "SPDMatrixDet: rows(A)<N!", _state);
59359 0 : ae_assert(a->cols>=n, "SPDMatrixDet: cols(A)<N!", _state);
59360 0 : ae_assert(isfinitertrmatrix(a, n, isupper, _state), "SPDMatrixDet: A contains infinite or NaN values!", _state);
59361 0 : b = spdmatrixcholesky(a, n, isupper, _state);
59362 0 : ae_assert(b, "SPDMatrixDet: A is not SPD!", _state);
59363 0 : result = spdmatrixcholeskydet(a, n, _state);
59364 0 : ae_frame_leave(_state);
59365 0 : return result;
59366 : }
59367 :
59368 :
59369 : #endif
59370 :
59371 : }
59372 :
|
