Mercurial > octave

comparison libinterp/corefcn/qz.cc @ 32660:f53ac65ffba6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
maint: New method rwdata() as clearer alternative to fortran_vec(). * etc/NEWS.10.md: Announce new method and recommend its use in future code. * doc/interpreter/external.txi: Update Octave manual to use rwdata. * liboctave/array/Array.h (rwdata): New function prototype. * liboctave/array/Array.h (fortran_vec): Make inline function that calls rwdata(). * liboctave/array/DiagArray2.h (rwdata): New function prototype. * liboctave/array/DiagArray2.h (fortran_vec): Make inline function that calls rwdata(). * examples/code/fortrandemo.cc, libgui/graphics/QtHandlesUtils.cc, libinterp/corefcn/Cell.cc, libinterp/corefcn/__dsearchn__.cc, libinterp/corefcn/__ichol__.cc, libinterp/corefcn/__ilu__.cc, libinterp/corefcn/__lin_interpn__.cc, libinterp/corefcn/__magick_read__.cc, libinterp/corefcn/__pchip_deriv__.cc, libinterp/corefcn/amd.cc, libinterp/corefcn/data.cc, libinterp/corefcn/dot.cc, libinterp/corefcn/ellipj.cc, libinterp/corefcn/filter.cc, libinterp/corefcn/gcd.cc, libinterp/corefcn/gl-render.cc, libinterp/corefcn/graphics.cc, libinterp/corefcn/graphics.in.h, libinterp/corefcn/kron.cc, libinterp/corefcn/ls-mat4.cc, libinterp/corefcn/ls-mat5.cc, libinterp/corefcn/mex.cc, libinterp/corefcn/oct-map.cc, libinterp/corefcn/oct-stream.cc, libinterp/corefcn/ordqz.cc, libinterp/corefcn/ordschur.cc, libinterp/corefcn/perms.cc, libinterp/corefcn/psi.cc, libinterp/corefcn/quadcc.cc, libinterp/corefcn/qz.cc, libinterp/corefcn/rand.cc, libinterp/corefcn/sqrtm.cc, libinterp/corefcn/strfind.cc, libinterp/corefcn/symrcm.cc, libinterp/corefcn/tril.cc, libinterp/corefcn/typecast.cc, libinterp/corefcn/xdiv.cc, libinterp/dldfcn/__delaunayn__.cc, libinterp/dldfcn/__glpk__.cc, libinterp/dldfcn/__ode15__.cc, libinterp/dldfcn/__voronoi__.cc, libinterp/dldfcn/audioread.cc, libinterp/dldfcn/convhulln.cc, libinterp/octave-value/ov-base-int.cc, libinterp/octave-value/ov-bool-mat.cc, libinterp/octave-value/ov-ch-mat.cc, libinterp/octave-value/ov-cx-diag.cc, libinterp/octave-value/ov-cx-mat.cc, libinterp/octave-value/ov-flt-cx-diag.cc, libinterp/octave-value/ov-flt-cx-mat.cc, libinterp/octave-value/ov-flt-re-diag.cc, libinterp/octave-value/ov-flt-re-mat.cc, libinterp/octave-value/ov-intx.h, libinterp/octave-value/ov-java.cc, libinterp/octave-value/ov-perm.cc, libinterp/octave-value/ov-re-diag.cc, libinterp/octave-value/ov-re-mat.cc, libinterp/octave-value/ov-str-mat.cc, liboctave/array/Array-base.cc, liboctave/array/Array-util.cc, liboctave/array/CColVector.cc, liboctave/array/CDiagMatrix.cc, liboctave/array/CMatrix.cc, liboctave/array/CNDArray.cc, liboctave/array/CRowVector.cc, liboctave/array/CSparse.cc, liboctave/array/DiagArray2.h, liboctave/array/MArray.cc, liboctave/array/PermMatrix.cc, liboctave/array/Range.h, liboctave/array/Sparse.cc, liboctave/array/boolSparse.cc, liboctave/array/dColVector.cc, liboctave/array/dDiagMatrix.cc, liboctave/array/dMatrix.cc, liboctave/array/dNDArray.cc, liboctave/array/dRowVector.cc, liboctave/array/dSparse.cc, liboctave/array/fCColVector.cc, liboctave/array/fCDiagMatrix.cc, liboctave/array/fCMatrix.cc, liboctave/array/fCNDArray.cc, liboctave/array/fCRowVector.cc, liboctave/array/fColVector.cc, liboctave/array/fMatrix.cc, liboctave/array/fNDArray.cc, liboctave/array/fRowVector.cc, liboctave/array/idx-vector.cc, liboctave/numeric/CollocWt.cc, liboctave/numeric/DASPK.cc, liboctave/numeric/DASRT.cc, liboctave/numeric/DASSL.cc, liboctave/numeric/EIG.cc, liboctave/numeric/LSODE.cc, liboctave/numeric/Quad.cc, liboctave/numeric/aepbalance.cc, liboctave/numeric/bsxfun-defs.cc, liboctave/numeric/chol.cc, liboctave/numeric/eigs-base.cc, liboctave/numeric/fEIG.cc, liboctave/numeric/gepbalance.cc, liboctave/numeric/gsvd.cc, liboctave/numeric/hess.cc, liboctave/numeric/lu.cc, liboctave/numeric/oct-convn.cc, liboctave/numeric/oct-rand.cc, liboctave/numeric/qr.cc, liboctave/numeric/qrp.cc, liboctave/numeric/schur.cc, liboctave/numeric/sparse-dmsolve.cc, liboctave/numeric/sparse-lu.cc, liboctave/numeric/sparse-qr.cc, liboctave/numeric/svd.cc, liboctave/operators/mx-inlines.cc, liboctave/operators/mx-op-defs.h, liboctave/util/oct-base64.cc, liboctave/util/oct-binmap.h, liboctave/util/str-vec.cc: Replace calls to fortran_vec() with calls to rwdata().
author Rik <rik@octave.org>
date Wed, 27 Dec 2023 16:55:14 -0800
parents 2e484f9f1f18
children
comparison
equal deleted inserted replaced
32659:71a23564ceca 32660:f53ac65ffba6
217 char comp_z = (nargout >= 4 ? 'V' : 'N'); 217 char comp_z = (nargout >= 4 ? 'V' : 'N');
218 218
219 // Initialize Q, Z to identity matrix if either is needed 219 // Initialize Q, Z to identity matrix if either is needed
220 if (comp_q == 'V' || comp_z == 'V') 220 if (comp_q == 'V' || comp_z == 'V')
221 { 221 {
222 double *QQptr = QQ.fortran_vec (); 222 double *QQptr = QQ.rwdata ();
223 double *ZZptr = ZZ.fortran_vec (); 223 double *ZZptr = ZZ.rwdata ();
224 std::fill_n (QQptr, QQ.numel (), 0.0); 224 std::fill_n (QQptr, QQ.numel (), 0.0);
225 std::fill_n (ZZptr, ZZ.numel (), 0.0); 225 std::fill_n (ZZptr, ZZ.numel (), 0.0);
226 for (F77_INT i = 0; i < nn; i++) 226 for (F77_INT i = 0; i < nn; i++)
227 { 227 {
228 QQ(i, i) = 1.0; 228 QQ(i, i) = 1.0;
252 if (comp_z == 'V') 252 if (comp_z == 'V')
253 CZ = ComplexMatrix (ZZ); 253 CZ = ComplexMatrix (ZZ);
254 254
255 F77_XFCN (zggbal, ZGGBAL, 255 F77_XFCN (zggbal, ZGGBAL,
256 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 256 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
257 nn, F77_DBLE_CMPLX_ARG (caa.fortran_vec ()), nn, 257 nn, F77_DBLE_CMPLX_ARG (caa.rwdata ()), nn,
258 F77_DBLE_CMPLX_ARG (cbb.fortran_vec ()), 258 F77_DBLE_CMPLX_ARG (cbb.rwdata ()),
259 nn, ilo, ihi, lscale.fortran_vec (), 259 nn, ilo, ihi, lscale.rwdata (),
260 rscale.fortran_vec (), work.fortran_vec (), info 260 rscale.rwdata (), work.rwdata (), info
261 F77_CHAR_ARG_LEN (1))); 261 F77_CHAR_ARG_LEN (1)));
262 } 262 }
263 else 263 else
264 { 264 {
265 #if defined (DEBUG) 265 #if defined (DEBUG)
267 octave_stdout << "qz: performing balancing; QQ =\n" << QQ << std::endl; 267 octave_stdout << "qz: performing balancing; QQ =\n" << QQ << std::endl;
268 #endif 268 #endif
269 269
270 F77_XFCN (dggbal, DGGBAL, 270 F77_XFCN (dggbal, DGGBAL,
271 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 271 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
272 nn, aa.fortran_vec (), nn, bb.fortran_vec (), 272 nn, aa.rwdata (), nn, bb.rwdata (),
273 nn, ilo, ihi, lscale.fortran_vec (), 273 nn, ilo, ihi, lscale.rwdata (),
274 rscale.fortran_vec (), work.fortran_vec (), info 274 rscale.rwdata (), work.rwdata (), info
275 F77_CHAR_ARG_LEN (1))); 275 F77_CHAR_ARG_LEN (1)));
276 } 276 }
277 277
278 // Only permutation balance above is done. Skip scaling balance. 278 // Only permutation balance above is done. Skip scaling balance.
279 279
292 CQ = CQ * cbqr.Q (); 292 CQ = CQ * cbqr.Q ();
293 293
294 F77_XFCN (zgghrd, ZGGHRD, 294 F77_XFCN (zgghrd, ZGGHRD,
295 (F77_CONST_CHAR_ARG2 (&comp_q, 1), 295 (F77_CONST_CHAR_ARG2 (&comp_q, 1),
296 F77_CONST_CHAR_ARG2 (&comp_z, 1), 296 F77_CONST_CHAR_ARG2 (&comp_z, 1),
297 nn, ilo, ihi, F77_DBLE_CMPLX_ARG (caa.fortran_vec ()), 297 nn, ilo, ihi, F77_DBLE_CMPLX_ARG (caa.rwdata ()),
298 nn, F77_DBLE_CMPLX_ARG (cbb.fortran_vec ()), nn, 298 nn, F77_DBLE_CMPLX_ARG (cbb.rwdata ()), nn,
299 F77_DBLE_CMPLX_ARG (CQ.fortran_vec ()), nn, 299 F77_DBLE_CMPLX_ARG (CQ.rwdata ()), nn,
300 F77_DBLE_CMPLX_ARG (CZ.fortran_vec ()), nn, info 300 F77_DBLE_CMPLX_ARG (CZ.rwdata ()), nn, info
301 F77_CHAR_ARG_LEN (1) 301 F77_CHAR_ARG_LEN (1)
302 F77_CHAR_ARG_LEN (1))); 302 F77_CHAR_ARG_LEN (1)));
303 303
304 ComplexRowVector cwork (nn); 304 ComplexRowVector cwork (nn);
305 305
306 F77_XFCN (zhgeqz, ZHGEQZ, 306 F77_XFCN (zhgeqz, ZHGEQZ,
307 (F77_CONST_CHAR_ARG2 (&qz_job, 1), 307 (F77_CONST_CHAR_ARG2 (&qz_job, 1),
308 F77_CONST_CHAR_ARG2 (&comp_q, 1), 308 F77_CONST_CHAR_ARG2 (&comp_q, 1),
309 F77_CONST_CHAR_ARG2 (&comp_z, 1), 309 F77_CONST_CHAR_ARG2 (&comp_z, 1),
310 nn, ilo, ihi, 310 nn, ilo, ihi,
311 F77_DBLE_CMPLX_ARG (caa.fortran_vec ()), nn, 311 F77_DBLE_CMPLX_ARG (caa.rwdata ()), nn,
312 F77_DBLE_CMPLX_ARG (cbb.fortran_vec ()), nn, 312 F77_DBLE_CMPLX_ARG (cbb.rwdata ()), nn,
313 F77_DBLE_CMPLX_ARG (xalpha.fortran_vec ()), 313 F77_DBLE_CMPLX_ARG (xalpha.rwdata ()),
314 F77_DBLE_CMPLX_ARG (xbeta.fortran_vec ()), 314 F77_DBLE_CMPLX_ARG (xbeta.rwdata ()),
315 F77_DBLE_CMPLX_ARG (CQ.fortran_vec ()), nn, 315 F77_DBLE_CMPLX_ARG (CQ.rwdata ()), nn,
316 F77_DBLE_CMPLX_ARG (CZ.fortran_vec ()), nn, 316 F77_DBLE_CMPLX_ARG (CZ.rwdata ()), nn,
317 F77_DBLE_CMPLX_ARG (cwork.fortran_vec ()), nn, 317 F77_DBLE_CMPLX_ARG (cwork.rwdata ()), nn,
318 rwork.fortran_vec (), info 318 rwork.rwdata (), info
319 F77_CHAR_ARG_LEN (1) 319 F77_CHAR_ARG_LEN (1)
320 F77_CHAR_ARG_LEN (1) 320 F77_CHAR_ARG_LEN (1)
321 F77_CHAR_ARG_LEN (1))); 321 F77_CHAR_ARG_LEN (1)));
322 322
323 if (comp_q == 'V') 323 if (comp_q == 'V')
325 // Left eigenvector. 325 // Left eigenvector.
326 F77_XFCN (zggbak, ZGGBAK, 326 F77_XFCN (zggbak, ZGGBAK,
327 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 327 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
328 F77_CONST_CHAR_ARG2 ("L", 1), 328 F77_CONST_CHAR_ARG2 ("L", 1),
329 nn, ilo, ihi, lscale.data (), rscale.data (), 329 nn, ilo, ihi, lscale.data (), rscale.data (),
330 nn, F77_DBLE_CMPLX_ARG (CQ.fortran_vec ()), nn, info 330 nn, F77_DBLE_CMPLX_ARG (CQ.rwdata ()), nn, info
331 F77_CHAR_ARG_LEN (1) 331 F77_CHAR_ARG_LEN (1)
332 F77_CHAR_ARG_LEN (1))); 332 F77_CHAR_ARG_LEN (1)));
333 } 333 }
334 334
335 if (comp_z == 'V') 335 if (comp_z == 'V')
337 // Right eigenvector. 337 // Right eigenvector.
338 F77_XFCN (zggbak, ZGGBAK, 338 F77_XFCN (zggbak, ZGGBAK,
339 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 339 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
340 F77_CONST_CHAR_ARG2 ("R", 1), 340 F77_CONST_CHAR_ARG2 ("R", 1),
341 nn, ilo, ihi, lscale.data (), rscale.data (), 341 nn, ilo, ihi, lscale.data (), rscale.data (),
342 nn, F77_DBLE_CMPLX_ARG (CZ.fortran_vec ()), nn, info 342 nn, F77_DBLE_CMPLX_ARG (CZ.rwdata ()), nn, info
343 F77_CHAR_ARG_LEN (1) 343 F77_CHAR_ARG_LEN (1)
344 F77_CHAR_ARG_LEN (1))); 344 F77_CHAR_ARG_LEN (1)));
345 } 345 }
346 346
347 } 347 }
389 389
390 // Reduce to generalized Hessenberg form. 390 // Reduce to generalized Hessenberg form.
391 F77_XFCN (dgghrd, DGGHRD, 391 F77_XFCN (dgghrd, DGGHRD,
392 (F77_CONST_CHAR_ARG2 (&comp_q, 1), 392 (F77_CONST_CHAR_ARG2 (&comp_q, 1),
393 F77_CONST_CHAR_ARG2 (&comp_z, 1), 393 F77_CONST_CHAR_ARG2 (&comp_z, 1),
394 nn, ilo, ihi, aa.fortran_vec (), 394 nn, ilo, ihi, aa.rwdata (),
395 nn, bb.fortran_vec (), nn, QQ.fortran_vec (), nn, 395 nn, bb.rwdata (), nn, QQ.rwdata (), nn,
396 ZZ.fortran_vec (), nn, info 396 ZZ.rwdata (), nn, info
397 F77_CHAR_ARG_LEN (1) 397 F77_CHAR_ARG_LEN (1)
398 F77_CHAR_ARG_LEN (1))); 398 F77_CHAR_ARG_LEN (1)));
399 399
400 // Check if just computing generalized eigenvalues, 400 // Check if just computing generalized eigenvalues,
401 // or if we're actually computing the decomposition. 401 // or if we're actually computing the decomposition.
403 // Reduce to generalized Schur form. 403 // Reduce to generalized Schur form.
404 F77_XFCN (dhgeqz, DHGEQZ, 404 F77_XFCN (dhgeqz, DHGEQZ,
405 (F77_CONST_CHAR_ARG2 (&qz_job, 1), 405 (F77_CONST_CHAR_ARG2 (&qz_job, 1),
406 F77_CONST_CHAR_ARG2 (&comp_q, 1), 406 F77_CONST_CHAR_ARG2 (&comp_q, 1),
407 F77_CONST_CHAR_ARG2 (&comp_z, 1), 407 F77_CONST_CHAR_ARG2 (&comp_z, 1),
408 nn, ilo, ihi, aa.fortran_vec (), nn, bb.fortran_vec (), 408 nn, ilo, ihi, aa.rwdata (), nn, bb.rwdata (),
409 nn, alphar.fortran_vec (), alphai.fortran_vec (), 409 nn, alphar.rwdata (), alphai.rwdata (),
410 betar.fortran_vec (), QQ.fortran_vec (), nn, 410 betar.rwdata (), QQ.rwdata (), nn,
411 ZZ.fortran_vec (), nn, work.fortran_vec (), nn, info 411 ZZ.rwdata (), nn, work.rwdata (), nn, info
412 F77_CHAR_ARG_LEN (1) 412 F77_CHAR_ARG_LEN (1)
413 F77_CHAR_ARG_LEN (1) 413 F77_CHAR_ARG_LEN (1)
414 F77_CHAR_ARG_LEN (1))); 414 F77_CHAR_ARG_LEN (1)));
415 415
416 if (comp_q == 'V') 416 if (comp_q == 'V')
417 { 417 {
418 F77_XFCN (dggbak, DGGBAK, 418 F77_XFCN (dggbak, DGGBAK,
419 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 419 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
420 F77_CONST_CHAR_ARG2 ("L", 1), 420 F77_CONST_CHAR_ARG2 ("L", 1),
421 nn, ilo, ihi, lscale.data (), rscale.data (), 421 nn, ilo, ihi, lscale.data (), rscale.data (),
422 nn, QQ.fortran_vec (), nn, info 422 nn, QQ.rwdata (), nn, info
423 F77_CHAR_ARG_LEN (1) 423 F77_CHAR_ARG_LEN (1)
424 F77_CHAR_ARG_LEN (1))); 424 F77_CHAR_ARG_LEN (1)));
425 425
426 #if defined (DEBUG) 426 #if defined (DEBUG)
427 if (comp_q == 'V') 427 if (comp_q == 'V')
434 { 434 {
435 F77_XFCN (dggbak, DGGBAK, 435 F77_XFCN (dggbak, DGGBAK,
436 (F77_CONST_CHAR_ARG2 (&bal_job, 1), 436 (F77_CONST_CHAR_ARG2 (&bal_job, 1),
437 F77_CONST_CHAR_ARG2 ("R", 1), 437 F77_CONST_CHAR_ARG2 ("R", 1),
438 nn, ilo, ihi, lscale.data (), rscale.data (), 438 nn, ilo, ihi, lscale.data (), rscale.data (),
439 nn, ZZ.fortran_vec (), nn, info 439 nn, ZZ.rwdata (), nn, info
440 F77_CHAR_ARG_LEN (1) 440 F77_CHAR_ARG_LEN (1)
441 F77_CHAR_ARG_LEN (1))); 441 F77_CHAR_ARG_LEN (1)));
442 442
443 #if defined (DEBUG) 443 #if defined (DEBUG)
444 if (comp_z == 'V') 444 if (comp_z == 'V')
467 F77_INT m; 467 F77_INT m;
468 468
469 F77_XFCN (ztgevc, ZTGEVC, 469 F77_XFCN (ztgevc, ZTGEVC,
470 (F77_CONST_CHAR_ARG2 (&side, 1), 470 (F77_CONST_CHAR_ARG2 (&side, 1),
471 F77_CONST_CHAR_ARG2 (&howmany, 1), 471 F77_CONST_CHAR_ARG2 (&howmany, 1),
472 select, nn, F77_DBLE_CMPLX_ARG (caa.fortran_vec ()), nn, 472 select, nn, F77_DBLE_CMPLX_ARG (caa.rwdata ()), nn,
473 F77_DBLE_CMPLX_ARG (cbb.fortran_vec ()), 473 F77_DBLE_CMPLX_ARG (cbb.rwdata ()),
474 nn, F77_DBLE_CMPLX_ARG (CVL.fortran_vec ()), nn, 474 nn, F77_DBLE_CMPLX_ARG (CVL.rwdata ()), nn,
475 F77_DBLE_CMPLX_ARG (CVR.fortran_vec ()), nn, nn, 475 F77_DBLE_CMPLX_ARG (CVR.rwdata ()), nn, nn,
476 m, F77_DBLE_CMPLX_ARG (cwork2.fortran_vec ()), 476 m, F77_DBLE_CMPLX_ARG (cwork2.rwdata ()),
477 rwork2.fortran_vec (), info 477 rwork2.rwdata (), info
478 F77_CHAR_ARG_LEN (1) 478 F77_CHAR_ARG_LEN (1)
479 F77_CHAR_ARG_LEN (1))); 479 F77_CHAR_ARG_LEN (1)));
480 } 480 }
481 else 481 else
482 { 482 {
489 F77_INT m; 489 F77_INT m;
490 490
491 F77_XFCN (dtgevc, DTGEVC, 491 F77_XFCN (dtgevc, DTGEVC,
492 (F77_CONST_CHAR_ARG2 (&side, 1), 492 (F77_CONST_CHAR_ARG2 (&side, 1),
493 F77_CONST_CHAR_ARG2 (&howmany, 1), 493 F77_CONST_CHAR_ARG2 (&howmany, 1),
494 select, nn, aa.fortran_vec (), nn, bb.fortran_vec (), 494 select, nn, aa.rwdata (), nn, bb.rwdata (),
495 nn, VL.fortran_vec (), nn, VR.fortran_vec (), nn, nn, 495 nn, VL.rwdata (), nn, VR.rwdata (), nn, nn,
496 m, work.fortran_vec (), info 496 m, work.rwdata (), info
497 F77_CHAR_ARG_LEN (1) 497 F77_CHAR_ARG_LEN (1)
498 F77_CHAR_ARG_LEN (1))); 498 F77_CHAR_ARG_LEN (1)));
499 } 499 }
500 } 500 }
501 501