From 375b1875c8c1d1d59d1bb6f2c227e6da12563faf Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 1 Jan 2020 13:18:53 +0100 Subject: [PATCH] [WIP] Update LAPACK to 3.9.0 (#2353) * Update make.inc entries for LAPACK 3.9.0 Reference-LAPACK PR 347 changed some variable names and relative paths * Update LAPACK to 3.9.0 * Add new functions from LAPACK 3.9.0 * Add new functions from LAPACK 3.9.0 * Restore LOADER command as it makes it easier to specify pthread as needed * Restore LOADER * Restore EIG/LIN prefixes in cmdbase * add binary path to lapack_testing.py call * Restore OpenMP version check * Restore OpenMP version check * Restore fix for out-of-bounds array accesses from #2096 --- Makefile | 20 +- cmake/lapack.cmake | 16 +- cmake/lapacke.cmake | 6 + exports/gensymbol | 31 +- lapack-netlib/.appveyor.yml | 38 + lapack-netlib/.gitignore | 6 + lapack-netlib/.travis.yml | 49 +- lapack-netlib/BLAS/CMakeLists.txt | 1 + lapack-netlib/BLAS/Makefile | 7 +- lapack-netlib/BLAS/SRC/Makefile | 21 +- lapack-netlib/BLAS/SRC/icamax.f | 2 +- lapack-netlib/BLAS/SRC/idamax.f | 2 +- lapack-netlib/BLAS/SRC/izamax.f | 2 +- lapack-netlib/BLAS/SRC/meson.build | 29 + lapack-netlib/BLAS/SRC/sdsdot.f | 146 +- lapack-netlib/BLAS/TESTING/Makefile | 33 +- lapack-netlib/BLAS/TESTING/cblat1.f | 2 +- lapack-netlib/BLAS/TESTING/dblat1.f | 2 +- lapack-netlib/BLAS/TESTING/sblat1.f | 2 +- lapack-netlib/BLAS/TESTING/zblat1.f | 2 +- lapack-netlib/CBLAS/CMakeLists.txt | 19 +- lapack-netlib/CBLAS/Makefile | 10 +- lapack-netlib/CBLAS/examples/Makefile | 16 +- lapack-netlib/CBLAS/examples/cblas_example1.c | 2 +- lapack-netlib/CBLAS/src/Makefile | 50 +- lapack-netlib/CBLAS/src/cblas_sgemm.c | 2 +- lapack-netlib/CBLAS/testing/Makefile | 40 +- lapack-netlib/CBLAS/testing/c_cblat1.f | 2 +- lapack-netlib/CBLAS/testing/c_dblat1.f | 2 +- lapack-netlib/CBLAS/testing/c_sblat1.f | 2 +- lapack-netlib/CBLAS/testing/c_zblat1.f | 2 +- .../CMAKE/CheckLAPACKCompilerFlags.cmake | 2 +- lapack-netlib/CMAKE/FindGcov.cmake | 2 +- lapack-netlib/CMAKE/Findcodecov.cmake | 2 +- lapack-netlib/CMAKE/FortranMangling.cmake | 2 +- .../CMAKE/lapack-config-build.cmake.in | 4 + .../CMAKE/lapack-config-install.cmake.in | 4 + lapack-netlib/CMakeLists.txt | 99 +- lapack-netlib/DOCS/Doxyfile | 2 +- lapack-netlib/DOCS/Doxyfile_man | 2 +- lapack-netlib/DOCS/lawn81.tex | 90 +- lapack-netlib/INSTALL/Makefile | 28 +- lapack-netlib/INSTALL/dlamch.f | 5 + lapack-netlib/INSTALL/dlamchf77.f | 4 + lapack-netlib/INSTALL/ilaver.f | 10 +- lapack-netlib/INSTALL/make.inc.ALPHA | 34 +- lapack-netlib/INSTALL/make.inc.HPPA | 34 +- lapack-netlib/INSTALL/make.inc.IRIX64 | 39 +- lapack-netlib/INSTALL/make.inc.O2K | 39 +- lapack-netlib/INSTALL/make.inc.SGI5 | 34 +- lapack-netlib/INSTALL/make.inc.SUN4 | 34 +- lapack-netlib/INSTALL/make.inc.SUN4SOL2 | 41 +- lapack-netlib/INSTALL/make.inc.XLF | 34 +- lapack-netlib/INSTALL/make.inc.gfortran | 34 +- lapack-netlib/INSTALL/make.inc.gfortran_debug | 34 +- lapack-netlib/INSTALL/make.inc.ifort | 34 +- lapack-netlib/INSTALL/make.inc.pgf95 | 34 +- lapack-netlib/INSTALL/make.inc.pghpf | 34 +- lapack-netlib/INSTALL/slamch.f | 1 + lapack-netlib/LAPACKE/CMakeLists.txt | 51 +- lapack-netlib/LAPACKE/Makefile | 14 +- .../cmake/lapacke-config-build.cmake.in | 5 +- .../cmake/lapacke-config-install.cmake.in | 5 +- lapack-netlib/LAPACKE/example/Makefile | 22 +- lapack-netlib/LAPACKE/include/CMakeLists.txt | 2 +- lapack-netlib/LAPACKE/include/lapack.h | 13715 ++++++++++++++++ lapack-netlib/LAPACKE/include/lapacke.h | 7025 +------- lapack-netlib/LAPACKE/src/CMakeLists.txt | 315 +- lapack-netlib/LAPACKE/src/Makefile | 355 +- lapack-netlib/LAPACKE/src/lapacke_cgejsv.c | 3 - lapack-netlib/LAPACKE/src/lapacke_cgelsd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c | 106 + .../LAPACKE/src/lapacke_cgesvdq_work.c | 149 + lapack-netlib/LAPACKE/src/lapacke_cggesx.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chbevd.c | 2 +- .../LAPACKE/src/lapacke_chbevd_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chbgvd.c | 2 +- .../LAPACKE/src/lapacke_cheev_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_cheevd.c | 4 +- .../LAPACKE/src/lapacke_cheevd_2stage.c | 4 +- .../LAPACKE/src/lapacke_cheevd_2stage_work.c | 4 +- .../LAPACKE/src/lapacke_cheevd_work.c | 5 +- lapack-netlib/LAPACKE/src/lapacke_cheevr.c | 2 +- .../LAPACKE/src/lapacke_cheevr_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chegst.c | 2 +- .../LAPACKE/src/lapacke_chegst_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chegvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chpevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_chpgvd.c | 2 +- .../LAPACKE/src/lapacke_clantr_work.c | 19 +- lapack-netlib/LAPACKE/src/lapacke_cstedc.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_cstegr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_cstemr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_csytrs2.c | 2 +- .../LAPACKE/src/lapacke_csytrs2_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ctgsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ctprfb.c | 35 +- lapack-netlib/LAPACKE/src/lapacke_cunmhr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dgeesx.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dgejsv.c | 3 - lapack-netlib/LAPACKE/src/lapacke_dgelsd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c | 106 + .../LAPACKE/src/lapacke_dgesvdq_work.c | 149 + lapack-netlib/LAPACKE/src/lapacke_dggesx.c | 2 +- .../LAPACKE/src/lapacke_dlantr_work.c | 19 +- lapack-netlib/LAPACKE/src/lapacke_dormhr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dsbevd.c | 2 +- .../LAPACKE/src/lapacke_dsbevd_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dsbgvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dspevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dspgvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dstedc.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dstegr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dstemr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dstevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dstevr.c | 2 +- .../LAPACKE/src/lapacke_dsyev_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_dsyevd.c | 4 +- .../LAPACKE/src/lapacke_dsyevd_2stage.c | 4 +- .../LAPACKE/src/lapacke_dsyevd_2stage_work.c | 4 +- .../LAPACKE/src/lapacke_dsyevd_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_dsyevr.c | 2 +- .../LAPACKE/src/lapacke_dsyevr_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dsygvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dsytrs2.c | 2 +- .../LAPACKE/src/lapacke_dsytrs2_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dtgsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_dtprfb.c | 37 +- lapack-netlib/LAPACKE/src/lapacke_dtrsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sgeesx.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sgejsv.c | 3 - lapack-netlib/LAPACKE/src/lapacke_sgelsd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c | 106 + .../LAPACKE/src/lapacke_sgesvdq_work.c | 148 + lapack-netlib/LAPACKE/src/lapacke_sggesx.c | 2 +- .../LAPACKE/src/lapacke_slantr_work.c | 19 +- lapack-netlib/LAPACKE/src/lapacke_sormhr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ssbevd.c | 2 +- .../LAPACKE/src/lapacke_ssbevd_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ssbgvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sspevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sspgvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sstedc.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sstegr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sstemr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sstevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_sstevr.c | 2 +- .../LAPACKE/src/lapacke_ssyev_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_ssyevd.c | 4 +- .../LAPACKE/src/lapacke_ssyevd_2stage.c | 4 +- .../LAPACKE/src/lapacke_ssyevd_2stage_work.c | 4 +- .../LAPACKE/src/lapacke_ssyevd_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_ssyevr.c | 2 +- .../LAPACKE/src/lapacke_ssyevr_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ssygvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ssytrs2.c | 2 +- .../LAPACKE/src/lapacke_ssytrs2_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_stgsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_stprfb.c | 37 +- lapack-netlib/LAPACKE/src/lapacke_strsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zgejsv.c | 3 - lapack-netlib/LAPACKE/src/lapacke_zgelsd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c | 106 + .../LAPACKE/src/lapacke_zgesvdq_work.c | 149 + lapack-netlib/LAPACKE/src/lapacke_zggesx.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhbevd.c | 2 +- .../LAPACKE/src/lapacke_zhbevd_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c | 2 +- .../LAPACKE/src/lapacke_zheev_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_zheevd.c | 4 +- .../LAPACKE/src/lapacke_zheevd_2stage.c | 4 +- .../LAPACKE/src/lapacke_zheevd_2stage_work.c | 4 +- .../LAPACKE/src/lapacke_zheevd_work.c | 4 +- lapack-netlib/LAPACKE/src/lapacke_zheevr.c | 2 +- .../LAPACKE/src/lapacke_zheevr_2stage.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhegst.c | 2 +- .../LAPACKE/src/lapacke_zhegst_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhegvd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhpevd.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c | 2 +- .../LAPACKE/src/lapacke_zlantr_work.c | 19 +- lapack-netlib/LAPACKE/src/lapacke_zstedc.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zstegr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zstemr.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c | 2 +- .../LAPACKE/src/lapacke_zsytrs2_work.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ztgsen.c | 2 +- lapack-netlib/LAPACKE/src/lapacke_ztprfb.c | 38 +- lapack-netlib/LAPACKE/src/lapacke_zunmhr.c | 2 +- lapack-netlib/LAPACKE/utils/Makefile | 17 +- .../LAPACKE/utils/lapacke_chp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_cpf_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_cpp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_csp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_ctp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_dpf_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_dpp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_dsp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_dtp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_spf_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_spp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_ssp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_stp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_zhp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_zpf_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_zpp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_zsp_nancheck.c | 2 +- .../LAPACKE/utils/lapacke_ztp_nancheck.c | 2 +- lapack-netlib/Makefile | 49 +- lapack-netlib/README.md | 13 +- lapack-netlib/SRC/CMakeLists.txt | 26 +- lapack-netlib/SRC/Makefile | 91 +- lapack-netlib/SRC/VARIANTS/Makefile | 22 +- lapack-netlib/SRC/VARIANTS/README | 12 +- lapack-netlib/SRC/cgbrfsx.f | 12 +- lapack-netlib/SRC/cgbsvxx.f | 10 +- lapack-netlib/SRC/cgebak.f | 8 +- lapack-netlib/SRC/cgeev.f | 2 +- lapack-netlib/SRC/cgejsv.f | 66 +- lapack-netlib/SRC/cgelq.f | 19 +- lapack-netlib/SRC/cgelq2.f | 18 +- lapack-netlib/SRC/cgelqf.f | 16 +- lapack-netlib/SRC/cgelqt.f | 1 + lapack-netlib/SRC/cgelqt3.f | 2 + lapack-netlib/SRC/cgemlq.f | 3 +- lapack-netlib/SRC/cgemlqt.f | 2 + lapack-netlib/SRC/cgemqr.f | 3 +- lapack-netlib/SRC/cgeqr.f | 20 +- lapack-netlib/SRC/cgeqr2.f | 19 +- lapack-netlib/SRC/cgeqr2p.f | 20 +- lapack-netlib/SRC/cgeqrf.f | 17 +- lapack-netlib/SRC/cgeqrfp.f | 20 +- lapack-netlib/SRC/cgerfsx.f | 12 +- lapack-netlib/SRC/cgesc2.f | 2 +- lapack-netlib/SRC/cgesvdq.f | 1391 ++ lapack-netlib/SRC/cgesvj.f | 46 +- lapack-netlib/SRC/cgesvxx.f | 10 +- lapack-netlib/SRC/cgetsls.f | 2 + lapack-netlib/SRC/cggesx.f | 8 +- lapack-netlib/SRC/cgsvj0.f | 18 +- lapack-netlib/SRC/cgsvj1.f | 20 +- lapack-netlib/SRC/chb2st_kernels.f | 70 +- lapack-netlib/SRC/checon_3.f | 9 +- lapack-netlib/SRC/cheevr.f | 2 +- lapack-netlib/SRC/cheevr_2stage.f | 2 +- lapack-netlib/SRC/chegs2.f | 1 + lapack-netlib/SRC/chegst.f | 1 + lapack-netlib/SRC/cherfsx.f | 12 +- lapack-netlib/SRC/chesv_aa.f | 6 +- lapack-netlib/SRC/chesv_aa_2stage.f | 4 +- lapack-netlib/SRC/chesvxx.f | 16 +- lapack-netlib/SRC/chetf2_rk.f | 4 +- lapack-netlib/SRC/chetrd_2stage.f | 13 +- lapack-netlib/SRC/chetrd_hb2st.F | 4 +- lapack-netlib/SRC/chetrd_he2hb.f | 2 +- lapack-netlib/SRC/chetrf_aa.f | 8 +- lapack-netlib/SRC/chetrf_aa_2stage.f | 34 +- lapack-netlib/SRC/chetri2.f | 4 +- lapack-netlib/SRC/chetrs_aa.f | 132 +- lapack-netlib/SRC/chetrs_aa_2stage.f | 10 +- lapack-netlib/SRC/chseqr.f | 44 +- lapack-netlib/SRC/cla_gbrcond_c.f | 4 +- lapack-netlib/SRC/cla_gbrcond_x.f | 4 +- lapack-netlib/SRC/cla_gbrfsx_extended.f | 12 +- lapack-netlib/SRC/cla_gercond_c.f | 8 +- lapack-netlib/SRC/cla_gercond_x.f | 4 +- lapack-netlib/SRC/cla_gerfsx_extended.f | 12 +- lapack-netlib/SRC/cla_hercond_c.f | 4 +- lapack-netlib/SRC/cla_hercond_x.f | 4 +- lapack-netlib/SRC/cla_herfsx_extended.f | 8 +- lapack-netlib/SRC/cla_porcond_c.f | 4 +- lapack-netlib/SRC/cla_porcond_x.f | 4 +- lapack-netlib/SRC/cla_porfsx_extended.f | 8 +- lapack-netlib/SRC/cla_porpvgrw.f | 2 +- lapack-netlib/SRC/cla_syrcond_c.f | 4 +- lapack-netlib/SRC/cla_syrcond_x.f | 4 +- lapack-netlib/SRC/cla_syrfsx_extended.f | 8 +- lapack-netlib/SRC/cla_syrpvgrw.f | 2 +- lapack-netlib/SRC/cla_wwaddw.f | 2 +- lapack-netlib/SRC/clahef_aa.f | 42 +- lapack-netlib/SRC/clahef_rk.f | 4 +- lapack-netlib/SRC/clahqr.f | 14 +- lapack-netlib/SRC/clamswlq.f | 1 + lapack-netlib/SRC/clamtsqr.f | 1 + lapack-netlib/SRC/clangb.f | 23 +- lapack-netlib/SRC/clange.f | 22 +- lapack-netlib/SRC/clanhb.f | 48 +- lapack-netlib/SRC/clanhe.f | 45 +- lapack-netlib/SRC/clanhp.f | 46 +- lapack-netlib/SRC/clanhs.f | 23 +- lapack-netlib/SRC/clansb.f | 42 +- lapack-netlib/SRC/clansp.f | 54 +- lapack-netlib/SRC/clansy.f | 40 +- lapack-netlib/SRC/clantb.f | 55 +- lapack-netlib/SRC/clantp.f | 53 +- lapack-netlib/SRC/clantr.f | 56 +- lapack-netlib/SRC/claqps.f | 2 +- lapack-netlib/SRC/claqr0.f | 34 +- lapack-netlib/SRC/claqr1.f | 2 +- lapack-netlib/SRC/claqr2.f | 18 +- lapack-netlib/SRC/claqr3.f | 18 +- lapack-netlib/SRC/claqr4.f | 34 +- lapack-netlib/SRC/claqr5.f | 52 +- lapack-netlib/SRC/clarfb.f | 2 + lapack-netlib/SRC/clarfx.f | 2 +- lapack-netlib/SRC/clarfy.f | 2 +- lapack-netlib/SRC/clarrv.f | 2 +- lapack-netlib/SRC/classq.f | 4 +- lapack-netlib/SRC/claswlq.f | 20 +- lapack-netlib/SRC/clasyf_aa.f | 48 +- lapack-netlib/SRC/clasyf_rk.f | 4 +- lapack-netlib/SRC/clatdf.f | 2 +- lapack-netlib/SRC/clatsqr.f | 25 +- lapack-netlib/SRC/claunhr_col_getrfnp.f | 248 + lapack-netlib/SRC/claunhr_col_getrfnp2.f | 314 + lapack-netlib/SRC/cporfsx.f | 16 +- lapack-netlib/SRC/cposvxx.f | 14 +- lapack-netlib/SRC/cpotrf2.f | 4 +- lapack-netlib/SRC/cstemr.f | 4 +- lapack-netlib/SRC/csycon_3.f | 9 +- lapack-netlib/SRC/csyconvf.f | 8 +- lapack-netlib/SRC/csyconvf_rook.f | 8 +- lapack-netlib/SRC/csyrfsx.f | 10 +- lapack-netlib/SRC/csysv_aa.f | 12 +- lapack-netlib/SRC/csysv_aa_2stage.f | 6 +- lapack-netlib/SRC/csysvxx.f | 10 +- lapack-netlib/SRC/csytf2_rk.f | 4 +- lapack-netlib/SRC/csytrf.f | 2 +- lapack-netlib/SRC/csytrf_aa.f | 12 +- lapack-netlib/SRC/csytrf_aa_2stage.f | 26 +- lapack-netlib/SRC/csytri2.f | 4 +- lapack-netlib/SRC/csytrs2.f | 2 +- lapack-netlib/SRC/csytrs_aa.f | 117 +- lapack-netlib/SRC/csytrs_aa_2stage.f | 18 +- lapack-netlib/SRC/ctgsy2.f | 18 +- lapack-netlib/SRC/ctplqt.f | 2 + lapack-netlib/SRC/ctplqt2.f | 2 + lapack-netlib/SRC/ctpmlqt.f | 4 +- lapack-netlib/SRC/ctpmqrt.f | 2 +- lapack-netlib/SRC/ctprfb.f | 4 +- lapack-netlib/SRC/cungtsqr.f | 307 + lapack-netlib/SRC/cunhr_col.f | 441 + lapack-netlib/SRC/dbdsqr.f | 2 +- lapack-netlib/SRC/dbdsvdx.f | 2 +- lapack-netlib/SRC/dcombssq.f | 92 + lapack-netlib/SRC/dgbrfsx.f | 10 +- lapack-netlib/SRC/dgbsvxx.f | 10 +- lapack-netlib/SRC/dgebak.f | 8 +- lapack-netlib/SRC/dgeesx.f | 4 +- lapack-netlib/SRC/dgejsv.f | 56 +- lapack-netlib/SRC/dgelq.f | 19 +- lapack-netlib/SRC/dgelq2.f | 18 +- lapack-netlib/SRC/dgelqf.f | 16 +- lapack-netlib/SRC/dgemlq.f | 3 +- lapack-netlib/SRC/dgemqr.f | 3 +- lapack-netlib/SRC/dgeqr.f | 20 +- lapack-netlib/SRC/dgeqr2.f | 19 +- lapack-netlib/SRC/dgeqr2p.f | 20 +- lapack-netlib/SRC/dgeqrf.f | 17 +- lapack-netlib/SRC/dgeqrfp.f | 20 +- lapack-netlib/SRC/dgerfsx.f | 10 +- lapack-netlib/SRC/dgesc2.f | 4 +- lapack-netlib/SRC/dgesdd.f | 4 +- lapack-netlib/SRC/dgesvdq.f | 1385 ++ lapack-netlib/SRC/dgesvj.f | 44 +- lapack-netlib/SRC/dgesvxx.f | 10 +- lapack-netlib/SRC/dgetc2.f | 2 +- lapack-netlib/SRC/dgetsls.f | 2 + lapack-netlib/SRC/dggesx.f | 8 +- lapack-netlib/SRC/dgsvj0.f | 20 +- lapack-netlib/SRC/dgsvj1.f | 30 +- lapack-netlib/SRC/dhseqr.f | 46 +- lapack-netlib/SRC/dla_gbrcond.f | 4 +- lapack-netlib/SRC/dla_gbrfsx_extended.f | 12 +- lapack-netlib/SRC/dla_gercond.f | 4 +- lapack-netlib/SRC/dla_gerfsx_extended.f | 12 +- lapack-netlib/SRC/dla_porcond.f | 4 +- lapack-netlib/SRC/dla_porfsx_extended.f | 8 +- lapack-netlib/SRC/dla_porpvgrw.f | 2 +- lapack-netlib/SRC/dla_syrcond.f | 4 +- lapack-netlib/SRC/dla_syrfsx_extended.f | 8 +- lapack-netlib/SRC/dla_syrpvgrw.f | 2 +- lapack-netlib/SRC/dla_wwaddw.f | 2 +- lapack-netlib/SRC/dlaed4.f | 2 +- lapack-netlib/SRC/dlaed8.f | 2 +- lapack-netlib/SRC/dlagtf.f | 6 +- lapack-netlib/SRC/dlagts.f | 20 +- lapack-netlib/SRC/dlahqr.f | 14 +- lapack-netlib/SRC/dlaln2.f | 2 +- lapack-netlib/SRC/dlamswlq.f | 1 + lapack-netlib/SRC/dlamtsqr.f | 1 + lapack-netlib/SRC/dlangb.f | 26 +- lapack-netlib/SRC/dlange.f | 22 +- lapack-netlib/SRC/dlanhs.f | 25 +- lapack-netlib/SRC/dlansb.f | 44 +- lapack-netlib/SRC/dlansp.f | 48 +- lapack-netlib/SRC/dlansy.f | 42 +- lapack-netlib/SRC/dlantb.f | 57 +- lapack-netlib/SRC/dlantp.f | 55 +- lapack-netlib/SRC/dlantr.f | 58 +- lapack-netlib/SRC/dlanv2.f | 8 +- lapack-netlib/SRC/dlaorhr_col_getrfnp.f | 248 + lapack-netlib/SRC/dlaorhr_col_getrfnp2.f | 305 + lapack-netlib/SRC/dlaqps.f | 2 +- lapack-netlib/SRC/dlaqr0.f | 38 +- lapack-netlib/SRC/dlaqr1.f | 2 +- lapack-netlib/SRC/dlaqr2.f | 18 +- lapack-netlib/SRC/dlaqr3.f | 18 +- lapack-netlib/SRC/dlaqr4.f | 38 +- lapack-netlib/SRC/dlaqr5.f | 52 +- lapack-netlib/SRC/dlarfb.f | 2 + lapack-netlib/SRC/dlarfx.f | 2 +- lapack-netlib/SRC/dlarfy.f | 2 +- lapack-netlib/SRC/dlarrb.f | 4 +- lapack-netlib/SRC/dlarre.f | 2 +- lapack-netlib/SRC/dlarrj.f | 2 +- lapack-netlib/SRC/dlarrv.f | 2 +- lapack-netlib/SRC/dlasd7.f | 2 +- lapack-netlib/SRC/dlasr.f | 2 +- lapack-netlib/SRC/dlassq.f | 2 +- lapack-netlib/SRC/dlaswlq.f | 20 +- lapack-netlib/SRC/dlasyf_aa.f | 42 +- lapack-netlib/SRC/dlasyf_rk.f | 4 +- lapack-netlib/SRC/dlasyf_rook.f | 2 +- lapack-netlib/SRC/dlatdf.f | 4 +- lapack-netlib/SRC/dlatsqr.f | 23 +- lapack-netlib/SRC/dorgtsqr.f | 306 + lapack-netlib/SRC/dorhr_col.f | 440 + lapack-netlib/SRC/dporfsx.f | 12 +- lapack-netlib/SRC/dposvxx.f | 10 +- lapack-netlib/SRC/dsb2st_kernels.f | 70 +- lapack-netlib/SRC/dsbgvx.f | 6 +- lapack-netlib/SRC/dsgesv.f | 10 +- lapack-netlib/SRC/dsposv.f | 6 +- lapack-netlib/SRC/dstemr.f | 4 +- lapack-netlib/SRC/dsyconvf.f | 8 +- lapack-netlib/SRC/dsyconvf_rook.f | 8 +- lapack-netlib/SRC/dsyev_2stage.f | 2 +- lapack-netlib/SRC/dsyevd_2stage.f | 2 +- lapack-netlib/SRC/dsyrfsx.f | 10 +- lapack-netlib/SRC/dsysv_aa.f | 6 +- lapack-netlib/SRC/dsysv_aa_2stage.f | 4 +- lapack-netlib/SRC/dsysvxx.f | 10 +- lapack-netlib/SRC/dsytf2_rk.f | 4 +- lapack-netlib/SRC/dsytrd_2stage.f | 13 +- lapack-netlib/SRC/dsytrd_sb2st.F | 4 +- lapack-netlib/SRC/dsytrd_sy2sb.f | 2 +- lapack-netlib/SRC/dsytrf.f | 6 +- lapack-netlib/SRC/dsytrf_aa.f | 8 +- lapack-netlib/SRC/dsytrf_aa_2stage.f | 58 +- lapack-netlib/SRC/dsytri2.f | 4 +- lapack-netlib/SRC/dsytrs_aa.f | 112 +- lapack-netlib/SRC/dsytrs_aa_2stage.f | 18 +- lapack-netlib/SRC/dtgsy2.f | 4 +- lapack-netlib/SRC/dtgsyl.f | 14 +- lapack-netlib/SRC/dtpmlqt.f | 2 +- lapack-netlib/SRC/dtpmqrt.f | 2 +- lapack-netlib/SRC/dtprfb.f | 4 +- lapack-netlib/SRC/ilaenv.f | 17 +- lapack-netlib/SRC/ilaenv2stage.f | 4 +- lapack-netlib/SRC/iparam2stage.F | 10 +- lapack-netlib/SRC/iparmq.f | 6 +- lapack-netlib/SRC/meson.build | 11 + lapack-netlib/SRC/sbdsvdx.f | 2 +- lapack-netlib/SRC/scombssq.f | 92 + lapack-netlib/SRC/sgbrfsx.f | 10 +- lapack-netlib/SRC/sgbsvxx.f | 10 +- lapack-netlib/SRC/sgebak.f | 8 +- lapack-netlib/SRC/sgeesx.f | 4 +- lapack-netlib/SRC/sgejsv.f | 54 +- lapack-netlib/SRC/sgelq.f | 19 +- lapack-netlib/SRC/sgelq2.f | 18 +- lapack-netlib/SRC/sgelqf.f | 16 +- lapack-netlib/SRC/sgelqt.f | 2 + lapack-netlib/SRC/sgelqt3.f | 2 + lapack-netlib/SRC/sgemlq.f | 3 +- lapack-netlib/SRC/sgemlqt.f | 2 + lapack-netlib/SRC/sgemqr.f | 3 +- lapack-netlib/SRC/sgeqr.f | 20 +- lapack-netlib/SRC/sgeqr2.f | 19 +- lapack-netlib/SRC/sgeqr2p.f | 20 +- lapack-netlib/SRC/sgeqrf.f | 17 +- lapack-netlib/SRC/sgeqrfp.f | 20 +- lapack-netlib/SRC/sgerfsx.f | 10 +- lapack-netlib/SRC/sgesc2.f | 4 +- lapack-netlib/SRC/sgesdd.f | 4 +- lapack-netlib/SRC/sgesvdq.f | 1388 ++ lapack-netlib/SRC/sgesvj.f | 44 +- lapack-netlib/SRC/sgesvxx.f | 10 +- lapack-netlib/SRC/sgetc2.f | 2 +- lapack-netlib/SRC/sgetsls.f | 4 +- lapack-netlib/SRC/sggesx.f | 8 +- lapack-netlib/SRC/sgsvj0.f | 20 +- lapack-netlib/SRC/sgsvj1.f | 20 +- lapack-netlib/SRC/shseqr.f | 46 +- lapack-netlib/SRC/sla_gbrcond.f | 4 +- lapack-netlib/SRC/sla_gbrfsx_extended.f | 12 +- lapack-netlib/SRC/sla_gercond.f | 4 +- lapack-netlib/SRC/sla_gerfsx_extended.f | 12 +- lapack-netlib/SRC/sla_porcond.f | 4 +- lapack-netlib/SRC/sla_porfsx_extended.f | 8 +- lapack-netlib/SRC/sla_syrcond.f | 4 +- lapack-netlib/SRC/sla_syrfsx_extended.f | 8 +- lapack-netlib/SRC/sla_syrpvgrw.f | 2 +- lapack-netlib/SRC/sla_wwaddw.f | 2 +- lapack-netlib/SRC/slaed4.f | 2 +- lapack-netlib/SRC/slaed8.f | 2 +- lapack-netlib/SRC/slagtf.f | 6 +- lapack-netlib/SRC/slagts.f | 20 +- lapack-netlib/SRC/slahqr.f | 14 +- lapack-netlib/SRC/slaln2.f | 2 +- lapack-netlib/SRC/slamswlq.f | 1 + lapack-netlib/SRC/slamtsqr.f | 1 + lapack-netlib/SRC/slangb.f | 26 +- lapack-netlib/SRC/slange.f | 22 +- lapack-netlib/SRC/slanhs.f | 25 +- lapack-netlib/SRC/slansb.f | 44 +- lapack-netlib/SRC/slansp.f | 48 +- lapack-netlib/SRC/slansy.f | 42 +- lapack-netlib/SRC/slantb.f | 57 +- lapack-netlib/SRC/slantp.f | 55 +- lapack-netlib/SRC/slantr.f | 58 +- lapack-netlib/SRC/slanv2.f | 8 +- lapack-netlib/SRC/slaorhr_col_getrfnp.f | 248 + lapack-netlib/SRC/slaorhr_col_getrfnp2.f | 305 + lapack-netlib/SRC/slaqps.f | 2 +- lapack-netlib/SRC/slaqr0.f | 38 +- lapack-netlib/SRC/slaqr1.f | 2 +- lapack-netlib/SRC/slaqr2.f | 18 +- lapack-netlib/SRC/slaqr3.f | 18 +- lapack-netlib/SRC/slaqr4.f | 38 +- lapack-netlib/SRC/slaqr5.f | 52 +- lapack-netlib/SRC/slarfb.f | 2 + lapack-netlib/SRC/slarfx.f | 2 +- lapack-netlib/SRC/slarfy.f | 2 +- lapack-netlib/SRC/slarrb.f | 4 +- lapack-netlib/SRC/slarre.f | 2 +- lapack-netlib/SRC/slarrj.f | 2 +- lapack-netlib/SRC/slarrv.f | 2 +- lapack-netlib/SRC/slasd7.f | 2 +- lapack-netlib/SRC/slassq.f | 2 +- lapack-netlib/SRC/slaswlq.f | 22 +- lapack-netlib/SRC/slasyf_aa.f | 42 +- lapack-netlib/SRC/slasyf_rk.f | 4 +- lapack-netlib/SRC/slatdf.f | 4 +- lapack-netlib/SRC/slatsqr.f | 23 +- lapack-netlib/SRC/sorgtsqr.f | 306 + lapack-netlib/SRC/sorhr_col.f | 439 + lapack-netlib/SRC/sporfsx.f | 12 +- lapack-netlib/SRC/sposvxx.f | 10 +- lapack-netlib/SRC/ssb2st_kernels.f | 70 +- lapack-netlib/SRC/ssbgvx.f | 6 +- lapack-netlib/SRC/sstemr.f | 4 +- lapack-netlib/SRC/ssyconvf.f | 8 +- lapack-netlib/SRC/ssyconvf_rook.f | 8 +- lapack-netlib/SRC/ssyev_2stage.f | 2 +- lapack-netlib/SRC/ssyevd_2stage.f | 2 +- lapack-netlib/SRC/ssyrfsx.f | 10 +- lapack-netlib/SRC/ssysv_aa.f | 6 +- lapack-netlib/SRC/ssysv_aa_2stage.f | 4 +- lapack-netlib/SRC/ssysvxx.f | 10 +- lapack-netlib/SRC/ssytf2_rk.f | 4 +- lapack-netlib/SRC/ssytrd_2stage.f | 13 +- lapack-netlib/SRC/ssytrd_sb2st.F | 4 +- lapack-netlib/SRC/ssytrd_sy2sb.f | 2 +- lapack-netlib/SRC/ssytrf.f | 6 +- lapack-netlib/SRC/ssytrf_aa.f | 8 +- lapack-netlib/SRC/ssytrf_aa_2stage.f | 26 +- lapack-netlib/SRC/ssytri2.f | 4 +- lapack-netlib/SRC/ssytrs_aa.f | 128 +- lapack-netlib/SRC/ssytrs_aa_2stage.f | 18 +- lapack-netlib/SRC/stgsy2.f | 4 +- lapack-netlib/SRC/stgsyl.f | 14 +- lapack-netlib/SRC/stpmlqt.f | 2 +- lapack-netlib/SRC/stpmqrt.f | 2 +- lapack-netlib/SRC/stprfb.f | 4 +- lapack-netlib/SRC/zcgesv.f | 10 +- lapack-netlib/SRC/zcposv.f | 6 +- lapack-netlib/SRC/zgbrfsx.f | 12 +- lapack-netlib/SRC/zgbsvxx.f | 10 +- lapack-netlib/SRC/zgebak.f | 8 +- lapack-netlib/SRC/zgeev.f | 2 +- lapack-netlib/SRC/zgejsv.f | 64 +- lapack-netlib/SRC/zgelq.f | 19 +- lapack-netlib/SRC/zgelq2.f | 18 +- lapack-netlib/SRC/zgelqf.f | 16 +- lapack-netlib/SRC/zgemlq.f | 3 +- lapack-netlib/SRC/zgemqr.f | 3 +- lapack-netlib/SRC/zgeqr.f | 20 +- lapack-netlib/SRC/zgeqr2.f | 19 +- lapack-netlib/SRC/zgeqr2p.f | 20 +- lapack-netlib/SRC/zgeqrf.f | 17 +- lapack-netlib/SRC/zgeqrfp.f | 20 +- lapack-netlib/SRC/zgerfsx.f | 12 +- lapack-netlib/SRC/zgesc2.f | 2 +- lapack-netlib/SRC/zgesvdq.f | 1389 ++ lapack-netlib/SRC/zgesvdx.f | 2 +- lapack-netlib/SRC/zgesvj.f | 46 +- lapack-netlib/SRC/zgesvxx.f | 10 +- lapack-netlib/SRC/zgetsls.f | 2 + lapack-netlib/SRC/zggesx.f | 8 +- lapack-netlib/SRC/zgsvj0.f | 18 +- lapack-netlib/SRC/zgsvj1.f | 20 +- lapack-netlib/SRC/zhb2st_kernels.f | 70 +- lapack-netlib/SRC/zhecon_3.f | 9 +- lapack-netlib/SRC/zheevr.f | 2 +- lapack-netlib/SRC/zheevr_2stage.f | 2 +- lapack-netlib/SRC/zhegs2.f | 1 + lapack-netlib/SRC/zhegst.f | 1 + lapack-netlib/SRC/zherfsx.f | 12 +- lapack-netlib/SRC/zhesv_aa.f | 6 +- lapack-netlib/SRC/zhesv_aa_2stage.f | 8 +- lapack-netlib/SRC/zhesvxx.f | 16 +- lapack-netlib/SRC/zhetf2_rk.f | 4 +- lapack-netlib/SRC/zhetrd_2stage.f | 13 +- lapack-netlib/SRC/zhetrd_hb2st.F | 4 +- lapack-netlib/SRC/zhetrd_he2hb.f | 2 +- lapack-netlib/SRC/zhetrf_aa.f | 8 +- lapack-netlib/SRC/zhetrf_aa_2stage.f | 42 +- lapack-netlib/SRC/zhetri2.f | 4 +- lapack-netlib/SRC/zhetrs_aa.f | 124 +- lapack-netlib/SRC/zhetrs_aa_2stage.f | 30 +- lapack-netlib/SRC/zhseqr.f | 44 +- lapack-netlib/SRC/zla_gbrcond_c.f | 4 +- lapack-netlib/SRC/zla_gbrcond_x.f | 4 +- lapack-netlib/SRC/zla_gbrfsx_extended.f | 12 +- lapack-netlib/SRC/zla_gercond_c.f | 8 +- lapack-netlib/SRC/zla_gercond_x.f | 4 +- lapack-netlib/SRC/zla_gerfsx_extended.f | 12 +- lapack-netlib/SRC/zla_hercond_c.f | 4 +- lapack-netlib/SRC/zla_hercond_x.f | 4 +- lapack-netlib/SRC/zla_herfsx_extended.f | 8 +- lapack-netlib/SRC/zla_herpvgrw.f | 2 +- lapack-netlib/SRC/zla_porcond_c.f | 4 +- lapack-netlib/SRC/zla_porcond_x.f | 4 +- lapack-netlib/SRC/zla_porfsx_extended.f | 8 +- lapack-netlib/SRC/zla_porpvgrw.f | 2 +- lapack-netlib/SRC/zla_syrcond_c.f | 4 +- lapack-netlib/SRC/zla_syrcond_x.f | 4 +- lapack-netlib/SRC/zla_syrfsx_extended.f | 8 +- lapack-netlib/SRC/zla_syrpvgrw.f | 2 +- lapack-netlib/SRC/zla_wwaddw.f | 2 +- lapack-netlib/SRC/zlahef_aa.f | 42 +- lapack-netlib/SRC/zlahef_rk.f | 4 +- lapack-netlib/SRC/zlahqr.f | 14 +- lapack-netlib/SRC/zlamswlq.f | 1 + lapack-netlib/SRC/zlamtsqr.f | 1 + lapack-netlib/SRC/zlangb.f | 23 +- lapack-netlib/SRC/zlange.f | 22 +- lapack-netlib/SRC/zlanhb.f | 48 +- lapack-netlib/SRC/zlanhe.f | 45 +- lapack-netlib/SRC/zlanhp.f | 46 +- lapack-netlib/SRC/zlanhs.f | 23 +- lapack-netlib/SRC/zlansb.f | 42 +- lapack-netlib/SRC/zlansp.f | 54 +- lapack-netlib/SRC/zlansy.f | 40 +- lapack-netlib/SRC/zlantb.f | 55 +- lapack-netlib/SRC/zlantp.f | 53 +- lapack-netlib/SRC/zlantr.f | 56 +- lapack-netlib/SRC/zlaqps.f | 2 +- lapack-netlib/SRC/zlaqr0.f | 34 +- lapack-netlib/SRC/zlaqr1.f | 2 +- lapack-netlib/SRC/zlaqr2.f | 18 +- lapack-netlib/SRC/zlaqr3.f | 18 +- lapack-netlib/SRC/zlaqr4.f | 32 +- lapack-netlib/SRC/zlaqr5.f | 52 +- lapack-netlib/SRC/zlarfb.f | 2 + lapack-netlib/SRC/zlarfx.f | 2 +- lapack-netlib/SRC/zlarfy.f | 2 +- lapack-netlib/SRC/zlarrv.f | 2 +- lapack-netlib/SRC/zlassq.f | 4 +- lapack-netlib/SRC/zlaswlq.f | 20 +- lapack-netlib/SRC/zlasyf_aa.f | 42 +- lapack-netlib/SRC/zlasyf_rk.f | 4 +- lapack-netlib/SRC/zlatdf.f | 2 +- lapack-netlib/SRC/zlatsqr.f | 25 +- lapack-netlib/SRC/zlaunhr_col_getrfnp.f | 248 + lapack-netlib/SRC/zlaunhr_col_getrfnp2.f | 314 + lapack-netlib/SRC/zporfsx.f | 16 +- lapack-netlib/SRC/zposvxx.f | 14 +- lapack-netlib/SRC/zpotrf2.f | 4 +- lapack-netlib/SRC/zstemr.f | 4 +- lapack-netlib/SRC/zsycon_3.f | 9 +- lapack-netlib/SRC/zsyconvf.f | 8 +- lapack-netlib/SRC/zsyconvf_rook.f | 8 +- lapack-netlib/SRC/zsyrfsx.f | 10 +- lapack-netlib/SRC/zsysv_aa.f | 6 +- lapack-netlib/SRC/zsysv_aa_2stage.f | 6 +- lapack-netlib/SRC/zsysvxx.f | 10 +- lapack-netlib/SRC/zsytf2_rk.f | 4 +- lapack-netlib/SRC/zsytrf.f | 2 +- lapack-netlib/SRC/zsytrf_aa.f | 8 +- lapack-netlib/SRC/zsytrf_aa_2stage.f | 26 +- lapack-netlib/SRC/zsytri2.f | 4 +- lapack-netlib/SRC/zsytrs2.f | 2 +- lapack-netlib/SRC/zsytrs_aa.f | 112 +- lapack-netlib/SRC/zsytrs_aa_2stage.f | 18 +- lapack-netlib/SRC/ztgsy2.f | 4 +- lapack-netlib/SRC/ztpmlqt.f | 2 +- lapack-netlib/SRC/ztpmqrt.f | 2 +- lapack-netlib/SRC/ztprfb.f | 4 +- lapack-netlib/SRC/zungtsqr.f | 307 + lapack-netlib/SRC/zunhr_col.f | 441 + lapack-netlib/TESTING/CMakeLists.txt | 2 +- lapack-netlib/TESTING/EIG/Makefile | 35 +- lapack-netlib/TESTING/EIG/cbdt05.f | 1 + lapack-netlib/TESTING/EIG/cchkst.f | 2 +- lapack-netlib/TESTING/EIG/cchkst2stg.f | 2 +- lapack-netlib/TESTING/EIG/cdrgsx.f | 2 +- lapack-netlib/TESTING/EIG/cdrvbd.f | 199 +- lapack-netlib/TESTING/EIG/cerred.f | 59 +- lapack-netlib/TESTING/EIG/cget51.f | 17 +- lapack-netlib/TESTING/EIG/chbt21.f | 12 +- lapack-netlib/TESTING/EIG/chet21.f | 32 +- lapack-netlib/TESTING/EIG/chet22.f | 12 +- lapack-netlib/TESTING/EIG/chpt21.f | 35 +- lapack-netlib/TESTING/EIG/cstt21.f | 13 +- lapack-netlib/TESTING/EIG/dbdt05.f | 1 + lapack-netlib/TESTING/EIG/dchkst.f | 2 +- lapack-netlib/TESTING/EIG/dchkst2stg.f | 2 +- lapack-netlib/TESTING/EIG/ddrgsx.f | 2 +- lapack-netlib/TESTING/EIG/ddrvbd.f | 113 +- lapack-netlib/TESTING/EIG/derred.f | 59 +- lapack-netlib/TESTING/EIG/dget39.f | 2 +- lapack-netlib/TESTING/EIG/dsbt21.f | 11 +- lapack-netlib/TESTING/EIG/dspt21.f | 32 +- lapack-netlib/TESTING/EIG/dsyt21.f | 30 +- lapack-netlib/TESTING/EIG/dsyt22.f | 12 +- lapack-netlib/TESTING/EIG/sbdt05.f | 1 + lapack-netlib/TESTING/EIG/schkst.f | 2 +- lapack-netlib/TESTING/EIG/schkst2stg.f | 2 +- lapack-netlib/TESTING/EIG/sdrgsx.f | 2 +- lapack-netlib/TESTING/EIG/sdrvbd.f | 111 +- lapack-netlib/TESTING/EIG/serred.f | 59 +- lapack-netlib/TESTING/EIG/sget39.f | 2 +- lapack-netlib/TESTING/EIG/ssbt21.f | 11 +- lapack-netlib/TESTING/EIG/sspt21.f | 32 +- lapack-netlib/TESTING/EIG/ssyt21.f | 30 +- lapack-netlib/TESTING/EIG/ssyt22.f | 12 +- lapack-netlib/TESTING/EIG/zbdt05.f | 1 + lapack-netlib/TESTING/EIG/zchkst.f | 2 +- lapack-netlib/TESTING/EIG/zchkst2stg.f | 2 +- lapack-netlib/TESTING/EIG/zdrgev3.f | 2 +- lapack-netlib/TESTING/EIG/zdrgsx.f | 2 +- lapack-netlib/TESTING/EIG/zdrvbd.f | 196 +- lapack-netlib/TESTING/EIG/zerred.f | 59 +- lapack-netlib/TESTING/EIG/zget51.f | 17 +- lapack-netlib/TESTING/EIG/zhbt21.f | 12 +- lapack-netlib/TESTING/EIG/zhet21.f | 32 +- lapack-netlib/TESTING/EIG/zhet22.f | 12 +- lapack-netlib/TESTING/EIG/zhpt21.f | 36 +- lapack-netlib/TESTING/EIG/zstt21.f | 11 +- lapack-netlib/TESTING/LIN/CMakeLists.txt | 12 +- lapack-netlib/TESTING/LIN/Makefile | 75 +- lapack-netlib/TESTING/LIN/cchkaa.f | 40 +- lapack-netlib/TESTING/LIN/cchkunhr_col.f | 239 + lapack-netlib/TESTING/LIN/cdrvls.f | 25 +- lapack-netlib/TESTING/LIN/cdrvsy_rk.f | 3 +- lapack-netlib/TESTING/LIN/cerrunhr_col.f | 164 + lapack-netlib/TESTING/LIN/cerrvx.f | 4 +- lapack-netlib/TESTING/LIN/clahilb.f | 2 +- lapack-netlib/TESTING/LIN/ctsqr01.f | 26 +- lapack-netlib/TESTING/LIN/cunhr_col01.f | 390 + lapack-netlib/TESTING/LIN/dchkaa.f | 39 +- lapack-netlib/TESTING/LIN/dchkorhr_col.f | 239 + lapack-netlib/TESTING/LIN/ddrvls.f | 16 +- lapack-netlib/TESTING/LIN/derrorhr_col.f | 164 + lapack-netlib/TESTING/LIN/derrvx.f | 2 +- lapack-netlib/TESTING/LIN/dorhr_col01.f | 386 + lapack-netlib/TESTING/LIN/dtsqr01.f | 26 +- lapack-netlib/TESTING/LIN/schkaa.f | 35 +- lapack-netlib/TESTING/LIN/schkorhr_col.f | 239 + lapack-netlib/TESTING/LIN/sdrvls.f | 20 +- lapack-netlib/TESTING/LIN/serrorhr_col.f | 164 + lapack-netlib/TESTING/LIN/serrvx.f | 2 +- lapack-netlib/TESTING/LIN/sorhr_col01.f | 386 + lapack-netlib/TESTING/LIN/stsqr01.f | 26 +- lapack-netlib/TESTING/LIN/zchkaa.f | 43 +- lapack-netlib/TESTING/LIN/zchkunhr_col.f | 239 + lapack-netlib/TESTING/LIN/zdrvhe_rk.f | 1 + lapack-netlib/TESTING/LIN/zdrvls.f | 25 +- lapack-netlib/TESTING/LIN/zerrunhr_col.f | 164 + lapack-netlib/TESTING/LIN/zerrvx.f | 36 +- lapack-netlib/TESTING/LIN/zlahilb.f | 2 +- lapack-netlib/TESTING/LIN/ztsqr01.f | 26 +- lapack-netlib/TESTING/LIN/zunhr_col01.f | 390 + lapack-netlib/TESTING/MATGEN/Makefile | 43 +- lapack-netlib/TESTING/MATGEN/clahilb.f | 2 +- lapack-netlib/TESTING/MATGEN/clatm2.f | 2 +- lapack-netlib/TESTING/MATGEN/clatm3.f | 2 +- lapack-netlib/TESTING/MATGEN/clatmr.f | 30 +- lapack-netlib/TESTING/MATGEN/dlatm2.f | 2 +- lapack-netlib/TESTING/MATGEN/dlatm3.f | 2 +- lapack-netlib/TESTING/MATGEN/dlatmr.f | 30 +- lapack-netlib/TESTING/MATGEN/slatm2.f | 2 +- lapack-netlib/TESTING/MATGEN/slatm3.f | 2 +- lapack-netlib/TESTING/MATGEN/slatmr.f | 30 +- lapack-netlib/TESTING/MATGEN/zlahilb.f | 2 +- lapack-netlib/TESTING/MATGEN/zlatm2.f | 2 +- lapack-netlib/TESTING/MATGEN/zlatm3.f | 2 +- lapack-netlib/TESTING/MATGEN/zlatmr.f | 30 +- lapack-netlib/TESTING/Makefile | 188 +- lapack-netlib/TESTING/ctest.in | 1 + lapack-netlib/TESTING/dtest.in | 1 + lapack-netlib/TESTING/stest.in | 1 + lapack-netlib/TESTING/ztest.in | 1 + lapack-netlib/appveyor.yml | 64 - lapack-netlib/lapack_build.cmake | 8 +- lapack-netlib/lapack_testing.py | 16 +- lapack-netlib/make.inc.example | 34 +- lapack-netlib/meson.build | 28 + lapack-netlib/meson_options.txt | 3 + 812 files changed, 36335 insertions(+), 11964 deletions(-) create mode 100644 lapack-netlib/.appveyor.yml create mode 100644 lapack-netlib/BLAS/SRC/meson.build create mode 100644 lapack-netlib/LAPACKE/include/lapack.h create mode 100644 lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_cgesvdq_work.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_dgesvdq_work.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_sgesvdq_work.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c create mode 100644 lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c create mode 100644 lapack-netlib/SRC/cgesvdq.f create mode 100644 lapack-netlib/SRC/claunhr_col_getrfnp.f create mode 100644 lapack-netlib/SRC/claunhr_col_getrfnp2.f create mode 100644 lapack-netlib/SRC/cungtsqr.f create mode 100644 lapack-netlib/SRC/cunhr_col.f create mode 100644 lapack-netlib/SRC/dcombssq.f create mode 100644 lapack-netlib/SRC/dgesvdq.f create mode 100644 lapack-netlib/SRC/dlaorhr_col_getrfnp.f create mode 100644 lapack-netlib/SRC/dlaorhr_col_getrfnp2.f create mode 100644 lapack-netlib/SRC/dorgtsqr.f create mode 100644 lapack-netlib/SRC/dorhr_col.f create mode 100644 lapack-netlib/SRC/meson.build create mode 100644 lapack-netlib/SRC/scombssq.f create mode 100644 lapack-netlib/SRC/sgesvdq.f create mode 100644 lapack-netlib/SRC/slaorhr_col_getrfnp.f create mode 100644 lapack-netlib/SRC/slaorhr_col_getrfnp2.f create mode 100644 lapack-netlib/SRC/sorgtsqr.f create mode 100644 lapack-netlib/SRC/sorhr_col.f create mode 100644 lapack-netlib/SRC/zgesvdq.f create mode 100644 lapack-netlib/SRC/zlaunhr_col_getrfnp.f create mode 100644 lapack-netlib/SRC/zlaunhr_col_getrfnp2.f create mode 100644 lapack-netlib/SRC/zungtsqr.f create mode 100644 lapack-netlib/SRC/zunhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/cchkunhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/cerrunhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/cunhr_col01.f create mode 100644 lapack-netlib/TESTING/LIN/dchkorhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/derrorhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/dorhr_col01.f create mode 100644 lapack-netlib/TESTING/LIN/schkorhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/serrorhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/sorhr_col01.f create mode 100644 lapack-netlib/TESTING/LIN/zchkunhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/zerrunhr_col.f create mode 100644 lapack-netlib/TESTING/LIN/zunhr_col01.f delete mode 100644 lapack-netlib/appveyor.yml create mode 100644 lapack-netlib/meson.build create mode 100644 lapack-netlib/meson_options.txt diff --git a/Makefile b/Makefile index 60f189ef2..a22e16bab 100644 --- a/Makefile +++ b/Makefile @@ -247,21 +247,21 @@ prof_lapack : lapack_prebuild lapack_prebuild : ifeq ($(NOFORTRAN), $(filter 0,$(NOFORTRAN))) - -@echo "FORTRAN = $(FC)" > $(NETLIB_LAPACK_DIR)/make.inc - -@echo "OPTS = $(LAPACK_FFLAGS)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "FC = $(FC)" > $(NETLIB_LAPACK_DIR)/make.inc + -@echo "FFLAGS = $(LAPACK_FFLAGS)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "POPTS = $(LAPACK_FPFLAGS)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "NOOPT = -O0 $(LAPACK_NOOPT)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "FFLAGS_NOOPT = -O0 $(LAPACK_NOOPT)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "PNOOPT = $(LAPACK_FPFLAGS) -O0" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "LOADOPTS = $(FFLAGS) $(EXTRALIB)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "LDFLAGS = $(FFLAGS) $(EXTRALIB)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "CC = $(CC)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "override CFLAGS = $(LAPACK_CFLAGS)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "override ARCH = $(AR)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "ARCHFLAGS = $(ARFLAGS) -ru" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "AR = $(AR)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "ARFLAGS = $(ARFLAGS) -ru" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "RANLIB = $(RANLIB)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "LAPACKLIB = ../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "TMGLIB = ../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "LAPACKLIB = ../../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "TMGLIB = ../../../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "BLASLIB = ../../../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc - -@echo "LAPACKELIB = ../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc + -@echo "LAPACKELIB = ../../../$(LIBNAME)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "LAPACKLIB_P = ../$(LIBNAME_P)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "SUFFIX = $(SUFFIX)" >> $(NETLIB_LAPACK_DIR)/make.inc -@echo "PSUFFIX = $(PSUFFIX)" >> $(NETLIB_LAPACK_DIR)/make.inc @@ -319,7 +319,7 @@ lapack-test : ifneq ($(CROSS), 1) ( cd $(NETLIB_LAPACK_DIR)/INSTALL; make all; ./testlsame; ./testslamch; ./testdlamch; \ ./testsecond; ./testdsecnd; ./testieee; ./testversion ) - (cd $(NETLIB_LAPACK_DIR); ./lapack_testing.py -r ) + (cd $(NETLIB_LAPACK_DIR); ./lapack_testing.py -r -b TESTING) endif lapack-runtest: diff --git a/cmake/lapack.cmake b/cmake/lapack.cmake index d1d2cdd3b..18a74d18e 100644 --- a/cmake/lapack.cmake +++ b/cmake/lapack.cmake @@ -115,7 +115,9 @@ set(SLASRC stplqt.f stplqt2.f stpmlqt.f ssytrd_2stage.f ssytrd_sy2sb.f ssytrd_sb2st.F ssb2st_kernels.f ssyevd_2stage.f ssyev_2stage.f ssyevx_2stage.f ssyevr_2stage.f - ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f) + ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f + scombssq.f sgesvdq.f slaorhr_col_getrfnp.f + slaorhr_col_getrfnp2.f sorgtsqr.f sorhr_col.f ) set(SXLASRC sgesvxx.f sgerfsx.f sla_gerfsx_extended.f sla_geamv.f sla_gercond.f sla_gerpvgrw.f ssysvxx.f ssyrfsx.f @@ -210,7 +212,9 @@ set(CLASRC ctplqt.f ctplqt2.f ctpmlqt.f chetrd_2stage.f chetrd_he2hb.f chetrd_hb2st.F chb2st_kernels.f cheevd_2stage.f cheev_2stage.f cheevx_2stage.f cheevr_2stage.f - chbev_2stage.f chbevx_2stage.f chbevd_2stage.f chegv_2stage.f) + chbev_2stage.f chbevx_2stage.f chbevd_2stage.f chegv_2stage.f + cgesvdq.f claunhr_col_getrfnp.f claunhr_col_getrfnp2.f + cungtsqr.f cunhr_col.f ) set(CXLASRC cgesvxx.f cgerfsx.f cla_gerfsx_extended.f cla_geamv.f cla_gercond_c.f cla_gercond_x.f cla_gerpvgrw.f @@ -299,7 +303,9 @@ set(DLASRC dtplqt.f dtplqt2.f dtpmlqt.f dsytrd_2stage.f dsytrd_sy2sb.f dsytrd_sb2st.F dsb2st_kernels.f dsyevd_2stage.f dsyev_2stage.f dsyevx_2stage.f dsyevr_2stage.f - dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f) + dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f + dcombssq.f dgesvdq.f dlaorhr_col_getrfnp.f + dlaorhr_col_getrfnp2.f dorgtsqr.f dorhr_col.f ) set(DXLASRC dgesvxx.f dgerfsx.f dla_gerfsx_extended.f dla_geamv.f dla_gercond.f dla_gerpvgrw.f dsysvxx.f dsyrfsx.f @@ -398,7 +404,9 @@ set(ZLASRC zgelq.f zlaswlq.f zlamswlq.f zgemlq.f zhetrd_2stage.f zhetrd_he2hb.f zhetrd_hb2st.F zhb2st_kernels.f zheevd_2stage.f zheev_2stage.f zheevx_2stage.f zheevr_2stage.f - zhbev_2stage.f zhbevx_2stage.f zhbevd_2stage.f zhegv_2stage.f) + zhbev_2stage.f zhbevx_2stage.f zhbevd_2stage.f zhegv_2stage.f + zgesvdq.f zlaunhr_col_getrfnp.f zlaunhr_col_getrfnp2.f + zungtsqr.f zunhr_col.f) set(ZXLASRC zgesvxx.f zgerfsx.f zla_gerfsx_extended.f zla_geamv.f zla_gercond_c.f zla_gercond_x.f zla_gerpvgrw.f zsysvxx.f zsyrfsx.f diff --git a/cmake/lapacke.cmake b/cmake/lapacke.cmake index 0fc88b882..f10905c4d 100644 --- a/cmake/lapacke.cmake +++ b/cmake/lapacke.cmake @@ -715,6 +715,8 @@ set(DSRC lapacke_dgesv_work.c lapacke_dgesvd.c lapacke_dgesvd_work.c + lapacke_dgesvdq.c + lapacke_dgesvdq_work.c lapacke_dgesvdx.c lapacke_dgesvdx_work.c lapacke_dgesvj.c @@ -1287,6 +1289,8 @@ set(SSRC lapacke_sgesv_work.c lapacke_sgesvd.c lapacke_sgesvd_work.c + lapacke_sgesvdq.c + lapacke_sgesvdq_work.c lapacke_sgesvdx.c lapacke_sgesvdx_work.c lapacke_sgesvj.c @@ -1853,6 +1857,8 @@ set(ZSRC lapacke_zgesv_work.c lapacke_zgesvd.c lapacke_zgesvd_work.c + lapacke_zgesvdq.c + lapacke_zgesvdq_work.c lapacke_zgesvdx.c lapacke_zgesvdx_work.c lapacke_zgesvj.c diff --git a/exports/gensymbol b/exports/gensymbol index 37ba0b191..d2894e6c8 100644 --- a/exports/gensymbol +++ b/exports/gensymbol @@ -694,7 +694,19 @@ # functions added for lapack-3.8.0 - ilaenv2stage + ilaenv2stage, + + # functions added for lapack-3.9.0 + cgesvdq, + cungtsqr, + dcombssq, + dgesvdq, + dorgtsqr, + scombssq, + sgesvdq, + sorgtsqr, + zgesvdq, + zungtsqr ); @lapack_extendedprecision_objs = ( @@ -3347,6 +3359,15 @@ LAPACKE_zsytrf_aa_2stage_work, LAPACKE_zsytrs_aa_2stage, LAPACKE_zsytrs_aa_2stage_work, + + # new functions from 3.9.0 + LAPACKE_dgesvdq, + LAPACKE_dgesvdq_work, + LAPACKE_sgesvdq, + LAPACKE_sgesvdq_work, + LAPACKE_zgesvdq, + LAPACKE_zgesvdq_work + ); #These function may need 2 underscores. @@ -3419,7 +3440,13 @@ dsytrf_aa_2stage, dsytrs_aa_2stage, zhesv_aa_2stage, zhetrf_aa_2stage, zhetrs_aa_2stage, zsysv_aa_2stage, - zsytrf_aa_2stage, zsytrs_aa_2stage + zsytrf_aa_2stage, zsytrs_aa_2stage, +# 3.9.0 + claunhr_col_getrfnp, claunhr_col_getrfnp2, cunhr_col, + dlaorhr_col_getrfnp, dlaorhr_col_getrfnp2, dorhr_col, + slaorhr_col_getrfnp, slaorhr_col_getrfnp2, sorhr_col, + zlaunhr_col_getrfnp, zlaunhr_col_getrfnp2, zunhr_col + ); diff --git a/lapack-netlib/.appveyor.yml b/lapack-netlib/.appveyor.yml new file mode 100644 index 000000000..0c16dcf7b --- /dev/null +++ b/lapack-netlib/.appveyor.yml @@ -0,0 +1,38 @@ +image: +- Visual Studio 2017 + +configuration: Release +clone_depth: 3 + +matrix: + fast_finish: false + +skip_commits: +# Add [av skip] to commit messages + message: /\[av skip\]/ + +cache: + - '%APPVEYOR_BUILD_FOLDER%\build' + +environment: + global: + CONDA_INSTALL_LOCN: C:\\Miniconda36-x64 + +install: + - call %CONDA_INSTALL_LOCN%\Scripts\activate.bat + - conda config --add channels conda-forge --force + - conda install --yes --quiet flang jom + - call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" amd64 + - set "LIB=%CONDA_INSTALL_LOCN%\Library\lib;%LIB%" + - set "CPATH=%CONDA_INSTALL_LOCN%\Library\include;%CPATH%" + +before_build: + - ps: if (-Not (Test-Path .\build)) { mkdir build } + - cd build + - cmake -G "NMake Makefiles JOM" -DCMAKE_Fortran_COMPILER=flang -DCMAKE_BUILD_TYPE=Release -DBUILD_TESTING=ON .. + +build_script: + - cmake --build . + +test_script: + - ctest -j2 diff --git a/lapack-netlib/.gitignore b/lapack-netlib/.gitignore index 4ac90962e..015f09d77 100644 --- a/lapack-netlib/.gitignore +++ b/lapack-netlib/.gitignore @@ -35,3 +35,9 @@ LAPACKE/example/xexample* # SED SRC/*-e LAPACKE/src/*-e +build* + +# DOCS documentation +DOCS/man +DOCS/explore-html +output_err diff --git a/lapack-netlib/.travis.yml b/lapack-netlib/.travis.yml index 68cfa607a..04369dafb 100644 --- a/lapack-netlib/.travis.yml +++ b/lapack-netlib/.travis.yml @@ -1,33 +1,32 @@ -language: cpp +language: c +dist: xenial +group: travis_latest + +git: + depth: 3 + quiet: true addons: apt: - sources: - - george-edison55-precise-backports # cmake packages: - - cmake - - cmake-data - - gfortran - -os: - - linux - - osx - -env: - - CMAKE_BUILD_TYPE=Release - - CMAKE_BUILD_TYPE=Coverage + - gfortran -install: - - if [[ "$TRAVIS_OS_NAME" == "osx" ]]; - then - for pkg in gcc cmake; do - if brew list -1 | grep -q "^${pkg}\$"; then - brew outdated $pkg || brew upgrade $pkg; - else - brew install $pkg; - fi - done - fi +matrix: + include: + - os: linux + env: CMAKE_BUILD_TYPE=Release + - os: linux + env: CMAKE_BUILD_TYPE=Coverage + - os: osx + env: CMAKE_BUILD_TYPE=Release + before_install: + - brew update > /dev/null + - brew install gcc > /dev/null + - os: osx + env: CMAKE_BUILD_TYPE=Coverage + before_install: + - brew update > /dev/null + - brew install gcc > /dev/null script: - export PR=https://api.github.com/repos/$TRAVIS_REPO_SLUG/pulls/$TRAVIS_PULL_REQUEST diff --git a/lapack-netlib/BLAS/CMakeLists.txt b/lapack-netlib/BLAS/CMakeLists.txt index e122b2b33..ee5676fc6 100644 --- a/lapack-netlib/BLAS/CMakeLists.txt +++ b/lapack-netlib/BLAS/CMakeLists.txt @@ -6,4 +6,5 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/blas.pc.in ${CMAKE_CURRENT_BINARY_DIR install(FILES ${CMAKE_CURRENT_BINARY_DIR}/blas.pc DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development ) diff --git a/lapack-netlib/BLAS/Makefile b/lapack-netlib/BLAS/Makefile index f9c4b534c..088ea5d50 100644 --- a/lapack-netlib/BLAS/Makefile +++ b/lapack-netlib/BLAS/Makefile @@ -1,13 +1,18 @@ -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: blas +.PHONY: blas blas: $(MAKE) -C SRC +.PHONY: blas_testing blas_testing: blas $(MAKE) -C TESTING run +.PHONY: clean cleanobj cleanlib cleanexe cleantest clean: $(MAKE) -C SRC clean $(MAKE) -C TESTING clean diff --git a/lapack-netlib/BLAS/SRC/Makefile b/lapack-netlib/BLAS/SRC/Makefile index a436365aa..66bb96421 100644 --- a/lapack-netlib/BLAS/SRC/Makefile +++ b/lapack-netlib/BLAS/SRC/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ####################################################################### # This is the makefile to create a library for the BLAS. # The files are grouped as follows: @@ -55,6 +53,10 @@ include ../../make.inc # ####################################################################### +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + +.PHONY: all all: $(BLASLIB) #--------------------------------------------------------- @@ -138,33 +140,32 @@ ALLOBJ = $(SBLAS1) $(SBLAS2) $(SBLAS3) $(DBLAS1) $(DBLAS2) $(DBLAS3) \ $(ZBLAS2) $(ZBLAS3) $(ALLBLAS) $(BLASLIB): $(ALLOBJ) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +.PHONY: single double complex complex16 single: $(SBLAS1) $(ALLBLAS) $(SBLAS2) $(SBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) double: $(DBLAS1) $(ALLBLAS) $(DBLAS2) $(DBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) complex: $(CBLAS1) $(CB1AUX) $(ALLBLAS) $(CBLAS2) $(CBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) complex16: $(ZBLAS1) $(ZB1AUX) $(ALLBLAS) $(ZBLAS2) $(ZBLAS3) - $(ARCH) $(ARCHFLAGS) $(BLASLIB) $^ + $(AR) $(ARFLAGS) $(BLASLIB) $^ $(RANLIB) $(BLASLIB) FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: rm -f *.o cleanlib: #rm -f $(BLASLIB) # May point to a system lib, e.g. -lblas - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/lapack-netlib/BLAS/SRC/icamax.f b/lapack-netlib/BLAS/SRC/icamax.f index 8057ab095..02bc90ae4 100644 --- a/lapack-netlib/BLAS/SRC/icamax.f +++ b/lapack-netlib/BLAS/SRC/icamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of CX *> \endverbatim * * Authors: diff --git a/lapack-netlib/BLAS/SRC/idamax.f b/lapack-netlib/BLAS/SRC/idamax.f index 7268534db..1578ea950 100644 --- a/lapack-netlib/BLAS/SRC/idamax.f +++ b/lapack-netlib/BLAS/SRC/idamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of DX *> \endverbatim * * Authors: diff --git a/lapack-netlib/BLAS/SRC/izamax.f b/lapack-netlib/BLAS/SRC/izamax.f index 63d8e97de..c0aabb7bc 100644 --- a/lapack-netlib/BLAS/SRC/izamax.f +++ b/lapack-netlib/BLAS/SRC/izamax.f @@ -43,7 +43,7 @@ *> \param[in] INCX *> \verbatim *> INCX is INTEGER -*> storage spacing between elements of SX +*> storage spacing between elements of ZX *> \endverbatim * * Authors: diff --git a/lapack-netlib/BLAS/SRC/meson.build b/lapack-netlib/BLAS/SRC/meson.build new file mode 100644 index 000000000..8d96f2acd --- /dev/null +++ b/lapack-netlib/BLAS/SRC/meson.build @@ -0,0 +1,29 @@ +SBLAS1 = files('isamax.f', 'sasum.f', 'saxpy.f', 'scopy.f', 'sdot.f', 'snrm2.f', 'srot.f', 'srotg.f', 'sscal.f', 'sswap.f', 'sdsdot.f', 'srotmg.f', 'srotm.f') + +CBLAS1 = files('scabs1.f', 'scasum.f', 'scnrm2.f', 'icamax.f', 'caxpy.f', 'ccopy.f', 'cdotc.f', 'cdotu.f', 'csscal.f', 'crotg.f', 'cscal.f', 'cswap.f', 'csrot.f') + +DBLAS1 = files('idamax.f', 'dasum.f', 'daxpy.f', 'dcopy.f', 'ddot.f', 'dnrm2.f', 'drot.f', 'drotg.f', 'dscal.f', 'dsdot.f', 'dswap.f', 'drotmg.f', 'drotm.f') + +ZBLAS1 = files('dcabs1.f', 'dzasum.f', 'dznrm2.f', 'izamax.f', 'zaxpy.f', 'zcopy.f', 'zdotc.f', 'zdotu.f', 'zdscal.f', 'zrotg.f', 'zscal.f', 'zswap.f', 'zdrot.f') + +CB1AUX = files('isamax.f', 'sasum.f', 'saxpy.f', 'scopy.f', 'snrm2.f', 'sscal.f') + +ZB1AUX = files('idamax.f', 'dasum.f', 'daxpy.f', 'dcopy.f', 'dnrm2.f', 'dscal.f') + +ALLBLAS = files('lsame.f', 'xerbla.f', 'xerbla_array.f') + +SBLAS2 = files('sgemv.f', 'sgbmv.f', 'ssymv.f', 'ssbmv.f', 'sspmv.f', 'strmv.f', 'stbmv.f', 'stpmv.f', 'strsv.f', 'stbsv.f', 'stpsv.f', 'sger.f', 'ssyr.f', 'sspr.f', 'ssyr2.f', 'sspr2.f') + +CBLAS2 = files('cgemv.f', 'cgbmv.f', 'chemv.f', 'chbmv.f', 'chpmv.f', 'ctrmv.f', 'ctbmv.f', 'ctpmv.f', 'ctrsv.f', 'ctbsv.f', 'ctpsv.f', 'cgerc.f', 'cgeru.f', 'cher.f', 'chpr.f', 'cher2.f', 'chpr2.f') + +DBLAS2 = files('dgemv.f', 'dgbmv.f', 'dsymv.f', 'dsbmv.f', 'dspmv.f', 'dtrmv.f', 'dtbmv.f', 'dtpmv.f', 'dtrsv.f', 'dtbsv.f', 'dtpsv.f', 'dger.f', 'dsyr.f', 'dspr.f', 'dsyr2.f', 'dspr2.f') + +ZBLAS2 = files('zgemv.f', 'zgbmv.f', 'zhemv.f', 'zhbmv.f', 'zhpmv.f', 'ztrmv.f', 'ztbmv.f', 'ztpmv.f', 'ztrsv.f', 'ztbsv.f', 'ztpsv.f', 'zgerc.f', 'zgeru.f', 'zher.f', 'zhpr.f', 'zher2.f', 'zhpr2.f') + +SBLAS3 = files('sgemm.f', 'ssymm.f', 'ssyrk.f', 'ssyr2k.f', 'strmm.f', 'strsm.f') + +CBLAS3 = files('cgemm.f', 'csymm.f', 'csyrk.f', 'csyr2k.f', 'ctrmm.f', 'ctrsm.f', 'chemm.f', 'cherk.f', 'cher2k.f') + +DBLAS3 = files('dgemm.f', 'dsymm.f', 'dsyrk.f', 'dsyr2k.f', 'dtrmm.f', 'dtrsm.f') + +ZBLAS3 = files('zgemm.f', 'zsymm.f', 'zsyrk.f', 'zsyr2k.f', 'ztrmm.f', 'ztrsm.f', 'zhemm.f', 'zherk.f', 'zher2k.f') diff --git a/lapack-netlib/BLAS/SRC/sdsdot.f b/lapack-netlib/BLAS/SRC/sdsdot.f index a0ec32b6f..a491e6982 100644 --- a/lapack-netlib/BLAS/SRC/sdsdot.f +++ b/lapack-netlib/BLAS/SRC/sdsdot.f @@ -23,13 +23,13 @@ *> *> \verbatim *> -* Compute the inner product of two vectors with extended -* precision accumulation. -* -* Returns S.P. result with dot product accumulated in D.P. -* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), -* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is -* defined in a similar way using INCY. +*> Compute the inner product of two vectors with extended +*> precision accumulation. +*> +*> Returns S.P. result with dot product accumulated in D.P. +*> SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), +*> where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is +*> defined in a similar way using INCY. *> \endverbatim * * Arguments: @@ -77,7 +77,14 @@ *> \author Lawson, C. L., (JPL), Hanson, R. J., (SNLA), *> \author Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) * -*> \ingroup complex_blas_level1 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2017 +* +*> \ingroup single_blas_level1 * *> \par Further Details: * ===================== @@ -102,65 +109,7 @@ *> 920501 Reformatted the REFERENCES section. (WRB) *> 070118 Reformat to LAPACK coding style *> \endverbatim -* -* ===================================================================== -* -* .. Local Scalars .. -* DOUBLE PRECISION DSDOT -* INTEGER I,KX,KY,NS -* .. -* .. Intrinsic Functions .. -* INTRINSIC DBLE -* .. -* DSDOT = SB -* IF (N.LE.0) THEN -* SDSDOT = DSDOT -* RETURN -* END IF -* IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN -* -* Code for equal and positive increments. -* -* NS = N*INCX -* DO I = 1,NS,INCX -* DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I)) -* END DO -* ELSE -* -* Code for unequal or nonpositive increments. -* -* KX = 1 -* KY = 1 -* IF (INCX.LT.0) KX = 1 + (1-N)*INCX -* IF (INCY.LT.0) KY = 1 + (1-N)*INCY -* DO I = 1,N -* DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY)) -* KX = KX + INCX -* KY = KY + INCY -* END DO -* END IF -* SDSDOT = DSDOT -* RETURN -* END -* -*> \par Purpose: -* ============= *> -*> \verbatim -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date November 2017 -* -*> \ingroup single_blas_level1 -* * ===================================================================== REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY) * @@ -175,71 +124,6 @@ * .. * .. Array Arguments .. REAL SX(*),SY(*) -* .. -* -* PURPOSE -* ======= -* -* Compute the inner product of two vectors with extended -* precision accumulation. -* -* Returns S.P. result with dot product accumulated in D.P. -* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), -* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is -* defined in a similar way using INCY. -* -* AUTHOR -* ====== -* Lawson, C. L., (JPL), Hanson, R. J., (SNLA), -* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) -* -* ARGUMENTS -* ========= -* -* N (input) INTEGER -* number of elements in input vector(s) -* -* SB (input) REAL -* single precision scalar to be added to inner product -* -* SX (input) REAL array, dimension (N) -* single precision vector with N elements -* -* INCX (input) INTEGER -* storage spacing between elements of SX -* -* SY (input) REAL array, dimension (N) -* single precision vector with N elements -* -* INCY (input) INTEGER -* storage spacing between elements of SY -* -* SDSDOT (output) REAL -* single precision dot product (SB if N .LE. 0) -* -* Further Details -* =============== -* -* REFERENCES -* -* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. -* Krogh, Basic linear algebra subprograms for Fortran -* usage, Algorithm No. 539, Transactions on Mathematical -* Software 5, 3 (September 1979), pp. 308-323. -* -* REVISION HISTORY (YYMMDD) -* -* 791001 DATE WRITTEN -* 890531 Changed all specific intrinsics to generic. (WRB) -* 890831 Modified array declarations. (WRB) -* 890831 REVISION DATE from Version 3.2 -* 891214 Prologue converted to Version 4.0 format. (BAB) -* 920310 Corrected definition of LX in DESCRIPTION. (WRB) -* 920501 Reformatted the REFERENCES section. (WRB) -* 070118 Reformat to LAPACK coding style -* -* ===================================================================== -* * .. Local Scalars .. DOUBLE PRECISION DSDOT INTEGER I,KX,KY,NS diff --git a/lapack-netlib/BLAS/TESTING/Makefile b/lapack-netlib/BLAS/TESTING/Makefile index 97150b1a3..5b3b0d6ee 100644 --- a/lapack-netlib/BLAS/TESTING/Makefile +++ b/lapack-netlib/BLAS/TESTING/Makefile @@ -1,5 +1,7 @@ -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.PHONY: all single double complex complex16 all: single double complex complex16 single: xblat1s xblat2s xblat3s double: xblat1d xblat2d xblat3d @@ -7,32 +9,33 @@ complex: xblat1c xblat2c xblat3c complex16: xblat1z xblat2z xblat3z xblat1s: sblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1d: dblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1c: cblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat1z: zblat1.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2s: sblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2d: dblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2c: cblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat2z: zblat2.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3s: sblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3d: dblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3c: cblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xblat3z: zblat3.o $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ +.PHONY: run run: all ./xblat1s > sblat1.out ./xblat1d > dblat1.out @@ -47,6 +50,7 @@ run: all ./xblat3c < cblat3.in ./xblat3z < zblat3.in +.PHONY: clean cleanobj cleanexe cleantest clean: cleanobj cleanexe cleantest cleanobj: rm -f *.o @@ -54,6 +58,3 @@ cleanexe: rm -f xblat* cleantest: rm -f *.out core - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/lapack-netlib/BLAS/TESTING/cblat1.f b/lapack-netlib/BLAS/TESTING/cblat1.f index 036dca3e0..ecf2a44cb 100644 --- a/lapack-netlib/BLAS/TESTING/cblat1.f +++ b/lapack-netlib/BLAS/TESTING/cblat1.f @@ -619,7 +619,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/BLAS/TESTING/dblat1.f b/lapack-netlib/BLAS/TESTING/dblat1.f index f3255fef4..28af121cd 100644 --- a/lapack-netlib/BLAS/TESTING/dblat1.f +++ b/lapack-netlib/BLAS/TESTING/dblat1.f @@ -991,7 +991,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/BLAS/TESTING/sblat1.f b/lapack-netlib/BLAS/TESTING/sblat1.f index a5c1c6af6..fe05bbe87 100644 --- a/lapack-netlib/BLAS/TESTING/sblat1.f +++ b/lapack-netlib/BLAS/TESTING/sblat1.f @@ -946,7 +946,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/BLAS/TESTING/zblat1.f b/lapack-netlib/BLAS/TESTING/zblat1.f index 4b0bcf884..2d7b88490 100644 --- a/lapack-netlib/BLAS/TESTING/zblat1.f +++ b/lapack-netlib/BLAS/TESTING/zblat1.f @@ -619,7 +619,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/CBLAS/CMakeLists.txt b/lapack-netlib/CBLAS/CMakeLists.txt index d9fa24530..04c5ab795 100644 --- a/lapack-netlib/CBLAS/CMakeLists.txt +++ b/lapack-netlib/CBLAS/CMakeLists.txt @@ -12,8 +12,10 @@ FortranCInterface_HEADER(${LAPACK_BINARY_DIR}/include/cblas_mangling.h SYMBOL_NAMESPACE "F77_") if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND) message(WARNING "Reverting to pre-defined include/lapacke_mangling.h") - configure_file(include/lapacke_mangling_with_flags.h.in - ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h) + configure_file(include/lapacke_mangling_with_flags.h.in + ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h) + configure_file(include/cblas_mangling_with_flags.h.in + ${LAPACK_BINARY_DIR}/include/cblas_mangling.h) endif() include_directories(include ${LAPACK_BINARY_DIR}/include) @@ -28,7 +30,10 @@ endforeach() endmacro() append_subdir_files(CBLAS_INCLUDE "include") -install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}) +install(FILES ${CBLAS_INCLUDE} ${LAPACK_BINARY_DIR}/include/cblas_mangling.h + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} + COMPONENT Development + ) # -------------------------------------------------- if(BUILD_TESTING) @@ -45,7 +50,9 @@ endif() set(_cblas_config_install_guard_target "") if(ALL_TARGETS) install(EXPORT cblas-targets - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION}) + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION} + COMPONENT Development + ) # Choose one of the cblas targets to use as a guard for # cblas-config.cmake to load targets from the install tree. list(GET ALL_TARGETS 0 _cblas_config_install_guard_target) @@ -82,4 +89,6 @@ install(FILES ) #install(EXPORT cblas-targets -# DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION}) +# DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/cblas-${LAPACK_VERSION} +# COMPONENT Development +# ) diff --git a/lapack-netlib/CBLAS/Makefile b/lapack-netlib/CBLAS/Makefile index 513e8fc82..6e199cdce 100644 --- a/lapack-netlib/CBLAS/Makefile +++ b/lapack-netlib/CBLAS/Makefile @@ -1,19 +1,25 @@ -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: cblas +.PHONY: cblas cblas: include/cblas_mangling.h $(MAKE) -C src include/cblas_mangling.h: include/cblas_mangling_with_flags.h.in - cp $< $@ + cp include/cblas_mangling_with_flags.h.in $@ +.PHONY: cblas_testing cblas_testing: cblas $(MAKE) -C testing run +.PHONY: cblas_example cblas_example: cblas $(MAKE) -C examples +.PHONY: clean cleanobj cleanlib cleanexe cleantest clean: $(MAKE) -C src clean $(MAKE) -C testing clean diff --git a/lapack-netlib/CBLAS/examples/Makefile b/lapack-netlib/CBLAS/examples/Makefile index 664b8bc57..84acd6561 100644 --- a/lapack-netlib/CBLAS/examples/Makefile +++ b/lapack-netlib/CBLAS/examples/Makefile @@ -1,17 +1,21 @@ -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< + +.PHONY: all all: cblas_ex1 cblas_ex2 cblas_ex1: cblas_example1.o $(CBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ cblas_ex2: cblas_example2.o $(CBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ +.PHONY: clean cleanobj cleanexe clean: cleanobj cleanexe cleanobj: rm -f *.o cleanexe: rm -f cblas_ex1 cblas_ex2 - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< diff --git a/lapack-netlib/CBLAS/examples/cblas_example1.c b/lapack-netlib/CBLAS/examples/cblas_example1.c index c3acd554d..3d5ed330c 100644 --- a/lapack-netlib/CBLAS/examples/cblas_example1.c +++ b/lapack-netlib/CBLAS/examples/cblas_example1.c @@ -47,7 +47,7 @@ int main ( ) a[m*3+1] = 6; a[m*3+2] = 7; a[m*3+3] = 8; - /* The elemetns of x and y */ + /* The elements of x and y */ x[0] = 1; x[1] = 2; x[2] = 1; diff --git a/lapack-netlib/CBLAS/src/Makefile b/lapack-netlib/CBLAS/src/Makefile index 6c0518ac7..7100568e4 100644 --- a/lapack-netlib/CBLAS/src/Makefile +++ b/lapack-netlib/CBLAS/src/Makefile @@ -1,7 +1,13 @@ # This Makefile compiles the CBLAS routines -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< + +.PHONY: all all: $(CBLASLIB) # Error handling routines for level 2 & 3 @@ -43,24 +49,25 @@ zlev1 = cblas_zswap.o cblas_zscal.o cblas_zdscal.o cblas_zcopy.o \ # Common files for level 1 single precision sclev1 = cblas_scasum.o scasumsub.o cblas_scnrm2.o scnrm2sub.o +.PHONY: slib1 dlib1 clib1 zlib1 # Single precision real slib1: $(slev1) $(sclev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib1: $(dlev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib1: $(clev1) $(sclev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib1: $(zlev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # @@ -95,24 +102,25 @@ zlev2 = cblas_zgemv.o cblas_zgbmv.o cblas_zhemv.o cblas_zhbmv.o cblas_zhpmv.o \ cblas_ztpsv.o cblas_zgeru.o cblas_zgerc.o cblas_zher.o cblas_zher2.o \ cblas_zhpr.o cblas_zhpr2.o +.PHONY: slib2 dlib2 clib2 zlib2 # Single precision real slib2: $(slev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib2: $(dlev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib2: $(clev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib2: $(zlev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # @@ -141,24 +149,25 @@ zlev3 = cblas_zgemm.o cblas_zsymm.o cblas_zhemm.o cblas_zherk.o \ cblas_zher2k.o cblas_ztrmm.o cblas_ztrsm.o cblas_zsyrk.o \ cblas_zsyr2k.o +.PHONY: slib3 dlib3 clib3 zlib3 # Single precision real slib3: $(slev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision real dlib3: $(dlev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Single precision complex clib3: $(clev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # Double precision complex zlib3: $(zlev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) @@ -166,36 +175,33 @@ alev1 = $(slev1) $(dlev1) $(clev1) $(zlev1) $(sclev1) alev2 = $(slev2) $(dlev2) $(clev2) $(zlev2) alev3 = $(slev3) $(dlev3) $(clev3) $(zlev3) +.PHONY: all1 all2 all3 # All level 1 all1: $(alev1) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All level 2 all2: $(alev2) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All level 3 all3: $(alev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $(CBLASLIB) $^ + $(AR) $(ARFLAGS) $(CBLASLIB) $^ $(RANLIB) $(CBLASLIB) # All levels and precisions $(CBLASLIB): $(alev1) $(alev2) $(alev3) $(errhand) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: rm -f *.o cleanlib: rm -f $(CBLASLIB) - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/lapack-netlib/CBLAS/src/cblas_sgemm.c b/lapack-netlib/CBLAS/src/cblas_sgemm.c index c4a49a2db..51cd7d18a 100644 --- a/lapack-netlib/CBLAS/src/cblas_sgemm.c +++ b/lapack-netlib/CBLAS/src/cblas_sgemm.c @@ -91,7 +91,7 @@ void cblas_sgemm(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, else { cblas_xerbla(2, "cblas_sgemm", - "Illegal TransA setting, %d\n", TransA); + "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/lapack-netlib/CBLAS/testing/Makefile b/lapack-netlib/CBLAS/testing/Makefile index 0182c3e88..e3b615b41 100644 --- a/lapack-netlib/CBLAS/testing/Makefile +++ b/lapack-netlib/CBLAS/testing/Makefile @@ -2,7 +2,12 @@ # The Makefile compiles c wrappers and testers for CBLAS. # -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< # Archive files necessary to compile LIB = $(CBLASLIB) $(BLASLIB) @@ -27,6 +32,7 @@ ztestl1o = c_zblas1.o ztestl2o = c_zblas2.o c_z2chke.o auxiliary.o c_xerbla.o ztestl3o = c_zblas3.o c_z3chke.o auxiliary.o c_xerbla.o +.PHONY: all all1 all2 all3 all: all1 all2 all3 all1: xscblat1 xdcblat1 xccblat1 xzcblat1 all2: xscblat2 xdcblat2 xccblat2 xzcblat2 @@ -38,37 +44,38 @@ all3: xscblat3 xdcblat3 xccblat3 xzcblat3 # Single real xscblat1: c_sblat1.o $(stestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xscblat2: c_sblat2.o $(stestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xscblat3: c_sblat3.o $(stestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Double real xdcblat1: c_dblat1.o $(dtestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xdcblat2: c_dblat2.o $(dtestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xdcblat3: c_dblat3.o $(dtestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Single complex xccblat1: c_cblat1.o $(ctestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xccblat2: c_cblat2.o $(ctestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xccblat3: c_cblat3.o $(ctestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # Double complex xzcblat1: c_zblat1.o $(ztestl1o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xzcblat2: c_zblat2.o $(ztestl2o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ xzcblat3: c_zblat3.o $(ztestl3o) $(LIB) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ # RUN TESTS +.PHONY: run run: all @echo "--> TESTING CBLAS 1 - SINGLE PRECISION REAL <--" @./xscblat1 > stest1.out @@ -95,6 +102,7 @@ run: all @echo "--> TESTING CBLAS 3 - DOUBLE PRECISION COMPLEX <--" @./xzcblat3 < zin3 > ztest3.out +.PHONY: clean cleanobj cleanexe cleantest clean: cleanobj cleanexe cleantest cleanobj: rm -f *.o @@ -102,9 +110,3 @@ cleanexe: rm -f x* cleantest: rm -f *.out core - -.SUFFIXES: .o .f .c -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/lapack-netlib/CBLAS/testing/c_cblat1.f b/lapack-netlib/CBLAS/testing/c_cblat1.f index c741ce506..1a123d74d 100644 --- a/lapack-netlib/CBLAS/testing/c_cblat1.f +++ b/lapack-netlib/CBLAS/testing/c_cblat1.f @@ -577,7 +577,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/CBLAS/testing/c_dblat1.f b/lapack-netlib/CBLAS/testing/c_dblat1.f index c570a9140..4a71b4dcf 100644 --- a/lapack-netlib/CBLAS/testing/c_dblat1.f +++ b/lapack-netlib/CBLAS/testing/c_dblat1.f @@ -653,7 +653,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/CBLAS/testing/c_sblat1.f b/lapack-netlib/CBLAS/testing/c_sblat1.f index 773787d6f..89902f12d 100644 --- a/lapack-netlib/CBLAS/testing/c_sblat1.f +++ b/lapack-netlib/CBLAS/testing/c_sblat1.f @@ -653,7 +653,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/CBLAS/testing/c_zblat1.f b/lapack-netlib/CBLAS/testing/c_zblat1.f index 03753e782..cd0c8541d 100644 --- a/lapack-netlib/CBLAS/testing/c_zblat1.f +++ b/lapack-netlib/CBLAS/testing/c_zblat1.f @@ -577,7 +577,7 @@ SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC) * ************************* STEST1 ***************************** * -* THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN +* THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT. * diff --git a/lapack-netlib/CMAKE/CheckLAPACKCompilerFlags.cmake b/lapack-netlib/CMAKE/CheckLAPACKCompilerFlags.cmake index acc51629e..add0d1797 100644 --- a/lapack-netlib/CMAKE/CheckLAPACKCompilerFlags.cmake +++ b/lapack-netlib/CMAKE/CheckLAPACKCompilerFlags.cmake @@ -1,4 +1,4 @@ -# This module checks against various known compilers and thier respective +# This module checks against various known compilers and their respective # flags to determine any specific flags needing to be set. # # 1. If FPE traps are enabled either abort or disable them diff --git a/lapack-netlib/CMAKE/FindGcov.cmake b/lapack-netlib/CMAKE/FindGcov.cmake index 4807f903e..3d4c0a2a0 100644 --- a/lapack-netlib/CMAKE/FindGcov.cmake +++ b/lapack-netlib/CMAKE/FindGcov.cmake @@ -20,7 +20,7 @@ set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY}) get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) foreach (LANG ${ENABLED_LANGUAGES}) - # Gcov evaluation is dependend on the used compiler. Check gcov support for + # Gcov evaluation is dependent on the used compiler. Check gcov support for # each compiler that is used. If gcov binary was already found for this # compiler, do not try to find it again. if(NOT GCOV_${CMAKE_${LANG}_COMPILER_ID}_BIN) diff --git a/lapack-netlib/CMAKE/Findcodecov.cmake b/lapack-netlib/CMAKE/Findcodecov.cmake index 1f33b2c09..384064007 100644 --- a/lapack-netlib/CMAKE/Findcodecov.cmake +++ b/lapack-netlib/CMAKE/Findcodecov.cmake @@ -42,7 +42,7 @@ set(CMAKE_REQUIRED_QUIET ${codecov_FIND_QUIETLY}) get_property(ENABLED_LANGUAGES GLOBAL PROPERTY ENABLED_LANGUAGES) foreach (LANG ${ENABLED_LANGUAGES}) - # Coverage flags are not dependend on language, but the used compiler. So + # Coverage flags are not dependent on language, but the used compiler. So # instead of searching flags foreach language, search flags foreach compiler # used. set(COMPILER ${CMAKE_${LANG}_COMPILER_ID}) diff --git a/lapack-netlib/CMAKE/FortranMangling.cmake b/lapack-netlib/CMAKE/FortranMangling.cmake index d772dc9bb..734ab6f4c 100644 --- a/lapack-netlib/CMAKE/FortranMangling.cmake +++ b/lapack-netlib/CMAKE/FortranMangling.cmake @@ -24,7 +24,7 @@ message(STATUS "=========") set(F77_OUTPUT_EXE "/Fe" CACHE INTERNAL "Fortran compiler option for setting executable file name.") else() - # in other case, let user specify their fortran configrations. + # in other case, let user specify their fortran configurations. set(F77_OPTION_COMPILE "-c" CACHE STRING "Fortran compiler option for compiling without linking.") set(F77_OUTPUT_OBJ "-o" CACHE STRING diff --git a/lapack-netlib/CMAKE/lapack-config-build.cmake.in b/lapack-netlib/CMAKE/lapack-config-build.cmake.in index 1d084fe13..f7e041663 100644 --- a/lapack-netlib/CMAKE/lapack-config-build.cmake.in +++ b/lapack-netlib/CMAKE/lapack-config-build.cmake.in @@ -5,6 +5,10 @@ if(_LAPACK_TARGET AND NOT TARGET "${_LAPACK_TARGET}") endif() unset(_LAPACK_TARGET) +# Hint for project building against lapack +set(LAPACK_Fortran_COMPILER_ID "@CMAKE_Fortran_COMPILER_ID@") + # Report the blas and lapack raw or imported libraries. set(LAPACK_blas_LIBRARIES "@BLAS_LIBRARIES@") set(LAPACK_lapack_LIBRARIES "@LAPACK_LIBRARIES@") +set(LAPACK_LIBRARIES ${LAPACK_blas_LIBRARIES} ${LAPACK_lapack_LIBRARIES}) diff --git a/lapack-netlib/CMAKE/lapack-config-install.cmake.in b/lapack-netlib/CMAKE/lapack-config-install.cmake.in index 4e04f8711..3de7362ea 100644 --- a/lapack-netlib/CMAKE/lapack-config-install.cmake.in +++ b/lapack-netlib/CMAKE/lapack-config-install.cmake.in @@ -8,8 +8,12 @@ if(_LAPACK_TARGET AND NOT TARGET "${_LAPACK_TARGET}") endif() unset(_LAPACK_TARGET) +# Hint for project building against lapack +set(LAPACK_Fortran_COMPILER_ID "@CMAKE_Fortran_COMPILER_ID@") + # Report the blas and lapack raw or imported libraries. set(LAPACK_blas_LIBRARIES "@BLAS_LIBRARIES@") set(LAPACK_lapack_LIBRARIES "@LAPACK_LIBRARIES@") +set(LAPACK_LIBRARIES ${LAPACK_blas_LIBRARIES} ${LAPACK_lapack_LIBRARIES}) unset(_LAPACK_SELF_DIR) diff --git a/lapack-netlib/CMakeLists.txt b/lapack-netlib/CMakeLists.txt index caa0e7107..df43d91b1 100644 --- a/lapack-netlib/CMakeLists.txt +++ b/lapack-netlib/CMakeLists.txt @@ -3,7 +3,7 @@ cmake_minimum_required(VERSION 2.8.12) project(LAPACK Fortran C) set(LAPACK_MAJOR_VERSION 3) -set(LAPACK_MINOR_VERSION 8) +set(LAPACK_MINOR_VERSION 9) set(LAPACK_PATCH_VERSION 0) set( LAPACK_VERSION @@ -13,6 +13,9 @@ set( # Add the CMake directory for custon CMake modules set(CMAKE_MODULE_PATH "${LAPACK_SOURCE_DIR}/CMAKE" ${CMAKE_MODULE_PATH}) +# Export all symbols on Windows when building shared libraries +SET(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS TRUE) + # Set a default build type if none was specified if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) message(STATUS "Setting build type to 'Release' as none was specified.") @@ -21,8 +24,19 @@ if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo" "Coverage") endif() -string(TOUPPER ${CMAKE_BUILD_TYPE} CMAKE_BUILD_TYPE_UPPER) -if(${CMAKE_BUILD_TYPE_UPPER} STREQUAL "COVERAGE") +# Coverage +set(_is_coverage_build 0) +set(_msg "Checking if build type is 'Coverage'") +message(STATUS "${_msg}") +if(NOT CMAKE_CONFIGURATION_TYPES) + string(TOLOWER ${CMAKE_BUILD_TYPE} _build_type_lc) + if(${_build_type_lc} STREQUAL "coverage") + set(_is_coverage_build 1) + endif() +endif() +message(STATUS "${_msg}: ${_is_coverage_build}") + +if(_is_coverage_build) message(STATUS "Adding coverage") find_package(codecov) endif() @@ -58,18 +72,18 @@ include(PreventInSourceBuilds) include(PreventInBuildInstalls) if(UNIX) - if("${CMAKE_Fortran_COMPILER}" MATCHES "ifort") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fp-model strict") + if(CMAKE_Fortran_COMPILER_ID STREQUAL Intel) + list(APPEND CMAKE_Fortran_FLAGS "-fp-model strict") endif() - if("${CMAKE_Fortran_COMPILER}" MATCHES "xlf") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qnosave -qstrict=none") + if(CMAKE_Fortran_COMPILER_ID STREQUAL XL) + list(APPEND CMAKE_Fortran_FLAGS "-qnosave -qstrict=none") endif() # Delete libmtsk in linking sequence for Sun/Oracle Fortran Compiler. # This library is not present in the Sun package SolarisStudio12.3-linux-x86-bin string(REPLACE \;mtsk\; \; CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES "${CMAKE_Fortran_IMPLICIT_LINK_LIBRARIES}") endif() -if(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq") +if(CMAKE_Fortran_COMPILER_ID STREQUAL Compaq) if(WIN32) if(CMAKE_GENERATOR STREQUAL "NMake Makefiles") get_filename_component(CMAKE_Fortran_COMPILER_CMDNAM ${CMAKE_Fortran_COMPILER} NAME_WE) @@ -96,24 +110,16 @@ if(CMAKE_Fortran_COMPILER_ID STREQUAL "Compaq") endif() endif() -# Get Python -message(STATUS "Looking for Python greater than 2.6 - ${PYTHONINTERP_FOUND}") -find_package(PythonInterp 2.7) # lapack_testing.py uses features from python 2.7 and greater -if(PYTHONINTERP_FOUND) - message(STATUS "Using Python version ${PYTHON_VERSION_STRING}") -else() - message(STATUS "No suitable Python version found, so skipping summary tests.") -endif() -# -------------------------------------------------- +# -------------------------------------------------- set(LAPACK_INSTALL_EXPORT_NAME lapack-targets) macro(lapack_install_library lib) install(TARGETS ${lib} EXPORT ${LAPACK_INSTALL_EXPORT_NAME} - ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} - LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} - RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT Development + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR} COMPONENT RuntimeLibraries + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR} COMPONENT RuntimeLibraries ) endmacro() @@ -121,12 +127,22 @@ set(PKG_CONFIG_DIR ${CMAKE_INSTALL_LIBDIR}/pkgconfig) # -------------------------------------------------- # Testing -option(BUILD_TESTING "Build tests" OFF) -enable_testing() +option(BUILD_TESTING "Build tests" ${_is_coverage_build}) include(CTest) -enable_testing() message(STATUS "Build tests: ${BUILD_TESTING}") +# lapack_testing.py uses features from python 2.7 and greater +if(BUILD_TESTING) + set(_msg "Looking for Python >= 2.7 needed for summary tests") + message(STATUS "${_msg}") + find_package(PythonInterp 2.7 QUIET) + if(PYTHONINTERP_FOUND) + message(STATUS "${_msg} - found (${PYTHON_VERSION_STRING})") + else() + message(STATUS "${_msg} - not found (skipping summary tests)") + endif() +endif() + # -------------------------------------------------- # Organize output files. On Windows this also keeps .dll files next # to the .exe files that need them, making tests easy to run. @@ -299,16 +315,40 @@ if(LAPACKE) add_subdirectory(LAPACKE) endif() +#------------------------------------- +# BLAS++ / LAPACK++ +option(BLAS++ "Build BLAS++" OFF) +option(LAPACK++ "Build LAPACK++" OFF) + + +function(_display_cpp_implementation_msg name) + string(TOLOWER ${name} name_lc) + message(STATUS "${name}++ enable") + message(STATUS "----------------") + message(STATUS "Thank you for your interest in ${name}++, a newly developed C++ API for ${name} library") + message(STATUS "The objective of ${name}++ is to provide a convenient, performance oriented API for development in the C++ language, that, for the most part, preserves established conventions, while, at the same time, takes advantages of modern C++ features, such as: namespaces, templates, exceptions, etc.") + message(STATUS "We are still working on integrating ${name}++ in our library. For the moment, you can download directly ${name_lc}++ from https://bitbucket.org/icl/${name_lc}pp") + message(STATUS "For support ${name}++ related question, please email: slate-user@icl.utk.edu") + message(STATUS "----------------") +endfunction() +if(BLAS++) + _display_cpp_implementation_msg("BLAS") +endif() +if(LAPACK++) + _display_cpp_implementation_msg("LAPACK") +endif() + # -------------------------------------------------- # CPACK Packaging set(CPACK_PACKAGE_NAME "LAPACK") set(CPACK_PACKAGE_VENDOR "University of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd") set(CPACK_PACKAGE_DESCRIPTION_SUMMARY "LAPACK- Linear Algebra Package") -set(CPACK_PACKAGE_VERSION_MAJOR 3) -set(CPACK_PACKAGE_VERSION_MINOR 5) -set(CPACK_PACKAGE_VERSION_PATCH 0) +set(CPACK_PACKAGE_VERSION_MAJOR ${LAPACK_MAJOR_VERSION}) +set(CPACK_PACKAGE_VERSION_MINOR ${LAPACK_MINOR_VERSION}) +set(CPACK_PACKAGE_VERSION_PATCH ${LAPACK_PATCH_VERSION}) set(CPACK_RESOURCE_FILE_LICENSE "${CMAKE_CURRENT_SOURCE_DIR}/LICENSE") +set(CPACK_MONOLITHIC_INSTALL ON) set(CPACK_PACKAGE_INSTALL_DIRECTORY "LAPACK") if(WIN32 AND NOT UNIX) # There is a bug in NSI that does not handle full unix paths properly. Make @@ -347,7 +387,9 @@ endif() set(_lapack_config_install_guard_target "") if(ALL_TARGETS) install(EXPORT lapack-targets - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION}) + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION} + COMPONENT Development + ) # Choose one of the lapack targets to use as a guard for # lapack-config.cmake to load targets from the install tree. @@ -382,6 +424,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapack.pc.in ${CMAKE_CURRENT_BINARY_D install(FILES ${CMAKE_CURRENT_BINARY_DIR}/lapack.pc DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development ) configure_file(${LAPACK_SOURCE_DIR}/CMAKE/lapack-config-install.cmake.in @@ -398,4 +441,6 @@ install(FILES ${LAPACK_BINARY_DIR}/CMakeFiles/lapack-config.cmake ${LAPACK_BINARY_DIR}/lapack-config-version.cmake DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapack-${LAPACK_VERSION} + COMPONENT Development ) + diff --git a/lapack-netlib/DOCS/Doxyfile b/lapack-netlib/DOCS/Doxyfile index 8f3558597..43cea43b5 100644 --- a/lapack-netlib/DOCS/Doxyfile +++ b/lapack-netlib/DOCS/Doxyfile @@ -38,7 +38,7 @@ PROJECT_NAME = LAPACK # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 3.8.0 +PROJECT_NUMBER = 3.9.0 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a diff --git a/lapack-netlib/DOCS/Doxyfile_man b/lapack-netlib/DOCS/Doxyfile_man index 6fb339a73..1767cf5f4 100644 --- a/lapack-netlib/DOCS/Doxyfile_man +++ b/lapack-netlib/DOCS/Doxyfile_man @@ -38,7 +38,7 @@ PROJECT_NAME = LAPACK # could be handy for archiving the generated documentation or if some version # control system is used. -PROJECT_NUMBER = 3.8.0 +PROJECT_NUMBER = 3.9.0 # Using the PROJECT_BRIEF tag one can provide an optional one line description # for a project that appears at the top of each page and should give viewer a diff --git a/lapack-netlib/DOCS/lawn81.tex b/lapack-netlib/DOCS/lawn81.tex index 291735299..794c2a7aa 100644 --- a/lapack-netlib/DOCS/lawn81.tex +++ b/lapack-netlib/DOCS/lawn81.tex @@ -439,39 +439,39 @@ SHELL = /bin/sh \end{quote} and it will need to be modified to \texttt{SHELL = /sbin/sh} if you are installing LAPACK on an SGI architecture. -Second, you will -need to modify the \texttt{PLAT} definition, which is appended to all -library names, to specify the architecture to which you are installing -LAPACK. This features avoids confusion in library names when you are -installing LAPACK on more than one architecture. Next, you will need -to modify \texttt{FORTRAN}, \texttt{OPTS}, \texttt{DRVOPTS}, \texttt{NOOPT}, \texttt{LOADER}, -and \texttt{LOADOPTS} to specify +Next, you will need to modify \texttt{FC}, \texttt{FFLAGS}, +\texttt{FFLAGS\_DRV}, \texttt{FFLAGS\_NOOPT}, and \texttt{LDFLAGS} to specify the compiler, compiler options, compiler options for the testing and -timing\footnotemark[\value{footnote}] main programs, loader, loader options. -Next you will have to choose which function you will use to time in the \texttt{SECOND} and \texttt{DSECND} routines. +timing\footnotemark[\value{footnote}] main programs, and linker options. +Next you will have to choose which function you will use to time in the +\texttt{SECOND} and \texttt{DSECND} routines. \begin{verbatim} -#The Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME -TIMER = EXT_ETIME -# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_ -# TIMER = EXT_ETIME_ -# For gfortran compiler: SECOND and DSECND will use the INTERNAL FUNCTION ETIME -# TIMER = INT_ETIME -# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...) -# SECOND and DSECND will use a call to the INTERNAL FUNCTION CPU_TIME -# TIMER = INT_CPU_TIME -# If neither of this works...you can use the NONE value... -# In that case, SECOND and DSECND will always return 0 -# TIMER = NONE +# Default: SECOND and DSECND will use a call to the +# EXTERNAL FUNCTION ETIME +#TIMER = EXT_ETIME +# For RS6K: SECOND and DSECND will use a call to the +# EXTERNAL FUNCTION ETIME_ +#TIMER = EXT_ETIME_ +# For gfortran compiler: SECOND and DSECND will use a call to the +# INTERNAL FUNCTION ETIME +TIMER = INT_ETIME +# If your Fortran compiler does not provide etime (like Nag Fortran +# Compiler, etc...) SECOND and DSECND will use a call to the +# INTERNAL FUNCTION CPU_TIME +#TIMER = INT_CPU_TIME +# If none of these work, you can use the NONE value. +# In that case, SECOND and DSECND will always return 0. +#TIMER = NONE \end{verbatim} Refer to the section~\ref{second} to get more information. -Next, you will need to modify \texttt{ARCH}, \texttt{ARCHFLAGS}, and \texttt{RANLIB} to specify archiver, +Next, you will need to modify \texttt{AR}, \texttt{ARFLAGS}, and \texttt{RANLIB} to specify archiver, archiver options, and ranlib for your machine. If your architecture does not require \texttt{ranlib} to be run after each archive command (as is the case with CRAY computers running UNICOS, Hewlett Packard computers running HP-UX, or SUN SPARCstations running Solaris), set -\texttt{ranlib=echo}. And finally, you must +\texttt{RANLIB = echo}. And finally, you must modify the \texttt{BLASLIB} definition to specify the BLAS library to which you will be linking. If an optimized version of the BLAS is available on your machine, you are highly recommended to link to that library. @@ -721,24 +721,24 @@ The version that will be used depends on the value of the TIMER variable in the \begin{itemize} \item If ETIME is available as an external function, set the value of the TIMER variable in your -make.inc to \texttt{EXT\_ETIME}:\texttt{second\_EXT\_ETIME.f} and \texttt{dsecnd\_EXT\_ETIME.f} will be used. +make.inc to \texttt{EXT\_ETIME}: \texttt{second\_EXT\_ETIME.f} and \texttt{dsecnd\_EXT\_ETIME.f} will be used. Usually on HPPA architectures, -the compiler and loader flag \texttt{+U77} should be included to access +the compiler and linker flag \texttt{+U77} should be included to access the function \texttt{ETIME}. \item If ETIME\_ is available as an external function, set the value of the TIMER variable in your make.inc -to \texttt{EXT\_ETIME\_}:\texttt{second\_EXT\_ETIME\_.f} and \texttt{dsecnd\_EXT\_ETIME\_.f} will be used. +to \texttt{EXT\_ETIME\_}: \texttt{second\_EXT\_ETIME\_.f} and \texttt{dsecnd\_EXT\_ETIME\_.f} will be used. It is the case on some IBM architectures such as IBM RS/6000s. \item If ETIME is available as an internal function, set the value of the TIMER variable in your make.inc -to \texttt{INT\_ETIME}:\texttt{second\_INT\_ETIME.f} and \texttt{dsecnd\_INT\_ETIME.f} will be used. +to \texttt{INT\_ETIME}: \texttt{second\_INT\_ETIME.f} and \texttt{dsecnd\_INT\_ETIME.f} will be used. This is the case with gfortan. \item If CPU\_TIME is available as an internal function, set the value of the TIMER variable in your make.inc -to \texttt{INT\_CPU\_TIME}:\texttt{second\_INT\_CPU\_TIME.f} and \texttt{dsecnd\_INT\_CPU\_TIME.f} will be used. +to \texttt{INT\_CPU\_TIME}: \texttt{second\_INT\_CPU\_TIME.f} and \texttt{dsecnd\_INT\_CPU\_TIME.f} will be used. \item If none of these function is available, set the value of the TIMER variable in your make.inc -to \texttt{NONE:}\texttt{second\_NONE.f} and \texttt{dsecnd\_NONE.f} will be used. +to \texttt{NONE}: \texttt{second\_NONE.f} and \texttt{dsecnd\_NONE.f} will be used. These routines will always return zero. \end{itemize} @@ -829,8 +829,8 @@ data type to the library if necessary. \end{itemize} \noindent -The BLAS library is created in \texttt{LAPACK/blas\_PLAT.a}, where -\texttt{PLAT} is the user-defined architecture suffix specified in the file +The BLAS library is created in \texttt{LAPACK/librefblas.a}, +or in the user-defined location specified by \texttt{BLASLIB} in the file \texttt{LAPACK/make.inc}. \subsection{Run the BLAS Test Programs}\label{testblas} @@ -882,8 +882,8 @@ data type to the library if necessary. \end{itemize} \noindent -The LAPACK library is created in \texttt{LAPACK/lapack\_PLAT.a}, where -\texttt{PLAT} is the user-defined architecture suffix specified in the file +The LAPACK library is created in \texttt{LAPACK/liblapack.a}, +or in the user-defined location specified by \texttt{LAPACKLIB} in the file \texttt{LAPACK/make.inc}. \subsection{Create the Test Matrix Generator Library} @@ -902,9 +902,9 @@ data type to the library if necessary. \end{itemize} \noindent -The test matrix generator library is created in \texttt{LAPACK/tmglib\_PLAT.a}, -where \texttt{PLAT} is the user-defined architecture suffix specified in the -file \texttt{LAPACK/make.inc}. +The test matrix generator library is created in \texttt{LAPACK/libtmglib.a}, +or in the user-defined location specified by \texttt{TMGLIB} in the file +\texttt{LAPACK/make.inc}. \subsection{Run the LAPACK Test Programs} @@ -1114,9 +1114,7 @@ To make a library of the instrumented LAPACK routines, first go to \texttt{LAPACK/TIMING/LIN/LINSRC} and type \texttt{make} followed by the data types desired, as in the examples of Section~\ref{toplevelmakefile}. The library of instrumented code is created in -\texttt{LAPACK/TIMING/LIN/linsrc\_PLAT.a}, -where \texttt{PLAT} is the user-defined architecture suffix specified in the -file \texttt{LAPACK/make.inc}. +\texttt{LAPACK/TIMING/LIN/linsrc.a}. \end{sloppypar} \item[b)] @@ -1251,9 +1249,7 @@ To make a library of the instrumented LAPACK routines, first go to \texttt{LAPACK/TIMING/EIG/EIGSRC} and type \texttt{make} followed by the data types desired, as in the examples of Section~\ref{toplevelmakefile}. The library of instrumented code is created in -\texttt{LAPACK/TIMING/EIG/eigsrc\_PLAT.a}, -where \texttt{PLAT} is the user-defined architecture suffix specified in the -file \texttt{LAPACK/make.inc}. +\texttt{LAPACK/TIMING/EIG/eigsrc.a}. \end{sloppypar} \item[b)] @@ -1389,7 +1385,7 @@ installing LAPACK on an SGI architecture. \section{ETIME} On HPPA architectures, -the compiler and loader flag \texttt{+U77} should be included to access +the compiler and linker flag \texttt{+U77} should be included to access the function \texttt{ETIME}. \section{ILAENV and IEEE-754 compliance} @@ -1494,13 +1490,13 @@ has two options: increase your stack size, or force all local variables to be allocated statically. On HPPA architectures, the -compiler and loader flag \texttt{-K} should be used when compiling these testing +compiler and linker flag \texttt{-K} should be used when compiling these testing and timing main programs to avoid such a stack overflow. I.e., set -\texttt{DRVOPTS = -K} in the \texttt{LAPACK/make.inc} file. +\texttt{FFLAGS\_DRV = -K} in the \texttt{LAPACK/make.inc} file. For similar reasons, -on SGI architectures, the compiler and loader flag \texttt{-static} should be -used. I.e., set \texttt{DRVOPTS = -static} in the \texttt{LAPACK/make.inc} file. +on SGI architectures, the compiler and linker flag \texttt{-static} should be +used. I.e., set \texttt{FFLAGS\_DRV = -static} in the \texttt{LAPACK/make.inc} file. \section{IEEE arithmetic} diff --git a/lapack-netlib/INSTALL/Makefile b/lapack-netlib/INSTALL/Makefile index 150a061d6..1007c1bca 100644 --- a/lapack-netlib/INSTALL/Makefile +++ b/lapack-netlib/INSTALL/Makefile @@ -1,30 +1,33 @@ -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all testlsame testslamch testdlamch testsecond testdsecnd testieee testversion all: testlsame testslamch testdlamch testsecond testdsecnd testieee testversion testlsame: lsame.o lsametst.o - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testslamch: slamch.o lsame.o slamchtst.o - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testdlamch: dlamch.o lsame.o dlamchtst.o - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testsecond: second_$(TIMER).o secondtst.o @echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)" - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testdsecnd: dsecnd_$(TIMER).o dsecndtst.o @echo "[INFO] : TIMER value: $(TIMER) (given by make.inc)" - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testieee: tstiee.o - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ testversion: ilaver.o LAPACK_version.o - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ +.PHONY: run run: all ./testlsame ./testslamch @@ -34,6 +37,7 @@ run: all ./testieee ./testversion +.PHONY: clean cleanobj cleanexe cleantest clean: cleanobj cleanexe cleantest cleanobj: rm -f *.o @@ -42,9 +46,5 @@ cleanexe: cleantest: rm -f core -.SUFFIXES: .o .f -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< - -slamch.o: slamch.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -dlamch.o: dlamch.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< +slamch.o: slamch.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +dlamch.o: dlamch.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< diff --git a/lapack-netlib/INSTALL/dlamch.f b/lapack-netlib/INSTALL/dlamch.f index 76f875cef..9073cd45e 100644 --- a/lapack-netlib/INSTALL/dlamch.f +++ b/lapack-netlib/INSTALL/dlamch.f @@ -10,6 +10,10 @@ * * DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) * +* .. Scalar Arguments .. +* CHARACTER CMACH +* .. +* * *> \par Purpose: * ============= @@ -24,6 +28,7 @@ * *> \param[in] CMACH *> \verbatim +*> CMACH is CHARACTER*1 *> Specifies the value to be returned by DLAMCH: *> = 'E' or 'e', DLAMCH := eps *> = 'S' or 's , DLAMCH := sfmin diff --git a/lapack-netlib/INSTALL/dlamchf77.f b/lapack-netlib/INSTALL/dlamchf77.f index 3efd21535..37b30551f 100644 --- a/lapack-netlib/INSTALL/dlamchf77.f +++ b/lapack-netlib/INSTALL/dlamchf77.f @@ -10,6 +10,10 @@ * * DOUBLE PRECISION FUNCTION DLAMCH( CMACH ) * +* .. Scalar Arguments .. +* CHARACTER CMACH +* .. +* * *> \par Purpose: * ============= diff --git a/lapack-netlib/INSTALL/ilaver.f b/lapack-netlib/INSTALL/ilaver.f index e1d59f465..79fe597ae 100644 --- a/lapack-netlib/INSTALL/ilaver.f +++ b/lapack-netlib/INSTALL/ilaver.f @@ -25,12 +25,15 @@ * ========== * *> \param[out] VERS_MAJOR +*> VERS_MAJOR is INTEGER *> return the lapack major version *> *> \param[out] VERS_MINOR +*> VERS_MINOR is INTEGER *> return the lapack minor version from the major version *> *> \param[out] VERS_PATCH +*> VERS_PATCH is INTEGER *> return the lapack patch version from the minor version * * Authors: @@ -41,24 +44,23 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date June 2017 +*> \date November 2019 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* June 2017 * * ===================================================================== * INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH * ===================================================================== VERS_MAJOR = 3 - VERS_MINOR = 8 + VERS_MINOR = 9 VERS_PATCH = 0 * ===================================================================== * diff --git a/lapack-netlib/INSTALL/make.inc.ALPHA b/lapack-netlib/INSTALL/make.inc.ALPHA index 0ceeaa155..d6397e81d 100644 --- a/lapack-netlib/INSTALL/make.inc.ALPHA +++ b/lapack-netlib/INSTALL/make.inc.ALPHA @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O4 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = -O4 -fpe1 -DRVOPTS = $(OPTS) -NOOPT = +FC = f77 +FFLAGS = -O4 -fpe1 +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -74,9 +72,9 @@ TIMER = EXT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -#BLASLIB = ../../librefblas.a +#BLASLIB = $(TOPSRCDIR)/librefblas.a BLASLIB = -ldxml -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.HPPA b/lapack-netlib/INSTALL/make.inc.HPPA index 8eabbbdf4..6ee2b2dfb 100644 --- a/lapack-netlib/INSTALL/make.inc.HPPA +++ b/lapack-netlib/INSTALL/make.inc.HPPA @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = +O4 +U77 -DRVOPTS = $(OPTS) -K -NOOPT = +U77 +FC = f77 +FFLAGS = +O4 +U77 +FFLAGS_DRV = $(FFLAGS) -K +FFLAGS_NOOPT = +U77 -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = -Aa +U77 +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -74,9 +72,9 @@ TIMER = EXT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -#BLASLIB = ../../librefblas.a +#BLASLIB = $(TOPSRCDIR)/librefblas.a BLASLIB = -lblas -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.IRIX64 b/lapack-netlib/INSTALL/make.inc.IRIX64 index d9e71e1bf..59fe522eb 100644 --- a/lapack-netlib/INSTALL/make.inc.IRIX64 +++ b/lapack-netlib/INSTALL/make.inc.IRIX64 @@ -8,33 +8,30 @@ SHELL = /sbin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON -#OPTS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON -DRVOPTS = $(OPTS) -static -NOOPT = -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON -#NOOPT = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON +FC = f77 +FFLAGS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON +#FFLAGS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON +FFLAGS_DRV = $(FFLAGS) -static +FFLAGS_NOOPT = -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON +#FFLAGS_NOOPT = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = -O3 -64 -mips4 -r10000 -OPT:IEEE_NaN_inf=ON -#LOADOPTS = -g -DEBUG:subscript_check=ON -trapuv -OPT:IEEE_NaN_inf=ON +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -78,8 +75,8 @@ TIMER = EXT_ETIME # possible.) # #BLASLIB = -lblas -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.O2K b/lapack-netlib/INSTALL/make.inc.O2K index 3ffcadacc..3c3dbc800 100644 --- a/lapack-netlib/INSTALL/make.inc.O2K +++ b/lapack-netlib/INSTALL/make.inc.O2K @@ -8,33 +8,30 @@ SHELL = /sbin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = -O3 -64 -mips4 -r10000 -#OPTS = -O3 -64 -mips4 -r10000 -mp -DRVOPTS = $(OPTS) -static -NOOPT = -64 -mips4 -r10000 -#NOOPT = -64 -mips4 -r10000 -mp +FC = f77 +FFLAGS = -O3 -64 -mips4 -r10000 +#FFLAGS = -O3 -64 -mips4 -r10000 -mp +FFLAGS_DRV = $(FFLAGS) -static +FFLAGS_NOOPT = -64 -mips4 -r10000 +#FFLAGS_NOOPT = -64 -mips4 -r10000 -mp -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = -O3 -64 -mips4 -r10000 -#LOADOPTS = -O3 -64 -mips4 -r10000 -mp +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -79,8 +76,8 @@ TIMER = EXT_ETIME # BLASLIB = -lblas #BLASLIB = -lblas_mp -#BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +#BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.SGI5 b/lapack-netlib/INSTALL/make.inc.SGI5 index c7019ac16..1013cffdb 100644 --- a/lapack-netlib/INSTALL/make.inc.SGI5 +++ b/lapack-netlib/INSTALL/make.inc.SGI5 @@ -8,30 +8,28 @@ SHELL = /sbin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O4 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = -O4 -DRVOPTS = $(OPTS) -static -NOOPT = +FC = f77 +FFLAGS = -O4 +FFLAGS_DRV = $(FFLAGS) -static +FFLAGS_NOOPT = -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -75,8 +73,8 @@ TIMER = EXT_ETIME # possible.) # #BLASLIB = -lblas -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.SUN4 b/lapack-netlib/INSTALL/make.inc.SUN4 index 4e44f1beb..2da0ecb65 100644 --- a/lapack-netlib/INSTALL/make.inc.SUN4 +++ b/lapack-netlib/INSTALL/make.inc.SUN4 @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -OPTS = -dalign -O4 -fast -DRVOPTS = $(OPTS) -NOOPT = +FC = f77 +FFLAGS = -dalign -O4 -fast +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -LOADOPTS = -dalign -O4 -fast +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -75,8 +73,8 @@ TIMER = EXT_ETIME # possible.) # #BLASLIB = -lblas -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.SUN4SOL2 b/lapack-netlib/INSTALL/make.inc.SUN4SOL2 index e6d79add3..d2db07c61 100644 --- a/lapack-netlib/INSTALL/make.inc.SUN4SOL2 +++ b/lapack-netlib/INSTALL/make.inc.SUN4SOL2 @@ -8,34 +8,31 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = cc +CC = cc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = f77 -#OPTS = -O4 -u -f -mt -#OPTS = -u -f -dalign -native -xO5 -xarch=v8plusa -OPTS = -u -f -dalign -native -xO2 -xarch=v8plusa -DRVOPTS = $(OPTS) -NOOPT = -u -f -#NOOPT = -u -f -mt +FC = f77 +#FFLAGS = -O4 -u -f -mt +#FFLAGS = -u -f -dalign -native -xO5 -xarch=v8plusa +FFLAGS = -u -f -dalign -native -xO2 -xarch=v8plusa +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -u -f +#FFLAGS_NOOPT = -u -f -mt -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = f77 -#LOADOPTS = -mt -LOADOPTS = -f -dalign -native -xO2 -xarch=v8plusa +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -78,10 +75,10 @@ TIMER = EXT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -#BLASLIB = ../../librefblas.a +#BLASLIB = $(TOPSRCDIR)/librefblas.a #BLASLIB = -xlic_lib=sunperf_mt BLASLIB = -xlic_lib=sunperf -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.XLF b/lapack-netlib/INSTALL/make.inc.XLF index 9466ee332..cb9d791a7 100644 --- a/lapack-netlib/INSTALL/make.inc.XLF +++ b/lapack-netlib/INSTALL/make.inc.XLF @@ -8,31 +8,29 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = xlc +CC = xlc CFLAGS = -O3 -qnosave -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = xlf -OPTS = -O3 -qfixed -qnosave +FC = xlf +FFLAGS = -O3 -qfixed -qnosave # For -O2, add -qstrict=none -DRVOPTS = $(OPTS) -NOOPT = -O0 -qfixed -qnosave +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -O0 -qfixed -qnosave -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = xlf -LOADOPTS = -qnosave +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -75,9 +73,9 @@ TIMER = EXT_ETIME_ # machine-specific, optimized BLAS library should be used whenever # possible.) # -#BLASLIB = ../../librefblas.a +#BLASLIB = $(TOPSRCDIR)/librefblas.a BLASLIB = -lessl -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.gfortran b/lapack-netlib/INSTALL/make.inc.gfortran index 39d98d4d4..104632747 100644 --- a/lapack-netlib/INSTALL/make.inc.gfortran +++ b/lapack-netlib/INSTALL/make.inc.gfortran @@ -8,10 +8,10 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = gcc +CC = gcc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # @@ -19,23 +19,21 @@ CFLAGS = -O3 # and handle these quantities appropriately. As a consequence, one # should not compile LAPACK with flags such as -ffpe-trap=overflow. # -FORTRAN = gfortran -OPTS = -O2 -frecursive -DRVOPTS = $(OPTS) -NOOPT = -O0 -frecursive +FC = gfortran +FFLAGS = -O2 -frecursive +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -O0 -frecursive -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = gfortran -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -78,8 +76,8 @@ TIMER = INT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.gfortran_debug b/lapack-netlib/INSTALL/make.inc.gfortran_debug index 10e6381df..246060827 100644 --- a/lapack-netlib/INSTALL/make.inc.gfortran_debug +++ b/lapack-netlib/INSTALL/make.inc.gfortran_debug @@ -8,10 +8,10 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = gcc +CC = gcc CFLAGS = -g -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # @@ -19,23 +19,21 @@ CFLAGS = -g # and handle these quantities appropriately. As a consequence, one # should not compile LAPACK with flags such as -ffpe-trap=overflow. # -FORTRAN = gfortran -fimplicit-none -g -frecursive -OPTS = -DRVOPTS = $(OPTS) -NOOPT = -g -O0 -frecursive +FC = gfortran +FFLAGS = -fimplicit-none -g -frecursive +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = $(FFLAGS) -O0 -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = gfortran -g -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -78,8 +76,8 @@ TIMER = INT_CPU_TIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.ifort b/lapack-netlib/INSTALL/make.inc.ifort index b067bd484..801b46aa5 100644 --- a/lapack-netlib/INSTALL/make.inc.ifort +++ b/lapack-netlib/INSTALL/make.inc.ifort @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = icc +CC = icc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = ifort -OPTS = -O3 -fp-model strict -assume protect_parens -DRVOPTS = $(OPTS) -NOOPT = -O0 -fp-model strict -assume protect_parens +FC = ifort +FFLAGS = -O3 -fp-model strict -assume protect_parens +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -O0 -fp-model strict -assume protect_parens -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = ifort -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -74,8 +72,8 @@ TIMER = EXT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.pgf95 b/lapack-netlib/INSTALL/make.inc.pgf95 index a9a5cec98..87b691cdd 100644 --- a/lapack-netlib/INSTALL/make.inc.pgf95 +++ b/lapack-netlib/INSTALL/make.inc.pgf95 @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = pgcc +CC = pgcc CFLAGS = -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = pgf95 -OPTS = -O3 -DRVOPTS = $(OPTS) -NOOPT = -O0 +FC = pgf95 +FFLAGS = -O3 +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -O0 -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = $(FORTRAN) -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -74,8 +72,8 @@ TIMER = INT_CPU_TIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/make.inc.pghpf b/lapack-netlib/INSTALL/make.inc.pghpf index 1d9bf549c..97d22d27d 100644 --- a/lapack-netlib/INSTALL/make.inc.pghpf +++ b/lapack-netlib/INSTALL/make.inc.pghpf @@ -8,30 +8,28 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = pghpc +CC = pghpc CFLAGS = -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # -FORTRAN = pghpf -OPTS = -O4 -Mnohpfc -Mdclchk -DRVOPTS = $(OPTS) -NOOPT = -Mnohpfc -Mdclchk +FC = pghpf +FFLAGS = -O4 -Mnohpfc -Mdclchk +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -Mnohpfc -Mdclchk -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = pghpf -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = echo +AR = ar +ARFLAGS = cr +RANLIB = echo # Timer for the SECOND and DSECND routines # @@ -75,8 +73,8 @@ TIMER = EXT_ETIME # possible.) # #BLASLIB = -lessl -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/INSTALL/slamch.f b/lapack-netlib/INSTALL/slamch.f index 3282fa6a3..342f446ff 100644 --- a/lapack-netlib/INSTALL/slamch.f +++ b/lapack-netlib/INSTALL/slamch.f @@ -28,6 +28,7 @@ * *> \param[in] CMACH *> \verbatim +*> CMACH is CHARACTER*1 *> Specifies the value to be returned by SLAMCH: *> = 'E' or 'e', SLAMCH := eps *> = 'S' or 's , SLAMCH := sfmin diff --git a/lapack-netlib/LAPACKE/CMakeLists.txt b/lapack-netlib/LAPACKE/CMakeLists.txt index 42faef5dd..0589a74ba 100644 --- a/lapack-netlib/LAPACKE/CMakeLists.txt +++ b/lapack-netlib/LAPACKE/CMakeLists.txt @@ -16,18 +16,16 @@ if(NOT FortranCInterface_GLOBAL_FOUND OR NOT FortranCInterface_MODULE_FOUND) ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h) endif() -if(WIN32 AND NOT UNIX) - add_definitions(-DHAVE_LAPACK_CONFIG_H -DLAPACK_COMPLEX_STRUCTURE) - message(STATUS "Windows BUILD") -endif() - -get_directory_property(DirDefs COMPILE_DEFINITIONS) - include_directories(include ${LAPACK_BINARY_DIR}/include) add_subdirectory(include) add_subdirectory(src) add_subdirectory(utils) +option(LAPACKE_BUILD_SINGLE "Build LAPACKE single precision real" ON) +option(LAPACKE_BUILD_DOUBLE "Build LAPACKE double precision real" ON) +option(LAPACKE_BUILD_COMPLEX "Build LAPACKE single precision complex" ON) +option(LAPACKE_BUILD_COMPLEX16 "Build LAPACKE double precision complex" ON) + macro(append_subdir_files variable dirname) get_directory_property(holder DIRECTORY ${dirname} DEFINITION ${variable}) foreach(depfile ${holder}) @@ -35,8 +33,29 @@ macro(append_subdir_files variable dirname) endforeach() endmacro() +message(STATUS "Build LAPACKE single precision real: ${LAPACKE_BUILD_SINGLE}") +message(STATUS "Build LAPACKE double precision real: ${LAPACKE_BUILD_DOUBLE}") +message(STATUS "Build LAPACKE single precision complex: ${LAPACKE_BUILD_COMPLEX}") +message(STATUS "Build LAPACKE double precision complex: ${LAPACKE_BUILD_COMPLEX16}") + append_subdir_files(LAPACKE_INCLUDE "include") append_subdir_files(SOURCES "src") +if (LAPACKE_BUILD_SINGLE) + append_subdir_files(SOURCES_SINGLE "src") + list(APPEND SOURCES ${SOURCES_SINGLE}) +endif() +if (LAPACKE_BUILD_DOUBLE) + append_subdir_files(SOURCES_DOUBLE "src") + list(APPEND SOURCES ${SOURCES_DOUBLE}) +endif() +if (LAPACKE_BUILD_COMPLEX) + append_subdir_files(SOURCES_COMPLEX "src") + list(APPEND SOURCES ${SOURCES_COMPLEX}) +endif() +if (LAPACKE_BUILD_COMPLEX16) + append_subdir_files(SOURCES_COMPLEX16 "src") + list(APPEND SOURCES ${SOURCES_COMPLEX16}) +endif() append_subdir_files(DEPRECATED "src") append_subdir_files(EXTENDED "src") append_subdir_files(MATGEN "src") @@ -61,9 +80,13 @@ set_target_properties( SOVERSION ${LAPACK_MAJOR_VERSION} ) target_include_directories(lapacke PUBLIC - $ + $ $ ) +if(WIN32 AND NOT UNIX) + target_compile_definitions(lapacke PUBLIC HAVE_LAPACK_CONFIG_H LAPACK_COMPLEX_STRUCTURE) + message(STATUS "Windows BUILD") +endif() if(LAPACKE_WITH_TMG) target_link_libraries(lapacke PRIVATE tmglib) @@ -71,7 +94,11 @@ endif() target_link_libraries(lapacke PRIVATE ${LAPACK_LIBRARIES}) lapack_install_library(lapacke) -install(FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR}) +install( + FILES ${LAPACKE_INCLUDE} ${LAPACK_BINARY_DIR}/include/lapacke_mangling.h + DESTINATION ${CMAKE_INSTALL_INCLUDEDIR} + COMPONENT Development + ) if(BUILD_TESTING) add_subdirectory(example) @@ -82,6 +109,7 @@ configure_file(${CMAKE_CURRENT_SOURCE_DIR}/lapacke.pc.in ${CMAKE_CURRENT_BINARY_ install(FILES ${CMAKE_CURRENT_BINARY_DIR}/lapacke.pc DESTINATION ${PKG_CONFIG_DIR} + COMPONENT Development ) configure_file(${CMAKE_CURRENT_SOURCE_DIR}/cmake/lapacke-config-version.cmake.in @@ -95,7 +123,10 @@ install(FILES ${CMAKE_CURRENT_BINARY_DIR}/CMakeFiles/lapacke-config.cmake ${LAPACK_BINARY_DIR}/lapacke-config-version.cmake DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapacke-${LAPACK_VERSION} + COMPONENT Development ) install(EXPORT lapacke-targets - DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapacke-${LAPACK_VERSION}) + DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/lapacke-${LAPACK_VERSION} + COMPONENT Development + ) diff --git a/lapack-netlib/LAPACKE/Makefile b/lapack-netlib/LAPACKE/Makefile index 016f8a2f2..a358d7c9f 100644 --- a/lapack-netlib/LAPACKE/Makefile +++ b/lapack-netlib/LAPACKE/Makefile @@ -40,22 +40,26 @@ # To clean everything including lapacke library type # 'make cleanall' # -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: lapacke +.PHONY: lapacke lapacke: include/lapacke_mangling.h $(MAKE) -C src $(MAKE) -C utils include/lapacke_mangling.h: include/lapacke_mangling_with_flags.h.in - cp $< $@ + cp include/lapacke_mangling_with_flags.h.in $@ +.PHONY: lapacke_example lapacke_example: lapacke $(MAKE) -C example -#clean: cleanlib -clean: cleanobj +.PHONY: clean cleanobj cleanlib cleanexe +clean: $(MAKE) -C src clean $(MAKE) -C utils clean $(MAKE) -C example clean @@ -64,6 +68,6 @@ cleanobj: $(MAKE) -C utils cleanobj $(MAKE) -C example cleanobj cleanlib: - rm -f ../$(LAPACKELIB) + $(MAKE) -C src cleanlib cleanexe: $(MAKE) -C example cleanexe diff --git a/lapack-netlib/LAPACKE/cmake/lapacke-config-build.cmake.in b/lapack-netlib/LAPACKE/cmake/lapacke-config-build.cmake.in index 6900f4533..0a1350172 100644 --- a/lapack-netlib/LAPACKE/cmake/lapacke-config-build.cmake.in +++ b/lapack-netlib/LAPACKE/cmake/lapacke-config-build.cmake.in @@ -7,8 +7,11 @@ if(NOT TARGET lapacke) include("@LAPACK_BINARY_DIR@/lapack-targets.cmake") endif() +# Hint for project building against lapack +set(LAPACKE_Fortran_COMPILER_ID ${LAPACK_Fortran_COMPILER_ID}) + # Report lapacke header search locations from build tree. set(LAPACKE_INCLUDE_DIRS "@LAPACK_BINARY_DIR@/include") # Report lapacke libraries. -set(LAPACKE_LIBRARIES lapacke) +set(LAPACKE_LIBRARIES lapacke ${LAPACK_LIBRARIES}) diff --git a/lapack-netlib/LAPACKE/cmake/lapacke-config-install.cmake.in b/lapack-netlib/LAPACKE/cmake/lapacke-config-install.cmake.in index caa459a24..57a5c2b2f 100644 --- a/lapack-netlib/LAPACKE/cmake/lapacke-config-install.cmake.in +++ b/lapack-netlib/LAPACKE/cmake/lapacke-config-install.cmake.in @@ -13,11 +13,14 @@ if(NOT TARGET lapacke) include(${_LAPACKE_SELF_DIR}/lapacke-targets.cmake) endif() +# Hint for project building against lapack +set(LAPACKE_Fortran_COMPILER_ID ${LAPACK_Fortran_COMPILER_ID}) + # Report lapacke header search locations. set(LAPACKE_INCLUDE_DIRS ${_LAPACKE_PREFIX}/include) # Report lapacke libraries. -set(LAPACKE_LIBRARIES lapacke) +set(LAPACKE_LIBRARIES lapacke ${LAPACK_LIBRARIES}) unset(_LAPACKE_PREFIX) unset(_LAPACKE_SELF_DIR) diff --git a/lapack-netlib/LAPACKE/example/Makefile b/lapack-netlib/LAPACKE/example/Makefile index f959a2be0..77526dc42 100644 --- a/lapack-netlib/LAPACKE/example/Makefile +++ b/lapack-netlib/LAPACKE/example/Makefile @@ -1,34 +1,38 @@ -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I. -I../include -c -o $@ $< + +.PHONY: all all: xexample_DGESV_rowmajor \ xexample_DGESV_colmajor \ xexample_DGELS_rowmajor \ xexample_DGELS_colmajor -LIBRARIES = ../../$(LAPACKELIB) ../../$(LAPACKLIB) $(BLASLIB) +LIBRARIES = $(LAPACKELIB) $(LAPACKLIB) $(BLASLIB) # Double Precision Examples xexample_DGESV_rowmajor: example_DGESV_rowmajor.o lapacke_example_aux.o $(LIBRARIES) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ ./$@ xexample_DGESV_colmajor: example_DGESV_colmajor.o lapacke_example_aux.o $(LIBRARIES) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ ./$@ xexample_DGELS_rowmajor: example_DGELS_rowmajor.o lapacke_example_aux.o $(LIBRARIES) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ ./$@ xexample_DGELS_colmajor: example_DGELS_colmajor.o lapacke_example_aux.o $(LIBRARIES) - $(LOADER) $(LOADOPTS) -o $@ $^ + $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^ ./$@ +.PHONY: clean cleanobj cleanexe clean: cleanobj cleanexe cleanobj: rm -f *.o cleanexe: rm -f x* - -.c.o: - $(CC) $(CFLAGS) -I. -I../include -c -o $@ $< diff --git a/lapack-netlib/LAPACKE/include/CMakeLists.txt b/lapack-netlib/LAPACKE/include/CMakeLists.txt index 4c30c0501..b690dc554 100644 --- a/lapack-netlib/LAPACKE/include/CMakeLists.txt +++ b/lapack-netlib/LAPACKE/include/CMakeLists.txt @@ -1,3 +1,3 @@ -set(LAPACKE_INCLUDE lapacke.h lapacke_config.h lapacke_utils.h) +set(LAPACKE_INCLUDE lapacke.h lapack.h lapacke_config.h lapacke_utils.h) file(COPY ${LAPACKE_INCLUDE} DESTINATION ${LAPACK_BINARY_DIR}/include) diff --git a/lapack-netlib/LAPACKE/include/lapack.h b/lapack-netlib/LAPACKE/include/lapack.h new file mode 100644 index 000000000..0a6226fe4 --- /dev/null +++ b/lapack-netlib/LAPACKE/include/lapack.h @@ -0,0 +1,13715 @@ +#ifndef LAPACK_H +#define LAPACK_H + +/* +* Turn on HAVE_LAPACK_CONFIG_H to redefine C-LAPACK datatypes +*/ +#ifdef HAVE_LAPACK_CONFIG_H +#include "lapacke_config.h" +#endif + +#include "lapacke_mangling.h" + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +/*----------------------------------------------------------------------------*/ +#ifndef lapack_int +#define lapack_int int +#endif + +#ifndef lapack_logical +#define lapack_logical lapack_int +#endif + +/* f2c, hence clapack and MacOS Accelerate, returns double instead of float + * for sdot, slange, clange, etc. */ +#if defined(LAPACK_F2C) + typedef double lapack_float_return; +#else + typedef float lapack_float_return; +#endif + +/* Complex types are structures equivalent to the +* Fortran complex types COMPLEX(4) and COMPLEX(8). +* +* One can also redefine the types with his own types +* for example by including in the code definitions like +* +* #define lapack_complex_float std::complex +* #define lapack_complex_double std::complex +* +* or define these types in the command line: +* +* -Dlapack_complex_float="std::complex" +* -Dlapack_complex_double="std::complex" +*/ + +#ifndef LAPACK_COMPLEX_CUSTOM + +/* Complex type (single precision) */ +#ifndef lapack_complex_float +#ifndef __cplusplus +#include +#else +#include +#endif +#define lapack_complex_float float _Complex +#endif + +#ifndef lapack_complex_float_real +#define lapack_complex_float_real(z) (creal(z)) +#endif + +#ifndef lapack_complex_float_imag +#define lapack_complex_float_imag(z) (cimag(z)) +#endif + +/* Complex type (double precision) */ +#ifndef lapack_complex_double +#ifndef __cplusplus +#include +#else +#include +#endif +#define lapack_complex_double double _Complex +#endif + +#ifndef lapack_complex_double_real +#define lapack_complex_double_real(z) (creal(z)) +#endif + +#ifndef lapack_complex_double_imag +#define lapack_complex_double_imag(z) (cimag(z)) +#endif + +#endif /* LAPACK_COMPLEX_CUSTOM */ + +/* Callback logical functions of one, two, or three arguments are used +* to select eigenvalues to sort to the top left of the Schur form. +* The value is selected if function returns TRUE (non-zero). */ + +typedef lapack_logical (*LAPACK_S_SELECT2) ( const float*, const float* ); +typedef lapack_logical (*LAPACK_S_SELECT3) + ( const float*, const float*, const float* ); +typedef lapack_logical (*LAPACK_D_SELECT2) ( const double*, const double* ); +typedef lapack_logical (*LAPACK_D_SELECT3) + ( const double*, const double*, const double* ); + +typedef lapack_logical (*LAPACK_C_SELECT1) ( const lapack_complex_float* ); +typedef lapack_logical (*LAPACK_C_SELECT2) + ( const lapack_complex_float*, const lapack_complex_float* ); +typedef lapack_logical (*LAPACK_Z_SELECT1) ( const lapack_complex_double* ); +typedef lapack_logical (*LAPACK_Z_SELECT2) + ( const lapack_complex_double*, const lapack_complex_double* ); + +#define LAPACK_lsame LAPACK_GLOBAL(lsame,LSAME) +lapack_logical LAPACK_lsame( char* ca, char* cb, + lapack_int lca, lapack_int lcb ); + + +/*----------------------------------------------------------------------------*/ +/* This is in alphabetical order (ignoring leading precision). */ + +#define LAPACK_cbbcsd LAPACK_GLOBAL(cbbcsd,CBBCSD) +void LAPACK_cbbcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + float* theta, + float* phi, + lapack_complex_float* U1, lapack_int const* ldu1, + lapack_complex_float* U2, lapack_int const* ldu2, + lapack_complex_float* V1T, lapack_int const* ldv1t, + lapack_complex_float* V2T, lapack_int const* ldv2t, + float* B11D, + float* B11E, + float* B12D, + float* B12E, + float* B21D, + float* B21E, + float* B22D, + float* B22E, + float* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_dbbcsd LAPACK_GLOBAL(dbbcsd,DBBCSD) +void LAPACK_dbbcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + double* theta, + double* phi, + double* U1, lapack_int const* ldu1, + double* U2, lapack_int const* ldu2, + double* V1T, lapack_int const* ldv1t, + double* V2T, lapack_int const* ldv2t, + double* B11D, + double* B11E, + double* B12D, + double* B12E, + double* b21d, + double* b21e, + double* b22d, + double* b22e, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sbbcsd LAPACK_GLOBAL(sbbcsd,SBBCSD) +void LAPACK_sbbcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + float* theta, + float* phi, + float* U1, lapack_int const* ldu1, + float* U2, lapack_int const* ldu2, + float* V1T, lapack_int const* ldv1t, + float* V2T, lapack_int const* ldv2t, + float* B11D, + float* B11E, + float* B12D, + float* B12E, + float* B21D, + float* B21E, + float* B22D, + float* B22E, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zbbcsd LAPACK_GLOBAL(zbbcsd,ZBBCSD) +void LAPACK_zbbcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + double* theta, + double* phi, + lapack_complex_double* U1, lapack_int const* ldu1, + lapack_complex_double* U2, lapack_int const* ldu2, + lapack_complex_double* V1T, lapack_int const* ldv1t, + lapack_complex_double* V2T, lapack_int const* ldv2t, + double* B11D, + double* B11E, + double* B12D, + double* B12E, + double* B21D, + double* B21E, + double* B22D, + double* B22E, + double* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_dbdsdc LAPACK_GLOBAL(dbdsdc,DBDSDC) +void LAPACK_dbdsdc( + char const* uplo, char const* compq, + lapack_int const* n, + double* D, + double* E, + double* U, lapack_int const* ldu, + double* VT, lapack_int const* ldvt, + double* Q, lapack_int* IQ, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sbdsdc LAPACK_GLOBAL(sbdsdc,SBDSDC) +void LAPACK_sbdsdc( + char const* uplo, char const* compq, + lapack_int const* n, + float* D, + float* E, + float* U, lapack_int const* ldu, + float* VT, lapack_int const* ldvt, + float* Q, lapack_int* IQ, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cbdsqr LAPACK_GLOBAL(cbdsqr,CBDSQR) +void LAPACK_cbdsqr( + char const* uplo, + lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, + float* D, + float* E, + lapack_complex_float* VT, lapack_int const* ldvt, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* C, lapack_int const* ldc, + float* rwork, + lapack_int* info ); + +#define LAPACK_dbdsqr LAPACK_GLOBAL(dbdsqr,DBDSQR) +void LAPACK_dbdsqr( + char const* uplo, + lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, + double* D, + double* E, + double* VT, lapack_int const* ldvt, + double* U, lapack_int const* ldu, + double* C, lapack_int const* ldc, + double* work, + lapack_int* info ); + +#define LAPACK_sbdsqr LAPACK_GLOBAL(sbdsqr,SBDSQR) +void LAPACK_sbdsqr( + char const* uplo, + lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, + float* D, + float* E, + float* VT, lapack_int const* ldvt, + float* U, lapack_int const* ldu, + float* C, lapack_int const* ldc, + float* work, + lapack_int* info ); + +#define LAPACK_zbdsqr LAPACK_GLOBAL(zbdsqr,ZBDSQR) +void LAPACK_zbdsqr( + char const* uplo, + lapack_int const* n, lapack_int const* ncvt, lapack_int const* nru, lapack_int const* ncc, + double* D, + double* E, + lapack_complex_double* VT, lapack_int const* ldvt, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* C, lapack_int const* ldc, + double* rwork, + lapack_int* info ); + +#define LAPACK_dbdsvdx LAPACK_GLOBAL(dbdsvdx,DBDSVDX) +void LAPACK_dbdsvdx( + char const* uplo, char const* jobz, char const* range, + lapack_int const* n, + double const* D, + double const* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + double* S, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sbdsvdx LAPACK_GLOBAL(sbdsvdx,SBDSVDX) +void LAPACK_sbdsvdx( + char const* uplo, char const* jobz, char const* range, + lapack_int const* n, + float const* D, + float const* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + float* S, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ddisna LAPACK_GLOBAL(ddisna,DDISNA) +void LAPACK_ddisna( + char const* job, + lapack_int const* m, lapack_int const* n, + double const* D, + double* SEP, + lapack_int* info ); + +#define LAPACK_sdisna LAPACK_GLOBAL(sdisna,SDISNA) +void LAPACK_sdisna( + char const* job, + lapack_int const* m, lapack_int const* n, + float const* D, + float* SEP, + lapack_int* info ); + +#define LAPACK_cgbbrd LAPACK_GLOBAL(cgbbrd,CGBBRD) +void LAPACK_cgbbrd( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float* AB, lapack_int const* ldab, + float* D, + float* E, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* PT, lapack_int const* ldpt, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbbrd LAPACK_GLOBAL(dgbbrd,DGBBRD) +void LAPACK_dgbbrd( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, + double* AB, lapack_int const* ldab, + double* D, + double* E, + double* Q, lapack_int const* ldq, + double* PT, lapack_int const* ldpt, + double* C, lapack_int const* ldc, + double* work, + lapack_int* info ); + +#define LAPACK_sgbbrd LAPACK_GLOBAL(sgbbrd,SGBBRD) +void LAPACK_sgbbrd( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, + float* AB, lapack_int const* ldab, + float* D, + float* E, + float* Q, lapack_int const* ldq, + float* PT, lapack_int const* ldpt, + float* C, lapack_int const* ldc, + float* work, + lapack_int* info ); + +#define LAPACK_zgbbrd LAPACK_GLOBAL(zgbbrd,ZGBBRD) +void LAPACK_zgbbrd( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* ncc, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double* AB, lapack_int const* ldab, + double* D, + double* E, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* PT, lapack_int const* ldpt, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbcon LAPACK_GLOBAL(cgbcon,CGBCON) +void LAPACK_cgbcon( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float const* AB, lapack_int const* ldab, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbcon LAPACK_GLOBAL(dgbcon,DGBCON) +void LAPACK_dgbcon( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* AB, lapack_int const* ldab, lapack_int const* ipiv, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgbcon LAPACK_GLOBAL(sgbcon,SGBCON) +void LAPACK_sgbcon( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* AB, lapack_int const* ldab, lapack_int const* ipiv, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgbcon LAPACK_GLOBAL(zgbcon,ZGBCON) +void LAPACK_zgbcon( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double const* AB, lapack_int const* ldab, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbequ LAPACK_GLOBAL(cgbequ,CGBEQU) +void LAPACK_cgbequ( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float const* AB, lapack_int const* ldab, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_dgbequ LAPACK_GLOBAL(dgbequ,DGBEQU) +void LAPACK_dgbequ( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* AB, lapack_int const* ldab, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_sgbequ LAPACK_GLOBAL(sgbequ,SGBEQU) +void LAPACK_sgbequ( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* AB, lapack_int const* ldab, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_zgbequ LAPACK_GLOBAL(zgbequ,ZGBEQU) +void LAPACK_zgbequ( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double const* AB, lapack_int const* ldab, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_cgbequb LAPACK_GLOBAL(cgbequb,CGBEQUB) +void LAPACK_cgbequb( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float const* AB, lapack_int const* ldab, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_dgbequb LAPACK_GLOBAL(dgbequb,DGBEQUB) +void LAPACK_dgbequb( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* AB, lapack_int const* ldab, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_sgbequb LAPACK_GLOBAL(sgbequb,SGBEQUB) +void LAPACK_sgbequb( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* AB, lapack_int const* ldab, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_zgbequb LAPACK_GLOBAL(zgbequb,ZGBEQUB) +void LAPACK_zgbequb( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double const* AB, lapack_int const* ldab, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_cgbrfs LAPACK_GLOBAL(cgbrfs,CGBRFS) +void LAPACK_cgbrfs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbrfs LAPACK_GLOBAL(dgbrfs,DGBRFS) +void LAPACK_dgbrfs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgbrfs LAPACK_GLOBAL(sgbrfs,SGBRFS) +void LAPACK_sgbrfs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgbrfs LAPACK_GLOBAL(zgbrfs,ZGBRFS) +void LAPACK_zgbrfs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbrfsx LAPACK_GLOBAL(cgbrfsx,CGBRFSX) +void LAPACK_cgbrfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + float* R, + float* C, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbrfsx LAPACK_GLOBAL(dgbrfsx,DGBRFSX) +void LAPACK_dgbrfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + double* R, + double* C, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgbrfsx LAPACK_GLOBAL(sgbrfsx,SGBRFSX) +void LAPACK_sgbrfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + float* R, + float* C, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgbrfsx LAPACK_GLOBAL(zgbrfsx,ZGBRFSX) +void LAPACK_zgbrfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double const* AFB, lapack_int const* ldafb, lapack_int const* ipiv, + double* R, + double* C, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbsv LAPACK_GLOBAL(cgbsv,CGBSV) +void LAPACK_cgbsv( + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgbsv LAPACK_GLOBAL(dgbsv,DGBSV) +void LAPACK_dgbsv( + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double* AB, lapack_int const* ldab, lapack_int* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgbsv LAPACK_GLOBAL(sgbsv,SGBSV) +void LAPACK_sgbsv( + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float* AB, lapack_int const* ldab, lapack_int* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgbsv LAPACK_GLOBAL(zgbsv,ZGBSV) +void LAPACK_zgbsv( + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cgbsvx LAPACK_GLOBAL(cgbsvx,CGBSVX) +void LAPACK_cgbsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + float* R, + float* C, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbsvx LAPACK_GLOBAL(dgbsvx,DGBSVX) +void LAPACK_dgbsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double* AB, lapack_int const* ldab, + double* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + double* R, + double* C, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgbsvx LAPACK_GLOBAL(sgbsvx,SGBSVX) +void LAPACK_sgbsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float* AB, lapack_int const* ldab, + float* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + float* R, + float* C, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgbsvx LAPACK_GLOBAL(zgbsvx,ZGBSVX) +void LAPACK_zgbsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + double* R, + double* C, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbsvxx LAPACK_GLOBAL(cgbsvxx,CGBSVXX) +void LAPACK_cgbsvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + float* R, + float* C, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgbsvxx LAPACK_GLOBAL(dgbsvxx,DGBSVXX) +void LAPACK_dgbsvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double* AB, lapack_int const* ldab, + double* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + double* R, + double* C, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgbsvxx LAPACK_GLOBAL(sgbsvxx,SGBSVXX) +void LAPACK_sgbsvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float* AB, lapack_int const* ldab, + float* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + float* R, + float* C, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgbsvxx LAPACK_GLOBAL(zgbsvxx,ZGBSVXX) +void LAPACK_zgbsvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* AFB, lapack_int const* ldafb, lapack_int* ipiv, char* equed, + double* R, + double* C, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgbtrf LAPACK_GLOBAL(cgbtrf,CGBTRF) +void LAPACK_cgbtrf( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dgbtrf LAPACK_GLOBAL(dgbtrf,DGBTRF) +void LAPACK_dgbtrf( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_sgbtrf LAPACK_GLOBAL(sgbtrf,SGBTRF) +void LAPACK_sgbtrf( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zgbtrf LAPACK_GLOBAL(zgbtrf,ZGBTRF) +void LAPACK_zgbtrf( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double* AB, lapack_int const* ldab, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_cgbtrs LAPACK_GLOBAL(cgbtrs,CGBTRS) +void LAPACK_cgbtrs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgbtrs LAPACK_GLOBAL(dgbtrs,DGBTRS) +void LAPACK_dgbtrs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgbtrs LAPACK_GLOBAL(sgbtrs,SGBTRS) +void LAPACK_sgbtrs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgbtrs LAPACK_GLOBAL(zgbtrs,ZGBTRS) +void LAPACK_zgbtrs( + char const* trans, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cgebak LAPACK_GLOBAL(cgebak,CGEBAK) +void LAPACK_cgebak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float const* scale, lapack_int const* m, + lapack_complex_float* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_dgebak LAPACK_GLOBAL(dgebak,DGEBAK) +void LAPACK_dgebak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double const* scale, lapack_int const* m, + double* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_sgebak LAPACK_GLOBAL(sgebak,SGEBAK) +void LAPACK_sgebak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float const* scale, lapack_int const* m, + float* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_zgebak LAPACK_GLOBAL(zgebak,ZGEBAK) +void LAPACK_zgebak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double const* scale, lapack_int const* m, + lapack_complex_double* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_cgebal LAPACK_GLOBAL(cgebal,CGEBAL) +void LAPACK_cgebal( + char const* job, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ilo, lapack_int* ihi, + float* scale, + lapack_int* info ); + +#define LAPACK_dgebal LAPACK_GLOBAL(dgebal,DGEBAL) +void LAPACK_dgebal( + char const* job, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ilo, lapack_int* ihi, + double* scale, + lapack_int* info ); + +#define LAPACK_sgebal LAPACK_GLOBAL(sgebal,SGEBAL) +void LAPACK_sgebal( + char const* job, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ilo, lapack_int* ihi, + float* scale, + lapack_int* info ); + +#define LAPACK_zgebal LAPACK_GLOBAL(zgebal,ZGEBAL) +void LAPACK_zgebal( + char const* job, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ilo, lapack_int* ihi, + double* scale, + lapack_int* info ); + +#define LAPACK_cgebrd LAPACK_GLOBAL(cgebrd,CGEBRD) +void LAPACK_cgebrd( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* D, + float* E, + lapack_complex_float* tauq, + lapack_complex_float* taup, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgebrd LAPACK_GLOBAL(dgebrd,DGEBRD) +void LAPACK_dgebrd( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* D, + double* E, + double* tauq, + double* taup, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgebrd LAPACK_GLOBAL(sgebrd,SGEBRD) +void LAPACK_sgebrd( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* D, + float* E, + float* tauq, + float* taup, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgebrd LAPACK_GLOBAL(zgebrd,ZGEBRD) +void LAPACK_zgebrd( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* D, + double* E, + lapack_complex_double* tauq, + lapack_complex_double* taup, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgecon LAPACK_GLOBAL(cgecon,CGECON) +void LAPACK_cgecon( + char const* norm, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float const* anorm, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgecon LAPACK_GLOBAL(dgecon,DGECON) +void LAPACK_dgecon( + char const* norm, + lapack_int const* n, + double const* A, lapack_int const* lda, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgecon LAPACK_GLOBAL(sgecon,SGECON) +void LAPACK_sgecon( + char const* norm, + lapack_int const* n, + float const* A, lapack_int const* lda, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgecon LAPACK_GLOBAL(zgecon,ZGECON) +void LAPACK_zgecon( + char const* norm, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double const* anorm, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgeequ LAPACK_GLOBAL(cgeequ,CGEEQU) +void LAPACK_cgeequ( + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_dgeequ LAPACK_GLOBAL(dgeequ,DGEEQU) +void LAPACK_dgeequ( + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_sgeequ LAPACK_GLOBAL(sgeequ,SGEEQU) +void LAPACK_sgeequ( + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_zgeequ LAPACK_GLOBAL(zgeequ,ZGEEQU) +void LAPACK_zgeequ( + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_cgeequb LAPACK_GLOBAL(cgeequb,CGEEQUB) +void LAPACK_cgeequb( + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_dgeequb LAPACK_GLOBAL(dgeequb,DGEEQUB) +void LAPACK_dgeequb( + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_sgeequb LAPACK_GLOBAL(sgeequb,SGEEQUB) +void LAPACK_sgeequb( + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float* R, + float* C, + float* rowcnd, + float* colcnd, + float* amax, + lapack_int* info ); + +#define LAPACK_zgeequb LAPACK_GLOBAL(zgeequb,ZGEEQUB) +void LAPACK_zgeequb( + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* R, + double* C, + double* rowcnd, + double* colcnd, + double* amax, + lapack_int* info ); + +#define LAPACK_cgees LAPACK_GLOBAL(cgees,CGEES) +void LAPACK_cgees( + char const* jobvs, char const* sort, LAPACK_C_SELECT1 select, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* sdim, + lapack_complex_float* W, + lapack_complex_float* VS, lapack_int const* ldvs, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dgees LAPACK_GLOBAL(dgees,DGEES) +void LAPACK_dgees( + char const* jobvs, char const* sort, LAPACK_D_SELECT2 select, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* sdim, + double* WR, + double* WI, + double* VS, lapack_int const* ldvs, + double* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sgees LAPACK_GLOBAL(sgees,SGEES) +void LAPACK_sgees( + char const* jobvs, char const* sort, LAPACK_S_SELECT2 select, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* sdim, + float* WR, + float* WI, + float* VS, lapack_int const* ldvs, + float* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zgees LAPACK_GLOBAL(zgees,ZGEES) +void LAPACK_zgees( + char const* jobvs, char const* sort, LAPACK_Z_SELECT1 select, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* sdim, + lapack_complex_double* W, + lapack_complex_double* VS, lapack_int const* ldvs, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cgeesx LAPACK_GLOBAL(cgeesx,CGEESX) +void LAPACK_cgeesx( + char const* jobvs, char const* sort, LAPACK_C_SELECT1 select, char const* sense, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* sdim, + lapack_complex_float* W, + lapack_complex_float* VS, lapack_int const* ldvs, + float* rconde, + float* rcondv, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dgeesx LAPACK_GLOBAL(dgeesx,DGEESX) +void LAPACK_dgeesx( + char const* jobvs, char const* sort, LAPACK_D_SELECT2 select, char const* sense, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* sdim, + double* WR, + double* WI, + double* VS, lapack_int const* ldvs, + double* rconde, + double* rcondv, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sgeesx LAPACK_GLOBAL(sgeesx,SGEESX) +void LAPACK_sgeesx( + char const* jobvs, char const* sort, LAPACK_S_SELECT2 select, char const* sense, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* sdim, + float* WR, + float* WI, + float* VS, lapack_int const* ldvs, + float* rconde, + float* rcondv, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zgeesx LAPACK_GLOBAL(zgeesx,ZGEESX) +void LAPACK_zgeesx( + char const* jobvs, char const* sort, LAPACK_Z_SELECT1 select, char const* sense, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* sdim, + lapack_complex_double* W, + lapack_complex_double* VS, lapack_int const* ldvs, + double* rconde, + double* rcondv, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cgeev LAPACK_GLOBAL(cgeev,CGEEV) +void LAPACK_cgeev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* W, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgeev LAPACK_GLOBAL(dgeev,DGEEV) +void LAPACK_dgeev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + double* A, lapack_int const* lda, + double* WR, + double* WI, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeev LAPACK_GLOBAL(sgeev,SGEEV) +void LAPACK_sgeev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + float* A, lapack_int const* lda, + float* WR, + float* WI, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeev LAPACK_GLOBAL(zgeev,ZGEEV) +void LAPACK_zgeev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* W, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgeevx LAPACK_GLOBAL(cgeevx,CGEEVX) +void LAPACK_cgeevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* W, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + float* scale, + float* abnrm, + float* rconde, + float* rcondv, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgeevx LAPACK_GLOBAL(dgeevx,DGEEVX) +void LAPACK_dgeevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + double* A, lapack_int const* lda, + double* WR, + double* WI, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + double* scale, + double* abnrm, + double* rconde, + double* rcondv, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgeevx LAPACK_GLOBAL(sgeevx,SGEEVX) +void LAPACK_sgeevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + float* A, lapack_int const* lda, + float* WR, + float* WI, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + float* scale, + float* abnrm, + float* rconde, + float* rcondv, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgeevx LAPACK_GLOBAL(zgeevx,ZGEEVX) +void LAPACK_zgeevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* W, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + double* scale, + double* abnrm, + double* rconde, + double* rcondv, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgehrd LAPACK_GLOBAL(cgehrd,CGEHRD) +void LAPACK_cgehrd( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgehrd LAPACK_GLOBAL(dgehrd,DGEHRD) +void LAPACK_dgehrd( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgehrd LAPACK_GLOBAL(sgehrd,SGEHRD) +void LAPACK_sgehrd( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgehrd LAPACK_GLOBAL(zgehrd,ZGEHRD) +void LAPACK_zgehrd( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgejsv LAPACK_GLOBAL(cgejsv,CGEJSV) +void LAPACK_cgejsv( + char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* SVA, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* V, lapack_int const* ldv, + lapack_complex_float* cwork, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dgejsv LAPACK_GLOBAL(dgejsv,DGEJSV) +void LAPACK_dgejsv( + char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* SVA, + double* U, lapack_int const* ldu, + double* V, lapack_int const* ldv, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgejsv LAPACK_GLOBAL(sgejsv,SGEJSV) +void LAPACK_sgejsv( + char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* SVA, + float* U, lapack_int const* ldu, + float* V, lapack_int const* ldv, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgejsv LAPACK_GLOBAL(zgejsv,ZGEJSV) +void LAPACK_zgejsv( + char const* joba, char const* jobu, char const* jobv, char const* jobr, char const* jobt, char const* jobp, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* SVA, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* V, lapack_int const* ldv, + lapack_complex_double* cwork, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cgelq LAPACK_GLOBAL(cgelq,CGELQ) +void LAPACK_cgelq( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* T, lapack_int const* tsize, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgelq LAPACK_GLOBAL(dgelq,DGELQ) +void LAPACK_dgelq( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* T, lapack_int const* tsize, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgelq LAPACK_GLOBAL(sgelq,SGELQ) +void LAPACK_sgelq( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* T, lapack_int const* tsize, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgelq LAPACK_GLOBAL(zgelq,ZGELQ) +void LAPACK_zgelq( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* T, lapack_int const* tsize, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgelq2 LAPACK_GLOBAL(cgelq2,CGELQ2) +void LAPACK_cgelq2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgelq2 LAPACK_GLOBAL(dgelq2,DGELQ2) +void LAPACK_dgelq2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, + lapack_int* info ); + +#define LAPACK_sgelq2 LAPACK_GLOBAL(sgelq2,SGELQ2) +void LAPACK_sgelq2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, + lapack_int* info ); + +#define LAPACK_zgelq2 LAPACK_GLOBAL(zgelq2,ZGELQ2) +void LAPACK_zgelq2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgelqf LAPACK_GLOBAL(cgelqf,CGELQF) +void LAPACK_cgelqf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgelqf LAPACK_GLOBAL(dgelqf,DGELQF) +void LAPACK_dgelqf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgelqf LAPACK_GLOBAL(sgelqf,SGELQF) +void LAPACK_sgelqf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgelqf LAPACK_GLOBAL(zgelqf,ZGELQF) +void LAPACK_zgelqf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgels LAPACK_GLOBAL(cgels,CGELS) +void LAPACK_cgels( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgels LAPACK_GLOBAL(dgels,DGELS) +void LAPACK_dgels( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgels LAPACK_GLOBAL(sgels,SGELS) +void LAPACK_sgels( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgels LAPACK_GLOBAL(zgels,ZGELS) +void LAPACK_zgels( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgelsd LAPACK_GLOBAL(cgelsd,CGELSD) +void LAPACK_cgelsd( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* S, + float const* rcond, lapack_int* rank, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dgelsd LAPACK_GLOBAL(dgelsd,DGELSD) +void LAPACK_dgelsd( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* S, + double const* rcond, lapack_int* rank, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgelsd LAPACK_GLOBAL(sgelsd,SGELSD) +void LAPACK_sgelsd( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* S, + float const* rcond, lapack_int* rank, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgelsd LAPACK_GLOBAL(zgelsd,ZGELSD) +void LAPACK_zgelsd( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* S, + double const* rcond, lapack_int* rank, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cgelss LAPACK_GLOBAL(cgelss,CGELSS) +void LAPACK_cgelss( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* S, + float const* rcond, lapack_int* rank, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgelss LAPACK_GLOBAL(dgelss,DGELSS) +void LAPACK_dgelss( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* S, + double const* rcond, lapack_int* rank, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgelss LAPACK_GLOBAL(sgelss,SGELSS) +void LAPACK_sgelss( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* S, + float const* rcond, lapack_int* rank, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgelss LAPACK_GLOBAL(zgelss,ZGELSS) +void LAPACK_zgelss( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* S, + double const* rcond, lapack_int* rank, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgelsy LAPACK_GLOBAL(cgelsy,CGELSY) +void LAPACK_cgelsy( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, lapack_int* JPVT, + float const* rcond, lapack_int* rank, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgelsy LAPACK_GLOBAL(dgelsy,DGELSY) +void LAPACK_dgelsy( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, lapack_int* JPVT, + double const* rcond, lapack_int* rank, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgelsy LAPACK_GLOBAL(sgelsy,SGELSY) +void LAPACK_sgelsy( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, lapack_int* JPVT, + float const* rcond, lapack_int* rank, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgelsy LAPACK_GLOBAL(zgelsy,ZGELSY) +void LAPACK_zgelsy( + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, lapack_int* JPVT, + double const* rcond, lapack_int* rank, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgemlq LAPACK_GLOBAL(cgemlq,CGEMLQ) +void LAPACK_cgemlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* T, lapack_int const* tsize, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgemlq LAPACK_GLOBAL(dgemlq,DGEMLQ) +void LAPACK_dgemlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* T, lapack_int const* tsize, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgemlq LAPACK_GLOBAL(sgemlq,SGEMLQ) +void LAPACK_sgemlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* T, lapack_int const* tsize, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgemlq LAPACK_GLOBAL(zgemlq,ZGEMLQ) +void LAPACK_zgemlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* T, lapack_int const* tsize, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgemqr LAPACK_GLOBAL(cgemqr,CGEMQR) +void LAPACK_cgemqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* T, lapack_int const* tsize, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgemqr LAPACK_GLOBAL(dgemqr,DGEMQR) +void LAPACK_dgemqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* T, lapack_int const* tsize, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgemqr LAPACK_GLOBAL(sgemqr,SGEMQR) +void LAPACK_sgemqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* T, lapack_int const* tsize, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgemqr LAPACK_GLOBAL(zgemqr,ZGEMQR) +void LAPACK_zgemqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* T, lapack_int const* tsize, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgemqrt LAPACK_GLOBAL(cgemqrt,CGEMQRT) +void LAPACK_cgemqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgemqrt LAPACK_GLOBAL(dgemqrt,DGEMQRT) +void LAPACK_dgemqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, + double const* V, lapack_int const* ldv, + double const* T, lapack_int const* ldt, + double* C, lapack_int const* ldc, + double* work, + lapack_int* info ); + +#define LAPACK_sgemqrt LAPACK_GLOBAL(sgemqrt,SGEMQRT) +void LAPACK_sgemqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, + float const* V, lapack_int const* ldv, + float const* T, lapack_int const* ldt, + float* C, lapack_int const* ldc, + float* work, + lapack_int* info ); + +#define LAPACK_zgemqrt LAPACK_GLOBAL(zgemqrt,ZGEMQRT) +void LAPACK_zgemqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* nb, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgeql2 LAPACK_GLOBAL(cgeql2,CGEQL2) +void LAPACK_cgeql2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgeql2 LAPACK_GLOBAL(dgeql2,DGEQL2) +void LAPACK_dgeql2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, + lapack_int* info ); + +#define LAPACK_sgeql2 LAPACK_GLOBAL(sgeql2,SGEQL2) +void LAPACK_sgeql2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, + lapack_int* info ); + +#define LAPACK_zgeql2 LAPACK_GLOBAL(zgeql2,ZGEQL2) +void LAPACK_zgeql2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgeqlf LAPACK_GLOBAL(cgeqlf,CGEQLF) +void LAPACK_cgeqlf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgeqlf LAPACK_GLOBAL(dgeqlf,DGEQLF) +void LAPACK_dgeqlf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqlf LAPACK_GLOBAL(sgeqlf,SGEQLF) +void LAPACK_sgeqlf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeqlf LAPACK_GLOBAL(zgeqlf,ZGEQLF) +void LAPACK_zgeqlf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqpf LAPACK_GLOBAL(sgeqpf,SGEQPF) +void LAPACK_sgeqpf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, + lapack_int* jpvt, float* tau, float* work, + lapack_int *info ); + +#define LAPACK_dgeqpf LAPACK_GLOBAL(dgeqpf,DGEQPF) +void LAPACK_dgeqpf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, + lapack_int* jpvt, double* tau, double* work, + lapack_int *info ); + +#define LAPACK_cgeqpf LAPACK_GLOBAL(cgeqpf,CGEQPF) +void LAPACK_cgeqpf( lapack_int* m, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_int* jpvt, + lapack_complex_float* tau, lapack_complex_float* work, + float* rwork, lapack_int *info ); + +#define LAPACK_zgeqpf LAPACK_GLOBAL(zgeqpf,ZGEQPF) +void LAPACK_zgeqpf( lapack_int* m, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_int* jpvt, + lapack_complex_double* tau, lapack_complex_double* work, + double* rwork, lapack_int *info ); + +#define LAPACK_cgeqp3 LAPACK_GLOBAL(cgeqp3,CGEQP3) +void LAPACK_cgeqp3( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* JPVT, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgeqp3 LAPACK_GLOBAL(dgeqp3,DGEQP3) +void LAPACK_dgeqp3( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* JPVT, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqp3 LAPACK_GLOBAL(sgeqp3,SGEQP3) +void LAPACK_sgeqp3( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* JPVT, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeqp3 LAPACK_GLOBAL(zgeqp3,ZGEQP3) +void LAPACK_zgeqp3( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* JPVT, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgeqr LAPACK_GLOBAL(cgeqr,CGEQR) +void LAPACK_cgeqr( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* T, lapack_int const* tsize, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgeqr LAPACK_GLOBAL(dgeqr,DGEQR) +void LAPACK_dgeqr( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* T, lapack_int const* tsize, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqr LAPACK_GLOBAL(sgeqr,SGEQR) +void LAPACK_sgeqr( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* T, lapack_int const* tsize, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeqr LAPACK_GLOBAL(zgeqr,ZGEQR) +void LAPACK_zgeqr( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* T, lapack_int const* tsize, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgeqr2 LAPACK_GLOBAL(cgeqr2,CGEQR2) +void LAPACK_cgeqr2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgeqr2 LAPACK_GLOBAL(dgeqr2,DGEQR2) +void LAPACK_dgeqr2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, + lapack_int* info ); + +#define LAPACK_sgeqr2 LAPACK_GLOBAL(sgeqr2,SGEQR2) +void LAPACK_sgeqr2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, + lapack_int* info ); + +#define LAPACK_zgeqr2 LAPACK_GLOBAL(zgeqr2,ZGEQR2) +void LAPACK_zgeqr2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgeqrf LAPACK_GLOBAL(cgeqrf,CGEQRF) +void LAPACK_cgeqrf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgeqrf LAPACK_GLOBAL(dgeqrf,DGEQRF) +void LAPACK_dgeqrf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqrf LAPACK_GLOBAL(sgeqrf,SGEQRF) +void LAPACK_sgeqrf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeqrf LAPACK_GLOBAL(zgeqrf,ZGEQRF) +void LAPACK_zgeqrf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgeqrfp LAPACK_GLOBAL(cgeqrfp,CGEQRFP) +void LAPACK_cgeqrfp( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgeqrfp LAPACK_GLOBAL(dgeqrfp,DGEQRFP) +void LAPACK_dgeqrfp( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgeqrfp LAPACK_GLOBAL(sgeqrfp,SGEQRFP) +void LAPACK_sgeqrfp( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgeqrfp LAPACK_GLOBAL(zgeqrfp,ZGEQRFP) +void LAPACK_zgeqrfp( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgeqrt LAPACK_GLOBAL(cgeqrt,CGEQRT) +void LAPACK_cgeqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* nb, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgeqrt LAPACK_GLOBAL(dgeqrt,DGEQRT) +void LAPACK_dgeqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* nb, + double* A, lapack_int const* lda, + double* T, lapack_int const* ldt, + double* work, + lapack_int* info ); + +#define LAPACK_sgeqrt LAPACK_GLOBAL(sgeqrt,SGEQRT) +void LAPACK_sgeqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* nb, + float* A, lapack_int const* lda, + float* T, lapack_int const* ldt, + float* work, + lapack_int* info ); + +#define LAPACK_zgeqrt LAPACK_GLOBAL(zgeqrt,ZGEQRT) +void LAPACK_zgeqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* nb, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgeqrt2 LAPACK_GLOBAL(cgeqrt2,CGEQRT2) +void LAPACK_cgeqrt2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_dgeqrt2 LAPACK_GLOBAL(dgeqrt2,DGEQRT2) +void LAPACK_dgeqrt2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_sgeqrt2 LAPACK_GLOBAL(sgeqrt2,SGEQRT2) +void LAPACK_sgeqrt2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_zgeqrt2 LAPACK_GLOBAL(zgeqrt2,ZGEQRT2) +void LAPACK_zgeqrt2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_cgeqrt3 LAPACK_GLOBAL(cgeqrt3,CGEQRT3) +void LAPACK_cgeqrt3( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_dgeqrt3 LAPACK_GLOBAL(dgeqrt3,DGEQRT3) +void LAPACK_dgeqrt3( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_sgeqrt3 LAPACK_GLOBAL(sgeqrt3,SGEQRT3) +void LAPACK_sgeqrt3( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_zgeqrt3 LAPACK_GLOBAL(zgeqrt3,ZGEQRT3) +void LAPACK_zgeqrt3( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_cgerfs LAPACK_GLOBAL(cgerfs,CGERFS) +void LAPACK_cgerfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgerfs LAPACK_GLOBAL(dgerfs,DGERFS) +void LAPACK_dgerfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgerfs LAPACK_GLOBAL(sgerfs,SGERFS) +void LAPACK_sgerfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgerfs LAPACK_GLOBAL(zgerfs,ZGERFS) +void LAPACK_zgerfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgerfsx LAPACK_GLOBAL(cgerfsx,CGERFSX) +void LAPACK_cgerfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float const* R, + float const* C, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgerfsx LAPACK_GLOBAL(dgerfsx,DGERFSX) +void LAPACK_dgerfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double const* R, + double const* C, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgerfsx LAPACK_GLOBAL(sgerfsx,SGERFSX) +void LAPACK_sgerfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float const* R, + float const* C, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgerfsx LAPACK_GLOBAL(zgerfsx,ZGERFSX) +void LAPACK_zgerfsx( + char const* trans, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double const* R, + double const* C, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgerq2 LAPACK_GLOBAL(cgerq2,CGERQ2) +void LAPACK_cgerq2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgerq2 LAPACK_GLOBAL(dgerq2,DGERQ2) +void LAPACK_dgerq2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, + lapack_int* info ); + +#define LAPACK_sgerq2 LAPACK_GLOBAL(sgerq2,SGERQ2) +void LAPACK_sgerq2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, + lapack_int* info ); + +#define LAPACK_zgerq2 LAPACK_GLOBAL(zgerq2,ZGERQ2) +void LAPACK_zgerq2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgerqf LAPACK_GLOBAL(cgerqf,CGERQF) +void LAPACK_cgerqf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgerqf LAPACK_GLOBAL(dgerqf,DGERQF) +void LAPACK_dgerqf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgerqf LAPACK_GLOBAL(sgerqf,SGERQF) +void LAPACK_sgerqf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgerqf LAPACK_GLOBAL(zgerqf,ZGERQF) +void LAPACK_zgerqf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgesdd LAPACK_GLOBAL(cgesdd,CGESDD) +void LAPACK_cgesdd( + char const* jobz, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* S, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* VT, lapack_int const* ldvt, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dgesdd LAPACK_GLOBAL(dgesdd,DGESDD) +void LAPACK_dgesdd( + char const* jobz, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* S, + double* U, lapack_int const* ldu, + double* VT, lapack_int const* ldvt, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgesdd LAPACK_GLOBAL(sgesdd,SGESDD) +void LAPACK_sgesdd( + char const* jobz, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* S, + float* U, lapack_int const* ldu, + float* VT, lapack_int const* ldvt, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgesdd LAPACK_GLOBAL(zgesdd,ZGESDD) +void LAPACK_zgesdd( + char const* jobz, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* S, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* VT, lapack_int const* ldvt, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV) +void LAPACK_cgesv( + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgesv LAPACK_GLOBAL(dgesv,DGESV) +void LAPACK_dgesv( + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgesv LAPACK_GLOBAL(sgesv,SGESV) +void LAPACK_sgesv( + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgesv LAPACK_GLOBAL(zgesv,ZGESV) +void LAPACK_zgesv( + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsgesv LAPACK_GLOBAL(dsgesv,DSGESV) +void LAPACK_dsgesv( + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* work, + float* swork, lapack_int* iter, + lapack_int* info ); + +#define LAPACK_zcgesv LAPACK_GLOBAL(zcgesv,ZCGESV) +void LAPACK_zcgesv( + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + lapack_complex_double* work, + lapack_complex_float* swork, + double* rwork, lapack_int* iter, + lapack_int* info ); + +#define LAPACK_cgesvd LAPACK_GLOBAL(cgesvd,CGESVD) +void LAPACK_cgesvd( + char const* jobu, char const* jobvt, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* S, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* VT, lapack_int const* ldvt, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgesvd LAPACK_GLOBAL(dgesvd,DGESVD) +void LAPACK_dgesvd( + char const* jobu, char const* jobvt, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* S, + double* U, lapack_int const* ldu, + double* VT, lapack_int const* ldvt, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgesvd LAPACK_GLOBAL(sgesvd,SGESVD) +void LAPACK_sgesvd( + char const* jobu, char const* jobvt, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* S, + float* U, lapack_int const* ldu, + float* VT, lapack_int const* ldvt, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgesvd LAPACK_GLOBAL(zgesvd,ZGESVD) +void LAPACK_zgesvd( + char const* jobu, char const* jobvt, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* S, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* VT, lapack_int const* ldvt, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgesvdq LAPACK_GLOBAL(cgesvdq,CGESVDQ) +void LAPACK_cgesvdq( + char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* S, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* V, lapack_int const* ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int const* liwork, + lapack_complex_float* cwork, lapack_int* lcwork, + float* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_dgesvdq LAPACK_GLOBAL(dgesvdq,DGESVDQ) +void LAPACK_dgesvdq( + char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* S, + double* U, lapack_int const* ldu, + double* V, lapack_int const* ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int const* liwork, + double* work, lapack_int* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_sgesvdq LAPACK_GLOBAL(sgesvdq,SGESVDQ) +void LAPACK_sgesvdq( + char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* S, + float* U, lapack_int const* ldu, + float* V, lapack_int const* ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int const* liwork, + float* work, lapack_int* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_zgesvdq LAPACK_GLOBAL(zgesvdq,ZGESVDQ) +void LAPACK_zgesvdq( + char const* joba, char const* jobp, char const* jobr, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* S, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* V, lapack_int const* ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int const* liwork, + lapack_complex_float* cwork, lapack_int* lcwork, + double* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_cgesvdx LAPACK_GLOBAL(cgesvdx,CGESVDX) +void LAPACK_cgesvdx( + char const* jobu, char const* jobvt, char const* range, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + float* S, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* VT, lapack_int const* ldvt, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dgesvdx LAPACK_GLOBAL(dgesvdx,DGESVDX) +void LAPACK_dgesvdx( + char const* jobu, char const* jobvt, char const* range, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + double* S, + double* U, lapack_int const* ldu, + double* VT, lapack_int const* ldvt, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgesvdx LAPACK_GLOBAL(sgesvdx,SGESVDX) +void LAPACK_sgesvdx( + char const* jobu, char const* jobvt, char const* range, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + float* S, + float* U, lapack_int const* ldu, + float* VT, lapack_int const* ldvt, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgesvdx LAPACK_GLOBAL(zgesvdx,ZGESVDX) +void LAPACK_zgesvdx( + char const* jobu, char const* jobvt, char const* range, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* ns, + double* S, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* VT, lapack_int const* ldvt, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cgesvj LAPACK_GLOBAL(cgesvj,CGESVJ) +void LAPACK_cgesvj( + char const* joba, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* SVA, lapack_int const* mv, + lapack_complex_float* V, lapack_int const* ldv, + lapack_complex_float* cwork, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_dgesvj LAPACK_GLOBAL(dgesvj,DGESVJ) +void LAPACK_dgesvj( + char const* joba, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* SVA, lapack_int const* mv, + double* V, lapack_int const* ldv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgesvj LAPACK_GLOBAL(sgesvj,SGESVJ) +void LAPACK_sgesvj( + char const* joba, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* SVA, lapack_int const* mv, + float* V, lapack_int const* ldv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgesvj LAPACK_GLOBAL(zgesvj,ZGESVJ) +void LAPACK_zgesvj( + char const* joba, char const* jobu, char const* jobv, + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* SVA, lapack_int const* mv, + lapack_complex_double* V, lapack_int const* ldv, + lapack_complex_double* cwork, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_cgesvx LAPACK_GLOBAL(cgesvx,CGESVX) +void LAPACK_cgesvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* R, + float* C, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgesvx LAPACK_GLOBAL(dgesvx,DGESVX) +void LAPACK_dgesvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* R, + double* C, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgesvx LAPACK_GLOBAL(sgesvx,SGESVX) +void LAPACK_sgesvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* R, + float* C, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgesvx LAPACK_GLOBAL(zgesvx,ZGESVX) +void LAPACK_zgesvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* R, + double* C, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgesvxx LAPACK_GLOBAL(cgesvxx,CGESVXX) +void LAPACK_cgesvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* R, + float* C, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgesvxx LAPACK_GLOBAL(dgesvxx,DGESVXX) +void LAPACK_dgesvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* R, + double* C, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgesvxx LAPACK_GLOBAL(sgesvxx,SGESVXX) +void LAPACK_sgesvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* R, + float* C, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgesvxx LAPACK_GLOBAL(zgesvxx,ZGESVXX) +void LAPACK_zgesvxx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* R, + double* C, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgetf2 LAPACK_GLOBAL(cgetf2,CGETF2) +void LAPACK_cgetf2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dgetf2 LAPACK_GLOBAL(dgetf2,DGETF2) +void LAPACK_dgetf2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_sgetf2 LAPACK_GLOBAL(sgetf2,SGETF2) +void LAPACK_sgetf2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zgetf2 LAPACK_GLOBAL(zgetf2,ZGETF2) +void LAPACK_zgetf2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF) +void LAPACK_cgetrf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF) +void LAPACK_dgetrf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) +void LAPACK_sgetrf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zgetrf LAPACK_GLOBAL(zgetrf,ZGETRF) +void LAPACK_zgetrf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_cgetrf2 LAPACK_GLOBAL(cgetrf2,CGETRF2) +void LAPACK_cgetrf2( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dgetrf2 LAPACK_GLOBAL(dgetrf2,DGETRF2) +void LAPACK_dgetrf2( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_sgetrf2 LAPACK_GLOBAL(sgetrf2,SGETRF2) +void LAPACK_sgetrf2( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zgetrf2 LAPACK_GLOBAL(zgetrf2,ZGETRF2) +void LAPACK_zgetrf2( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_cgetri LAPACK_GLOBAL(cgetri,CGETRI) +void LAPACK_cgetri( + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgetri LAPACK_GLOBAL(dgetri,DGETRI) +void LAPACK_dgetri( + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgetri LAPACK_GLOBAL(sgetri,SGETRI) +void LAPACK_sgetri( + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgetri LAPACK_GLOBAL(zgetri,ZGETRI) +void LAPACK_zgetri( + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgetrs LAPACK_GLOBAL(cgetrs,CGETRS) +void LAPACK_cgetrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgetrs LAPACK_GLOBAL(dgetrs,DGETRS) +void LAPACK_dgetrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgetrs LAPACK_GLOBAL(sgetrs,SGETRS) +void LAPACK_sgetrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgetrs LAPACK_GLOBAL(zgetrs,ZGETRS) +void LAPACK_zgetrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cgetsls LAPACK_GLOBAL(cgetsls,CGETSLS) +void LAPACK_cgetsls( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgetsls LAPACK_GLOBAL(dgetsls,DGETSLS) +void LAPACK_dgetsls( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgetsls LAPACK_GLOBAL(sgetsls,SGETSLS) +void LAPACK_sgetsls( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgetsls LAPACK_GLOBAL(zgetsls,ZGETSLS) +void LAPACK_zgetsls( + char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cggbak LAPACK_GLOBAL(cggbak,CGGBAK) +void LAPACK_cggbak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float const* lscale, + float const* rscale, lapack_int const* m, + lapack_complex_float* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_dggbak LAPACK_GLOBAL(dggbak,DGGBAK) +void LAPACK_dggbak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double const* lscale, + double const* rscale, lapack_int const* m, + double* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_sggbak LAPACK_GLOBAL(sggbak,SGGBAK) +void LAPACK_sggbak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float const* lscale, + float const* rscale, lapack_int const* m, + float* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_zggbak LAPACK_GLOBAL(zggbak,ZGGBAK) +void LAPACK_zggbak( + char const* job, char const* side, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double const* lscale, + double const* rscale, lapack_int const* m, + lapack_complex_double* V, lapack_int const* ldv, + lapack_int* info ); + +#define LAPACK_cggbal LAPACK_GLOBAL(cggbal,CGGBAL) +void LAPACK_cggbal( + char const* job, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, lapack_int* ilo, lapack_int* ihi, + float* lscale, + float* rscale, + float* work, + lapack_int* info ); + +#define LAPACK_dggbal LAPACK_GLOBAL(dggbal,DGGBAL) +void LAPACK_dggbal( + char const* job, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, lapack_int* ilo, lapack_int* ihi, + double* lscale, + double* rscale, + double* work, + lapack_int* info ); + +#define LAPACK_sggbal LAPACK_GLOBAL(sggbal,SGGBAL) +void LAPACK_sggbal( + char const* job, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, lapack_int* ilo, lapack_int* ihi, + float* lscale, + float* rscale, + float* work, + lapack_int* info ); + +#define LAPACK_zggbal LAPACK_GLOBAL(zggbal,ZGGBAL) +void LAPACK_zggbal( + char const* job, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, lapack_int* ilo, lapack_int* ihi, + double* lscale, + double* rscale, + double* work, + lapack_int* info ); + +#define LAPACK_cgges LAPACK_GLOBAL(cgges,CGGES) +void LAPACK_cgges( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VSL, lapack_int const* ldvsl, + lapack_complex_float* VSR, lapack_int const* ldvsr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dgges LAPACK_GLOBAL(dgges,DGGES) +void LAPACK_dgges( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, lapack_int* sdim, + double* alphar, + double* alphai, + double* beta, + double* VSL, lapack_int const* ldvsl, + double* VSR, lapack_int const* ldvsr, + double* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sgges LAPACK_GLOBAL(sgges,SGGES) +void LAPACK_sgges( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, lapack_int* sdim, + float* alphar, + float* alphai, + float* beta, + float* VSL, lapack_int const* ldvsl, + float* VSR, lapack_int const* ldvsr, + float* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zgges LAPACK_GLOBAL(zgges,ZGGES) +void LAPACK_zgges( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VSL, lapack_int const* ldvsl, + lapack_complex_double* VSR, lapack_int const* ldvsr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cgges3 LAPACK_GLOBAL(cgges3,CGGES3) +void LAPACK_cgges3( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VSL, lapack_int const* ldvsl, + lapack_complex_float* VSR, lapack_int const* ldvsr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dgges3 LAPACK_GLOBAL(dgges3,DGGES3) +void LAPACK_dgges3( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, lapack_int* sdim, + double* alphar, + double* alphai, + double* beta, + double* VSL, lapack_int const* ldvsl, + double* VSR, lapack_int const* ldvsr, + double* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sgges3 LAPACK_GLOBAL(sgges3,SGGES3) +void LAPACK_sgges3( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, lapack_int* sdim, + float* alphar, + float* alphai, + float* beta, + float* VSL, lapack_int const* ldvsl, + float* VSR, lapack_int const* ldvsr, + float* work, lapack_int const* lwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zgges3 LAPACK_GLOBAL(zgges3,ZGGES3) +void LAPACK_zgges3( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VSL, lapack_int const* ldvsl, + lapack_complex_double* VSR, lapack_int const* ldvsr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cggesx LAPACK_GLOBAL(cggesx,CGGESX) +void LAPACK_cggesx( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_C_SELECT2 selctg, char const* sense, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VSL, lapack_int const* ldvsl, + lapack_complex_float* VSR, lapack_int const* ldvsr, + float* rconde, + float* rcondv, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dggesx LAPACK_GLOBAL(dggesx,DGGESX) +void LAPACK_dggesx( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_D_SELECT3 selctg, char const* sense, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, lapack_int* sdim, + double* alphar, + double* alphai, + double* beta, + double* VSL, lapack_int const* ldvsl, + double* VSR, lapack_int const* ldvsr, + double* rconde, + double* rcondv, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sggesx LAPACK_GLOBAL(sggesx,SGGESX) +void LAPACK_sggesx( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_S_SELECT3 selctg, char const* sense, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, lapack_int* sdim, + float* alphar, + float* alphai, + float* beta, + float* VSL, lapack_int const* ldvsl, + float* VSR, lapack_int const* ldvsr, + float* rconde, + float* rcondv, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zggesx LAPACK_GLOBAL(zggesx,ZGGESX) +void LAPACK_zggesx( + char const* jobvsl, char const* jobvsr, char const* sort, LAPACK_Z_SELECT2 selctg, char const* sense, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, lapack_int* sdim, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VSL, lapack_int const* ldvsl, + lapack_complex_double* VSR, lapack_int const* ldvsr, + double* rconde, + double* rcondv, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_int const* liwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cggev LAPACK_GLOBAL(cggev,CGGEV) +void LAPACK_cggev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dggev LAPACK_GLOBAL(dggev,DGGEV) +void LAPACK_dggev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* alphar, + double* alphai, + double* beta, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggev LAPACK_GLOBAL(sggev,SGGEV) +void LAPACK_sggev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* alphar, + float* alphai, + float* beta, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggev LAPACK_GLOBAL(zggev,ZGGEV) +void LAPACK_zggev( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cggev3 LAPACK_GLOBAL(cggev3,CGGEV3) +void LAPACK_cggev3( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dggev3 LAPACK_GLOBAL(dggev3,DGGEV3) +void LAPACK_dggev3( + char const* jobvl, char const* jobvr, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* alphar, + double* alphai, + double* beta, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggev3 LAPACK_GLOBAL(sggev3,SGGEV3) +void LAPACK_sggev3( + char const* jobvl, char const* jobvr, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* alphar, + float* alphai, + float* beta, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggev3 LAPACK_GLOBAL(zggev3,ZGGEV3) +void LAPACK_zggev3( + char const* jobvl, char const* jobvr, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cggevx LAPACK_GLOBAL(cggevx,CGGEVX) +void LAPACK_cggevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + float* lscale, + float* rscale, + float* abnrm, + float* bbnrm, + float* rconde, + float* rcondv, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_dggevx LAPACK_GLOBAL(dggevx,DGGEVX) +void LAPACK_dggevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* alphar, + double* alphai, + double* beta, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + double* lscale, + double* rscale, + double* abnrm, + double* bbnrm, + double* rconde, + double* rcondv, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_sggevx LAPACK_GLOBAL(sggevx,SGGEVX) +void LAPACK_sggevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* alphar, + float* alphai, + float* beta, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + float* lscale, + float* rscale, + float* abnrm, + float* bbnrm, + float* rconde, + float* rcondv, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_zggevx LAPACK_GLOBAL(zggevx,ZGGEVX) +void LAPACK_zggevx( + char const* balanc, char const* jobvl, char const* jobvr, char const* sense, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int* ilo, lapack_int* ihi, + double* lscale, + double* rscale, + double* abnrm, + double* bbnrm, + double* rconde, + double* rcondv, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_logical* BWORK, + lapack_int* info ); + +#define LAPACK_cggglm LAPACK_GLOBAL(cggglm,CGGGLM) +void LAPACK_cggglm( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* D, + lapack_complex_float* X, + lapack_complex_float* Y, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dggglm LAPACK_GLOBAL(dggglm,DGGGLM) +void LAPACK_dggglm( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* D, + double* X, + double* Y, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggglm LAPACK_GLOBAL(sggglm,SGGGLM) +void LAPACK_sggglm( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* D, + float* X, + float* Y, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggglm LAPACK_GLOBAL(zggglm,ZGGGLM) +void LAPACK_zggglm( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* D, + lapack_complex_double* X, + lapack_complex_double* Y, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgghd3 LAPACK_GLOBAL(cgghd3,CGGHD3) +void LAPACK_cgghd3( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgghd3 LAPACK_GLOBAL(dgghd3,DGGHD3) +void LAPACK_dgghd3( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* Q, lapack_int const* ldq, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgghd3 LAPACK_GLOBAL(sgghd3,SGGHD3) +void LAPACK_sgghd3( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* Q, lapack_int const* ldq, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgghd3 LAPACK_GLOBAL(zgghd3,ZGGHD3) +void LAPACK_zgghd3( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgghrd LAPACK_GLOBAL(cgghrd,CGGHRD) +void LAPACK_cgghrd( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_int* info ); + +#define LAPACK_dgghrd LAPACK_GLOBAL(dgghrd,DGGHRD) +void LAPACK_dgghrd( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* Q, lapack_int const* ldq, + double* Z, lapack_int const* ldz, + lapack_int* info ); + +#define LAPACK_sgghrd LAPACK_GLOBAL(sgghrd,SGGHRD) +void LAPACK_sgghrd( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* Q, lapack_int const* ldq, + float* Z, lapack_int const* ldz, + lapack_int* info ); + +#define LAPACK_zgghrd LAPACK_GLOBAL(zgghrd,ZGGHRD) +void LAPACK_zgghrd( + char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_int* info ); + +#define LAPACK_cgglse LAPACK_GLOBAL(cgglse,CGGLSE) +void LAPACK_cgglse( + lapack_int const* m, lapack_int const* n, lapack_int const* p, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* C, + lapack_complex_float* D, + lapack_complex_float* X, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dgglse LAPACK_GLOBAL(dgglse,DGGLSE) +void LAPACK_dgglse( + lapack_int const* m, lapack_int const* n, lapack_int const* p, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* C, + double* D, + double* X, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sgglse LAPACK_GLOBAL(sgglse,SGGLSE) +void LAPACK_sgglse( + lapack_int const* m, lapack_int const* n, lapack_int const* p, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* C, + float* D, + float* X, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zgglse LAPACK_GLOBAL(zgglse,ZGGLSE) +void LAPACK_zgglse( + lapack_int const* m, lapack_int const* n, lapack_int const* p, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* C, + lapack_complex_double* D, + lapack_complex_double* X, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cggqrf LAPACK_GLOBAL(cggqrf,CGGQRF) +void LAPACK_cggqrf( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* taua, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* taub, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dggqrf LAPACK_GLOBAL(dggqrf,DGGQRF) +void LAPACK_dggqrf( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + double* A, lapack_int const* lda, + double* taua, + double* B, lapack_int const* ldb, + double* taub, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggqrf LAPACK_GLOBAL(sggqrf,SGGQRF) +void LAPACK_sggqrf( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + float* A, lapack_int const* lda, + float* taua, + float* B, lapack_int const* ldb, + float* taub, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggqrf LAPACK_GLOBAL(zggqrf,ZGGQRF) +void LAPACK_zggqrf( + lapack_int const* n, lapack_int const* m, lapack_int const* p, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* taua, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* taub, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cggrqf LAPACK_GLOBAL(cggrqf,CGGRQF) +void LAPACK_cggrqf( + lapack_int const* m, lapack_int const* p, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* taua, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* taub, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dggrqf LAPACK_GLOBAL(dggrqf,DGGRQF) +void LAPACK_dggrqf( + lapack_int const* m, lapack_int const* p, lapack_int const* n, + double* A, lapack_int const* lda, + double* taua, + double* B, lapack_int const* ldb, + double* taub, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggrqf LAPACK_GLOBAL(sggrqf,SGGRQF) +void LAPACK_sggrqf( + lapack_int const* m, lapack_int const* p, lapack_int const* n, + float* A, lapack_int const* lda, + float* taua, + float* B, lapack_int const* ldb, + float* taub, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggrqf LAPACK_GLOBAL(zggrqf,ZGGRQF) +void LAPACK_zggrqf( + lapack_int const* m, lapack_int const* p, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* taua, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* taub, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggsvd LAPACK_GLOBAL(sggsvd,SGGSVD) +lapack_int LAPACKE_sggsvd( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* alpha, float* beta, float* u, lapack_int ldu, + float* v, lapack_int ldv, float* q, lapack_int ldq, + lapack_int* iwork ); + +#define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD) +lapack_int LAPACKE_dggsvd( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* alpha, double* beta, double* u, + lapack_int ldu, double* v, lapack_int ldv, double* q, + lapack_int ldq, lapack_int* iwork ); + +#define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD) +lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + float* alpha, float* beta, lapack_complex_float* u, + lapack_int ldu, lapack_complex_float* v, + lapack_int ldv, lapack_complex_float* q, + lapack_int ldq, lapack_int* iwork ); + +#define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD) +lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double* alpha, double* beta, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_int* iwork ); + +#define LAPACK_cggsvd3 LAPACK_GLOBAL(cggsvd3,CGGSVD3) +void LAPACK_cggsvd3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* alpha, + float* beta, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* V, lapack_int const* ldv, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dggsvd3 LAPACK_GLOBAL(dggsvd3,DGGSVD3) +void LAPACK_dggsvd3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* alpha, + double* beta, + double* U, lapack_int const* ldu, + double* V, lapack_int const* ldv, + double* Q, lapack_int const* ldq, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sggsvd3 LAPACK_GLOBAL(sggsvd3,SGGSVD3) +void LAPACK_sggsvd3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* alpha, + float* beta, + float* U, lapack_int const* ldu, + float* V, lapack_int const* ldv, + float* Q, lapack_int const* ldq, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zggsvd3 LAPACK_GLOBAL(zggsvd3,ZGGSVD3) +void LAPACK_zggsvd3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* n, lapack_int const* p, lapack_int* k, lapack_int* l, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* alpha, + double* beta, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* V, lapack_int const* ldv, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sggsvp LAPACK_GLOBAL(sggsvp,SGGSVP) +lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, float* a, + lapack_int lda, float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, float* u, + lapack_int ldu, float* v, lapack_int ldv, float* q, + lapack_int ldq ); + +#define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP) +lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, double* a, + lapack_int lda, double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq ); + +#define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP) +lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq ); + +#define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP) +lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, lapack_complex_double* u, + lapack_int ldu, lapack_complex_double* v, + lapack_int ldv, lapack_complex_double* q, + lapack_int ldq ); + +#define LAPACK_cggsvp3 LAPACK_GLOBAL(cggsvp3,CGGSVP3) +void LAPACK_cggsvp3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float const* tola, + float const* tolb, lapack_int* k, lapack_int* l, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* V, lapack_int const* ldv, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_int* iwork, + float* rwork, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dggsvp3 LAPACK_GLOBAL(dggsvp3,DGGSVP3) +void LAPACK_dggsvp3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double const* tola, + double const* tolb, lapack_int* k, lapack_int* l, + double* U, lapack_int const* ldu, + double* V, lapack_int const* ldv, + double* Q, lapack_int const* ldq, + lapack_int* iwork, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sggsvp3 LAPACK_GLOBAL(sggsvp3,SGGSVP3) +void LAPACK_sggsvp3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float const* tola, + float const* tolb, lapack_int* k, lapack_int* l, + float* U, lapack_int const* ldu, + float* V, lapack_int const* ldv, + float* Q, lapack_int const* ldq, + lapack_int* iwork, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zggsvp3 LAPACK_GLOBAL(zggsvp3,ZGGSVP3) +void LAPACK_zggsvp3( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double const* tola, + double const* tolb, lapack_int* k, lapack_int* l, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* V, lapack_int const* ldv, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_int* iwork, + double* rwork, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cgtcon LAPACK_GLOBAL(cgtcon,CGTCON) +void LAPACK_cgtcon( + char const* norm, + lapack_int const* n, + lapack_complex_float const* DL, + lapack_complex_float const* D, + lapack_complex_float const* DU, + lapack_complex_float const* DU2, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dgtcon LAPACK_GLOBAL(dgtcon,DGTCON) +void LAPACK_dgtcon( + char const* norm, + lapack_int const* n, + double const* DL, + double const* D, + double const* DU, + double const* DU2, lapack_int const* ipiv, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgtcon LAPACK_GLOBAL(sgtcon,SGTCON) +void LAPACK_sgtcon( + char const* norm, + lapack_int const* n, + float const* DL, + float const* D, + float const* DU, + float const* DU2, lapack_int const* ipiv, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgtcon LAPACK_GLOBAL(zgtcon,ZGTCON) +void LAPACK_zgtcon( + char const* norm, + lapack_int const* n, + lapack_complex_double const* DL, + lapack_complex_double const* D, + lapack_complex_double const* DU, + lapack_complex_double const* DU2, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cgtrfs LAPACK_GLOBAL(cgtrfs,CGTRFS) +void LAPACK_cgtrfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* DL, + lapack_complex_float const* D, + lapack_complex_float const* DU, + lapack_complex_float const* DLF, + lapack_complex_float const* DF, + lapack_complex_float const* DUF, + lapack_complex_float const* DU2, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgtrfs LAPACK_GLOBAL(dgtrfs,DGTRFS) +void LAPACK_dgtrfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double const* DL, + double const* D, + double const* DU, + double const* DLF, + double const* DF, + double const* DUF, + double const* DU2, lapack_int const* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgtrfs LAPACK_GLOBAL(sgtrfs,SGTRFS) +void LAPACK_sgtrfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float const* DL, + float const* D, + float const* DU, + float const* DLF, + float const* DF, + float const* DUF, + float const* DU2, lapack_int const* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgtrfs LAPACK_GLOBAL(zgtrfs,ZGTRFS) +void LAPACK_zgtrfs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* DL, + lapack_complex_double const* D, + lapack_complex_double const* DU, + lapack_complex_double const* DLF, + lapack_complex_double const* DF, + lapack_complex_double const* DUF, + lapack_complex_double const* DU2, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgtsv LAPACK_GLOBAL(cgtsv,CGTSV) +void LAPACK_cgtsv( + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* DL, + lapack_complex_float* D, + lapack_complex_float* DU, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgtsv LAPACK_GLOBAL(dgtsv,DGTSV) +void LAPACK_dgtsv( + lapack_int const* n, lapack_int const* nrhs, + double* DL, + double* D, + double* DU, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgtsv LAPACK_GLOBAL(sgtsv,SGTSV) +void LAPACK_sgtsv( + lapack_int const* n, lapack_int const* nrhs, + float* DL, + float* D, + float* DU, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgtsv LAPACK_GLOBAL(zgtsv,ZGTSV) +void LAPACK_zgtsv( + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* DL, + lapack_complex_double* D, + lapack_complex_double* DU, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cgtsvx LAPACK_GLOBAL(cgtsvx,CGTSVX) +void LAPACK_cgtsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* DL, + lapack_complex_float const* D, + lapack_complex_float const* DU, + lapack_complex_float* DLF, + lapack_complex_float* DF, + lapack_complex_float* DUF, + lapack_complex_float* DU2, lapack_int* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dgtsvx LAPACK_GLOBAL(dgtsvx,DGTSVX) +void LAPACK_dgtsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double const* DL, + double const* D, + double const* DU, + double* DLF, + double* DF, + double* DUF, + double* DU2, lapack_int* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sgtsvx LAPACK_GLOBAL(sgtsvx,SGTSVX) +void LAPACK_sgtsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float const* DL, + float const* D, + float const* DU, + float* DLF, + float* DF, + float* DUF, + float* DU2, lapack_int* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zgtsvx LAPACK_GLOBAL(zgtsvx,ZGTSVX) +void LAPACK_zgtsvx( + char const* fact, char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* DL, + lapack_complex_double const* D, + lapack_complex_double const* DU, + lapack_complex_double* DLF, + lapack_complex_double* DF, + lapack_complex_double* DUF, + lapack_complex_double* DU2, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cgttrf LAPACK_GLOBAL(cgttrf,CGTTRF) +void LAPACK_cgttrf( + lapack_int const* n, + lapack_complex_float* DL, + lapack_complex_float* D, + lapack_complex_float* DU, + lapack_complex_float* DU2, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dgttrf LAPACK_GLOBAL(dgttrf,DGTTRF) +void LAPACK_dgttrf( + lapack_int const* n, + double* DL, + double* D, + double* DU, + double* DU2, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_sgttrf LAPACK_GLOBAL(sgttrf,SGTTRF) +void LAPACK_sgttrf( + lapack_int const* n, + float* DL, + float* D, + float* DU, + float* DU2, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zgttrf LAPACK_GLOBAL(zgttrf,ZGTTRF) +void LAPACK_zgttrf( + lapack_int const* n, + lapack_complex_double* DL, + lapack_complex_double* D, + lapack_complex_double* DU, + lapack_complex_double* DU2, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_cgttrs LAPACK_GLOBAL(cgttrs,CGTTRS) +void LAPACK_cgttrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* DL, + lapack_complex_float const* D, + lapack_complex_float const* DU, + lapack_complex_float const* DU2, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dgttrs LAPACK_GLOBAL(dgttrs,DGTTRS) +void LAPACK_dgttrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + double const* DL, + double const* D, + double const* DU, + double const* DU2, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sgttrs LAPACK_GLOBAL(sgttrs,SGTTRS) +void LAPACK_sgttrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + float const* DL, + float const* D, + float const* DU, + float const* DU2, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zgttrs LAPACK_GLOBAL(zgttrs,ZGTTRS) +void LAPACK_zgttrs( + char const* trans, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* DL, + lapack_complex_double const* D, + lapack_complex_double const* DU, + lapack_complex_double const* DU2, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chbev LAPACK_GLOBAL(chbev,CHBEV) +void LAPACK_chbev( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhbev LAPACK_GLOBAL(zhbev,ZHBEV) +void LAPACK_zhbev( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chbev_2stage LAPACK_GLOBAL(chbev_2stage,CHBEV_2STAGE) +void LAPACK_chbev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhbev_2stage LAPACK_GLOBAL(zhbev_2stage,ZHBEV_2STAGE) +void LAPACK_zhbev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_chbevd LAPACK_GLOBAL(chbevd,CHBEVD) +void LAPACK_chbevd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhbevd LAPACK_GLOBAL(zhbevd,ZHBEVD) +void LAPACK_zhbevd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chbevd_2stage LAPACK_GLOBAL(chbevd_2stage,CHBEVD_2STAGE) +void LAPACK_chbevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhbevd_2stage LAPACK_GLOBAL(zhbevd_2stage,ZHBEVD_2STAGE) +void LAPACK_zhbevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chbevx LAPACK_GLOBAL(chbevx,CHBEVX) +void LAPACK_chbevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhbevx LAPACK_GLOBAL(zhbevx,ZHBEVX) +void LAPACK_zhbevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chbevx_2stage LAPACK_GLOBAL(chbevx_2stage,CHBEVX_2STAGE) +void LAPACK_chbevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhbevx_2stage LAPACK_GLOBAL(zhbevx_2stage,ZHBEVX_2STAGE) +void LAPACK_zhbevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chbgst LAPACK_GLOBAL(chbgst,CHBGST) +void LAPACK_chbgst( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float const* BB, lapack_int const* ldbb, + lapack_complex_float* X, lapack_int const* ldx, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhbgst LAPACK_GLOBAL(zhbgst,ZHBGST) +void LAPACK_zhbgst( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double const* BB, lapack_int const* ldbb, + lapack_complex_double* X, lapack_int const* ldx, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chbgv LAPACK_GLOBAL(chbgv,CHBGV) +void LAPACK_chbgv( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* BB, lapack_int const* ldbb, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhbgv LAPACK_GLOBAL(zhbgv,ZHBGV) +void LAPACK_zhbgv( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* BB, lapack_int const* ldbb, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chbgvd LAPACK_GLOBAL(chbgvd,CHBGVD) +void LAPACK_chbgvd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* BB, lapack_int const* ldbb, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhbgvd LAPACK_GLOBAL(zhbgvd,ZHBGVD) +void LAPACK_zhbgvd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* BB, lapack_int const* ldbb, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chbgvx LAPACK_GLOBAL(chbgvx,CHBGVX) +void LAPACK_chbgvx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* BB, lapack_int const* ldbb, + lapack_complex_float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhbgvx LAPACK_GLOBAL(zhbgvx,ZHBGVX) +void LAPACK_zhbgvx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* BB, lapack_int const* ldbb, + lapack_complex_double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chbtrd LAPACK_GLOBAL(chbtrd,CHBTRD) +void LAPACK_chbtrd( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + float* D, + float* E, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhbtrd LAPACK_GLOBAL(zhbtrd,ZHBTRD) +void LAPACK_zhbtrd( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + double* D, + double* E, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_checon LAPACK_GLOBAL(checon,CHECON) +void LAPACK_checon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhecon LAPACK_GLOBAL(zhecon,ZHECON) +void LAPACK_zhecon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_checon_3 LAPACK_GLOBAL(checon_3,CHECON_3) +void LAPACK_checon_3( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhecon_3 LAPACK_GLOBAL(zhecon_3,ZHECON_3) +void LAPACK_zhecon_3( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cheequb LAPACK_GLOBAL(cheequb,CHEEQUB) +void LAPACK_cheequb( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zheequb LAPACK_GLOBAL(zheequb,ZHEEQUB) +void LAPACK_zheequb( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cheev LAPACK_GLOBAL(cheev,CHEEV) +void LAPACK_cheev( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zheev LAPACK_GLOBAL(zheev,ZHEEV) +void LAPACK_zheev( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cheev_2stage LAPACK_GLOBAL(cheev_2stage,CHEEV_2STAGE) +void LAPACK_cheev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zheev_2stage LAPACK_GLOBAL(zheev_2stage,ZHEEV_2STAGE) +void LAPACK_zheev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_cheevd LAPACK_GLOBAL(cheevd,CHEEVD) +void LAPACK_cheevd( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zheevd LAPACK_GLOBAL(zheevd,ZHEEVD) +void LAPACK_zheevd( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cheevd_2stage LAPACK_GLOBAL(cheevd_2stage,CHEEVD_2STAGE) +void LAPACK_cheevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zheevd_2stage LAPACK_GLOBAL(zheevd_2stage,ZHEEVD_2STAGE) +void LAPACK_zheevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cheevr LAPACK_GLOBAL(cheevr,CHEEVR) +void LAPACK_cheevr( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zheevr LAPACK_GLOBAL(zheevr,ZHEEVR) +void LAPACK_zheevr( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cheevr_2stage LAPACK_GLOBAL(cheevr_2stage,CHEEVR_2STAGE) +void LAPACK_cheevr_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zheevr_2stage LAPACK_GLOBAL(zheevr_2stage,ZHEEVR_2STAGE) +void LAPACK_zheevr_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cheevx LAPACK_GLOBAL(cheevx,CHEEVX) +void LAPACK_cheevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zheevx LAPACK_GLOBAL(zheevx,ZHEEVX) +void LAPACK_zheevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_cheevx_2stage LAPACK_GLOBAL(cheevx_2stage,CHEEVX_2STAGE) +void LAPACK_cheevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zheevx_2stage LAPACK_GLOBAL(zheevx_2stage,ZHEEVX_2STAGE) +void LAPACK_zheevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chegst LAPACK_GLOBAL(chegst,CHEGST) +void LAPACK_chegst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhegst LAPACK_GLOBAL(zhegst,ZHEGST) +void LAPACK_zhegst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chegv LAPACK_GLOBAL(chegv,CHEGV) +void LAPACK_chegv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhegv LAPACK_GLOBAL(zhegv,ZHEGV) +void LAPACK_zhegv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_chegv_2stage LAPACK_GLOBAL(chegv_2stage,CHEGV_2STAGE) +void LAPACK_chegv_2stage( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhegv_2stage LAPACK_GLOBAL(zhegv_2stage,ZHEGV_2STAGE) +void LAPACK_zhegv_2stage( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_chegvd LAPACK_GLOBAL(chegvd,CHEGVD) +void LAPACK_chegvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float* W, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhegvd LAPACK_GLOBAL(zhegvd,ZHEGVD) +void LAPACK_zhegvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double* W, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chegvx LAPACK_GLOBAL(chegvx,CHEGVX) +void LAPACK_chegvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhegvx LAPACK_GLOBAL(zhegvx,ZHEGVX) +void LAPACK_zhegvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_cherfs LAPACK_GLOBAL(cherfs,CHERFS) +void LAPACK_cherfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zherfs LAPACK_GLOBAL(zherfs,ZHERFS) +void LAPACK_zherfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cherfsx LAPACK_GLOBAL(cherfsx,CHERFSX) +void LAPACK_cherfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float* S, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zherfsx LAPACK_GLOBAL(zherfsx,ZHERFSX) +void LAPACK_zherfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double* S, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chesv LAPACK_GLOBAL(chesv,CHESV) +void LAPACK_chesv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhesv LAPACK_GLOBAL(zhesv,ZHESV) +void LAPACK_zhesv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chesv_aa LAPACK_GLOBAL(chesv_aa,CHESV_AA) +void LAPACK_chesv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhesv_aa LAPACK_GLOBAL(zhesv_aa,ZHESV_AA) +void LAPACK_zhesv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chesv_aa_2stage LAPACK_GLOBAL(chesv_aa_2stage,CHESV_AA_2STAGE) +void LAPACK_chesv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhesv_aa_2stage LAPACK_GLOBAL(zhesv_aa_2stage,ZHESV_AA_2STAGE) +void LAPACK_zhesv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chesv_rk LAPACK_GLOBAL(chesv_rk,CHESV_RK) +void LAPACK_chesv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* E, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhesv_rk LAPACK_GLOBAL(zhesv_rk,ZHESV_RK) +void LAPACK_zhesv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* E, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chesv_rook LAPACK_GLOBAL(chesv_rook,CHESV_ROOK) +void LAPACK_chesv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhesv_rook LAPACK_GLOBAL(zhesv_rook,ZHESV_ROOK) +void LAPACK_zhesv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chesvx LAPACK_GLOBAL(chesvx,CHESVX) +void LAPACK_chesvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhesvx LAPACK_GLOBAL(zhesvx,ZHESVX) +void LAPACK_zhesvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_chesvxx LAPACK_GLOBAL(chesvxx,CHESVXX) +void LAPACK_chesvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhesvxx LAPACK_GLOBAL(zhesvxx,ZHESVXX) +void LAPACK_zhesvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cheswapr LAPACK_GLOBAL(cheswapr,CHESWAPR) +void LAPACK_cheswapr( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_zheswapr LAPACK_GLOBAL(zheswapr,ZHESWAPR) +void LAPACK_zheswapr( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_chetrd LAPACK_GLOBAL(chetrd,CHETRD) +void LAPACK_chetrd( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* D, + float* E, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrd LAPACK_GLOBAL(zhetrd,ZHETRD) +void LAPACK_zhetrd( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* D, + double* E, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrd_2stage LAPACK_GLOBAL(chetrd_2stage,CHETRD_2STAGE) +void LAPACK_chetrd_2stage( + char const* vect, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + float* D, + float* E, + lapack_complex_float* tau, + lapack_complex_float* HOUS2, lapack_int const* lhous2, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrd_2stage LAPACK_GLOBAL(zhetrd_2stage,ZHETRD_2STAGE) +void LAPACK_zhetrd_2stage( + char const* vect, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + double* D, + double* E, + lapack_complex_double* tau, + lapack_complex_double* HOUS2, lapack_int const* lhous2, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrf LAPACK_GLOBAL(chetrf,CHETRF) +void LAPACK_chetrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrf LAPACK_GLOBAL(zhetrf,ZHETRF) +void LAPACK_zhetrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrf_aa LAPACK_GLOBAL(chetrf_aa,CHETRF_AA) +void LAPACK_chetrf_aa( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrf_aa LAPACK_GLOBAL(zhetrf_aa,ZHETRF_AA) +void LAPACK_zhetrf_aa( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrf_aa_2stage LAPACK_GLOBAL(chetrf_aa_2stage,CHETRF_AA_2STAGE) +void LAPACK_chetrf_aa_2stage( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrf_aa_2stage LAPACK_GLOBAL(zhetrf_aa_2stage,ZHETRF_AA_2STAGE) +void LAPACK_zhetrf_aa_2stage( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrf_rk LAPACK_GLOBAL(chetrf_rk,CHETRF_RK) +void LAPACK_chetrf_rk( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* E, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrf_rk LAPACK_GLOBAL(zhetrf_rk,ZHETRF_RK) +void LAPACK_zhetrf_rk( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* E, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrf_rook LAPACK_GLOBAL(chetrf_rook,CHETRF_ROOK) +void LAPACK_chetrf_rook( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrf_rook LAPACK_GLOBAL(zhetrf_rook,ZHETRF_ROOK) +void LAPACK_zhetrf_rook( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetri LAPACK_GLOBAL(chetri,CHETRI) +void LAPACK_chetri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhetri LAPACK_GLOBAL(zhetri,ZHETRI) +void LAPACK_zhetri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_chetri2 LAPACK_GLOBAL(chetri2,CHETRI2) +void LAPACK_chetri2( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetri2 LAPACK_GLOBAL(zhetri2,ZHETRI2) +void LAPACK_zhetri2( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetri2x LAPACK_GLOBAL(chetri2x,CHETRI2X) +void LAPACK_chetri2x( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_zhetri2x LAPACK_GLOBAL(zhetri2x,ZHETRI2X) +void LAPACK_zhetri2x( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_chetri_3 LAPACK_GLOBAL(chetri_3,CHETRI_3) +void LAPACK_chetri_3( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetri_3 LAPACK_GLOBAL(zhetri_3,ZHETRI_3) +void LAPACK_zhetri_3( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrs LAPACK_GLOBAL(chetrs,CHETRS) +void LAPACK_chetrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhetrs LAPACK_GLOBAL(zhetrs,ZHETRS) +void LAPACK_zhetrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chetrs2 LAPACK_GLOBAL(chetrs2,CHETRS2) +void LAPACK_chetrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhetrs2 LAPACK_GLOBAL(zhetrs2,ZHETRS2) +void LAPACK_zhetrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_chetrs_3 LAPACK_GLOBAL(chetrs_3,CHETRS_3) +void LAPACK_chetrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhetrs_3 LAPACK_GLOBAL(zhetrs_3,ZHETRS_3) +void LAPACK_zhetrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chetrs_aa LAPACK_GLOBAL(chetrs_aa,CHETRS_AA) +void LAPACK_chetrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhetrs_aa LAPACK_GLOBAL(zhetrs_aa,ZHETRS_AA) +void LAPACK_zhetrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_chetrs_aa_2stage LAPACK_GLOBAL(chetrs_aa_2stage,CHETRS_AA_2STAGE) +void LAPACK_chetrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhetrs_aa_2stage LAPACK_GLOBAL(zhetrs_aa_2stage,ZHETRS_AA_2STAGE) +void LAPACK_zhetrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chetrs_rook LAPACK_GLOBAL(chetrs_rook,CHETRS_ROOK) +void LAPACK_chetrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhetrs_rook LAPACK_GLOBAL(zhetrs_rook,ZHETRS_ROOK) +void LAPACK_zhetrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chfrk LAPACK_GLOBAL(chfrk,CHFRK) +void LAPACK_chfrk( + char const* transr, char const* uplo, char const* trans, + lapack_int const* n, lapack_int const* k, + float const* alpha, + lapack_complex_float const* A, lapack_int const* lda, + float const* beta, + lapack_complex_float* C ); + +#define LAPACK_zhfrk LAPACK_GLOBAL(zhfrk,ZHFRK) +void LAPACK_zhfrk( + char const* transr, char const* uplo, char const* trans, + lapack_int const* n, lapack_int const* k, + double const* alpha, + lapack_complex_double const* A, lapack_int const* lda, + double const* beta, + lapack_complex_double* C ); + +#define LAPACK_chgeqz LAPACK_GLOBAL(chgeqz,CHGEQZ) +void LAPACK_chgeqz( + char const* job, char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* H, lapack_int const* ldh, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dhgeqz LAPACK_GLOBAL(dhgeqz,DHGEQZ) +void LAPACK_dhgeqz( + char const* job, char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* H, lapack_int const* ldh, + double* T, lapack_int const* ldt, + double* alphar, + double* alphai, + double* beta, + double* Q, lapack_int const* ldq, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_shgeqz LAPACK_GLOBAL(shgeqz,SHGEQZ) +void LAPACK_shgeqz( + char const* job, char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* H, lapack_int const* ldh, + float* T, lapack_int const* ldt, + float* alphar, + float* alphai, + float* beta, + float* Q, lapack_int const* ldq, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhgeqz LAPACK_GLOBAL(zhgeqz,ZHGEQZ) +void LAPACK_zhgeqz( + char const* job, char const* compq, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* H, lapack_int const* ldh, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_chpcon LAPACK_GLOBAL(chpcon,CHPCON) +void LAPACK_chpcon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhpcon LAPACK_GLOBAL(zhpcon,ZHPCON) +void LAPACK_zhpcon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_chpev LAPACK_GLOBAL(chpev,CHPEV) +void LAPACK_chpev( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhpev LAPACK_GLOBAL(zhpev,ZHPEV) +void LAPACK_zhpev( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chpevd LAPACK_GLOBAL(chpevd,CHPEVD) +void LAPACK_chpevd( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhpevd LAPACK_GLOBAL(zhpevd,ZHPEVD) +void LAPACK_zhpevd( + char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chpevx LAPACK_GLOBAL(chpevx,CHPEVX) +void LAPACK_chpevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhpevx LAPACK_GLOBAL(zhpevx,ZHPEVX) +void LAPACK_zhpevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chpgst LAPACK_GLOBAL(chpgst,CHPGST) +void LAPACK_chpgst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_complex_float const* BP, + lapack_int* info ); + +#define LAPACK_zhpgst LAPACK_GLOBAL(zhpgst,ZHPGST) +void LAPACK_zhpgst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_complex_double const* BP, + lapack_int* info ); + +#define LAPACK_chpgv LAPACK_GLOBAL(chpgv,CHPGV) +void LAPACK_chpgv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_complex_float* BP, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhpgv LAPACK_GLOBAL(zhpgv,ZHPGV) +void LAPACK_zhpgv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_complex_double* BP, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chpgvd LAPACK_GLOBAL(chpgvd,CHPGVD) +void LAPACK_chpgvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_complex_float* BP, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zhpgvd LAPACK_GLOBAL(zhpgvd,ZHPGVD) +void LAPACK_zhpgvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_complex_double* BP, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_chpgvx LAPACK_GLOBAL(chpgvx,CHPGVX) +void LAPACK_chpgvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_complex_float* BP, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, + float* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zhpgvx LAPACK_GLOBAL(zhpgvx,ZHPGVX) +void LAPACK_zhpgvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_complex_double* BP, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, + double* rwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_chprfs LAPACK_GLOBAL(chprfs,CHPRFS) +void LAPACK_chprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float const* AFP, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhprfs LAPACK_GLOBAL(zhprfs,ZHPRFS) +void LAPACK_zhprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double const* AFP, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chpsv LAPACK_GLOBAL(chpsv,CHPSV) +void LAPACK_chpsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* AP, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhpsv LAPACK_GLOBAL(zhpsv,ZHPSV) +void LAPACK_zhpsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* AP, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chpsvx LAPACK_GLOBAL(chpsvx,CHPSVX) +void LAPACK_chpsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float* AFP, lapack_int* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_zhpsvx LAPACK_GLOBAL(zhpsvx,ZHPSVX) +void LAPACK_zhpsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double* AFP, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_chptrd LAPACK_GLOBAL(chptrd,CHPTRD) +void LAPACK_chptrd( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + float* D, + float* E, + lapack_complex_float* tau, + lapack_int* info ); + +#define LAPACK_zhptrd LAPACK_GLOBAL(zhptrd,ZHPTRD) +void LAPACK_zhptrd( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + double* D, + double* E, + lapack_complex_double* tau, + lapack_int* info ); + +#define LAPACK_chptrf LAPACK_GLOBAL(chptrf,CHPTRF) +void LAPACK_chptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zhptrf LAPACK_GLOBAL(zhptrf,ZHPTRF) +void LAPACK_zhptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_chptri LAPACK_GLOBAL(chptri,CHPTRI) +void LAPACK_chptri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, lapack_int const* ipiv, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zhptri LAPACK_GLOBAL(zhptri,ZHPTRI) +void LAPACK_zhptri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, lapack_int const* ipiv, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_chptrs LAPACK_GLOBAL(chptrs,CHPTRS) +void LAPACK_chptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zhptrs LAPACK_GLOBAL(zhptrs,ZHPTRS) +void LAPACK_zhptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_chsein LAPACK_GLOBAL(chsein,CHSEIN) +void LAPACK_chsein( + char const* side, char const* eigsrc, char const* initv, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float const* H, lapack_int const* ldh, + lapack_complex_float* W, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, + float* rwork, lapack_int* IFAILL, lapack_int* IFAILR, + lapack_int* info ); + +#define LAPACK_dhsein LAPACK_GLOBAL(dhsein,DHSEIN) +void LAPACK_dhsein( + char const* side, char const* eigsrc, char const* initv, + lapack_logical* select, + lapack_int const* n, + double const* H, lapack_int const* ldh, + double* WR, + double const* WI, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + double* work, lapack_int* IFAILL, lapack_int* IFAILR, + lapack_int* info ); + +#define LAPACK_shsein LAPACK_GLOBAL(shsein,SHSEIN) +void LAPACK_shsein( + char const* side, char const* eigsrc, char const* initv, + lapack_logical* select, + lapack_int const* n, + float const* H, lapack_int const* ldh, + float* WR, + float const* WI, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + float* work, lapack_int* IFAILL, lapack_int* IFAILR, + lapack_int* info ); + +#define LAPACK_zhsein LAPACK_GLOBAL(zhsein,ZHSEIN) +void LAPACK_zhsein( + char const* side, char const* eigsrc, char const* initv, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double const* H, lapack_int const* ldh, + lapack_complex_double* W, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, + double* rwork, lapack_int* IFAILL, lapack_int* IFAILR, + lapack_int* info ); + +#define LAPACK_chseqr LAPACK_GLOBAL(chseqr,CHSEQR) +void LAPACK_chseqr( + char const* job, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* H, lapack_int const* ldh, + lapack_complex_float* W, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dhseqr LAPACK_GLOBAL(dhseqr,DHSEQR) +void LAPACK_dhseqr( + char const* job, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* H, lapack_int const* ldh, + double* WR, + double* WI, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_shseqr LAPACK_GLOBAL(shseqr,SHSEQR) +void LAPACK_shseqr( + char const* job, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* H, lapack_int const* ldh, + float* WR, + float* WI, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zhseqr LAPACK_GLOBAL(zhseqr,ZHSEQR) +void LAPACK_zhseqr( + char const* job, char const* compz, + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* H, lapack_int const* ldh, + lapack_complex_double* W, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_clacgv LAPACK_GLOBAL(clacgv,CLACGV) +void LAPACK_clacgv( + lapack_int const* n, + lapack_complex_float* X, lapack_int const* incx ); + +#define LAPACK_zlacgv LAPACK_GLOBAL(zlacgv,ZLACGV) +void LAPACK_zlacgv( + lapack_int const* n, + lapack_complex_double* X, lapack_int const* incx ); + +#define LAPACK_clacn2 LAPACK_GLOBAL(clacn2,CLACN2) +void LAPACK_clacn2( + lapack_int const* n, + lapack_complex_float* V, + lapack_complex_float* X, + float* est, lapack_int* kase, lapack_int* ISAVE ); + +#define LAPACK_dlacn2 LAPACK_GLOBAL(dlacn2,DLACN2) +void LAPACK_dlacn2( + lapack_int const* n, + double* V, + double* X, lapack_int* ISGN, + double* est, lapack_int* kase, lapack_int* ISAVE ); + +#define LAPACK_slacn2 LAPACK_GLOBAL(slacn2,SLACN2) +void LAPACK_slacn2( + lapack_int const* n, + float* V, + float* X, lapack_int* ISGN, + float* est, lapack_int* kase, lapack_int* ISAVE ); + +#define LAPACK_zlacn2 LAPACK_GLOBAL(zlacn2,ZLACN2) +void LAPACK_zlacn2( + lapack_int const* n, + lapack_complex_double* V, + lapack_complex_double* X, + double* est, lapack_int* kase, lapack_int* ISAVE ); + +#define LAPACK_clacp2 LAPACK_GLOBAL(clacp2,CLACP2) +void LAPACK_clacp2( + char const* uplo, + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb ); + +#define LAPACK_zlacp2 LAPACK_GLOBAL(zlacp2,ZLACP2) +void LAPACK_zlacp2( + char const* uplo, + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb ); + +#define LAPACK_clacpy LAPACK_GLOBAL(clacpy,CLACPY) +void LAPACK_clacpy( + char const* uplo, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb ); + +#define LAPACK_dlacpy LAPACK_GLOBAL(dlacpy,DLACPY) +void LAPACK_dlacpy( + char const* uplo, + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double* B, lapack_int const* ldb ); + +#define LAPACK_slacpy LAPACK_GLOBAL(slacpy,SLACPY) +void LAPACK_slacpy( + char const* uplo, + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float* B, lapack_int const* ldb ); + +#define LAPACK_zlacpy LAPACK_GLOBAL(zlacpy,ZLACPY) +void LAPACK_zlacpy( + char const* uplo, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb ); + +#define LAPACK_clacrm LAPACK_GLOBAL(clacrm,CLACRM) +void LAPACK_clacrm( + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + lapack_complex_float* C, lapack_int const* ldc, + float* rwork ); + +#define LAPACK_zlacrm LAPACK_GLOBAL(zlacrm,ZLACRM) +void LAPACK_zlacrm( + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + lapack_complex_double* C, lapack_int const* ldc, + double* rwork ); + +#define LAPACK_zlag2c LAPACK_GLOBAL(zlag2c,ZLAG2C) +void LAPACK_zlag2c( + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_float* SA, lapack_int const* ldsa, + lapack_int* info ); + +#define LAPACK_slag2d LAPACK_GLOBAL(slag2d,SLAG2D) +void LAPACK_slag2d( + lapack_int const* m, lapack_int const* n, + float const* SA, lapack_int const* ldsa, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dlag2s LAPACK_GLOBAL(dlag2s,DLAG2S) +void LAPACK_dlag2s( + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + float* SA, lapack_int const* ldsa, + lapack_int* info ); + +#define LAPACK_clag2z LAPACK_GLOBAL(clag2z,CLAG2Z) +void LAPACK_clag2z( + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* SA, lapack_int const* ldsa, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE) +void LAPACK_clagge( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* D, + lapack_complex_float* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE) +void LAPACK_dlagge( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* D, + double* A, lapack_int const* lda, lapack_int* iseed, + double* work, + lapack_int* info ); + +#define LAPACK_slagge LAPACK_GLOBAL(slagge,SLAGGE) +void LAPACK_slagge( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* D, + float* A, lapack_int const* lda, lapack_int* iseed, + float* work, + lapack_int* info ); + +#define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE) +void LAPACK_zlagge( + lapack_int const* m, lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* D, + lapack_complex_double* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_claghe LAPACK_GLOBAL(claghe,CLAGHE) +void LAPACK_claghe( + lapack_int const* n, lapack_int const* k, + float const* D, + lapack_complex_float* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zlaghe LAPACK_GLOBAL(zlaghe,ZLAGHE) +void LAPACK_zlaghe( + lapack_int const* n, lapack_int const* k, + double const* D, + lapack_complex_double* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_clagsy LAPACK_GLOBAL(clagsy,CLAGSY) +void LAPACK_clagsy( + lapack_int const* n, lapack_int const* k, + float const* D, + lapack_complex_float* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dlagsy LAPACK_GLOBAL(dlagsy,DLAGSY) +void LAPACK_dlagsy( + lapack_int const* n, lapack_int const* k, + double const* D, + double* A, lapack_int const* lda, lapack_int* iseed, + double* work, + lapack_int* info ); + +#define LAPACK_slagsy LAPACK_GLOBAL(slagsy,SLAGSY) +void LAPACK_slagsy( + lapack_int const* n, lapack_int const* k, + float const* D, + float* A, lapack_int const* lda, lapack_int* iseed, + float* work, + lapack_int* info ); + +#define LAPACK_zlagsy LAPACK_GLOBAL(zlagsy,ZLAGSY) +void LAPACK_zlagsy( + lapack_int const* n, lapack_int const* k, + double const* D, + lapack_complex_double* A, lapack_int const* lda, lapack_int* iseed, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_dlamch LAPACK_GLOBAL(dlamch,DLAMCH) +double LAPACK_dlamch( + char const* cmach ); + +#define LAPACK_slamch LAPACK_GLOBAL(slamch,SLAMCH) +lapack_float_return LAPACK_slamch( + char const* cmach ); + +#define LAPACK_clangb LAPACK_GLOBAL(clangb,CLANGB) +lapack_float_return LAPACK_clangb( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_dlangb LAPACK_GLOBAL(dlangb,DLANGB) +double LAPACK_dlangb( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_slangb LAPACK_GLOBAL(slangb,SLANGB) +lapack_float_return LAPACK_slangb( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_zlangb LAPACK_GLOBAL(zlangb,ZLANGB) +double LAPACK_zlangb( + char const* norm, + lapack_int const* n, lapack_int const* kl, lapack_int const* ku, + lapack_complex_double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_clange LAPACK_GLOBAL(clange,CLANGE) +lapack_float_return LAPACK_clange( + char const* norm, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_dlange LAPACK_GLOBAL(dlange,DLANGE) +double LAPACK_dlange( + char const* norm, + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_slange LAPACK_GLOBAL(slange,SLANGE) +lapack_float_return LAPACK_slange( + char const* norm, + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_zlange LAPACK_GLOBAL(zlange,ZLANGE) +double LAPACK_zlange( + char const* norm, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_clangt LAPACK_GLOBAL(clangt,CLANGT) +lapack_float_return LAPACK_clangt( + char const* norm, + lapack_int const* n, + lapack_complex_float const* DL, + lapack_complex_float const* D, + lapack_complex_float const* DU ); + +#define LAPACK_dlangt LAPACK_GLOBAL(dlangt,DLANGT) +double LAPACK_dlangt( + char const* norm, + lapack_int const* n, + double const* DL, + double const* D, + double const* DU ); + +#define LAPACK_slangt LAPACK_GLOBAL(slangt,SLANGT) +lapack_float_return LAPACK_slangt( + char const* norm, + lapack_int const* n, + float const* DL, + float const* D, + float const* DU ); + +#define LAPACK_zlangt LAPACK_GLOBAL(zlangt,ZLANGT) +double LAPACK_zlangt( + char const* norm, + lapack_int const* n, + lapack_complex_double const* DL, + lapack_complex_double const* D, + lapack_complex_double const* DU ); + +#define LAPACK_clanhb LAPACK_GLOBAL(clanhb,CLANHB) +lapack_float_return LAPACK_clanhb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + lapack_complex_float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_zlanhb LAPACK_GLOBAL(zlanhb,ZLANHB) +double LAPACK_zlanhb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + lapack_complex_double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_clanhe LAPACK_GLOBAL(clanhe,CLANHE) +lapack_float_return LAPACK_clanhe( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_zlanhe LAPACK_GLOBAL(zlanhe,ZLANHE) +double LAPACK_zlanhe( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_clanhp LAPACK_GLOBAL(clanhp,CLANHP) +lapack_float_return LAPACK_clanhp( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + float* work ); + +#define LAPACK_zlanhp LAPACK_GLOBAL(zlanhp,ZLANHP) +double LAPACK_zlanhp( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + double* work ); + +#define LAPACK_clanhs LAPACK_GLOBAL(clanhs,CLANHS) +lapack_float_return LAPACK_clanhs( + char const* norm, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_dlanhs LAPACK_GLOBAL(dlanhs,DLANHS) +double LAPACK_dlanhs( + char const* norm, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_slanhs LAPACK_GLOBAL(slanhs,SLANHS) +lapack_float_return LAPACK_slanhs( + char const* norm, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_zlanhs LAPACK_GLOBAL(zlanhs,ZLANHS) +double LAPACK_zlanhs( + char const* norm, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_clanht LAPACK_GLOBAL(clanht,CLANHT) +lapack_float_return LAPACK_clanht( + char const* norm, + lapack_int const* n, + float const* D, + lapack_complex_float const* E ); + +#define LAPACK_zlanht LAPACK_GLOBAL(zlanht,ZLANHT) +double LAPACK_zlanht( + char const* norm, + lapack_int const* n, + double const* D, + lapack_complex_double const* E ); + +#define LAPACK_clansb LAPACK_GLOBAL(clansb,CLANSB) +lapack_float_return LAPACK_clansb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + lapack_complex_float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_dlansb LAPACK_GLOBAL(dlansb,DLANSB) +double LAPACK_dlansb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_slansb LAPACK_GLOBAL(slansb,SLANSB) +lapack_float_return LAPACK_slansb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_zlansb LAPACK_GLOBAL(zlansb,ZLANSB) +double LAPACK_zlansb( + char const* norm, char const* uplo, + lapack_int const* n, lapack_int const* k, + lapack_complex_double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_clansp LAPACK_GLOBAL(clansp,CLANSP) +lapack_float_return LAPACK_clansp( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + float* work ); + +#define LAPACK_dlansp LAPACK_GLOBAL(dlansp,DLANSP) +double LAPACK_dlansp( + char const* norm, char const* uplo, + lapack_int const* n, + double const* AP, + double* work ); + +#define LAPACK_slansp LAPACK_GLOBAL(slansp,SLANSP) +lapack_float_return LAPACK_slansp( + char const* norm, char const* uplo, + lapack_int const* n, + float const* AP, + float* work ); + +#define LAPACK_zlansp LAPACK_GLOBAL(zlansp,ZLANSP) +double LAPACK_zlansp( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + double* work ); + +#define LAPACK_dlanst LAPACK_GLOBAL(dlanst,DLANST) +double LAPACK_dlanst( + char const* norm, + lapack_int const* n, + double const* D, + double const* E ); + +#define LAPACK_slanst LAPACK_GLOBAL(slanst,SLANST) +lapack_float_return LAPACK_slanst( + char const* norm, + lapack_int const* n, + float const* D, + float const* E ); + +#define LAPACK_clansy LAPACK_GLOBAL(clansy,CLANSY) +lapack_float_return LAPACK_clansy( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_dlansy LAPACK_GLOBAL(dlansy,DLANSY) +double LAPACK_dlansy( + char const* norm, char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_slansy LAPACK_GLOBAL(slansy,SLANSY) +lapack_float_return LAPACK_slansy( + char const* norm, char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_zlansy LAPACK_GLOBAL(zlansy,ZLANSY) +double LAPACK_zlansy( + char const* norm, char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_clantb LAPACK_GLOBAL(clantb,CLANTB) +lapack_float_return LAPACK_clantb( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* k, + lapack_complex_float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_dlantb LAPACK_GLOBAL(dlantb,DLANTB) +double LAPACK_dlantb( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* k, + double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_slantb LAPACK_GLOBAL(slantb,SLANTB) +lapack_float_return LAPACK_slantb( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* k, + float const* AB, lapack_int const* ldab, + float* work ); + +#define LAPACK_zlantb LAPACK_GLOBAL(zlantb,ZLANTB) +double LAPACK_zlantb( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* k, + lapack_complex_double const* AB, lapack_int const* ldab, + double* work ); + +#define LAPACK_clantp LAPACK_GLOBAL(clantp,CLANTP) +lapack_float_return LAPACK_clantp( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float const* AP, + float* work ); + +#define LAPACK_dlantp LAPACK_GLOBAL(dlantp,DLANTP) +double LAPACK_dlantp( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + double const* AP, + double* work ); + +#define LAPACK_slantp LAPACK_GLOBAL(slantp,SLANTP) +lapack_float_return LAPACK_slantp( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + float const* AP, + float* work ); + +#define LAPACK_zlantp LAPACK_GLOBAL(zlantp,ZLANTP) +double LAPACK_zlantp( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double const* AP, + double* work ); + +#define LAPACK_clantr LAPACK_GLOBAL(clantr,CLANTR) +lapack_float_return LAPACK_clantr( + char const* norm, char const* uplo, char const* diag, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_dlantr LAPACK_GLOBAL(dlantr,DLANTR) +double LAPACK_dlantr( + char const* norm, char const* uplo, char const* diag, + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_slantr LAPACK_GLOBAL(slantr,SLANTR) +lapack_float_return LAPACK_slantr( + char const* norm, char const* uplo, char const* diag, + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float* work ); + +#define LAPACK_zlantr LAPACK_GLOBAL(zlantr,ZLANTR) +double LAPACK_zlantr( + char const* norm, char const* uplo, char const* diag, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* work ); + +#define LAPACK_clapmr LAPACK_GLOBAL(clapmr,CLAPMR) +void LAPACK_clapmr( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + lapack_complex_float* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_dlapmr LAPACK_GLOBAL(dlapmr,DLAPMR) +void LAPACK_dlapmr( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + double* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_slapmr LAPACK_GLOBAL(slapmr,SLAPMR) +void LAPACK_slapmr( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + float* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_zlapmr LAPACK_GLOBAL(zlapmr,ZLAPMR) +void LAPACK_zlapmr( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + lapack_complex_double* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_clapmt LAPACK_GLOBAL(clapmt,CLAPMT) +void LAPACK_clapmt( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + lapack_complex_float* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_dlapmt LAPACK_GLOBAL(dlapmt,DLAPMT) +void LAPACK_dlapmt( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + double* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_slapmt LAPACK_GLOBAL(slapmt,SLAPMT) +void LAPACK_slapmt( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + float* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_zlapmt LAPACK_GLOBAL(zlapmt,ZLAPMT) +void LAPACK_zlapmt( + lapack_logical const* forwrd, lapack_int const* m, lapack_int const* n, + lapack_complex_double* X, lapack_int const* ldx, lapack_int* K ); + +#define LAPACK_dlapy2 LAPACK_GLOBAL(dlapy2,DLAPY2) +double LAPACK_dlapy2( + double const* x, + double const* y ); + +#define LAPACK_slapy2 LAPACK_GLOBAL(slapy2,SLAPY2) +lapack_float_return LAPACK_slapy2( + float const* x, + float const* y ); + +#define LAPACK_dlapy3 LAPACK_GLOBAL(dlapy3,DLAPY3) +double LAPACK_dlapy3( + double const* x, + double const* y, + double const* z ); + +#define LAPACK_slapy3 LAPACK_GLOBAL(slapy3,SLAPY3) +lapack_float_return LAPACK_slapy3( + float const* x, + float const* y, + float const* z ); + +#define LAPACK_clarcm LAPACK_GLOBAL(clarcm,CLARCM) +void LAPACK_clarcm( + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* C, lapack_int const* ldc, + float* rwork ); + +#define LAPACK_zlarcm LAPACK_GLOBAL(zlarcm,ZLARCM) +void LAPACK_zlarcm( + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* C, lapack_int const* ldc, + double* rwork ); + +#define LAPACK_clarf LAPACK_GLOBAL(clarf,CLARF) +void LAPACK_clarf( + char const* side, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* V, lapack_int const* incv, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work ); + +#define LAPACK_dlarf LAPACK_GLOBAL(dlarf,DLARF) +void LAPACK_dlarf( + char const* side, + lapack_int const* m, lapack_int const* n, + double const* V, lapack_int const* incv, + double const* tau, + double* C, lapack_int const* ldc, + double* work ); + +#define LAPACK_slarf LAPACK_GLOBAL(slarf,SLARF) +void LAPACK_slarf( + char const* side, + lapack_int const* m, lapack_int const* n, + float const* V, lapack_int const* incv, + float const* tau, + float* C, lapack_int const* ldc, + float* work ); + +#define LAPACK_zlarf LAPACK_GLOBAL(zlarf,ZLARF) +void LAPACK_zlarf( + char const* side, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* V, lapack_int const* incv, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work ); + +#define LAPACK_clarfb LAPACK_GLOBAL(clarfb,CLARFB) +void LAPACK_clarfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* ldwork ); + +#define LAPACK_dlarfb LAPACK_GLOBAL(dlarfb,DLARFB) +void LAPACK_dlarfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* V, lapack_int const* ldv, + double const* T, lapack_int const* ldt, + double* C, lapack_int const* ldc, + double* work, lapack_int const* ldwork ); + +#define LAPACK_slarfb LAPACK_GLOBAL(slarfb,SLARFB) +void LAPACK_slarfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* V, lapack_int const* ldv, + float const* T, lapack_int const* ldt, + float* C, lapack_int const* ldc, + float* work, lapack_int const* ldwork ); + +#define LAPACK_zlarfb LAPACK_GLOBAL(zlarfb,ZLARFB) +void LAPACK_zlarfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* ldwork ); + +#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG) +void LAPACK_clarfg( + lapack_int const* n, + lapack_complex_float* alpha, + lapack_complex_float* X, lapack_int const* incx, + lapack_complex_float* tau ); + +#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG) +void LAPACK_dlarfg( + lapack_int const* n, + double* alpha, + double* X, lapack_int const* incx, + double* tau ); + +#define LAPACK_slarfg LAPACK_GLOBAL(slarfg,SLARFG) +void LAPACK_slarfg( + lapack_int const* n, + float* alpha, + float* X, lapack_int const* incx, + float* tau ); + +#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG) +void LAPACK_zlarfg( + lapack_int const* n, + lapack_complex_double* alpha, + lapack_complex_double* X, lapack_int const* incx, + lapack_complex_double* tau ); + +#define LAPACK_clarft LAPACK_GLOBAL(clarft,CLARFT) +void LAPACK_clarft( + char const* direct, char const* storev, + lapack_int const* n, lapack_int const* k, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* tau, + lapack_complex_float* T, lapack_int const* ldt ); + +#define LAPACK_dlarft LAPACK_GLOBAL(dlarft,DLARFT) +void LAPACK_dlarft( + char const* direct, char const* storev, + lapack_int const* n, lapack_int const* k, + double const* V, lapack_int const* ldv, + double const* tau, + double* T, lapack_int const* ldt ); + +#define LAPACK_slarft LAPACK_GLOBAL(slarft,SLARFT) +void LAPACK_slarft( + char const* direct, char const* storev, + lapack_int const* n, lapack_int const* k, + float const* V, lapack_int const* ldv, + float const* tau, + float* T, lapack_int const* ldt ); + +#define LAPACK_zlarft LAPACK_GLOBAL(zlarft,ZLARFT) +void LAPACK_zlarft( + char const* direct, char const* storev, + lapack_int const* n, lapack_int const* k, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* tau, + lapack_complex_double* T, lapack_int const* ldt ); + +#define LAPACK_clarfx LAPACK_GLOBAL(clarfx,CLARFX) +void LAPACK_clarfx( + char const* side, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* V, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work ); + +#define LAPACK_dlarfx LAPACK_GLOBAL(dlarfx,DLARFX) +void LAPACK_dlarfx( + char const* side, + lapack_int const* m, lapack_int const* n, + double const* V, + double const* tau, + double* C, lapack_int const* ldc, + double* work ); + +#define LAPACK_slarfx LAPACK_GLOBAL(slarfx,SLARFX) +void LAPACK_slarfx( + char const* side, + lapack_int const* m, lapack_int const* n, + float const* V, + float const* tau, + float* C, lapack_int const* ldc, + float* work ); + +#define LAPACK_zlarfx LAPACK_GLOBAL(zlarfx,ZLARFX) +void LAPACK_zlarfx( + char const* side, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* V, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work ); + +#define LAPACK_clarnv LAPACK_GLOBAL(clarnv,CLARNV) +void LAPACK_clarnv( + lapack_int const* idist, lapack_int* iseed, lapack_int const* n, + lapack_complex_float* X ); + +#define LAPACK_dlarnv LAPACK_GLOBAL(dlarnv,DLARNV) +void LAPACK_dlarnv( + lapack_int const* idist, lapack_int* iseed, lapack_int const* n, + double* X ); + +#define LAPACK_slarnv LAPACK_GLOBAL(slarnv,SLARNV) +void LAPACK_slarnv( + lapack_int const* idist, lapack_int* iseed, lapack_int const* n, + float* X ); + +#define LAPACK_zlarnv LAPACK_GLOBAL(zlarnv,ZLARNV) +void LAPACK_zlarnv( + lapack_int const* idist, lapack_int* iseed, lapack_int const* n, + lapack_complex_double* X ); + +#define LAPACK_dlartgp LAPACK_GLOBAL(dlartgp,DLARTGP) +void LAPACK_dlartgp( + double const* f, + double const* g, + double* cs, + double* sn, + double* r ); + +#define LAPACK_slartgp LAPACK_GLOBAL(slartgp,SLARTGP) +void LAPACK_slartgp( + float const* f, + float const* g, + float* cs, + float* sn, + float* r ); + +#define LAPACK_dlartgs LAPACK_GLOBAL(dlartgs,DLARTGS) +void LAPACK_dlartgs( + double const* x, + double const* y, + double const* sigma, + double* cs, + double* sn ); + +#define LAPACK_slartgs LAPACK_GLOBAL(slartgs,SLARTGS) +void LAPACK_slartgs( + float const* x, + float const* y, + float const* sigma, + float* cs, + float* sn ); + +#define LAPACK_clascl LAPACK_GLOBAL(clascl,CLASCL) +void LAPACK_clascl( + char const* type, + lapack_int const* kl, lapack_int const* ku, + float const* cfrom, + float const* cto, lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dlascl LAPACK_GLOBAL(dlascl,DLASCL) +void LAPACK_dlascl( + char const* type, + lapack_int const* kl, lapack_int const* ku, + double const* cfrom, + double const* cto, lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_slascl LAPACK_GLOBAL(slascl,SLASCL) +void LAPACK_slascl( + char const* type, + lapack_int const* kl, lapack_int const* ku, + float const* cfrom, + float const* cto, lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zlascl LAPACK_GLOBAL(zlascl,ZLASCL) +void LAPACK_zlascl( + char const* type, + lapack_int const* kl, lapack_int const* ku, + double const* cfrom, + double const* cto, lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_claset LAPACK_GLOBAL(claset,CLASET) +void LAPACK_claset( + char const* uplo, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* alpha, + lapack_complex_float const* beta, + lapack_complex_float* A, lapack_int const* lda ); + +#define LAPACK_dlaset LAPACK_GLOBAL(dlaset,DLASET) +void LAPACK_dlaset( + char const* uplo, + lapack_int const* m, lapack_int const* n, + double const* alpha, + double const* beta, + double* A, lapack_int const* lda ); + +#define LAPACK_slaset LAPACK_GLOBAL(slaset,SLASET) +void LAPACK_slaset( + char const* uplo, + lapack_int const* m, lapack_int const* n, + float const* alpha, + float const* beta, + float* A, lapack_int const* lda ); + +#define LAPACK_zlaset LAPACK_GLOBAL(zlaset,ZLASET) +void LAPACK_zlaset( + char const* uplo, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* alpha, + lapack_complex_double const* beta, + lapack_complex_double* A, lapack_int const* lda ); + +#define LAPACK_dlasrt LAPACK_GLOBAL(dlasrt,DLASRT) +void LAPACK_dlasrt( + char const* id, + lapack_int const* n, + double* D, + lapack_int* info ); + +#define LAPACK_slasrt LAPACK_GLOBAL(slasrt,SLASRT) +void LAPACK_slasrt( + char const* id, + lapack_int const* n, + float* D, + lapack_int* info ); + +#define LAPACK_classq LAPACK_GLOBAL(classq,CLASSQ) +void LAPACK_classq( + lapack_int const* n, + lapack_complex_float const* X, lapack_int const* incx, + float* scale, + float* sumsq ); + +#define LAPACK_dlassq LAPACK_GLOBAL(dlassq,DLASSQ) +void LAPACK_dlassq( + lapack_int const* n, + double const* X, lapack_int const* incx, + double* scale, + double* sumsq ); + +#define LAPACK_slassq LAPACK_GLOBAL(slassq,SLASSQ) +void LAPACK_slassq( + lapack_int const* n, + float const* X, lapack_int const* incx, + float* scale, + float* sumsq ); + +#define LAPACK_zlassq LAPACK_GLOBAL(zlassq,ZLASSQ) +void LAPACK_zlassq( + lapack_int const* n, + lapack_complex_double const* X, lapack_int const* incx, + double* scale, + double* sumsq ); + +#define LAPACK_claswp LAPACK_GLOBAL(claswp,CLASWP) +void LAPACK_claswp( + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); + +#define LAPACK_dlaswp LAPACK_GLOBAL(dlaswp,DLASWP) +void LAPACK_dlaswp( + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); + +#define LAPACK_slaswp LAPACK_GLOBAL(slaswp,SLASWP) +void LAPACK_slaswp( + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); + +#define LAPACK_zlaswp LAPACK_GLOBAL(zlaswp,ZLASWP) +void LAPACK_zlaswp( + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* k1, lapack_int const* k2, lapack_int const* ipiv, lapack_int const* incx ); + +#define LAPACK_clatms LAPACK_GLOBAL(clatms,CLATMS) +void LAPACK_clatms( + lapack_int const* m, lapack_int const* n, char const* dist, + lapack_int* iseed, char const* sym, + float* D, + lapack_int const* mode, + float const* cond, + float const* dmax, lapack_int const* kl, lapack_int const* ku, char const* pack, + lapack_complex_float* A, + lapack_int const* lda, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dlatms LAPACK_GLOBAL(dlatms,DLATMS) +void LAPACK_dlatms( + lapack_int const* m, lapack_int const* n, char const* dist, + lapack_int* iseed, char const* sym, + double* D, + lapack_int const* mode, + double const* cond, + double const* dmax, lapack_int const* kl, lapack_int const* ku, char const* pack, + double* A, + lapack_int const* lda, + double* work, + lapack_int* info ); + +#define LAPACK_slatms LAPACK_GLOBAL(slatms,SLATMS) +void LAPACK_slatms( + lapack_int const* m, lapack_int const* n, char const* dist, + lapack_int* iseed, char const* sym, + float* D, + lapack_int const* mode, + float const* cond, + float const* dmax, lapack_int const* kl, lapack_int const* ku, char const* pack, + float* A, + lapack_int const* lda, + float* work, + lapack_int* info ); + +#define LAPACK_zlatms LAPACK_GLOBAL(zlatms,ZLATMS) +void LAPACK_zlatms( + lapack_int const* m, lapack_int const* n, char const* dist, + lapack_int* iseed, char const* sym, + double* D, + lapack_int const* mode, + double const* cond, + double const* dmax, lapack_int const* kl, lapack_int const* ku, char const* pack, + lapack_complex_double* A, + lapack_int const* lda, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_clauum LAPACK_GLOBAL(clauum,CLAUUM) +void LAPACK_clauum( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dlauum LAPACK_GLOBAL(dlauum,DLAUUM) +void LAPACK_dlauum( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_slauum LAPACK_GLOBAL(slauum,SLAUUM) +void LAPACK_slauum( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zlauum LAPACK_GLOBAL(zlauum,ZLAUUM) +void LAPACK_zlauum( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ilaver LAPACK_GLOBAL(ilaver,ILAVER) +void LAPACK_ilaver( + lapack_int* vers_major, lapack_int* vers_minor, lapack_int* vers_patch ); + +#define LAPACK_dopgtr LAPACK_GLOBAL(dopgtr,DOPGTR) +void LAPACK_dopgtr( + char const* uplo, + lapack_int const* n, + double const* AP, + double const* tau, + double* Q, lapack_int const* ldq, + double* work, + lapack_int* info ); + +#define LAPACK_sopgtr LAPACK_GLOBAL(sopgtr,SOPGTR) +void LAPACK_sopgtr( + char const* uplo, + lapack_int const* n, + float const* AP, + float const* tau, + float* Q, lapack_int const* ldq, + float* work, + lapack_int* info ); + +#define LAPACK_dopmtr LAPACK_GLOBAL(dopmtr,DOPMTR) +void LAPACK_dopmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + double const* AP, + double const* tau, + double* C, lapack_int const* ldc, + double* work, + lapack_int* info ); + +#define LAPACK_sopmtr LAPACK_GLOBAL(sopmtr,SOPMTR) +void LAPACK_sopmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + float const* AP, + float const* tau, + float* C, lapack_int const* ldc, + float* work, + lapack_int* info ); + +#define LAPACK_dorbdb LAPACK_GLOBAL(dorbdb,DORBDB) +void LAPACK_dorbdb( + char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + double* X11, lapack_int const* ldx11, + double* X12, lapack_int const* ldx12, + double* X21, lapack_int const* ldx21, + double* X22, lapack_int const* ldx22, + double* theta, + double* phi, + double* TAUP1, + double* TAUP2, + double* TAUQ1, + double* TAUQ2, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorbdb LAPACK_GLOBAL(sorbdb,SORBDB) +void LAPACK_sorbdb( + char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + float* X11, lapack_int const* ldx11, + float* X12, lapack_int const* ldx12, + float* X21, lapack_int const* ldx21, + float* X22, lapack_int const* ldx22, + float* theta, + float* phi, + float* TAUP1, + float* TAUP2, + float* TAUQ1, + float* TAUQ2, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorcsd LAPACK_GLOBAL(dorcsd,DORCSD) +void LAPACK_dorcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + double* X11, lapack_int const* ldx11, + double* X12, lapack_int const* ldx12, + double* X21, lapack_int const* ldx21, + double* X22, lapack_int const* ldx22, + double* theta, + double* U1, lapack_int const* ldu1, + double* U2, lapack_int const* ldu2, + double* V1T, lapack_int const* ldv1t, + double* V2T, lapack_int const* ldv2t, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sorcsd LAPACK_GLOBAL(sorcsd,SORCSD) +void LAPACK_sorcsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + float* X11, lapack_int const* ldx11, + float* X12, lapack_int const* ldx12, + float* X21, lapack_int const* ldx21, + float* X22, lapack_int const* ldx22, + float* theta, + float* U1, lapack_int const* ldu1, + float* U2, lapack_int const* ldu2, + float* V1T, lapack_int const* ldv1t, + float* V2T, lapack_int const* ldv2t, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dorcsd2by1 LAPACK_GLOBAL(dorcsd2by1,DORCSD2BY1) +void LAPACK_dorcsd2by1( + char const* jobu1, char const* jobu2, char const* jobv1t, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + double* X11, lapack_int const* ldx11, + double* X21, lapack_int const* ldx21, + double* theta, + double* U1, lapack_int const* ldu1, + double* U2, lapack_int const* ldu2, + double* V1T, lapack_int const* ldv1t, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sorcsd2by1 LAPACK_GLOBAL(sorcsd2by1,SORCSD2BY1) +void LAPACK_sorcsd2by1( + char const* jobu1, char const* jobu2, char const* jobv1t, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + float* X11, lapack_int const* ldx11, + float* X21, lapack_int const* ldx21, + float* theta, + float* U1, lapack_int const* ldu1, + float* U2, lapack_int const* ldu2, + float* V1T, lapack_int const* ldv1t, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dorgbr LAPACK_GLOBAL(dorgbr,DORGBR) +void LAPACK_dorgbr( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorgbr LAPACK_GLOBAL(sorgbr,SORGBR) +void LAPACK_sorgbr( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorghr LAPACK_GLOBAL(dorghr,DORGHR) +void LAPACK_dorghr( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorghr LAPACK_GLOBAL(sorghr,SORGHR) +void LAPACK_sorghr( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorglq LAPACK_GLOBAL(dorglq,DORGLQ) +void LAPACK_dorglq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorglq LAPACK_GLOBAL(sorglq,SORGLQ) +void LAPACK_sorglq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorgql LAPACK_GLOBAL(dorgql,DORGQL) +void LAPACK_dorgql( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorgql LAPACK_GLOBAL(sorgql,SORGQL) +void LAPACK_sorgql( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorgqr LAPACK_GLOBAL(dorgqr,DORGQR) +void LAPACK_dorgqr( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorgqr LAPACK_GLOBAL(sorgqr,SORGQR) +void LAPACK_sorgqr( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorgrq LAPACK_GLOBAL(dorgrq,DORGRQ) +void LAPACK_dorgrq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorgrq LAPACK_GLOBAL(sorgrq,SORGRQ) +void LAPACK_sorgrq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dorgtr LAPACK_GLOBAL(dorgtr,DORGTR) +void LAPACK_dorgtr( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sorgtr LAPACK_GLOBAL(sorgtr,SORGTR) +void LAPACK_sorgtr( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormbr LAPACK_GLOBAL(dormbr,DORMBR) +void LAPACK_dormbr( + char const* vect, char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormbr LAPACK_GLOBAL(sormbr,SORMBR) +void LAPACK_sormbr( + char const* vect, char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormhr LAPACK_GLOBAL(dormhr,DORMHR) +void LAPACK_dormhr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormhr LAPACK_GLOBAL(sormhr,SORMHR) +void LAPACK_sormhr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormlq LAPACK_GLOBAL(dormlq,DORMLQ) +void LAPACK_dormlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormlq LAPACK_GLOBAL(sormlq,SORMLQ) +void LAPACK_sormlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormql LAPACK_GLOBAL(dormql,DORMQL) +void LAPACK_dormql( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormql LAPACK_GLOBAL(sormql,SORMQL) +void LAPACK_sormql( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormqr LAPACK_GLOBAL(dormqr,DORMQR) +void LAPACK_dormqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormqr LAPACK_GLOBAL(sormqr,SORMQR) +void LAPACK_sormqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormrq LAPACK_GLOBAL(dormrq,DORMRQ) +void LAPACK_dormrq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormrq LAPACK_GLOBAL(sormrq,SORMRQ) +void LAPACK_sormrq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormrz LAPACK_GLOBAL(dormrz,DORMRZ) +void LAPACK_dormrz( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormrz LAPACK_GLOBAL(sormrz,SORMRZ) +void LAPACK_sormrz( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dormtr LAPACK_GLOBAL(dormtr,DORMTR) +void LAPACK_dormtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double const* tau, + double* C, lapack_int const* ldc, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_sormtr LAPACK_GLOBAL(sormtr,SORMTR) +void LAPACK_sormtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float const* tau, + float* C, lapack_int const* ldc, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cpbcon LAPACK_GLOBAL(cpbcon,CPBCON) +void LAPACK_cpbcon( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float const* AB, lapack_int const* ldab, + float const* anorm, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dpbcon LAPACK_GLOBAL(dpbcon,DPBCON) +void LAPACK_dpbcon( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + double const* AB, lapack_int const* ldab, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_spbcon LAPACK_GLOBAL(spbcon,SPBCON) +void LAPACK_spbcon( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + float const* AB, lapack_int const* ldab, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zpbcon LAPACK_GLOBAL(zpbcon,ZPBCON) +void LAPACK_zpbcon( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double const* AB, lapack_int const* ldab, + double const* anorm, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpbequ LAPACK_GLOBAL(cpbequ,CPBEQU) +void LAPACK_cpbequ( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float const* AB, lapack_int const* ldab, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_dpbequ LAPACK_GLOBAL(dpbequ,DPBEQU) +void LAPACK_dpbequ( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + double const* AB, lapack_int const* ldab, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_spbequ LAPACK_GLOBAL(spbequ,SPBEQU) +void LAPACK_spbequ( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + float const* AB, lapack_int const* ldab, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_zpbequ LAPACK_GLOBAL(zpbequ,ZPBEQU) +void LAPACK_zpbequ( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double const* AB, lapack_int const* ldab, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_cpbrfs LAPACK_GLOBAL(cpbrfs,CPBRFS) +void LAPACK_cpbrfs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float const* AFB, lapack_int const* ldafb, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dpbrfs LAPACK_GLOBAL(dpbrfs,DPBRFS) +void LAPACK_dpbrfs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double const* AFB, lapack_int const* ldafb, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_spbrfs LAPACK_GLOBAL(spbrfs,SPBRFS) +void LAPACK_spbrfs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float const* AFB, lapack_int const* ldafb, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zpbrfs LAPACK_GLOBAL(zpbrfs,ZPBRFS) +void LAPACK_zpbrfs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double const* AFB, lapack_int const* ldafb, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpbstf LAPACK_GLOBAL(cpbstf,CPBSTF) +void LAPACK_cpbstf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_dpbstf LAPACK_GLOBAL(dpbstf,DPBSTF) +void LAPACK_dpbstf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_spbstf LAPACK_GLOBAL(spbstf,SPBSTF) +void LAPACK_spbstf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_zpbstf LAPACK_GLOBAL(zpbstf,ZPBSTF) +void LAPACK_zpbstf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_cpbsv LAPACK_GLOBAL(cpbsv,CPBSV) +void LAPACK_cpbsv( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpbsv LAPACK_GLOBAL(dpbsv,DPBSV) +void LAPACK_dpbsv( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double* AB, lapack_int const* ldab, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spbsv LAPACK_GLOBAL(spbsv,SPBSV) +void LAPACK_spbsv( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float* AB, lapack_int const* ldab, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpbsv LAPACK_GLOBAL(zpbsv,ZPBSV) +void LAPACK_zpbsv( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cpbsvx LAPACK_GLOBAL(cpbsvx,CPBSVX) +void LAPACK_cpbsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_complex_float* AFB, lapack_int const* ldafb, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dpbsvx LAPACK_GLOBAL(dpbsvx,DPBSVX) +void LAPACK_dpbsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double* AB, lapack_int const* ldab, + double* AFB, lapack_int const* ldafb, char* equed, + double* S, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_spbsvx LAPACK_GLOBAL(spbsvx,SPBSVX) +void LAPACK_spbsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float* AB, lapack_int const* ldab, + float* AFB, lapack_int const* ldafb, char* equed, + float* S, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zpbsvx LAPACK_GLOBAL(zpbsvx,ZPBSVX) +void LAPACK_zpbsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_complex_double* AFB, lapack_int const* ldafb, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpbtrf LAPACK_GLOBAL(cpbtrf,CPBTRF) +void LAPACK_cpbtrf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_dpbtrf LAPACK_GLOBAL(dpbtrf,DPBTRF) +void LAPACK_dpbtrf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_spbtrf LAPACK_GLOBAL(spbtrf,SPBTRF) +void LAPACK_spbtrf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_zpbtrf LAPACK_GLOBAL(zpbtrf,ZPBTRF) +void LAPACK_zpbtrf( + char const* uplo, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double* AB, lapack_int const* ldab, + lapack_int* info ); + +#define LAPACK_cpbtrs LAPACK_GLOBAL(cpbtrs,CPBTRS) +void LAPACK_cpbtrs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpbtrs LAPACK_GLOBAL(dpbtrs,DPBTRS) +void LAPACK_dpbtrs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spbtrs LAPACK_GLOBAL(spbtrs,SPBTRS) +void LAPACK_spbtrs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpbtrs LAPACK_GLOBAL(zpbtrs,ZPBTRS) +void LAPACK_zpbtrs( + char const* uplo, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cpftrf LAPACK_GLOBAL(cpftrf,CPFTRF) +void LAPACK_cpftrf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, + lapack_int* info ); + +#define LAPACK_dpftrf LAPACK_GLOBAL(dpftrf,DPFTRF) +void LAPACK_dpftrf( + char const* transr, char const* uplo, + lapack_int const* n, + double* A, + lapack_int* info ); + +#define LAPACK_spftrf LAPACK_GLOBAL(spftrf,SPFTRF) +void LAPACK_spftrf( + char const* transr, char const* uplo, + lapack_int const* n, + float* A, + lapack_int* info ); + +#define LAPACK_zpftrf LAPACK_GLOBAL(zpftrf,ZPFTRF) +void LAPACK_zpftrf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, + lapack_int* info ); + +#define LAPACK_cpftri LAPACK_GLOBAL(cpftri,CPFTRI) +void LAPACK_cpftri( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float* A, + lapack_int* info ); + +#define LAPACK_dpftri LAPACK_GLOBAL(dpftri,DPFTRI) +void LAPACK_dpftri( + char const* transr, char const* uplo, + lapack_int const* n, + double* A, + lapack_int* info ); + +#define LAPACK_spftri LAPACK_GLOBAL(spftri,SPFTRI) +void LAPACK_spftri( + char const* transr, char const* uplo, + lapack_int const* n, + float* A, + lapack_int* info ); + +#define LAPACK_zpftri LAPACK_GLOBAL(zpftri,ZPFTRI) +void LAPACK_zpftri( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double* A, + lapack_int* info ); + +#define LAPACK_cpftrs LAPACK_GLOBAL(cpftrs,CPFTRS) +void LAPACK_cpftrs( + char const* transr, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpftrs LAPACK_GLOBAL(dpftrs,DPFTRS) +void LAPACK_dpftrs( + char const* transr, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spftrs LAPACK_GLOBAL(spftrs,SPFTRS) +void LAPACK_spftrs( + char const* transr, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpftrs LAPACK_GLOBAL(zpftrs,ZPFTRS) +void LAPACK_zpftrs( + char const* transr, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cpocon LAPACK_GLOBAL(cpocon,CPOCON) +void LAPACK_cpocon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float const* anorm, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dpocon LAPACK_GLOBAL(dpocon,DPOCON) +void LAPACK_dpocon( + char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_spocon LAPACK_GLOBAL(spocon,SPOCON) +void LAPACK_spocon( + char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zpocon LAPACK_GLOBAL(zpocon,ZPOCON) +void LAPACK_zpocon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double const* anorm, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpoequ LAPACK_GLOBAL(cpoequ,CPOEQU) +void LAPACK_cpoequ( + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_dpoequ LAPACK_GLOBAL(dpoequ,DPOEQU) +void LAPACK_dpoequ( + lapack_int const* n, + double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_spoequ LAPACK_GLOBAL(spoequ,SPOEQU) +void LAPACK_spoequ( + lapack_int const* n, + float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_zpoequ LAPACK_GLOBAL(zpoequ,ZPOEQU) +void LAPACK_zpoequ( + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_cpoequb LAPACK_GLOBAL(cpoequb,CPOEQUB) +void LAPACK_cpoequb( + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_dpoequb LAPACK_GLOBAL(dpoequb,DPOEQUB) +void LAPACK_dpoequb( + lapack_int const* n, + double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_spoequb LAPACK_GLOBAL(spoequb,SPOEQUB) +void LAPACK_spoequb( + lapack_int const* n, + float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_zpoequb LAPACK_GLOBAL(zpoequb,ZPOEQUB) +void LAPACK_zpoequb( + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_cporfs LAPACK_GLOBAL(cporfs,CPORFS) +void LAPACK_cporfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dporfs LAPACK_GLOBAL(dporfs,DPORFS) +void LAPACK_dporfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sporfs LAPACK_GLOBAL(sporfs,SPORFS) +void LAPACK_sporfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zporfs LAPACK_GLOBAL(zporfs,ZPORFS) +void LAPACK_zporfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cporfsx LAPACK_GLOBAL(cporfsx,CPORFSX) +void LAPACK_cporfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, + float* S, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dporfsx LAPACK_GLOBAL(dporfsx,DPORFSX) +void LAPACK_dporfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, + double* S, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sporfsx LAPACK_GLOBAL(sporfsx,SPORFSX) +void LAPACK_sporfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, + float* S, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zporfsx LAPACK_GLOBAL(zporfsx,ZPORFSX) +void LAPACK_zporfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, + double* S, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cposv LAPACK_GLOBAL(cposv,CPOSV) +void LAPACK_cposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dposv LAPACK_GLOBAL(dposv,DPOSV) +void LAPACK_dposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sposv LAPACK_GLOBAL(sposv,SPOSV) +void LAPACK_sposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zposv LAPACK_GLOBAL(zposv,ZPOSV) +void LAPACK_zposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsposv LAPACK_GLOBAL(dsposv,DSPOSV) +void LAPACK_dsposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* work, + float* swork, lapack_int* iter, + lapack_int* info ); + +#define LAPACK_zcposv LAPACK_GLOBAL(zcposv,ZCPOSV) +void LAPACK_zcposv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + lapack_complex_double* work, + lapack_complex_float* swork, + double* rwork, lapack_int* iter, + lapack_int* info ); + +#define LAPACK_cposvx LAPACK_GLOBAL(cposvx,CPOSVX) +void LAPACK_cposvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dposvx LAPACK_GLOBAL(dposvx,DPOSVX) +void LAPACK_dposvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, char* equed, + double* S, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sposvx LAPACK_GLOBAL(sposvx,SPOSVX) +void LAPACK_sposvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, char* equed, + float* S, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zposvx LAPACK_GLOBAL(zposvx,ZPOSVX) +void LAPACK_zposvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cposvxx LAPACK_GLOBAL(cposvxx,CPOSVXX) +void LAPACK_cposvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dposvxx LAPACK_GLOBAL(dposvxx,DPOSVXX) +void LAPACK_dposvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, char* equed, + double* S, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sposvxx LAPACK_GLOBAL(sposvxx,SPOSVXX) +void LAPACK_sposvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, char* equed, + float* S, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zposvxx LAPACK_GLOBAL(zposvxx,ZPOSVXX) +void LAPACK_zposvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpotf2 LAPACK_GLOBAL(cpotf2,CPOTF2) +void LAPACK_cpotf2( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dpotf2 LAPACK_GLOBAL(dpotf2,DPOTF2) +void LAPACK_dpotf2( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_spotf2 LAPACK_GLOBAL(spotf2,SPOTF2) +void LAPACK_spotf2( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zpotf2 LAPACK_GLOBAL(zpotf2,ZPOTF2) +void LAPACK_zpotf2( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_cpotrf LAPACK_GLOBAL(cpotrf,CPOTRF) +void LAPACK_cpotrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dpotrf LAPACK_GLOBAL(dpotrf,DPOTRF) +void LAPACK_dpotrf( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_spotrf LAPACK_GLOBAL(spotrf,SPOTRF) +void LAPACK_spotrf( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zpotrf LAPACK_GLOBAL(zpotrf,ZPOTRF) +void LAPACK_zpotrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_cpotrf2 LAPACK_GLOBAL(cpotrf2,CPOTRF2) +void LAPACK_cpotrf2( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dpotrf2 LAPACK_GLOBAL(dpotrf2,DPOTRF2) +void LAPACK_dpotrf2( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_spotrf2 LAPACK_GLOBAL(spotrf2,SPOTRF2) +void LAPACK_spotrf2( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zpotrf2 LAPACK_GLOBAL(zpotrf2,ZPOTRF2) +void LAPACK_zpotrf2( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_cpotri LAPACK_GLOBAL(cpotri,CPOTRI) +void LAPACK_cpotri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dpotri LAPACK_GLOBAL(dpotri,DPOTRI) +void LAPACK_dpotri( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_spotri LAPACK_GLOBAL(spotri,SPOTRI) +void LAPACK_spotri( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_zpotri LAPACK_GLOBAL(zpotri,ZPOTRI) +void LAPACK_zpotri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_cpotrs LAPACK_GLOBAL(cpotrs,CPOTRS) +void LAPACK_cpotrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpotrs LAPACK_GLOBAL(dpotrs,DPOTRS) +void LAPACK_dpotrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spotrs LAPACK_GLOBAL(spotrs,SPOTRS) +void LAPACK_spotrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpotrs LAPACK_GLOBAL(zpotrs,ZPOTRS) +void LAPACK_zpotrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cppcon LAPACK_GLOBAL(cppcon,CPPCON) +void LAPACK_cppcon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + float const* anorm, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dppcon LAPACK_GLOBAL(dppcon,DPPCON) +void LAPACK_dppcon( + char const* uplo, + lapack_int const* n, + double const* AP, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sppcon LAPACK_GLOBAL(sppcon,SPPCON) +void LAPACK_sppcon( + char const* uplo, + lapack_int const* n, + float const* AP, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zppcon LAPACK_GLOBAL(zppcon,ZPPCON) +void LAPACK_zppcon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + double const* anorm, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cppequ LAPACK_GLOBAL(cppequ,CPPEQU) +void LAPACK_cppequ( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_dppequ LAPACK_GLOBAL(dppequ,DPPEQU) +void LAPACK_dppequ( + char const* uplo, + lapack_int const* n, + double const* AP, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_sppequ LAPACK_GLOBAL(sppequ,SPPEQU) +void LAPACK_sppequ( + char const* uplo, + lapack_int const* n, + float const* AP, + float* S, + float* scond, + float* amax, + lapack_int* info ); + +#define LAPACK_zppequ LAPACK_GLOBAL(zppequ,ZPPEQU) +void LAPACK_zppequ( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + double* S, + double* scond, + double* amax, + lapack_int* info ); + +#define LAPACK_cpprfs LAPACK_GLOBAL(cpprfs,CPPRFS) +void LAPACK_cpprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float const* AFP, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dpprfs LAPACK_GLOBAL(dpprfs,DPPRFS) +void LAPACK_dpprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double const* AFP, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_spprfs LAPACK_GLOBAL(spprfs,SPPRFS) +void LAPACK_spprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float const* AFP, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zpprfs LAPACK_GLOBAL(zpprfs,ZPPRFS) +void LAPACK_zpprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double const* AFP, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cppsv LAPACK_GLOBAL(cppsv,CPPSV) +void LAPACK_cppsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* AP, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dppsv LAPACK_GLOBAL(dppsv,DPPSV) +void LAPACK_dppsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* AP, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sppsv LAPACK_GLOBAL(sppsv,SPPSV) +void LAPACK_sppsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* AP, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zppsv LAPACK_GLOBAL(zppsv,ZPPSV) +void LAPACK_zppsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* AP, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cppsvx LAPACK_GLOBAL(cppsvx,CPPSVX) +void LAPACK_cppsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* AP, + lapack_complex_float* AFP, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dppsvx LAPACK_GLOBAL(dppsvx,DPPSVX) +void LAPACK_dppsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* AP, + double* AFP, char* equed, + double* S, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sppsvx LAPACK_GLOBAL(sppsvx,SPPSVX) +void LAPACK_sppsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* AP, + float* AFP, char* equed, + float* S, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zppsvx LAPACK_GLOBAL(zppsvx,ZPPSVX) +void LAPACK_zppsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* AP, + lapack_complex_double* AFP, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpptrf LAPACK_GLOBAL(cpptrf,CPPTRF) +void LAPACK_cpptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_int* info ); + +#define LAPACK_dpptrf LAPACK_GLOBAL(dpptrf,DPPTRF) +void LAPACK_dpptrf( + char const* uplo, + lapack_int const* n, + double* AP, + lapack_int* info ); + +#define LAPACK_spptrf LAPACK_GLOBAL(spptrf,SPPTRF) +void LAPACK_spptrf( + char const* uplo, + lapack_int const* n, + float* AP, + lapack_int* info ); + +#define LAPACK_zpptrf LAPACK_GLOBAL(zpptrf,ZPPTRF) +void LAPACK_zpptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_int* info ); + +#define LAPACK_cpptri LAPACK_GLOBAL(cpptri,CPPTRI) +void LAPACK_cpptri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, + lapack_int* info ); + +#define LAPACK_dpptri LAPACK_GLOBAL(dpptri,DPPTRI) +void LAPACK_dpptri( + char const* uplo, + lapack_int const* n, + double* AP, + lapack_int* info ); + +#define LAPACK_spptri LAPACK_GLOBAL(spptri,SPPTRI) +void LAPACK_spptri( + char const* uplo, + lapack_int const* n, + float* AP, + lapack_int* info ); + +#define LAPACK_zpptri LAPACK_GLOBAL(zpptri,ZPPTRI) +void LAPACK_zpptri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, + lapack_int* info ); + +#define LAPACK_cpptrs LAPACK_GLOBAL(cpptrs,CPPTRS) +void LAPACK_cpptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpptrs LAPACK_GLOBAL(dpptrs,DPPTRS) +void LAPACK_dpptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spptrs LAPACK_GLOBAL(spptrs,SPPTRS) +void LAPACK_spptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpptrs LAPACK_GLOBAL(zpptrs,ZPPTRS) +void LAPACK_zpptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cpstrf LAPACK_GLOBAL(cpstrf,CPSTRF) +void LAPACK_cpstrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* piv, lapack_int* rank, + float const* tol, + float* work, + lapack_int* info ); + +#define LAPACK_dpstrf LAPACK_GLOBAL(dpstrf,DPSTRF) +void LAPACK_dpstrf( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* piv, lapack_int* rank, + double const* tol, + double* work, + lapack_int* info ); + +#define LAPACK_spstrf LAPACK_GLOBAL(spstrf,SPSTRF) +void LAPACK_spstrf( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* piv, lapack_int* rank, + float const* tol, + float* work, + lapack_int* info ); + +#define LAPACK_zpstrf LAPACK_GLOBAL(zpstrf,ZPSTRF) +void LAPACK_zpstrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* piv, lapack_int* rank, + double const* tol, + double* work, + lapack_int* info ); + +#define LAPACK_cptcon LAPACK_GLOBAL(cptcon,CPTCON) +void LAPACK_cptcon( + lapack_int const* n, + float const* D, + lapack_complex_float const* E, + float const* anorm, + float* rcond, + float* rwork, + lapack_int* info ); + +#define LAPACK_dptcon LAPACK_GLOBAL(dptcon,DPTCON) +void LAPACK_dptcon( + lapack_int const* n, + double const* D, + double const* E, + double const* anorm, + double* rcond, + double* work, + lapack_int* info ); + +#define LAPACK_sptcon LAPACK_GLOBAL(sptcon,SPTCON) +void LAPACK_sptcon( + lapack_int const* n, + float const* D, + float const* E, + float const* anorm, + float* rcond, + float* work, + lapack_int* info ); + +#define LAPACK_zptcon LAPACK_GLOBAL(zptcon,ZPTCON) +void LAPACK_zptcon( + lapack_int const* n, + double const* D, + lapack_complex_double const* E, + double const* anorm, + double* rcond, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpteqr LAPACK_GLOBAL(cpteqr,CPTEQR) +void LAPACK_cpteqr( + char const* compz, + lapack_int const* n, + float* D, + float* E, + lapack_complex_float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dpteqr LAPACK_GLOBAL(dpteqr,DPTEQR) +void LAPACK_dpteqr( + char const* compz, + lapack_int const* n, + double* D, + double* E, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_spteqr LAPACK_GLOBAL(spteqr,SPTEQR) +void LAPACK_spteqr( + char const* compz, + lapack_int const* n, + float* D, + float* E, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_zpteqr LAPACK_GLOBAL(zpteqr,ZPTEQR) +void LAPACK_zpteqr( + char const* compz, + lapack_int const* n, + double* D, + double* E, + lapack_complex_double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_cptrfs LAPACK_GLOBAL(cptrfs,CPTRFS) +void LAPACK_cptrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* D, + lapack_complex_float const* E, + float const* DF, + lapack_complex_float const* EF, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dptrfs LAPACK_GLOBAL(dptrfs,DPTRFS) +void LAPACK_dptrfs( + lapack_int const* n, lapack_int const* nrhs, + double const* D, + double const* E, + double const* DF, + double const* EF, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* info ); + +#define LAPACK_sptrfs LAPACK_GLOBAL(sptrfs,SPTRFS) +void LAPACK_sptrfs( + lapack_int const* n, lapack_int const* nrhs, + float const* D, + float const* E, + float const* DF, + float const* EF, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* info ); + +#define LAPACK_zptrfs LAPACK_GLOBAL(zptrfs,ZPTRFS) +void LAPACK_zptrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* D, + lapack_complex_double const* E, + double const* DF, + lapack_complex_double const* EF, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cptsv LAPACK_GLOBAL(cptsv,CPTSV) +void LAPACK_cptsv( + lapack_int const* n, lapack_int const* nrhs, + float* D, + lapack_complex_float* E, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dptsv LAPACK_GLOBAL(dptsv,DPTSV) +void LAPACK_dptsv( + lapack_int const* n, lapack_int const* nrhs, + double* D, + double* E, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sptsv LAPACK_GLOBAL(sptsv,SPTSV) +void LAPACK_sptsv( + lapack_int const* n, lapack_int const* nrhs, + float* D, + float* E, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zptsv LAPACK_GLOBAL(zptsv,ZPTSV) +void LAPACK_zptsv( + lapack_int const* n, lapack_int const* nrhs, + double* D, + lapack_complex_double* E, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cptsvx LAPACK_GLOBAL(cptsvx,CPTSVX) +void LAPACK_cptsvx( + char const* fact, + lapack_int const* n, lapack_int const* nrhs, + float const* D, + lapack_complex_float const* E, + float* DF, + lapack_complex_float* EF, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dptsvx LAPACK_GLOBAL(dptsvx,DPTSVX) +void LAPACK_dptsvx( + char const* fact, + lapack_int const* n, lapack_int const* nrhs, + double const* D, + double const* E, + double* DF, + double* EF, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* info ); + +#define LAPACK_sptsvx LAPACK_GLOBAL(sptsvx,SPTSVX) +void LAPACK_sptsvx( + char const* fact, + lapack_int const* n, lapack_int const* nrhs, + float const* D, + float const* E, + float* DF, + float* EF, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* info ); + +#define LAPACK_zptsvx LAPACK_GLOBAL(zptsvx,ZPTSVX) +void LAPACK_zptsvx( + char const* fact, + lapack_int const* n, lapack_int const* nrhs, + double const* D, + lapack_complex_double const* E, + double* DF, + lapack_complex_double* EF, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cpttrf LAPACK_GLOBAL(cpttrf,CPTTRF) +void LAPACK_cpttrf( + lapack_int const* n, + float* D, + lapack_complex_float* E, + lapack_int* info ); + +#define LAPACK_dpttrf LAPACK_GLOBAL(dpttrf,DPTTRF) +void LAPACK_dpttrf( + lapack_int const* n, + double* D, + double* E, + lapack_int* info ); + +#define LAPACK_spttrf LAPACK_GLOBAL(spttrf,SPTTRF) +void LAPACK_spttrf( + lapack_int const* n, + float* D, + float* E, + lapack_int* info ); + +#define LAPACK_zpttrf LAPACK_GLOBAL(zpttrf,ZPTTRF) +void LAPACK_zpttrf( + lapack_int const* n, + double* D, + lapack_complex_double* E, + lapack_int* info ); + +#define LAPACK_cpttrs LAPACK_GLOBAL(cpttrs,CPTTRS) +void LAPACK_cpttrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* D, + lapack_complex_float const* E, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dpttrs LAPACK_GLOBAL(dpttrs,DPTTRS) +void LAPACK_dpttrs( + lapack_int const* n, lapack_int const* nrhs, + double const* D, + double const* E, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_spttrs LAPACK_GLOBAL(spttrs,SPTTRS) +void LAPACK_spttrs( + lapack_int const* n, lapack_int const* nrhs, + float const* D, + float const* E, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zpttrs LAPACK_GLOBAL(zpttrs,ZPTTRS) +void LAPACK_zpttrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* D, + lapack_complex_double const* E, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsbev LAPACK_GLOBAL(dsbev,DSBEV) +void LAPACK_dsbev( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_ssbev LAPACK_GLOBAL(ssbev,SSBEV) +void LAPACK_ssbev( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dsbev_2stage LAPACK_GLOBAL(dsbev_2stage,DSBEV_2STAGE) +void LAPACK_dsbev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssbev_2stage LAPACK_GLOBAL(ssbev_2stage,SSBEV_2STAGE) +void LAPACK_ssbev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsbevd LAPACK_GLOBAL(dsbevd,DSBEVD) +void LAPACK_dsbevd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssbevd LAPACK_GLOBAL(ssbevd,SSBEVD) +void LAPACK_ssbevd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsbevd_2stage LAPACK_GLOBAL(dsbevd_2stage,DSBEVD_2STAGE) +void LAPACK_dsbevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssbevd_2stage LAPACK_GLOBAL(ssbevd_2stage,SSBEVD_2STAGE) +void LAPACK_ssbevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsbevx LAPACK_GLOBAL(dsbevx,DSBEVX) +void LAPACK_dsbevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssbevx LAPACK_GLOBAL(ssbevx,SSBEVX) +void LAPACK_ssbevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dsbevx_2stage LAPACK_GLOBAL(dsbevx_2stage,DSBEVX_2STAGE) +void LAPACK_dsbevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssbevx_2stage LAPACK_GLOBAL(ssbevx_2stage,SSBEVX_2STAGE) +void LAPACK_ssbevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dsbgst LAPACK_GLOBAL(dsbgst,DSBGST) +void LAPACK_dsbgst( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + double* AB, lapack_int const* ldab, + double const* BB, lapack_int const* ldbb, + double* X, lapack_int const* ldx, + double* work, + lapack_int* info ); + +#define LAPACK_ssbgst LAPACK_GLOBAL(ssbgst,SSBGST) +void LAPACK_ssbgst( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + float* AB, lapack_int const* ldab, + float const* BB, lapack_int const* ldbb, + float* X, lapack_int const* ldx, + float* work, + lapack_int* info ); + +#define LAPACK_dsbgv LAPACK_GLOBAL(dsbgv,DSBGV) +void LAPACK_dsbgv( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + double* AB, lapack_int const* ldab, + double* BB, lapack_int const* ldbb, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_ssbgv LAPACK_GLOBAL(ssbgv,SSBGV) +void LAPACK_ssbgv( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + float* AB, lapack_int const* ldab, + float* BB, lapack_int const* ldbb, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dsbgvd LAPACK_GLOBAL(dsbgvd,DSBGVD) +void LAPACK_dsbgvd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + double* AB, lapack_int const* ldab, + double* BB, lapack_int const* ldbb, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssbgvd LAPACK_GLOBAL(ssbgvd,SSBGVD) +void LAPACK_ssbgvd( + char const* jobz, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + float* AB, lapack_int const* ldab, + float* BB, lapack_int const* ldbb, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsbgvx LAPACK_GLOBAL(dsbgvx,DSBGVX) +void LAPACK_dsbgvx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + double* AB, lapack_int const* ldab, + double* BB, lapack_int const* ldbb, + double* Q, lapack_int const* ldq, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssbgvx LAPACK_GLOBAL(ssbgvx,SSBGVX) +void LAPACK_ssbgvx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, lapack_int const* ka, lapack_int const* kb, + float* AB, lapack_int const* ldab, + float* BB, lapack_int const* ldbb, + float* Q, lapack_int const* ldq, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dsbtrd LAPACK_GLOBAL(dsbtrd,DSBTRD) +void LAPACK_dsbtrd( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* kd, + double* AB, lapack_int const* ldab, + double* D, + double* E, + double* Q, lapack_int const* ldq, + double* work, + lapack_int* info ); + +#define LAPACK_ssbtrd LAPACK_GLOBAL(ssbtrd,SSBTRD) +void LAPACK_ssbtrd( + char const* vect, char const* uplo, + lapack_int const* n, lapack_int const* kd, + float* AB, lapack_int const* ldab, + float* D, + float* E, + float* Q, lapack_int const* ldq, + float* work, + lapack_int* info ); + +#define LAPACK_dsfrk LAPACK_GLOBAL(dsfrk,DSFRK) +void LAPACK_dsfrk( + char const* transr, char const* uplo, char const* trans, + lapack_int const* n, lapack_int const* k, + double const* alpha, + double const* A, lapack_int const* lda, + double const* beta, + double* C ); + +#define LAPACK_ssfrk LAPACK_GLOBAL(ssfrk,SSFRK) +void LAPACK_ssfrk( + char const* transr, char const* uplo, char const* trans, + lapack_int const* n, lapack_int const* k, + float const* alpha, + float const* A, lapack_int const* lda, + float const* beta, + float* C ); + +#define LAPACK_cspcon LAPACK_GLOBAL(cspcon,CSPCON) +void LAPACK_cspcon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dspcon LAPACK_GLOBAL(dspcon,DSPCON) +void LAPACK_dspcon( + char const* uplo, + lapack_int const* n, + double const* AP, lapack_int const* ipiv, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sspcon LAPACK_GLOBAL(sspcon,SSPCON) +void LAPACK_sspcon( + char const* uplo, + lapack_int const* n, + float const* AP, lapack_int const* ipiv, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zspcon LAPACK_GLOBAL(zspcon,ZSPCON) +void LAPACK_zspcon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_dspev LAPACK_GLOBAL(dspev,DSPEV) +void LAPACK_dspev( + char const* jobz, char const* uplo, + lapack_int const* n, + double* AP, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_sspev LAPACK_GLOBAL(sspev,SSPEV) +void LAPACK_sspev( + char const* jobz, char const* uplo, + lapack_int const* n, + float* AP, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dspevd LAPACK_GLOBAL(dspevd,DSPEVD) +void LAPACK_dspevd( + char const* jobz, char const* uplo, + lapack_int const* n, + double* AP, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sspevd LAPACK_GLOBAL(sspevd,SSPEVD) +void LAPACK_sspevd( + char const* jobz, char const* uplo, + lapack_int const* n, + float* AP, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dspevx LAPACK_GLOBAL(dspevx,DSPEVX) +void LAPACK_dspevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* AP, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_sspevx LAPACK_GLOBAL(sspevx,SSPEVX) +void LAPACK_sspevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* AP, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dspgst LAPACK_GLOBAL(dspgst,DSPGST) +void LAPACK_dspgst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + double* AP, + double const* BP, + lapack_int* info ); + +#define LAPACK_sspgst LAPACK_GLOBAL(sspgst,SSPGST) +void LAPACK_sspgst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + float* AP, + float const* BP, + lapack_int* info ); + +#define LAPACK_dspgv LAPACK_GLOBAL(dspgv,DSPGV) +void LAPACK_dspgv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + double* AP, + double* BP, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_sspgv LAPACK_GLOBAL(sspgv,SSPGV) +void LAPACK_sspgv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + float* AP, + float* BP, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dspgvd LAPACK_GLOBAL(dspgvd,DSPGVD) +void LAPACK_dspgvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + double* AP, + double* BP, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sspgvd LAPACK_GLOBAL(sspgvd,SSPGVD) +void LAPACK_sspgvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + float* AP, + float* BP, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dspgvx LAPACK_GLOBAL(dspgvx,DSPGVX) +void LAPACK_dspgvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* AP, + double* BP, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_sspgvx LAPACK_GLOBAL(sspgvx,SSPGVX) +void LAPACK_sspgvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* AP, + float* BP, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_csprfs LAPACK_GLOBAL(csprfs,CSPRFS) +void LAPACK_csprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float const* AFP, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dsprfs LAPACK_GLOBAL(dsprfs,DSPRFS) +void LAPACK_dsprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double const* AFP, lapack_int const* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssprfs LAPACK_GLOBAL(ssprfs,SSPRFS) +void LAPACK_ssprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float const* AFP, lapack_int const* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsprfs LAPACK_GLOBAL(zsprfs,ZSPRFS) +void LAPACK_zsprfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double const* AFP, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_cspsv LAPACK_GLOBAL(cspsv,CSPSV) +void LAPACK_cspsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* AP, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dspsv LAPACK_GLOBAL(dspsv,DSPSV) +void LAPACK_dspsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* AP, lapack_int* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_sspsv LAPACK_GLOBAL(sspsv,SSPSV) +void LAPACK_sspsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* AP, lapack_int* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zspsv LAPACK_GLOBAL(zspsv,ZSPSV) +void LAPACK_zspsv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* AP, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_cspsvx LAPACK_GLOBAL(cspsvx,CSPSVX) +void LAPACK_cspsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float* AFP, lapack_int* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dspsvx LAPACK_GLOBAL(dspsvx,DSPSVX) +void LAPACK_dspsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double* AFP, lapack_int* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sspsvx LAPACK_GLOBAL(sspsvx,SSPSVX) +void LAPACK_sspsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float* AFP, lapack_int* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zspsvx LAPACK_GLOBAL(zspsvx,ZSPSVX) +void LAPACK_zspsvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double* AFP, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_dsptrd LAPACK_GLOBAL(dsptrd,DSPTRD) +void LAPACK_dsptrd( + char const* uplo, + lapack_int const* n, + double* AP, + double* D, + double* E, + double* tau, + lapack_int* info ); + +#define LAPACK_ssptrd LAPACK_GLOBAL(ssptrd,SSPTRD) +void LAPACK_ssptrd( + char const* uplo, + lapack_int const* n, + float* AP, + float* D, + float* E, + float* tau, + lapack_int* info ); + +#define LAPACK_csptrf LAPACK_GLOBAL(csptrf,CSPTRF) +void LAPACK_csptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_dsptrf LAPACK_GLOBAL(dsptrf,DSPTRF) +void LAPACK_dsptrf( + char const* uplo, + lapack_int const* n, + double* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_ssptrf LAPACK_GLOBAL(ssptrf,SSPTRF) +void LAPACK_ssptrf( + char const* uplo, + lapack_int const* n, + float* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_zsptrf LAPACK_GLOBAL(zsptrf,ZSPTRF) +void LAPACK_zsptrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, lapack_int* ipiv, + lapack_int* info ); + +#define LAPACK_csptri LAPACK_GLOBAL(csptri,CSPTRI) +void LAPACK_csptri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* AP, lapack_int const* ipiv, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsptri LAPACK_GLOBAL(dsptri,DSPTRI) +void LAPACK_dsptri( + char const* uplo, + lapack_int const* n, + double* AP, lapack_int const* ipiv, + double* work, + lapack_int* info ); + +#define LAPACK_ssptri LAPACK_GLOBAL(ssptri,SSPTRI) +void LAPACK_ssptri( + char const* uplo, + lapack_int const* n, + float* AP, lapack_int const* ipiv, + float* work, + lapack_int* info ); + +#define LAPACK_zsptri LAPACK_GLOBAL(zsptri,ZSPTRI) +void LAPACK_zsptri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* AP, lapack_int const* ipiv, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_csptrs LAPACK_GLOBAL(csptrs,CSPTRS) +void LAPACK_csptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsptrs LAPACK_GLOBAL(dsptrs,DSPTRS) +void LAPACK_dsptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssptrs LAPACK_GLOBAL(ssptrs,SSPTRS) +void LAPACK_ssptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zsptrs LAPACK_GLOBAL(zsptrs,ZSPTRS) +void LAPACK_zsptrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dstebz LAPACK_GLOBAL(dstebz,DSTEBZ) +void LAPACK_dstebz( + char const* range, char const* order, + lapack_int const* n, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, + double const* D, + double const* E, lapack_int* m, lapack_int* nsplit, + double* W, lapack_int* IBLOCK, lapack_int* ISPLIT, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_sstebz LAPACK_GLOBAL(sstebz,SSTEBZ) +void LAPACK_sstebz( + char const* range, char const* order, + lapack_int const* n, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, + float const* D, + float const* E, lapack_int* m, lapack_int* nsplit, + float* W, lapack_int* IBLOCK, lapack_int* ISPLIT, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cstedc LAPACK_GLOBAL(cstedc,CSTEDC) +void LAPACK_cstedc( + char const* compz, + lapack_int const* n, + float* D, + float* E, + lapack_complex_float* Z, lapack_int const* ldz, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dstedc LAPACK_GLOBAL(dstedc,DSTEDC) +void LAPACK_dstedc( + char const* compz, + lapack_int const* n, + double* D, + double* E, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sstedc LAPACK_GLOBAL(sstedc,SSTEDC) +void LAPACK_sstedc( + char const* compz, + lapack_int const* n, + float* D, + float* E, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zstedc LAPACK_GLOBAL(zstedc,ZSTEDC) +void LAPACK_zstedc( + char const* compz, + lapack_int const* n, + double* D, + double* E, + lapack_complex_double* Z, lapack_int const* ldz, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cstegr LAPACK_GLOBAL(cstegr,CSTEGR) +void LAPACK_cstegr( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dstegr LAPACK_GLOBAL(dstegr,DSTEGR) +void LAPACK_dstegr( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sstegr LAPACK_GLOBAL(sstegr,SSTEGR) +void LAPACK_sstegr( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zstegr LAPACK_GLOBAL(zstegr,ZSTEGR) +void LAPACK_zstegr( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_cstein LAPACK_GLOBAL(cstein,CSTEIN) +void LAPACK_cstein( + lapack_int const* n, + float const* D, + float const* E, lapack_int const* m, + float const* W, lapack_int const* IBLOCK, lapack_int const* ISPLIT, + lapack_complex_float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dstein LAPACK_GLOBAL(dstein,DSTEIN) +void LAPACK_dstein( + lapack_int const* n, + double const* D, + double const* E, lapack_int const* m, + double const* W, lapack_int const* IBLOCK, lapack_int const* ISPLIT, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_sstein LAPACK_GLOBAL(sstein,SSTEIN) +void LAPACK_sstein( + lapack_int const* n, + float const* D, + float const* E, lapack_int const* m, + float const* W, lapack_int const* IBLOCK, lapack_int const* ISPLIT, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_zstein LAPACK_GLOBAL(zstein,ZSTEIN) +void LAPACK_zstein( + lapack_int const* n, + double const* D, + double const* E, lapack_int const* m, + double const* W, lapack_int const* IBLOCK, lapack_int const* ISPLIT, + lapack_complex_double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_cstemr LAPACK_GLOBAL(cstemr,CSTEMR) +void LAPACK_cstemr( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* m, + float* W, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int const* nzc, lapack_int* ISUPPZ, lapack_logical* tryrac, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dstemr LAPACK_GLOBAL(dstemr,DSTEMR) +void LAPACK_dstemr( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, lapack_int const* nzc, lapack_int* ISUPPZ, lapack_logical* tryrac, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sstemr LAPACK_GLOBAL(sstemr,SSTEMR) +void LAPACK_sstemr( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, lapack_int const* nzc, lapack_int* ISUPPZ, lapack_logical* tryrac, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zstemr LAPACK_GLOBAL(zstemr,ZSTEMR) +void LAPACK_zstemr( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, lapack_int* m, + double* W, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int const* nzc, lapack_int* ISUPPZ, lapack_logical* tryrac, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_csteqr LAPACK_GLOBAL(csteqr,CSTEQR) +void LAPACK_csteqr( + char const* compz, + lapack_int const* n, + float* D, + float* E, + lapack_complex_float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dsteqr LAPACK_GLOBAL(dsteqr,DSTEQR) +void LAPACK_dsteqr( + char const* compz, + lapack_int const* n, + double* D, + double* E, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_ssteqr LAPACK_GLOBAL(ssteqr,SSTEQR) +void LAPACK_ssteqr( + char const* compz, + lapack_int const* n, + float* D, + float* E, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_zsteqr LAPACK_GLOBAL(zsteqr,ZSTEQR) +void LAPACK_zsteqr( + char const* compz, + lapack_int const* n, + double* D, + double* E, + lapack_complex_double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_dsterf LAPACK_GLOBAL(dsterf,DSTERF) +void LAPACK_dsterf( + lapack_int const* n, + double* D, + double* E, + lapack_int* info ); + +#define LAPACK_ssterf LAPACK_GLOBAL(ssterf,SSTERF) +void LAPACK_ssterf( + lapack_int const* n, + float* D, + float* E, + lapack_int* info ); + +#define LAPACK_dstev LAPACK_GLOBAL(dstev,DSTEV) +void LAPACK_dstev( + char const* jobz, + lapack_int const* n, + double* D, + double* E, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* info ); + +#define LAPACK_sstev LAPACK_GLOBAL(sstev,SSTEV) +void LAPACK_sstev( + char const* jobz, + lapack_int const* n, + float* D, + float* E, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* info ); + +#define LAPACK_dstevd LAPACK_GLOBAL(dstevd,DSTEVD) +void LAPACK_dstevd( + char const* jobz, + lapack_int const* n, + double* D, + double* E, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sstevd LAPACK_GLOBAL(sstevd,SSTEVD) +void LAPACK_sstevd( + char const* jobz, + lapack_int const* n, + float* D, + float* E, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dstevr LAPACK_GLOBAL(dstevr,DSTEVR) +void LAPACK_dstevr( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sstevr LAPACK_GLOBAL(sstevr,SSTEVR) +void LAPACK_sstevr( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dstevx LAPACK_GLOBAL(dstevx,DSTEVX) +void LAPACK_dstevx( + char const* jobz, char const* range, + lapack_int const* n, + double* D, + double* E, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_sstevx LAPACK_GLOBAL(sstevx,SSTEVX) +void LAPACK_sstevx( + char const* jobz, char const* range, + lapack_int const* n, + float* D, + float* E, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_csycon LAPACK_GLOBAL(csycon,CSYCON) +void LAPACK_csycon( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsycon LAPACK_GLOBAL(dsycon,DSYCON) +void LAPACK_dsycon( + char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, lapack_int const* ipiv, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssycon LAPACK_GLOBAL(ssycon,SSYCON) +void LAPACK_ssycon( + char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, lapack_int const* ipiv, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsycon LAPACK_GLOBAL(zsycon,ZSYCON) +void LAPACK_zsycon( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_csycon_3 LAPACK_GLOBAL(csycon_3,CSYCON_3) +void LAPACK_csycon_3( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + float const* anorm, + float* rcond, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsycon_3 LAPACK_GLOBAL(dsycon_3,DSYCON_3) +void LAPACK_dsycon_3( + char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double const* E, lapack_int const* ipiv, + double const* anorm, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssycon_3 LAPACK_GLOBAL(ssycon_3,SSYCON_3) +void LAPACK_ssycon_3( + char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float const* E, lapack_int const* ipiv, + float const* anorm, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsycon_3 LAPACK_GLOBAL(zsycon_3,ZSYCON_3) +void LAPACK_zsycon_3( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + double const* anorm, + double* rcond, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_csyconv LAPACK_GLOBAL(csyconv,CSYCONV) +void LAPACK_csyconv( + char const* uplo, char const* way, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* E, + lapack_int* info ); + +#define LAPACK_dsyconv LAPACK_GLOBAL(dsyconv,DSYCONV) +void LAPACK_dsyconv( + char const* uplo, char const* way, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* E, + lapack_int* info ); + +#define LAPACK_ssyconv LAPACK_GLOBAL(ssyconv,SSYCONV) +void LAPACK_ssyconv( + char const* uplo, char const* way, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* E, + lapack_int* info ); + +#define LAPACK_zsyconv LAPACK_GLOBAL(zsyconv,ZSYCONV) +void LAPACK_zsyconv( + char const* uplo, char const* way, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* E, + lapack_int* info ); + +#define LAPACK_csyequb LAPACK_GLOBAL(csyequb,CSYEQUB) +void LAPACK_csyequb( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsyequb LAPACK_GLOBAL(dsyequb,DSYEQUB) +void LAPACK_dsyequb( + char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + double* work, + lapack_int* info ); + +#define LAPACK_ssyequb LAPACK_GLOBAL(ssyequb,SSYEQUB) +void LAPACK_ssyequb( + char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* S, + float* scond, + float* amax, + float* work, + lapack_int* info ); + +#define LAPACK_zsyequb LAPACK_GLOBAL(zsyequb,ZSYEQUB) +void LAPACK_zsyequb( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* S, + double* scond, + double* amax, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_dsyev LAPACK_GLOBAL(dsyev,DSYEV) +void LAPACK_dsyev( + char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* W, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssyev LAPACK_GLOBAL(ssyev,SSYEV) +void LAPACK_ssyev( + char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* W, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsyev_2stage LAPACK_GLOBAL(dsyev_2stage,DSYEV_2STAGE) +void LAPACK_dsyev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* W, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssyev_2stage LAPACK_GLOBAL(ssyev_2stage,SSYEV_2STAGE) +void LAPACK_ssyev_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* W, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsyevd LAPACK_GLOBAL(dsyevd,DSYEVD) +void LAPACK_dsyevd( + char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* W, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssyevd LAPACK_GLOBAL(ssyevd,SSYEVD) +void LAPACK_ssyevd( + char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* W, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsyevd_2stage LAPACK_GLOBAL(dsyevd_2stage,DSYEVD_2STAGE) +void LAPACK_dsyevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* W, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssyevd_2stage LAPACK_GLOBAL(ssyevd_2stage,SSYEVD_2STAGE) +void LAPACK_ssyevd_2stage( + char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* W, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsyevr LAPACK_GLOBAL(dsyevr,DSYEVR) +void LAPACK_dsyevr( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssyevr LAPACK_GLOBAL(ssyevr,SSYEVR) +void LAPACK_ssyevr( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsyevr_2stage LAPACK_GLOBAL(dsyevr_2stage,DSYEVR_2STAGE) +void LAPACK_dsyevr_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssyevr_2stage LAPACK_GLOBAL(ssyevr_2stage,SSYEVR_2STAGE) +void LAPACK_ssyevr_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, lapack_int* ISUPPZ, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsyevx LAPACK_GLOBAL(dsyevx,DSYEVX) +void LAPACK_dsyevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssyevx LAPACK_GLOBAL(ssyevx,SSYEVX) +void LAPACK_ssyevx( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dsyevx_2stage LAPACK_GLOBAL(dsyevx_2stage,DSYEVX_2STAGE) +void LAPACK_dsyevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssyevx_2stage LAPACK_GLOBAL(ssyevx_2stage,SSYEVX_2STAGE) +void LAPACK_ssyevx_2stage( + char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_dsygst LAPACK_GLOBAL(dsygst,DSYGST) +void LAPACK_dsygst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssygst LAPACK_GLOBAL(ssygst,SSYGST) +void LAPACK_ssygst( + lapack_int const* itype, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsygv LAPACK_GLOBAL(dsygv,DSYGV) +void LAPACK_dsygv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* W, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssygv LAPACK_GLOBAL(ssygv,SSYGV) +void LAPACK_ssygv( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* W, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsygv_2stage LAPACK_GLOBAL(dsygv_2stage,DSYGV_2STAGE) +void LAPACK_dsygv_2stage( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* W, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssygv_2stage LAPACK_GLOBAL(ssygv_2stage,SSYGV_2STAGE) +void LAPACK_ssygv_2stage( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* W, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsygvd LAPACK_GLOBAL(dsygvd,DSYGVD) +void LAPACK_dsygvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* W, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ssygvd LAPACK_GLOBAL(ssygvd,SSYGVD) +void LAPACK_ssygvd( + lapack_int const* itype, char const* jobz, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* W, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dsygvx LAPACK_GLOBAL(dsygvx,DSYGVX) +void LAPACK_dsygvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double const* vl, + double const* vu, lapack_int const* il, lapack_int const* iu, + double const* abstol, lapack_int* m, + double* W, + double* Z, lapack_int const* ldz, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_ssygvx LAPACK_GLOBAL(ssygvx,SSYGVX) +void LAPACK_ssygvx( + lapack_int const* itype, char const* jobz, char const* range, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float const* vl, + float const* vu, lapack_int const* il, lapack_int const* iu, + float const* abstol, lapack_int* m, + float* W, + float* Z, lapack_int const* ldz, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int* IFAIL, + lapack_int* info ); + +#define LAPACK_csyr LAPACK_GLOBAL(csyr,CSYR) +void LAPACK_csyr( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* alpha, + lapack_complex_float const* X, lapack_int const* incx, + lapack_complex_float* A, lapack_int const* lda ); + +#define LAPACK_zsyr LAPACK_GLOBAL(zsyr,ZSYR) +void LAPACK_zsyr( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* alpha, + lapack_complex_double const* X, lapack_int const* incx, + lapack_complex_double* A, lapack_int const* lda ); + +#define LAPACK_csyrfs LAPACK_GLOBAL(csyrfs,CSYRFS) +void LAPACK_csyrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dsyrfs LAPACK_GLOBAL(dsyrfs,DSYRFS) +void LAPACK_dsyrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssyrfs LAPACK_GLOBAL(ssyrfs,SSYRFS) +void LAPACK_ssyrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsyrfs LAPACK_GLOBAL(zsyrfs,ZSYRFS) +void LAPACK_zsyrfs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_csyrfsx LAPACK_GLOBAL(csyrfsx,CSYRFSX) +void LAPACK_csyrfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float* S, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dsyrfsx LAPACK_GLOBAL(dsyrfsx,DSYRFSX) +void LAPACK_dsyrfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double* S, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssyrfsx LAPACK_GLOBAL(ssyrfsx,SSYRFSX) +void LAPACK_ssyrfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + float* S, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsyrfsx LAPACK_GLOBAL(zsyrfsx,ZSYRFSX) +void LAPACK_zsyrfsx( + char const* uplo, char const* equed, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* AF, lapack_int const* ldaf, lapack_int const* ipiv, + double* S, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_csysv LAPACK_GLOBAL(csysv,CSYSV) +void LAPACK_csysv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsysv LAPACK_GLOBAL(dsysv,DSYSV) +void LAPACK_dsysv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssysv LAPACK_GLOBAL(ssysv,SSYSV) +void LAPACK_ssysv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsysv LAPACK_GLOBAL(zsysv,ZSYSV) +void LAPACK_zsysv( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csysv_aa LAPACK_GLOBAL(csysv_aa,CSYSV_AA) +void LAPACK_csysv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsysv_aa LAPACK_GLOBAL(dsysv_aa,DSYSV_AA) +void LAPACK_dsysv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssysv_aa LAPACK_GLOBAL(ssysv_aa,SSYSV_AA) +void LAPACK_ssysv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsysv_aa LAPACK_GLOBAL(zsysv_aa,ZSYSV_AA) +void LAPACK_zsysv_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csysv_aa_2stage LAPACK_GLOBAL(csysv_aa_2stage,CSYSV_AA_2STAGE) +void LAPACK_csysv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsysv_aa_2stage LAPACK_GLOBAL(dsysv_aa_2stage,DSYSV_AA_2STAGE) +void LAPACK_dsysv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssysv_aa_2stage LAPACK_GLOBAL(ssysv_aa_2stage,SSYSV_AA_2STAGE) +void LAPACK_ssysv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsysv_aa_2stage LAPACK_GLOBAL(zsysv_aa_2stage,ZSYSV_AA_2STAGE) +void LAPACK_zsysv_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csysv_rk LAPACK_GLOBAL(csysv_rk,CSYSV_RK) +void LAPACK_csysv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* E, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsysv_rk LAPACK_GLOBAL(dsysv_rk,DSYSV_RK) +void LAPACK_dsysv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* E, lapack_int* ipiv, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssysv_rk LAPACK_GLOBAL(ssysv_rk,SSYSV_RK) +void LAPACK_ssysv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* E, lapack_int* ipiv, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsysv_rk LAPACK_GLOBAL(zsysv_rk,ZSYSV_RK) +void LAPACK_zsysv_rk( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* E, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csysv_rook LAPACK_GLOBAL(csysv_rook,CSYSV_ROOK) +void LAPACK_csysv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsysv_rook LAPACK_GLOBAL(dsysv_rook,DSYSV_ROOK) +void LAPACK_dsysv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssysv_rook LAPACK_GLOBAL(ssysv_rook,SSYSV_ROOK) +void LAPACK_ssysv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsysv_rook LAPACK_GLOBAL(zsysv_rook,ZSYSV_ROOK) +void LAPACK_zsysv_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csysvx LAPACK_GLOBAL(csysvx,CSYSVX) +void LAPACK_csysvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dsysvx LAPACK_GLOBAL(dsysvx,DSYSVX) +void LAPACK_dsysvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, lapack_int* ipiv, + double const* B, lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssysvx LAPACK_GLOBAL(ssysvx,SSYSVX) +void LAPACK_ssysvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, lapack_int* ipiv, + float const* B, lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* ferr, + float* berr, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsysvx LAPACK_GLOBAL(zsysvx,ZSYSVX) +void LAPACK_zsysvx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* ferr, + double* berr, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_csysvxx LAPACK_GLOBAL(csysvxx,CSYSVXX) +void LAPACK_csysvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* S, + lapack_complex_float* B, + lapack_int const* ldb, + lapack_complex_float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dsysvxx LAPACK_GLOBAL(dsysvxx,DSYSVXX) +void LAPACK_dsysvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, + double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* S, + double* B, + lapack_int const* ldb, + double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ssysvxx LAPACK_GLOBAL(ssysvxx,SSYSVXX) +void LAPACK_ssysvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, + float* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + float* S, + float* B, + lapack_int const* ldb, + float* X, lapack_int const* ldx, + float* rcond, + float* rpvgrw, + float* berr, lapack_int const* n_err_bnds, + float* err_bnds_norm, + float* err_bnds_comp, lapack_int const* nparams, + float* params, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zsysvxx LAPACK_GLOBAL(zsysvxx,ZSYSVXX) +void LAPACK_zsysvxx( + char const* fact, char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* AF, lapack_int const* ldaf, lapack_int* ipiv, char* equed, + double* S, + lapack_complex_double* B, + lapack_int const* ldb, + lapack_complex_double* X, lapack_int const* ldx, + double* rcond, + double* rpvgrw, + double* berr, lapack_int const* n_err_bnds, + double* err_bnds_norm, + double* err_bnds_comp, lapack_int const* nparams, + double* params, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_csyswapr LAPACK_GLOBAL(csyswapr,CSYSWAPR) +void LAPACK_csyswapr( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_dsyswapr LAPACK_GLOBAL(dsyswapr,DSYSWAPR) +void LAPACK_dsyswapr( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_ssyswapr LAPACK_GLOBAL(ssyswapr,SSYSWAPR) +void LAPACK_ssyswapr( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_zsyswapr LAPACK_GLOBAL(zsyswapr,ZSYSWAPR) +void LAPACK_zsyswapr( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* i1, lapack_int const* i2 ); + +#define LAPACK_dsytrd LAPACK_GLOBAL(dsytrd,DSYTRD) +void LAPACK_dsytrd( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* D, + double* E, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrd LAPACK_GLOBAL(ssytrd,SSYTRD) +void LAPACK_ssytrd( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* D, + float* E, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrd_2stage LAPACK_GLOBAL(dsytrd_2stage,DSYTRD_2STAGE) +void LAPACK_dsytrd_2stage( + char const* vect, char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* D, + double* E, + double* tau, + double* HOUS2, lapack_int const* lhous2, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrd_2stage LAPACK_GLOBAL(ssytrd_2stage,SSYTRD_2STAGE) +void LAPACK_ssytrd_2stage( + char const* vect, char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* D, + float* E, + float* tau, + float* HOUS2, lapack_int const* lhous2, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrf LAPACK_GLOBAL(csytrf,CSYTRF) +void LAPACK_csytrf( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrf LAPACK_GLOBAL(dsytrf,DSYTRF) +void LAPACK_dsytrf( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrf LAPACK_GLOBAL(ssytrf,SSYTRF) +void LAPACK_ssytrf( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrf LAPACK_GLOBAL(zsytrf,ZSYTRF) +void LAPACK_zsytrf( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrf_aa LAPACK_GLOBAL(csytrf_aa,CSYTRF_AA) +void LAPACK_csytrf_aa( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrf_aa LAPACK_GLOBAL(dsytrf_aa,DSYTRF_AA) +void LAPACK_dsytrf_aa( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrf_aa LAPACK_GLOBAL(ssytrf_aa,SSYTRF_AA) +void LAPACK_ssytrf_aa( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrf_aa LAPACK_GLOBAL(zsytrf_aa,ZSYTRF_AA) +void LAPACK_zsytrf_aa( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrf_aa_2stage LAPACK_GLOBAL(csytrf_aa_2stage,CSYTRF_AA_2STAGE) +void LAPACK_csytrf_aa_2stage( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrf_aa_2stage LAPACK_GLOBAL(dsytrf_aa_2stage,DSYTRF_AA_2STAGE) +void LAPACK_dsytrf_aa_2stage( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrf_aa_2stage LAPACK_GLOBAL(ssytrf_aa_2stage,SSYTRF_AA_2STAGE) +void LAPACK_ssytrf_aa_2stage( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrf_aa_2stage LAPACK_GLOBAL(zsytrf_aa_2stage,ZSYTRF_AA_2STAGE) +void LAPACK_zsytrf_aa_2stage( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int* ipiv, lapack_int* ipiv2, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrf_rk LAPACK_GLOBAL(csytrf_rk,CSYTRF_RK) +void LAPACK_csytrf_rk( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* E, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrf_rk LAPACK_GLOBAL(dsytrf_rk,DSYTRF_RK) +void LAPACK_dsytrf_rk( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double* E, lapack_int* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrf_rk LAPACK_GLOBAL(ssytrf_rk,SSYTRF_RK) +void LAPACK_ssytrf_rk( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float* E, lapack_int* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrf_rk LAPACK_GLOBAL(zsytrf_rk,ZSYTRF_RK) +void LAPACK_zsytrf_rk( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* E, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrf_rook LAPACK_GLOBAL(csytrf_rook,CSYTRF_ROOK) +void LAPACK_csytrf_rook( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrf_rook LAPACK_GLOBAL(dsytrf_rook,DSYTRF_ROOK) +void LAPACK_dsytrf_rook( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrf_rook LAPACK_GLOBAL(ssytrf_rook,SSYTRF_ROOK) +void LAPACK_ssytrf_rook( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrf_rook LAPACK_GLOBAL(zsytrf_rook,ZSYTRF_ROOK) +void LAPACK_zsytrf_rook( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytri LAPACK_GLOBAL(csytri,CSYTRI) +void LAPACK_csytri( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsytri LAPACK_GLOBAL(dsytri,DSYTRI) +void LAPACK_dsytri( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* work, + lapack_int* info ); + +#define LAPACK_ssytri LAPACK_GLOBAL(ssytri,SSYTRI) +void LAPACK_ssytri( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* work, + lapack_int* info ); + +#define LAPACK_zsytri LAPACK_GLOBAL(zsytri,ZSYTRI) +void LAPACK_zsytri( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_csytri2 LAPACK_GLOBAL(csytri2,CSYTRI2) +void LAPACK_csytri2( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytri2 LAPACK_GLOBAL(dsytri2,DSYTRI2) +void LAPACK_dsytri2( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytri2 LAPACK_GLOBAL(ssytri2,SSYTRI2) +void LAPACK_ssytri2( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytri2 LAPACK_GLOBAL(zsytri2,ZSYTRI2) +void LAPACK_zsytri2( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytri2x LAPACK_GLOBAL(csytri2x,CSYTRI2X) +void LAPACK_csytri2x( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_dsytri2x LAPACK_GLOBAL(dsytri2x,DSYTRI2X) +void LAPACK_dsytri2x( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_ssytri2x LAPACK_GLOBAL(ssytri2x,SSYTRI2X) +void LAPACK_ssytri2x( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_zsytri2x LAPACK_GLOBAL(zsytri2x,ZSYTRI2X) +void LAPACK_zsytri2x( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* nb, + lapack_int* info ); + +#define LAPACK_csytri_3 LAPACK_GLOBAL(csytri_3,CSYTRI_3) +void LAPACK_csytri_3( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytri_3 LAPACK_GLOBAL(dsytri_3,DSYTRI_3) +void LAPACK_dsytri_3( + char const* uplo, + lapack_int const* n, + double* A, lapack_int const* lda, + double const* E, lapack_int const* ipiv, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytri_3 LAPACK_GLOBAL(ssytri_3,SSYTRI_3) +void LAPACK_ssytri_3( + char const* uplo, + lapack_int const* n, + float* A, lapack_int const* lda, + float const* E, lapack_int const* ipiv, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytri_3 LAPACK_GLOBAL(zsytri_3,ZSYTRI_3) +void LAPACK_zsytri_3( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrs LAPACK_GLOBAL(csytrs,CSYTRS) +void LAPACK_csytrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsytrs LAPACK_GLOBAL(dsytrs,DSYTRS) +void LAPACK_dsytrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssytrs LAPACK_GLOBAL(ssytrs,SSYTRS) +void LAPACK_ssytrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zsytrs LAPACK_GLOBAL(zsytrs,ZSYTRS) +void LAPACK_zsytrs( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_csytrs2 LAPACK_GLOBAL(csytrs2,CSYTRS2) +void LAPACK_csytrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dsytrs2 LAPACK_GLOBAL(dsytrs2,DSYTRS2) +void LAPACK_dsytrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double* A, lapack_int const* lda, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + double* work, + lapack_int* info ); + +#define LAPACK_ssytrs2 LAPACK_GLOBAL(ssytrs2,SSYTRS2) +void LAPACK_ssytrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float* A, lapack_int const* lda, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + float* work, + lapack_int* info ); + +#define LAPACK_zsytrs2 LAPACK_GLOBAL(zsytrs2,ZSYTRS2) +void LAPACK_zsytrs2( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_csytrs_3 LAPACK_GLOBAL(csytrs_3,CSYTRS_3) +void LAPACK_csytrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* E, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsytrs_3 LAPACK_GLOBAL(dsytrs_3,DSYTRS_3) +void LAPACK_dsytrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* E, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssytrs_3 LAPACK_GLOBAL(ssytrs_3,SSYTRS_3) +void LAPACK_ssytrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* E, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zsytrs_3 LAPACK_GLOBAL(zsytrs_3,ZSYTRS_3) +void LAPACK_zsytrs_3( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* E, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_csytrs_aa LAPACK_GLOBAL(csytrs_aa,CSYTRS_AA) +void LAPACK_csytrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dsytrs_aa LAPACK_GLOBAL(dsytrs_aa,DSYTRS_AA) +void LAPACK_dsytrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ssytrs_aa LAPACK_GLOBAL(ssytrs_aa,SSYTRS_AA) +void LAPACK_ssytrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zsytrs_aa LAPACK_GLOBAL(zsytrs_aa,ZSYTRS_AA) +void LAPACK_zsytrs_aa( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_csytrs_aa_2stage LAPACK_GLOBAL(csytrs_aa_2stage,CSYTRS_AA_2STAGE) +void LAPACK_csytrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsytrs_aa_2stage LAPACK_GLOBAL(dsytrs_aa_2stage,DSYTRS_AA_2STAGE) +void LAPACK_dsytrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssytrs_aa_2stage LAPACK_GLOBAL(ssytrs_aa_2stage,SSYTRS_AA_2STAGE) +void LAPACK_ssytrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zsytrs_aa_2stage LAPACK_GLOBAL(zsytrs_aa_2stage,ZSYTRS_AA_2STAGE) +void LAPACK_zsytrs_aa_2stage( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* TB, lapack_int const* ltb, lapack_int const* ipiv, lapack_int const* ipiv2, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_csytrs_rook LAPACK_GLOBAL(csytrs_rook,CSYTRS_ROOK) +void LAPACK_csytrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dsytrs_rook LAPACK_GLOBAL(dsytrs_rook,DSYTRS_ROOK) +void LAPACK_dsytrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, lapack_int const* ipiv, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ssytrs_rook LAPACK_GLOBAL(ssytrs_rook,SSYTRS_ROOK) +void LAPACK_ssytrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, lapack_int const* ipiv, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_zsytrs_rook LAPACK_GLOBAL(zsytrs_rook,ZSYTRS_ROOK) +void LAPACK_zsytrs_rook( + char const* uplo, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, lapack_int const* ipiv, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ctbcon LAPACK_GLOBAL(ctbcon,CTBCON) +void LAPACK_ctbcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* kd, + lapack_complex_float const* AB, lapack_int const* ldab, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtbcon LAPACK_GLOBAL(dtbcon,DTBCON) +void LAPACK_dtbcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* kd, + double const* AB, lapack_int const* ldab, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stbcon LAPACK_GLOBAL(stbcon,STBCON) +void LAPACK_stbcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* kd, + float const* AB, lapack_int const* ldab, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztbcon LAPACK_GLOBAL(ztbcon,ZTBCON) +void LAPACK_ztbcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, lapack_int const* kd, + lapack_complex_double const* AB, lapack_int const* ldab, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctbrfs LAPACK_GLOBAL(ctbrfs,CTBRFS) +void LAPACK_ctbrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtbrfs LAPACK_GLOBAL(dtbrfs,DTBRFS) +void LAPACK_dtbrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double const* B, lapack_int const* ldb, + double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stbrfs LAPACK_GLOBAL(stbrfs,STBRFS) +void LAPACK_stbrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float const* B, lapack_int const* ldb, + float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztbrfs LAPACK_GLOBAL(ztbrfs,ZTBRFS) +void LAPACK_ztbrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctbtrs LAPACK_GLOBAL(ctbtrs,CTBTRS) +void LAPACK_ctbtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_float const* AB, lapack_int const* ldab, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dtbtrs LAPACK_GLOBAL(dtbtrs,DTBTRS) +void LAPACK_dtbtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + double const* AB, lapack_int const* ldab, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_stbtrs LAPACK_GLOBAL(stbtrs,STBTRS) +void LAPACK_stbtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + float const* AB, lapack_int const* ldab, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ztbtrs LAPACK_GLOBAL(ztbtrs,ZTBTRS) +void LAPACK_ztbtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* kd, lapack_int const* nrhs, + lapack_complex_double const* AB, lapack_int const* ldab, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ctfsm LAPACK_GLOBAL(ctfsm,CTFSM) +void LAPACK_ctfsm( + char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* alpha, + lapack_complex_float const* A, + lapack_complex_float* B, lapack_int const* ldb ); + +#define LAPACK_dtfsm LAPACK_GLOBAL(dtfsm,DTFSM) +void LAPACK_dtfsm( + char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, + lapack_int const* m, lapack_int const* n, + double const* alpha, + double const* A, + double* B, lapack_int const* ldb ); + +#define LAPACK_stfsm LAPACK_GLOBAL(stfsm,STFSM) +void LAPACK_stfsm( + char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, + lapack_int const* m, lapack_int const* n, + float const* alpha, + float const* A, + float* B, lapack_int const* ldb ); + +#define LAPACK_ztfsm LAPACK_GLOBAL(ztfsm,ZTFSM) +void LAPACK_ztfsm( + char const* transr, char const* side, char const* uplo, char const* trans, char const* diag, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* alpha, + lapack_complex_double const* A, + lapack_complex_double* B, lapack_int const* ldb ); + +#define LAPACK_ctftri LAPACK_GLOBAL(ctftri,CTFTRI) +void LAPACK_ctftri( + char const* transr, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float* A, + lapack_int* info ); + +#define LAPACK_dtftri LAPACK_GLOBAL(dtftri,DTFTRI) +void LAPACK_dtftri( + char const* transr, char const* uplo, char const* diag, + lapack_int const* n, + double* A, + lapack_int* info ); + +#define LAPACK_stftri LAPACK_GLOBAL(stftri,STFTRI) +void LAPACK_stftri( + char const* transr, char const* uplo, char const* diag, + lapack_int const* n, + float* A, + lapack_int* info ); + +#define LAPACK_ztftri LAPACK_GLOBAL(ztftri,ZTFTRI) +void LAPACK_ztftri( + char const* transr, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double* A, + lapack_int* info ); + +#define LAPACK_ctfttp LAPACK_GLOBAL(ctfttp,CTFTTP) +void LAPACK_ctfttp( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float const* ARF, + lapack_complex_float* AP, + lapack_int* info ); + +#define LAPACK_dtfttp LAPACK_GLOBAL(dtfttp,DTFTTP) +void LAPACK_dtfttp( + char const* transr, char const* uplo, + lapack_int const* n, + double const* ARF, + double* AP, + lapack_int* info ); + +#define LAPACK_stfttp LAPACK_GLOBAL(stfttp,STFTTP) +void LAPACK_stfttp( + char const* transr, char const* uplo, + lapack_int const* n, + float const* ARF, + float* AP, + lapack_int* info ); + +#define LAPACK_ztfttp LAPACK_GLOBAL(ztfttp,ZTFTTP) +void LAPACK_ztfttp( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double const* ARF, + lapack_complex_double* AP, + lapack_int* info ); + +#define LAPACK_ctfttr LAPACK_GLOBAL(ctfttr,CTFTTR) +void LAPACK_ctfttr( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float const* ARF, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dtfttr LAPACK_GLOBAL(dtfttr,DTFTTR) +void LAPACK_dtfttr( + char const* transr, char const* uplo, + lapack_int const* n, + double const* ARF, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_stfttr LAPACK_GLOBAL(stfttr,STFTTR) +void LAPACK_stfttr( + char const* transr, char const* uplo, + lapack_int const* n, + float const* ARF, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ztfttr LAPACK_GLOBAL(ztfttr,ZTFTTR) +void LAPACK_ztfttr( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double const* ARF, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ctgevc LAPACK_GLOBAL(ctgevc,CTGEVC) +void LAPACK_ctgevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float const* S, lapack_int const* lds, + lapack_complex_float const* P, lapack_int const* ldp, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtgevc LAPACK_GLOBAL(dtgevc,DTGEVC) +void LAPACK_dtgevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + double const* S, lapack_int const* lds, + double const* P, lapack_int const* ldp, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + double* work, + lapack_int* info ); + +#define LAPACK_stgevc LAPACK_GLOBAL(stgevc,STGEVC) +void LAPACK_stgevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + float const* S, lapack_int const* lds, + float const* P, lapack_int const* ldp, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + float* work, + lapack_int* info ); + +#define LAPACK_ztgevc LAPACK_GLOBAL(ztgevc,ZTGEVC) +void LAPACK_ztgevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double const* S, lapack_int const* lds, + lapack_complex_double const* P, lapack_int const* ldp, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctgexc LAPACK_GLOBAL(ctgexc,CTGEXC) +void LAPACK_ctgexc( + lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int const* ifst, lapack_int* ilst, + lapack_int* info ); + +#define LAPACK_dtgexc LAPACK_GLOBAL(dtgexc,DTGEXC) +void LAPACK_dtgexc( + lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* Q, lapack_int const* ldq, + double* Z, lapack_int const* ldz, lapack_int* ifst, lapack_int* ilst, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_stgexc LAPACK_GLOBAL(stgexc,STGEXC) +void LAPACK_stgexc( + lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* Q, lapack_int const* ldq, + float* Z, lapack_int const* ldz, lapack_int* ifst, lapack_int* ilst, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ztgexc LAPACK_GLOBAL(ztgexc,ZTGEXC) +void LAPACK_ztgexc( + lapack_logical const* wantq, lapack_logical const* wantz, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int const* ifst, lapack_int* ilst, + lapack_int* info ); + +#define LAPACK_ctgsen LAPACK_GLOBAL(ctgsen,CTGSEN) +void LAPACK_ctgsen( + lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* alpha, + lapack_complex_float* beta, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* Z, lapack_int const* ldz, lapack_int* m, + float* pl, + float* pr, + float* DIF, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dtgsen LAPACK_GLOBAL(dtgsen,DTGSEN) +void LAPACK_dtgsen( + lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* alphar, + double* alphai, + double* beta, + double* Q, lapack_int const* ldq, + double* Z, lapack_int const* ldz, lapack_int* m, + double* pl, + double* pr, + double* DIF, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_stgsen LAPACK_GLOBAL(stgsen,STGSEN) +void LAPACK_stgsen( + lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* alphar, + float* alphai, + float* beta, + float* Q, lapack_int const* ldq, + float* Z, lapack_int const* ldz, lapack_int* m, + float* pl, + float* pr, + float* DIF, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ztgsen LAPACK_GLOBAL(ztgsen,ZTGSEN) +void LAPACK_ztgsen( + lapack_int const* ijob, lapack_logical const* wantq, lapack_logical const* wantz, lapack_logical const* select, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* alpha, + lapack_complex_double* beta, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* Z, lapack_int const* ldz, lapack_int* m, + double* pl, + double* pr, + double* DIF, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ctgsja LAPACK_GLOBAL(ctgsja,CTGSJA) +void LAPACK_ctgsja( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + float const* tola, + float const* tolb, + float* alpha, + float* beta, + lapack_complex_float* U, lapack_int const* ldu, + lapack_complex_float* V, lapack_int const* ldv, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* work, lapack_int* ncycle, + lapack_int* info ); + +#define LAPACK_dtgsja LAPACK_GLOBAL(dtgsja,DTGSJA) +void LAPACK_dtgsja( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double const* tola, + double const* tolb, + double* alpha, + double* beta, + double* U, lapack_int const* ldu, + double* V, lapack_int const* ldv, + double* Q, lapack_int const* ldq, + double* work, lapack_int* ncycle, + lapack_int* info ); + +#define LAPACK_stgsja LAPACK_GLOBAL(stgsja,STGSJA) +void LAPACK_stgsja( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float const* tola, + float const* tolb, + float* alpha, + float* beta, + float* U, lapack_int const* ldu, + float* V, lapack_int const* ldv, + float* Q, lapack_int const* ldq, + float* work, lapack_int* ncycle, + lapack_int* info ); + +#define LAPACK_ztgsja LAPACK_GLOBAL(ztgsja,ZTGSJA) +void LAPACK_ztgsja( + char const* jobu, char const* jobv, char const* jobq, + lapack_int const* m, lapack_int const* p, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + double const* tola, + double const* tolb, + double* alpha, + double* beta, + lapack_complex_double* U, lapack_int const* ldu, + lapack_complex_double* V, lapack_int const* ldv, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* work, lapack_int* ncycle, + lapack_int* info ); + +#define LAPACK_ctgsna LAPACK_GLOBAL(ctgsna,CTGSNA) +void LAPACK_ctgsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float const* VL, lapack_int const* ldvl, + lapack_complex_float const* VR, lapack_int const* ldvr, + float* S, + float* DIF, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dtgsna LAPACK_GLOBAL(dtgsna,DTGSNA) +void LAPACK_dtgsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + double const* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + double const* VL, lapack_int const* ldvl, + double const* VR, lapack_int const* ldvr, + double* S, + double* DIF, lapack_int const* mm, lapack_int* m, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stgsna LAPACK_GLOBAL(stgsna,STGSNA) +void LAPACK_stgsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + float const* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + float const* VL, lapack_int const* ldvl, + float const* VR, lapack_int const* ldvr, + float* S, + float* DIF, lapack_int const* mm, lapack_int* m, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztgsna LAPACK_GLOBAL(ztgsna,ZTGSNA) +void LAPACK_ztgsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double const* VL, lapack_int const* ldvl, + lapack_complex_double const* VR, lapack_int const* ldvr, + double* S, + double* DIF, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ctgsyl LAPACK_GLOBAL(ctgsyl,CTGSYL) +void LAPACK_ctgsyl( + char const* trans, + lapack_int const* ijob, lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float const* D, lapack_int const* ldd, + lapack_complex_float const* E, lapack_int const* lde, + lapack_complex_float* F, lapack_int const* ldf, + float* dif, + float* scale, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_dtgsyl LAPACK_GLOBAL(dtgsyl,DTGSYL) +void LAPACK_dtgsyl( + char const* trans, + lapack_int const* ijob, lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + double* C, lapack_int const* ldc, + double const* D, lapack_int const* ldd, + double const* E, lapack_int const* lde, + double* F, lapack_int const* ldf, + double* dif, + double* scale, + double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stgsyl LAPACK_GLOBAL(stgsyl,STGSYL) +void LAPACK_stgsyl( + char const* trans, + lapack_int const* ijob, lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + float* C, lapack_int const* ldc, + float const* D, lapack_int const* ldd, + float const* E, lapack_int const* lde, + float* F, lapack_int const* ldf, + float* dif, + float* scale, + float* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztgsyl LAPACK_GLOBAL(ztgsyl,ZTGSYL) +void LAPACK_ztgsyl( + char const* trans, + lapack_int const* ijob, lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double const* D, lapack_int const* ldd, + lapack_complex_double const* E, lapack_int const* lde, + lapack_complex_double* F, lapack_int const* ldf, + double* dif, + double* scale, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ctpcon LAPACK_GLOBAL(ctpcon,CTPCON) +void LAPACK_ctpcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float const* AP, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtpcon LAPACK_GLOBAL(dtpcon,DTPCON) +void LAPACK_dtpcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + double const* AP, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stpcon LAPACK_GLOBAL(stpcon,STPCON) +void LAPACK_stpcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + float const* AP, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztpcon LAPACK_GLOBAL(ztpcon,ZTPCON) +void LAPACK_ztpcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double const* AP, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctplqt LAPACK_GLOBAL(ctplqt,CTPLQT) +void LAPACK_ctplqt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dtplqt LAPACK_GLOBAL(dtplqt,DTPLQT) +void LAPACK_dtplqt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* T, lapack_int const* ldt, + double* work, + lapack_int* info ); + +#define LAPACK_stplqt LAPACK_GLOBAL(stplqt,STPLQT) +void LAPACK_stplqt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* T, lapack_int const* ldt, + float* work, + lapack_int* info ); + +#define LAPACK_ztplqt LAPACK_GLOBAL(ztplqt,ZTPLQT) +void LAPACK_ztplqt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* mb, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_ctplqt2 LAPACK_GLOBAL(ctplqt2,CTPLQT2) +void LAPACK_ctplqt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_dtplqt2 LAPACK_GLOBAL(dtplqt2,DTPLQT2) +void LAPACK_dtplqt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_stplqt2 LAPACK_GLOBAL(stplqt2,STPLQT2) +void LAPACK_stplqt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_ztplqt2 LAPACK_GLOBAL(ztplqt2,ZTPLQT2) +void LAPACK_ztplqt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_ctpmlqt LAPACK_GLOBAL(ctpmlqt,CTPMLQT) +void LAPACK_ctpmlqt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dtpmlqt LAPACK_GLOBAL(dtpmlqt,DTPMLQT) +void LAPACK_dtpmlqt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, + double const* V, lapack_int const* ldv, + double const* T, lapack_int const* ldt, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* work, + lapack_int* info ); + +#define LAPACK_stpmlqt LAPACK_GLOBAL(stpmlqt,STPMLQT) +void LAPACK_stpmlqt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, + float const* V, lapack_int const* ldv, + float const* T, lapack_int const* ldt, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* work, + lapack_int* info ); + +#define LAPACK_ztpmlqt LAPACK_GLOBAL(ztpmlqt,ZTPMLQT) +void LAPACK_ztpmlqt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* mb, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_ctpmqrt LAPACK_GLOBAL(ctpmqrt,CTPMQRT) +void LAPACK_ctpmqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dtpmqrt LAPACK_GLOBAL(dtpmqrt,DTPMQRT) +void LAPACK_dtpmqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, + double const* V, lapack_int const* ldv, + double const* T, lapack_int const* ldt, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* work, + lapack_int* info ); + +#define LAPACK_stpmqrt LAPACK_GLOBAL(stpmqrt,STPMQRT) +void LAPACK_stpmqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, + float const* V, lapack_int const* ldv, + float const* T, lapack_int const* ldt, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* work, + lapack_int* info ); + +#define LAPACK_ztpmqrt LAPACK_GLOBAL(ztpmqrt,ZTPMQRT) +void LAPACK_ztpmqrt( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, lapack_int const* nb, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_ctpqrt LAPACK_GLOBAL(ctpqrt,CTPQRT) +void LAPACK_ctpqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_dtpqrt LAPACK_GLOBAL(dtpqrt,DTPQRT) +void LAPACK_dtpqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* T, lapack_int const* ldt, + double* work, + lapack_int* info ); + +#define LAPACK_stpqrt LAPACK_GLOBAL(stpqrt,STPQRT) +void LAPACK_stpqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* T, lapack_int const* ldt, + float* work, + lapack_int* info ); + +#define LAPACK_ztpqrt LAPACK_GLOBAL(ztpqrt,ZTPQRT) +void LAPACK_ztpqrt( + lapack_int const* m, lapack_int const* n, lapack_int const* l, lapack_int const* nb, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_ctpqrt2 LAPACK_GLOBAL(ctpqrt2,CTPQRT2) +void LAPACK_ctpqrt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_dtpqrt2 LAPACK_GLOBAL(dtpqrt2,DTPQRT2) +void LAPACK_dtpqrt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_stpqrt2 LAPACK_GLOBAL(stpqrt2,STPQRT2) +void LAPACK_stpqrt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_ztpqrt2 LAPACK_GLOBAL(ztpqrt2,ZTPQRT2) +void LAPACK_ztpqrt2( + lapack_int const* m, lapack_int const* n, lapack_int const* l, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* T, lapack_int const* ldt, + lapack_int* info ); + +#define LAPACK_ctprfb LAPACK_GLOBAL(ctprfb,CTPRFB) +void LAPACK_ctprfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_float const* V, lapack_int const* ldv, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_complex_float* work, lapack_int const* ldwork ); + +#define LAPACK_dtprfb LAPACK_GLOBAL(dtprfb,DTPRFB) +void LAPACK_dtprfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + double const* V, lapack_int const* ldv, + double const* T, lapack_int const* ldt, + double* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + double* work, lapack_int const* ldwork ); + +#define LAPACK_stprfb LAPACK_GLOBAL(stprfb,STPRFB) +void LAPACK_stprfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + float const* V, lapack_int const* ldv, + float const* T, lapack_int const* ldt, + float* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + float* work, lapack_int const* ldwork ); + +#define LAPACK_ztprfb LAPACK_GLOBAL(ztprfb,ZTPRFB) +void LAPACK_ztprfb( + char const* side, char const* trans, char const* direct, char const* storev, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_double const* V, lapack_int const* ldv, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_complex_double* work, lapack_int const* ldwork ); + +#define LAPACK_ctprfs LAPACK_GLOBAL(ctprfs,CTPRFS) +void LAPACK_ctprfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtprfs LAPACK_GLOBAL(dtprfs,DTPRFS) +void LAPACK_dtprfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double const* B, lapack_int const* ldb, + double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_stprfs LAPACK_GLOBAL(stprfs,STPRFS) +void LAPACK_stprfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float const* B, lapack_int const* ldb, + float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztprfs LAPACK_GLOBAL(ztprfs,ZTPRFS) +void LAPACK_ztprfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctptri LAPACK_GLOBAL(ctptri,CTPTRI) +void LAPACK_ctptri( + char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float* AP, + lapack_int* info ); + +#define LAPACK_dtptri LAPACK_GLOBAL(dtptri,DTPTRI) +void LAPACK_dtptri( + char const* uplo, char const* diag, + lapack_int const* n, + double* AP, + lapack_int* info ); + +#define LAPACK_stptri LAPACK_GLOBAL(stptri,STPTRI) +void LAPACK_stptri( + char const* uplo, char const* diag, + lapack_int const* n, + float* AP, + lapack_int* info ); + +#define LAPACK_ztptri LAPACK_GLOBAL(ztptri,ZTPTRI) +void LAPACK_ztptri( + char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double* AP, + lapack_int* info ); + +#define LAPACK_ctptrs LAPACK_GLOBAL(ctptrs,CTPTRS) +void LAPACK_ctptrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* AP, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dtptrs LAPACK_GLOBAL(dtptrs,DTPTRS) +void LAPACK_dtptrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + double const* AP, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_stptrs LAPACK_GLOBAL(stptrs,STPTRS) +void LAPACK_stptrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + float const* AP, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ztptrs LAPACK_GLOBAL(ztptrs,ZTPTRS) +void LAPACK_ztptrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* AP, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ctpttf LAPACK_GLOBAL(ctpttf,CTPTTF) +void LAPACK_ctpttf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + lapack_complex_float* ARF, + lapack_int* info ); + +#define LAPACK_dtpttf LAPACK_GLOBAL(dtpttf,DTPTTF) +void LAPACK_dtpttf( + char const* transr, char const* uplo, + lapack_int const* n, + double const* AP, + double* ARF, + lapack_int* info ); + +#define LAPACK_stpttf LAPACK_GLOBAL(stpttf,STPTTF) +void LAPACK_stpttf( + char const* transr, char const* uplo, + lapack_int const* n, + float const* AP, + float* ARF, + lapack_int* info ); + +#define LAPACK_ztpttf LAPACK_GLOBAL(ztpttf,ZTPTTF) +void LAPACK_ztpttf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + lapack_complex_double* ARF, + lapack_int* info ); + +#define LAPACK_ctpttr LAPACK_GLOBAL(ctpttr,CTPTTR) +void LAPACK_ctpttr( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dtpttr LAPACK_GLOBAL(dtpttr,DTPTTR) +void LAPACK_dtpttr( + char const* uplo, + lapack_int const* n, + double const* AP, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_stpttr LAPACK_GLOBAL(stpttr,STPTTR) +void LAPACK_stpttr( + char const* uplo, + lapack_int const* n, + float const* AP, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ztpttr LAPACK_GLOBAL(ztpttr,ZTPTTR) +void LAPACK_ztpttr( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ctrcon LAPACK_GLOBAL(ctrcon,CTRCON) +void LAPACK_ctrcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + float* rcond, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtrcon LAPACK_GLOBAL(dtrcon,DTRCON) +void LAPACK_dtrcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* rcond, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_strcon LAPACK_GLOBAL(strcon,STRCON) +void LAPACK_strcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* rcond, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztrcon LAPACK_GLOBAL(ztrcon,ZTRCON) +void LAPACK_ztrcon( + char const* norm, char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + double* rcond, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctrevc LAPACK_GLOBAL(ctrevc,CTREVC) +void LAPACK_ctrevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtrevc LAPACK_GLOBAL(dtrevc,DTREVC) +void LAPACK_dtrevc( + char const* side, char const* howmny, + lapack_logical* select, + lapack_int const* n, + double const* T, lapack_int const* ldt, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + double* work, + lapack_int* info ); + +#define LAPACK_strevc LAPACK_GLOBAL(strevc,STREVC) +void LAPACK_strevc( + char const* side, char const* howmny, + lapack_logical* select, + lapack_int const* n, + float const* T, lapack_int const* ldt, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + float* work, + lapack_int* info ); + +#define LAPACK_ztrevc LAPACK_GLOBAL(ztrevc,ZTREVC) +void LAPACK_ztrevc( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctrevc3 LAPACK_GLOBAL(ctrevc3,CTREVC3) +void LAPACK_ctrevc3( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* VL, lapack_int const* ldvl, + lapack_complex_float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_dtrevc3 LAPACK_GLOBAL(dtrevc3,DTREVC3) +void LAPACK_dtrevc3( + char const* side, char const* howmny, + lapack_logical* select, + lapack_int const* n, + double const* T, lapack_int const* ldt, + double* VL, lapack_int const* ldvl, + double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_strevc3 LAPACK_GLOBAL(strevc3,STREVC3) +void LAPACK_strevc3( + char const* side, char const* howmny, + lapack_logical* select, + lapack_int const* n, + float const* T, lapack_int const* ldt, + float* VL, lapack_int const* ldvl, + float* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ztrevc3 LAPACK_GLOBAL(ztrevc3,ZTREVC3) +void LAPACK_ztrevc3( + char const* side, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* VL, lapack_int const* ldvl, + lapack_complex_double* VR, lapack_int const* ldvr, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* info ); + +#define LAPACK_ctrexc LAPACK_GLOBAL(ctrexc,CTREXC) +void LAPACK_ctrexc( + char const* compq, + lapack_int const* n, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* Q, lapack_int const* ldq, lapack_int const* ifst, lapack_int const* ilst, + lapack_int* info ); + +#define LAPACK_dtrexc LAPACK_GLOBAL(dtrexc,DTREXC) +void LAPACK_dtrexc( + char const* compq, + lapack_int const* n, + double* T, lapack_int const* ldt, + double* Q, lapack_int const* ldq, lapack_int* ifst, lapack_int* ilst, + double* work, + lapack_int* info ); + +#define LAPACK_strexc LAPACK_GLOBAL(strexc,STREXC) +void LAPACK_strexc( + char const* compq, + lapack_int const* n, + float* T, lapack_int const* ldt, + float* Q, lapack_int const* ldq, lapack_int* ifst, lapack_int* ilst, + float* work, + lapack_int* info ); + +#define LAPACK_ztrexc LAPACK_GLOBAL(ztrexc,ZTREXC) +void LAPACK_ztrexc( + char const* compq, + lapack_int const* n, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* Q, lapack_int const* ldq, lapack_int const* ifst, lapack_int const* ilst, + lapack_int* info ); + +#define LAPACK_ctrrfs LAPACK_GLOBAL(ctrrfs,CTRRFS) +void LAPACK_ctrrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + lapack_complex_float* work, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtrrfs LAPACK_GLOBAL(dtrrfs,DTRRFS) +void LAPACK_dtrrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + double* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_strrfs LAPACK_GLOBAL(strrfs,STRRFS) +void LAPACK_strrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + float const* X, lapack_int const* ldx, + float* ferr, + float* berr, + float* work, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztrrfs LAPACK_GLOBAL(ztrrfs,ZTRRFS) +void LAPACK_ztrrfs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double const* X, lapack_int const* ldx, + double* ferr, + double* berr, + lapack_complex_double* work, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctrsen LAPACK_GLOBAL(ctrsen,CTRSEN) +void LAPACK_ctrsen( + char const* job, char const* compq, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float* T, lapack_int const* ldt, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* W, lapack_int* m, + float* s, + float* sep, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dtrsen LAPACK_GLOBAL(dtrsen,DTRSEN) +void LAPACK_dtrsen( + char const* job, char const* compq, + lapack_logical const* select, + lapack_int const* n, + double* T, lapack_int const* ldt, + double* Q, lapack_int const* ldq, + double* WR, + double* WI, lapack_int* m, + double* s, + double* sep, + double* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_strsen LAPACK_GLOBAL(strsen,STRSEN) +void LAPACK_strsen( + char const* job, char const* compq, + lapack_logical const* select, + lapack_int const* n, + float* T, lapack_int const* ldt, + float* Q, lapack_int const* ldq, + float* WR, + float* WI, lapack_int* m, + float* s, + float* sep, + float* work, lapack_int const* lwork, + lapack_int* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_ztrsen LAPACK_GLOBAL(ztrsen,ZTRSEN) +void LAPACK_ztrsen( + char const* job, char const* compq, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double* T, lapack_int const* ldt, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* W, lapack_int* m, + double* s, + double* sep, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ctrsna LAPACK_GLOBAL(ctrsna,CTRSNA) +void LAPACK_ctrsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_float const* T, lapack_int const* ldt, + lapack_complex_float const* VL, lapack_int const* ldvl, + lapack_complex_float const* VR, lapack_int const* ldvr, + float* S, + float* SEP, lapack_int const* mm, lapack_int* m, + lapack_complex_float* work, lapack_int const* ldwork, + float* rwork, + lapack_int* info ); + +#define LAPACK_dtrsna LAPACK_GLOBAL(dtrsna,DTRSNA) +void LAPACK_dtrsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + double const* T, lapack_int const* ldt, + double const* VL, lapack_int const* ldvl, + double const* VR, lapack_int const* ldvr, + double* S, + double* SEP, lapack_int const* mm, lapack_int* m, + double* work, lapack_int const* ldwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_strsna LAPACK_GLOBAL(strsna,STRSNA) +void LAPACK_strsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + float const* T, lapack_int const* ldt, + float const* VL, lapack_int const* ldvl, + float const* VR, lapack_int const* ldvr, + float* S, + float* SEP, lapack_int const* mm, lapack_int* m, + float* work, lapack_int const* ldwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_ztrsna LAPACK_GLOBAL(ztrsna,ZTRSNA) +void LAPACK_ztrsna( + char const* job, char const* howmny, + lapack_logical const* select, + lapack_int const* n, + lapack_complex_double const* T, lapack_int const* ldt, + lapack_complex_double const* VL, lapack_int const* ldvl, + lapack_complex_double const* VR, lapack_int const* ldvr, + double* S, + double* SEP, lapack_int const* mm, lapack_int* m, + lapack_complex_double* work, lapack_int const* ldwork, + double* rwork, + lapack_int* info ); + +#define LAPACK_ctrsyl LAPACK_GLOBAL(ctrsyl,CTRSYL) +void LAPACK_ctrsyl( + char const* trana, char const* tranb, + lapack_int const* isgn, lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* B, lapack_int const* ldb, + lapack_complex_float* C, lapack_int const* ldc, + float* scale, + lapack_int* info ); + +#define LAPACK_dtrsyl LAPACK_GLOBAL(dtrsyl,DTRSYL) +void LAPACK_dtrsyl( + char const* trana, char const* tranb, + lapack_int const* isgn, lapack_int const* m, lapack_int const* n, + double const* A, lapack_int const* lda, + double const* B, lapack_int const* ldb, + double* C, lapack_int const* ldc, + double* scale, + lapack_int* info ); + +#define LAPACK_strsyl LAPACK_GLOBAL(strsyl,STRSYL) +void LAPACK_strsyl( + char const* trana, char const* tranb, + lapack_int const* isgn, lapack_int const* m, lapack_int const* n, + float const* A, lapack_int const* lda, + float const* B, lapack_int const* ldb, + float* C, lapack_int const* ldc, + float* scale, + lapack_int* info ); + +#define LAPACK_ztrsyl LAPACK_GLOBAL(ztrsyl,ZTRSYL) +void LAPACK_ztrsyl( + char const* trana, char const* tranb, + lapack_int const* isgn, lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* B, lapack_int const* ldb, + lapack_complex_double* C, lapack_int const* ldc, + double* scale, + lapack_int* info ); + +#define LAPACK_ctrtri LAPACK_GLOBAL(ctrtri,CTRTRI) +void LAPACK_ctrtri( + char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_dtrtri LAPACK_GLOBAL(dtrtri,DTRTRI) +void LAPACK_dtrtri( + char const* uplo, char const* diag, + lapack_int const* n, + double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_strtri LAPACK_GLOBAL(strtri,STRTRI) +void LAPACK_strtri( + char const* uplo, char const* diag, + lapack_int const* n, + float* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ztrtri LAPACK_GLOBAL(ztrtri,ZTRTRI) +void LAPACK_ztrtri( + char const* uplo, char const* diag, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_int* info ); + +#define LAPACK_ctrtrs LAPACK_GLOBAL(ctrtrs,CTRTRS) +void LAPACK_ctrtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_dtrtrs LAPACK_GLOBAL(dtrtrs,DTRTRS) +void LAPACK_dtrtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + double const* A, lapack_int const* lda, + double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_strtrs LAPACK_GLOBAL(strtrs,STRTRS) +void LAPACK_strtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + float const* A, lapack_int const* lda, + float* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ztrtrs LAPACK_GLOBAL(ztrtrs,ZTRTRS) +void LAPACK_ztrtrs( + char const* uplo, char const* trans, char const* diag, + lapack_int const* n, lapack_int const* nrhs, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* B, lapack_int const* ldb, + lapack_int* info ); + +#define LAPACK_ctrttf LAPACK_GLOBAL(ctrttf,CTRTTF) +void LAPACK_ctrttf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* ARF, + lapack_int* info ); + +#define LAPACK_dtrttf LAPACK_GLOBAL(dtrttf,DTRTTF) +void LAPACK_dtrttf( + char const* transr, char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* ARF, + lapack_int* info ); + +#define LAPACK_strttf LAPACK_GLOBAL(strttf,STRTTF) +void LAPACK_strttf( + char const* transr, char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* ARF, + lapack_int* info ); + +#define LAPACK_ztrttf LAPACK_GLOBAL(ztrttf,ZTRTTF) +void LAPACK_ztrttf( + char const* transr, char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* ARF, + lapack_int* info ); + +#define LAPACK_ctrttp LAPACK_GLOBAL(ctrttp,CTRTTP) +void LAPACK_ctrttp( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float* AP, + lapack_int* info ); + +#define LAPACK_dtrttp LAPACK_GLOBAL(dtrttp,DTRTTP) +void LAPACK_dtrttp( + char const* uplo, + lapack_int const* n, + double const* A, lapack_int const* lda, + double* AP, + lapack_int* info ); + +#define LAPACK_strttp LAPACK_GLOBAL(strttp,STRTTP) +void LAPACK_strttp( + char const* uplo, + lapack_int const* n, + float const* A, lapack_int const* lda, + float* AP, + lapack_int* info ); + +#define LAPACK_ztrttp LAPACK_GLOBAL(ztrttp,ZTRTTP) +void LAPACK_ztrttp( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double* AP, + lapack_int* info ); + +#define LAPACK_ctzrzf LAPACK_GLOBAL(ctzrzf,CTZRZF) +void LAPACK_ctzrzf( + lapack_int const* m, lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_dtzrzf LAPACK_GLOBAL(dtzrzf,DTZRZF) +void LAPACK_dtzrzf( + lapack_int const* m, lapack_int const* n, + double* A, lapack_int const* lda, + double* tau, + double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_stzrzf LAPACK_GLOBAL(stzrzf,STZRZF) +void LAPACK_stzrzf( + lapack_int const* m, lapack_int const* n, + float* A, lapack_int const* lda, + float* tau, + float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_ztzrzf LAPACK_GLOBAL(ztzrzf,ZTZRZF) +void LAPACK_ztzrzf( + lapack_int const* m, lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunbdb LAPACK_GLOBAL(cunbdb,CUNBDB) +void LAPACK_cunbdb( + char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_float* X11, lapack_int const* ldx11, + lapack_complex_float* X12, lapack_int const* ldx12, + lapack_complex_float* X21, lapack_int const* ldx21, + lapack_complex_float* X22, lapack_int const* ldx22, + float* theta, + float* phi, + lapack_complex_float* TAUP1, + lapack_complex_float* TAUP2, + lapack_complex_float* TAUQ1, + lapack_complex_float* TAUQ2, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunbdb LAPACK_GLOBAL(zunbdb,ZUNBDB) +void LAPACK_zunbdb( + char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_double* X11, lapack_int const* ldx11, + lapack_complex_double* X12, lapack_int const* ldx12, + lapack_complex_double* X21, lapack_int const* ldx21, + lapack_complex_double* X22, lapack_int const* ldx22, + double* theta, + double* phi, + lapack_complex_double* TAUP1, + lapack_complex_double* TAUP2, + lapack_complex_double* TAUQ1, + lapack_complex_double* TAUQ2, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cuncsd LAPACK_GLOBAL(cuncsd,CUNCSD) +void LAPACK_cuncsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_float* X11, lapack_int const* ldx11, + lapack_complex_float* X12, lapack_int const* ldx12, + lapack_complex_float* X21, lapack_int const* ldx21, + lapack_complex_float* X22, lapack_int const* ldx22, + float* theta, + lapack_complex_float* U1, lapack_int const* ldu1, + lapack_complex_float* U2, lapack_int const* ldu2, + lapack_complex_float* V1T, lapack_int const* ldv1t, + lapack_complex_float* V2T, lapack_int const* ldv2t, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zuncsd LAPACK_GLOBAL(zuncsd,ZUNCSD) +void LAPACK_zuncsd( + char const* jobu1, char const* jobu2, char const* jobv1t, char const* jobv2t, char const* trans, char const* signs, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_double* X11, lapack_int const* ldx11, + lapack_complex_double* X12, lapack_int const* ldx12, + lapack_complex_double* X21, lapack_int const* ldx21, + lapack_complex_double* X22, lapack_int const* ldx22, + double* theta, + lapack_complex_double* U1, lapack_int const* ldu1, + lapack_complex_double* U2, lapack_int const* ldu2, + lapack_complex_double* V1T, lapack_int const* ldv1t, + lapack_complex_double* V2T, lapack_int const* ldv2t, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cuncsd2by1 LAPACK_GLOBAL(cuncsd2by1,CUNCSD2BY1) +void LAPACK_cuncsd2by1( + char const* jobu1, char const* jobu2, char const* jobv1t, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_float* X11, lapack_int const* ldx11, + lapack_complex_float* X21, lapack_int const* ldx21, + float* theta, + lapack_complex_float* U1, lapack_int const* ldu1, + lapack_complex_float* U2, lapack_int const* ldu2, + lapack_complex_float* V1T, lapack_int const* ldv1t, + lapack_complex_float* work, lapack_int const* lwork, + float* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_zuncsd2by1 LAPACK_GLOBAL(zuncsd2by1,ZUNCSD2BY1) +void LAPACK_zuncsd2by1( + char const* jobu1, char const* jobu2, char const* jobv1t, + lapack_int const* m, lapack_int const* p, lapack_int const* q, + lapack_complex_double* X11, lapack_int const* ldx11, + lapack_complex_double* X21, lapack_int const* ldx21, + double* theta, + lapack_complex_double* U1, lapack_int const* ldu1, + lapack_complex_double* U2, lapack_int const* ldu2, + lapack_complex_double* V1T, lapack_int const* ldv1t, + lapack_complex_double* work, lapack_int const* lwork, + double* rwork, lapack_int const* lrwork, + lapack_int* iwork, + lapack_int* info ); + +#define LAPACK_cungbr LAPACK_GLOBAL(cungbr,CUNGBR) +void LAPACK_cungbr( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zungbr LAPACK_GLOBAL(zungbr,ZUNGBR) +void LAPACK_zungbr( + char const* vect, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunghr LAPACK_GLOBAL(cunghr,CUNGHR) +void LAPACK_cunghr( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunghr LAPACK_GLOBAL(zunghr,ZUNGHR) +void LAPACK_zunghr( + lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunglq LAPACK_GLOBAL(cunglq,CUNGLQ) +void LAPACK_cunglq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunglq LAPACK_GLOBAL(zunglq,ZUNGLQ) +void LAPACK_zunglq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cungql LAPACK_GLOBAL(cungql,CUNGQL) +void LAPACK_cungql( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zungql LAPACK_GLOBAL(zungql,ZUNGQL) +void LAPACK_zungql( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cungqr LAPACK_GLOBAL(cungqr,CUNGQR) +void LAPACK_cungqr( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zungqr LAPACK_GLOBAL(zungqr,ZUNGQR) +void LAPACK_zungqr( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cungrq LAPACK_GLOBAL(cungrq,CUNGRQ) +void LAPACK_cungrq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zungrq LAPACK_GLOBAL(zungrq,ZUNGRQ) +void LAPACK_zungrq( + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cungtr LAPACK_GLOBAL(cungtr,CUNGTR) +void LAPACK_cungtr( + char const* uplo, + lapack_int const* n, + lapack_complex_float* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zungtr LAPACK_GLOBAL(zungtr,ZUNGTR) +void LAPACK_zungtr( + char const* uplo, + lapack_int const* n, + lapack_complex_double* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmbr LAPACK_GLOBAL(cunmbr,CUNMBR) +void LAPACK_cunmbr( + char const* vect, char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmbr LAPACK_GLOBAL(zunmbr,ZUNMBR) +void LAPACK_zunmbr( + char const* vect, char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmhr LAPACK_GLOBAL(cunmhr,CUNMHR) +void LAPACK_cunmhr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmhr LAPACK_GLOBAL(zunmhr,ZUNMHR) +void LAPACK_zunmhr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* ilo, lapack_int const* ihi, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmlq LAPACK_GLOBAL(cunmlq,CUNMLQ) +void LAPACK_cunmlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmlq LAPACK_GLOBAL(zunmlq,ZUNMLQ) +void LAPACK_zunmlq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmql LAPACK_GLOBAL(cunmql,CUNMQL) +void LAPACK_cunmql( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmql LAPACK_GLOBAL(zunmql,ZUNMQL) +void LAPACK_zunmql( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmqr LAPACK_GLOBAL(cunmqr,CUNMQR) +void LAPACK_cunmqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmqr LAPACK_GLOBAL(zunmqr,ZUNMQR) +void LAPACK_zunmqr( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmrq LAPACK_GLOBAL(cunmrq,CUNMRQ) +void LAPACK_cunmrq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmrq LAPACK_GLOBAL(zunmrq,ZUNMRQ) +void LAPACK_zunmrq( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmrz LAPACK_GLOBAL(cunmrz,CUNMRZ) +void LAPACK_cunmrz( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmrz LAPACK_GLOBAL(zunmrz,ZUNMRZ) +void LAPACK_zunmrz( + char const* side, char const* trans, + lapack_int const* m, lapack_int const* n, lapack_int const* k, lapack_int const* l, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cunmtr LAPACK_GLOBAL(cunmtr,CUNMTR) +void LAPACK_cunmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* A, lapack_int const* lda, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_zunmtr LAPACK_GLOBAL(zunmtr,ZUNMTR) +void LAPACK_zunmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* A, lapack_int const* lda, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, lapack_int const* lwork, + lapack_int* info ); + +#define LAPACK_cupgtr LAPACK_GLOBAL(cupgtr,CUPGTR) +void LAPACK_cupgtr( + char const* uplo, + lapack_int const* n, + lapack_complex_float const* AP, + lapack_complex_float const* tau, + lapack_complex_float* Q, lapack_int const* ldq, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zupgtr LAPACK_GLOBAL(zupgtr,ZUPGTR) +void LAPACK_zupgtr( + char const* uplo, + lapack_int const* n, + lapack_complex_double const* AP, + lapack_complex_double const* tau, + lapack_complex_double* Q, lapack_int const* ldq, + lapack_complex_double* work, + lapack_int* info ); + +#define LAPACK_cupmtr LAPACK_GLOBAL(cupmtr,CUPMTR) +void LAPACK_cupmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + lapack_complex_float const* AP, + lapack_complex_float const* tau, + lapack_complex_float* C, lapack_int const* ldc, + lapack_complex_float* work, + lapack_int* info ); + +#define LAPACK_zupmtr LAPACK_GLOBAL(zupmtr,ZUPMTR) +void LAPACK_zupmtr( + char const* side, char const* uplo, char const* trans, + lapack_int const* m, lapack_int const* n, + lapack_complex_double const* AP, + lapack_complex_double const* tau, + lapack_complex_double* C, lapack_int const* ldc, + lapack_complex_double* work, + lapack_int* info ); + +#ifdef __cplusplus +} /* extern "C" */ +#endif + +#endif /* LAPACK_H */ diff --git a/lapack-netlib/LAPACKE/include/lapacke.h b/lapack-netlib/LAPACKE/include/lapacke.h index c5ea465e0..6eb0b696b 100644 --- a/lapack-netlib/LAPACKE/include/lapacke.h +++ b/lapack-netlib/LAPACKE/include/lapacke.h @@ -34,81 +34,7 @@ #ifndef _LAPACKE_H_ #define _LAPACKE_H_ -/* -* Turn on HAVE_LAPACK_CONFIG_H to redefine C-LAPACK datatypes -*/ -#ifdef HAVE_LAPACK_CONFIG_H -#include "lapacke_config.h" -#endif - -#include - -#ifndef lapack_int -#define lapack_int int -#endif - -#ifndef lapack_logical -#define lapack_logical lapack_int -#endif - -/* Complex types are structures equivalent to the -* Fortran complex types COMPLEX(4) and COMPLEX(8). -* -* One can also redefine the types with his own types -* for example by including in the code definitions like -* -* #define lapack_complex_float std::complex -* #define lapack_complex_double std::complex -* -* or define these types in the command line: -* -* -Dlapack_complex_float="std::complex" -* -Dlapack_complex_double="std::complex" -*/ - -#ifndef LAPACK_COMPLEX_CUSTOM - -/* Complex type (single precision) */ -#ifndef lapack_complex_float -#ifndef __cplusplus -#include -#else -#include -#endif -#define lapack_complex_float float _Complex -#endif - -#ifndef lapack_complex_float_real -#define lapack_complex_float_real(z) (creal(z)) -#endif - -#ifndef lapack_complex_float_imag -#define lapack_complex_float_imag(z) (cimag(z)) -#endif - -lapack_complex_float lapack_make_complex_float( float re, float im ); - -/* Complex type (double precision) */ -#ifndef lapack_complex_double -#ifndef __cplusplus -#include -#else -#include -#endif -#define lapack_complex_double double _Complex -#endif - -#ifndef lapack_complex_double_real -#define lapack_complex_double_real(z) (creal(z)) -#endif - -#ifndef lapack_complex_double_imag -#define lapack_complex_double_imag(z) (cimag(z)) -#endif - -lapack_complex_double lapack_make_complex_double( double re, double im ); - -#endif +#include "lapack.h" #ifdef __cplusplus extern "C" { @@ -130,29 +56,8 @@ extern "C" { #define LAPACK_WORK_MEMORY_ERROR -1010 #define LAPACK_TRANSPOSE_MEMORY_ERROR -1011 -/* Callback logical functions of one, two, or three arguments are used -* to select eigenvalues to sort to the top left of the Schur form. -* The value is selected if function returns TRUE (non-zero). */ - -typedef lapack_logical (*LAPACK_S_SELECT2) ( const float*, const float* ); -typedef lapack_logical (*LAPACK_S_SELECT3) - ( const float*, const float*, const float* ); -typedef lapack_logical (*LAPACK_D_SELECT2) ( const double*, const double* ); -typedef lapack_logical (*LAPACK_D_SELECT3) - ( const double*, const double*, const double* ); - -typedef lapack_logical (*LAPACK_C_SELECT1) ( const lapack_complex_float* ); -typedef lapack_logical (*LAPACK_C_SELECT2) - ( const lapack_complex_float*, const lapack_complex_float* ); -typedef lapack_logical (*LAPACK_Z_SELECT1) ( const lapack_complex_double* ); -typedef lapack_logical (*LAPACK_Z_SELECT2) - ( const lapack_complex_double*, const lapack_complex_double* ); - -#include "lapacke_mangling.h" - -#define LAPACK_lsame LAPACK_GLOBAL(lsame,LSAME) -lapack_logical LAPACK_lsame( char* ca, char* cb, - lapack_int lca, lapack_int lcb ); +lapack_complex_float lapack_make_complex_float( float re, float im ); +lapack_complex_double lapack_make_complex_double( double re, double im ); /* C-LAPACK function prototypes */ @@ -1034,6 +939,25 @@ lapack_int LAPACKE_zgesvdx( int matrix_layout, char jobu, char jobvt, char range lapack_complex_double* vt, lapack_int ldvt, lapack_int* superb ); +lapack_int LAPACKE_sgesvdq( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, float* a, lapack_int lda, + float* s, float* u, lapack_int ldu, float* v, + lapack_int ldv, lapack_int* numrank ); +lapack_int LAPACKE_dgesvdq( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, double* a, + lapack_int lda, double* s, double* u, lapack_int ldu, + double* v, lapack_int ldv, lapack_int* numrank); +lapack_int LAPACKE_cgesvdq( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda, float* s, lapack_complex_float* u, + lapack_int ldu, lapack_complex_float* v, + lapack_int ldv, lapack_int* numrank ); +lapack_int LAPACKE_zgesvdq( int matrix_layout, char joba, char jobp, char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda, double* s, lapack_complex_double* u, + lapack_int ldu, lapack_complex_double* v, + lapack_int ldv, lapack_int* numrank ); + lapack_int LAPACKE_sgesvj( int matrix_layout, char joba, char jobu, char jobv, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, lapack_int mv, float* v, lapack_int ldv, @@ -1943,11 +1867,11 @@ lapack_int LAPACKE_zheevx( int matrix_layout, char jobz, char range, char uplo, lapack_int LAPACKE_chegst( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, - lapack_int lda, const lapack_complex_float* b, + lapack_int lda, lapack_complex_float* b, lapack_int ldb ); lapack_int LAPACKE_zhegst( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ); lapack_int LAPACKE_chegv( int matrix_layout, lapack_int itype, char jobz, @@ -5824,6 +5748,45 @@ lapack_int LAPACKE_zgesvdx_work( int matrix_layout, char jobu, char jobvt, char lapack_complex_double* work, lapack_int lwork, double* rwork, lapack_int* iwork ); +lapack_int LAPACKE_sgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, float* a, + lapack_int lda, float* s, float* u, + lapack_int ldu, float* v, lapack_int ldv, + lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + float* work, lapack_int lwork, + float* rwork, lapack_int lrwork); +lapack_int LAPACKE_dgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, double* a, + lapack_int lda, double* s, double* u, + lapack_int ldu, double* v, lapack_int ldv, + lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + double* work, lapack_int lwork, + double* rwork, lapack_int lrwork); +lapack_int LAPACKE_cgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + float* s, lapack_complex_float* u, + lapack_int ldu, lapack_complex_float* v, + lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + lapack_complex_float* cwork, lapack_int lcwork, + float* rwork, lapack_int lrwork); +lapack_int LAPACKE_zgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + double* s, lapack_complex_double* u, + lapack_int ldu, lapack_complex_double* v, + lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + lapack_complex_double* cwork, lapack_int lcwork, + double* rwork, lapack_int lrwork); + lapack_int LAPACKE_sgesvj_work( int matrix_layout, char joba, char jobu, char jobv, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, lapack_int mv, @@ -6969,11 +6932,11 @@ lapack_int LAPACKE_zheevx_work( int matrix_layout, char jobz, char range, lapack_int LAPACKE_chegst_work( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, - lapack_int lda, const lapack_complex_float* b, + lapack_int lda, lapack_complex_float* b, lapack_int ldb ); lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ); lapack_int LAPACKE_chegv_work( int matrix_layout, lapack_int itype, char jobz, @@ -10590,11 +10553,11 @@ lapack_int LAPACKE_csytri2x_work( int matrix_layout, char uplo, lapack_int n, const lapack_int* ipiv, lapack_complex_float* work, lapack_int nb ); lapack_int LAPACKE_csytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_float* a, + lapack_int nrhs, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ); lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_float* a, + lapack_int nrhs, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* work ); @@ -10755,10 +10718,10 @@ lapack_int LAPACKE_dsytri2x_work( int matrix_layout, char uplo, lapack_int n, const lapack_int* ipiv, double* work, lapack_int nb ); lapack_int LAPACKE_dsytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const double* a, lapack_int lda, + lapack_int nrhs, double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ); lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const double* a, + lapack_int nrhs, double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb, double* work ); lapack_int LAPACKE_sbbcsd( int matrix_layout, char jobu1, char jobu2, @@ -10850,10 +10813,10 @@ lapack_int LAPACKE_ssytri2x_work( int matrix_layout, char uplo, lapack_int n, const lapack_int* ipiv, float* work, lapack_int nb ); lapack_int LAPACKE_ssytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const float* a, lapack_int lda, + lapack_int nrhs, float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ); lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const float* a, + lapack_int nrhs, float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb, float* work ); lapack_int LAPACKE_zbbcsd( int matrix_layout, char jobu1, char jobu2, @@ -10935,11 +10898,11 @@ lapack_int LAPACKE_zsytri2x_work( int matrix_layout, char uplo, lapack_int n, const lapack_int* ipiv, lapack_complex_double* work, lapack_int nb ); lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_double* a, + lapack_int nrhs, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ); lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_double* a, + lapack_int nrhs, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* work ); @@ -12609,6848 +12572,6 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ); - -#define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) -#define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF) -#define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF) -#define LAPACK_zgetrf LAPACK_GLOBAL(zgetrf,ZGETRF) -#define LAPACK_sgetrf2 LAPACK_GLOBAL(sgetrf2,SGETRF2) -#define LAPACK_dgetrf2 LAPACK_GLOBAL(dgetrf2,DGETRF2) -#define LAPACK_cgetrf2 LAPACK_GLOBAL(cgetrf2,CGETRF2) -#define LAPACK_zgetrf2 LAPACK_GLOBAL(zgetrf2,ZGETRF2) -#define LAPACK_sgbtrf LAPACK_GLOBAL(sgbtrf,SGBTRF) -#define LAPACK_dgbtrf LAPACK_GLOBAL(dgbtrf,DGBTRF) -#define LAPACK_cgbtrf LAPACK_GLOBAL(cgbtrf,CGBTRF) -#define LAPACK_zgbtrf LAPACK_GLOBAL(zgbtrf,ZGBTRF) -#define LAPACK_sgttrf LAPACK_GLOBAL(sgttrf,SGTTRF) -#define LAPACK_dgttrf LAPACK_GLOBAL(dgttrf,DGTTRF) -#define LAPACK_cgttrf LAPACK_GLOBAL(cgttrf,CGTTRF) -#define LAPACK_zgttrf LAPACK_GLOBAL(zgttrf,ZGTTRF) -#define LAPACK_spotrf LAPACK_GLOBAL(spotrf,SPOTRF) -#define LAPACK_dpotrf LAPACK_GLOBAL(dpotrf,DPOTRF) -#define LAPACK_cpotrf LAPACK_GLOBAL(cpotrf,CPOTRF) -#define LAPACK_zpotrf LAPACK_GLOBAL(zpotrf,ZPOTRF) -#define LAPACK_spotrf2 LAPACK_GLOBAL(spotrf2,SPOTRF2) -#define LAPACK_dpotrf2 LAPACK_GLOBAL(dpotrf2,DPOTRF2) -#define LAPACK_cpotrf2 LAPACK_GLOBAL(cpotrf2,CPOTRF2) -#define LAPACK_zpotrf2 LAPACK_GLOBAL(zpotrf2,ZPOTRF2) -#define LAPACK_dpstrf LAPACK_GLOBAL(dpstrf,DPSTRF) -#define LAPACK_spstrf LAPACK_GLOBAL(spstrf,SPSTRF) -#define LAPACK_zpstrf LAPACK_GLOBAL(zpstrf,ZPSTRF) -#define LAPACK_cpstrf LAPACK_GLOBAL(cpstrf,CPSTRF) -#define LAPACK_dpftrf LAPACK_GLOBAL(dpftrf,DPFTRF) -#define LAPACK_spftrf LAPACK_GLOBAL(spftrf,SPFTRF) -#define LAPACK_zpftrf LAPACK_GLOBAL(zpftrf,ZPFTRF) -#define LAPACK_cpftrf LAPACK_GLOBAL(cpftrf,CPFTRF) -#define LAPACK_spptrf LAPACK_GLOBAL(spptrf,SPPTRF) -#define LAPACK_dpptrf LAPACK_GLOBAL(dpptrf,DPPTRF) -#define LAPACK_cpptrf LAPACK_GLOBAL(cpptrf,CPPTRF) -#define LAPACK_zpptrf LAPACK_GLOBAL(zpptrf,ZPPTRF) -#define LAPACK_spbtrf LAPACK_GLOBAL(spbtrf,SPBTRF) -#define LAPACK_dpbtrf LAPACK_GLOBAL(dpbtrf,DPBTRF) -#define LAPACK_cpbtrf LAPACK_GLOBAL(cpbtrf,CPBTRF) -#define LAPACK_zpbtrf LAPACK_GLOBAL(zpbtrf,ZPBTRF) -#define LAPACK_spttrf LAPACK_GLOBAL(spttrf,SPTTRF) -#define LAPACK_dpttrf LAPACK_GLOBAL(dpttrf,DPTTRF) -#define LAPACK_cpttrf LAPACK_GLOBAL(cpttrf,CPTTRF) -#define LAPACK_zpttrf LAPACK_GLOBAL(zpttrf,ZPTTRF) -#define LAPACK_ssytrf LAPACK_GLOBAL(ssytrf,SSYTRF) -#define LAPACK_ssytrf_rook LAPACK_GLOBAL(ssytrf_rook,SSYTRF_ROOK) -#define LAPACK_dsytrf LAPACK_GLOBAL(dsytrf,DSYTRF) -#define LAPACK_dsytrf_rook LAPACK_GLOBAL(dsytrf_rook,DSYTRF_ROOK) -#define LAPACK_csytrf LAPACK_GLOBAL(csytrf,CSYTRF) -#define LAPACK_csytrf_rook LAPACK_GLOBAL(csytrf_rook,CSYTRF_ROOK) -#define LAPACK_zsytrf LAPACK_GLOBAL(zsytrf,ZSYTRF) -#define LAPACK_zsytrf_rook LAPACK_GLOBAL(zsytrf_rook,ZSYTRF_ROOK) -#define LAPACK_chetrf LAPACK_GLOBAL(chetrf,CHETRF) -#define LAPACK_chetrf_rook LAPACK_GLOBAL(chetrf_rook,CHETRF_ROOK) -#define LAPACK_zhetrf LAPACK_GLOBAL(zhetrf,ZHETRF) -#define LAPACK_zhetrf_rook LAPACK_GLOBAL(zhetrf_rook,ZHETRF_ROOK) -#define LAPACK_ssptrf LAPACK_GLOBAL(ssptrf,SSPTRF) -#define LAPACK_dsptrf LAPACK_GLOBAL(dsptrf,DSPTRF) -#define LAPACK_csptrf LAPACK_GLOBAL(csptrf,CSPTRF) -#define LAPACK_zsptrf LAPACK_GLOBAL(zsptrf,ZSPTRF) -#define LAPACK_chptrf LAPACK_GLOBAL(chptrf,CHPTRF) -#define LAPACK_zhptrf LAPACK_GLOBAL(zhptrf,ZHPTRF) -#define LAPACK_sgetrs LAPACK_GLOBAL(sgetrs,SGETRS) -#define LAPACK_dgetrs LAPACK_GLOBAL(dgetrs,DGETRS) -#define LAPACK_cgetrs LAPACK_GLOBAL(cgetrs,CGETRS) -#define LAPACK_zgetrs LAPACK_GLOBAL(zgetrs,ZGETRS) -#define LAPACK_sgbtrs LAPACK_GLOBAL(sgbtrs,SGBTRS) -#define LAPACK_dgbtrs LAPACK_GLOBAL(dgbtrs,DGBTRS) -#define LAPACK_cgbtrs LAPACK_GLOBAL(cgbtrs,CGBTRS) -#define LAPACK_zgbtrs LAPACK_GLOBAL(zgbtrs,ZGBTRS) -#define LAPACK_sgttrs LAPACK_GLOBAL(sgttrs,SGTTRS) -#define LAPACK_dgttrs LAPACK_GLOBAL(dgttrs,DGTTRS) -#define LAPACK_cgttrs LAPACK_GLOBAL(cgttrs,CGTTRS) -#define LAPACK_zgttrs LAPACK_GLOBAL(zgttrs,ZGTTRS) -#define LAPACK_spotrs LAPACK_GLOBAL(spotrs,SPOTRS) -#define LAPACK_dpotrs LAPACK_GLOBAL(dpotrs,DPOTRS) -#define LAPACK_cpotrs LAPACK_GLOBAL(cpotrs,CPOTRS) -#define LAPACK_zpotrs LAPACK_GLOBAL(zpotrs,ZPOTRS) -#define LAPACK_dpftrs LAPACK_GLOBAL(dpftrs,DPFTRS) -#define LAPACK_spftrs LAPACK_GLOBAL(spftrs,SPFTRS) -#define LAPACK_zpftrs LAPACK_GLOBAL(zpftrs,ZPFTRS) -#define LAPACK_cpftrs LAPACK_GLOBAL(cpftrs,CPFTRS) -#define LAPACK_spptrs LAPACK_GLOBAL(spptrs,SPPTRS) -#define LAPACK_dpptrs LAPACK_GLOBAL(dpptrs,DPPTRS) -#define LAPACK_cpptrs LAPACK_GLOBAL(cpptrs,CPPTRS) -#define LAPACK_zpptrs LAPACK_GLOBAL(zpptrs,ZPPTRS) -#define LAPACK_spbtrs LAPACK_GLOBAL(spbtrs,SPBTRS) -#define LAPACK_dpbtrs LAPACK_GLOBAL(dpbtrs,DPBTRS) -#define LAPACK_cpbtrs LAPACK_GLOBAL(cpbtrs,CPBTRS) -#define LAPACK_zpbtrs LAPACK_GLOBAL(zpbtrs,ZPBTRS) -#define LAPACK_spttrs LAPACK_GLOBAL(spttrs,SPTTRS) -#define LAPACK_dpttrs LAPACK_GLOBAL(dpttrs,DPTTRS) -#define LAPACK_cpttrs LAPACK_GLOBAL(cpttrs,CPTTRS) -#define LAPACK_zpttrs LAPACK_GLOBAL(zpttrs,ZPTTRS) -#define LAPACK_ssytrs LAPACK_GLOBAL(ssytrs,SSYTRS) -#define LAPACK_ssytrs_rook LAPACK_GLOBAL(ssytrs_rook,SSYTRS_ROOK) -#define LAPACK_dsytrs LAPACK_GLOBAL(dsytrs,DSYTRS) -#define LAPACK_dsytrs_rook LAPACK_GLOBAL(dsytrs_rook,DSYTRS_ROOK) -#define LAPACK_csytrs LAPACK_GLOBAL(csytrs,CSYTRS) -#define LAPACK_csytrs_rook LAPACK_GLOBAL(csytrs_rook,CSYTRS_ROOK) -#define LAPACK_zsytrs LAPACK_GLOBAL(zsytrs,ZSYTRS) -#define LAPACK_zsytrs_rook LAPACK_GLOBAL(zsytrs_rook,ZSYTRS_ROOK) -#define LAPACK_chetrs LAPACK_GLOBAL(chetrs,CHETRS) -#define LAPACK_chetrs_rook LAPACK_GLOBAL(chetrs_rook,CHETRS_ROOK) -#define LAPACK_zhetrs LAPACK_GLOBAL(zhetrs,ZHETRS) -#define LAPACK_zhetrs_rook LAPACK_GLOBAL(zhetrs_rook,ZHETRS_ROOK) -#define LAPACK_ssptrs LAPACK_GLOBAL(ssptrs,SSPTRS) -#define LAPACK_dsptrs LAPACK_GLOBAL(dsptrs,DSPTRS) -#define LAPACK_csptrs LAPACK_GLOBAL(csptrs,CSPTRS) -#define LAPACK_zsptrs LAPACK_GLOBAL(zsptrs,ZSPTRS) -#define LAPACK_chptrs LAPACK_GLOBAL(chptrs,CHPTRS) -#define LAPACK_zhptrs LAPACK_GLOBAL(zhptrs,ZHPTRS) -#define LAPACK_strtrs LAPACK_GLOBAL(strtrs,STRTRS) -#define LAPACK_dtrtrs LAPACK_GLOBAL(dtrtrs,DTRTRS) -#define LAPACK_ctrtrs LAPACK_GLOBAL(ctrtrs,CTRTRS) -#define LAPACK_ztrtrs LAPACK_GLOBAL(ztrtrs,ZTRTRS) -#define LAPACK_stptrs LAPACK_GLOBAL(stptrs,STPTRS) -#define LAPACK_dtptrs LAPACK_GLOBAL(dtptrs,DTPTRS) -#define LAPACK_ctptrs LAPACK_GLOBAL(ctptrs,CTPTRS) -#define LAPACK_ztptrs LAPACK_GLOBAL(ztptrs,ZTPTRS) -#define LAPACK_stbtrs LAPACK_GLOBAL(stbtrs,STBTRS) -#define LAPACK_dtbtrs LAPACK_GLOBAL(dtbtrs,DTBTRS) -#define LAPACK_ctbtrs LAPACK_GLOBAL(ctbtrs,CTBTRS) -#define LAPACK_ztbtrs LAPACK_GLOBAL(ztbtrs,ZTBTRS) -#define LAPACK_sgecon LAPACK_GLOBAL(sgecon,SGECON) -#define LAPACK_dgecon LAPACK_GLOBAL(dgecon,DGECON) -#define LAPACK_cgecon LAPACK_GLOBAL(cgecon,CGECON) -#define LAPACK_zgecon LAPACK_GLOBAL(zgecon,ZGECON) -#define LAPACK_sgbcon LAPACK_GLOBAL(sgbcon,SGBCON) -#define LAPACK_dgbcon LAPACK_GLOBAL(dgbcon,DGBCON) -#define LAPACK_cgbcon LAPACK_GLOBAL(cgbcon,CGBCON) -#define LAPACK_zgbcon LAPACK_GLOBAL(zgbcon,ZGBCON) -#define LAPACK_sgtcon LAPACK_GLOBAL(sgtcon,SGTCON) -#define LAPACK_dgtcon LAPACK_GLOBAL(dgtcon,DGTCON) -#define LAPACK_cgtcon LAPACK_GLOBAL(cgtcon,CGTCON) -#define LAPACK_zgtcon LAPACK_GLOBAL(zgtcon,ZGTCON) -#define LAPACK_spocon LAPACK_GLOBAL(spocon,SPOCON) -#define LAPACK_dpocon LAPACK_GLOBAL(dpocon,DPOCON) -#define LAPACK_cpocon LAPACK_GLOBAL(cpocon,CPOCON) -#define LAPACK_zpocon LAPACK_GLOBAL(zpocon,ZPOCON) -#define LAPACK_sppcon LAPACK_GLOBAL(sppcon,SPPCON) -#define LAPACK_dppcon LAPACK_GLOBAL(dppcon,DPPCON) -#define LAPACK_cppcon LAPACK_GLOBAL(cppcon,CPPCON) -#define LAPACK_zppcon LAPACK_GLOBAL(zppcon,ZPPCON) -#define LAPACK_spbcon LAPACK_GLOBAL(spbcon,SPBCON) -#define LAPACK_dpbcon LAPACK_GLOBAL(dpbcon,DPBCON) -#define LAPACK_cpbcon LAPACK_GLOBAL(cpbcon,CPBCON) -#define LAPACK_zpbcon LAPACK_GLOBAL(zpbcon,ZPBCON) -#define LAPACK_sptcon LAPACK_GLOBAL(sptcon,SPTCON) -#define LAPACK_dptcon LAPACK_GLOBAL(dptcon,DPTCON) -#define LAPACK_cptcon LAPACK_GLOBAL(cptcon,CPTCON) -#define LAPACK_zptcon LAPACK_GLOBAL(zptcon,ZPTCON) -#define LAPACK_ssycon LAPACK_GLOBAL(ssycon,SSYCON) -#define LAPACK_dsycon LAPACK_GLOBAL(dsycon,DSYCON) -#define LAPACK_csycon LAPACK_GLOBAL(csycon,CSYCON) -#define LAPACK_zsycon LAPACK_GLOBAL(zsycon,ZSYCON) -#define LAPACK_checon LAPACK_GLOBAL(checon,CHECON) -#define LAPACK_zhecon LAPACK_GLOBAL(zhecon,ZHECON) -#define LAPACK_sspcon LAPACK_GLOBAL(sspcon,SSPCON) -#define LAPACK_dspcon LAPACK_GLOBAL(dspcon,DSPCON) -#define LAPACK_cspcon LAPACK_GLOBAL(cspcon,CSPCON) -#define LAPACK_zspcon LAPACK_GLOBAL(zspcon,ZSPCON) -#define LAPACK_chpcon LAPACK_GLOBAL(chpcon,CHPCON) -#define LAPACK_zhpcon LAPACK_GLOBAL(zhpcon,ZHPCON) -#define LAPACK_strcon LAPACK_GLOBAL(strcon,STRCON) -#define LAPACK_dtrcon LAPACK_GLOBAL(dtrcon,DTRCON) -#define LAPACK_ctrcon LAPACK_GLOBAL(ctrcon,CTRCON) -#define LAPACK_ztrcon LAPACK_GLOBAL(ztrcon,ZTRCON) -#define LAPACK_stpcon LAPACK_GLOBAL(stpcon,STPCON) -#define LAPACK_dtpcon LAPACK_GLOBAL(dtpcon,DTPCON) -#define LAPACK_ctpcon LAPACK_GLOBAL(ctpcon,CTPCON) -#define LAPACK_ztpcon LAPACK_GLOBAL(ztpcon,ZTPCON) -#define LAPACK_stbcon LAPACK_GLOBAL(stbcon,STBCON) -#define LAPACK_dtbcon LAPACK_GLOBAL(dtbcon,DTBCON) -#define LAPACK_ctbcon LAPACK_GLOBAL(ctbcon,CTBCON) -#define LAPACK_ztbcon LAPACK_GLOBAL(ztbcon,ZTBCON) -#define LAPACK_sgerfs LAPACK_GLOBAL(sgerfs,SGERFS) -#define LAPACK_dgerfs LAPACK_GLOBAL(dgerfs,DGERFS) -#define LAPACK_cgerfs LAPACK_GLOBAL(cgerfs,CGERFS) -#define LAPACK_zgerfs LAPACK_GLOBAL(zgerfs,ZGERFS) -#define LAPACK_dgerfsx LAPACK_GLOBAL(dgerfsx,DGERFSX) -#define LAPACK_sgerfsx LAPACK_GLOBAL(sgerfsx,SGERFSX) -#define LAPACK_zgerfsx LAPACK_GLOBAL(zgerfsx,ZGERFSX) -#define LAPACK_cgerfsx LAPACK_GLOBAL(cgerfsx,CGERFSX) -#define LAPACK_sgbrfs LAPACK_GLOBAL(sgbrfs,SGBRFS) -#define LAPACK_dgbrfs LAPACK_GLOBAL(dgbrfs,DGBRFS) -#define LAPACK_cgbrfs LAPACK_GLOBAL(cgbrfs,CGBRFS) -#define LAPACK_zgbrfs LAPACK_GLOBAL(zgbrfs,ZGBRFS) -#define LAPACK_dgbrfsx LAPACK_GLOBAL(dgbrfsx,DGBRFSX) -#define LAPACK_sgbrfsx LAPACK_GLOBAL(sgbrfsx,SGBRFSX) -#define LAPACK_zgbrfsx LAPACK_GLOBAL(zgbrfsx,ZGBRFSX) -#define LAPACK_cgbrfsx LAPACK_GLOBAL(cgbrfsx,CGBRFSX) -#define LAPACK_sgtrfs LAPACK_GLOBAL(sgtrfs,SGTRFS) -#define LAPACK_dgtrfs LAPACK_GLOBAL(dgtrfs,DGTRFS) -#define LAPACK_cgtrfs LAPACK_GLOBAL(cgtrfs,CGTRFS) -#define LAPACK_zgtrfs LAPACK_GLOBAL(zgtrfs,ZGTRFS) -#define LAPACK_sporfs LAPACK_GLOBAL(sporfs,SPORFS) -#define LAPACK_dporfs LAPACK_GLOBAL(dporfs,DPORFS) -#define LAPACK_cporfs LAPACK_GLOBAL(cporfs,CPORFS) -#define LAPACK_zporfs LAPACK_GLOBAL(zporfs,ZPORFS) -#define LAPACK_dporfsx LAPACK_GLOBAL(dporfsx,DPORFSX) -#define LAPACK_sporfsx LAPACK_GLOBAL(sporfsx,SPORFSX) -#define LAPACK_zporfsx LAPACK_GLOBAL(zporfsx,ZPORFSX) -#define LAPACK_cporfsx LAPACK_GLOBAL(cporfsx,CPORFSX) -#define LAPACK_spprfs LAPACK_GLOBAL(spprfs,SPPRFS) -#define LAPACK_dpprfs LAPACK_GLOBAL(dpprfs,DPPRFS) -#define LAPACK_cpprfs LAPACK_GLOBAL(cpprfs,CPPRFS) -#define LAPACK_zpprfs LAPACK_GLOBAL(zpprfs,ZPPRFS) -#define LAPACK_spbrfs LAPACK_GLOBAL(spbrfs,SPBRFS) -#define LAPACK_dpbrfs LAPACK_GLOBAL(dpbrfs,DPBRFS) -#define LAPACK_cpbrfs LAPACK_GLOBAL(cpbrfs,CPBRFS) -#define LAPACK_zpbrfs LAPACK_GLOBAL(zpbrfs,ZPBRFS) -#define LAPACK_sptrfs LAPACK_GLOBAL(sptrfs,SPTRFS) -#define LAPACK_dptrfs LAPACK_GLOBAL(dptrfs,DPTRFS) -#define LAPACK_cptrfs LAPACK_GLOBAL(cptrfs,CPTRFS) -#define LAPACK_zptrfs LAPACK_GLOBAL(zptrfs,ZPTRFS) -#define LAPACK_ssyrfs LAPACK_GLOBAL(ssyrfs,SSYRFS) -#define LAPACK_dsyrfs LAPACK_GLOBAL(dsyrfs,DSYRFS) -#define LAPACK_csyrfs LAPACK_GLOBAL(csyrfs,CSYRFS) -#define LAPACK_zsyrfs LAPACK_GLOBAL(zsyrfs,ZSYRFS) -#define LAPACK_dsyrfsx LAPACK_GLOBAL(dsyrfsx,DSYRFSX) -#define LAPACK_ssyrfsx LAPACK_GLOBAL(ssyrfsx,SSYRFSX) -#define LAPACK_zsyrfsx LAPACK_GLOBAL(zsyrfsx,ZSYRFSX) -#define LAPACK_csyrfsx LAPACK_GLOBAL(csyrfsx,CSYRFSX) -#define LAPACK_cherfs LAPACK_GLOBAL(cherfs,CHERFS) -#define LAPACK_zherfs LAPACK_GLOBAL(zherfs,ZHERFS) -#define LAPACK_zherfsx LAPACK_GLOBAL(zherfsx,ZHERFSX) -#define LAPACK_cherfsx LAPACK_GLOBAL(cherfsx,CHERFSX) -#define LAPACK_ssprfs LAPACK_GLOBAL(ssprfs,SSPRFS) -#define LAPACK_dsprfs LAPACK_GLOBAL(dsprfs,DSPRFS) -#define LAPACK_csprfs LAPACK_GLOBAL(csprfs,CSPRFS) -#define LAPACK_zsprfs LAPACK_GLOBAL(zsprfs,ZSPRFS) -#define LAPACK_chprfs LAPACK_GLOBAL(chprfs,CHPRFS) -#define LAPACK_zhprfs LAPACK_GLOBAL(zhprfs,ZHPRFS) -#define LAPACK_strrfs LAPACK_GLOBAL(strrfs,STRRFS) -#define LAPACK_dtrrfs LAPACK_GLOBAL(dtrrfs,DTRRFS) -#define LAPACK_ctrrfs LAPACK_GLOBAL(ctrrfs,CTRRFS) -#define LAPACK_ztrrfs LAPACK_GLOBAL(ztrrfs,ZTRRFS) -#define LAPACK_stprfs LAPACK_GLOBAL(stprfs,STPRFS) -#define LAPACK_dtprfs LAPACK_GLOBAL(dtprfs,DTPRFS) -#define LAPACK_ctprfs LAPACK_GLOBAL(ctprfs,CTPRFS) -#define LAPACK_ztprfs LAPACK_GLOBAL(ztprfs,ZTPRFS) -#define LAPACK_stbrfs LAPACK_GLOBAL(stbrfs,STBRFS) -#define LAPACK_dtbrfs LAPACK_GLOBAL(dtbrfs,DTBRFS) -#define LAPACK_ctbrfs LAPACK_GLOBAL(ctbrfs,CTBRFS) -#define LAPACK_ztbrfs LAPACK_GLOBAL(ztbrfs,ZTBRFS) -#define LAPACK_sgetri LAPACK_GLOBAL(sgetri,SGETRI) -#define LAPACK_dgetri LAPACK_GLOBAL(dgetri,DGETRI) -#define LAPACK_cgetri LAPACK_GLOBAL(cgetri,CGETRI) -#define LAPACK_zgetri LAPACK_GLOBAL(zgetri,ZGETRI) -#define LAPACK_spotri LAPACK_GLOBAL(spotri,SPOTRI) -#define LAPACK_dpotri LAPACK_GLOBAL(dpotri,DPOTRI) -#define LAPACK_cpotri LAPACK_GLOBAL(cpotri,CPOTRI) -#define LAPACK_zpotri LAPACK_GLOBAL(zpotri,ZPOTRI) -#define LAPACK_dpftri LAPACK_GLOBAL(dpftri,DPFTRI) -#define LAPACK_spftri LAPACK_GLOBAL(spftri,SPFTRI) -#define LAPACK_zpftri LAPACK_GLOBAL(zpftri,ZPFTRI) -#define LAPACK_cpftri LAPACK_GLOBAL(cpftri,CPFTRI) -#define LAPACK_spptri LAPACK_GLOBAL(spptri,SPPTRI) -#define LAPACK_dpptri LAPACK_GLOBAL(dpptri,DPPTRI) -#define LAPACK_cpptri LAPACK_GLOBAL(cpptri,CPPTRI) -#define LAPACK_zpptri LAPACK_GLOBAL(zpptri,ZPPTRI) -#define LAPACK_ssytri LAPACK_GLOBAL(ssytri,SSYTRI) -#define LAPACK_dsytri LAPACK_GLOBAL(dsytri,DSYTRI) -#define LAPACK_csytri LAPACK_GLOBAL(csytri,CSYTRI) -#define LAPACK_zsytri LAPACK_GLOBAL(zsytri,ZSYTRI) -#define LAPACK_chetri LAPACK_GLOBAL(chetri,CHETRI) -#define LAPACK_zhetri LAPACK_GLOBAL(zhetri,ZHETRI) -#define LAPACK_ssptri LAPACK_GLOBAL(ssptri,SSPTRI) -#define LAPACK_dsptri LAPACK_GLOBAL(dsptri,DSPTRI) -#define LAPACK_csptri LAPACK_GLOBAL(csptri,CSPTRI) -#define LAPACK_zsptri LAPACK_GLOBAL(zsptri,ZSPTRI) -#define LAPACK_chptri LAPACK_GLOBAL(chptri,CHPTRI) -#define LAPACK_zhptri LAPACK_GLOBAL(zhptri,ZHPTRI) -#define LAPACK_strtri LAPACK_GLOBAL(strtri,STRTRI) -#define LAPACK_dtrtri LAPACK_GLOBAL(dtrtri,DTRTRI) -#define LAPACK_ctrtri LAPACK_GLOBAL(ctrtri,CTRTRI) -#define LAPACK_ztrtri LAPACK_GLOBAL(ztrtri,ZTRTRI) -#define LAPACK_dtftri LAPACK_GLOBAL(dtftri,DTFTRI) -#define LAPACK_stftri LAPACK_GLOBAL(stftri,STFTRI) -#define LAPACK_ztftri LAPACK_GLOBAL(ztftri,ZTFTRI) -#define LAPACK_ctftri LAPACK_GLOBAL(ctftri,CTFTRI) -#define LAPACK_stptri LAPACK_GLOBAL(stptri,STPTRI) -#define LAPACK_dtptri LAPACK_GLOBAL(dtptri,DTPTRI) -#define LAPACK_ctptri LAPACK_GLOBAL(ctptri,CTPTRI) -#define LAPACK_ztptri LAPACK_GLOBAL(ztptri,ZTPTRI) -#define LAPACK_sgeequ LAPACK_GLOBAL(sgeequ,SGEEQU) -#define LAPACK_dgeequ LAPACK_GLOBAL(dgeequ,DGEEQU) -#define LAPACK_cgeequ LAPACK_GLOBAL(cgeequ,CGEEQU) -#define LAPACK_zgeequ LAPACK_GLOBAL(zgeequ,ZGEEQU) -#define LAPACK_dgeequb LAPACK_GLOBAL(dgeequb,DGEEQUB) -#define LAPACK_sgeequb LAPACK_GLOBAL(sgeequb,SGEEQUB) -#define LAPACK_zgeequb LAPACK_GLOBAL(zgeequb,ZGEEQUB) -#define LAPACK_cgeequb LAPACK_GLOBAL(cgeequb,CGEEQUB) -#define LAPACK_sgbequ LAPACK_GLOBAL(sgbequ,SGBEQU) -#define LAPACK_dgbequ LAPACK_GLOBAL(dgbequ,DGBEQU) -#define LAPACK_cgbequ LAPACK_GLOBAL(cgbequ,CGBEQU) -#define LAPACK_zgbequ LAPACK_GLOBAL(zgbequ,ZGBEQU) -#define LAPACK_dgbequb LAPACK_GLOBAL(dgbequb,DGBEQUB) -#define LAPACK_sgbequb LAPACK_GLOBAL(sgbequb,SGBEQUB) -#define LAPACK_zgbequb LAPACK_GLOBAL(zgbequb,ZGBEQUB) -#define LAPACK_cgbequb LAPACK_GLOBAL(cgbequb,CGBEQUB) -#define LAPACK_spoequ LAPACK_GLOBAL(spoequ,SPOEQU) -#define LAPACK_dpoequ LAPACK_GLOBAL(dpoequ,DPOEQU) -#define LAPACK_cpoequ LAPACK_GLOBAL(cpoequ,CPOEQU) -#define LAPACK_zpoequ LAPACK_GLOBAL(zpoequ,ZPOEQU) -#define LAPACK_dpoequb LAPACK_GLOBAL(dpoequb,DPOEQUB) -#define LAPACK_spoequb LAPACK_GLOBAL(spoequb,SPOEQUB) -#define LAPACK_zpoequb LAPACK_GLOBAL(zpoequb,ZPOEQUB) -#define LAPACK_cpoequb LAPACK_GLOBAL(cpoequb,CPOEQUB) -#define LAPACK_sppequ LAPACK_GLOBAL(sppequ,SPPEQU) -#define LAPACK_dppequ LAPACK_GLOBAL(dppequ,DPPEQU) -#define LAPACK_cppequ LAPACK_GLOBAL(cppequ,CPPEQU) -#define LAPACK_zppequ LAPACK_GLOBAL(zppequ,ZPPEQU) -#define LAPACK_spbequ LAPACK_GLOBAL(spbequ,SPBEQU) -#define LAPACK_dpbequ LAPACK_GLOBAL(dpbequ,DPBEQU) -#define LAPACK_cpbequ LAPACK_GLOBAL(cpbequ,CPBEQU) -#define LAPACK_zpbequ LAPACK_GLOBAL(zpbequ,ZPBEQU) -#define LAPACK_dsyequb LAPACK_GLOBAL(dsyequb,DSYEQUB) -#define LAPACK_ssyequb LAPACK_GLOBAL(ssyequb,SSYEQUB) -#define LAPACK_zsyequb LAPACK_GLOBAL(zsyequb,ZSYEQUB) -#define LAPACK_csyequb LAPACK_GLOBAL(csyequb,CSYEQUB) -#define LAPACK_zheequb LAPACK_GLOBAL(zheequb,ZHEEQUB) -#define LAPACK_cheequb LAPACK_GLOBAL(cheequb,CHEEQUB) -#define LAPACK_sgesv LAPACK_GLOBAL(sgesv,SGESV) -#define LAPACK_dgesv LAPACK_GLOBAL(dgesv,DGESV) -#define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV) -#define LAPACK_zgesv LAPACK_GLOBAL(zgesv,ZGESV) -#define LAPACK_dsgesv LAPACK_GLOBAL(dsgesv,DSGESV) -#define LAPACK_zcgesv LAPACK_GLOBAL(zcgesv,ZCGESV) -#define LAPACK_sgesvx LAPACK_GLOBAL(sgesvx,SGESVX) -#define LAPACK_dgesvx LAPACK_GLOBAL(dgesvx,DGESVX) -#define LAPACK_cgesvx LAPACK_GLOBAL(cgesvx,CGESVX) -#define LAPACK_zgesvx LAPACK_GLOBAL(zgesvx,ZGESVX) -#define LAPACK_dgesvxx LAPACK_GLOBAL(dgesvxx,DGESVXX) -#define LAPACK_sgesvxx LAPACK_GLOBAL(sgesvxx,SGESVXX) -#define LAPACK_zgesvxx LAPACK_GLOBAL(zgesvxx,ZGESVXX) -#define LAPACK_cgesvxx LAPACK_GLOBAL(cgesvxx,CGESVXX) -#define LAPACK_sgbsv LAPACK_GLOBAL(sgbsv,SGBSV) -#define LAPACK_dgbsv LAPACK_GLOBAL(dgbsv,DGBSV) -#define LAPACK_cgbsv LAPACK_GLOBAL(cgbsv,CGBSV) -#define LAPACK_zgbsv LAPACK_GLOBAL(zgbsv,ZGBSV) -#define LAPACK_sgbsvx LAPACK_GLOBAL(sgbsvx,SGBSVX) -#define LAPACK_dgbsvx LAPACK_GLOBAL(dgbsvx,DGBSVX) -#define LAPACK_cgbsvx LAPACK_GLOBAL(cgbsvx,CGBSVX) -#define LAPACK_zgbsvx LAPACK_GLOBAL(zgbsvx,ZGBSVX) -#define LAPACK_dgbsvxx LAPACK_GLOBAL(dgbsvxx,DGBSVXX) -#define LAPACK_sgbsvxx LAPACK_GLOBAL(sgbsvxx,SGBSVXX) -#define LAPACK_zgbsvxx LAPACK_GLOBAL(zgbsvxx,ZGBSVXX) -#define LAPACK_cgbsvxx LAPACK_GLOBAL(cgbsvxx,CGBSVXX) -#define LAPACK_sgtsv LAPACK_GLOBAL(sgtsv,SGTSV) -#define LAPACK_dgtsv LAPACK_GLOBAL(dgtsv,DGTSV) -#define LAPACK_cgtsv LAPACK_GLOBAL(cgtsv,CGTSV) -#define LAPACK_zgtsv LAPACK_GLOBAL(zgtsv,ZGTSV) -#define LAPACK_sgtsvx LAPACK_GLOBAL(sgtsvx,SGTSVX) -#define LAPACK_dgtsvx LAPACK_GLOBAL(dgtsvx,DGTSVX) -#define LAPACK_cgtsvx LAPACK_GLOBAL(cgtsvx,CGTSVX) -#define LAPACK_zgtsvx LAPACK_GLOBAL(zgtsvx,ZGTSVX) -#define LAPACK_sposv LAPACK_GLOBAL(sposv,SPOSV) -#define LAPACK_dposv LAPACK_GLOBAL(dposv,DPOSV) -#define LAPACK_cposv LAPACK_GLOBAL(cposv,CPOSV) -#define LAPACK_zposv LAPACK_GLOBAL(zposv,ZPOSV) -#define LAPACK_dsposv LAPACK_GLOBAL(dsposv,DSPOSV) -#define LAPACK_zcposv LAPACK_GLOBAL(zcposv,ZCPOSV) -#define LAPACK_sposvx LAPACK_GLOBAL(sposvx,SPOSVX) -#define LAPACK_dposvx LAPACK_GLOBAL(dposvx,DPOSVX) -#define LAPACK_cposvx LAPACK_GLOBAL(cposvx,CPOSVX) -#define LAPACK_zposvx LAPACK_GLOBAL(zposvx,ZPOSVX) -#define LAPACK_dposvxx LAPACK_GLOBAL(dposvxx,DPOSVXX) -#define LAPACK_sposvxx LAPACK_GLOBAL(sposvxx,SPOSVXX) -#define LAPACK_zposvxx LAPACK_GLOBAL(zposvxx,ZPOSVXX) -#define LAPACK_cposvxx LAPACK_GLOBAL(cposvxx,CPOSVXX) -#define LAPACK_sppsv LAPACK_GLOBAL(sppsv,SPPSV) -#define LAPACK_dppsv LAPACK_GLOBAL(dppsv,DPPSV) -#define LAPACK_cppsv LAPACK_GLOBAL(cppsv,CPPSV) -#define LAPACK_zppsv LAPACK_GLOBAL(zppsv,ZPPSV) -#define LAPACK_sppsvx LAPACK_GLOBAL(sppsvx,SPPSVX) -#define LAPACK_dppsvx LAPACK_GLOBAL(dppsvx,DPPSVX) -#define LAPACK_cppsvx LAPACK_GLOBAL(cppsvx,CPPSVX) -#define LAPACK_zppsvx LAPACK_GLOBAL(zppsvx,ZPPSVX) -#define LAPACK_spbsv LAPACK_GLOBAL(spbsv,SPBSV) -#define LAPACK_dpbsv LAPACK_GLOBAL(dpbsv,DPBSV) -#define LAPACK_cpbsv LAPACK_GLOBAL(cpbsv,CPBSV) -#define LAPACK_zpbsv LAPACK_GLOBAL(zpbsv,ZPBSV) -#define LAPACK_spbsvx LAPACK_GLOBAL(spbsvx,SPBSVX) -#define LAPACK_dpbsvx LAPACK_GLOBAL(dpbsvx,DPBSVX) -#define LAPACK_cpbsvx LAPACK_GLOBAL(cpbsvx,CPBSVX) -#define LAPACK_zpbsvx LAPACK_GLOBAL(zpbsvx,ZPBSVX) -#define LAPACK_sptsv LAPACK_GLOBAL(sptsv,SPTSV) -#define LAPACK_dptsv LAPACK_GLOBAL(dptsv,DPTSV) -#define LAPACK_cptsv LAPACK_GLOBAL(cptsv,CPTSV) -#define LAPACK_zptsv LAPACK_GLOBAL(zptsv,ZPTSV) -#define LAPACK_sptsvx LAPACK_GLOBAL(sptsvx,SPTSVX) -#define LAPACK_dptsvx LAPACK_GLOBAL(dptsvx,DPTSVX) -#define LAPACK_cptsvx LAPACK_GLOBAL(cptsvx,CPTSVX) -#define LAPACK_zptsvx LAPACK_GLOBAL(zptsvx,ZPTSVX) -#define LAPACK_ssysv LAPACK_GLOBAL(ssysv,SSYSV) -#define LAPACK_dsysv LAPACK_GLOBAL(dsysv,DSYSV) -#define LAPACK_csysv LAPACK_GLOBAL(csysv,CSYSV) -#define LAPACK_zsysv LAPACK_GLOBAL(zsysv,ZSYSV) -#define LAPACK_ssysvx LAPACK_GLOBAL(ssysvx,SSYSVX) -#define LAPACK_dsysvx LAPACK_GLOBAL(dsysvx,DSYSVX) -#define LAPACK_csysvx LAPACK_GLOBAL(csysvx,CSYSVX) -#define LAPACK_zsysvx LAPACK_GLOBAL(zsysvx,ZSYSVX) -#define LAPACK_dsysvxx LAPACK_GLOBAL(dsysvxx,DSYSVXX) -#define LAPACK_ssysvxx LAPACK_GLOBAL(ssysvxx,SSYSVXX) -#define LAPACK_zsysvxx LAPACK_GLOBAL(zsysvxx,ZSYSVXX) -#define LAPACK_csysvxx LAPACK_GLOBAL(csysvxx,CSYSVXX) -#define LAPACK_chesv LAPACK_GLOBAL(chesv,CHESV) -#define LAPACK_zhesv LAPACK_GLOBAL(zhesv,ZHESV) -#define LAPACK_chesvx LAPACK_GLOBAL(chesvx,CHESVX) -#define LAPACK_zhesvx LAPACK_GLOBAL(zhesvx,ZHESVX) -#define LAPACK_zhesvxx LAPACK_GLOBAL(zhesvxx,ZHESVXX) -#define LAPACK_chesvxx LAPACK_GLOBAL(chesvxx,CHESVXX) -#define LAPACK_sspsv LAPACK_GLOBAL(sspsv,SSPSV) -#define LAPACK_dspsv LAPACK_GLOBAL(dspsv,DSPSV) -#define LAPACK_cspsv LAPACK_GLOBAL(cspsv,CSPSV) -#define LAPACK_zspsv LAPACK_GLOBAL(zspsv,ZSPSV) -#define LAPACK_sspsvx LAPACK_GLOBAL(sspsvx,SSPSVX) -#define LAPACK_dspsvx LAPACK_GLOBAL(dspsvx,DSPSVX) -#define LAPACK_cspsvx LAPACK_GLOBAL(cspsvx,CSPSVX) -#define LAPACK_zspsvx LAPACK_GLOBAL(zspsvx,ZSPSVX) -#define LAPACK_chpsv LAPACK_GLOBAL(chpsv,CHPSV) -#define LAPACK_zhpsv LAPACK_GLOBAL(zhpsv,ZHPSV) -#define LAPACK_chpsvx LAPACK_GLOBAL(chpsvx,CHPSVX) -#define LAPACK_zhpsvx LAPACK_GLOBAL(zhpsvx,ZHPSVX) -#define LAPACK_sgeqrf LAPACK_GLOBAL(sgeqrf,SGEQRF) -#define LAPACK_dgeqrf LAPACK_GLOBAL(dgeqrf,DGEQRF) -#define LAPACK_cgeqrf LAPACK_GLOBAL(cgeqrf,CGEQRF) -#define LAPACK_zgeqrf LAPACK_GLOBAL(zgeqrf,ZGEQRF) -#define LAPACK_sgeqpf LAPACK_GLOBAL(sgeqpf,SGEQPF) -#define LAPACK_dgeqpf LAPACK_GLOBAL(dgeqpf,DGEQPF) -#define LAPACK_cgeqpf LAPACK_GLOBAL(cgeqpf,CGEQPF) -#define LAPACK_zgeqpf LAPACK_GLOBAL(zgeqpf,ZGEQPF) -#define LAPACK_sgeqp3 LAPACK_GLOBAL(sgeqp3,SGEQP3) -#define LAPACK_dgeqp3 LAPACK_GLOBAL(dgeqp3,DGEQP3) -#define LAPACK_cgeqp3 LAPACK_GLOBAL(cgeqp3,CGEQP3) -#define LAPACK_zgeqp3 LAPACK_GLOBAL(zgeqp3,ZGEQP3) -#define LAPACK_sorgqr LAPACK_GLOBAL(sorgqr,SORGQR) -#define LAPACK_dorgqr LAPACK_GLOBAL(dorgqr,DORGQR) -#define LAPACK_sormqr LAPACK_GLOBAL(sormqr,SORMQR) -#define LAPACK_dormqr LAPACK_GLOBAL(dormqr,DORMQR) -#define LAPACK_cungqr LAPACK_GLOBAL(cungqr,CUNGQR) -#define LAPACK_zungqr LAPACK_GLOBAL(zungqr,ZUNGQR) -#define LAPACK_cunmqr LAPACK_GLOBAL(cunmqr,CUNMQR) -#define LAPACK_zunmqr LAPACK_GLOBAL(zunmqr,ZUNMQR) -#define LAPACK_sgelqf LAPACK_GLOBAL(sgelqf,SGELQF) -#define LAPACK_dgelqf LAPACK_GLOBAL(dgelqf,DGELQF) -#define LAPACK_cgelqf LAPACK_GLOBAL(cgelqf,CGELQF) -#define LAPACK_zgelqf LAPACK_GLOBAL(zgelqf,ZGELQF) -#define LAPACK_sorglq LAPACK_GLOBAL(sorglq,SORGLQ) -#define LAPACK_dorglq LAPACK_GLOBAL(dorglq,DORGLQ) -#define LAPACK_sormlq LAPACK_GLOBAL(sormlq,SORMLQ) -#define LAPACK_dormlq LAPACK_GLOBAL(dormlq,DORMLQ) -#define LAPACK_cunglq LAPACK_GLOBAL(cunglq,CUNGLQ) -#define LAPACK_zunglq LAPACK_GLOBAL(zunglq,ZUNGLQ) -#define LAPACK_cunmlq LAPACK_GLOBAL(cunmlq,CUNMLQ) -#define LAPACK_zunmlq LAPACK_GLOBAL(zunmlq,ZUNMLQ) -#define LAPACK_sgeqlf LAPACK_GLOBAL(sgeqlf,SGEQLF) -#define LAPACK_dgeqlf LAPACK_GLOBAL(dgeqlf,DGEQLF) -#define LAPACK_cgeqlf LAPACK_GLOBAL(cgeqlf,CGEQLF) -#define LAPACK_zgeqlf LAPACK_GLOBAL(zgeqlf,ZGEQLF) -#define LAPACK_sorgql LAPACK_GLOBAL(sorgql,SORGQL) -#define LAPACK_dorgql LAPACK_GLOBAL(dorgql,DORGQL) -#define LAPACK_cungql LAPACK_GLOBAL(cungql,CUNGQL) -#define LAPACK_zungql LAPACK_GLOBAL(zungql,ZUNGQL) -#define LAPACK_sormql LAPACK_GLOBAL(sormql,SORMQL) -#define LAPACK_dormql LAPACK_GLOBAL(dormql,DORMQL) -#define LAPACK_cunmql LAPACK_GLOBAL(cunmql,CUNMQL) -#define LAPACK_zunmql LAPACK_GLOBAL(zunmql,ZUNMQL) -#define LAPACK_sgerqf LAPACK_GLOBAL(sgerqf,SGERQF) -#define LAPACK_dgerqf LAPACK_GLOBAL(dgerqf,DGERQF) -#define LAPACK_cgerqf LAPACK_GLOBAL(cgerqf,CGERQF) -#define LAPACK_zgerqf LAPACK_GLOBAL(zgerqf,ZGERQF) -#define LAPACK_sorgrq LAPACK_GLOBAL(sorgrq,SORGRQ) -#define LAPACK_dorgrq LAPACK_GLOBAL(dorgrq,DORGRQ) -#define LAPACK_cungrq LAPACK_GLOBAL(cungrq,CUNGRQ) -#define LAPACK_zungrq LAPACK_GLOBAL(zungrq,ZUNGRQ) -#define LAPACK_sormrq LAPACK_GLOBAL(sormrq,SORMRQ) -#define LAPACK_dormrq LAPACK_GLOBAL(dormrq,DORMRQ) -#define LAPACK_cunmrq LAPACK_GLOBAL(cunmrq,CUNMRQ) -#define LAPACK_zunmrq LAPACK_GLOBAL(zunmrq,ZUNMRQ) -#define LAPACK_stzrzf LAPACK_GLOBAL(stzrzf,STZRZF) -#define LAPACK_dtzrzf LAPACK_GLOBAL(dtzrzf,DTZRZF) -#define LAPACK_ctzrzf LAPACK_GLOBAL(ctzrzf,CTZRZF) -#define LAPACK_ztzrzf LAPACK_GLOBAL(ztzrzf,ZTZRZF) -#define LAPACK_sormrz LAPACK_GLOBAL(sormrz,SORMRZ) -#define LAPACK_dormrz LAPACK_GLOBAL(dormrz,DORMRZ) -#define LAPACK_cunmrz LAPACK_GLOBAL(cunmrz,CUNMRZ) -#define LAPACK_zunmrz LAPACK_GLOBAL(zunmrz,ZUNMRZ) -#define LAPACK_sggqrf LAPACK_GLOBAL(sggqrf,SGGQRF) -#define LAPACK_dggqrf LAPACK_GLOBAL(dggqrf,DGGQRF) -#define LAPACK_cggqrf LAPACK_GLOBAL(cggqrf,CGGQRF) -#define LAPACK_zggqrf LAPACK_GLOBAL(zggqrf,ZGGQRF) -#define LAPACK_sggrqf LAPACK_GLOBAL(sggrqf,SGGRQF) -#define LAPACK_dggrqf LAPACK_GLOBAL(dggrqf,DGGRQF) -#define LAPACK_cggrqf LAPACK_GLOBAL(cggrqf,CGGRQF) -#define LAPACK_zggrqf LAPACK_GLOBAL(zggrqf,ZGGRQF) -#define LAPACK_sgebrd LAPACK_GLOBAL(sgebrd,SGEBRD) -#define LAPACK_dgebrd LAPACK_GLOBAL(dgebrd,DGEBRD) -#define LAPACK_cgebrd LAPACK_GLOBAL(cgebrd,CGEBRD) -#define LAPACK_zgebrd LAPACK_GLOBAL(zgebrd,ZGEBRD) -#define LAPACK_sgbbrd LAPACK_GLOBAL(sgbbrd,SGBBRD) -#define LAPACK_dgbbrd LAPACK_GLOBAL(dgbbrd,DGBBRD) -#define LAPACK_cgbbrd LAPACK_GLOBAL(cgbbrd,CGBBRD) -#define LAPACK_zgbbrd LAPACK_GLOBAL(zgbbrd,ZGBBRD) -#define LAPACK_sorgbr LAPACK_GLOBAL(sorgbr,SORGBR) -#define LAPACK_dorgbr LAPACK_GLOBAL(dorgbr,DORGBR) -#define LAPACK_sormbr LAPACK_GLOBAL(sormbr,SORMBR) -#define LAPACK_dormbr LAPACK_GLOBAL(dormbr,DORMBR) -#define LAPACK_cungbr LAPACK_GLOBAL(cungbr,CUNGBR) -#define LAPACK_zungbr LAPACK_GLOBAL(zungbr,ZUNGBR) -#define LAPACK_cunmbr LAPACK_GLOBAL(cunmbr,CUNMBR) -#define LAPACK_zunmbr LAPACK_GLOBAL(zunmbr,ZUNMBR) -#define LAPACK_sbdsqr LAPACK_GLOBAL(sbdsqr,SBDSQR) -#define LAPACK_dbdsqr LAPACK_GLOBAL(dbdsqr,DBDSQR) -#define LAPACK_cbdsqr LAPACK_GLOBAL(cbdsqr,CBDSQR) -#define LAPACK_zbdsqr LAPACK_GLOBAL(zbdsqr,ZBDSQR) -#define LAPACK_sbdsdc LAPACK_GLOBAL(sbdsdc,SBDSDC) -#define LAPACK_dbdsdc LAPACK_GLOBAL(dbdsdc,DBDSDC) -#define LAPACK_sbdsvdx LAPACK_GLOBAL(sbdsvdx,SBDSVDX) -#define LAPACK_dbdsvdx LAPACK_GLOBAL(dbdsvdx,DBDSVDX) -#define LAPACK_ssytrd LAPACK_GLOBAL(ssytrd,SSYTRD) -#define LAPACK_dsytrd LAPACK_GLOBAL(dsytrd,DSYTRD) -#define LAPACK_sorgtr LAPACK_GLOBAL(sorgtr,SORGTR) -#define LAPACK_dorgtr LAPACK_GLOBAL(dorgtr,DORGTR) -#define LAPACK_sormtr LAPACK_GLOBAL(sormtr,SORMTR) -#define LAPACK_dormtr LAPACK_GLOBAL(dormtr,DORMTR) -#define LAPACK_chetrd LAPACK_GLOBAL(chetrd,CHETRD) -#define LAPACK_zhetrd LAPACK_GLOBAL(zhetrd,ZHETRD) -#define LAPACK_cungtr LAPACK_GLOBAL(cungtr,CUNGTR) -#define LAPACK_zungtr LAPACK_GLOBAL(zungtr,ZUNGTR) -#define LAPACK_cunmtr LAPACK_GLOBAL(cunmtr,CUNMTR) -#define LAPACK_zunmtr LAPACK_GLOBAL(zunmtr,ZUNMTR) -#define LAPACK_ssptrd LAPACK_GLOBAL(ssptrd,SSPTRD) -#define LAPACK_dsptrd LAPACK_GLOBAL(dsptrd,DSPTRD) -#define LAPACK_sopgtr LAPACK_GLOBAL(sopgtr,SOPGTR) -#define LAPACK_dopgtr LAPACK_GLOBAL(dopgtr,DOPGTR) -#define LAPACK_sopmtr LAPACK_GLOBAL(sopmtr,SOPMTR) -#define LAPACK_dopmtr LAPACK_GLOBAL(dopmtr,DOPMTR) -#define LAPACK_chptrd LAPACK_GLOBAL(chptrd,CHPTRD) -#define LAPACK_zhptrd LAPACK_GLOBAL(zhptrd,ZHPTRD) -#define LAPACK_cupgtr LAPACK_GLOBAL(cupgtr,CUPGTR) -#define LAPACK_zupgtr LAPACK_GLOBAL(zupgtr,ZUPGTR) -#define LAPACK_cupmtr LAPACK_GLOBAL(cupmtr,CUPMTR) -#define LAPACK_zupmtr LAPACK_GLOBAL(zupmtr,ZUPMTR) -#define LAPACK_ssbtrd LAPACK_GLOBAL(ssbtrd,SSBTRD) -#define LAPACK_dsbtrd LAPACK_GLOBAL(dsbtrd,DSBTRD) -#define LAPACK_chbtrd LAPACK_GLOBAL(chbtrd,CHBTRD) -#define LAPACK_zhbtrd LAPACK_GLOBAL(zhbtrd,ZHBTRD) -#define LAPACK_ssterf LAPACK_GLOBAL(ssterf,SSTERF) -#define LAPACK_dsterf LAPACK_GLOBAL(dsterf,DSTERF) -#define LAPACK_ssteqr LAPACK_GLOBAL(ssteqr,SSTEQR) -#define LAPACK_dsteqr LAPACK_GLOBAL(dsteqr,DSTEQR) -#define LAPACK_csteqr LAPACK_GLOBAL(csteqr,CSTEQR) -#define LAPACK_zsteqr LAPACK_GLOBAL(zsteqr,ZSTEQR) -#define LAPACK_sstemr LAPACK_GLOBAL(sstemr,SSTEMR) -#define LAPACK_dstemr LAPACK_GLOBAL(dstemr,DSTEMR) -#define LAPACK_cstemr LAPACK_GLOBAL(cstemr,CSTEMR) -#define LAPACK_zstemr LAPACK_GLOBAL(zstemr,ZSTEMR) -#define LAPACK_sstedc LAPACK_GLOBAL(sstedc,SSTEDC) -#define LAPACK_dstedc LAPACK_GLOBAL(dstedc,DSTEDC) -#define LAPACK_cstedc LAPACK_GLOBAL(cstedc,CSTEDC) -#define LAPACK_zstedc LAPACK_GLOBAL(zstedc,ZSTEDC) -#define LAPACK_sstegr LAPACK_GLOBAL(sstegr,SSTEGR) -#define LAPACK_dstegr LAPACK_GLOBAL(dstegr,DSTEGR) -#define LAPACK_cstegr LAPACK_GLOBAL(cstegr,CSTEGR) -#define LAPACK_zstegr LAPACK_GLOBAL(zstegr,ZSTEGR) -#define LAPACK_spteqr LAPACK_GLOBAL(spteqr,SPTEQR) -#define LAPACK_dpteqr LAPACK_GLOBAL(dpteqr,DPTEQR) -#define LAPACK_cpteqr LAPACK_GLOBAL(cpteqr,CPTEQR) -#define LAPACK_zpteqr LAPACK_GLOBAL(zpteqr,ZPTEQR) -#define LAPACK_sstebz LAPACK_GLOBAL(sstebz,SSTEBZ) -#define LAPACK_dstebz LAPACK_GLOBAL(dstebz,DSTEBZ) -#define LAPACK_sstein LAPACK_GLOBAL(sstein,SSTEIN) -#define LAPACK_dstein LAPACK_GLOBAL(dstein,DSTEIN) -#define LAPACK_cstein LAPACK_GLOBAL(cstein,CSTEIN) -#define LAPACK_zstein LAPACK_GLOBAL(zstein,ZSTEIN) -#define LAPACK_sdisna LAPACK_GLOBAL(sdisna,SDISNA) -#define LAPACK_ddisna LAPACK_GLOBAL(ddisna,DDISNA) -#define LAPACK_ssygst LAPACK_GLOBAL(ssygst,SSYGST) -#define LAPACK_dsygst LAPACK_GLOBAL(dsygst,DSYGST) -#define LAPACK_chegst LAPACK_GLOBAL(chegst,CHEGST) -#define LAPACK_zhegst LAPACK_GLOBAL(zhegst,ZHEGST) -#define LAPACK_sspgst LAPACK_GLOBAL(sspgst,SSPGST) -#define LAPACK_dspgst LAPACK_GLOBAL(dspgst,DSPGST) -#define LAPACK_chpgst LAPACK_GLOBAL(chpgst,CHPGST) -#define LAPACK_zhpgst LAPACK_GLOBAL(zhpgst,ZHPGST) -#define LAPACK_ssbgst LAPACK_GLOBAL(ssbgst,SSBGST) -#define LAPACK_dsbgst LAPACK_GLOBAL(dsbgst,DSBGST) -#define LAPACK_chbgst LAPACK_GLOBAL(chbgst,CHBGST) -#define LAPACK_zhbgst LAPACK_GLOBAL(zhbgst,ZHBGST) -#define LAPACK_spbstf LAPACK_GLOBAL(spbstf,SPBSTF) -#define LAPACK_dpbstf LAPACK_GLOBAL(dpbstf,DPBSTF) -#define LAPACK_cpbstf LAPACK_GLOBAL(cpbstf,CPBSTF) -#define LAPACK_zpbstf LAPACK_GLOBAL(zpbstf,ZPBSTF) -#define LAPACK_sgehrd LAPACK_GLOBAL(sgehrd,SGEHRD) -#define LAPACK_dgehrd LAPACK_GLOBAL(dgehrd,DGEHRD) -#define LAPACK_cgehrd LAPACK_GLOBAL(cgehrd,CGEHRD) -#define LAPACK_zgehrd LAPACK_GLOBAL(zgehrd,ZGEHRD) -#define LAPACK_sorghr LAPACK_GLOBAL(sorghr,SORGHR) -#define LAPACK_dorghr LAPACK_GLOBAL(dorghr,DORGHR) -#define LAPACK_sormhr LAPACK_GLOBAL(sormhr,SORMHR) -#define LAPACK_dormhr LAPACK_GLOBAL(dormhr,DORMHR) -#define LAPACK_cunghr LAPACK_GLOBAL(cunghr,CUNGHR) -#define LAPACK_zunghr LAPACK_GLOBAL(zunghr,ZUNGHR) -#define LAPACK_cunmhr LAPACK_GLOBAL(cunmhr,CUNMHR) -#define LAPACK_zunmhr LAPACK_GLOBAL(zunmhr,ZUNMHR) -#define LAPACK_sgebal LAPACK_GLOBAL(sgebal,SGEBAL) -#define LAPACK_dgebal LAPACK_GLOBAL(dgebal,DGEBAL) -#define LAPACK_cgebal LAPACK_GLOBAL(cgebal,CGEBAL) -#define LAPACK_zgebal LAPACK_GLOBAL(zgebal,ZGEBAL) -#define LAPACK_sgebak LAPACK_GLOBAL(sgebak,SGEBAK) -#define LAPACK_dgebak LAPACK_GLOBAL(dgebak,DGEBAK) -#define LAPACK_cgebak LAPACK_GLOBAL(cgebak,CGEBAK) -#define LAPACK_zgebak LAPACK_GLOBAL(zgebak,ZGEBAK) -#define LAPACK_shseqr LAPACK_GLOBAL(shseqr,SHSEQR) -#define LAPACK_dhseqr LAPACK_GLOBAL(dhseqr,DHSEQR) -#define LAPACK_chseqr LAPACK_GLOBAL(chseqr,CHSEQR) -#define LAPACK_zhseqr LAPACK_GLOBAL(zhseqr,ZHSEQR) -#define LAPACK_shsein LAPACK_GLOBAL(shsein,SHSEIN) -#define LAPACK_dhsein LAPACK_GLOBAL(dhsein,DHSEIN) -#define LAPACK_chsein LAPACK_GLOBAL(chsein,CHSEIN) -#define LAPACK_zhsein LAPACK_GLOBAL(zhsein,ZHSEIN) -#define LAPACK_strevc LAPACK_GLOBAL(strevc,STREVC) -#define LAPACK_dtrevc LAPACK_GLOBAL(dtrevc,DTREVC) -#define LAPACK_ctrevc LAPACK_GLOBAL(ctrevc,CTREVC) -#define LAPACK_ztrevc LAPACK_GLOBAL(ztrevc,ZTREVC) -#define LAPACK_strsna LAPACK_GLOBAL(strsna,STRSNA) -#define LAPACK_dtrsna LAPACK_GLOBAL(dtrsna,DTRSNA) -#define LAPACK_ctrsna LAPACK_GLOBAL(ctrsna,CTRSNA) -#define LAPACK_ztrsna LAPACK_GLOBAL(ztrsna,ZTRSNA) -#define LAPACK_strexc LAPACK_GLOBAL(strexc,STREXC) -#define LAPACK_dtrexc LAPACK_GLOBAL(dtrexc,DTREXC) -#define LAPACK_ctrexc LAPACK_GLOBAL(ctrexc,CTREXC) -#define LAPACK_ztrexc LAPACK_GLOBAL(ztrexc,ZTREXC) -#define LAPACK_strsen LAPACK_GLOBAL(strsen,STRSEN) -#define LAPACK_dtrsen LAPACK_GLOBAL(dtrsen,DTRSEN) -#define LAPACK_ctrsen LAPACK_GLOBAL(ctrsen,CTRSEN) -#define LAPACK_ztrsen LAPACK_GLOBAL(ztrsen,ZTRSEN) -#define LAPACK_strsyl LAPACK_GLOBAL(strsyl,STRSYL) -#define LAPACK_dtrsyl LAPACK_GLOBAL(dtrsyl,DTRSYL) -#define LAPACK_ctrsyl LAPACK_GLOBAL(ctrsyl,CTRSYL) -#define LAPACK_ztrsyl LAPACK_GLOBAL(ztrsyl,ZTRSYL) -#define LAPACK_sgghrd LAPACK_GLOBAL(sgghrd,SGGHRD) -#define LAPACK_dgghrd LAPACK_GLOBAL(dgghrd,DGGHRD) -#define LAPACK_cgghrd LAPACK_GLOBAL(cgghrd,CGGHRD) -#define LAPACK_zgghrd LAPACK_GLOBAL(zgghrd,ZGGHRD) -#define LAPACK_sgghd3 LAPACK_GLOBAL(sgghd3,SGGHD3) -#define LAPACK_dgghd3 LAPACK_GLOBAL(dgghd3,DGGHD3) -#define LAPACK_cgghd3 LAPACK_GLOBAL(cgghd3,CGGHD3) -#define LAPACK_zgghd3 LAPACK_GLOBAL(zgghd3,ZGGHD3) -#define LAPACK_sggbal LAPACK_GLOBAL(sggbal,SGGBAL) -#define LAPACK_dggbal LAPACK_GLOBAL(dggbal,DGGBAL) -#define LAPACK_cggbal LAPACK_GLOBAL(cggbal,CGGBAL) -#define LAPACK_zggbal LAPACK_GLOBAL(zggbal,ZGGBAL) -#define LAPACK_sggbak LAPACK_GLOBAL(sggbak,SGGBAK) -#define LAPACK_dggbak LAPACK_GLOBAL(dggbak,DGGBAK) -#define LAPACK_cggbak LAPACK_GLOBAL(cggbak,CGGBAK) -#define LAPACK_zggbak LAPACK_GLOBAL(zggbak,ZGGBAK) -#define LAPACK_shgeqz LAPACK_GLOBAL(shgeqz,SHGEQZ) -#define LAPACK_dhgeqz LAPACK_GLOBAL(dhgeqz,DHGEQZ) -#define LAPACK_chgeqz LAPACK_GLOBAL(chgeqz,CHGEQZ) -#define LAPACK_zhgeqz LAPACK_GLOBAL(zhgeqz,ZHGEQZ) -#define LAPACK_stgevc LAPACK_GLOBAL(stgevc,STGEVC) -#define LAPACK_dtgevc LAPACK_GLOBAL(dtgevc,DTGEVC) -#define LAPACK_ctgevc LAPACK_GLOBAL(ctgevc,CTGEVC) -#define LAPACK_ztgevc LAPACK_GLOBAL(ztgevc,ZTGEVC) -#define LAPACK_stgexc LAPACK_GLOBAL(stgexc,STGEXC) -#define LAPACK_dtgexc LAPACK_GLOBAL(dtgexc,DTGEXC) -#define LAPACK_ctgexc LAPACK_GLOBAL(ctgexc,CTGEXC) -#define LAPACK_ztgexc LAPACK_GLOBAL(ztgexc,ZTGEXC) -#define LAPACK_stgsen LAPACK_GLOBAL(stgsen,STGSEN) -#define LAPACK_dtgsen LAPACK_GLOBAL(dtgsen,DTGSEN) -#define LAPACK_ctgsen LAPACK_GLOBAL(ctgsen,CTGSEN) -#define LAPACK_ztgsen LAPACK_GLOBAL(ztgsen,ZTGSEN) -#define LAPACK_stgsyl LAPACK_GLOBAL(stgsyl,STGSYL) -#define LAPACK_dtgsyl LAPACK_GLOBAL(dtgsyl,DTGSYL) -#define LAPACK_ctgsyl LAPACK_GLOBAL(ctgsyl,CTGSYL) -#define LAPACK_ztgsyl LAPACK_GLOBAL(ztgsyl,ZTGSYL) -#define LAPACK_stgsna LAPACK_GLOBAL(stgsna,STGSNA) -#define LAPACK_dtgsna LAPACK_GLOBAL(dtgsna,DTGSNA) -#define LAPACK_ctgsna LAPACK_GLOBAL(ctgsna,CTGSNA) -#define LAPACK_ztgsna LAPACK_GLOBAL(ztgsna,ZTGSNA) -#define LAPACK_sggsvp LAPACK_GLOBAL(sggsvp,SGGSVP) -#define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP) -#define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP) -#define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP) -#define LAPACK_sggsvp3 LAPACK_GLOBAL(sggsvp3,SGGSVP3) -#define LAPACK_dggsvp3 LAPACK_GLOBAL(dggsvp3,DGGSVP3) -#define LAPACK_cggsvp3 LAPACK_GLOBAL(cggsvp3,CGGSVP3) -#define LAPACK_zggsvp3 LAPACK_GLOBAL(zggsvp3,ZGGSVP3) -#define LAPACK_stgsja LAPACK_GLOBAL(stgsja,STGSJA) -#define LAPACK_dtgsja LAPACK_GLOBAL(dtgsja,DTGSJA) -#define LAPACK_ctgsja LAPACK_GLOBAL(ctgsja,CTGSJA) -#define LAPACK_ztgsja LAPACK_GLOBAL(ztgsja,ZTGSJA) -#define LAPACK_sgels LAPACK_GLOBAL(sgels,SGELS) -#define LAPACK_dgels LAPACK_GLOBAL(dgels,DGELS) -#define LAPACK_cgels LAPACK_GLOBAL(cgels,CGELS) -#define LAPACK_zgels LAPACK_GLOBAL(zgels,ZGELS) -#define LAPACK_sgelsy LAPACK_GLOBAL(sgelsy,SGELSY) -#define LAPACK_dgelsy LAPACK_GLOBAL(dgelsy,DGELSY) -#define LAPACK_cgelsy LAPACK_GLOBAL(cgelsy,CGELSY) -#define LAPACK_zgelsy LAPACK_GLOBAL(zgelsy,ZGELSY) -#define LAPACK_sgelss LAPACK_GLOBAL(sgelss,SGELSS) -#define LAPACK_dgelss LAPACK_GLOBAL(dgelss,DGELSS) -#define LAPACK_cgelss LAPACK_GLOBAL(cgelss,CGELSS) -#define LAPACK_zgelss LAPACK_GLOBAL(zgelss,ZGELSS) -#define LAPACK_sgelsd LAPACK_GLOBAL(sgelsd,SGELSD) -#define LAPACK_dgelsd LAPACK_GLOBAL(dgelsd,DGELSD) -#define LAPACK_cgelsd LAPACK_GLOBAL(cgelsd,CGELSD) -#define LAPACK_zgelsd LAPACK_GLOBAL(zgelsd,ZGELSD) -#define LAPACK_sgglse LAPACK_GLOBAL(sgglse,SGGLSE) -#define LAPACK_dgglse LAPACK_GLOBAL(dgglse,DGGLSE) -#define LAPACK_cgglse LAPACK_GLOBAL(cgglse,CGGLSE) -#define LAPACK_zgglse LAPACK_GLOBAL(zgglse,ZGGLSE) -#define LAPACK_sggglm LAPACK_GLOBAL(sggglm,SGGGLM) -#define LAPACK_dggglm LAPACK_GLOBAL(dggglm,DGGGLM) -#define LAPACK_cggglm LAPACK_GLOBAL(cggglm,CGGGLM) -#define LAPACK_zggglm LAPACK_GLOBAL(zggglm,ZGGGLM) -#define LAPACK_ssyev LAPACK_GLOBAL(ssyev,SSYEV) -#define LAPACK_dsyev LAPACK_GLOBAL(dsyev,DSYEV) -#define LAPACK_cheev LAPACK_GLOBAL(cheev,CHEEV) -#define LAPACK_zheev LAPACK_GLOBAL(zheev,ZHEEV) -#define LAPACK_ssyev_2stage LAPACK_GLOBAL(ssyev_2stage,SSYEV_2STAGE) -#define LAPACK_dsyev_2stage LAPACK_GLOBAL(dsyev_2stage,DSYEV_2STAGE) -#define LAPACK_cheev_2stage LAPACK_GLOBAL(cheev_2stage,CHEEV_2STAGE) -#define LAPACK_zheev_2stage LAPACK_GLOBAL(zheev_2stage,ZHEEV_2STAGE) -#define LAPACK_ssyevd LAPACK_GLOBAL(ssyevd,SSYEVD) -#define LAPACK_dsyevd LAPACK_GLOBAL(dsyevd,DSYEVD) -#define LAPACK_cheevd LAPACK_GLOBAL(cheevd,CHEEVD) -#define LAPACK_zheevd LAPACK_GLOBAL(zheevd,ZHEEVD) -#define LAPACK_ssyevd_2stage LAPACK_GLOBAL(ssyevd_2stage,SSYEVD_2STAGE) -#define LAPACK_dsyevd_2stage LAPACK_GLOBAL(dsyevd_2stage,DSYEVD_2STAGE) -#define LAPACK_cheevd_2stage LAPACK_GLOBAL(cheevd_2stage,CHEEVD_2STAGE) -#define LAPACK_zheevd_2stage LAPACK_GLOBAL(zheevd_2stage,ZHEEVD_2STAGE) -#define LAPACK_ssyevx LAPACK_GLOBAL(ssyevx,SSYEVX) -#define LAPACK_dsyevx LAPACK_GLOBAL(dsyevx,DSYEVX) -#define LAPACK_cheevx LAPACK_GLOBAL(cheevx,CHEEVX) -#define LAPACK_zheevx LAPACK_GLOBAL(zheevx,ZHEEVX) -#define LAPACK_ssyevx_2stage LAPACK_GLOBAL(ssyevx_2stage,SSYEVX_2STAGE) -#define LAPACK_dsyevx_2stage LAPACK_GLOBAL(dsyevx_2stage,DSYEVX_2STAGE) -#define LAPACK_cheevx_2stage LAPACK_GLOBAL(cheevx_2stage,CHEEVX_2STAGE) -#define LAPACK_zheevx_2stage LAPACK_GLOBAL(zheevx_2stage,ZHEEVX_2STAGE) -#define LAPACK_ssyevr LAPACK_GLOBAL(ssyevr,SSYEVR) -#define LAPACK_dsyevr LAPACK_GLOBAL(dsyevr,DSYEVR) -#define LAPACK_cheevr LAPACK_GLOBAL(cheevr,CHEEVR) -#define LAPACK_zheevr LAPACK_GLOBAL(zheevr,ZHEEVR) -#define LAPACK_ssyevr_2stage LAPACK_GLOBAL(ssyevr_2stage,SSYEVR_2STAGE) -#define LAPACK_dsyevr_2stage LAPACK_GLOBAL(dsyevr_2stage,DSYEVR_2STAGE) -#define LAPACK_cheevr_2stage LAPACK_GLOBAL(cheevr_2stage,CHEEVR_2STAGE) -#define LAPACK_zheevr_2stage LAPACK_GLOBAL(zheevr_2stage,ZHEEVR_2STAGE) -#define LAPACK_sspev LAPACK_GLOBAL(sspev,SSPEV) -#define LAPACK_dspev LAPACK_GLOBAL(dspev,DSPEV) -#define LAPACK_chpev LAPACK_GLOBAL(chpev,CHPEV) -#define LAPACK_zhpev LAPACK_GLOBAL(zhpev,ZHPEV) -#define LAPACK_sspevd LAPACK_GLOBAL(sspevd,SSPEVD) -#define LAPACK_dspevd LAPACK_GLOBAL(dspevd,DSPEVD) -#define LAPACK_chpevd LAPACK_GLOBAL(chpevd,CHPEVD) -#define LAPACK_zhpevd LAPACK_GLOBAL(zhpevd,ZHPEVD) -#define LAPACK_sspevx LAPACK_GLOBAL(sspevx,SSPEVX) -#define LAPACK_dspevx LAPACK_GLOBAL(dspevx,DSPEVX) -#define LAPACK_chpevx LAPACK_GLOBAL(chpevx,CHPEVX) -#define LAPACK_zhpevx LAPACK_GLOBAL(zhpevx,ZHPEVX) -#define LAPACK_ssbev LAPACK_GLOBAL(ssbev,SSBEV) -#define LAPACK_dsbev LAPACK_GLOBAL(dsbev,DSBEV) -#define LAPACK_chbev LAPACK_GLOBAL(chbev,CHBEV) -#define LAPACK_zhbev LAPACK_GLOBAL(zhbev,ZHBEV) -#define LAPACK_ssbev_2stage LAPACK_GLOBAL(ssbev_2stage,SSBEV_2STAGE) -#define LAPACK_dsbev_2stage LAPACK_GLOBAL(dsbev_2stage,DSBEV_2STAGE) -#define LAPACK_chbev_2stage LAPACK_GLOBAL(chbev_2stage,CHBEV_2STAGE) -#define LAPACK_zhbev_2stage LAPACK_GLOBAL(zhbev_2stage,ZHBEV_2STAGE) -#define LAPACK_ssbevd LAPACK_GLOBAL(ssbevd,SSBEVD) -#define LAPACK_dsbevd LAPACK_GLOBAL(dsbevd,DSBEVD) -#define LAPACK_chbevd LAPACK_GLOBAL(chbevd,CHBEVD) -#define LAPACK_zhbevd LAPACK_GLOBAL(zhbevd,ZHBEVD) -#define LAPACK_ssbevd_2stage LAPACK_GLOBAL(ssbevd_2stage,SSBEVD_2STAGE) -#define LAPACK_dsbevd_2stage LAPACK_GLOBAL(dsbevd_2stage,DSBEVD_2STAGE) -#define LAPACK_chbevd_2stage LAPACK_GLOBAL(chbevd_2stage,CHBEVD_2STAGE) -#define LAPACK_zhbevd_2stage LAPACK_GLOBAL(zhbevd_2stage,ZHBEVD_2STAGE) -#define LAPACK_ssbevx LAPACK_GLOBAL(ssbevx,SSBEVX) -#define LAPACK_dsbevx LAPACK_GLOBAL(dsbevx,DSBEVX) -#define LAPACK_chbevx LAPACK_GLOBAL(chbevx,CHBEVX) -#define LAPACK_zhbevx LAPACK_GLOBAL(zhbevx,ZHBEVX) -#define LAPACK_ssbevx_2stage LAPACK_GLOBAL(ssbevx_2stage,SSBEVX_2STAGE) -#define LAPACK_dsbevx_2stage LAPACK_GLOBAL(dsbevx_2stage,DSBEVX_2STAGE) -#define LAPACK_chbevx_2stage LAPACK_GLOBAL(chbevx_2stage,CHBEVX_2STAGE) -#define LAPACK_zhbevx_2stage LAPACK_GLOBAL(zhbevx_2stage,ZHBEVX_2STAGE) -#define LAPACK_sstev LAPACK_GLOBAL(sstev,SSTEV) -#define LAPACK_dstev LAPACK_GLOBAL(dstev,DSTEV) -#define LAPACK_sstevd LAPACK_GLOBAL(sstevd,SSTEVD) -#define LAPACK_dstevd LAPACK_GLOBAL(dstevd,DSTEVD) -#define LAPACK_sstevx LAPACK_GLOBAL(sstevx,SSTEVX) -#define LAPACK_dstevx LAPACK_GLOBAL(dstevx,DSTEVX) -#define LAPACK_sstevr LAPACK_GLOBAL(sstevr,SSTEVR) -#define LAPACK_dstevr LAPACK_GLOBAL(dstevr,DSTEVR) -#define LAPACK_sgees LAPACK_GLOBAL(sgees,SGEES) -#define LAPACK_dgees LAPACK_GLOBAL(dgees,DGEES) -#define LAPACK_cgees LAPACK_GLOBAL(cgees,CGEES) -#define LAPACK_zgees LAPACK_GLOBAL(zgees,ZGEES) -#define LAPACK_sgeesx LAPACK_GLOBAL(sgeesx,SGEESX) -#define LAPACK_dgeesx LAPACK_GLOBAL(dgeesx,DGEESX) -#define LAPACK_cgeesx LAPACK_GLOBAL(cgeesx,CGEESX) -#define LAPACK_zgeesx LAPACK_GLOBAL(zgeesx,ZGEESX) -#define LAPACK_sgeev LAPACK_GLOBAL(sgeev,SGEEV) -#define LAPACK_dgeev LAPACK_GLOBAL(dgeev,DGEEV) -#define LAPACK_cgeev LAPACK_GLOBAL(cgeev,CGEEV) -#define LAPACK_zgeev LAPACK_GLOBAL(zgeev,ZGEEV) -#define LAPACK_sgeevx LAPACK_GLOBAL(sgeevx,SGEEVX) -#define LAPACK_dgeevx LAPACK_GLOBAL(dgeevx,DGEEVX) -#define LAPACK_cgeevx LAPACK_GLOBAL(cgeevx,CGEEVX) -#define LAPACK_zgeevx LAPACK_GLOBAL(zgeevx,ZGEEVX) -#define LAPACK_sgesvd LAPACK_GLOBAL(sgesvd,SGESVD) -#define LAPACK_dgesvd LAPACK_GLOBAL(dgesvd,DGESVD) -#define LAPACK_cgesvd LAPACK_GLOBAL(cgesvd,CGESVD) -#define LAPACK_zgesvd LAPACK_GLOBAL(zgesvd,ZGESVD) -#define LAPACK_sgesvdx LAPACK_GLOBAL(sgesvdx,SGESVDX) -#define LAPACK_dgesvdx LAPACK_GLOBAL(dgesvdx,DGESVDX) -#define LAPACK_cgesvdx LAPACK_GLOBAL(cgesvdx,CGESVDX) -#define LAPACK_zgesvdx LAPACK_GLOBAL(zgesvdx,ZGESVDX) -#define LAPACK_sgesdd LAPACK_GLOBAL(sgesdd,SGESDD) -#define LAPACK_dgesdd LAPACK_GLOBAL(dgesdd,DGESDD) -#define LAPACK_cgesdd LAPACK_GLOBAL(cgesdd,CGESDD) -#define LAPACK_zgesdd LAPACK_GLOBAL(zgesdd,ZGESDD) -#define LAPACK_sgejsv LAPACK_GLOBAL(sgejsv,SGEJSV) -#define LAPACK_dgejsv LAPACK_GLOBAL(dgejsv,DGEJSV) -#define LAPACK_cgejsv LAPACK_GLOBAL(cgejsv,CGEJSV) -#define LAPACK_zgejsv LAPACK_GLOBAL(zgejsv,ZGEJSV) -#define LAPACK_sgesvj LAPACK_GLOBAL(sgesvj,SGESVJ) -#define LAPACK_dgesvj LAPACK_GLOBAL(dgesvj,DGESVJ) -#define LAPACK_cgesvj LAPACK_GLOBAL(cgesvj,CGESVJ) -#define LAPACK_zgesvj LAPACK_GLOBAL(zgesvj,ZGESVJ) -#define LAPACK_sggsvd LAPACK_GLOBAL(sggsvd,SGGSVD) -#define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD) -#define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD) -#define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD) -#define LAPACK_ssygv LAPACK_GLOBAL(ssygv,SSYGV) -#define LAPACK_dsygv LAPACK_GLOBAL(dsygv,DSYGV) -#define LAPACK_chegv LAPACK_GLOBAL(chegv,CHEGV) -#define LAPACK_zhegv LAPACK_GLOBAL(zhegv,ZHEGV) -#define LAPACK_ssygv_2stage LAPACK_GLOBAL(ssygv_2stage,SSYGV_2STAGE) -#define LAPACK_dsygv_2stage LAPACK_GLOBAL(dsygv_2stage,DSYGV_2STAGE) -#define LAPACK_chegv_2stage LAPACK_GLOBAL(chegv_2stage,CHEGV_2STAGE) -#define LAPACK_zhegv_2stage LAPACK_GLOBAL(zhegv_2stage,ZHEGV_2STAGE) -#define LAPACK_ssygvd LAPACK_GLOBAL(ssygvd,SSYGVD) -#define LAPACK_dsygvd LAPACK_GLOBAL(dsygvd,DSYGVD) -#define LAPACK_chegvd LAPACK_GLOBAL(chegvd,CHEGVD) -#define LAPACK_zhegvd LAPACK_GLOBAL(zhegvd,ZHEGVD) -#define LAPACK_ssygvx LAPACK_GLOBAL(ssygvx,SSYGVX) -#define LAPACK_dsygvx LAPACK_GLOBAL(dsygvx,DSYGVX) -#define LAPACK_chegvx LAPACK_GLOBAL(chegvx,CHEGVX) -#define LAPACK_zhegvx LAPACK_GLOBAL(zhegvx,ZHEGVX) -#define LAPACK_sspgv LAPACK_GLOBAL(sspgv,SSPGV) -#define LAPACK_dspgv LAPACK_GLOBAL(dspgv,DSPGV) -#define LAPACK_chpgv LAPACK_GLOBAL(chpgv,CHPGV) -#define LAPACK_zhpgv LAPACK_GLOBAL(zhpgv,ZHPGV) -#define LAPACK_sspgvd LAPACK_GLOBAL(sspgvd,SSPGVD) -#define LAPACK_dspgvd LAPACK_GLOBAL(dspgvd,DSPGVD) -#define LAPACK_chpgvd LAPACK_GLOBAL(chpgvd,CHPGVD) -#define LAPACK_zhpgvd LAPACK_GLOBAL(zhpgvd,ZHPGVD) -#define LAPACK_sspgvx LAPACK_GLOBAL(sspgvx,SSPGVX) -#define LAPACK_dspgvx LAPACK_GLOBAL(dspgvx,DSPGVX) -#define LAPACK_chpgvx LAPACK_GLOBAL(chpgvx,CHPGVX) -#define LAPACK_zhpgvx LAPACK_GLOBAL(zhpgvx,ZHPGVX) -#define LAPACK_ssbgv LAPACK_GLOBAL(ssbgv,SSBGV) -#define LAPACK_dsbgv LAPACK_GLOBAL(dsbgv,DSBGV) -#define LAPACK_chbgv LAPACK_GLOBAL(chbgv,CHBGV) -#define LAPACK_zhbgv LAPACK_GLOBAL(zhbgv,ZHBGV) -#define LAPACK_ssbgvd LAPACK_GLOBAL(ssbgvd,SSBGVD) -#define LAPACK_dsbgvd LAPACK_GLOBAL(dsbgvd,DSBGVD) -#define LAPACK_chbgvd LAPACK_GLOBAL(chbgvd,CHBGVD) -#define LAPACK_zhbgvd LAPACK_GLOBAL(zhbgvd,ZHBGVD) -#define LAPACK_ssbgvx LAPACK_GLOBAL(ssbgvx,SSBGVX) -#define LAPACK_dsbgvx LAPACK_GLOBAL(dsbgvx,DSBGVX) -#define LAPACK_chbgvx LAPACK_GLOBAL(chbgvx,CHBGVX) -#define LAPACK_zhbgvx LAPACK_GLOBAL(zhbgvx,ZHBGVX) -#define LAPACK_sgges LAPACK_GLOBAL(sgges,SGGES) -#define LAPACK_dgges LAPACK_GLOBAL(dgges,DGGES) -#define LAPACK_cgges LAPACK_GLOBAL(cgges,CGGES) -#define LAPACK_zgges LAPACK_GLOBAL(zgges,ZGGES) -#define LAPACK_sgges3 LAPACK_GLOBAL(sgges3,SGGES3) -#define LAPACK_dgges3 LAPACK_GLOBAL(dgges3,DGGES3) -#define LAPACK_cgges3 LAPACK_GLOBAL(cgges3,CGGES3) -#define LAPACK_zgges3 LAPACK_GLOBAL(zgges3,ZGGES3) -#define LAPACK_sggesx LAPACK_GLOBAL(sggesx,SGGESX) -#define LAPACK_dggesx LAPACK_GLOBAL(dggesx,DGGESX) -#define LAPACK_cggesx LAPACK_GLOBAL(cggesx,CGGESX) -#define LAPACK_zggesx LAPACK_GLOBAL(zggesx,ZGGESX) -#define LAPACK_sggev LAPACK_GLOBAL(sggev,SGGEV) -#define LAPACK_dggev LAPACK_GLOBAL(dggev,DGGEV) -#define LAPACK_cggev LAPACK_GLOBAL(cggev,CGGEV) -#define LAPACK_zggev LAPACK_GLOBAL(zggev,ZGGEV) -#define LAPACK_sggev3 LAPACK_GLOBAL(sggev3,SGGEV3) -#define LAPACK_dggev3 LAPACK_GLOBAL(dggev3,DGGEV3) -#define LAPACK_cggev3 LAPACK_GLOBAL(cggev3,CGGEV3) -#define LAPACK_zggev3 LAPACK_GLOBAL(zggev3,ZGGEV3) -#define LAPACK_sggevx LAPACK_GLOBAL(sggevx,SGGEVX) -#define LAPACK_dggevx LAPACK_GLOBAL(dggevx,DGGEVX) -#define LAPACK_cggevx LAPACK_GLOBAL(cggevx,CGGEVX) -#define LAPACK_zggevx LAPACK_GLOBAL(zggevx,ZGGEVX) -#define LAPACK_dsfrk LAPACK_GLOBAL(dsfrk,DSFRK) -#define LAPACK_ssfrk LAPACK_GLOBAL(ssfrk,SSFRK) -#define LAPACK_zhfrk LAPACK_GLOBAL(zhfrk,ZHFRK) -#define LAPACK_chfrk LAPACK_GLOBAL(chfrk,CHFRK) -#define LAPACK_dtfsm LAPACK_GLOBAL(dtfsm,DTFSM) -#define LAPACK_stfsm LAPACK_GLOBAL(stfsm,STFSM) -#define LAPACK_ztfsm LAPACK_GLOBAL(ztfsm,ZTFSM) -#define LAPACK_ctfsm LAPACK_GLOBAL(ctfsm,CTFSM) -#define LAPACK_dtfttp LAPACK_GLOBAL(dtfttp,DTFTTP) -#define LAPACK_stfttp LAPACK_GLOBAL(stfttp,STFTTP) -#define LAPACK_ztfttp LAPACK_GLOBAL(ztfttp,ZTFTTP) -#define LAPACK_ctfttp LAPACK_GLOBAL(ctfttp,CTFTTP) -#define LAPACK_dtfttr LAPACK_GLOBAL(dtfttr,DTFTTR) -#define LAPACK_stfttr LAPACK_GLOBAL(stfttr,STFTTR) -#define LAPACK_ztfttr LAPACK_GLOBAL(ztfttr,ZTFTTR) -#define LAPACK_ctfttr LAPACK_GLOBAL(ctfttr,CTFTTR) -#define LAPACK_dtpttf LAPACK_GLOBAL(dtpttf,DTPTTF) -#define LAPACK_stpttf LAPACK_GLOBAL(stpttf,STPTTF) -#define LAPACK_ztpttf LAPACK_GLOBAL(ztpttf,ZTPTTF) -#define LAPACK_ctpttf LAPACK_GLOBAL(ctpttf,CTPTTF) -#define LAPACK_dtpttr LAPACK_GLOBAL(dtpttr,DTPTTR) -#define LAPACK_stpttr LAPACK_GLOBAL(stpttr,STPTTR) -#define LAPACK_ztpttr LAPACK_GLOBAL(ztpttr,ZTPTTR) -#define LAPACK_ctpttr LAPACK_GLOBAL(ctpttr,CTPTTR) -#define LAPACK_dtrttf LAPACK_GLOBAL(dtrttf,DTRTTF) -#define LAPACK_strttf LAPACK_GLOBAL(strttf,STRTTF) -#define LAPACK_ztrttf LAPACK_GLOBAL(ztrttf,ZTRTTF) -#define LAPACK_ctrttf LAPACK_GLOBAL(ctrttf,CTRTTF) -#define LAPACK_dtrttp LAPACK_GLOBAL(dtrttp,DTRTTP) -#define LAPACK_strttp LAPACK_GLOBAL(strttp,STRTTP) -#define LAPACK_ztrttp LAPACK_GLOBAL(ztrttp,ZTRTTP) -#define LAPACK_ctrttp LAPACK_GLOBAL(ctrttp,CTRTTP) -#define LAPACK_sgeqrfp LAPACK_GLOBAL(sgeqrfp,SGEQRFP) -#define LAPACK_dgeqrfp LAPACK_GLOBAL(dgeqrfp,DGEQRFP) -#define LAPACK_cgeqrfp LAPACK_GLOBAL(cgeqrfp,CGEQRFP) -#define LAPACK_zgeqrfp LAPACK_GLOBAL(zgeqrfp,ZGEQRFP) -#define LAPACK_clacgv LAPACK_GLOBAL(clacgv,CLACGV) -#define LAPACK_zlacgv LAPACK_GLOBAL(zlacgv,ZLACGV) -#define LAPACK_slarnv LAPACK_GLOBAL(slarnv,SLARNV) -#define LAPACK_dlarnv LAPACK_GLOBAL(dlarnv,DLARNV) -#define LAPACK_clarnv LAPACK_GLOBAL(clarnv,CLARNV) -#define LAPACK_zlarnv LAPACK_GLOBAL(zlarnv,ZLARNV) -#define LAPACK_sgeqr2 LAPACK_GLOBAL(sgeqr2,SGEQR2) -#define LAPACK_dgeqr2 LAPACK_GLOBAL(dgeqr2,DGEQR2) -#define LAPACK_cgeqr2 LAPACK_GLOBAL(cgeqr2,CGEQR2) -#define LAPACK_zgeqr2 LAPACK_GLOBAL(zgeqr2,ZGEQR2) -#define LAPACK_slacn2 LAPACK_GLOBAL(slacn2,SLACN2) -#define LAPACK_dlacn2 LAPACK_GLOBAL(dlacn2,DLACN2) -#define LAPACK_clacn2 LAPACK_GLOBAL(clacn2,CLACN2) -#define LAPACK_zlacn2 LAPACK_GLOBAL(zlacn2,ZLACN2) -#define LAPACK_slacpy LAPACK_GLOBAL(slacpy,SLACPY) -#define LAPACK_dlacpy LAPACK_GLOBAL(dlacpy,DLACPY) -#define LAPACK_clacpy LAPACK_GLOBAL(clacpy,CLACPY) -#define LAPACK_zlacpy LAPACK_GLOBAL(zlacpy,ZLACPY) -#define LAPACK_clacp2 LAPACK_GLOBAL(clacp2,CLACP2) -#define LAPACK_zlacp2 LAPACK_GLOBAL(zlacp2,ZLACP2) -#define LAPACK_sgetf2 LAPACK_GLOBAL(sgetf2,SGETF2) -#define LAPACK_dgetf2 LAPACK_GLOBAL(dgetf2,DGETF2) -#define LAPACK_cgetf2 LAPACK_GLOBAL(cgetf2,CGETF2) -#define LAPACK_zgetf2 LAPACK_GLOBAL(zgetf2,ZGETF2) -#define LAPACK_slaswp LAPACK_GLOBAL(slaswp,SLASWP) -#define LAPACK_dlaswp LAPACK_GLOBAL(dlaswp,DLASWP) -#define LAPACK_claswp LAPACK_GLOBAL(claswp,CLASWP) -#define LAPACK_zlaswp LAPACK_GLOBAL(zlaswp,ZLASWP) -#define LAPACK_slange LAPACK_GLOBAL(slange,SLANGE) -#define LAPACK_dlange LAPACK_GLOBAL(dlange,DLANGE) -#define LAPACK_clange LAPACK_GLOBAL(clange,CLANGE) -#define LAPACK_zlange LAPACK_GLOBAL(zlange,ZLANGE) -#define LAPACK_clanhe LAPACK_GLOBAL(clanhe,CLANHE) -#define LAPACK_zlanhe LAPACK_GLOBAL(zlanhe,ZLANHE) -#define LAPACK_clarcm LAPACK_GLOBAL(clarcm,CLARCM) -#define LAPACK_zlarcm LAPACK_GLOBAL(zlarcm,ZLARCM) -#define LAPACK_clacrm LAPACK_GLOBAL(clacrm,CLACRM) -#define LAPACK_zlacrm LAPACK_GLOBAL(zlacrm,ZLACRM) -#define LAPACK_slansy LAPACK_GLOBAL(slansy,SLANSY) -#define LAPACK_dlansy LAPACK_GLOBAL(dlansy,DLANSY) -#define LAPACK_clansy LAPACK_GLOBAL(clansy,CLANSY) -#define LAPACK_zlansy LAPACK_GLOBAL(zlansy,ZLANSY) -#define LAPACK_slantr LAPACK_GLOBAL(slantr,SLANTR) -#define LAPACK_dlantr LAPACK_GLOBAL(dlantr,DLANTR) -#define LAPACK_clantr LAPACK_GLOBAL(clantr,CLANTR) -#define LAPACK_zlantr LAPACK_GLOBAL(zlantr,ZLANTR) -#define LAPACK_slamch LAPACK_GLOBAL(slamch,SLAMCH) -#define LAPACK_dlamch LAPACK_GLOBAL(dlamch,DLAMCH) -#define LAPACK_sgelq2 LAPACK_GLOBAL(sgelq2,SGELQ2) -#define LAPACK_dgelq2 LAPACK_GLOBAL(dgelq2,DGELQ2) -#define LAPACK_cgelq2 LAPACK_GLOBAL(cgelq2,CGELQ2) -#define LAPACK_zgelq2 LAPACK_GLOBAL(zgelq2,ZGELQ2) -#define LAPACK_slarfb LAPACK_GLOBAL(slarfb,SLARFB) -#define LAPACK_dlarfb LAPACK_GLOBAL(dlarfb,DLARFB) -#define LAPACK_clarfb LAPACK_GLOBAL(clarfb,CLARFB) -#define LAPACK_zlarfb LAPACK_GLOBAL(zlarfb,ZLARFB) -#define LAPACK_slarfg LAPACK_GLOBAL(slarfg,SLARFG) -#define LAPACK_dlarfg LAPACK_GLOBAL(dlarfg,DLARFG) -#define LAPACK_clarfg LAPACK_GLOBAL(clarfg,CLARFG) -#define LAPACK_zlarfg LAPACK_GLOBAL(zlarfg,ZLARFG) -#define LAPACK_slassq LAPACK_GLOBAL(slassq,SLASSQ) -#define LAPACK_dlassq LAPACK_GLOBAL(dlassq,DLASSQ) -#define LAPACK_classq LAPACK_GLOBAL(classq,CLASSQ) -#define LAPACK_zlassq LAPACK_GLOBAL(zlassq,ZLASSQ) -#define LAPACK_slarft LAPACK_GLOBAL(slarft,SLARFT) -#define LAPACK_dlarft LAPACK_GLOBAL(dlarft,DLARFT) -#define LAPACK_clarft LAPACK_GLOBAL(clarft,CLARFT) -#define LAPACK_zlarft LAPACK_GLOBAL(zlarft,ZLARFT) -#define LAPACK_slarfx LAPACK_GLOBAL(slarfx,SLARFX) -#define LAPACK_dlarfx LAPACK_GLOBAL(dlarfx,DLARFX) -#define LAPACK_clarfx LAPACK_GLOBAL(clarfx,CLARFX) -#define LAPACK_zlarfx LAPACK_GLOBAL(zlarfx,ZLARFX) -#define LAPACK_slatms LAPACK_GLOBAL(slatms,SLATMS) -#define LAPACK_dlatms LAPACK_GLOBAL(dlatms,DLATMS) -#define LAPACK_clatms LAPACK_GLOBAL(clatms,CLATMS) -#define LAPACK_zlatms LAPACK_GLOBAL(zlatms,ZLATMS) -#define LAPACK_slag2d LAPACK_GLOBAL(slag2d,SLAG2D) -#define LAPACK_dlag2s LAPACK_GLOBAL(dlag2s,DLAG2S) -#define LAPACK_clag2z LAPACK_GLOBAL(clag2z,CLAG2Z) -#define LAPACK_zlag2c LAPACK_GLOBAL(zlag2c,ZLAG2C) -#define LAPACK_slauum LAPACK_GLOBAL(slauum,SLAUUM) -#define LAPACK_dlauum LAPACK_GLOBAL(dlauum,DLAUUM) -#define LAPACK_clauum LAPACK_GLOBAL(clauum,CLAUUM) -#define LAPACK_zlauum LAPACK_GLOBAL(zlauum,ZLAUUM) -#define LAPACK_slagge LAPACK_GLOBAL(slagge,SLAGGE) -#define LAPACK_dlagge LAPACK_GLOBAL(dlagge,DLAGGE) -#define LAPACK_clagge LAPACK_GLOBAL(clagge,CLAGGE) -#define LAPACK_zlagge LAPACK_GLOBAL(zlagge,ZLAGGE) -#define LAPACK_slascl LAPACK_GLOBAL(slascl,SLASCL) -#define LAPACK_dlascl LAPACK_GLOBAL(dlascl,DLASCL) -#define LAPACK_clascl LAPACK_GLOBAL(clascl,CLASCL) -#define LAPACK_zlascl LAPACK_GLOBAL(zlascl,ZLASCL) -#define LAPACK_slaset LAPACK_GLOBAL(slaset,SLASET) -#define LAPACK_dlaset LAPACK_GLOBAL(dlaset,DLASET) -#define LAPACK_claset LAPACK_GLOBAL(claset,CLASET) -#define LAPACK_zlaset LAPACK_GLOBAL(zlaset,ZLASET) -#define LAPACK_slasrt LAPACK_GLOBAL(slasrt,SLASRT) -#define LAPACK_dlasrt LAPACK_GLOBAL(dlasrt,DLASRT) -#define LAPACK_slagsy LAPACK_GLOBAL(slagsy,SLAGSY) -#define LAPACK_dlagsy LAPACK_GLOBAL(dlagsy,DLAGSY) -#define LAPACK_clagsy LAPACK_GLOBAL(clagsy,CLAGSY) -#define LAPACK_zlagsy LAPACK_GLOBAL(zlagsy,ZLAGSY) -#define LAPACK_claghe LAPACK_GLOBAL(claghe,CLAGHE) -#define LAPACK_zlaghe LAPACK_GLOBAL(zlaghe,ZLAGHE) -#define LAPACK_slapmr LAPACK_GLOBAL(slapmr,SLAPMR) -#define LAPACK_dlapmr LAPACK_GLOBAL(dlapmr,DLAPMR) -#define LAPACK_clapmr LAPACK_GLOBAL(clapmr,CLAPMR) -#define LAPACK_zlapmr LAPACK_GLOBAL(zlapmr,ZLAPMR) -#define LAPACK_slapmt LAPACK_GLOBAL(slapmt,SLAPMT) -#define LAPACK_dlapmt LAPACK_GLOBAL(dlapmt,DLAPMT) -#define LAPACK_clapmt LAPACK_GLOBAL(clapmt,CLAPMT) -#define LAPACK_zlapmt LAPACK_GLOBAL(zlapmt,ZLAPMT) -#define LAPACK_slapy2 LAPACK_GLOBAL(slapy2,SLAPY2) -#define LAPACK_dlapy2 LAPACK_GLOBAL(dlapy2,DLAPY2) -#define LAPACK_slapy3 LAPACK_GLOBAL(slapy3,SLAPY3) -#define LAPACK_dlapy3 LAPACK_GLOBAL(dlapy3,DLAPY3) -#define LAPACK_slartgp LAPACK_GLOBAL(slartgp,SLARTGP) -#define LAPACK_dlartgp LAPACK_GLOBAL(dlartgp,DLARTGP) -#define LAPACK_slartgs LAPACK_GLOBAL(slartgs,SLARTGS) -#define LAPACK_dlartgs LAPACK_GLOBAL(dlartgs,DLARTGS) -// LAPACK 3.3.0 -#define LAPACK_cbbcsd LAPACK_GLOBAL(cbbcsd,CBBCSD) -#define LAPACK_cheswapr LAPACK_GLOBAL(cheswapr,CHESWAPR) -#define LAPACK_chetri2 LAPACK_GLOBAL(chetri2,CHETRI2) -#define LAPACK_chetri2x LAPACK_GLOBAL(chetri2x,CHETRI2X) -#define LAPACK_chetrs2 LAPACK_GLOBAL(chetrs2,CHETRS2) -#define LAPACK_csyconv LAPACK_GLOBAL(csyconv,CSYCONV) -#define LAPACK_csyswapr LAPACK_GLOBAL(csyswapr,CSYSWAPR) -#define LAPACK_csytri2 LAPACK_GLOBAL(csytri2,CSYTRI2) -#define LAPACK_csytri2x LAPACK_GLOBAL(csytri2x,CSYTRI2X) -#define LAPACK_csytrs2 LAPACK_GLOBAL(csytrs2,CSYTRS2) -#define LAPACK_cunbdb LAPACK_GLOBAL(cunbdb,CUNBDB) -#define LAPACK_cuncsd LAPACK_GLOBAL(cuncsd,CUNCSD) -#define LAPACK_cuncsd2by1 LAPACK_GLOBAL(cuncsd2by1,CUNCSD2BY1) -#define LAPACK_dbbcsd LAPACK_GLOBAL(dbbcsd,DBBCSD) -#define LAPACK_dorbdb LAPACK_GLOBAL(dorbdb,DORBDB) -#define LAPACK_dorcsd LAPACK_GLOBAL(dorcsd,DORCSD) -#define LAPACK_dorcsd2by1 LAPACK_GLOBAL(dorcsd2by1,DORCSD2BY1) -#define LAPACK_dsyconv LAPACK_GLOBAL(dsyconv,DSYCONV) -#define LAPACK_dsyswapr LAPACK_GLOBAL(dsyswapr,DSYSWAPR) -#define LAPACK_dsytri2 LAPACK_GLOBAL(dsytri2,DSYTRI2) -#define LAPACK_dsytri2x LAPACK_GLOBAL(dsytri2x,DSYTRI2X) -#define LAPACK_dsytrs2 LAPACK_GLOBAL(dsytrs2,DSYTRS2) -#define LAPACK_sbbcsd LAPACK_GLOBAL(sbbcsd,SBBCSD) -#define LAPACK_sorbdb LAPACK_GLOBAL(sorbdb,SORBDB) -#define LAPACK_sorcsd LAPACK_GLOBAL(sorcsd,SORCSD) -#define LAPACK_sorcsd2by1 LAPACK_GLOBAL(sorcsd2by1,SORCSD2BY1) -#define LAPACK_ssyconv LAPACK_GLOBAL(ssyconv,SSYCONV) -#define LAPACK_ssyswapr LAPACK_GLOBAL(ssyswapr,SSYSWAPR) -#define LAPACK_ssytri2 LAPACK_GLOBAL(ssytri2,SSYTRI2) -#define LAPACK_ssytri2x LAPACK_GLOBAL(ssytri2x,SSYTRI2X) -#define LAPACK_ssytrs2 LAPACK_GLOBAL(ssytrs2,SSYTRS2) -#define LAPACK_zbbcsd LAPACK_GLOBAL(zbbcsd,ZBBCSD) -#define LAPACK_zheswapr LAPACK_GLOBAL(zheswapr,ZHESWAPR) -#define LAPACK_zhetri2 LAPACK_GLOBAL(zhetri2,ZHETRI2) -#define LAPACK_zhetri2x LAPACK_GLOBAL(zhetri2x,ZHETRI2X) -#define LAPACK_zhetrs2 LAPACK_GLOBAL(zhetrs2,ZHETRS2) -#define LAPACK_zsyconv LAPACK_GLOBAL(zsyconv,ZSYCONV) -#define LAPACK_zsyswapr LAPACK_GLOBAL(zsyswapr,ZSYSWAPR) -#define LAPACK_zsytri2 LAPACK_GLOBAL(zsytri2,ZSYTRI2) -#define LAPACK_zsytri2x LAPACK_GLOBAL(zsytri2x,ZSYTRI2X) -#define LAPACK_zsytrs2 LAPACK_GLOBAL(zsytrs2,ZSYTRS2) -#define LAPACK_zunbdb LAPACK_GLOBAL(zunbdb,ZUNBDB) -#define LAPACK_zuncsd LAPACK_GLOBAL(zuncsd,ZUNCSD) -#define LAPACK_zuncsd2by1 LAPACK_GLOBAL(zuncsd2by1,ZUNCSD2BY1) -// LAPACK 3.4.0 -#define LAPACK_sgemqrt LAPACK_GLOBAL(sgemqrt,SGEMQRT) -#define LAPACK_dgemqrt LAPACK_GLOBAL(dgemqrt,DGEMQRT) -#define LAPACK_cgemqrt LAPACK_GLOBAL(cgemqrt,CGEMQRT) -#define LAPACK_zgemqrt LAPACK_GLOBAL(zgemqrt,ZGEMQRT) -#define LAPACK_sgeqrt LAPACK_GLOBAL(sgeqrt,SGEQRT) -#define LAPACK_dgeqrt LAPACK_GLOBAL(dgeqrt,DGEQRT) -#define LAPACK_cgeqrt LAPACK_GLOBAL(cgeqrt,CGEQRT) -#define LAPACK_zgeqrt LAPACK_GLOBAL(zgeqrt,ZGEQRT) -#define LAPACK_sgeqrt2 LAPACK_GLOBAL(sgeqrt2,SGEQRT2) -#define LAPACK_dgeqrt2 LAPACK_GLOBAL(dgeqrt2,DGEQRT2) -#define LAPACK_cgeqrt2 LAPACK_GLOBAL(cgeqrt2,CGEQRT2) -#define LAPACK_zgeqrt2 LAPACK_GLOBAL(zgeqrt2,ZGEQRT2) -#define LAPACK_sgeqrt3 LAPACK_GLOBAL(sgeqrt3,SGEQRT3) -#define LAPACK_dgeqrt3 LAPACK_GLOBAL(dgeqrt3,DGEQRT3) -#define LAPACK_cgeqrt3 LAPACK_GLOBAL(cgeqrt3,CGEQRT3) -#define LAPACK_zgeqrt3 LAPACK_GLOBAL(zgeqrt3,ZGEQRT3) -#define LAPACK_stpmqrt LAPACK_GLOBAL(stpmqrt,STPMQRT) -#define LAPACK_dtpmqrt LAPACK_GLOBAL(dtpmqrt,DTPMQRT) -#define LAPACK_ctpmqrt LAPACK_GLOBAL(ctpmqrt,CTPMQRT) -#define LAPACK_ztpmqrt LAPACK_GLOBAL(ztpmqrt,ZTPMQRT) -#define LAPACK_stpqrt LAPACK_GLOBAL(stpqrt,STPQRT) -#define LAPACK_dtpqrt LAPACK_GLOBAL(dtpqrt,DTPQRT) -#define LAPACK_ctpqrt LAPACK_GLOBAL(ctpqrt,CTPQRT) -#define LAPACK_ztpqrt LAPACK_GLOBAL(ztpqrt,ZTPQRT) -#define LAPACK_stpqrt2 LAPACK_GLOBAL(stpqrt2,STPQRT2) -#define LAPACK_dtpqrt2 LAPACK_GLOBAL(dtpqrt2,DTPQRT2) -#define LAPACK_ctpqrt2 LAPACK_GLOBAL(ctpqrt2,CTPQRT2) -#define LAPACK_ztpqrt2 LAPACK_GLOBAL(ztpqrt2,ZTPQRT2) -#define LAPACK_stprfb LAPACK_GLOBAL(stprfb,STPRFB) -#define LAPACK_dtprfb LAPACK_GLOBAL(dtprfb,DTPRFB) -#define LAPACK_ctprfb LAPACK_GLOBAL(ctprfb,CTPRFB) -#define LAPACK_ztprfb LAPACK_GLOBAL(ztprfb,ZTPRFB) -// LAPACK 3.5.0 -#define LAPACK_ssysv_rook LAPACK_GLOBAL(ssysv_rook,SSYSV_ROOK) -#define LAPACK_dsysv_rook LAPACK_GLOBAL(dsysv_rook,DSYSV_ROOK) -#define LAPACK_csysv_rook LAPACK_GLOBAL(csysv_rook,CSYSV_ROOK) -#define LAPACK_zsysv_rook LAPACK_GLOBAL(zsysv_rook,ZSYSV_ROOK) -#define LAPACK_csyr LAPACK_GLOBAL(csyr,CSYR) -#define LAPACK_zsyr LAPACK_GLOBAL(zsyr,ZSYR) -#define LAPACK_ilaver LAPACK_GLOBAL(ilaver,ILAVER) -// LAPACK 3.6.0 -#define LAPACK_sggsvd3 LAPACK_GLOBAL(sggsvd3,SGGSVD3) -#define LAPACK_dggsvd3 LAPACK_GLOBAL(dggsvd3,DGGSVD3) -#define LAPACK_cggsvd3 LAPACK_GLOBAL(cggsvd3,CGGSVD3) -#define LAPACK_zggsvd3 LAPACK_GLOBAL(zggsvd3,ZGGSVD3) -// LAPACK 3.7.0 -#define LAPACK_ssysv_aa LAPACK_GLOBAL(ssysv_aa,SSYSV_AA) -#define LAPACK_dsysv_aa LAPACK_GLOBAL(dsysv_aa,DSYSV_AA) -#define LAPACK_chesv_aa LAPACK_GLOBAL(chesv_aa,CHESV_AA) -#define LAPACK_zsysv_aa LAPACK_GLOBAL(zsysv_aa,ZSYSV_AA) -#define LAPACK_csysv_aa LAPACK_GLOBAL(csysv_aa,CSYSV_AA) -#define LAPACK_zhesv_aa LAPACK_GLOBAL(zhesv_aa,ZHESV_AA) -#define LAPACK_ssytrs_aa LAPACK_GLOBAL(ssytrs_aa,SSYTRS_AA) -#define LAPACK_dsytrs_aa LAPACK_GLOBAL(dsytrs_aa,DSYTRS_AA) -#define LAPACK_csytrs_aa LAPACK_GLOBAL(csytrs_aa,CSYTRS_AA) -#define LAPACK_zsytrs_aa LAPACK_GLOBAL(zsytrs_aa,ZSYTRS_AA) -#define LAPACK_chetrs_aa LAPACK_GLOBAL(chetrs_aa,CHETRS_AA) -#define LAPACK_zhetrs_aa LAPACK_GLOBAL(zhetrs_aa,ZHETRS_AA) -#define LAPACK_ssytrf_aa LAPACK_GLOBAL(ssytrf_aa,SSYTRF_AA) -#define LAPACK_dsytrf_aa LAPACK_GLOBAL(dsytrf_aa,DSYTRF_AA) -#define LAPACK_csytrf_aa LAPACK_GLOBAL(csytrf_aa,CSYTRF_AA) -#define LAPACK_zsytrf_aa LAPACK_GLOBAL(zsytrf_aa,ZSYTRF_AA) -#define LAPACK_chetrf_aa LAPACK_GLOBAL(chetrf_aa,CHETRF_AA) -#define LAPACK_zhetrf_aa LAPACK_GLOBAL(zhetrf_aa,ZHETRF_AA) - -#define LAPACK_ssysv_rk LAPACK_GLOBAL(ssysv_rk,SSYSV_RK) -#define LAPACK_dsysv_rk LAPACK_GLOBAL(dsysv_rk,DSYSV_RK) -#define LAPACK_chesv_rk LAPACK_GLOBAL(chesv_rk,CHESV_RK) -#define LAPACK_zsysv_rk LAPACK_GLOBAL(zsysv_rk,ZSYSV_RK) -#define LAPACK_csysv_rk LAPACK_GLOBAL(csysv_rk,CSYSV_RK) -#define LAPACK_zhesv_rk LAPACK_GLOBAL(zhesv_rk,ZHESV_RK) -#define LAPACK_ssytrf_rk LAPACK_GLOBAL(ssytrf_rk,SSYTRF_RK) -#define LAPACK_dsytrf_rk LAPACK_GLOBAL(dsytrf_rk,DSYTRF_RK) -#define LAPACK_csytrf_rk LAPACK_GLOBAL(csytrf_rk,CSYTRF_RK) -#define LAPACK_zsytrf_rk LAPACK_GLOBAL(zsytrf_rk,ZSYTRF_RK) -#define LAPACK_chetrf_rk LAPACK_GLOBAL(chetrf_rk,CHETRF_RK) -#define LAPACK_zhetrf_rk LAPACK_GLOBAL(zhetrf_rk,ZHETRF_RK) -#define LAPACK_ssytrs_3 LAPACK_GLOBAL(ssytrs_3,SSYTRS_3) -#define LAPACK_dsytrs_3 LAPACK_GLOBAL(dsytrs_3,DSYTRS_3) -#define LAPACK_csytrs_3 LAPACK_GLOBAL(csytrs_3,CSYTRS_3) -#define LAPACK_zsytrs_3 LAPACK_GLOBAL(zsytrs_3,ZSYTRS_3) -#define LAPACK_chetrs_3 LAPACK_GLOBAL(chetrs_3,CHETRS_3) -#define LAPACK_zhetrs_3 LAPACK_GLOBAL(zhetrs_3,ZHETRS_3) -#define LAPACK_ssytri_3 LAPACK_GLOBAL(ssytri_3,SSYTRI_3) -#define LAPACK_dsytri_3 LAPACK_GLOBAL(dsytri_3,DSYTRI_3) -#define LAPACK_csytri_3 LAPACK_GLOBAL(csytri_3,CSYTRI_3) -#define LAPACK_zsytri_3 LAPACK_GLOBAL(zsytri_3,ZSYTRI_3) -#define LAPACK_chetri_3 LAPACK_GLOBAL(chetri_3,CHETRI_3) -#define LAPACK_zhetri_3 LAPACK_GLOBAL(zhetri_3,ZHETRI_3) -#define LAPACK_ssycon_3 LAPACK_GLOBAL(ssycon_3,SSYCON_3) -#define LAPACK_dsycon_3 LAPACK_GLOBAL(dsycon_3,DSYCON_3) -#define LAPACK_csycon_3 LAPACK_GLOBAL(csycon_3,CSYCON_3) -#define LAPACK_zsycon_3 LAPACK_GLOBAL(zsycon_3,ZSYCON_3) -#define LAPACK_checon_3 LAPACK_GLOBAL(checon_3,CHECON_3) -#define LAPACK_zhecon_3 LAPACK_GLOBAL(zhecon_3,ZHECON_3) -#define LAPACK_sgelq LAPACK_GLOBAL(sgelq,SGELQ) -#define LAPACK_dgelq LAPACK_GLOBAL(dgelq,DGELQ) -#define LAPACK_cgelq LAPACK_GLOBAL(cgelq,CGELQ) -#define LAPACK_zgelq LAPACK_GLOBAL(zgelq,ZGELQ) -#define LAPACK_sgemlq LAPACK_GLOBAL(sgemlq,SGEMLQ) -#define LAPACK_dgemlq LAPACK_GLOBAL(dgemlq,DGEMLQ) -#define LAPACK_cgemlq LAPACK_GLOBAL(cgemlq,CGEMLQ) -#define LAPACK_zgemlq LAPACK_GLOBAL(zgemlq,ZGEMLQ) -#define LAPACK_sgeqr LAPACK_GLOBAL(sgeqr,SGEQR) -#define LAPACK_dgeqr LAPACK_GLOBAL(dgeqr,DGEQR) -#define LAPACK_cgeqr LAPACK_GLOBAL(cgeqr,CGEQR) -#define LAPACK_zgeqr LAPACK_GLOBAL(zgeqr,ZGEQR) -#define LAPACK_sgemqr LAPACK_GLOBAL(sgemqr,SGEMQR) -#define LAPACK_dgemqr LAPACK_GLOBAL(dgemqr,DGEMQR) -#define LAPACK_cgemqr LAPACK_GLOBAL(cgemqr,CGEMQR) -#define LAPACK_zgemqr LAPACK_GLOBAL(zgemqr,ZGEMQR) -#define LAPACK_sgetsls LAPACK_GLOBAL(sgetsls,SGETSLS) -#define LAPACK_dgetsls LAPACK_GLOBAL(dgetsls,DGETSLS) -#define LAPACK_cgetsls LAPACK_GLOBAL(cgetsls,CGETSLS) -#define LAPACK_zgetsls LAPACK_GLOBAL(zgetsls,ZGETSLS) - -// LAPACK 3.8.0 -#define LAPACK_ssysv_aa_2stage LAPACK_GLOBAL(ssysv_aa_2stage,SSYSV_AA_2STAGE) -#define LAPACK_dsysv_aa_2stage LAPACK_GLOBAL(dsysv_aa_2stage,DSYSV_AA_2STAGE) -#define LAPACK_chesv_aa_2stage LAPACK_GLOBAL(chesv_aa_2stage,CHESV_AA_2STAGE) -#define LAPACK_zsysv_aa_2stage LAPACK_GLOBAL(zsysv_aa_2stage,ZSYSV_AA_2STAGE) -#define LAPACK_csysv_aa_2stage LAPACK_GLOBAL(csysv_aa_2stage,CSYSV_AA_2STAGE) -#define LAPACK_zhesv_aa_2stage LAPACK_GLOBAL(zhesv_aa_2stage,ZHESV_AA_2STAGE) -#define LAPACK_ssytrs_aa_2stage LAPACK_GLOBAL(ssytrs_aa_2stage,SSYTRS_AA_2STAGE) -#define LAPACK_dsytrs_aa_2stage LAPACK_GLOBAL(dsytrs_aa_2stage,DSYTRS_AA_2STAGE) -#define LAPACK_csytrs_aa_2stage LAPACK_GLOBAL(csytrs_aa_2stage,CSYTRS_AA_2STAGE) -#define LAPACK_zsytrs_aa_2stage LAPACK_GLOBAL(zsytrs_aa_2stage,ZSYTRS_AA_2STAGE) -#define LAPACK_chetrs_aa_2stage LAPACK_GLOBAL(chetrs_aa_2stage,CHETRS_AA_2STAGE) -#define LAPACK_zhetrs_aa_2stage LAPACK_GLOBAL(zhetrs_aa_2stage,ZHETRS_AA_2STAGE) -#define LAPACK_ssytrf_aa_2stage LAPACK_GLOBAL(ssytrf_aa_2stage,SSYTRF_AA_2STAGE) -#define LAPACK_dsytrf_aa_2stage LAPACK_GLOBAL(dsytrf_aa_2stage,DSYTRF_AA_2STAGE) -#define LAPACK_csytrf_aa_2stage LAPACK_GLOBAL(csytrf_aa_2stage,CSYTRF_AA_2STAGE) -#define LAPACK_zsytrf_aa_2stage LAPACK_GLOBAL(zsytrf_aa_2stage,ZSYTRF_AA_2STAGE) -#define LAPACK_chetrf_aa_2stage LAPACK_GLOBAL(chetrf_aa_2stage,CHETRF_AA_2STAGE) -#define LAPACK_zhetrf_aa_2stage LAPACK_GLOBAL(zhetrf_aa_2stage,ZHETRF_AA_2STAGE) - - -void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_dgetrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_cgetrf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_zgetrf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_sgetrf2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_dgetrf2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_cgetrf2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_zgetrf2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_sgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, float* ab, lapack_int* ldab, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_dgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, double* ab, lapack_int* ldab, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_cgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_complex_float* ab, lapack_int* ldab, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_zgbtrf( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_complex_double* ab, lapack_int* ldab, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_sgttrf( lapack_int* n, float* dl, float* d, float* du, float* du2, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_dgttrf( lapack_int* n, double* dl, double* d, double* du, - double* du2, lapack_int* ipiv, lapack_int *info ); -void LAPACK_cgttrf( lapack_int* n, lapack_complex_float* dl, - lapack_complex_float* d, lapack_complex_float* du, - lapack_complex_float* du2, lapack_int* ipiv, - lapack_int *info ); -void LAPACK_zgttrf( lapack_int* n, lapack_complex_double* dl, - lapack_complex_double* d, lapack_complex_double* du, - lapack_complex_double* du2, lapack_int* ipiv, - lapack_int *info ); -void LAPACK_spotrf2( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dpotrf2( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_cpotrf2( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_zpotrf2( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_spotrf( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dpotrf( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_cpotrf( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_zpotrf( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_dpstrf( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int* piv, lapack_int* rank, double* tol, - double* work, lapack_int *info ); -void LAPACK_spstrf( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int* piv, lapack_int* rank, float* tol, float* work, - lapack_int *info ); -void LAPACK_zpstrf( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* piv, lapack_int* rank, - double* tol, double* work, lapack_int *info ); -void LAPACK_cpstrf( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* piv, lapack_int* rank, - float* tol, float* work, lapack_int *info ); -void LAPACK_dpftrf( char* transr, char* uplo, lapack_int* n, double* a, - lapack_int *info ); -void LAPACK_spftrf( char* transr, char* uplo, lapack_int* n, float* a, - lapack_int *info ); -void LAPACK_zpftrf( char* transr, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int *info ); -void LAPACK_cpftrf( char* transr, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int *info ); -void LAPACK_spptrf( char* uplo, lapack_int* n, float* ap, lapack_int *info ); -void LAPACK_dpptrf( char* uplo, lapack_int* n, double* ap, lapack_int *info ); -void LAPACK_cpptrf( char* uplo, lapack_int* n, lapack_complex_float* ap, - lapack_int *info ); -void LAPACK_zpptrf( char* uplo, lapack_int* n, lapack_complex_double* ap, - lapack_int *info ); -void LAPACK_spbtrf( char* uplo, lapack_int* n, lapack_int* kd, float* ab, - lapack_int* ldab, lapack_int *info ); -void LAPACK_dpbtrf( char* uplo, lapack_int* n, lapack_int* kd, double* ab, - lapack_int* ldab, lapack_int *info ); -void LAPACK_cpbtrf( char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, - lapack_int *info ); -void LAPACK_zpbtrf( char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, - lapack_int *info ); -void LAPACK_spttrf( lapack_int* n, float* d, float* e, lapack_int *info ); -void LAPACK_dpttrf( lapack_int* n, double* d, double* e, lapack_int *info ); -void LAPACK_cpttrf( lapack_int* n, float* d, lapack_complex_float* e, - lapack_int *info ); -void LAPACK_zpttrf( lapack_int* n, double* d, lapack_complex_double* e, - lapack_int *info ); -void LAPACK_ssytrf( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsytrf( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csytrf( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsytrf( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chetrf( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhetrf( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ssptrf( char* uplo, lapack_int* n, float* ap, lapack_int* ipiv, - lapack_int *info ); -void LAPACK_dsptrf( char* uplo, lapack_int* n, double* ap, lapack_int* ipiv, - lapack_int *info ); -void LAPACK_csptrf( char* uplo, lapack_int* n, lapack_complex_float* ap, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_zsptrf( char* uplo, lapack_int* n, lapack_complex_double* ap, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_chptrf( char* uplo, lapack_int* n, lapack_complex_float* ap, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_zhptrf( char* uplo, lapack_int* n, lapack_complex_double* ap, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_sgetrs( char* trans, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, const lapack_int* ipiv, - float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_dgetrs( char* trans, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const lapack_int* ipiv, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_cgetrs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zgetrs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_sgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const float* ab, lapack_int* ldab, - const lapack_int* ipiv, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const double* ab, lapack_int* ldab, - const lapack_int* ipiv, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const lapack_complex_float* ab, - lapack_int* ldab, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zgbtrs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const lapack_complex_double* ab, - lapack_int* ldab, const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_sgttrs( char* trans, lapack_int* n, lapack_int* nrhs, - const float* dl, const float* d, const float* du, - const float* du2, const lapack_int* ipiv, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dgttrs( char* trans, lapack_int* n, lapack_int* nrhs, - const double* dl, const double* d, const double* du, - const double* du2, const lapack_int* ipiv, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_cgttrs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* dl, - const lapack_complex_float* d, - const lapack_complex_float* du, - const lapack_complex_float* du2, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zgttrs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* dl, - const lapack_complex_double* d, - const lapack_complex_double* du, - const lapack_complex_double* du2, const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_spotrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a, - lapack_int* lda, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dpotrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_cpotrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zpotrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_spftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs, - const float* a, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_cpftrs( char* transr, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_spptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const float* ap, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dpptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* ap, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cpptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zpptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_spbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const float* ab, lapack_int* ldab, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const double* ab, lapack_int* ldab, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_cpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zpbtrs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_spttrs( lapack_int* n, lapack_int* nrhs, const float* d, - const float* e, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dpttrs( lapack_int* n, lapack_int* nrhs, const double* d, - const double* e, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cpttrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d, - const lapack_complex_float* e, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zpttrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* d, const lapack_complex_double* e, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_ssytrs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a, - lapack_int* lda, const lapack_int* ipiv, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dsytrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const lapack_int* ipiv, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_csytrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zsytrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_chetrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zhetrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_ssptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const float* ap, const lapack_int* ipiv, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dsptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* ap, const lapack_int* ipiv, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_csptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zsptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_chptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zhptrs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_strtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const float* a, lapack_int* lda, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dtrtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const double* a, lapack_int* lda, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_ctrtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_ztrtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_stptrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const float* ap, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dtptrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const double* ap, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_ctptrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* ap, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_ztptrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_double* ap, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_stbtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, const float* ab, - lapack_int* ldab, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dtbtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, const double* ab, - lapack_int* ldab, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_ctbtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, - const lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_ztbtrs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, - const lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_sgecon( char* norm, lapack_int* n, const float* a, lapack_int* lda, - float* anorm, float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgecon( char* norm, lapack_int* n, const double* a, lapack_int* lda, - double* anorm, double* rcond, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgecon( char* norm, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* anorm, float* rcond, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zgecon( char* norm, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* anorm, double* rcond, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku, - const float* ab, lapack_int* ldab, const lapack_int* ipiv, - float* anorm, float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku, - const double* ab, lapack_int* ldab, const lapack_int* ipiv, - double* anorm, double* rcond, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku, - const lapack_complex_float* ab, lapack_int* ldab, - const lapack_int* ipiv, float* anorm, float* rcond, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zgbcon( char* norm, lapack_int* n, lapack_int* kl, lapack_int* ku, - const lapack_complex_double* ab, lapack_int* ldab, - const lapack_int* ipiv, double* anorm, double* rcond, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sgtcon( char* norm, lapack_int* n, const float* dl, const float* d, - const float* du, const float* du2, const lapack_int* ipiv, - float* anorm, float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgtcon( char* norm, lapack_int* n, const double* dl, - const double* d, const double* du, const double* du2, - const lapack_int* ipiv, double* anorm, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cgtcon( char* norm, lapack_int* n, const lapack_complex_float* dl, - const lapack_complex_float* d, - const lapack_complex_float* du, - const lapack_complex_float* du2, const lapack_int* ipiv, - float* anorm, float* rcond, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zgtcon( char* norm, lapack_int* n, const lapack_complex_double* dl, - const lapack_complex_double* d, - const lapack_complex_double* du, - const lapack_complex_double* du2, const lapack_int* ipiv, - double* anorm, double* rcond, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_spocon( char* uplo, lapack_int* n, const float* a, lapack_int* lda, - float* anorm, float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dpocon( char* uplo, lapack_int* n, const double* a, lapack_int* lda, - double* anorm, double* rcond, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cpocon( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* anorm, float* rcond, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zpocon( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* anorm, double* rcond, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sppcon( char* uplo, lapack_int* n, const float* ap, float* anorm, - float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dppcon( char* uplo, lapack_int* n, const double* ap, double* anorm, - double* rcond, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cppcon( char* uplo, lapack_int* n, const lapack_complex_float* ap, - float* anorm, float* rcond, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zppcon( char* uplo, lapack_int* n, const lapack_complex_double* ap, - double* anorm, double* rcond, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_spbcon( char* uplo, lapack_int* n, lapack_int* kd, const float* ab, - lapack_int* ldab, float* anorm, float* rcond, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dpbcon( char* uplo, lapack_int* n, lapack_int* kd, const double* ab, - lapack_int* ldab, double* anorm, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cpbcon( char* uplo, lapack_int* n, lapack_int* kd, - const lapack_complex_float* ab, lapack_int* ldab, - float* anorm, float* rcond, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zpbcon( char* uplo, lapack_int* n, lapack_int* kd, - const lapack_complex_double* ab, lapack_int* ldab, - double* anorm, double* rcond, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_sptcon( lapack_int* n, const float* d, const float* e, float* anorm, - float* rcond, float* work, lapack_int *info ); -void LAPACK_dptcon( lapack_int* n, const double* d, const double* e, - double* anorm, double* rcond, double* work, - lapack_int *info ); -void LAPACK_cptcon( lapack_int* n, const float* d, - const lapack_complex_float* e, float* anorm, float* rcond, - float* work, lapack_int *info ); -void LAPACK_zptcon( lapack_int* n, const double* d, - const lapack_complex_double* e, double* anorm, - double* rcond, double* work, lapack_int *info ); -void LAPACK_ssycon( char* uplo, lapack_int* n, const float* a, lapack_int* lda, - const lapack_int* ipiv, float* anorm, float* rcond, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dsycon( char* uplo, lapack_int* n, const double* a, lapack_int* lda, - const lapack_int* ipiv, double* anorm, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_csycon( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, float* anorm, - float* rcond, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zsycon( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_int* ipiv, double* anorm, - double* rcond, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_checon( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, float* anorm, - float* rcond, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zhecon( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_int* ipiv, double* anorm, - double* rcond, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_sspcon( char* uplo, lapack_int* n, const float* ap, - const lapack_int* ipiv, float* anorm, float* rcond, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dspcon( char* uplo, lapack_int* n, const double* ap, - const lapack_int* ipiv, double* anorm, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cspcon( char* uplo, lapack_int* n, const lapack_complex_float* ap, - const lapack_int* ipiv, float* anorm, float* rcond, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zspcon( char* uplo, lapack_int* n, const lapack_complex_double* ap, - const lapack_int* ipiv, double* anorm, double* rcond, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_chpcon( char* uplo, lapack_int* n, const lapack_complex_float* ap, - const lapack_int* ipiv, float* anorm, float* rcond, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zhpcon( char* uplo, lapack_int* n, const lapack_complex_double* ap, - const lapack_int* ipiv, double* anorm, double* rcond, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_strcon( char* norm, char* uplo, char* diag, lapack_int* n, - const float* a, lapack_int* lda, float* rcond, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dtrcon( char* norm, char* uplo, char* diag, lapack_int* n, - const double* a, lapack_int* lda, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_ctrcon( char* norm, char* uplo, char* diag, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, - float* rcond, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztrcon( char* norm, char* uplo, char* diag, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, - double* rcond, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_stpcon( char* norm, char* uplo, char* diag, lapack_int* n, - const float* ap, float* rcond, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dtpcon( char* norm, char* uplo, char* diag, lapack_int* n, - const double* ap, double* rcond, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ctpcon( char* norm, char* uplo, char* diag, lapack_int* n, - const lapack_complex_float* ap, float* rcond, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztpcon( char* norm, char* uplo, char* diag, lapack_int* n, - const lapack_complex_double* ap, double* rcond, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_stbcon( char* norm, char* uplo, char* diag, lapack_int* n, - lapack_int* kd, const float* ab, lapack_int* ldab, - float* rcond, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dtbcon( char* norm, char* uplo, char* diag, lapack_int* n, - lapack_int* kd, const double* ab, lapack_int* ldab, - double* rcond, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_ctbcon( char* norm, char* uplo, char* diag, lapack_int* n, - lapack_int* kd, const lapack_complex_float* ab, - lapack_int* ldab, float* rcond, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_ztbcon( char* norm, char* uplo, char* diag, lapack_int* n, - lapack_int* kd, const lapack_complex_double* ab, - lapack_int* ldab, double* rcond, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sgerfs( char* trans, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, const float* af, - lapack_int* ldaf, const lapack_int* ipiv, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* ferr, - float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgerfs( char* trans, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const lapack_int* ipiv, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cgerfs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zgerfs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_dgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const lapack_int* ipiv, const double* r, - const double* c, const double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* rcond, double* berr, - lapack_int* n_err_bnds, double* err_bnds_norm, - double* err_bnds_comp, lapack_int* nparams, double* params, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_sgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, const float* af, - lapack_int* ldaf, const lapack_int* ipiv, const float* r, - const float* c, const float* b, lapack_int* ldb, float* x, - lapack_int* ldx, float* rcond, float* berr, - lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_zgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const double* r, const double* c, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cgerfsx( char* trans, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const float* r, const float* c, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* berr, lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const float* ab, lapack_int* ldab, - const float* afb, lapack_int* ldafb, const lapack_int* ipiv, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const double* ab, lapack_int* ldab, - const double* afb, lapack_int* ldafb, - const lapack_int* ipiv, const double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* ferr, double* berr, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const lapack_complex_float* ab, - lapack_int* ldab, const lapack_complex_float* afb, - lapack_int* ldafb, const lapack_int* ipiv, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zgbrfs( char* trans, lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, const lapack_complex_double* ab, - lapack_int* ldab, const lapack_complex_double* afb, - lapack_int* ldafb, const lapack_int* ipiv, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_dgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, const double* ab, - lapack_int* ldab, const double* afb, lapack_int* ldafb, - const lapack_int* ipiv, const double* r, const double* c, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* rcond, double* berr, - lapack_int* n_err_bnds, double* err_bnds_norm, - double* err_bnds_comp, lapack_int* nparams, double* params, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_sgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, const float* ab, - lapack_int* ldab, const float* afb, lapack_int* ldafb, - const lapack_int* ipiv, const float* r, const float* c, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* rcond, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, - const lapack_complex_double* ab, lapack_int* ldab, - const lapack_complex_double* afb, lapack_int* ldafb, - const lapack_int* ipiv, const double* r, const double* c, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cgbrfsx( char* trans, char* equed, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, - const lapack_complex_float* ab, lapack_int* ldab, - const lapack_complex_float* afb, lapack_int* ldafb, - const lapack_int* ipiv, const float* r, const float* c, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* berr, lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sgtrfs( char* trans, lapack_int* n, lapack_int* nrhs, - const float* dl, const float* d, const float* du, - const float* dlf, const float* df, const float* duf, - const float* du2, const lapack_int* ipiv, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* ferr, - float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgtrfs( char* trans, lapack_int* n, lapack_int* nrhs, - const double* dl, const double* d, const double* du, - const double* dlf, const double* df, const double* duf, - const double* du2, const lapack_int* ipiv, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cgtrfs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* dl, - const lapack_complex_float* d, - const lapack_complex_float* du, - const lapack_complex_float* dlf, - const lapack_complex_float* df, - const lapack_complex_float* duf, - const lapack_complex_float* du2, const lapack_int* ipiv, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zgtrfs( char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* dl, - const lapack_complex_double* d, - const lapack_complex_double* du, - const lapack_complex_double* dlf, - const lapack_complex_double* df, - const lapack_complex_double* duf, - const lapack_complex_double* du2, const lapack_int* ipiv, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sporfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a, - lapack_int* lda, const float* af, lapack_int* ldaf, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dporfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* ferr, double* berr, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cporfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zporfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_dporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const double* s, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* rcond, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_sporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, const float* af, - lapack_int* ldaf, const float* s, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* berr, lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_zporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const double* s, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cporfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const float* s, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_spprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const float* ap, const float* afp, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* ferr, - float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dpprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* ap, const double* afp, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cpprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, - const lapack_complex_float* afp, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zpprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, - const lapack_complex_double* afp, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_spbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const float* ab, lapack_int* ldab, const float* afb, - lapack_int* ldafb, const float* b, lapack_int* ldb, - float* x, lapack_int* ldx, float* ferr, float* berr, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const double* ab, lapack_int* ldab, const double* afb, - lapack_int* ldafb, const double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* ferr, double* berr, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const lapack_complex_float* ab, lapack_int* ldab, - const lapack_complex_float* afb, lapack_int* ldafb, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zpbrfs( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - const lapack_complex_double* ab, lapack_int* ldab, - const lapack_complex_double* afb, lapack_int* ldafb, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sptrfs( lapack_int* n, lapack_int* nrhs, const float* d, - const float* e, const float* df, const float* ef, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* ferr, float* berr, float* work, lapack_int *info ); -void LAPACK_dptrfs( lapack_int* n, lapack_int* nrhs, const double* d, - const double* e, const double* df, const double* ef, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* ferr, double* berr, double* work, - lapack_int *info ); -void LAPACK_cptrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* d, - const lapack_complex_float* e, const float* df, - const lapack_complex_float* ef, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zptrfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* d, const lapack_complex_double* e, - const double* df, const lapack_complex_double* ef, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_ssyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a, - lapack_int* lda, const float* af, lapack_int* ldaf, - const lapack_int* ipiv, const float* b, lapack_int* ldb, - float* x, lapack_int* ldx, float* ferr, float* berr, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const lapack_int* ipiv, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_csyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zsyrfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_dsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const double* af, - lapack_int* ldaf, const lapack_int* ipiv, const double* s, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* rcond, double* berr, - lapack_int* n_err_bnds, double* err_bnds_norm, - double* err_bnds_comp, lapack_int* nparams, double* params, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_ssyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, const float* af, - lapack_int* ldaf, const lapack_int* ipiv, const float* s, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* rcond, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zsyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const double* s, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_csyrfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const float* s, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* berr, lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_cherfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zherfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_zherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* af, lapack_int* ldaf, - const lapack_int* ipiv, const double* s, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cherfsx( char* uplo, char* equed, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* af, lapack_int* ldaf, - const lapack_int* ipiv, const float* s, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* berr, lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ssprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const float* ap, const float* afp, const lapack_int* ipiv, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dsprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* ap, const double* afp, const lapack_int* ipiv, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* ferr, double* berr, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_csprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, - const lapack_complex_float* afp, const lapack_int* ipiv, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zsprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, - const lapack_complex_double* afp, const lapack_int* ipiv, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_chprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, - const lapack_complex_float* afp, const lapack_int* ipiv, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zhprfs( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, - const lapack_complex_double* afp, const lapack_int* ipiv, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* ferr, - double* berr, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_strrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const float* a, lapack_int* lda, - const float* b, lapack_int* ldb, const float* x, - lapack_int* ldx, float* ferr, float* berr, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dtrrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const double* a, lapack_int* lda, - const double* b, lapack_int* ldb, const double* x, - lapack_int* ldx, double* ferr, double* berr, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ctrrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* b, - lapack_int* ldb, const lapack_complex_float* x, - lapack_int* ldx, float* ferr, float* berr, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztrrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* b, - lapack_int* ldb, const lapack_complex_double* x, - lapack_int* ldx, double* ferr, double* berr, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_stprfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const float* ap, const float* b, - lapack_int* ldb, const float* x, lapack_int* ldx, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dtprfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const double* ap, const double* b, - lapack_int* ldb, const double* x, lapack_int* ldx, - double* ferr, double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_ctprfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* ap, - const lapack_complex_float* b, lapack_int* ldb, - const lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztprfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* nrhs, const lapack_complex_double* ap, - const lapack_complex_double* b, lapack_int* ldb, - const lapack_complex_double* x, lapack_int* ldx, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_stbrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, const float* ab, - lapack_int* ldab, const float* b, lapack_int* ldb, - const float* x, lapack_int* ldx, float* ferr, float* berr, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dtbrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, const double* ab, - lapack_int* ldab, const double* b, lapack_int* ldb, - const double* x, lapack_int* ldx, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_ctbrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, - const lapack_complex_float* ab, lapack_int* ldab, - const lapack_complex_float* b, lapack_int* ldb, - const lapack_complex_float* x, lapack_int* ldx, float* ferr, - float* berr, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztbrfs( char* uplo, char* trans, char* diag, lapack_int* n, - lapack_int* kd, lapack_int* nrhs, - const lapack_complex_double* ab, lapack_int* ldab, - const lapack_complex_double* b, lapack_int* ldb, - const lapack_complex_double* x, lapack_int* ldx, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_sgetri( lapack_int* n, float* a, lapack_int* lda, - const lapack_int* ipiv, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgetri( lapack_int* n, double* a, lapack_int* lda, - const lapack_int* ipiv, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgetri( lapack_int* n, lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zgetri( lapack_int* n, lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_spotri( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dpotri( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_cpotri( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_zpotri( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_dpftri( char* transr, char* uplo, lapack_int* n, double* a, - lapack_int *info ); -void LAPACK_spftri( char* transr, char* uplo, lapack_int* n, float* a, - lapack_int *info ); -void LAPACK_zpftri( char* transr, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int *info ); -void LAPACK_cpftri( char* transr, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int *info ); -void LAPACK_spptri( char* uplo, lapack_int* n, float* ap, lapack_int *info ); -void LAPACK_dpptri( char* uplo, lapack_int* n, double* ap, lapack_int *info ); -void LAPACK_cpptri( char* uplo, lapack_int* n, lapack_complex_float* ap, - lapack_int *info ); -void LAPACK_zpptri( char* uplo, lapack_int* n, lapack_complex_double* ap, - lapack_int *info ); -void LAPACK_ssytri( char* uplo, lapack_int* n, float* a, lapack_int* lda, - const lapack_int* ipiv, float* work, lapack_int *info ); -void LAPACK_dsytri( char* uplo, lapack_int* n, double* a, lapack_int* lda, - const lapack_int* ipiv, double* work, lapack_int *info ); -void LAPACK_csytri( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zsytri( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_chetri( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zhetri( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_ssptri( char* uplo, lapack_int* n, float* ap, - const lapack_int* ipiv, float* work, lapack_int *info ); -void LAPACK_dsptri( char* uplo, lapack_int* n, double* ap, - const lapack_int* ipiv, double* work, lapack_int *info ); -void LAPACK_csptri( char* uplo, lapack_int* n, lapack_complex_float* ap, - const lapack_int* ipiv, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zsptri( char* uplo, lapack_int* n, lapack_complex_double* ap, - const lapack_int* ipiv, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_chptri( char* uplo, lapack_int* n, lapack_complex_float* ap, - const lapack_int* ipiv, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zhptri( char* uplo, lapack_int* n, lapack_complex_double* ap, - const lapack_int* ipiv, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_strtri( char* uplo, char* diag, lapack_int* n, float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_dtrtri( char* uplo, char* diag, lapack_int* n, double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_ctrtri( char* uplo, char* diag, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_ztrtri( char* uplo, char* diag, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dtftri( char* transr, char* uplo, char* diag, lapack_int* n, - double* a, lapack_int *info ); -void LAPACK_stftri( char* transr, char* uplo, char* diag, lapack_int* n, - float* a, lapack_int *info ); -void LAPACK_ztftri( char* transr, char* uplo, char* diag, lapack_int* n, - lapack_complex_double* a, lapack_int *info ); -void LAPACK_ctftri( char* transr, char* uplo, char* diag, lapack_int* n, - lapack_complex_float* a, lapack_int *info ); -void LAPACK_stptri( char* uplo, char* diag, lapack_int* n, float* ap, - lapack_int *info ); -void LAPACK_dtptri( char* uplo, char* diag, lapack_int* n, double* ap, - lapack_int *info ); -void LAPACK_ctptri( char* uplo, char* diag, lapack_int* n, - lapack_complex_float* ap, lapack_int *info ); -void LAPACK_ztptri( char* uplo, char* diag, lapack_int* n, - lapack_complex_double* ap, lapack_int *info ); -void LAPACK_sgeequ( lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, float* r, float* c, float* rowcnd, - float* colcnd, float* amax, lapack_int *info ); -void LAPACK_dgeequ( lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, double* r, double* c, double* rowcnd, - double* colcnd, double* amax, lapack_int *info ); -void LAPACK_cgeequ( lapack_int* m, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* r, float* c, float* rowcnd, - float* colcnd, float* amax, lapack_int *info ); -void LAPACK_zgeequ( lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, double* r, - double* c, double* rowcnd, double* colcnd, double* amax, - lapack_int *info ); -void LAPACK_dgeequb( lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, double* r, double* c, double* rowcnd, - double* colcnd, double* amax, lapack_int *info ); -void LAPACK_sgeequb( lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, float* r, float* c, float* rowcnd, - float* colcnd, float* amax, lapack_int *info ); -void LAPACK_zgeequb( lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, double* r, - double* c, double* rowcnd, double* colcnd, double* amax, - lapack_int *info ); -void LAPACK_cgeequb( lapack_int* m, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, float* r, - float* c, float* rowcnd, float* colcnd, float* amax, - lapack_int *info ); -void LAPACK_sgbequ( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const float* ab, lapack_int* ldab, float* r, - float* c, float* rowcnd, float* colcnd, float* amax, - lapack_int *info ); -void LAPACK_dgbequ( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const double* ab, lapack_int* ldab, - double* r, double* c, double* rowcnd, double* colcnd, - double* amax, lapack_int *info ); -void LAPACK_cgbequ( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const lapack_complex_float* ab, - lapack_int* ldab, float* r, float* c, float* rowcnd, - float* colcnd, float* amax, lapack_int *info ); -void LAPACK_zgbequ( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const lapack_complex_double* ab, - lapack_int* ldab, double* r, double* c, double* rowcnd, - double* colcnd, double* amax, lapack_int *info ); -void LAPACK_dgbequb( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const double* ab, lapack_int* ldab, - double* r, double* c, double* rowcnd, double* colcnd, - double* amax, lapack_int *info ); -void LAPACK_sgbequb( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const float* ab, lapack_int* ldab, - float* r, float* c, float* rowcnd, float* colcnd, - float* amax, lapack_int *info ); -void LAPACK_zgbequb( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const lapack_complex_double* ab, - lapack_int* ldab, double* r, double* c, double* rowcnd, - double* colcnd, double* amax, lapack_int *info ); -void LAPACK_cgbequb( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const lapack_complex_float* ab, - lapack_int* ldab, float* r, float* c, float* rowcnd, - float* colcnd, float* amax, lapack_int *info ); -void LAPACK_spoequ( lapack_int* n, const float* a, lapack_int* lda, float* s, - float* scond, float* amax, lapack_int *info ); -void LAPACK_dpoequ( lapack_int* n, const double* a, lapack_int* lda, double* s, - double* scond, double* amax, lapack_int *info ); -void LAPACK_cpoequ( lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* s, float* scond, float* amax, - lapack_int *info ); -void LAPACK_zpoequ( lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* s, double* scond, double* amax, - lapack_int *info ); -void LAPACK_dpoequb( lapack_int* n, const double* a, lapack_int* lda, double* s, - double* scond, double* amax, lapack_int *info ); -void LAPACK_spoequb( lapack_int* n, const float* a, lapack_int* lda, float* s, - float* scond, float* amax, lapack_int *info ); -void LAPACK_zpoequb( lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* s, double* scond, double* amax, - lapack_int *info ); -void LAPACK_cpoequb( lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* s, float* scond, float* amax, - lapack_int *info ); -void LAPACK_sppequ( char* uplo, lapack_int* n, const float* ap, float* s, - float* scond, float* amax, lapack_int *info ); -void LAPACK_dppequ( char* uplo, lapack_int* n, const double* ap, double* s, - double* scond, double* amax, lapack_int *info ); -void LAPACK_cppequ( char* uplo, lapack_int* n, const lapack_complex_float* ap, - float* s, float* scond, float* amax, lapack_int *info ); -void LAPACK_zppequ( char* uplo, lapack_int* n, const lapack_complex_double* ap, - double* s, double* scond, double* amax, lapack_int *info ); -void LAPACK_spbequ( char* uplo, lapack_int* n, lapack_int* kd, const float* ab, - lapack_int* ldab, float* s, float* scond, float* amax, - lapack_int *info ); -void LAPACK_dpbequ( char* uplo, lapack_int* n, lapack_int* kd, const double* ab, - lapack_int* ldab, double* s, double* scond, double* amax, - lapack_int *info ); -void LAPACK_cpbequ( char* uplo, lapack_int* n, lapack_int* kd, - const lapack_complex_float* ab, lapack_int* ldab, float* s, - float* scond, float* amax, lapack_int *info ); -void LAPACK_zpbequ( char* uplo, lapack_int* n, lapack_int* kd, - const lapack_complex_double* ab, lapack_int* ldab, - double* s, double* scond, double* amax, lapack_int *info ); -void LAPACK_dsyequb( char* uplo, lapack_int* n, const double* a, - lapack_int* lda, double* s, double* scond, double* amax, - double* work, lapack_int *info ); -void LAPACK_ssyequb( char* uplo, lapack_int* n, const float* a, lapack_int* lda, - float* s, float* scond, float* amax, float* work, - lapack_int *info ); -void LAPACK_zsyequb( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* s, double* scond, double* amax, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_csyequb( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* s, float* scond, float* amax, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zheequb( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, double* s, double* scond, double* amax, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_cheequb( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, float* s, float* scond, float* amax, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_sgesv( lapack_int* n, lapack_int* nrhs, float* a, lapack_int* lda, - lapack_int* ipiv, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda, - lapack_int* ipiv, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dsgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda, - lapack_int* ipiv, double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* work, float* swork, - lapack_int* iter, lapack_int *info ); -void LAPACK_zcgesv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - lapack_complex_double* work, lapack_complex_float* swork, - double* rwork, lapack_int* iter, lapack_int *info ); -void LAPACK_sgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* r, float* c, float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* r, double* c, - double* b, lapack_int* ldb, double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* r, float* c, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zgesvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* r, double* c, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_dgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* r, double* c, - double* b, lapack_int* ldb, double* x, lapack_int* ldx, - double* rcond, double* rpvgrw, double* berr, - lapack_int* n_err_bnds, double* err_bnds_norm, - double* err_bnds_comp, lapack_int* nparams, double* params, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_sgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* r, float* c, - float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* rcond, float* rpvgrw, float* berr, - lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_zgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* r, double* c, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cgesvxx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* r, float* c, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, float* ab, lapack_int* ldab, - lapack_int* ipiv, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, double* ab, lapack_int* ldab, - lapack_int* ipiv, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, lapack_complex_float* ab, lapack_int* ldab, - lapack_int* ipiv, lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zgbsv( lapack_int* n, lapack_int* kl, lapack_int* ku, - lapack_int* nrhs, lapack_complex_double* ab, - lapack_int* ldab, lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_sgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, float* ab, - lapack_int* ldab, float* afb, lapack_int* ldafb, - lapack_int* ipiv, char* equed, float* r, float* c, float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, double* ab, - lapack_int* ldab, double* afb, lapack_int* ldafb, - lapack_int* ipiv, char* equed, double* r, double* c, - double* b, lapack_int* ldb, double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab, - lapack_int* ldab, lapack_complex_float* afb, - lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r, - float* c, lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zgbsvx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, lapack_complex_double* ab, - lapack_int* ldab, lapack_complex_double* afb, - lapack_int* ldafb, lapack_int* ipiv, char* equed, double* r, - double* c, lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_dgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, double* ab, - lapack_int* ldab, double* afb, lapack_int* ldafb, - lapack_int* ipiv, char* equed, double* r, double* c, - double* b, lapack_int* ldb, double* x, lapack_int* ldx, - double* rcond, double* rpvgrw, double* berr, - lapack_int* n_err_bnds, double* err_bnds_norm, - double* err_bnds_comp, lapack_int* nparams, double* params, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_sgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, float* ab, - lapack_int* ldab, float* afb, lapack_int* ldafb, - lapack_int* ipiv, char* equed, float* r, float* c, - float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* rcond, float* rpvgrw, float* berr, - lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_zgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, - lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* afb, lapack_int* ldafb, - lapack_int* ipiv, char* equed, double* r, double* c, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cgbsvxx( char* fact, char* trans, lapack_int* n, lapack_int* kl, - lapack_int* ku, lapack_int* nrhs, lapack_complex_float* ab, - lapack_int* ldab, lapack_complex_float* afb, - lapack_int* ldafb, lapack_int* ipiv, char* equed, float* r, - float* c, lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sgtsv( lapack_int* n, lapack_int* nrhs, float* dl, float* d, - float* du, float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_dgtsv( lapack_int* n, lapack_int* nrhs, double* dl, double* d, - double* du, double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_cgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_float* dl, - lapack_complex_float* d, lapack_complex_float* du, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zgtsv( lapack_int* n, lapack_int* nrhs, lapack_complex_double* dl, - lapack_complex_double* d, lapack_complex_double* du, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_sgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - const float* dl, const float* d, const float* du, - float* dlf, float* df, float* duf, float* du2, - lapack_int* ipiv, const float* b, lapack_int* ldb, float* x, - lapack_int* ldx, float* rcond, float* ferr, float* berr, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - const double* dl, const double* d, const double* du, - double* dlf, double* df, double* duf, double* du2, - lapack_int* ipiv, const double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* rcond, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* dl, - const lapack_complex_float* d, - const lapack_complex_float* du, lapack_complex_float* dlf, - lapack_complex_float* df, lapack_complex_float* duf, - lapack_complex_float* du2, lapack_int* ipiv, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zgtsvx( char* fact, char* trans, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* dl, - const lapack_complex_double* d, - const lapack_complex_double* du, lapack_complex_double* dlf, - lapack_complex_double* df, lapack_complex_double* duf, - lapack_complex_double* du2, lapack_int* ipiv, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_sposv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cposv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zposv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dsposv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* work, float* swork, - lapack_int* iter, lapack_int *info ); -void LAPACK_zcposv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, - lapack_complex_double* work, lapack_complex_float* swork, - double* rwork, lapack_int* iter, lapack_int *info ); -void LAPACK_sposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* af, lapack_int* ldaf, - char* equed, float* s, float* b, lapack_int* ldb, float* x, - lapack_int* ldx, float* rcond, float* ferr, float* berr, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* af, lapack_int* ldaf, - char* equed, double* s, double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* rcond, double* ferr, - double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, char* equed, - float* s, lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zposvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, char* equed, - double* s, lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_dposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* af, lapack_int* ldaf, - char* equed, double* s, double* b, lapack_int* ldb, - double* x, lapack_int* ldx, double* rcond, double* rpvgrw, - double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_sposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* af, lapack_int* ldaf, - char* equed, float* s, float* b, lapack_int* ldb, float* x, - lapack_int* ldx, float* rcond, float* rpvgrw, float* berr, - lapack_int* n_err_bnds, float* err_bnds_norm, - float* err_bnds_comp, lapack_int* nparams, float* params, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_zposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, char* equed, - double* s, lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_cposvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, char* equed, - float* s, lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sppsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap, - float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_dppsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_cppsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* ap, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zppsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* ap, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_sppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - float* ap, float* afp, char* equed, float* s, float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - double* ap, double* afp, char* equed, double* s, double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* ap, lapack_complex_float* afp, - char* equed, float* s, lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zppsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* ap, lapack_complex_double* afp, - char* equed, double* s, lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_spbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - float* ab, lapack_int* ldab, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - double* ab, lapack_int* ldab, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zpbsv( char* uplo, lapack_int* n, lapack_int* kd, lapack_int* nrhs, - lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_spbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd, - lapack_int* nrhs, float* ab, lapack_int* ldab, float* afb, - lapack_int* ldafb, char* equed, float* s, float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd, - lapack_int* nrhs, double* ab, lapack_int* ldab, double* afb, - lapack_int* ldafb, char* equed, double* s, double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd, - lapack_int* nrhs, lapack_complex_float* ab, - lapack_int* ldab, lapack_complex_float* afb, - lapack_int* ldafb, char* equed, float* s, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zpbsvx( char* fact, char* uplo, lapack_int* n, lapack_int* kd, - lapack_int* nrhs, lapack_complex_double* ab, - lapack_int* ldab, lapack_complex_double* afb, - lapack_int* ldafb, char* equed, double* s, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_sptsv( lapack_int* n, lapack_int* nrhs, float* d, float* e, - float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_dptsv( lapack_int* n, lapack_int* nrhs, double* d, double* e, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_cptsv( lapack_int* n, lapack_int* nrhs, float* d, - lapack_complex_float* e, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zptsv( lapack_int* n, lapack_int* nrhs, double* d, - lapack_complex_double* e, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_sptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d, - const float* e, float* df, float* ef, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int *info ); -void LAPACK_dptsvx( char* fact, lapack_int* n, lapack_int* nrhs, - const double* d, const double* e, double* df, double* ef, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* rcond, double* ferr, double* berr, - double* work, lapack_int *info ); -void LAPACK_cptsvx( char* fact, lapack_int* n, lapack_int* nrhs, const float* d, - const lapack_complex_float* e, float* df, - lapack_complex_float* ef, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zptsvx( char* fact, lapack_int* n, lapack_int* nrhs, - const double* d, const lapack_complex_double* e, double* df, - lapack_complex_double* ef, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_ssysv( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, lapack_int* ipiv, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsysv( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, lapack_int* ipiv, double* b, - lapack_int* ldb, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csysv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsysv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ssysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const float* a, lapack_int* lda, float* af, - lapack_int* ldaf, lapack_int* ipiv, const float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* ferr, float* berr, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, double* af, - lapack_int* ldaf, lapack_int* ipiv, const double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* rcond, - double* ferr, double* berr, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_csysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zsysvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_dsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* s, double* b, - lapack_int* ldb, double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ssysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* s, float* b, - lapack_int* ldb, float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zsysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* s, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_csysvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* s, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_chesv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhesv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zhesvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_zhesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, double* s, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* x, lapack_int* ldx, double* rcond, - double* rpvgrw, double* berr, lapack_int* n_err_bnds, - double* err_bnds_norm, double* err_bnds_comp, - lapack_int* nparams, double* params, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_chesvxx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* af, lapack_int* ldaf, - lapack_int* ipiv, char* equed, float* s, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* x, lapack_int* ldx, float* rcond, - float* rpvgrw, float* berr, lapack_int* n_err_bnds, - float* err_bnds_norm, float* err_bnds_comp, - lapack_int* nparams, float* params, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_sspsv( char* uplo, lapack_int* n, lapack_int* nrhs, float* ap, - lapack_int* ipiv, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dspsv( char* uplo, lapack_int* n, lapack_int* nrhs, double* ap, - lapack_int* ipiv, double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_cspsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* ap, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zspsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* ap, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_sspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const float* ap, float* afp, lapack_int* ipiv, - const float* b, lapack_int* ldb, float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, float* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const double* ap, double* afp, lapack_int* ipiv, - const double* b, lapack_int* ldb, double* x, - lapack_int* ldx, double* rcond, double* ferr, double* berr, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, lapack_complex_float* afp, - lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zspsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, lapack_complex_double* afp, - lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_chpsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* ap, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zhpsv( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* ap, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_chpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* ap, lapack_complex_float* afp, - lapack_int* ipiv, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* x, lapack_int* ldx, - float* rcond, float* ferr, float* berr, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zhpsvx( char* fact, char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* ap, lapack_complex_double* afp, - lapack_int* ipiv, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* x, lapack_int* ldx, - double* rcond, double* ferr, double* berr, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sgeqrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgeqrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgeqrf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgeqrf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgeqpf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - lapack_int* jpvt, float* tau, float* work, - lapack_int *info ); -void LAPACK_dgeqpf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - lapack_int* jpvt, double* tau, double* work, - lapack_int *info ); -void LAPACK_cgeqpf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* jpvt, - lapack_complex_float* tau, lapack_complex_float* work, - float* rwork, lapack_int *info ); -void LAPACK_zgeqpf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* jpvt, - lapack_complex_double* tau, lapack_complex_double* work, - double* rwork, lapack_int *info ); -void LAPACK_sgeqp3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - lapack_int* jpvt, float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dgeqp3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - lapack_int* jpvt, double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgeqp3( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* jpvt, - lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int *info ); -void LAPACK_zgeqp3( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* jpvt, - lapack_complex_double* tau, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int *info ); -void LAPACK_sorgqr( lapack_int* m, lapack_int* n, lapack_int* k, float* a, - lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorgqr( lapack_int* m, lapack_int* n, lapack_int* k, double* a, - lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sormqr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const float* a, lapack_int* lda, - const float* tau, float* c, lapack_int* ldc, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dormqr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const double* a, lapack_int* lda, - const double* tau, double* c, lapack_int* ldc, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cungqr( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zungqr( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmqr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmqr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgelqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgelqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgelqf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgelqf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sorglq( lapack_int* m, lapack_int* n, lapack_int* k, float* a, - lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorglq( lapack_int* m, lapack_int* n, lapack_int* k, double* a, - lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sormlq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const float* a, lapack_int* lda, - const float* tau, float* c, lapack_int* ldc, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dormlq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const double* a, lapack_int* lda, - const double* tau, double* c, lapack_int* ldc, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cunglq( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zunglq( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmlq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmlq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgeqlf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgeqlf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgeqlf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgeqlf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sorgql( lapack_int* m, lapack_int* n, lapack_int* k, float* a, - lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorgql( lapack_int* m, lapack_int* n, lapack_int* k, double* a, - lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cungql( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zungql( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sormql( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const float* a, lapack_int* lda, - const float* tau, float* c, lapack_int* ldc, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dormql( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const double* a, lapack_int* lda, - const double* tau, double* c, lapack_int* ldc, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cunmql( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmql( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgerqf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgerqf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgerqf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgerqf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sorgrq( lapack_int* m, lapack_int* n, lapack_int* k, float* a, - lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorgrq( lapack_int* m, lapack_int* n, lapack_int* k, double* a, - lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cungrq( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zungrq( lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sormrq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const float* a, lapack_int* lda, - const float* tau, float* c, lapack_int* ldc, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dormrq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const double* a, lapack_int* lda, - const double* tau, double* c, lapack_int* ldc, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cunmrq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmrq( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_stzrzf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dtzrzf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ctzrzf( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ztzrzf( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sormrz( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, const float* a, - lapack_int* lda, const float* tau, float* c, - lapack_int* ldc, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dormrz( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, const double* a, - lapack_int* lda, const double* tau, double* c, - lapack_int* ldc, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmrz( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmrz( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, lapack_complex_double* c, - lapack_int* ldc, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sggqrf( lapack_int* n, lapack_int* m, lapack_int* p, float* a, - lapack_int* lda, float* taua, float* b, lapack_int* ldb, - float* taub, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dggqrf( lapack_int* n, lapack_int* m, lapack_int* p, double* a, - lapack_int* lda, double* taua, double* b, lapack_int* ldb, - double* taub, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cggqrf( lapack_int* n, lapack_int* m, lapack_int* p, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* taua, lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* taub, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zggqrf( lapack_int* n, lapack_int* m, lapack_int* p, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* taua, lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* taub, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sggrqf( lapack_int* m, lapack_int* p, lapack_int* n, float* a, - lapack_int* lda, float* taua, float* b, lapack_int* ldb, - float* taub, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dggrqf( lapack_int* m, lapack_int* p, lapack_int* n, double* a, - lapack_int* lda, double* taua, double* b, lapack_int* ldb, - double* taub, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cggrqf( lapack_int* m, lapack_int* p, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* taua, lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* taub, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zggrqf( lapack_int* m, lapack_int* p, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* taua, lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* taub, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgebrd( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* d, float* e, float* tauq, float* taup, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dgebrd( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* d, double* e, double* tauq, double* taup, - double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_cgebrd( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, float* d, float* e, - lapack_complex_float* tauq, lapack_complex_float* taup, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgebrd( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, double* d, double* e, - lapack_complex_double* tauq, lapack_complex_double* taup, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc, - lapack_int* kl, lapack_int* ku, float* ab, lapack_int* ldab, - float* d, float* e, float* q, lapack_int* ldq, float* pt, - lapack_int* ldpt, float* c, lapack_int* ldc, float* work, - lapack_int *info ); -void LAPACK_dgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc, - lapack_int* kl, lapack_int* ku, double* ab, - lapack_int* ldab, double* d, double* e, double* q, - lapack_int* ldq, double* pt, lapack_int* ldpt, double* c, - lapack_int* ldc, double* work, lapack_int *info ); -void LAPACK_cgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc, - lapack_int* kl, lapack_int* ku, lapack_complex_float* ab, - lapack_int* ldab, float* d, float* e, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* pt, lapack_int* ldpt, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zgbbrd( char* vect, lapack_int* m, lapack_int* n, lapack_int* ncc, - lapack_int* kl, lapack_int* ku, lapack_complex_double* ab, - lapack_int* ldab, double* d, double* e, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* pt, lapack_int* ldpt, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k, - float* a, lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorgbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k, - double* a, lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sormbr( char* vect, char* side, char* trans, lapack_int* m, - lapack_int* n, lapack_int* k, const float* a, - lapack_int* lda, const float* tau, float* c, - lapack_int* ldc, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dormbr( char* vect, char* side, char* trans, lapack_int* m, - lapack_int* n, lapack_int* k, const double* a, - lapack_int* lda, const double* tau, double* c, - lapack_int* ldc, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zungbr( char* vect, lapack_int* m, lapack_int* n, lapack_int* k, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmbr( char* vect, char* side, char* trans, lapack_int* m, - lapack_int* n, lapack_int* k, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmbr( char* vect, char* side, char* trans, lapack_int* m, - lapack_int* n, lapack_int* k, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, lapack_complex_double* c, - lapack_int* ldc, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt, - lapack_int* nru, lapack_int* ncc, float* d, float* e, - float* vt, lapack_int* ldvt, float* u, lapack_int* ldu, - float* c, lapack_int* ldc, float* work, lapack_int *info ); -void LAPACK_dbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt, - lapack_int* nru, lapack_int* ncc, double* d, double* e, - double* vt, lapack_int* ldvt, double* u, lapack_int* ldu, - double* c, lapack_int* ldc, double* work, - lapack_int *info ); -void LAPACK_cbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt, - lapack_int* nru, lapack_int* ncc, float* d, float* e, - lapack_complex_float* vt, lapack_int* ldvt, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* c, lapack_int* ldc, float* work, - lapack_int *info ); -void LAPACK_zbdsqr( char* uplo, lapack_int* n, lapack_int* ncvt, - lapack_int* nru, lapack_int* ncc, double* d, double* e, - lapack_complex_double* vt, lapack_int* ldvt, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* c, lapack_int* ldc, double* work, - lapack_int *info ); -void LAPACK_sbdsdc( char* uplo, char* compq, lapack_int* n, float* d, float* e, - float* u, lapack_int* ldu, float* vt, lapack_int* ldvt, - float* q, lapack_int* iq, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dbdsdc( char* uplo, char* compq, lapack_int* n, double* d, - double* e, double* u, lapack_int* ldu, double* vt, - lapack_int* ldvt, double* q, lapack_int* iq, double* work, - lapack_int* iwork, lapack_int *info ); -void LAPACK_sbdsvdx( char* uplo, char* jobz, char* range, - lapack_int* n, float* d, float* e, - float* vl, float* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, - float* s, float* z, lapack_int* ldz, - float* work, lapack_int *iwork, lapack_int *info ); -void LAPACK_dbdsvdx( char* uplo, char* jobz, char* range, - lapack_int* n, double* d, double* e, - double* vl, double* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, - double* s, double* z, lapack_int* ldz, - double* work, lapack_int *iwork, lapack_int *info ); -void LAPACK_ssytrd( char* uplo, lapack_int* n, float* a, lapack_int* lda, - float* d, float* e, float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dsytrd( char* uplo, lapack_int* n, double* a, lapack_int* lda, - double* d, double* e, double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sorgtr( char* uplo, lapack_int* n, float* a, lapack_int* lda, - const float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dorgtr( char* uplo, lapack_int* n, double* a, lapack_int* lda, - const double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sormtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const float* a, lapack_int* lda, - const float* tau, float* c, lapack_int* ldc, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dormtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const double* a, lapack_int* lda, - const double* tau, double* c, lapack_int* ldc, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_chetrd( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, float* d, float* e, - lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zhetrd( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, double* d, double* e, - lapack_complex_double* tau, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cungtr( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zungtr( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zunmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ssptrd( char* uplo, lapack_int* n, float* ap, float* d, float* e, - float* tau, lapack_int *info ); -void LAPACK_dsptrd( char* uplo, lapack_int* n, double* ap, double* d, double* e, - double* tau, lapack_int *info ); -void LAPACK_sopgtr( char* uplo, lapack_int* n, const float* ap, - const float* tau, float* q, lapack_int* ldq, float* work, - lapack_int *info ); -void LAPACK_dopgtr( char* uplo, lapack_int* n, const double* ap, - const double* tau, double* q, lapack_int* ldq, double* work, - lapack_int *info ); -void LAPACK_sopmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const float* ap, const float* tau, float* c, - lapack_int* ldc, float* work, lapack_int *info ); -void LAPACK_dopmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const double* ap, const double* tau, - double* c, lapack_int* ldc, double* work, - lapack_int *info ); -void LAPACK_chptrd( char* uplo, lapack_int* n, lapack_complex_float* ap, - float* d, float* e, lapack_complex_float* tau, - lapack_int *info ); -void LAPACK_zhptrd( char* uplo, lapack_int* n, lapack_complex_double* ap, - double* d, double* e, lapack_complex_double* tau, - lapack_int *info ); -void LAPACK_cupgtr( char* uplo, lapack_int* n, const lapack_complex_float* ap, - const lapack_complex_float* tau, lapack_complex_float* q, - lapack_int* ldq, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zupgtr( char* uplo, lapack_int* n, const lapack_complex_double* ap, - const lapack_complex_double* tau, lapack_complex_double* q, - lapack_int* ldq, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_cupmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const lapack_complex_float* ap, - const lapack_complex_float* tau, lapack_complex_float* c, - lapack_int* ldc, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zupmtr( char* side, char* uplo, char* trans, lapack_int* m, - lapack_int* n, const lapack_complex_double* ap, - const lapack_complex_double* tau, lapack_complex_double* c, - lapack_int* ldc, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_ssbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd, - float* ab, lapack_int* ldab, float* d, float* e, float* q, - lapack_int* ldq, float* work, lapack_int *info ); -void LAPACK_dsbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd, - double* ab, lapack_int* ldab, double* d, double* e, - double* q, lapack_int* ldq, double* work, - lapack_int *info ); -void LAPACK_chbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, float* d, - float* e, lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zhbtrd( char* vect, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, double* d, - double* e, lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_ssterf( lapack_int* n, float* d, float* e, lapack_int *info ); -void LAPACK_dsterf( lapack_int* n, double* d, double* e, lapack_int *info ); -void LAPACK_ssteqr( char* compz, lapack_int* n, float* d, float* e, float* z, - lapack_int* ldz, float* work, lapack_int *info ); -void LAPACK_dsteqr( char* compz, lapack_int* n, double* d, double* e, double* z, - lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_csteqr( char* compz, lapack_int* n, float* d, float* e, - lapack_complex_float* z, lapack_int* ldz, float* work, - lapack_int *info ); -void LAPACK_zsteqr( char* compz, lapack_int* n, double* d, double* e, - lapack_complex_double* z, lapack_int* ldz, double* work, - lapack_int *info ); -void LAPACK_sstemr( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - lapack_int* m, float* w, float* z, lapack_int* ldz, - lapack_int* nzc, lapack_int* isuppz, lapack_logical* tryrac, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_dstemr( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, lapack_int* m, double* w, double* z, - lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz, - lapack_logical* tryrac, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cstemr( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_int* nzc, lapack_int* isuppz, - lapack_logical* tryrac, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_zstemr( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, lapack_int* m, double* w, - lapack_complex_double* z, lapack_int* ldz, lapack_int* nzc, - lapack_int* isuppz, lapack_logical* tryrac, double* work, - lapack_int* lwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_sstedc( char* compz, lapack_int* n, float* d, float* e, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dstedc( char* compz, lapack_int* n, double* d, double* e, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cstedc( char* compz, lapack_int* n, float* d, float* e, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zstedc( char* compz, lapack_int* n, double* d, double* e, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_sstegr( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, float* z, - lapack_int* ldz, lapack_int* isuppz, float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_dstegr( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, lapack_int* isuppz, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_cstegr( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_int* isuppz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_zstegr( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_int* isuppz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_spteqr( char* compz, lapack_int* n, float* d, float* e, float* z, - lapack_int* ldz, float* work, lapack_int *info ); -void LAPACK_dpteqr( char* compz, lapack_int* n, double* d, double* e, double* z, - lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_cpteqr( char* compz, lapack_int* n, float* d, float* e, - lapack_complex_float* z, lapack_int* ldz, float* work, - lapack_int *info ); -void LAPACK_zpteqr( char* compz, lapack_int* n, double* d, double* e, - lapack_complex_double* z, lapack_int* ldz, double* work, - lapack_int *info ); -void LAPACK_sstebz( char* range, char* order, lapack_int* n, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - const float* d, const float* e, lapack_int* m, - lapack_int* nsplit, float* w, lapack_int* iblock, - lapack_int* isplit, float* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dstebz( char* range, char* order, lapack_int* n, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - const double* d, const double* e, lapack_int* m, - lapack_int* nsplit, double* w, lapack_int* iblock, - lapack_int* isplit, double* work, lapack_int* iwork, - lapack_int *info ); -void LAPACK_sstein( lapack_int* n, const float* d, const float* e, - lapack_int* m, const float* w, const lapack_int* iblock, - const lapack_int* isplit, float* z, lapack_int* ldz, - float* work, lapack_int* iwork, lapack_int* ifailv, - lapack_int *info ); -void LAPACK_dstein( lapack_int* n, const double* d, const double* e, - lapack_int* m, const double* w, const lapack_int* iblock, - const lapack_int* isplit, double* z, lapack_int* ldz, - double* work, lapack_int* iwork, lapack_int* ifailv, - lapack_int *info ); -void LAPACK_cstein( lapack_int* n, const float* d, const float* e, - lapack_int* m, const float* w, const lapack_int* iblock, - const lapack_int* isplit, lapack_complex_float* z, - lapack_int* ldz, float* work, lapack_int* iwork, - lapack_int* ifailv, lapack_int *info ); -void LAPACK_zstein( lapack_int* n, const double* d, const double* e, - lapack_int* m, const double* w, const lapack_int* iblock, - const lapack_int* isplit, lapack_complex_double* z, - lapack_int* ldz, double* work, lapack_int* iwork, - lapack_int* ifailv, lapack_int *info ); -void LAPACK_sdisna( char* job, lapack_int* m, lapack_int* n, const float* d, - float* sep, lapack_int *info ); -void LAPACK_ddisna( char* job, lapack_int* m, lapack_int* n, const double* d, - double* sep, lapack_int *info ); -void LAPACK_ssygst( lapack_int* itype, char* uplo, lapack_int* n, float* a, - lapack_int* lda, const float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dsygst( lapack_int* itype, char* uplo, lapack_int* n, double* a, - lapack_int* lda, const double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_chegst( lapack_int* itype, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zhegst( lapack_int* itype, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_sspgst( lapack_int* itype, char* uplo, lapack_int* n, float* ap, - const float* bp, lapack_int *info ); -void LAPACK_dspgst( lapack_int* itype, char* uplo, lapack_int* n, double* ap, - const double* bp, lapack_int *info ); -void LAPACK_chpgst( lapack_int* itype, char* uplo, lapack_int* n, - lapack_complex_float* ap, const lapack_complex_float* bp, - lapack_int *info ); -void LAPACK_zhpgst( lapack_int* itype, char* uplo, lapack_int* n, - lapack_complex_double* ap, const lapack_complex_double* bp, - lapack_int *info ); -void LAPACK_ssbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, float* ab, lapack_int* ldab, - const float* bb, lapack_int* ldbb, float* x, - lapack_int* ldx, float* work, lapack_int *info ); -void LAPACK_dsbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, double* ab, lapack_int* ldab, - const double* bb, lapack_int* ldbb, double* x, - lapack_int* ldx, double* work, lapack_int *info ); -void LAPACK_chbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab, - const lapack_complex_float* bb, lapack_int* ldbb, - lapack_complex_float* x, lapack_int* ldx, - lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zhbgst( char* vect, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab, - const lapack_complex_double* bb, lapack_int* ldbb, - lapack_complex_double* x, lapack_int* ldx, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_spbstf( char* uplo, lapack_int* n, lapack_int* kb, float* bb, - lapack_int* ldbb, lapack_int *info ); -void LAPACK_dpbstf( char* uplo, lapack_int* n, lapack_int* kb, double* bb, - lapack_int* ldbb, lapack_int *info ); -void LAPACK_cpbstf( char* uplo, lapack_int* n, lapack_int* kb, - lapack_complex_float* bb, lapack_int* ldbb, - lapack_int *info ); -void LAPACK_zpbstf( char* uplo, lapack_int* n, lapack_int* kb, - lapack_complex_double* bb, lapack_int* ldbb, - lapack_int *info ); -void LAPACK_sgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a, - lapack_int* lda, float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a, - lapack_int* lda, double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zgehrd( lapack_int* n, lapack_int* ilo, lapack_int* ihi, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tau, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a, - lapack_int* lda, const float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dorghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a, - lapack_int* lda, const double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sormhr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, const float* a, - lapack_int* lda, const float* tau, float* c, - lapack_int* ldc, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dormhr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, const double* a, - lapack_int* lda, const double* tau, double* c, - lapack_int* ldc, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, - lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zunghr( lapack_int* n, lapack_int* ilo, lapack_int* ihi, - lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cunmhr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* tau, lapack_complex_float* c, - lapack_int* ldc, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zunmhr( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* tau, lapack_complex_double* c, - lapack_int* ldc, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sgebal( char* job, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ilo, lapack_int* ihi, float* scale, - lapack_int *info ); -void LAPACK_dgebal( char* job, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ilo, lapack_int* ihi, double* scale, - lapack_int *info ); -void LAPACK_cgebal( char* job, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ilo, lapack_int* ihi, - float* scale, lapack_int *info ); -void LAPACK_zgebal( char* job, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ilo, lapack_int* ihi, - double* scale, lapack_int *info ); -void LAPACK_sgebak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const float* scale, lapack_int* m, - float* v, lapack_int* ldv, lapack_int *info ); -void LAPACK_dgebak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const double* scale, lapack_int* m, - double* v, lapack_int* ldv, lapack_int *info ); -void LAPACK_cgebak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const float* scale, lapack_int* m, - lapack_complex_float* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_zgebak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const double* scale, lapack_int* m, - lapack_complex_double* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_shseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, float* h, lapack_int* ldh, float* wr, - float* wi, float* z, lapack_int* ldz, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, double* h, lapack_int* ldh, double* wr, - double* wi, double* z, lapack_int* ldz, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_chseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, lapack_complex_float* h, lapack_int* ldh, - lapack_complex_float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zhseqr( char* job, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, lapack_complex_double* h, lapack_int* ldh, - lapack_complex_double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_shsein( char* job, char* eigsrc, char* initv, - lapack_logical* select, lapack_int* n, const float* h, - lapack_int* ldh, float* wr, const float* wi, float* vl, - lapack_int* ldvl, float* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, float* work, - lapack_int* ifaill, lapack_int* ifailr, lapack_int *info ); -void LAPACK_dhsein( char* job, char* eigsrc, char* initv, - lapack_logical* select, lapack_int* n, const double* h, - lapack_int* ldh, double* wr, const double* wi, double* vl, - lapack_int* ldvl, double* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, double* work, - lapack_int* ifaill, lapack_int* ifailr, lapack_int *info ); -void LAPACK_chsein( char* job, char* eigsrc, char* initv, - const lapack_logical* select, lapack_int* n, - const lapack_complex_float* h, lapack_int* ldh, - lapack_complex_float* w, lapack_complex_float* vl, - lapack_int* ldvl, lapack_complex_float* vr, - lapack_int* ldvr, lapack_int* mm, lapack_int* m, - lapack_complex_float* work, float* rwork, - lapack_int* ifaill, lapack_int* ifailr, lapack_int *info ); -void LAPACK_zhsein( char* job, char* eigsrc, char* initv, - const lapack_logical* select, lapack_int* n, - const lapack_complex_double* h, lapack_int* ldh, - lapack_complex_double* w, lapack_complex_double* vl, - lapack_int* ldvl, lapack_complex_double* vr, - lapack_int* ldvr, lapack_int* mm, lapack_int* m, - lapack_complex_double* work, double* rwork, - lapack_int* ifaill, lapack_int* ifailr, lapack_int *info ); -void LAPACK_strevc( char* side, char* howmny, lapack_logical* select, - lapack_int* n, const float* t, lapack_int* ldt, float* vl, - lapack_int* ldvl, float* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, float* work, - lapack_int *info ); -void LAPACK_dtrevc( char* side, char* howmny, lapack_logical* select, - lapack_int* n, const double* t, lapack_int* ldt, double* vl, - lapack_int* ldvl, double* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, double* work, - lapack_int *info ); -void LAPACK_ctrevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* vl, lapack_int* ldvl, - lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm, - lapack_int* m, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztrevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* vl, lapack_int* ldvl, - lapack_complex_double* vr, lapack_int* ldvr, lapack_int* mm, - lapack_int* m, lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_strsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const float* t, lapack_int* ldt, - const float* vl, lapack_int* ldvl, const float* vr, - lapack_int* ldvr, float* s, float* sep, lapack_int* mm, - lapack_int* m, float* work, lapack_int* ldwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dtrsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const double* t, lapack_int* ldt, - const double* vl, lapack_int* ldvl, const double* vr, - lapack_int* ldvr, double* s, double* sep, lapack_int* mm, - lapack_int* m, double* work, lapack_int* ldwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ctrsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_float* t, - lapack_int* ldt, const lapack_complex_float* vl, - lapack_int* ldvl, const lapack_complex_float* vr, - lapack_int* ldvr, float* s, float* sep, lapack_int* mm, - lapack_int* m, lapack_complex_float* work, - lapack_int* ldwork, float* rwork, lapack_int *info ); -void LAPACK_ztrsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_double* t, - lapack_int* ldt, const lapack_complex_double* vl, - lapack_int* ldvl, const lapack_complex_double* vr, - lapack_int* ldvr, double* s, double* sep, lapack_int* mm, - lapack_int* m, lapack_complex_double* work, - lapack_int* ldwork, double* rwork, lapack_int *info ); -void LAPACK_strexc( char* compq, lapack_int* n, float* t, lapack_int* ldt, - float* q, lapack_int* ldq, lapack_int* ifst, - lapack_int* ilst, float* work, lapack_int *info ); -void LAPACK_dtrexc( char* compq, lapack_int* n, double* t, lapack_int* ldt, - double* q, lapack_int* ldq, lapack_int* ifst, - lapack_int* ilst, double* work, lapack_int *info ); -void LAPACK_ctrexc( char* compq, lapack_int* n, lapack_complex_float* t, - lapack_int* ldt, lapack_complex_float* q, lapack_int* ldq, - lapack_int* ifst, lapack_int* ilst, lapack_int *info ); -void LAPACK_ztrexc( char* compq, lapack_int* n, lapack_complex_double* t, - lapack_int* ldt, lapack_complex_double* q, lapack_int* ldq, - lapack_int* ifst, lapack_int* ilst, lapack_int *info ); -void LAPACK_strsen( char* job, char* compq, const lapack_logical* select, - lapack_int* n, float* t, lapack_int* ldt, float* q, - lapack_int* ldq, float* wr, float* wi, lapack_int* m, - float* s, float* sep, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dtrsen( char* job, char* compq, const lapack_logical* select, - lapack_int* n, double* t, lapack_int* ldt, double* q, - lapack_int* ldq, double* wr, double* wi, lapack_int* m, - double* s, double* sep, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_ctrsen( char* job, char* compq, const lapack_logical* select, - lapack_int* n, lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* w, lapack_int* m, float* s, - float* sep, lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ztrsen( char* job, char* compq, const lapack_logical* select, - lapack_int* n, lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* w, lapack_int* m, double* s, - double* sep, lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_strsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m, - lapack_int* n, const float* a, lapack_int* lda, - const float* b, lapack_int* ldb, float* c, lapack_int* ldc, - float* scale, lapack_int *info ); -void LAPACK_dtrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m, - lapack_int* n, const double* a, lapack_int* lda, - const double* b, lapack_int* ldb, double* c, - lapack_int* ldc, double* scale, lapack_int *info ); -void LAPACK_ctrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m, - lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* c, lapack_int* ldc, - float* scale, lapack_int *info ); -void LAPACK_ztrsyl( char* trana, char* tranb, lapack_int* isgn, lapack_int* m, - lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* c, lapack_int* ldc, - double* scale, lapack_int *info ); -void LAPACK_sgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* q, lapack_int* ldq, float* z, - lapack_int* ldz, lapack_int *info ); -void LAPACK_dgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* q, lapack_int* ldq, double* z, - lapack_int* ldz, lapack_int *info ); -void LAPACK_cgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* z, lapack_int* ldz, - lapack_int *info ); -void LAPACK_zgghrd( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, - lapack_int *info ); -void LAPACK_sgghd3( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* q, lapack_int* ldq, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgghd3( char* compq, char* compz, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* q, lapack_int* ldq, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgghd3( char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgghd3( char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sggbal( char* job, lapack_int* n, float* a, lapack_int* lda, - float* b, lapack_int* ldb, lapack_int* ilo, lapack_int* ihi, - float* lscale, float* rscale, float* work, - lapack_int *info ); -void LAPACK_dggbal( char* job, lapack_int* n, double* a, lapack_int* lda, - double* b, lapack_int* ldb, lapack_int* ilo, - lapack_int* ihi, double* lscale, double* rscale, - double* work, lapack_int *info ); -void LAPACK_cggbal( char* job, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, - lapack_int* ilo, lapack_int* ihi, float* lscale, - float* rscale, float* work, lapack_int *info ); -void LAPACK_zggbal( char* job, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, - lapack_int* ilo, lapack_int* ihi, double* lscale, - double* rscale, double* work, lapack_int *info ); -void LAPACK_sggbak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const float* lscale, const float* rscale, - lapack_int* m, float* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_dggbak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const double* lscale, const double* rscale, - lapack_int* m, double* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_cggbak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const float* lscale, const float* rscale, - lapack_int* m, lapack_complex_float* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_zggbak( char* job, char* side, lapack_int* n, lapack_int* ilo, - lapack_int* ihi, const double* lscale, const double* rscale, - lapack_int* m, lapack_complex_double* v, lapack_int* ldv, - lapack_int *info ); -void LAPACK_shgeqz( char* job, char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, float* h, lapack_int* ldh, - float* t, lapack_int* ldt, float* alphar, float* alphai, - float* beta, float* q, lapack_int* ldq, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dhgeqz( char* job, char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, double* h, - lapack_int* ldh, double* t, lapack_int* ldt, double* alphar, - double* alphai, double* beta, double* q, lapack_int* ldq, - double* z, lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chgeqz( char* job, char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, lapack_complex_float* h, - lapack_int* ldh, lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zhgeqz( char* job, char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, lapack_complex_double* h, - lapack_int* ldh, lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_stgevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, const float* s, lapack_int* lds, - const float* p, lapack_int* ldp, float* vl, - lapack_int* ldvl, float* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, float* work, - lapack_int *info ); -void LAPACK_dtgevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, const double* s, lapack_int* lds, - const double* p, lapack_int* ldp, double* vl, - lapack_int* ldvl, double* vr, lapack_int* ldvr, - lapack_int* mm, lapack_int* m, double* work, - lapack_int *info ); -void LAPACK_ctgevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_float* s, - lapack_int* lds, const lapack_complex_float* p, - lapack_int* ldp, lapack_complex_float* vl, lapack_int* ldvl, - lapack_complex_float* vr, lapack_int* ldvr, lapack_int* mm, - lapack_int* m, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_ztgevc( char* side, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_double* s, - lapack_int* lds, const lapack_complex_double* p, - lapack_int* ldp, lapack_complex_double* vl, - lapack_int* ldvl, lapack_complex_double* vr, - lapack_int* ldvr, lapack_int* mm, lapack_int* m, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_stgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* q, lapack_int* ldq, float* z, lapack_int* ldz, - lapack_int* ifst, lapack_int* ilst, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dtgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* q, lapack_int* ldq, double* z, lapack_int* ldz, - lapack_int* ifst, lapack_int* ilst, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_ctgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* z, lapack_int* ldz, lapack_int* ifst, - lapack_int* ilst, lapack_int *info ); -void LAPACK_ztgexc( lapack_logical* wantq, lapack_logical* wantz, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, lapack_int* ifst, - lapack_int* ilst, lapack_int *info ); -void LAPACK_stgsen( lapack_int* ijob, lapack_logical* wantq, - lapack_logical* wantz, const lapack_logical* select, - lapack_int* n, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* alphar, float* alphai, float* beta, - float* q, lapack_int* ldq, float* z, lapack_int* ldz, - lapack_int* m, float* pl, float* pr, float* dif, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_dtgsen( lapack_int* ijob, lapack_logical* wantq, - lapack_logical* wantz, const lapack_logical* select, - lapack_int* n, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* alphar, double* alphai, - double* beta, double* q, lapack_int* ldq, double* z, - lapack_int* ldz, lapack_int* m, double* pl, double* pr, - double* dif, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_ctgsen( lapack_int* ijob, lapack_logical* wantq, - lapack_logical* wantz, const lapack_logical* select, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* z, lapack_int* ldz, lapack_int* m, - float* pl, float* pr, float* dif, - lapack_complex_float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_ztgsen( lapack_int* ijob, lapack_logical* wantq, - lapack_logical* wantz, const lapack_logical* select, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, lapack_int* m, - double* pl, double* pr, double* dif, - lapack_complex_double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_stgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n, - const float* a, lapack_int* lda, const float* b, - lapack_int* ldb, float* c, lapack_int* ldc, const float* d, - lapack_int* ldd, const float* e, lapack_int* lde, float* f, - lapack_int* ldf, float* scale, float* dif, float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_dtgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n, - const double* a, lapack_int* lda, const double* b, - lapack_int* ldb, double* c, lapack_int* ldc, - const double* d, lapack_int* ldd, const double* e, - lapack_int* lde, double* f, lapack_int* ldf, double* scale, - double* dif, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ctgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* c, lapack_int* ldc, - const lapack_complex_float* d, lapack_int* ldd, - const lapack_complex_float* e, lapack_int* lde, - lapack_complex_float* f, lapack_int* ldf, float* scale, - float* dif, lapack_complex_float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_ztgsyl( char* trans, lapack_int* ijob, lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* c, lapack_int* ldc, - const lapack_complex_double* d, lapack_int* ldd, - const lapack_complex_double* e, lapack_int* lde, - lapack_complex_double* f, lapack_int* ldf, double* scale, - double* dif, lapack_complex_double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_stgsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const float* a, lapack_int* lda, - const float* b, lapack_int* ldb, const float* vl, - lapack_int* ldvl, const float* vr, lapack_int* ldvr, - float* s, float* dif, lapack_int* mm, lapack_int* m, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dtgsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const double* a, lapack_int* lda, - const double* b, lapack_int* ldb, const double* vl, - lapack_int* ldvl, const double* vr, lapack_int* ldvr, - double* s, double* dif, lapack_int* mm, lapack_int* m, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_ctgsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* b, - lapack_int* ldb, const lapack_complex_float* vl, - lapack_int* ldvl, const lapack_complex_float* vr, - lapack_int* ldvr, float* s, float* dif, lapack_int* mm, - lapack_int* m, lapack_complex_float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_ztgsna( char* job, char* howmny, const lapack_logical* select, - lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* b, - lapack_int* ldb, const lapack_complex_double* vl, - lapack_int* ldvl, const lapack_complex_double* vr, - lapack_int* ldvr, double* s, double* dif, lapack_int* mm, - lapack_int* m, lapack_complex_double* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_sggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, float* a, lapack_int* lda, - float* b, lapack_int* ldb, float* tola, float* tolb, - lapack_int* k, lapack_int* l, float* u, lapack_int* ldu, - float* v, lapack_int* ldv, float* q, lapack_int* ldq, - lapack_int* iwork, float* tau, float* work, - lapack_int *info ); -void LAPACK_dggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, double* a, lapack_int* lda, - double* b, lapack_int* ldb, double* tola, double* tolb, - lapack_int* k, lapack_int* l, double* u, lapack_int* ldu, - double* v, lapack_int* ldv, double* q, lapack_int* ldq, - lapack_int* iwork, double* tau, double* work, - lapack_int *info ); -void LAPACK_cggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, - float* tola, float* tolb, lapack_int* k, lapack_int* l, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* q, lapack_int* ldq, lapack_int* iwork, - float* rwork, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, - double* tola, double* tolb, lapack_int* k, lapack_int* l, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* q, lapack_int* ldq, - lapack_int* iwork, double* rwork, - lapack_complex_double* tau, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_sggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, float* a, lapack_int* lda, - float* b, lapack_int* ldb, float* tola, float* tolb, - lapack_int* k, lapack_int* l, float* u, lapack_int* ldu, - float* v, lapack_int* ldv, float* q, lapack_int* ldq, - lapack_int* iwork, float* tau, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, double* a, lapack_int* lda, - double* b, lapack_int* ldb, double* tola, double* tolb, - lapack_int* k, lapack_int* l, double* u, lapack_int* ldu, - double* v, lapack_int* ldv, double* q, lapack_int* ldq, - lapack_int* iwork, double* tau, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, - float* tola, float* tolb, lapack_int* k, lapack_int* l, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* q, lapack_int* ldq, lapack_int* iwork, - float* rwork, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, - double* tola, double* tolb, lapack_int* k, lapack_int* l, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* q, lapack_int* ldq, - lapack_int* iwork, double* rwork, - lapack_complex_double* tau, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_stgsja( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* tola, float* tolb, float* alpha, float* beta, - float* u, lapack_int* ldu, float* v, lapack_int* ldv, - float* q, lapack_int* ldq, float* work, lapack_int* ncycle, - lapack_int *info ); -void LAPACK_dtgsja( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* tola, double* tolb, double* alpha, double* beta, - double* u, lapack_int* ldu, double* v, lapack_int* ldv, - double* q, lapack_int* ldq, double* work, - lapack_int* ncycle, lapack_int *info ); -void LAPACK_ctgsja( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* tola, - float* tolb, float* alpha, float* beta, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* work, lapack_int* ncycle, - lapack_int *info ); -void LAPACK_ztgsja( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* tola, - double* tolb, double* alpha, double* beta, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* work, lapack_int* ncycle, - lapack_int *info ); -void LAPACK_sgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_cgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_sgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, float* b, lapack_int* ldb, - lapack_int* jpvt, float* rcond, lapack_int* rank, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* b, lapack_int* ldb, - lapack_int* jpvt, double* rcond, lapack_int* rank, - double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_cgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, lapack_int* jpvt, - float* rcond, lapack_int* rank, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int *info ); -void LAPACK_zgelsy( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, lapack_int* jpvt, - double* rcond, lapack_int* rank, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_sgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* s, - float* rcond, lapack_int* rank, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* s, - double* rcond, lapack_int* rank, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* s, - float* rcond, lapack_int* rank, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int *info ); -void LAPACK_zgelss( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* s, - double* rcond, lapack_int* rank, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_sgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* s, - float* rcond, lapack_int* rank, float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_dgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* s, - double* rcond, lapack_int* rank, double* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_cgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* s, - float* rcond, lapack_int* rank, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_zgelsd( lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* s, - double* rcond, lapack_int* rank, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_sgglse( lapack_int* m, lapack_int* n, lapack_int* p, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* c, - float* d, float* x, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgglse( lapack_int* m, lapack_int* n, lapack_int* p, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* c, - double* d, double* x, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgglse( lapack_int* m, lapack_int* n, lapack_int* p, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* c, lapack_complex_float* d, - lapack_complex_float* x, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zgglse( lapack_int* m, lapack_int* n, lapack_int* p, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* c, lapack_complex_double* d, - lapack_complex_double* x, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sggglm( lapack_int* n, lapack_int* m, lapack_int* p, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* d, - float* x, float* y, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dggglm( lapack_int* n, lapack_int* m, lapack_int* p, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* d, - double* x, double* y, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cggglm( lapack_int* n, lapack_int* m, lapack_int* p, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* d, lapack_complex_float* x, - lapack_complex_float* y, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zggglm( lapack_int* n, lapack_int* m, lapack_int* p, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* d, lapack_complex_double* x, - lapack_complex_double* y, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_ssyev( char* jobz, char* uplo, lapack_int* n, float* a, - lapack_int* lda, float* w, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsyev( char* jobz, char* uplo, lapack_int* n, double* a, - lapack_int* lda, double* w, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cheev( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zheev( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_ssyevd( char* jobz, char* uplo, lapack_int* n, float* a, - lapack_int* lda, float* w, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsyevd( char* jobz, char* uplo, lapack_int* n, double* a, - lapack_int* lda, double* w, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cheevd( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zheevd( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssyevx( char* jobz, char* range, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, float* z, lapack_int* ldz, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dsyevx( char* jobz, char* range, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, double* z, lapack_int* ldz, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_cheevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_zheevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_ssyevr( char* jobz, char* range, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, float* z, lapack_int* ldz, - lapack_int* isuppz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsyevr( char* jobz, char* range, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, double* z, lapack_int* ldz, - lapack_int* isuppz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cheevr( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_int* isuppz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zheevr( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_int* isuppz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_sspev( char* jobz, char* uplo, lapack_int* n, float* ap, float* w, - float* z, lapack_int* ldz, float* work, lapack_int *info ); -void LAPACK_dspev( char* jobz, char* uplo, lapack_int* n, double* ap, double* w, - double* z, lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_chpev( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* ap, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, float* rwork, - lapack_int *info ); -void LAPACK_zhpev( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* ap, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sspevd( char* jobz, char* uplo, lapack_int* n, float* ap, float* w, - float* z, lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dspevd( char* jobz, char* uplo, lapack_int* n, double* ap, - double* w, double* z, lapack_int* ldz, double* work, - lapack_int* lwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_chpevd( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* ap, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* lrwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_zhpevd( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* ap, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_sspevx( char* jobz, char* range, char* uplo, lapack_int* n, - float* ap, float* vl, float* vu, lapack_int* il, - lapack_int* iu, float* abstol, lapack_int* m, float* w, - float* z, lapack_int* ldz, float* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dspevx( char* jobz, char* range, char* uplo, lapack_int* n, - double* ap, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_chpevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_float* ap, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, float* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_zhpevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_double* ap, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, double* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_ssbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - float* ab, lapack_int* ldab, float* w, float* z, - lapack_int* ldz, float* work, lapack_int *info ); -void LAPACK_dsbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - double* ab, lapack_int* ldab, double* w, double* z, - lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_chbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, float* rwork, lapack_int *info ); -void LAPACK_zhbev( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_ssbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - float* ab, lapack_int* ldab, float* w, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - double* ab, lapack_int* ldab, double* w, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_chbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zhbevd( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssbevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, float* ab, lapack_int* ldab, float* q, - lapack_int* ldq, float* vl, float* vu, lapack_int* il, - lapack_int* iu, float* abstol, lapack_int* m, float* w, - float* z, lapack_int* ldz, float* work, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_dsbevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, double* ab, lapack_int* ldab, double* q, - lapack_int* ldq, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_chbevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* q, lapack_int* ldq, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - float* rwork, lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_zhbevx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* q, lapack_int* ldq, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, - double* rwork, lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_sstev( char* jobz, lapack_int* n, float* d, float* e, float* z, - lapack_int* ldz, float* work, lapack_int *info ); -void LAPACK_dstev( char* jobz, lapack_int* n, double* d, double* e, double* z, - lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_sstevd( char* jobz, lapack_int* n, float* d, float* e, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dstevd( char* jobz, lapack_int* n, double* d, double* e, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_sstevx( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, float* z, - lapack_int* ldz, float* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dstevx( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_sstevr( char* jobz, char* range, lapack_int* n, float* d, float* e, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, float* z, - lapack_int* ldz, lapack_int* isuppz, float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_dstevr( char* jobz, char* range, lapack_int* n, double* d, - double* e, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, lapack_int* isuppz, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_sgees( char* jobvs, char* sort, LAPACK_S_SELECT2 select, - lapack_int* n, float* a, lapack_int* lda, lapack_int* sdim, - float* wr, float* wi, float* vs, lapack_int* ldvs, - float* work, lapack_int* lwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_dgees( char* jobvs, char* sort, LAPACK_D_SELECT2 select, - lapack_int* n, double* a, lapack_int* lda, lapack_int* sdim, - double* wr, double* wi, double* vs, lapack_int* ldvs, - double* work, lapack_int* lwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_cgees( char* jobvs, char* sort, LAPACK_C_SELECT1 select, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_int* sdim, lapack_complex_float* w, - lapack_complex_float* vs, lapack_int* ldvs, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_zgees( char* jobvs, char* sort, LAPACK_Z_SELECT1 select, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_int* sdim, lapack_complex_double* w, - lapack_complex_double* vs, lapack_int* ldvs, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_logical* bwork, lapack_int *info ); -void LAPACK_sgeesx( char* jobvs, char* sort, LAPACK_S_SELECT2 select, - char* sense, lapack_int* n, float* a, lapack_int* lda, - lapack_int* sdim, float* wr, float* wi, float* vs, - lapack_int* ldvs, float* rconde, float* rcondv, float* work, - lapack_int* lwork, lapack_int* iwork, lapack_int* liwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_dgeesx( char* jobvs, char* sort, LAPACK_D_SELECT2 select, - char* sense, lapack_int* n, double* a, lapack_int* lda, - lapack_int* sdim, double* wr, double* wi, double* vs, - lapack_int* ldvs, double* rconde, double* rcondv, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_cgeesx( char* jobvs, char* sort, LAPACK_C_SELECT1 select, - char* sense, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* sdim, lapack_complex_float* w, - lapack_complex_float* vs, lapack_int* ldvs, float* rconde, - float* rcondv, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_zgeesx( char* jobvs, char* sort, LAPACK_Z_SELECT1 select, - char* sense, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* sdim, lapack_complex_double* w, - lapack_complex_double* vs, lapack_int* ldvs, double* rconde, - double* rcondv, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_sgeev( char* jobvl, char* jobvr, lapack_int* n, float* a, - lapack_int* lda, float* wr, float* wi, float* vl, - lapack_int* ldvl, float* vr, lapack_int* ldvr, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dgeev( char* jobvl, char* jobvr, lapack_int* n, double* a, - lapack_int* lda, double* wr, double* wi, double* vl, - lapack_int* ldvl, double* vr, lapack_int* ldvr, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgeev( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* w, lapack_complex_float* vl, - lapack_int* ldvl, lapack_complex_float* vr, lapack_int* ldvr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zgeev( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* w, lapack_complex_double* vl, - lapack_int* ldvl, lapack_complex_double* vr, - lapack_int* ldvr, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int *info ); -void LAPACK_sgeevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, float* a, lapack_int* lda, float* wr, - float* wi, float* vl, lapack_int* ldvl, float* vr, - lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi, - float* scale, float* abnrm, float* rconde, float* rcondv, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dgeevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, double* a, lapack_int* lda, double* wr, - double* wi, double* vl, lapack_int* ldvl, double* vr, - lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi, - double* scale, double* abnrm, double* rconde, - double* rcondv, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgeevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* w, lapack_complex_float* vl, - lapack_int* ldvl, lapack_complex_float* vr, - lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi, - float* scale, float* abnrm, float* rconde, float* rcondv, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zgeevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* w, lapack_complex_double* vl, - lapack_int* ldvl, lapack_complex_double* vr, - lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi, - double* scale, double* abnrm, double* rconde, - double* rcondv, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int *info ); -void LAPACK_sgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n, - float* a, lapack_int* lda, float* s, float* u, - lapack_int* ldu, float* vt, lapack_int* ldvt, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_dgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n, - double* a, lapack_int* lda, double* s, double* u, - lapack_int* ldu, double* vt, lapack_int* ldvt, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* s, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* vt, lapack_int* ldvt, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zgesvd( char* jobu, char* jobvt, lapack_int* m, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* s, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* vt, lapack_int* ldvt, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_sgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, float* s, float* u, - lapack_int* ldu, float* vt, lapack_int* ldvt, float* work, - lapack_int* lwork, lapack_int *iwork, lapack_int *info ); -void LAPACK_dgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, double* s, double* u, - lapack_int* ldu, double* vt, lapack_int* ldvt, double* work, - lapack_int* lwork, lapack_int *iwork, lapack_int *info ); -void LAPACK_cgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, float* s, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* vt, lapack_int* ldvt, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *iwork, lapack_int *info ); -void LAPACK_zgesvdx( char* jobu, char* jobvt, char* range, lapack_int* m, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, lapack_int* ns, double* s, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* vt, lapack_int* ldvt, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *iwork, lapack_int *info ); -void LAPACK_sgesdd( char* jobz, lapack_int* m, lapack_int* n, float* a, - lapack_int* lda, float* s, float* u, lapack_int* ldu, - float* vt, lapack_int* ldvt, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dgesdd( char* jobz, lapack_int* m, lapack_int* n, double* a, - lapack_int* lda, double* s, double* u, lapack_int* ldu, - double* vt, lapack_int* ldvt, double* work, - lapack_int* lwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_cgesdd( char* jobz, lapack_int* m, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* s, - lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* vt, lapack_int* ldvt, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zgesdd( char* jobz, lapack_int* m, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* s, - lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* vt, lapack_int* ldvt, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_dgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt, - char* jobp, lapack_int* m, lapack_int* n, double* a, - lapack_int* lda, double* sva, double* u, lapack_int* ldu, - double* v, lapack_int* ldv, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_sgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt, - char* jobp, lapack_int* m, lapack_int* n, float* a, - lapack_int* lda, float* sva, float* u, lapack_int* ldu, - float* v, lapack_int* ldv, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_cgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt, - char* jobp, lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, float* sva, lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, lapack_complex_float* cwork, - lapack_int* lwork, float* work, lapack_int* lrwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zgejsv( char* joba, char* jobu, char* jobv, char* jobr, char* jobt, - char* jobp, lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, double* sva, lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, lapack_complex_double* cwork, - lapack_int* lwork, double* work, lapack_int* lrwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_dgesvj( char* joba, char* jobu, char* jobv, lapack_int* m, - lapack_int* n, double* a, lapack_int* lda, double* sva, - lapack_int* mv, double* v, lapack_int* ldv, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_sgesvj( char* joba, char* jobu, char* jobv, lapack_int* m, - lapack_int* n, float* a, lapack_int* lda, float* sva, - lapack_int* mv, float* v, lapack_int* ldv, float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cgesvj( char* joba, char* jobu, char* jobv, lapack_int* m, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, float* sva, - lapack_int* mv, lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* cwork, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int *info ); -void LAPACK_zgesvj( char* joba, char* jobu, char* jobv, lapack_int* m, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, double* sva, - lapack_int* mv, lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* cwork, lapack_int* lwork, double* rwork, - lapack_int* lrwork, lapack_int *info ); -void LAPACK_sggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* alpha, float* beta, float* u, lapack_int* ldu, - float* v, lapack_int* ldv, float* q, lapack_int* ldq, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* alpha, double* beta, double* u, lapack_int* ldu, - double* v, lapack_int* ldv, double* q, lapack_int* ldq, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_cggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* alpha, - float* beta, lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* work, float* rwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_zggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* alpha, - double* beta, lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* work, double* rwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_sggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* alpha, float* beta, float* u, lapack_int* ldu, - float* v, lapack_int* ldv, float* q, lapack_int* ldq, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_dggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* alpha, double* beta, double* u, lapack_int* ldu, - double* v, lapack_int* ldv, double* q, lapack_int* ldq, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int *info ); -void LAPACK_cggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* alpha, - float* beta, lapack_complex_float* u, lapack_int* ldu, - lapack_complex_float* v, lapack_int* ldv, - lapack_complex_float* q, lapack_int* ldq, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* iwork, lapack_int *info ); -void LAPACK_zggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, - lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* alpha, - double* beta, lapack_complex_double* u, lapack_int* ldu, - lapack_complex_double* v, lapack_int* ldv, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* iwork, lapack_int *info ); -void LAPACK_ssygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* w, float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* w, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zhegv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_ssygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* w, float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_dsygvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* w, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_chegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zhegvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssygvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* vl, float* vu, lapack_int* il, - lapack_int* iu, float* abstol, lapack_int* m, float* w, - float* z, lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_dsygvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_chegvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_zhegvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_sspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - float* ap, float* bp, float* w, float* z, lapack_int* ldz, - float* work, lapack_int *info ); -void LAPACK_dspgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - double* ap, double* bp, double* w, double* z, - lapack_int* ldz, double* work, lapack_int *info ); -void LAPACK_chpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* ap, lapack_complex_float* bp, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, float* rwork, lapack_int *info ); -void LAPACK_zhpgv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* ap, lapack_complex_double* bp, - double* w, lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_sspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - float* ap, float* bp, float* w, float* z, lapack_int* ldz, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_dspgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - double* ap, double* bp, double* w, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_chpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* ap, lapack_complex_float* bp, - float* w, lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zhpgvd( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* ap, lapack_complex_double* bp, - double* w, lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_sspgvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, float* ap, float* bp, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, float* z, lapack_int* ldz, - float* work, lapack_int* iwork, lapack_int* ifail, - lapack_int *info ); -void LAPACK_dspgvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, double* ap, double* bp, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, double* z, lapack_int* ldz, - double* work, lapack_int* iwork, lapack_int* ifail, - lapack_int *info ); -void LAPACK_chpgvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, lapack_complex_float* ap, - lapack_complex_float* bp, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, float* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_zhpgvx( lapack_int* itype, char* jobz, char* range, char* uplo, - lapack_int* n, lapack_complex_double* ap, - lapack_complex_double* bp, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, double* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_ssbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, float* ab, lapack_int* ldab, float* bb, - lapack_int* ldbb, float* w, float* z, lapack_int* ldz, - float* work, lapack_int *info ); -void LAPACK_dsbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, double* ab, lapack_int* ldab, double* bb, - lapack_int* ldbb, double* w, double* z, lapack_int* ldz, - double* work, lapack_int *info ); -void LAPACK_chbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* bb, lapack_int* ldbb, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, float* rwork, lapack_int *info ); -void LAPACK_zhbgv( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* bb, lapack_int* ldbb, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, double* rwork, - lapack_int *info ); -void LAPACK_ssbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, float* ab, lapack_int* ldab, float* bb, - lapack_int* ldbb, float* w, float* z, lapack_int* ldz, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_dsbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, double* ab, lapack_int* ldab, double* bb, - lapack_int* ldbb, double* w, double* z, lapack_int* ldz, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_chbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* bb, lapack_int* ldbb, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zhbgvd( char* jobz, char* uplo, lapack_int* n, lapack_int* ka, - lapack_int* kb, lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* bb, lapack_int* ldbb, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssbgvx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* ka, lapack_int* kb, float* ab, lapack_int* ldab, - float* bb, lapack_int* ldbb, float* q, lapack_int* ldq, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, float* z, - lapack_int* ldz, float* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dsbgvx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* ka, lapack_int* kb, double* ab, - lapack_int* ldab, double* bb, lapack_int* ldbb, double* q, - lapack_int* ldq, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_chbgvx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* ka, lapack_int* kb, lapack_complex_float* ab, - lapack_int* ldab, lapack_complex_float* bb, - lapack_int* ldbb, lapack_complex_float* q, lapack_int* ldq, - float* vl, float* vu, lapack_int* il, lapack_int* iu, - float* abstol, lapack_int* m, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, float* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_zhbgvx( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* ka, lapack_int* kb, lapack_complex_double* ab, - lapack_int* ldab, lapack_complex_double* bb, - lapack_int* ldbb, lapack_complex_double* q, lapack_int* ldq, - double* vl, double* vu, lapack_int* il, lapack_int* iu, - double* abstol, lapack_int* m, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, double* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_sgges( char* jobvsl, char* jobvsr, char* sort, - LAPACK_S_SELECT3 selctg, lapack_int* n, float* a, - lapack_int* lda, float* b, lapack_int* ldb, lapack_int* sdim, - float* alphar, float* alphai, float* beta, float* vsl, - lapack_int* ldvsl, float* vsr, lapack_int* ldvsr, - float* work, lapack_int* lwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_dgges( char* jobvsl, char* jobvsr, char* sort, - LAPACK_D_SELECT3 selctg, lapack_int* n, double* a, - lapack_int* lda, double* b, lapack_int* ldb, - lapack_int* sdim, double* alphar, double* alphai, - double* beta, double* vsl, lapack_int* ldvsl, double* vsr, - lapack_int* ldvsr, double* work, lapack_int* lwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_cgges( char* jobvsl, char* jobvsr, char* sort, - LAPACK_C_SELECT2 selctg, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vsl, lapack_int* ldvsl, - lapack_complex_float* vsr, lapack_int* ldvsr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_zgges( char* jobvsl, char* jobvsr, char* sort, - LAPACK_Z_SELECT2 selctg, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vsl, lapack_int* ldvsl, - lapack_complex_double* vsr, lapack_int* ldvsr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_logical* bwork, lapack_int *info ); -void LAPACK_sgges3( char* jobvsl, char* jobvsr, char* sort, - LAPACK_S_SELECT3 selctg, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - lapack_int* sdim, float* alphar, float* alphai, - float* beta, float* vsl, lapack_int* ldvsl, - float* vsr, lapack_int* ldvsr, - float* work, lapack_int* lwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_dgges3( char* jobvsl, char* jobvsr, char* sort, - LAPACK_D_SELECT3 selctg, lapack_int* n, double* a, - lapack_int* lda, double* b, lapack_int* ldb, - lapack_int* sdim, double* alphar, double* alphai, - double* beta, double* vsl, lapack_int* ldvsl, double* vsr, - lapack_int* ldvsr, double* work, lapack_int* lwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_cgges3( char* jobvsl, char* jobvsr, char* sort, - LAPACK_C_SELECT2 selctg, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_int* sdim, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vsl, lapack_int* ldvsl, - lapack_complex_float* vsr, lapack_int* ldvsr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_zgges3( char* jobvsl, char* jobvsr, char* sort, - LAPACK_Z_SELECT2 selctg, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vsl, lapack_int* ldvsl, - lapack_complex_double* vsr, lapack_int* ldvsr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_logical* bwork, lapack_int *info ); -void LAPACK_sggesx( char* jobvsl, char* jobvsr, char* sort, - LAPACK_S_SELECT3 selctg, char* sense, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - lapack_int* sdim, float* alphar, float* alphai, float* beta, - float* vsl, lapack_int* ldvsl, float* vsr, - lapack_int* ldvsr, float* rconde, float* rcondv, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_dggesx( char* jobvsl, char* jobvsr, char* sort, - LAPACK_D_SELECT3 selctg, char* sense, lapack_int* n, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - lapack_int* sdim, double* alphar, double* alphai, - double* beta, double* vsl, lapack_int* ldvsl, double* vsr, - lapack_int* ldvsr, double* rconde, double* rcondv, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* liwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_cggesx( char* jobvsl, char* jobvsr, char* sort, - LAPACK_C_SELECT2 selctg, char* sense, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, lapack_int* sdim, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vsl, lapack_int* ldvsl, - lapack_complex_float* vsr, lapack_int* ldvsr, float* rconde, - float* rcondv, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* iwork, - lapack_int* liwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_zggesx( char* jobvsl, char* jobvsr, char* sort, - LAPACK_Z_SELECT2 selctg, char* sense, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, lapack_int* sdim, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vsl, lapack_int* ldvsl, - lapack_complex_double* vsr, lapack_int* ldvsr, - double* rconde, double* rcondv, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int* iwork, - lapack_int* liwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_sggev( char* jobvl, char* jobvr, lapack_int* n, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* alphar, - float* alphai, float* beta, float* vl, lapack_int* ldvl, - float* vr, lapack_int* ldvr, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dggev( char* jobvl, char* jobvr, lapack_int* n, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* alphar, - double* alphai, double* beta, double* vl, lapack_int* ldvl, - double* vr, lapack_int* ldvr, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cggev( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vl, lapack_int* ldvl, - lapack_complex_float* vr, lapack_int* ldvr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zggev( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vl, lapack_int* ldvl, - lapack_complex_double* vr, lapack_int* ldvr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_sggev3( char* jobvl, char* jobvr, lapack_int* n, float* a, - lapack_int* lda, float* b, lapack_int* ldb, float* alphar, - float* alphai, float* beta, float* vl, lapack_int* ldvl, - float* vr, lapack_int* ldvr, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dggev3( char* jobvl, char* jobvr, lapack_int* n, double* a, - lapack_int* lda, double* b, lapack_int* ldb, double* alphar, - double* alphai, double* beta, double* vl, lapack_int* ldvl, - double* vr, lapack_int* ldvr, double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_cggev3( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vl, lapack_int* ldvl, - lapack_complex_float* vr, lapack_int* ldvr, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zggev3( char* jobvl, char* jobvr, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vl, lapack_int* ldvl, - lapack_complex_double* vr, lapack_int* ldvr, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_sggevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* alphar, float* alphai, float* beta, - float* vl, lapack_int* ldvl, float* vr, lapack_int* ldvr, - lapack_int* ilo, lapack_int* ihi, float* lscale, - float* rscale, float* abnrm, float* bbnrm, float* rconde, - float* rcondv, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_dggevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* alphar, double* alphai, - double* beta, double* vl, lapack_int* ldvl, double* vr, - lapack_int* ldvr, lapack_int* ilo, lapack_int* ihi, - double* lscale, double* rscale, double* abnrm, - double* bbnrm, double* rconde, double* rcondv, double* work, - lapack_int* lwork, lapack_int* iwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_cggevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* vl, lapack_int* ldvl, - lapack_complex_float* vr, lapack_int* ldvr, lapack_int* ilo, - lapack_int* ihi, float* lscale, float* rscale, float* abnrm, - float* bbnrm, float* rconde, float* rcondv, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* iwork, lapack_logical* bwork, - lapack_int *info ); -void LAPACK_zggevx( char* balanc, char* jobvl, char* jobvr, char* sense, - lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* vl, lapack_int* ldvl, - lapack_complex_double* vr, lapack_int* ldvr, - lapack_int* ilo, lapack_int* ihi, double* lscale, - double* rscale, double* abnrm, double* bbnrm, - double* rconde, double* rcondv, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int* iwork, - lapack_logical* bwork, lapack_int *info ); -void LAPACK_dsfrk( char* transr, char* uplo, char* trans, lapack_int* n, - lapack_int* k, double* alpha, const double* a, - lapack_int* lda, double* beta, double* c ); -void LAPACK_ssfrk( char* transr, char* uplo, char* trans, lapack_int* n, - lapack_int* k, float* alpha, const float* a, lapack_int* lda, - float* beta, float* c ); -void LAPACK_zhfrk( char* transr, char* uplo, char* trans, lapack_int* n, - lapack_int* k, double* alpha, const lapack_complex_double* a, - lapack_int* lda, double* beta, lapack_complex_double* c ); -void LAPACK_chfrk( char* transr, char* uplo, char* trans, lapack_int* n, - lapack_int* k, float* alpha, const lapack_complex_float* a, - lapack_int* lda, float* beta, lapack_complex_float* c ); -void LAPACK_dtfsm( char* transr, char* side, char* uplo, char* trans, - char* diag, lapack_int* m, lapack_int* n, double* alpha, - const double* a, double* b, lapack_int* ldb ); -void LAPACK_stfsm( char* transr, char* side, char* uplo, char* trans, - char* diag, lapack_int* m, lapack_int* n, float* alpha, - const float* a, float* b, lapack_int* ldb ); -void LAPACK_ztfsm( char* transr, char* side, char* uplo, char* trans, - char* diag, lapack_int* m, lapack_int* n, - lapack_complex_double* alpha, const lapack_complex_double* a, - lapack_complex_double* b, lapack_int* ldb ); -void LAPACK_ctfsm( char* transr, char* side, char* uplo, char* trans, - char* diag, lapack_int* m, lapack_int* n, - lapack_complex_float* alpha, const lapack_complex_float* a, - lapack_complex_float* b, lapack_int* ldb ); -void LAPACK_dtfttp( char* transr, char* uplo, lapack_int* n, const double* arf, - double* ap, lapack_int *info ); -void LAPACK_stfttp( char* transr, char* uplo, lapack_int* n, const float* arf, - float* ap, lapack_int *info ); -void LAPACK_ztfttp( char* transr, char* uplo, lapack_int* n, - const lapack_complex_double* arf, lapack_complex_double* ap, - lapack_int *info ); -void LAPACK_ctfttp( char* transr, char* uplo, lapack_int* n, - const lapack_complex_float* arf, lapack_complex_float* ap, - lapack_int *info ); -void LAPACK_dtfttr( char* transr, char* uplo, lapack_int* n, const double* arf, - double* a, lapack_int* lda, lapack_int *info ); -void LAPACK_stfttr( char* transr, char* uplo, lapack_int* n, const float* arf, - float* a, lapack_int* lda, lapack_int *info ); -void LAPACK_ztfttr( char* transr, char* uplo, lapack_int* n, - const lapack_complex_double* arf, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_ctfttr( char* transr, char* uplo, lapack_int* n, - const lapack_complex_float* arf, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_dtpttf( char* transr, char* uplo, lapack_int* n, const double* ap, - double* arf, lapack_int *info ); -void LAPACK_stpttf( char* transr, char* uplo, lapack_int* n, const float* ap, - float* arf, lapack_int *info ); -void LAPACK_ztpttf( char* transr, char* uplo, lapack_int* n, - const lapack_complex_double* ap, lapack_complex_double* arf, - lapack_int *info ); -void LAPACK_ctpttf( char* transr, char* uplo, lapack_int* n, - const lapack_complex_float* ap, lapack_complex_float* arf, - lapack_int *info ); -void LAPACK_dtpttr( char* uplo, lapack_int* n, const double* ap, double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_stpttr( char* uplo, lapack_int* n, const float* ap, float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_ztpttr( char* uplo, lapack_int* n, const lapack_complex_double* ap, - lapack_complex_double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_ctpttr( char* uplo, lapack_int* n, const lapack_complex_float* ap, - lapack_complex_float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dtrttf( char* transr, char* uplo, lapack_int* n, const double* a, - lapack_int* lda, double* arf, lapack_int *info ); -void LAPACK_strttf( char* transr, char* uplo, lapack_int* n, const float* a, - lapack_int* lda, float* arf, lapack_int *info ); -void LAPACK_ztrttf( char* transr, char* uplo, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* arf, lapack_int *info ); -void LAPACK_ctrttf( char* transr, char* uplo, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* arf, lapack_int *info ); -void LAPACK_dtrttp( char* uplo, lapack_int* n, const double* a, lapack_int* lda, - double* ap, lapack_int *info ); -void LAPACK_strttp( char* uplo, lapack_int* n, const float* a, lapack_int* lda, - float* ap, lapack_int *info ); -void LAPACK_ztrttp( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* ap, - lapack_int *info ); -void LAPACK_ctrttp( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* ap, - lapack_int *info ); -void LAPACK_sgeqrfp( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dgeqrfp( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgeqrfp( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_clacgv( lapack_int* n, lapack_complex_float* x, lapack_int* incx ); -void LAPACK_zlacgv( lapack_int* n, lapack_complex_double* x, lapack_int* incx ); -void LAPACK_slarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n, - float* x ); -void LAPACK_dlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n, - double* x ); -void LAPACK_clarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n, - lapack_complex_float* x ); -void LAPACK_zlarnv( lapack_int* idist, lapack_int* iseed, lapack_int* n, - lapack_complex_double* x ); -void LAPACK_sgeqr2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int *info ); -void LAPACK_dgeqr2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int *info ); -void LAPACK_cgeqr2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zgeqr2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_slacn2( lapack_int* n, float* v, float* x, lapack_int* isgn, - float* est, lapack_int* kase, lapack_int* isave ); -void LAPACK_dlacn2( lapack_int* n, double* v, double* x, lapack_int* isgn, - double* est, lapack_int* kase, lapack_int* isave ); -void LAPACK_clacn2( lapack_int* n, lapack_complex_float* v, - lapack_complex_float* x, float* est, - lapack_int* kase, lapack_int* isave ); -void LAPACK_zlacn2( lapack_int* n, lapack_complex_double* v, - lapack_complex_double* x, double* est, - lapack_int* kase, lapack_int* isave ); -void LAPACK_slacpy( char* uplo, lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, float* b, lapack_int* ldb ); -void LAPACK_dlacpy( char* uplo, lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, double* b, lapack_int* ldb ); -void LAPACK_clacpy( char* uplo, lapack_int* m, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb ); -void LAPACK_zlacpy( char* uplo, lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb ); - -void LAPACK_clacp2( char* uplo, lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb ); -void LAPACK_zlacp2( char* uplo, lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, lapack_complex_double* b, - lapack_int* ldb ); - -void LAPACK_sgetf2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_dgetf2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, lapack_int *info ); -void LAPACK_cgetf2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_zgetf2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, lapack_int *info ); -void LAPACK_slaswp( lapack_int* n, float* a, lapack_int* lda, lapack_int* k1, - lapack_int* k2, const lapack_int* ipiv, lapack_int* incx ); -void LAPACK_dlaswp( lapack_int* n, double* a, lapack_int* lda, lapack_int* k1, - lapack_int* k2, const lapack_int* ipiv, lapack_int* incx ); -void LAPACK_claswp( lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_int* k1, lapack_int* k2, const lapack_int* ipiv, - lapack_int* incx ); -void LAPACK_zlaswp( lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_int* k1, lapack_int* k2, const lapack_int* ipiv, - lapack_int* incx ); -float LAPACK_slange( char* norm, lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, float* work ); -double LAPACK_dlange( char* norm, lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, double* work ); -float LAPACK_clange( char* norm, lapack_int* m, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, float* work ); -double LAPACK_zlange( char* norm, lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, double* work ); -float LAPACK_clanhe( char* norm, char* uplo, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, float* work ); -double LAPACK_zlanhe( char* norm, char* uplo, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, double* work ); -void LAPACK_clarcm( lapack_int* m, lapack_int* n, const float* a, - lapack_int* lda, const lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* c, - lapack_int* ldc, float* work ); -void LAPACK_zlarcm( lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, const lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* c, - lapack_int* ldc, double* work ); -void LAPACK_clacrm( lapack_int* m, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const float* b, - lapack_int* ldb, lapack_complex_float* c, - lapack_int* ldc, float* work ); -void LAPACK_zlacrm( lapack_int* m, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const double* b, - lapack_int* ldb, lapack_complex_double* c, - lapack_int* ldc, double* work ); -float LAPACK_slansy( char* norm, char* uplo, lapack_int* n, const float* a, - lapack_int* lda, float* work ); -double LAPACK_dlansy( char* norm, char* uplo, lapack_int* n, const double* a, - lapack_int* lda, double* work ); -float LAPACK_clansy( char* norm, char* uplo, lapack_int* n, - const lapack_complex_float* a, lapack_int* lda, float* work ); -double LAPACK_zlansy( char* norm, char* uplo, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, double* work ); -float LAPACK_slantr( char* norm, char* uplo, char* diag, lapack_int* m, - lapack_int* n, const float* a, lapack_int* lda, float* work ); -double LAPACK_dlantr( char* norm, char* uplo, char* diag, lapack_int* m, - lapack_int* n, const double* a, lapack_int* lda, double* work ); -float LAPACK_clantr( char* norm, char* uplo, char* diag, lapack_int* m, - lapack_int* n, const lapack_complex_float* a, lapack_int* lda, - float* work ); -double LAPACK_zlantr( char* norm, char* uplo, char* diag, lapack_int* m, - lapack_int* n, const lapack_complex_double* a, lapack_int* lda, - double* work ); -float LAPACK_slamch( char* cmach ); -double LAPACK_dlamch( char* cmach ); -void LAPACK_sgelq2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* tau, float* work, lapack_int *info ); -void LAPACK_dgelq2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* tau, double* work, lapack_int *info ); -void LAPACK_cgelq2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* tau, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zgelq2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* tau, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_slarfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, const float* v, - lapack_int* ldv, const float* t, lapack_int* ldt, float* c, - lapack_int* ldc, float* work, lapack_int* ldwork ); -void LAPACK_dlarfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, - const double* v, lapack_int* ldv, const double* t, - lapack_int* ldt, double* c, lapack_int* ldc, double* work, - lapack_int* ldwork ); -void LAPACK_clarfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_float* v, lapack_int* ldv, - const lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* ldwork ); -void LAPACK_zlarfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_double* v, lapack_int* ldv, - const lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* ldwork ); -void LAPACK_slarfg( lapack_int* n, float* alpha, float* x, lapack_int* incx, - float* tau ); -void LAPACK_dlarfg( lapack_int* n, double* alpha, double* x, lapack_int* incx, - double* tau ); -void LAPACK_clarfg( lapack_int* n, lapack_complex_float* alpha, - lapack_complex_float* x, lapack_int* incx, - lapack_complex_float* tau ); -void LAPACK_zlarfg( lapack_int* n, lapack_complex_double* alpha, - lapack_complex_double* x, lapack_int* incx, - lapack_complex_double* tau ); -void LAPACK_slassq( lapack_int *n, float* x, lapack_int *incx, float* scale, float* sumsq ); -void LAPACK_dlassq( lapack_int *n, double* x, lapack_int *incx, double* scale, double* sumsq ); -void LAPACK_classq( lapack_int *n, lapack_complex_float* x, lapack_int *incx, float* scale, float* sumsq ); -void LAPACK_zlassq( lapack_int *n, lapack_complex_double* x, lapack_int *incx, double* scale, double* sumsq ); -void LAPACK_slarft( char* direct, char* storev, lapack_int* n, lapack_int* k, - const float* v, lapack_int* ldv, const float* tau, float* t, - lapack_int* ldt ); -void LAPACK_dlarft( char* direct, char* storev, lapack_int* n, lapack_int* k, - const double* v, lapack_int* ldv, const double* tau, - double* t, lapack_int* ldt ); -void LAPACK_clarft( char* direct, char* storev, lapack_int* n, lapack_int* k, - const lapack_complex_float* v, lapack_int* ldv, - const lapack_complex_float* tau, lapack_complex_float* t, - lapack_int* ldt ); -void LAPACK_zlarft( char* direct, char* storev, lapack_int* n, lapack_int* k, - const lapack_complex_double* v, lapack_int* ldv, - const lapack_complex_double* tau, lapack_complex_double* t, - lapack_int* ldt ); -void LAPACK_slarfx( char* side, lapack_int* m, lapack_int* n, const float* v, - float* tau, float* c, lapack_int* ldc, float* work ); -void LAPACK_dlarfx( char* side, lapack_int* m, lapack_int* n, const double* v, - double* tau, double* c, lapack_int* ldc, double* work ); -void LAPACK_clarfx( char* side, lapack_int* m, lapack_int* n, - const lapack_complex_float* v, lapack_complex_float* tau, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work ); -void LAPACK_zlarfx( char* side, lapack_int* m, lapack_int* n, - const lapack_complex_double* v, lapack_complex_double* tau, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work ); -void LAPACK_slatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed, - char* sym, float* d, lapack_int* mode, float* cond, - float* dmax, lapack_int* kl, lapack_int* ku, char* pack, - float* a, lapack_int* lda, float* work, lapack_int *info ); -void LAPACK_dlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed, - char* sym, double* d, lapack_int* mode, double* cond, - double* dmax, lapack_int* kl, lapack_int* ku, char* pack, - double* a, lapack_int* lda, double* work, - lapack_int *info ); -void LAPACK_clatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed, - char* sym, float* d, lapack_int* mode, float* cond, - float* dmax, lapack_int* kl, lapack_int* ku, char* pack, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zlatms( lapack_int* m, lapack_int* n, char* dist, lapack_int* iseed, - char* sym, double* d, lapack_int* mode, double* cond, - double* dmax, lapack_int* kl, lapack_int* ku, char* pack, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_slag2d( lapack_int* m, lapack_int* n, const float* sa, - lapack_int* ldsa, double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dlag2s( lapack_int* m, lapack_int* n, const double* a, - lapack_int* lda, float* sa, lapack_int* ldsa, - lapack_int *info ); -void LAPACK_clag2z( lapack_int* m, lapack_int* n, - const lapack_complex_float* sa, lapack_int* ldsa, - lapack_complex_double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_zlag2c( lapack_int* m, lapack_int* n, - const lapack_complex_double* a, lapack_int* lda, - lapack_complex_float* sa, lapack_int* ldsa, - lapack_int *info ); -void LAPACK_slauum( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_dlauum( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int *info ); -void LAPACK_clauum( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_zlauum( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_slagge( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const float* d, float* a, lapack_int* lda, - lapack_int* iseed, float* work, lapack_int *info ); -void LAPACK_dlagge( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const double* d, double* a, lapack_int* lda, - lapack_int* iseed, double* work, lapack_int *info ); -void LAPACK_clagge( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const float* d, lapack_complex_float* a, - lapack_int* lda, lapack_int* iseed, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zlagge( lapack_int* m, lapack_int* n, lapack_int* kl, - lapack_int* ku, const double* d, lapack_complex_double* a, - lapack_int* lda, lapack_int* iseed, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_slascl( char* type, lapack_int* kl, lapack_int* ku, float* cfrom, - float* cto, lapack_int* m, lapack_int* n, float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_dlascl( char* type, lapack_int* kl, lapack_int* ku, double* cfrom, - double* cto, lapack_int* m, lapack_int* n, double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_clascl( char* type, lapack_int* kl, lapack_int* ku, float* cfrom, - float* cto, lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_zlascl( char* type, lapack_int* kl, lapack_int* ku, double* cfrom, - double* cto, lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int *info ); -void LAPACK_slaset( char* uplo, lapack_int* m, lapack_int* n, float* alpha, - float* beta, float* a, lapack_int* lda ); -void LAPACK_dlaset( char* uplo, lapack_int* m, lapack_int* n, double* alpha, - double* beta, double* a, lapack_int* lda ); -void LAPACK_claset( char* uplo, lapack_int* m, lapack_int* n, - lapack_complex_float* alpha, lapack_complex_float* beta, - lapack_complex_float* a, lapack_int* lda ); -void LAPACK_zlaset( char* uplo, lapack_int* m, lapack_int* n, - lapack_complex_double* alpha, lapack_complex_double* beta, - lapack_complex_double* a, lapack_int* lda ); -void LAPACK_slasrt( char* id, lapack_int* n, float* d, lapack_int *info ); -void LAPACK_dlasrt( char* id, lapack_int* n, double* d, lapack_int *info ); -void LAPACK_claghe( lapack_int* n, lapack_int* k, const float* d, - lapack_complex_float* a, lapack_int* lda, lapack_int* iseed, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zlaghe( lapack_int* n, lapack_int* k, const double* d, - lapack_complex_double* a, lapack_int* lda, - lapack_int* iseed, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_slagsy( lapack_int* n, lapack_int* k, const float* d, float* a, - lapack_int* lda, lapack_int* iseed, float* work, - lapack_int *info ); -void LAPACK_dlagsy( lapack_int* n, lapack_int* k, const double* d, double* a, - lapack_int* lda, lapack_int* iseed, double* work, - lapack_int *info ); -void LAPACK_clagsy( lapack_int* n, lapack_int* k, const float* d, - lapack_complex_float* a, lapack_int* lda, lapack_int* iseed, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zlagsy( lapack_int* n, lapack_int* k, const double* d, - lapack_complex_double* a, lapack_int* lda, - lapack_int* iseed, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_slapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - float* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_dlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - double* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_clapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - lapack_complex_float* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_zlapmr( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - lapack_complex_double* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_slapmt( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - float* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_dlapmt( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - double* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_clapmt( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - lapack_complex_float* x, lapack_int* ldx, lapack_int* k ); -void LAPACK_zlapmt( lapack_logical* forwrd, lapack_int* m, lapack_int* n, - lapack_complex_double* x, lapack_int* ldx, lapack_int* k ); -float LAPACK_slapy2( float* x, float* y ); -double LAPACK_dlapy2( double* x, double* y ); -float LAPACK_slapy3( float* x, float* y, float* z ); -double LAPACK_dlapy3( double* x, double* y, double* z ); -void LAPACK_slartgp( float* f, float* g, float* cs, float* sn, float* r ); -void LAPACK_dlartgp( double* f, double* g, double* cs, double* sn, double* r ); -void LAPACK_slartgs( float* x, float* y, float* sigma, float* cs, float* sn ); -void LAPACK_dlartgs( double* x, double* y, double* sigma, double* cs, - double* sn ); -// LAPACK 3.3.0 -void LAPACK_cbbcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - lapack_int* m, lapack_int* p, lapack_int* q, - float* theta, float* phi, - lapack_complex_float* u1, lapack_int* ldu1, - lapack_complex_float* u2, lapack_int* ldu2, - lapack_complex_float* v1t, lapack_int* ldv1t, - lapack_complex_float* v2t, lapack_int* ldv2t, - float* b11d, float* b11e, float* b12d, - float* b12e, float* b21d, float* b21e, - float* b22d, float* b22e, float* rwork, - lapack_int* lrwork , lapack_int *info ); -void LAPACK_cheswapr( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* i1, lapack_int* i2 ); -void LAPACK_chetri2( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_chetri2x( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* nb , lapack_int *info ); -void LAPACK_chetrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work , lapack_int *info ); -void LAPACK_csyconv( char* uplo, char* way, - lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* e , lapack_int *info ); -void LAPACK_csyswapr( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_int* i1, lapack_int* i2 ); -void LAPACK_csytri2( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_csytri2x( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* nb , lapack_int *info ); -void LAPACK_csytrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work , lapack_int *info ); -void LAPACK_cunbdb( char* trans, char* signs, - lapack_int* m, lapack_int* p, lapack_int* q, - lapack_complex_float* x11, lapack_int* ldx11, - lapack_complex_float* x12, lapack_int* ldx12, - lapack_complex_float* x21, lapack_int* ldx21, - lapack_complex_float* x22, lapack_int* ldx22, - float* theta, float* phi, - lapack_complex_float* taup1, - lapack_complex_float* taup2, - lapack_complex_float* tauq1, - lapack_complex_float* tauq2, - lapack_complex_float* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_cuncsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - char* signs, lapack_int* m, lapack_int* p, - lapack_int* q, lapack_complex_float* x11, - lapack_int* ldx11, lapack_complex_float* x12, - lapack_int* ldx12, lapack_complex_float* x21, - lapack_int* ldx21, lapack_complex_float* x22, - lapack_int* ldx22, float* theta, - lapack_complex_float* u1, lapack_int* ldu1, - lapack_complex_float* u2, lapack_int* ldu2, - lapack_complex_float* v1t, lapack_int* ldv1t, - lapack_complex_float* v2t, lapack_int* ldv2t, - lapack_complex_float* work, lapack_int* lwork, - float* rwork, lapack_int* lrwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_cuncsd2by1( char* jobu1, char* jobu2, - char* jobv1t, lapack_int* m, lapack_int* p, - lapack_int* q, lapack_complex_float* x11, - lapack_int* ldx11, lapack_complex_float* x21, - lapack_int* ldx21, float* theta, - lapack_complex_float* u1, lapack_int* ldu1, - lapack_complex_float* u2, lapack_int* ldu2, - lapack_complex_float* v1t, lapack_int* ldv1t, - lapack_complex_float* work, lapack_int* lwork, - float* rwork, lapack_int* lrwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_dbbcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - lapack_int* m, lapack_int* p, lapack_int* q, - double* theta, double* phi, double* u1, - lapack_int* ldu1, double* u2, lapack_int* ldu2, - double* v1t, lapack_int* ldv1t, double* v2t, - lapack_int* ldv2t, double* b11d, double* b11e, - double* b12d, double* b12e, double* b21d, - double* b21e, double* b22d, double* b22e, - double* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_dorbdb( char* trans, char* signs, - lapack_int* m, lapack_int* p, lapack_int* q, - double* x11, lapack_int* ldx11, double* x12, - lapack_int* ldx12, double* x21, lapack_int* ldx21, - double* x22, lapack_int* ldx22, double* theta, - double* phi, double* taup1, double* taup2, - double* tauq1, double* tauq2, double* work, - lapack_int* lwork , lapack_int *info ); -void LAPACK_dorcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - char* signs, lapack_int* m, lapack_int* p, - lapack_int* q, double* x11, lapack_int* ldx11, - double* x12, lapack_int* ldx12, double* x21, - lapack_int* ldx21, double* x22, lapack_int* ldx22, - double* theta, double* u1, lapack_int* ldu1, - double* u2, lapack_int* ldu2, double* v1t, - lapack_int* ldv1t, double* v2t, lapack_int* ldv2t, - double* work, lapack_int* lwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_dorcsd2by1( char* jobu1, char* jobu2, - char* jobv1t, lapack_int* m, lapack_int* p, - lapack_int* q, double* x11, lapack_int* ldx11, - double* x21, lapack_int* ldx21, - double* theta, double* u1, lapack_int* ldu1, - double* u2, lapack_int* ldu2, double* v1t, - lapack_int* ldv1t, double* work, lapack_int* lwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_dsyconv( char* uplo, char* way, - lapack_int* n, double* a, lapack_int* lda, - const lapack_int* ipiv, double* e , lapack_int *info ); -void LAPACK_dsyswapr( char* uplo, lapack_int* n, double* a, - lapack_int* lda, lapack_int* i1, lapack_int* i2 ); -void LAPACK_dsytri2( char* uplo, lapack_int* n, - double* a, lapack_int* lda, - const lapack_int* ipiv, - double* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_dsytri2x( char* uplo, lapack_int* n, - double* a, lapack_int* lda, - const lapack_int* ipiv, double* work, - lapack_int* nb , lapack_int *info ); -void LAPACK_dsytrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, const double* a, - lapack_int* lda, const lapack_int* ipiv, - double* b, lapack_int* ldb, double* work , lapack_int *info ); -void LAPACK_sbbcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - lapack_int* m, lapack_int* p, lapack_int* q, - float* theta, float* phi, float* u1, - lapack_int* ldu1, float* u2, lapack_int* ldu2, - float* v1t, lapack_int* ldv1t, float* v2t, - lapack_int* ldv2t, float* b11d, float* b11e, - float* b12d, float* b12e, float* b21d, - float* b21e, float* b22d, float* b22e, - float* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_sorbdb( char* trans, char* signs, - lapack_int* m, lapack_int* p, lapack_int* q, - float* x11, lapack_int* ldx11, float* x12, - lapack_int* ldx12, float* x21, lapack_int* ldx21, - float* x22, lapack_int* ldx22, float* theta, - float* phi, float* taup1, float* taup2, - float* tauq1, float* tauq2, float* work, - lapack_int* lwork , lapack_int *info ); -void LAPACK_sorcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - char* signs, lapack_int* m, lapack_int* p, - lapack_int* q, float* x11, lapack_int* ldx11, - float* x12, lapack_int* ldx12, float* x21, - lapack_int* ldx21, float* x22, lapack_int* ldx22, - float* theta, float* u1, lapack_int* ldu1, - float* u2, lapack_int* ldu2, float* v1t, - lapack_int* ldv1t, float* v2t, lapack_int* ldv2t, - float* work, lapack_int* lwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_sorcsd2by1( char* jobu1, char* jobu2, - char* jobv1t, lapack_int* m, lapack_int* p, - lapack_int* q, float* x11, lapack_int* ldx11, - float* x21, lapack_int* ldx21, - float* theta, float* u1, lapack_int* ldu1, - float* u2, lapack_int* ldu2, float* v1t, - lapack_int* ldv1t, float* work, lapack_int* lwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_ssyconv( char* uplo, char* way, - lapack_int* n, float* a, lapack_int* lda, - const lapack_int* ipiv, float* e , lapack_int *info ); -void LAPACK_ssyswapr( char* uplo, lapack_int* n, float* a, - lapack_int* lda, lapack_int* i1, lapack_int* i2 ); -void LAPACK_ssytri2( char* uplo, lapack_int* n, - float* a, lapack_int* lda, - const lapack_int* ipiv, - float* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_ssytri2x( char* uplo, lapack_int* n, - float* a, lapack_int* lda, - const lapack_int* ipiv, float* work, - lapack_int* nb , lapack_int *info ); -void LAPACK_ssytrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, const float* a, - lapack_int* lda, const lapack_int* ipiv, - float* b, lapack_int* ldb, float* work , lapack_int *info ); -void LAPACK_zbbcsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - lapack_int* m, lapack_int* p, lapack_int* q, - double* theta, double* phi, - lapack_complex_double* u1, lapack_int* ldu1, - lapack_complex_double* u2, lapack_int* ldu2, - lapack_complex_double* v1t, lapack_int* ldv1t, - lapack_complex_double* v2t, lapack_int* ldv2t, - double* b11d, double* b11e, double* b12d, - double* b12e, double* b21d, double* b21e, - double* b22d, double* b22e, double* rwork, - lapack_int* lrwork , lapack_int *info ); -void LAPACK_zheswapr( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* i1, lapack_int* i2 ); -void LAPACK_zhetri2( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_zhetri2x( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* nb , lapack_int *info ); -void LAPACK_zhetrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work , lapack_int *info ); -void LAPACK_zsyconv( char* uplo, char* way, - lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_double* e , lapack_int *info ); -void LAPACK_zsyswapr( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* i1, - lapack_int* i2 ); -void LAPACK_zsytri2( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_zsytri2x( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* nb , lapack_int *info ); -void LAPACK_zsytrs2( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work , lapack_int *info ); -void LAPACK_zunbdb( char* trans, char* signs, - lapack_int* m, lapack_int* p, lapack_int* q, - lapack_complex_double* x11, lapack_int* ldx11, - lapack_complex_double* x12, lapack_int* ldx12, - lapack_complex_double* x21, lapack_int* ldx21, - lapack_complex_double* x22, lapack_int* ldx22, - double* theta, double* phi, - lapack_complex_double* taup1, - lapack_complex_double* taup2, - lapack_complex_double* tauq1, - lapack_complex_double* tauq2, - lapack_complex_double* work, lapack_int* lwork , lapack_int *info ); -void LAPACK_zuncsd( char* jobu1, char* jobu2, - char* jobv1t, char* jobv2t, char* trans, - char* signs, lapack_int* m, lapack_int* p, - lapack_int* q, lapack_complex_double* x11, - lapack_int* ldx11, lapack_complex_double* x12, - lapack_int* ldx12, lapack_complex_double* x21, - lapack_int* ldx21, lapack_complex_double* x22, - lapack_int* ldx22, double* theta, - lapack_complex_double* u1, lapack_int* ldu1, - lapack_complex_double* u2, lapack_int* ldu2, - lapack_complex_double* v1t, lapack_int* ldv1t, - lapack_complex_double* v2t, lapack_int* ldv2t, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, - lapack_int* iwork , lapack_int *info ); -void LAPACK_zuncsd2by1( char* jobu1, char* jobu2, - char* jobv1t, lapack_int* m, lapack_int* p, - lapack_int* q, lapack_complex_double* x11, - lapack_int* ldx11, lapack_complex_double* x21, - lapack_int* ldx21, double* theta, - lapack_complex_double* u1, lapack_int* ldu1, - lapack_complex_double* u2, lapack_int* ldu2, - lapack_complex_double* v1t, lapack_int* ldv1t, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, - lapack_int* iwork , lapack_int *info ); -// LAPACK 3.4.0 -void LAPACK_sgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* nb, const float* v, - lapack_int* ldv, const float* t, lapack_int* ldt, float* c, - lapack_int* ldc, float* work, lapack_int *info ); -void LAPACK_dgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* nb, const double* v, - lapack_int* ldv, const double* t, lapack_int* ldt, - double* c, lapack_int* ldc, double* work, - lapack_int *info ); -void LAPACK_cgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* nb, - const lapack_complex_float* v, lapack_int* ldv, - const lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* nb, - const lapack_complex_double* v, lapack_int* ldv, - const lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_sgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, float* a, - lapack_int* lda, float* t, lapack_int* ldt, float* work, - lapack_int *info ); -void LAPACK_dgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, double* a, - lapack_int* lda, double* t, lapack_int* ldt, double* work, - lapack_int *info ); -void LAPACK_cgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_zgeqrt( lapack_int* m, lapack_int* n, lapack_int* nb, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_sgeqrt2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_dgeqrt2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_cgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_zgeqrt2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_sgeqrt3( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_dgeqrt3( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_cgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_zgeqrt3( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_stpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, lapack_int* nb, - const float* v, lapack_int* ldv, const float* t, - lapack_int* ldt, float* a, lapack_int* lda, float* b, - lapack_int* ldb, float* work, lapack_int *info ); -void LAPACK_dtpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, lapack_int* nb, - const double* v, lapack_int* ldv, const double* t, - lapack_int* ldt, double* a, lapack_int* lda, double* b, - lapack_int* ldb, double* work, lapack_int *info ); -void LAPACK_ctpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, lapack_int* nb, - const lapack_complex_float* v, lapack_int* ldv, - const lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_ztpmqrt( char* side, char* trans, lapack_int* m, lapack_int* n, - lapack_int* k, lapack_int* l, lapack_int* nb, - const lapack_complex_double* v, lapack_int* ldv, - const lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_stpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* t, lapack_int* ldt, float* work, lapack_int *info ); -void LAPACK_dtpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* t, lapack_int* ldt, double* work, - lapack_int *info ); -void LAPACK_ctpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* work, lapack_int *info ); -void LAPACK_ztpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* work, lapack_int *info ); -void LAPACK_stpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, - float* a, lapack_int* lda, - float* b, lapack_int* ldb, - float* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_dtpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, - double* a, lapack_int* lda, - double* b, lapack_int* ldb, - double* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_ctpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_ztpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* t, lapack_int* ldt, - lapack_int *info ); -void LAPACK_stprfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, - const float* v, lapack_int* ldv, const float* t, - lapack_int* ldt, float* a, lapack_int* lda, float* b, - lapack_int* ldb, const float* work, - lapack_int* ldwork ); -void LAPACK_dtprfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, - const double* v, lapack_int* ldv, const double* t, - lapack_int* ldt, double* a, lapack_int* lda, double* b, - lapack_int* ldb, const double* work, - lapack_int* ldwork ); -void LAPACK_ctprfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, - const lapack_complex_float* v, lapack_int* ldv, - const lapack_complex_float* t, lapack_int* ldt, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* ldwork ); -void LAPACK_ztprfb( char* side, char* trans, char* direct, char* storev, - lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, - const lapack_complex_double* v, lapack_int* ldv, - const lapack_complex_double* t, lapack_int* ldt, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* ldwork ); -// LAPACK 3.5.0 -void LAPACK_ssysv_rook( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, lapack_int* ipiv, float* b, - lapack_int* ldb, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ssytrf_rook( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsysv_rook( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, lapack_int* ipiv, double* b, - lapack_int* ldb, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsytrf_rook( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csysv_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_complex_float* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_csytrf_rook( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsysv_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_complex_double* work, - lapack_int* lwork, lapack_int *info ); -void LAPACK_zsytrf_rook( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_ssytrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, const float* a, - lapack_int* lda, const lapack_int* ipiv, float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_dsytrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - const double* a, lapack_int* lda, const lapack_int* ipiv, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_csytrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zsytrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_chetrf_rook( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhetrf_rook( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chetrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_float* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_float* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_zhetrs_rook( char* uplo, lapack_int* n, lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, lapack_complex_double* b, - lapack_int* ldb, lapack_int *info ); - -void LAPACK_csyr( char* uplo, lapack_int* n, lapack_complex_float* alpha, - const lapack_complex_float* x, lapack_int* incx, - lapack_complex_float* a, lapack_int* lda ); -void LAPACK_zsyr( char* uplo, lapack_int* n, lapack_complex_double* alpha, - const lapack_complex_double* x, lapack_int* incx, - lapack_complex_double* a, lapack_int* lda ); -void LAPACK_ilaver( const lapack_int* vers_major, const lapack_int* vers_minor, - const lapack_int* vers_patch ); - -// LAPACK 3.7.0 -void LAPACK_ssysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, lapack_int* ipiv, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, lapack_int* ipiv, double* b, - lapack_int* ldb, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsysv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chesv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhesv_aa( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrf_aa( char* uplo, lapack_int* n, float* a, lapack_int* lda, - lapack_int* ipiv, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsytrf_aa( char* uplo, lapack_int* n, double* a, lapack_int* lda, - lapack_int* ipiv, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csytrf_aa( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsytrf_aa( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chetrf_aa( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhetrf_aa( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, const float* a, - lapack_int* lda, const lapack_int* ipiv, - float* b, lapack_int* ldb, float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsytrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, const double* a, - lapack_int* lda, const lapack_int* ipiv, - double* b, lapack_int* ldb, double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_csytrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work , lapack_int* lwork, lapack_int *info ); -void LAPACK_zsytrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_chetrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work , lapack_int* lwork, lapack_int *info ); -void LAPACK_zhetrs_aa( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); - -void LAPACK_ssysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, - lapack_int* lda, float* e, lapack_int* ipiv, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* e, lapack_int* ipiv, double* b, - lapack_int* ldb, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* e, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* e, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chesv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* e, lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhesv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* e, lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrf_rk( char* uplo, lapack_int* n, float* a, lapack_int* lda, - float* e, lapack_int* ipiv, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsytrf_rk( char* uplo, lapack_int* n, double* a, lapack_int* lda, - double* e, lapack_int* ipiv, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csytrf_rk( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* e, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsytrf_rk( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* e, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chetrf_rk( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* e, lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhetrf_rk( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* e, lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, const float* a, - lapack_int* lda, const float* e, const lapack_int* ipiv, - float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_dsytrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, const double* a, - lapack_int* lda, const double* e, const lapack_int* ipiv, - double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_csytrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, - const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zsytrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* e, const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_chetrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, - const lapack_int* ipiv, - lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); -void LAPACK_zhetrs_3( char* uplo, lapack_int* n, - lapack_int* nrhs, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* e, - const lapack_int* ipiv, - lapack_complex_double* b, lapack_int* ldb, lapack_int *info ); - -void LAPACK_ssytri_3( char* uplo, lapack_int* n, float* a, lapack_int* lda, const float* e, - const lapack_int* ipiv, float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsytri_3( char* uplo, lapack_int* n, double* a, lapack_int* lda, const double* e, - const lapack_int* ipiv, double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_csytri_3( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_zsytri_3( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_chetri_3( char* uplo, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, - lapack_complex_float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_zhetri_3( char* uplo, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, - lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); - -void LAPACK_ssycon_3( char* uplo, lapack_int* n, const float* a, lapack_int* lda, const float* e, - const lapack_int* ipiv, float* anorm, float* rcond, - float* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_dsycon_3( char* uplo, lapack_int* n, const double* a, lapack_int* lda, const double* e, - const lapack_int* ipiv, double* anorm, double* rcond, - double* work, lapack_int* iwork, lapack_int *info ); -void LAPACK_csycon_3( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, float* anorm, - float* rcond, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zsycon_3( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, double* anorm, - double* rcond, lapack_complex_double* work, - lapack_int *info ); -void LAPACK_checon_3( char* uplo, lapack_int* n, const lapack_complex_float* a, - lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, float* anorm, - float* rcond, lapack_complex_float* work, - lapack_int *info ); -void LAPACK_zhecon_3( char* uplo, lapack_int* n, const lapack_complex_double* a, - lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, double* anorm, - double* rcond, lapack_complex_double* work, - lapack_int *info ); - -void LAPACK_sgelq( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* t, lapack_int* tsize, float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_dgelq( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* t, lapack_int* tsize, double* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_cgelq( lapack_int* m, lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* t, lapack_int* tsize, lapack_complex_float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_zgelq( lapack_int* m, lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* t, lapack_int* tsize, lapack_complex_double* work, lapack_int* lwork, - lapack_int* info ); - -void LAPACK_sgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const float* a, lapack_int* lda, - const float* t, lapack_int* tsize, - float* c, lapack_int* ldc, - float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_dgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const double* a, lapack_int* lda, - const double* t, lapack_int* tsize, - double* c, lapack_int* ldc, - double* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_cgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* t, lapack_int* tsize, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_zgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* t, lapack_int* tsize, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int* info ); - -void LAPACK_sgeqr( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* t, lapack_int* tsize, float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_dgeqr( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* t, lapack_int* tsize, double* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_cgeqr( lapack_int* m, lapack_int* n, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* t, lapack_int* tsize, lapack_complex_float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_zgeqr( lapack_int* m, lapack_int* n, lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* t, lapack_int* tsize, lapack_complex_double* work, lapack_int* lwork, - lapack_int* info ); - -void LAPACK_sgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const float* a, lapack_int* lda, - const float* t, lapack_int* tsize, - float* c, lapack_int* ldc, - float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_dgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const double* a, lapack_int* lda, - const double* t, lapack_int* tsize, - double* c, lapack_int* ldc, - double* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_cgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_float* a, lapack_int* lda, - const lapack_complex_float* t, lapack_int* tsize, - lapack_complex_float* c, lapack_int* ldc, - lapack_complex_float* work, lapack_int* lwork, - lapack_int* info ); -void LAPACK_zgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, - const lapack_complex_double* a, lapack_int* lda, - const lapack_complex_double* t, lapack_int* tsize, - lapack_complex_double* c, lapack_int* ldc, - lapack_complex_double* work, lapack_int* lwork, - lapack_int* info ); - -void LAPACK_sgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_cgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssyev_2stage( char* jobz, char* uplo, lapack_int* n, float* a, - lapack_int* lda, float* w, float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_dsyev_2stage( char* jobz, char* uplo, lapack_int* n, double* a, - lapack_int* lda, double* w, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_cheev_2stage( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zheev_2stage( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); -void LAPACK_ssyevd_2stage( char* jobz, char* uplo, lapack_int* n, float* a, - lapack_int* lda, float* w, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsyevd_2stage( char* jobz, char* uplo, lapack_int* n, double* a, - lapack_int* lda, double* w, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cheevd_2stage( char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zheevd_2stage( char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssyevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, float* z, lapack_int* ldz, - float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dsyevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, double* z, lapack_int* ldz, - double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_cheevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, - lapack_int* lwork, float* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_zheevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, - lapack_int* lwork, double* rwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_ssyevr_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* vl, float* vu, - lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, float* z, lapack_int* ldz, - lapack_int* isuppz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsyevr_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* vl, double* vu, - lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, double* z, lapack_int* ldz, - lapack_int* isuppz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_cheevr_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_int* isuppz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zheevr_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_int* isuppz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssbev_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - float* ab, lapack_int* ldab, float* w, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsbev_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - double* ab, lapack_int* ldab, double* w, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_chbev_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, lapack_int *info ); -void LAPACK_zhbev_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, double* rwork, - lapack_int *info ); -void LAPACK_ssbevd_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - float* ab, lapack_int* ldab, float* w, float* z, - lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_dsbevd_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - double* ab, lapack_int* ldab, double* w, double* z, - lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int* iwork, lapack_int* liwork, lapack_int *info ); -void LAPACK_chbevd_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_float* ab, lapack_int* ldab, float* w, - lapack_complex_float* z, lapack_int* ldz, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* lrwork, lapack_int* iwork, lapack_int* liwork, - lapack_int *info ); -void LAPACK_zhbevd_2stage( char* jobz, char* uplo, lapack_int* n, lapack_int* kd, - lapack_complex_double* ab, lapack_int* ldab, double* w, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int* lrwork, lapack_int* iwork, - lapack_int* liwork, lapack_int *info ); -void LAPACK_ssbevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, float* ab, lapack_int* ldab, float* q, - lapack_int* ldq, float* vl, float* vu, lapack_int* il, - lapack_int* iu, float* abstol, lapack_int* m, float* w, - float* z, lapack_int* ldz, float* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_dsbevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, double* ab, lapack_int* ldab, double* q, - lapack_int* ldq, double* vl, double* vu, lapack_int* il, - lapack_int* iu, double* abstol, lapack_int* m, double* w, - double* z, lapack_int* ldz, double* work, lapack_int* lwork, lapack_int* iwork, - lapack_int* ifail, lapack_int *info ); -void LAPACK_chbevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, lapack_complex_float* ab, lapack_int* ldab, - lapack_complex_float* q, lapack_int* ldq, float* vl, - float* vu, lapack_int* il, lapack_int* iu, float* abstol, - lapack_int* m, float* w, lapack_complex_float* z, - lapack_int* ldz, lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_zhbevx_2stage( char* jobz, char* range, char* uplo, lapack_int* n, - lapack_int* kd, lapack_complex_double* ab, lapack_int* ldab, - lapack_complex_double* q, lapack_int* ldq, double* vl, - double* vu, lapack_int* il, lapack_int* iu, double* abstol, - lapack_int* m, double* w, lapack_complex_double* z, - lapack_int* ldz, lapack_complex_double* work, lapack_int* lwork, double* rwork, - lapack_int* iwork, lapack_int* ifail, lapack_int *info ); -void LAPACK_ssygv_2stage( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* b, lapack_int* ldb, - float* w, float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsygv_2stage( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - double* a, lapack_int* lda, double* b, lapack_int* ldb, - double* w, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chegv_2stage( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* b, lapack_int* ldb, float* w, - lapack_complex_float* work, lapack_int* lwork, float* rwork, - lapack_int *info ); -void LAPACK_zhegv_2stage( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, double* w, - lapack_complex_double* work, lapack_int* lwork, - double* rwork, lapack_int *info ); - -//LAPACK 3.8.0 - -void LAPACK_ssysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int* ldb, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, double* b, - lapack_int* ldb, double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsysv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chesv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* b, lapack_int* ldb, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhesv_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrf_aa_2stage( char* uplo, lapack_int* n, - float* a, lapack_int* lda, float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - float* work, lapack_int* lwork, lapack_int *info ); -void LAPACK_dsytrf_aa_2stage( char* uplo, lapack_int* n, double* a, - lapack_int* lda, double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_csytrf_aa_2stage( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zsytrf_aa_2stage( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_chetrf_aa_2stage( char* uplo, lapack_int* n, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* work, lapack_int* lwork, - lapack_int *info ); -void LAPACK_zhetrf_aa_2stage( char* uplo, lapack_int* n, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); - -void LAPACK_ssytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - float* a, lapack_int* lda, float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_dsytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, - lapack_int* lda, double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, double* b, - lapack_int* ldb, lapack_int *info ); -void LAPACK_csytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zsytrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_chetrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_float* b, lapack_int* ldb, - lapack_int *info ); -void LAPACK_zhetrs_aa_2stage( char* uplo, lapack_int* n, lapack_int* nrhs, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* tb, lapack_int* ltb, - lapack_int* ipiv, lapack_int* ipiv2, - lapack_complex_double* b, lapack_int* ldb, - lapack_int *info ); /* APIs for set/get nancheck flags */ void LAPACKE_set_nancheck( int flag ); diff --git a/lapack-netlib/LAPACKE/src/CMakeLists.txt b/lapack-netlib/LAPACKE/src/CMakeLists.txt index 26e52acfa..4c13dce0b 100644 --- a/lapack-netlib/LAPACKE/src/CMakeLists.txt +++ b/lapack-netlib/LAPACKE/src/CMakeLists.txt @@ -1,4 +1,4 @@ -set(SOURCES +set(SOURCES_COMPLEX lapacke_cbbcsd.c lapacke_cbbcsd_work.c lapacke_cbdsqr.c @@ -78,11 +78,11 @@ lapacke_cgeqrf_work.c lapacke_cgeqrfp.c lapacke_cgeqrfp_work.c lapacke_cgeqrt.c +lapacke_cgeqrt_work.c lapacke_cgeqrt2.c lapacke_cgeqrt2_work.c lapacke_cgeqrt3.c lapacke_cgeqrt3_work.c -lapacke_cgeqrt_work.c lapacke_cgerfs.c lapacke_cgerfs_work.c lapacke_cgerqf.c @@ -93,6 +93,8 @@ lapacke_cgesv.c lapacke_cgesv_work.c lapacke_cgesvd.c lapacke_cgesvd_work.c +lapacke_cgesvdq.c +lapacke_cgesvdq_work.c lapacke_cgesvdx.c lapacke_cgesvdx_work.c lapacke_cgesvj.c @@ -129,10 +131,10 @@ lapacke_cggevx.c lapacke_cggevx_work.c lapacke_cggglm.c lapacke_cggglm_work.c -lapacke_cgghrd.c -lapacke_cgghrd_work.c lapacke_cgghd3.c lapacke_cgghd3_work.c +lapacke_cgghrd.c +lapacke_cgghrd_work.c lapacke_cgglse.c lapacke_cgglse_work.c lapacke_cggqrf.c @@ -157,14 +159,14 @@ lapacke_cgttrs.c lapacke_cgttrs_work.c lapacke_chbev.c lapacke_chbev_work.c -lapacke_chbevd.c -lapacke_chbevd_work.c -lapacke_chbevx.c -lapacke_chbevx_work.c lapacke_chbev_2stage.c lapacke_chbev_2stage_work.c +lapacke_chbevd.c +lapacke_chbevd_work.c lapacke_chbevd_2stage.c lapacke_chbevd_2stage_work.c +lapacke_chbevx.c +lapacke_chbevx_work.c lapacke_chbevx_2stage.c lapacke_chbevx_2stage_work.c lapacke_chbgst.c @@ -185,18 +187,18 @@ lapacke_cheequb.c lapacke_cheequb_work.c lapacke_cheev.c lapacke_cheev_work.c -lapacke_cheevd.c -lapacke_cheevd_work.c -lapacke_cheevr.c -lapacke_cheevr_work.c -lapacke_cheevx.c -lapacke_cheevx_work.c lapacke_cheev_2stage.c lapacke_cheev_2stage_work.c +lapacke_cheevd.c +lapacke_cheevd_work.c lapacke_cheevd_2stage.c lapacke_cheevd_2stage_work.c +lapacke_cheevr.c +lapacke_cheevr_work.c lapacke_cheevr_2stage.c lapacke_cheevr_2stage_work.c +lapacke_cheevx.c +lapacke_cheevx_work.c lapacke_cheevx_2stage.c lapacke_cheevx_2stage_work.c lapacke_chegst.c @@ -214,8 +216,8 @@ lapacke_cherfs_work.c lapacke_chesv.c lapacke_chesv_work.c lapacke_chesv_aa.c -lapacke_chesv_aa_2stage.c lapacke_chesv_aa_work.c +lapacke_chesv_aa_2stage.c lapacke_chesv_aa_2stage_work.c lapacke_chesv_rk.c lapacke_chesv_rk_work.c @@ -226,35 +228,35 @@ lapacke_cheswapr_work.c lapacke_chetrd.c lapacke_chetrd_work.c lapacke_chetrf.c -lapacke_chetrf_rook.c lapacke_chetrf_work.c -lapacke_chetrf_rook_work.c lapacke_chetrf_aa.c -lapacke_chetrf_aa_2stage.c lapacke_chetrf_aa_work.c +lapacke_chetrf_aa_2stage.c lapacke_chetrf_aa_2stage_work.c lapacke_chetrf_rk.c lapacke_chetrf_rk_work.c +lapacke_chetrf_rook.c +lapacke_chetrf_rook_work.c lapacke_chetri.c +lapacke_chetri_work.c lapacke_chetri2.c lapacke_chetri2_work.c -lapacke_chetri_3.c -lapacke_chetri_3_work.c lapacke_chetri2x.c lapacke_chetri2x_work.c -lapacke_chetri_work.c +lapacke_chetri_3.c +lapacke_chetri_3_work.c lapacke_chetrs.c -lapacke_chetrs_rook.c +lapacke_chetrs_work.c lapacke_chetrs2.c lapacke_chetrs2_work.c -lapacke_chetrs_work.c -lapacke_chetrs_rook_work.c +lapacke_chetrs_3.c +lapacke_chetrs_3_work.c lapacke_chetrs_aa.c -lapacke_chetrs_aa_2stage.c lapacke_chetrs_aa_work.c +lapacke_chetrs_aa_2stage.c lapacke_chetrs_aa_2stage_work.c -lapacke_chetrs_3.c -lapacke_chetrs_3_work.c +lapacke_chetrs_rook.c +lapacke_chetrs_rook_work.c lapacke_chfrk.c lapacke_chfrk_work.c lapacke_chgeqz.c @@ -445,52 +447,54 @@ lapacke_csyconv.c lapacke_csyconv_work.c lapacke_csyequb.c lapacke_csyequb_work.c +lapacke_csyr.c +lapacke_csyr_work.c lapacke_csyrfs.c lapacke_csyrfs_work.c lapacke_csysv.c -lapacke_csysv_rook.c -lapacke_csysv_rook_work.c lapacke_csysv_work.c lapacke_csysv_aa.c -lapacke_csysv_aa_2stage.c lapacke_csysv_aa_work.c +lapacke_csysv_aa_2stage.c lapacke_csysv_aa_2stage_work.c lapacke_csysv_rk.c lapacke_csysv_rk_work.c +lapacke_csysv_rook.c +lapacke_csysv_rook_work.c lapacke_csysvx.c lapacke_csysvx_work.c lapacke_csyswapr.c lapacke_csyswapr_work.c lapacke_csytrf.c lapacke_csytrf_work.c -lapacke_csytrf_rook.c -lapacke_csytrf_rook_work.c lapacke_csytrf_aa.c -lapacke_csytrf_aa_2stage.c lapacke_csytrf_aa_work.c +lapacke_csytrf_aa_2stage.c lapacke_csytrf_aa_2stage_work.c lapacke_csytrf_rk.c lapacke_csytrf_rk_work.c +lapacke_csytrf_rook.c +lapacke_csytrf_rook_work.c lapacke_csytri.c +lapacke_csytri_work.c lapacke_csytri2.c lapacke_csytri2_work.c -lapacke_csytri_3.c -lapacke_csytri_3_work.c lapacke_csytri2x.c lapacke_csytri2x_work.c -lapacke_csytri_work.c +lapacke_csytri_3.c +lapacke_csytri_3_work.c lapacke_csytrs.c -lapacke_csytrs_rook.c +lapacke_csytrs_work.c lapacke_csytrs2.c lapacke_csytrs2_work.c -lapacke_csytrs_work.c -lapacke_csytrs_rook_work.c +lapacke_csytrs_3.c +lapacke_csytrs_3_work.c lapacke_csytrs_aa.c -lapacke_csytrs_aa_2stage.c lapacke_csytrs_aa_work.c +lapacke_csytrs_aa_2stage.c lapacke_csytrs_aa_2stage_work.c -lapacke_csytrs_3.c -lapacke_csytrs_3_work.c +lapacke_csytrs_rook.c +lapacke_csytrs_rook_work.c lapacke_ctbcon.c lapacke_ctbcon_work.c lapacke_ctbrfs.c @@ -522,9 +526,9 @@ lapacke_ctpcon_work.c lapacke_ctpmqrt.c lapacke_ctpmqrt_work.c lapacke_ctpqrt.c +lapacke_ctpqrt_work.c lapacke_ctpqrt2.c lapacke_ctpqrt2_work.c -lapacke_ctpqrt_work.c lapacke_ctprfb.c lapacke_ctprfb_work.c lapacke_ctprfs.c @@ -601,14 +605,16 @@ lapacke_cupgtr.c lapacke_cupgtr_work.c lapacke_cupmtr.c lapacke_cupmtr_work.c +) +set(SOURCES_DOUBLE lapacke_dbbcsd.c lapacke_dbbcsd_work.c lapacke_dbdsdc.c lapacke_dbdsdc_work.c -lapacke_dbdsvdx.c -lapacke_dbdsvdx_work.c lapacke_dbdsqr.c lapacke_dbdsqr_work.c +lapacke_dbdsvdx.c +lapacke_dbdsvdx_work.c lapacke_ddisna.c lapacke_ddisna_work.c lapacke_dgbbrd.c @@ -686,11 +692,11 @@ lapacke_dgeqrf_work.c lapacke_dgeqrfp.c lapacke_dgeqrfp_work.c lapacke_dgeqrt.c +lapacke_dgeqrt_work.c lapacke_dgeqrt2.c lapacke_dgeqrt2_work.c lapacke_dgeqrt3.c lapacke_dgeqrt3_work.c -lapacke_dgeqrt_work.c lapacke_dgerfs.c lapacke_dgerfs_work.c lapacke_dgerqf.c @@ -701,6 +707,8 @@ lapacke_dgesv.c lapacke_dgesv_work.c lapacke_dgesvd.c lapacke_dgesvd_work.c +lapacke_dgesvdq.c +lapacke_dgesvdq_work.c lapacke_dgesvdx.c lapacke_dgesvdx_work.c lapacke_dgesvj.c @@ -737,10 +745,10 @@ lapacke_dggevx.c lapacke_dggevx_work.c lapacke_dggglm.c lapacke_dggglm_work.c -lapacke_dgghrd.c -lapacke_dgghrd_work.c lapacke_dgghd3.c lapacke_dgghd3_work.c +lapacke_dgghrd.c +lapacke_dgghrd_work.c lapacke_dgglse.c lapacke_dgglse_work.c lapacke_dggqrf.c @@ -823,10 +831,10 @@ lapacke_dopmtr.c lapacke_dopmtr_work.c lapacke_dorbdb.c lapacke_dorbdb_work.c -lapacke_dorcsd2by1.c -lapacke_dorcsd2by1_work.c lapacke_dorcsd.c lapacke_dorcsd_work.c +lapacke_dorcsd2by1.c +lapacke_dorcsd2by1_work.c lapacke_dorgbr.c lapacke_dorgbr_work.c lapacke_dorghr.c @@ -933,14 +941,14 @@ lapacke_dpttrs.c lapacke_dpttrs_work.c lapacke_dsbev.c lapacke_dsbev_work.c -lapacke_dsbevd.c -lapacke_dsbevd_work.c -lapacke_dsbevx.c -lapacke_dsbevx_work.c lapacke_dsbev_2stage.c lapacke_dsbev_2stage_work.c +lapacke_dsbevd.c +lapacke_dsbevd_work.c lapacke_dsbevd_2stage.c lapacke_dsbevd_2stage_work.c +lapacke_dsbevx.c +lapacke_dsbevx_work.c lapacke_dsbevx_2stage.c lapacke_dsbevx_2stage_work.c lapacke_dsbgst.c @@ -1021,18 +1029,18 @@ lapacke_dsyequb.c lapacke_dsyequb_work.c lapacke_dsyev.c lapacke_dsyev_work.c -lapacke_dsyevd.c -lapacke_dsyevd_work.c -lapacke_dsyevr.c -lapacke_dsyevr_work.c -lapacke_dsyevx.c -lapacke_dsyevx_work.c lapacke_dsyev_2stage.c lapacke_dsyev_2stage_work.c +lapacke_dsyevd.c +lapacke_dsyevd_work.c lapacke_dsyevd_2stage.c lapacke_dsyevd_2stage_work.c +lapacke_dsyevr.c +lapacke_dsyevr_work.c lapacke_dsyevr_2stage.c lapacke_dsyevr_2stage_work.c +lapacke_dsyevx.c +lapacke_dsyevx_work.c lapacke_dsyevx_2stage.c lapacke_dsyevx_2stage_work.c lapacke_dsygst.c @@ -1048,15 +1056,15 @@ lapacke_dsygvx_work.c lapacke_dsyrfs.c lapacke_dsyrfs_work.c lapacke_dsysv.c -lapacke_dsysv_rook.c -lapacke_dsysv_rook_work.c lapacke_dsysv_work.c lapacke_dsysv_aa.c -lapacke_dsysv_aa_2stage.c lapacke_dsysv_aa_work.c +lapacke_dsysv_aa_2stage.c lapacke_dsysv_aa_2stage_work.c lapacke_dsysv_rk.c lapacke_dsysv_rk_work.c +lapacke_dsysv_rook.c +lapacke_dsysv_rook_work.c lapacke_dsysvx.c lapacke_dsysvx_work.c lapacke_dsyswapr.c @@ -1065,33 +1073,33 @@ lapacke_dsytrd.c lapacke_dsytrd_work.c lapacke_dsytrf.c lapacke_dsytrf_work.c -lapacke_dsytrf_rook.c -lapacke_dsytrf_rook_work.c lapacke_dsytrf_aa.c -lapacke_dsytrf_aa_2stage.c lapacke_dsytrf_aa_work.c +lapacke_dsytrf_aa_2stage.c lapacke_dsytrf_aa_2stage_work.c lapacke_dsytrf_rk.c lapacke_dsytrf_rk_work.c +lapacke_dsytrf_rook.c +lapacke_dsytrf_rook_work.c lapacke_dsytri.c +lapacke_dsytri_work.c lapacke_dsytri2.c lapacke_dsytri2_work.c -lapacke_dsytri_3.c -lapacke_dsytri_3_work.c lapacke_dsytri2x.c lapacke_dsytri2x_work.c -lapacke_dsytri_work.c +lapacke_dsytri_3.c +lapacke_dsytri_3_work.c lapacke_dsytrs.c -lapacke_dsytrs_rook.c +lapacke_dsytrs_work.c lapacke_dsytrs2.c lapacke_dsytrs2_work.c +lapacke_dsytrs_3.c +lapacke_dsytrs_3_work.c lapacke_dsytrs_aa.c -lapacke_dsytrs_aa_2stage.c lapacke_dsytrs_aa_work.c +lapacke_dsytrs_aa_2stage.c lapacke_dsytrs_aa_2stage_work.c -lapacke_dsytrs_3.c -lapacke_dsytrs_3_work.c -lapacke_dsytrs_work.c +lapacke_dsytrs_rook.c lapacke_dsytrs_rook_work.c lapacke_dtbcon.c lapacke_dtbcon_work.c @@ -1124,9 +1132,9 @@ lapacke_dtpcon_work.c lapacke_dtpmqrt.c lapacke_dtpmqrt_work.c lapacke_dtpqrt.c +lapacke_dtpqrt_work.c lapacke_dtpqrt2.c lapacke_dtpqrt2_work.c -lapacke_dtpqrt_work.c lapacke_dtprfb.c lapacke_dtprfb_work.c lapacke_dtprfs.c @@ -1163,15 +1171,21 @@ lapacke_dtrttp.c lapacke_dtrttp_work.c lapacke_dtzrzf.c lapacke_dtzrzf_work.c +) + +set(SOURCES lapacke_nancheck.c +lapacke_ilaver.c +) +set(SOURCES_SINGLE lapacke_sbbcsd.c lapacke_sbbcsd_work.c lapacke_sbdsdc.c lapacke_sbdsdc_work.c -lapacke_sbdsvdx.c -lapacke_sbdsvdx_work.c lapacke_sbdsqr.c lapacke_sbdsqr_work.c +lapacke_sbdsvdx.c +lapacke_sbdsvdx_work.c lapacke_sdisna.c lapacke_sdisna_work.c lapacke_sgbbrd.c @@ -1249,11 +1263,11 @@ lapacke_sgeqrf_work.c lapacke_sgeqrfp.c lapacke_sgeqrfp_work.c lapacke_sgeqrt.c +lapacke_sgeqrt_work.c lapacke_sgeqrt2.c lapacke_sgeqrt2_work.c lapacke_sgeqrt3.c lapacke_sgeqrt3_work.c -lapacke_sgeqrt_work.c lapacke_sgerfs.c lapacke_sgerfs_work.c lapacke_sgerqf.c @@ -1264,6 +1278,8 @@ lapacke_sgesv.c lapacke_sgesv_work.c lapacke_sgesvd.c lapacke_sgesvd_work.c +lapacke_sgesvdq.c +lapacke_sgesvdq_work.c lapacke_sgesvdx.c lapacke_sgesvdx_work.c lapacke_sgesvj.c @@ -1300,10 +1316,10 @@ lapacke_sggevx.c lapacke_sggevx_work.c lapacke_sggglm.c lapacke_sggglm_work.c -lapacke_sgghrd.c -lapacke_sgghrd_work.c lapacke_sgghd3.c lapacke_sgghd3_work.c +lapacke_sgghrd.c +lapacke_sgghrd_work.c lapacke_sgglse.c lapacke_sgglse_work.c lapacke_sggqrf.c @@ -1496,14 +1512,14 @@ lapacke_spttrs.c lapacke_spttrs_work.c lapacke_ssbev.c lapacke_ssbev_work.c -lapacke_ssbevd.c -lapacke_ssbevd_work.c -lapacke_ssbevx.c -lapacke_ssbevx_work.c lapacke_ssbev_2stage.c lapacke_ssbev_2stage_work.c +lapacke_ssbevd.c +lapacke_ssbevd_work.c lapacke_ssbevd_2stage.c lapacke_ssbevd_2stage_work.c +lapacke_ssbevx.c +lapacke_ssbevx_work.c lapacke_ssbevx_2stage.c lapacke_ssbevx_2stage_work.c lapacke_ssbgst.c @@ -1580,18 +1596,18 @@ lapacke_ssyequb.c lapacke_ssyequb_work.c lapacke_ssyev.c lapacke_ssyev_work.c -lapacke_ssyevd.c -lapacke_ssyevd_work.c -lapacke_ssyevr.c -lapacke_ssyevr_work.c -lapacke_ssyevx.c -lapacke_ssyevx_work.c lapacke_ssyev_2stage.c lapacke_ssyev_2stage_work.c +lapacke_ssyevd.c +lapacke_ssyevd_work.c lapacke_ssyevd_2stage.c lapacke_ssyevd_2stage_work.c +lapacke_ssyevr.c +lapacke_ssyevr_work.c lapacke_ssyevr_2stage.c lapacke_ssyevr_2stage_work.c +lapacke_ssyevx.c +lapacke_ssyevx_work.c lapacke_ssyevx_2stage.c lapacke_ssyevx_2stage_work.c lapacke_ssygst.c @@ -1607,8 +1623,6 @@ lapacke_ssygvx_work.c lapacke_ssyrfs.c lapacke_ssyrfs_work.c lapacke_ssysv.c -lapacke_ssysv_rook.c -lapacke_ssysv_rook_work.c lapacke_ssysv_work.c lapacke_ssysv_aa.c lapacke_ssysv_aa_work.c @@ -1616,6 +1630,8 @@ lapacke_ssysv_aa_2stage.c lapacke_ssysv_aa_2stage_work.c lapacke_ssysv_rk.c lapacke_ssysv_rk_work.c +lapacke_ssysv_rook.c +lapacke_ssysv_rook_work.c lapacke_ssysvx.c lapacke_ssysvx_work.c lapacke_ssyswapr.c @@ -1624,33 +1640,33 @@ lapacke_ssytrd.c lapacke_ssytrd_work.c lapacke_ssytrf.c lapacke_ssytrf_work.c -lapacke_ssytrf_rook.c -lapacke_ssytrf_rook_work.c lapacke_ssytrf_aa.c -lapacke_ssytrf_aa_2stage.c lapacke_ssytrf_aa_work.c +lapacke_ssytrf_aa_2stage.c lapacke_ssytrf_aa_2stage_work.c lapacke_ssytrf_rk.c lapacke_ssytrf_rk_work.c +lapacke_ssytrf_rook.c +lapacke_ssytrf_rook_work.c lapacke_ssytri.c +lapacke_ssytri_work.c lapacke_ssytri2.c lapacke_ssytri2_work.c -lapacke_ssytri_3.c -lapacke_ssytri_3_work.c lapacke_ssytri2x.c lapacke_ssytri2x_work.c -lapacke_ssytri_work.c +lapacke_ssytri_3.c +lapacke_ssytri_3_work.c lapacke_ssytrs.c -lapacke_ssytrs_rook.c +lapacke_ssytrs_work.c lapacke_ssytrs2.c lapacke_ssytrs2_work.c +lapacke_ssytrs_3.c +lapacke_ssytrs_3_work.c lapacke_ssytrs_aa.c -lapacke_ssytrs_aa_2stage.c lapacke_ssytrs_aa_work.c +lapacke_ssytrs_aa_2stage.c lapacke_ssytrs_aa_2stage_work.c -lapacke_ssytrs_3.c -lapacke_ssytrs_3_work.c -lapacke_ssytrs_work.c +lapacke_ssytrs_rook.c lapacke_ssytrs_rook_work.c lapacke_stbcon.c lapacke_stbcon_work.c @@ -1722,6 +1738,8 @@ lapacke_strttp.c lapacke_strttp_work.c lapacke_stzrzf.c lapacke_stzrzf_work.c +) +set(SOURCES_COMPLEX16 lapacke_zbbcsd.c lapacke_zbbcsd_work.c lapacke_zbdsqr.c @@ -1805,11 +1823,11 @@ lapacke_zgeqrf_work.c lapacke_zgeqrfp.c lapacke_zgeqrfp_work.c lapacke_zgeqrt.c +lapacke_zgeqrt_work.c lapacke_zgeqrt2.c lapacke_zgeqrt2_work.c lapacke_zgeqrt3.c lapacke_zgeqrt3_work.c -lapacke_zgeqrt_work.c lapacke_zgerfs.c lapacke_zgerfs_work.c lapacke_zgerqf.c @@ -1820,6 +1838,8 @@ lapacke_zgesv.c lapacke_zgesv_work.c lapacke_zgesvd.c lapacke_zgesvd_work.c +lapacke_zgesvdq.c +lapacke_zgesvdq_work.c lapacke_zgesvdx.c lapacke_zgesvdx_work.c lapacke_zgesvj.c @@ -1856,10 +1876,10 @@ lapacke_zggevx.c lapacke_zggevx_work.c lapacke_zggglm.c lapacke_zggglm_work.c -lapacke_zgghrd.c -lapacke_zgghrd_work.c lapacke_zgghd3.c lapacke_zgghd3_work.c +lapacke_zgghrd.c +lapacke_zgghrd_work.c lapacke_zgglse.c lapacke_zgglse_work.c lapacke_zggqrf.c @@ -1884,14 +1904,14 @@ lapacke_zgttrs.c lapacke_zgttrs_work.c lapacke_zhbev.c lapacke_zhbev_work.c -lapacke_zhbevd.c -lapacke_zhbevd_work.c -lapacke_zhbevx.c -lapacke_zhbevx_work.c lapacke_zhbev_2stage.c lapacke_zhbev_2stage_work.c +lapacke_zhbevd.c +lapacke_zhbevd_work.c lapacke_zhbevd_2stage.c lapacke_zhbevd_2stage_work.c +lapacke_zhbevx.c +lapacke_zhbevx_work.c lapacke_zhbevx_2stage.c lapacke_zhbevx_2stage_work.c lapacke_zhbgst.c @@ -1912,18 +1932,18 @@ lapacke_zheequb.c lapacke_zheequb_work.c lapacke_zheev.c lapacke_zheev_work.c -lapacke_zheevd.c -lapacke_zheevd_work.c -lapacke_zheevr.c -lapacke_zheevr_work.c -lapacke_zheevx.c -lapacke_zheevx_work.c lapacke_zheev_2stage.c lapacke_zheev_2stage_work.c +lapacke_zheevd.c +lapacke_zheevd_work.c lapacke_zheevd_2stage.c lapacke_zheevd_2stage_work.c +lapacke_zheevr.c +lapacke_zheevr_work.c lapacke_zheevr_2stage.c lapacke_zheevr_2stage_work.c +lapacke_zheevx.c +lapacke_zheevx_work.c lapacke_zheevx_2stage.c lapacke_zheevx_2stage_work.c lapacke_zhegst.c @@ -1941,8 +1961,8 @@ lapacke_zherfs_work.c lapacke_zhesv.c lapacke_zhesv_work.c lapacke_zhesv_aa.c -lapacke_zhesv_aa_2stage.c lapacke_zhesv_aa_work.c +lapacke_zhesv_aa_2stage.c lapacke_zhesv_aa_2stage_work.c lapacke_zhesv_rk.c lapacke_zhesv_rk_work.c @@ -1953,34 +1973,34 @@ lapacke_zheswapr_work.c lapacke_zhetrd.c lapacke_zhetrd_work.c lapacke_zhetrf.c -lapacke_zhetrf_rook.c lapacke_zhetrf_work.c -lapacke_zhetrf_rook_work.c lapacke_zhetrf_aa.c -lapacke_zhetrf_aa_2stage.c lapacke_zhetrf_aa_work.c +lapacke_zhetrf_aa_2stage.c lapacke_zhetrf_aa_2stage_work.c lapacke_zhetrf_rk.c lapacke_zhetrf_rk_work.c +lapacke_zhetrf_rook.c +lapacke_zhetrf_rook_work.c lapacke_zhetri.c +lapacke_zhetri_work.c lapacke_zhetri2.c lapacke_zhetri2_work.c -lapacke_zhetri_3.c -lapacke_zhetri_3_work.c lapacke_zhetri2x.c lapacke_zhetri2x_work.c -lapacke_zhetri_work.c +lapacke_zhetri_3.c +lapacke_zhetri_3_work.c lapacke_zhetrs.c -lapacke_zhetrs_rook.c +lapacke_zhetrs_work.c lapacke_zhetrs2.c lapacke_zhetrs2_work.c -lapacke_zhetrs_work.c +lapacke_zhetrs_3.c +lapacke_zhetrs_3_work.c lapacke_zhetrs_aa.c -lapacke_zhetrs_aa_2stage.c lapacke_zhetrs_aa_work.c +lapacke_zhetrs_aa_2stage.c lapacke_zhetrs_aa_2stage_work.c -lapacke_zhetrs_3.c -lapacke_zhetrs_3_work.c +lapacke_zhetrs_rook.c lapacke_zhetrs_rook_work.c lapacke_zhfrk.c lapacke_zhfrk_work.c @@ -2172,52 +2192,54 @@ lapacke_zsyconv.c lapacke_zsyconv_work.c lapacke_zsyequb.c lapacke_zsyequb_work.c +lapacke_zsyr.c +lapacke_zsyr_work.c lapacke_zsyrfs.c lapacke_zsyrfs_work.c lapacke_zsysv.c -lapacke_zsysv_rook.c -lapacke_zsysv_rook_work.c lapacke_zsysv_work.c lapacke_zsysv_aa.c -lapacke_zsysv_aa_2stage.c lapacke_zsysv_aa_work.c +lapacke_zsysv_aa_2stage.c lapacke_zsysv_aa_2stage_work.c lapacke_zsysv_rk.c lapacke_zsysv_rk_work.c +lapacke_zsysv_rook.c +lapacke_zsysv_rook_work.c lapacke_zsysvx.c lapacke_zsysvx_work.c lapacke_zsyswapr.c lapacke_zsyswapr_work.c lapacke_zsytrf.c lapacke_zsytrf_work.c -lapacke_zsytrf_rook.c -lapacke_zsytrf_rook_work.c lapacke_zsytrf_aa.c -lapacke_zsytrf_aa_2stage.c lapacke_zsytrf_aa_work.c +lapacke_zsytrf_aa_2stage.c lapacke_zsytrf_aa_2stage_work.c lapacke_zsytrf_rk.c lapacke_zsytrf_rk_work.c +lapacke_zsytrf_rook.c +lapacke_zsytrf_rook_work.c lapacke_zsytri.c +lapacke_zsytri_work.c lapacke_zsytri2.c lapacke_zsytri2_work.c -lapacke_zsytri_3.c -lapacke_zsytri_3_work.c lapacke_zsytri2x.c lapacke_zsytri2x_work.c -lapacke_zsytri_work.c +lapacke_zsytri_3.c +lapacke_zsytri_3_work.c lapacke_zsytrs.c -lapacke_zsytrs_rook.c +lapacke_zsytrs_work.c lapacke_zsytrs2.c lapacke_zsytrs2_work.c -lapacke_zsytrs_work.c -lapacke_zsytrs_rook_work.c +lapacke_zsytrs_3.c +lapacke_zsytrs_3_work.c lapacke_zsytrs_aa.c -lapacke_zsytrs_aa_2stage.c lapacke_zsytrs_aa_work.c +lapacke_zsytrs_aa_2stage.c lapacke_zsytrs_aa_2stage_work.c -lapacke_zsytrs_3.c -lapacke_zsytrs_3_work.c +lapacke_zsytrs_rook.c +lapacke_zsytrs_rook_work.c lapacke_ztbcon.c lapacke_ztbcon_work.c lapacke_ztbrfs.c @@ -2249,9 +2271,9 @@ lapacke_ztpcon_work.c lapacke_ztpmqrt.c lapacke_ztpmqrt_work.c lapacke_ztpqrt.c +lapacke_ztpqrt_work.c lapacke_ztpqrt2.c lapacke_ztpqrt2_work.c -lapacke_ztpqrt_work.c lapacke_ztprfb.c lapacke_ztprfb_work.c lapacke_ztprfs.c @@ -2328,11 +2350,6 @@ lapacke_zupgtr.c lapacke_zupgtr_work.c lapacke_zupmtr.c lapacke_zupmtr_work.c -lapacke_zsyr.c -lapacke_csyr.c -lapacke_zsyr_work.c -lapacke_csyr_work.c -lapacke_ilaver.c ) set(DEPRECATED diff --git a/lapack-netlib/LAPACKE/src/Makefile b/lapack-netlib/LAPACKE/src/Makefile index 7672f9f73..8060151ae 100644 --- a/lapack-netlib/LAPACKE/src/Makefile +++ b/lapack-netlib/LAPACKE/src/Makefile @@ -32,12 +32,21 @@ ############################################################################## # makefile for LAPACKE, used to build lapacke binary. # -# Note: we use multiple OBJ_A, OBJ_B, etc, instead of a single OBJ +# Note: we use multiple OBJ_S, OBJ_C, etc, instead of a single OBJ # to allow build with mingw (argument list too long for the msys ar) # -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc -OBJ_A = \ +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< + +OBJ = \ +lapacke_ilaver.o \ +lapacke_nancheck.o + +OBJ_C = \ lapacke_cbbcsd.o \ lapacke_cbbcsd_work.o \ lapacke_cbdsqr.o \ @@ -82,12 +91,12 @@ lapacke_cgeevx.o \ lapacke_cgeevx_work.o \ lapacke_cgehrd.o \ lapacke_cgehrd_work.o \ +lapacke_cgejsv.o \ +lapacke_cgejsv_work.o \ lapacke_cgelq.o \ lapacke_cgelq_work.o \ lapacke_cgelq2.o \ lapacke_cgelq2_work.o \ -lapacke_cgejsv.o \ -lapacke_cgejsv_work.o \ lapacke_cgelqf.o \ lapacke_cgelqf_work.o \ lapacke_cgels.o \ @@ -117,11 +126,11 @@ lapacke_cgeqrf_work.o \ lapacke_cgeqrfp.o \ lapacke_cgeqrfp_work.o \ lapacke_cgeqrt.o \ +lapacke_cgeqrt_work.o \ lapacke_cgeqrt2.o \ lapacke_cgeqrt2_work.o \ lapacke_cgeqrt3.o \ lapacke_cgeqrt3_work.o \ -lapacke_cgeqrt_work.o \ lapacke_cgerfs.o \ lapacke_cgerfs_work.o \ lapacke_cgerqf.o \ @@ -132,6 +141,8 @@ lapacke_cgesv.o \ lapacke_cgesv_work.o \ lapacke_cgesvd.o \ lapacke_cgesvd_work.o \ +lapacke_cgesvdq.o \ +lapacke_cgesvdq_work.o \ lapacke_cgesvdx.o \ lapacke_cgesvdx_work.o \ lapacke_cgesvj.o \ @@ -168,10 +179,10 @@ lapacke_cggevx.o \ lapacke_cggevx_work.o \ lapacke_cggglm.o \ lapacke_cggglm_work.o \ -lapacke_cgghrd.o \ -lapacke_cgghrd_work.o \ lapacke_cgghd3.o \ lapacke_cgghd3_work.o \ +lapacke_cgghrd.o \ +lapacke_cgghrd_work.o \ lapacke_cgglse.o \ lapacke_cgglse_work.o \ lapacke_cggqrf.o \ @@ -196,14 +207,14 @@ lapacke_cgttrs.o \ lapacke_cgttrs_work.o \ lapacke_chbev.o \ lapacke_chbev_work.o \ -lapacke_chbevd.o \ -lapacke_chbevd_work.o \ -lapacke_chbevx.o \ -lapacke_chbevx_work.o \ lapacke_chbev_2stage.o \ lapacke_chbev_2stage_work.o \ +lapacke_chbevd.o \ +lapacke_chbevd_work.o \ lapacke_chbevd_2stage.o \ lapacke_chbevd_2stage_work.o \ +lapacke_chbevx.o \ +lapacke_chbevx_work.o \ lapacke_chbevx_2stage.o \ lapacke_chbevx_2stage_work.o \ lapacke_chbgst.o \ @@ -224,18 +235,18 @@ lapacke_cheequb.o \ lapacke_cheequb_work.o \ lapacke_cheev.o \ lapacke_cheev_work.o \ -lapacke_cheevd.o \ -lapacke_cheevd_work.o \ -lapacke_cheevr.o \ -lapacke_cheevr_work.o \ -lapacke_cheevx.o \ -lapacke_cheevx_work.o \ lapacke_cheev_2stage.o \ lapacke_cheev_2stage_work.o \ +lapacke_cheevd.o \ +lapacke_cheevd_work.o \ lapacke_cheevd_2stage.o \ lapacke_cheevd_2stage_work.o \ +lapacke_cheevr.o \ +lapacke_cheevr_work.o \ lapacke_cheevr_2stage.o \ lapacke_cheevr_2stage_work.o \ +lapacke_cheevx.o \ +lapacke_cheevx_work.o \ lapacke_cheevx_2stage.o \ lapacke_cheevx_2stage_work.o \ lapacke_chegst.o \ @@ -265,35 +276,35 @@ lapacke_cheswapr_work.o \ lapacke_chetrd.o \ lapacke_chetrd_work.o \ lapacke_chetrf.o \ -lapacke_chetrf_rook.o \ lapacke_chetrf_work.o \ -lapacke_chetrf_rook_work.o \ lapacke_chetrf_aa.o \ -lapacke_chetrf_aa_2stage.o \ lapacke_chetrf_aa_work.o \ +lapacke_chetrf_aa_2stage.o \ lapacke_chetrf_aa_2stage_work.o \ lapacke_chetrf_rk.o \ lapacke_chetrf_rk_work.o \ +lapacke_chetrf_rook.o \ +lapacke_chetrf_rook_work.o \ lapacke_chetri.o \ +lapacke_chetri_work.o \ lapacke_chetri2.o \ lapacke_chetri2_work.o \ -lapacke_chetri_3.o \ -lapacke_chetri_3_work.o \ lapacke_chetri2x.o \ lapacke_chetri2x_work.o \ -lapacke_chetri_work.o \ +lapacke_chetri_3.o \ +lapacke_chetri_3_work.o \ lapacke_chetrs.o \ -lapacke_chetrs_rook.o \ +lapacke_chetrs_work.o \ lapacke_chetrs2.o \ lapacke_chetrs2_work.o \ -lapacke_chetrs_work.o \ -lapacke_chetrs_rook_work.o \ +lapacke_chetrs_3.o \ +lapacke_chetrs_3_work.o \ lapacke_chetrs_aa.o \ -lapacke_chetrs_aa_2stage.o \ lapacke_chetrs_aa_work.o \ +lapacke_chetrs_aa_2stage.o \ lapacke_chetrs_aa_2stage_work.o \ -lapacke_chetrs_3.o \ -lapacke_chetrs_3_work.o \ +lapacke_chetrs_rook.o \ +lapacke_chetrs_rook_work.o \ lapacke_chfrk.o \ lapacke_chfrk_work.o \ lapacke_chgeqz.o \ @@ -484,11 +495,11 @@ lapacke_csyconv.o \ lapacke_csyconv_work.o \ lapacke_csyequb.o \ lapacke_csyequb_work.o \ +lapacke_csyr.o \ +lapacke_csyr_work.o \ lapacke_csyrfs.o \ lapacke_csyrfs_work.o \ lapacke_csysv.o \ -lapacke_csysv_rook.o \ -lapacke_csysv_rook_work.o \ lapacke_csysv_work.o \ lapacke_csysv_aa.o \ lapacke_csysv_aa_work.o \ @@ -496,40 +507,42 @@ lapacke_csysv_aa_2stage.o \ lapacke_csysv_aa_2stage_work.o \ lapacke_csysv_rk.o \ lapacke_csysv_rk_work.o \ +lapacke_csysv_rook.o \ +lapacke_csysv_rook_work.o \ lapacke_csysvx.o \ lapacke_csysvx_work.o \ lapacke_csyswapr.o \ lapacke_csyswapr_work.o \ lapacke_csytrf.o \ lapacke_csytrf_work.o \ -lapacke_csytrf_rook.o \ -lapacke_csytrf_rook_work.o \ lapacke_csytrf_aa.o \ -lapacke_csytrf_aa_2stage.o \ lapacke_csytrf_aa_work.o \ +lapacke_csytrf_aa_2stage.o \ lapacke_csytrf_aa_2stage_work.o \ lapacke_csytrf_rk.o \ lapacke_csytrf_rk_work.o \ +lapacke_csytrf_rook.o \ +lapacke_csytrf_rook_work.o \ lapacke_csytri.o \ +lapacke_csytri_work.o \ lapacke_csytri2.o \ lapacke_csytri2_work.o \ -lapacke_csytri_3.o \ -lapacke_csytri_3_work.o \ lapacke_csytri2x.o \ lapacke_csytri2x_work.o \ -lapacke_csytri_work.o \ +lapacke_csytri_3.o \ +lapacke_csytri_3_work.o \ lapacke_csytrs.o \ -lapacke_csytrs_rook.o \ +lapacke_csytrs_work.o \ lapacke_csytrs2.o \ lapacke_csytrs2_work.o \ -lapacke_csytrs_work.o \ -lapacke_csytrs_rook_work.o \ +lapacke_csytrs_3.o \ +lapacke_csytrs_3_work.o \ lapacke_csytrs_aa.o \ -lapacke_csytrs_aa_2stage.o \ lapacke_csytrs_aa_work.o \ +lapacke_csytrs_aa_2stage.o \ lapacke_csytrs_aa_2stage_work.o \ -lapacke_csytrs_3.o \ -lapacke_csytrs_3_work.o \ +lapacke_csytrs_rook.o \ +lapacke_csytrs_rook_work.o \ lapacke_ctbcon.o \ lapacke_ctbcon_work.o \ lapacke_ctbrfs.o \ @@ -561,9 +574,9 @@ lapacke_ctpcon_work.o \ lapacke_ctpmqrt.o \ lapacke_ctpmqrt_work.o \ lapacke_ctpqrt.o \ +lapacke_ctpqrt_work.o \ lapacke_ctpqrt2.o \ lapacke_ctpqrt2_work.o \ -lapacke_ctpqrt_work.o \ lapacke_ctprfb.o \ lapacke_ctprfb_work.o \ lapacke_ctprfs.o \ @@ -639,15 +652,17 @@ lapacke_cunmtr_work.o \ lapacke_cupgtr.o \ lapacke_cupgtr_work.o \ lapacke_cupmtr.o \ -lapacke_cupmtr_work.o \ +lapacke_cupmtr_work.o + +OBJ_D = \ lapacke_dbbcsd.o \ lapacke_dbbcsd_work.o \ lapacke_dbdsdc.o \ lapacke_dbdsdc_work.o \ -lapacke_dbdsvdx.o \ -lapacke_dbdsvdx_work.o \ lapacke_dbdsqr.o \ lapacke_dbdsqr_work.o \ +lapacke_dbdsvdx.o \ +lapacke_dbdsvdx_work.o \ lapacke_ddisna.o \ lapacke_ddisna_work.o \ lapacke_dgbbrd.o \ @@ -725,11 +740,11 @@ lapacke_dgeqrf_work.o \ lapacke_dgeqrfp.o \ lapacke_dgeqrfp_work.o \ lapacke_dgeqrt.o \ +lapacke_dgeqrt_work.o \ lapacke_dgeqrt2.o \ lapacke_dgeqrt2_work.o \ lapacke_dgeqrt3.o \ lapacke_dgeqrt3_work.o \ -lapacke_dgeqrt_work.o \ lapacke_dgerfs.o \ lapacke_dgerfs_work.o \ lapacke_dgerqf.o \ @@ -740,6 +755,8 @@ lapacke_dgesv.o \ lapacke_dgesv_work.o \ lapacke_dgesvd.o \ lapacke_dgesvd_work.o \ +lapacke_dgesvdq.o \ +lapacke_dgesvdq_work.o \ lapacke_dgesvdx.o \ lapacke_dgesvdx_work.o \ lapacke_dgesvj.o \ @@ -776,10 +793,10 @@ lapacke_dggevx.o \ lapacke_dggevx_work.o \ lapacke_dggglm.o \ lapacke_dggglm_work.o \ -lapacke_dgghrd.o \ -lapacke_dgghrd_work.o \ lapacke_dgghd3.o \ lapacke_dgghd3_work.o \ +lapacke_dgghrd.o \ +lapacke_dgghrd_work.o \ lapacke_dgglse.o \ lapacke_dgglse_work.o \ lapacke_dggqrf.o \ @@ -972,14 +989,14 @@ lapacke_dpttrs.o \ lapacke_dpttrs_work.o \ lapacke_dsbev.o \ lapacke_dsbev_work.o \ -lapacke_dsbevd.o \ -lapacke_dsbevd_work.o \ -lapacke_dsbevx.o \ -lapacke_dsbevx_work.o \ lapacke_dsbev_2stage.o \ lapacke_dsbev_2stage_work.o \ +lapacke_dsbevd.o \ +lapacke_dsbevd_work.o \ lapacke_dsbevd_2stage.o \ lapacke_dsbevd_2stage_work.o \ +lapacke_dsbevx.o \ +lapacke_dsbevx_work.o \ lapacke_dsbevx_2stage.o \ lapacke_dsbevx_2stage_work.o \ lapacke_dsbgst.o \ @@ -1060,18 +1077,18 @@ lapacke_dsyequb.o \ lapacke_dsyequb_work.o \ lapacke_dsyev.o \ lapacke_dsyev_work.o \ -lapacke_dsyevd.o \ -lapacke_dsyevd_work.o \ -lapacke_dsyevr.o \ -lapacke_dsyevr_work.o \ -lapacke_dsyevx.o \ -lapacke_dsyevx_work.o \ lapacke_dsyev_2stage.o \ lapacke_dsyev_2stage_work.o \ +lapacke_dsyevd.o \ +lapacke_dsyevd_work.o \ lapacke_dsyevd_2stage.o \ lapacke_dsyevd_2stage_work.o \ +lapacke_dsyevr.o \ +lapacke_dsyevr_work.o \ lapacke_dsyevr_2stage.o \ lapacke_dsyevr_2stage_work.o \ +lapacke_dsyevx.o \ +lapacke_dsyevx_work.o \ lapacke_dsyevx_2stage.o \ lapacke_dsyevx_2stage_work.o \ lapacke_dsygst.o \ @@ -1087,8 +1104,6 @@ lapacke_dsygvx_work.o \ lapacke_dsyrfs.o \ lapacke_dsyrfs_work.o \ lapacke_dsysv.o \ -lapacke_dsysv_rook.o \ -lapacke_dsysv_rook_work.o \ lapacke_dsysv_work.o \ lapacke_dsysv_aa.o \ lapacke_dsysv_aa_work.o \ @@ -1096,6 +1111,8 @@ lapacke_dsysv_aa_2stage.o \ lapacke_dsysv_aa_2stage_work.o \ lapacke_dsysv_rk.o \ lapacke_dsysv_rk_work.o \ +lapacke_dsysv_rook.o \ +lapacke_dsysv_rook_work.o \ lapacke_dsysvx.o \ lapacke_dsysvx_work.o \ lapacke_dsyswapr.o \ @@ -1104,36 +1121,34 @@ lapacke_dsytrd.o \ lapacke_dsytrd_work.o \ lapacke_dsytrf.o \ lapacke_dsytrf_work.o \ -lapacke_dsytrf_rook.o \ -lapacke_dsytrf_rook_work.o \ lapacke_dsytrf_aa.o \ lapacke_dsytrf_aa_work.o \ lapacke_dsytrf_aa_2stage.o \ lapacke_dsytrf_aa_2stage_work.o \ lapacke_dsytrf_rk.o \ lapacke_dsytrf_rk_work.o \ +lapacke_dsytrf_rook.o \ +lapacke_dsytrf_rook_work.o \ lapacke_dsytri.o \ +lapacke_dsytri_work.o \ lapacke_dsytri2.o \ lapacke_dsytri2_work.o \ -lapacke_dsytri_3.o \ -lapacke_dsytri_3_work.o \ lapacke_dsytri2x.o \ lapacke_dsytri2x_work.o \ -lapacke_dsytri_work.o - -OBJ_B = \ +lapacke_dsytri_3.o \ +lapacke_dsytri_3_work.o \ lapacke_dsytrs.o \ -lapacke_dsytrs_rook.o \ +lapacke_dsytrs_work.o \ lapacke_dsytrs2.o \ lapacke_dsytrs2_work.o \ -lapacke_dsytrs_work.o \ -lapacke_dsytrs_rook_work.o \ +lapacke_dsytrs_3.o \ +lapacke_dsytrs_3_work.o \ lapacke_dsytrs_aa.o \ -lapacke_dsytrs_aa_2stage.o \ lapacke_dsytrs_aa_work.o \ +lapacke_dsytrs_aa_2stage.o \ lapacke_dsytrs_aa_2stage_work.o \ -lapacke_dsytrs_3.o \ -lapacke_dsytrs_3_work.o \ +lapacke_dsytrs_rook.o \ +lapacke_dsytrs_rook_work.o \ lapacke_dtbcon.o \ lapacke_dtbcon_work.o \ lapacke_dtbrfs.o \ @@ -1165,9 +1180,9 @@ lapacke_dtpcon_work.o \ lapacke_dtpmqrt.o \ lapacke_dtpmqrt_work.o \ lapacke_dtpqrt.o \ +lapacke_dtpqrt_work.o \ lapacke_dtpqrt2.o \ lapacke_dtpqrt2_work.o \ -lapacke_dtpqrt_work.o \ lapacke_dtprfb.o \ lapacke_dtprfb_work.o \ lapacke_dtprfs.o \ @@ -1203,16 +1218,17 @@ lapacke_dtrttf_work.o \ lapacke_dtrttp.o \ lapacke_dtrttp_work.o \ lapacke_dtzrzf.o \ -lapacke_dtzrzf_work.o \ -lapacke_nancheck.o \ +lapacke_dtzrzf_work.o + +OBJ_S = \ lapacke_sbbcsd.o \ lapacke_sbbcsd_work.o \ lapacke_sbdsdc.o \ lapacke_sbdsdc_work.o \ -lapacke_sbdsvdx.o \ -lapacke_sbdsvdx_work.o \ lapacke_sbdsqr.o \ lapacke_sbdsqr_work.o \ +lapacke_sbdsvdx.o \ +lapacke_sbdsvdx_work.o \ lapacke_sdisna.o \ lapacke_sdisna_work.o \ lapacke_sgbbrd.o \ @@ -1290,11 +1306,11 @@ lapacke_sgeqrf_work.o \ lapacke_sgeqrfp.o \ lapacke_sgeqrfp_work.o \ lapacke_sgeqrt.o \ +lapacke_sgeqrt_work.o \ lapacke_sgeqrt2.o \ lapacke_sgeqrt2_work.o \ lapacke_sgeqrt3.o \ lapacke_sgeqrt3_work.o \ -lapacke_sgeqrt_work.o \ lapacke_sgerfs.o \ lapacke_sgerfs_work.o \ lapacke_sgerqf.o \ @@ -1305,6 +1321,8 @@ lapacke_sgesv.o \ lapacke_sgesv_work.o \ lapacke_sgesvd.o \ lapacke_sgesvd_work.o \ +lapacke_sgesvdq.o \ +lapacke_sgesvdq_work.o \ lapacke_sgesvdx.o \ lapacke_sgesvdx_work.o \ lapacke_sgesvj.o \ @@ -1341,10 +1359,10 @@ lapacke_sggevx.o \ lapacke_sggevx_work.o \ lapacke_sggglm.o \ lapacke_sggglm_work.o \ -lapacke_sgghrd.o \ -lapacke_sgghrd_work.o \ lapacke_sgghd3.o \ lapacke_sgghd3_work.o \ +lapacke_sgghrd.o \ +lapacke_sgghrd_work.o \ lapacke_sgglse.o \ lapacke_sgglse_work.o \ lapacke_sggqrf.o \ @@ -1537,14 +1555,14 @@ lapacke_spttrs.o \ lapacke_spttrs_work.o \ lapacke_ssbev.o \ lapacke_ssbev_work.o \ -lapacke_ssbevd.o \ -lapacke_ssbevd_work.o \ -lapacke_ssbevx.o \ -lapacke_ssbevx_work.o \ lapacke_ssbev_2stage.o \ lapacke_ssbev_2stage_work.o \ +lapacke_ssbevd.o \ +lapacke_ssbevd_work.o \ lapacke_ssbevd_2stage.o \ lapacke_ssbevd_2stage_work.o \ +lapacke_ssbevx.o \ +lapacke_ssbevx_work.o \ lapacke_ssbevx_2stage.o \ lapacke_ssbevx_2stage_work.o \ lapacke_ssbgst.o \ @@ -1621,18 +1639,18 @@ lapacke_ssyequb.o \ lapacke_ssyequb_work.o \ lapacke_ssyev.o \ lapacke_ssyev_work.o \ -lapacke_ssyevd.o \ -lapacke_ssyevd_work.o \ -lapacke_ssyevr.o \ -lapacke_ssyevr_work.o \ -lapacke_ssyevx.o \ -lapacke_ssyevx_work.o \ lapacke_ssyev_2stage.o \ lapacke_ssyev_2stage_work.o \ +lapacke_ssyevd.o \ +lapacke_ssyevd_work.o \ lapacke_ssyevd_2stage.o \ lapacke_ssyevd_2stage_work.o \ +lapacke_ssyevr.o \ +lapacke_ssyevr_work.o \ lapacke_ssyevr_2stage.o \ lapacke_ssyevr_2stage_work.o \ +lapacke_ssyevx.o \ +lapacke_ssyevx_work.o \ lapacke_ssyevx_2stage.o \ lapacke_ssyevx_2stage_work.o \ lapacke_ssygst.o \ @@ -1648,8 +1666,6 @@ lapacke_ssygvx_work.o \ lapacke_ssyrfs.o \ lapacke_ssyrfs_work.o \ lapacke_ssysv.o \ -lapacke_ssysv_rook.o \ -lapacke_ssysv_rook_work.o \ lapacke_ssysv_work.o \ lapacke_ssysv_aa.o \ lapacke_ssysv_aa_work.o \ @@ -1657,6 +1673,8 @@ lapacke_ssysv_aa_2stage.o \ lapacke_ssysv_aa_2stage_work.o \ lapacke_ssysv_rk.o \ lapacke_ssysv_rk_work.o \ +lapacke_ssysv_rook.o \ +lapacke_ssysv_rook_work.o \ lapacke_ssysvx.o \ lapacke_ssysvx_work.o \ lapacke_ssyswapr.o \ @@ -1665,34 +1683,34 @@ lapacke_ssytrd.o \ lapacke_ssytrd_work.o \ lapacke_ssytrf.o \ lapacke_ssytrf_work.o \ -lapacke_ssytrf_rook.o \ -lapacke_ssytrf_rook_work.o \ lapacke_ssytrf_aa.o \ lapacke_ssytrf_aa_work.o \ lapacke_ssytrf_aa_2stage.o \ lapacke_ssytrf_aa_2stage_work.o \ lapacke_ssytrf_rk.o \ lapacke_ssytrf_rk_work.o \ +lapacke_ssytrf_rook.o \ +lapacke_ssytrf_rook_work.o \ lapacke_ssytri.o \ +lapacke_ssytri_work.o \ lapacke_ssytri2.o \ lapacke_ssytri2_work.o \ -lapacke_ssytri_3.o \ -lapacke_ssytri_3_work.o \ lapacke_ssytri2x.o \ lapacke_ssytri2x_work.o \ -lapacke_ssytri_work.o \ +lapacke_ssytri_3.o \ +lapacke_ssytri_3_work.o \ lapacke_ssytrs.o \ -lapacke_ssytrs_rook.o \ +lapacke_ssytrs_work.o \ lapacke_ssytrs2.o \ lapacke_ssytrs2_work.o \ -lapacke_ssytrs_work.o \ -lapacke_ssytrs_rook_work.o \ +lapacke_ssytrs_3.o \ +lapacke_ssytrs_3_work.o \ lapacke_ssytrs_aa.o \ -lapacke_ssytrs_aa_2stage.o \ lapacke_ssytrs_aa_work.o \ +lapacke_ssytrs_aa_2stage.o \ lapacke_ssytrs_aa_2stage_work.o \ -lapacke_ssytrs_3.o \ -lapacke_ssytrs_3_work.o \ +lapacke_ssytrs_rook.o \ +lapacke_ssytrs_rook_work.o \ lapacke_stbcon.o \ lapacke_stbcon_work.o \ lapacke_stbrfs.o \ @@ -1762,7 +1780,9 @@ lapacke_strttf_work.o \ lapacke_strttp.o \ lapacke_strttp_work.o \ lapacke_stzrzf.o \ -lapacke_stzrzf_work.o \ +lapacke_stzrzf_work.o + +OBJ_Z = \ lapacke_zbbcsd.o \ lapacke_zbbcsd_work.o \ lapacke_zbdsqr.o \ @@ -1846,11 +1866,11 @@ lapacke_zgeqrf_work.o \ lapacke_zgeqrfp.o \ lapacke_zgeqrfp_work.o \ lapacke_zgeqrt.o \ +lapacke_zgeqrt_work.o \ lapacke_zgeqrt2.o \ lapacke_zgeqrt2_work.o \ lapacke_zgeqrt3.o \ lapacke_zgeqrt3_work.o \ -lapacke_zgeqrt_work.o \ lapacke_zgerfs.o \ lapacke_zgerfs_work.o \ lapacke_zgerqf.o \ @@ -1861,6 +1881,8 @@ lapacke_zgesv.o \ lapacke_zgesv_work.o \ lapacke_zgesvd.o \ lapacke_zgesvd_work.o \ +lapacke_zgesvdq.o \ +lapacke_zgesvdq_work.o \ lapacke_zgesvdx.o \ lapacke_zgesvdx_work.o \ lapacke_zgesvj.o \ @@ -1897,10 +1919,10 @@ lapacke_zggevx.o \ lapacke_zggevx_work.o \ lapacke_zggglm.o \ lapacke_zggglm_work.o \ -lapacke_zgghrd.o \ -lapacke_zgghrd_work.o \ lapacke_zgghd3.o \ lapacke_zgghd3_work.o \ +lapacke_zgghrd.o \ +lapacke_zgghrd_work.o \ lapacke_zgglse.o \ lapacke_zgglse_work.o \ lapacke_zggqrf.o \ @@ -1925,14 +1947,14 @@ lapacke_zgttrs.o \ lapacke_zgttrs_work.o \ lapacke_zhbev.o \ lapacke_zhbev_work.o \ -lapacke_zhbevd.o \ -lapacke_zhbevd_work.o \ -lapacke_zhbevx.o \ -lapacke_zhbevx_work.o \ lapacke_zhbev_2stage.o \ lapacke_zhbev_2stage_work.o \ +lapacke_zhbevd.o \ +lapacke_zhbevd_work.o \ lapacke_zhbevd_2stage.o \ lapacke_zhbevd_2stage_work.o \ +lapacke_zhbevx.o \ +lapacke_zhbevx_work.o \ lapacke_zhbevx_2stage.o \ lapacke_zhbevx_2stage_work.o \ lapacke_zhbgst.o \ @@ -1953,18 +1975,18 @@ lapacke_zheequb.o \ lapacke_zheequb_work.o \ lapacke_zheev.o \ lapacke_zheev_work.o \ -lapacke_zheevd.o \ -lapacke_zheevd_work.o \ -lapacke_zheevr.o \ -lapacke_zheevr_work.o \ -lapacke_zheevx.o \ -lapacke_zheevx_work.o \ lapacke_zheev_2stage.o \ lapacke_zheev_2stage_work.o \ +lapacke_zheevd.o \ +lapacke_zheevd_work.o \ lapacke_zheevd_2stage.o \ lapacke_zheevd_2stage_work.o \ +lapacke_zheevr.o \ +lapacke_zheevr_work.o \ lapacke_zheevr_2stage.o \ lapacke_zheevr_2stage_work.o \ +lapacke_zheevx.o \ +lapacke_zheevx_work.o \ lapacke_zheevx_2stage.o \ lapacke_zheevx_2stage_work.o \ lapacke_zhegst.o \ @@ -1994,35 +2016,35 @@ lapacke_zheswapr_work.o \ lapacke_zhetrd.o \ lapacke_zhetrd_work.o \ lapacke_zhetrf.o \ -lapacke_zhetrf_rook.o \ lapacke_zhetrf_work.o \ -lapacke_zhetrf_rook_work.o \ lapacke_zhetrf_aa.o \ -lapacke_zhetrf_aa_2stage.o \ lapacke_zhetrf_aa_work.o \ +lapacke_zhetrf_aa_2stage.o \ lapacke_zhetrf_aa_2stage_work.o \ lapacke_zhetrf_rk.o \ lapacke_zhetrf_rk_work.o \ +lapacke_zhetrf_rook.o \ +lapacke_zhetrf_rook_work.o \ lapacke_zhetri.o \ +lapacke_zhetri_work.o \ lapacke_zhetri2.o \ lapacke_zhetri2_work.o \ -lapacke_zhetri_3.o \ -lapacke_zhetri_3_work.o \ lapacke_zhetri2x.o \ lapacke_zhetri2x_work.o \ -lapacke_zhetri_work.o \ +lapacke_zhetri_3.o \ +lapacke_zhetri_3_work.o \ lapacke_zhetrs.o \ -lapacke_zhetrs_rook.o \ +lapacke_zhetrs_work.o \ lapacke_zhetrs2.o \ lapacke_zhetrs2_work.o \ -lapacke_zhetrs_work.o \ -lapacke_zhetrs_rook_work.o \ +lapacke_zhetrs_3.o \ +lapacke_zhetrs_3_work.o \ lapacke_zhetrs_aa.o \ -lapacke_zhetrs_aa_2stage.o \ lapacke_zhetrs_aa_work.o \ +lapacke_zhetrs_aa_2stage.o \ lapacke_zhetrs_aa_2stage_work.o \ -lapacke_zhetrs_3.o \ -lapacke_zhetrs_3_work.o \ +lapacke_zhetrs_rook.o \ +lapacke_zhetrs_rook_work.o \ lapacke_zhfrk.o \ lapacke_zhfrk_work.o \ lapacke_zhgeqz.o \ @@ -2213,11 +2235,11 @@ lapacke_zsyconv.o \ lapacke_zsyconv_work.o \ lapacke_zsyequb.o \ lapacke_zsyequb_work.o \ +lapacke_zsyr.o \ +lapacke_zsyr_work.o \ lapacke_zsyrfs.o \ lapacke_zsyrfs_work.o \ lapacke_zsysv.o \ -lapacke_zsysv_rook.o \ -lapacke_zsysv_rook_work.o \ lapacke_zsysv_work.o \ lapacke_zsysv_aa.o \ lapacke_zsysv_aa_work.o \ @@ -2225,40 +2247,42 @@ lapacke_zsysv_aa_2stage.o \ lapacke_zsysv_aa_2stage_work.o \ lapacke_zsysv_rk.o \ lapacke_zsysv_rk_work.o \ +lapacke_zsysv_rook.o \ +lapacke_zsysv_rook_work.o \ lapacke_zsysvx.o \ lapacke_zsysvx_work.o \ lapacke_zsyswapr.o \ lapacke_zsyswapr_work.o \ lapacke_zsytrf.o \ lapacke_zsytrf_work.o \ -lapacke_zsytrf_rook.o \ -lapacke_zsytrf_rook_work.o \ lapacke_zsytrf_aa.o \ -lapacke_zsytrf_aa_2stage.o \ lapacke_zsytrf_aa_work.o \ +lapacke_zsytrf_aa_2stage.o \ lapacke_zsytrf_aa_2stage_work.o \ lapacke_zsytrf_rk.o \ lapacke_zsytrf_rk_work.o \ +lapacke_zsytrf_rook.o \ +lapacke_zsytrf_rook_work.o \ lapacke_zsytri.o \ +lapacke_zsytri_work.o \ lapacke_zsytri2.o \ lapacke_zsytri2_work.o \ -lapacke_zsytri_3.o \ -lapacke_zsytri_3_work.o \ lapacke_zsytri2x.o \ lapacke_zsytri2x_work.o \ -lapacke_zsytri_work.o \ +lapacke_zsytri_3.o \ +lapacke_zsytri_3_work.o \ lapacke_zsytrs.o \ -lapacke_zsytrs_rook.o \ +lapacke_zsytrs_work.o \ lapacke_zsytrs2.o \ lapacke_zsytrs2_work.o \ -lapacke_zsytrs_work.o \ -lapacke_zsytrs_rook_work.o \ +lapacke_zsytrs_3.o \ +lapacke_zsytrs_3_work.o \ lapacke_zsytrs_aa.o \ -lapacke_zsytrs_aa_2stage.o \ lapacke_zsytrs_aa_work.o \ +lapacke_zsytrs_aa_2stage.o \ lapacke_zsytrs_aa_2stage_work.o \ -lapacke_zsytrs_3.o \ -lapacke_zsytrs_3_work.o \ +lapacke_zsytrs_rook.o \ +lapacke_zsytrs_rook_work.o \ lapacke_ztbcon.o \ lapacke_ztbcon_work.o \ lapacke_ztbrfs.o \ @@ -2290,9 +2314,9 @@ lapacke_ztpcon_work.o \ lapacke_ztpmqrt.o \ lapacke_ztpmqrt_work.o \ lapacke_ztpqrt.o \ +lapacke_ztpqrt_work.o \ lapacke_ztpqrt2.o \ lapacke_ztpqrt2_work.o \ -lapacke_ztpqrt_work.o \ lapacke_ztprfb.o \ lapacke_ztprfb_work.o \ lapacke_ztprfs.o \ @@ -2368,12 +2392,7 @@ lapacke_zunmtr_work.o \ lapacke_zupgtr.o \ lapacke_zupgtr_work.o \ lapacke_zupmtr.o \ -lapacke_zupmtr_work.o \ -lapacke_zsyr.o \ -lapacke_csyr.o \ -lapacke_zsyr_work.o \ -lapacke_csyr_work.o \ -lapacke_ilaver.o +lapacke_zupmtr_work.o ifdef BUILD_DEPRECATED DEPRECATED = \ @@ -2452,27 +2471,29 @@ lapacke_zlagsy.o \ lapacke_zlagsy_work.o endif -all: ../../$(LAPACKELIB) +.PHONY: all +all: $(LAPACKELIB) -.PHONY: ../../$(LAPACKELIB) - -../../$(LAPACKELIB): $(OBJ_A) $(OBJ_B) $(DEPRECATED) $(EXTENDED) $(MATGEN) - $(ARCH) $(ARCHFLAGS) $@ $(OBJ_A) - $(ARCH) $(ARCHFLAGS) $@ $(OBJ_B) +$(LAPACKELIB): $(OBJ) $(OBJ_S) $(OBJ_C) $(OBJ_D) $(OBJ_Z) $(DEPRECATED) $(EXTENDED) $(MATGEN) + $(AR) $(ARFLAGS) $@ $(OBJ) + $(AR) $(ARFLAGS) $@ $(OBJ_S) + $(AR) $(ARFLAGS) $@ $(OBJ_C) + $(AR) $(ARFLAGS) $@ $(OBJ_D) + $(AR) $(ARFLAGS) $@ $(OBJ_Z) ifdef BUILD_DEPRECATED - $(ARCH) $(ARCHFLAGS) $@ $(DEPRECATED) + $(AR) $(ARFLAGS) $@ $(DEPRECATED) endif ifdef (USEXBLAS) - $(ARCH) $(ARCHFLAGS) $@ $(EXTENDED) + $(AR) $(ARFLAGS) $@ $(EXTENDED) endif ifdef LAPACKE_WITH_TMG - $(ARCH) $(ARCHFLAGS) $@ $(MATGEN) + $(AR) $(ARFLAGS) $@ $(MATGEN) endif $(RANLIB) $@ -clean: cleanobj +.PHONY: clean cleanobj cleanlib +clean: cleanobj cleanlib cleanobj: rm -f *.o - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< +cleanlib: + rm -f $(LAPACKELIB) diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c index 7d371f660..41278428b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgejsv.c @@ -124,7 +124,6 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, float* rwork = NULL; lapack_complex_float* cwork = NULL; lapack_int i; - lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cgejsv", -1 ); return -1; @@ -132,8 +131,6 @@ lapack_int LAPACKE_cgejsv( int matrix_layout, char joba, char jobu, char jobv, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; - nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgelsd.c b/lapack-netlib/LAPACKE/src/lapacke_cgelsd.c index 2ee891977..9d022dae6 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cgelsd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cgelsd.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_cgelsd( int matrix_layout, lapack_int m, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c new file mode 100644 index 000000000..91458136c --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq.c @@ -0,0 +1,106 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgesvdq +* Author: Intel Corporation +* Generated November 2018 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgesvdq( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, lapack_int* numrank) +{ + lapack_int info = 0; + lapack_int liwork = -1; + lapack_int* iwork = NULL; + lapack_int iwork_query; + lapack_int lcwork = -1; + lapack_complex_float* cwork = NULL; + lapack_complex_float cwork_query; + lapack_int lrwork = -1; + double* rwork = NULL; + double rwork_query; + lapack_int i; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgesvdq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + &iwork_query, liwork, &cwork_query, lcwork, + &rwork_query, lrwork ); + if( info != 0 ) { + goto exit_level_0; + } + liwork = iwork_query; + lcwork = LAPACK_C2INT(cwork_query); + lrwork = (lapack_int)rwork_query; + /* Allocate memory for work arrays */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + cwork = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lcwork ); + if( cwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + iwork, liwork, cwork, lcwork, rwork, lrwork ); + + /* Release memory and exit */ + LAPACKE_free( iwork ); + LAPACKE_free( cwork ); + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgesvdq", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_cgesvdq_work.c b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq_work.c new file mode 100644 index 000000000..e86f76e4b --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_cgesvdq_work.c @@ -0,0 +1,149 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgesvdq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_float* a, + lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + lapack_complex_float* cwork, lapack_int lcwork, + float* rwork, lapack_int lrwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, + numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || + LAPACKE_lsame( jobu, 's' ) ) ? m : 1; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : + (LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'a' ) ? n : + ( LAPACKE_lsame( jobv, 's' ) ? MIN(m,n) : 1); + lapack_int lda_t = MAX(1,m); + lapack_int ldu_t = MAX(1,nrows_u); + lapack_int ldv_t = MAX(1,nrows_v); + lapack_complex_float* a_t = NULL; + lapack_complex_float* u_t = NULL; + lapack_complex_float* v_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); + return info; + } + if( ldu < ncols_u ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); + return info; + } + if( ldv < n ) { + info = -14; + LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lcwork == -1 ) { + LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + cwork, &lcwork, rwork, &lrwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + u_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + v_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + cwork, &lcwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, + u, ldu ); + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, + ldv ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_free( v_t ); + } +exit_level_2: + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_free( u_t ); + } +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_cggesx.c b/lapack-netlib/LAPACKE/src/lapacke_cggesx.c index fc939a314..9581691c6 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cggesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cggesx.c @@ -91,7 +91,7 @@ lapack_int LAPACKE_cggesx( int matrix_layout, char jobvsl, char jobvsr, if( info != 0 ) { goto exit_level_2; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_chbevd.c b/lapack-netlib/LAPACKE/src/lapacke_chbevd.c index 024cf2585..b4af255a9 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chbevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chbevd.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_chbevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_chbevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_chbevd_2stage.c index 63f7d8ccb..e8e9a6830 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chbevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chbevd_2stage.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_chbevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_chbgvd.c b/lapack-netlib/LAPACKE/src/lapacke_chbgvd.c index d44f6c622..5a7331d87 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chbgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chbgvd.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_chbgvd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheev_work.c b/lapack-netlib/LAPACKE/src/lapacke_cheev_work.c index 40224607c..f505dfab0 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheev_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheev_work.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_cheev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevd.c b/lapack-netlib/LAPACKE/src/lapacke_cheevd.c index d0dea375b..75fa47915 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevd.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_cheevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage.c index d87481abf..cb4d34a09 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapac #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_cge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_cheevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage_work.c b/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage_work.c index cb51f9ee4..e9e6a5d1d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevd_2stage_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_cheevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevd_work.c b/lapack-netlib/LAPACKE/src/lapacke_cheevd_work.c index 81869c564..4c5f352a8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevd_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevd_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,8 @@ lapack_int LAPACKE_cheevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevr.c b/lapack-netlib/LAPACKE/src/lapacke_cheevr.c index 6fe261624..f277e7f70 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevr.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_cheevr( int matrix_layout, char jobz, char range, char uplo, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cheevr_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_cheevr_2stage.c index 5b3f5c77a..a09eac1bd 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cheevr_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cheevr_2stage.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_cheevr_2stage( int matrix_layout, char jobz, char range, char if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_chegst.c b/lapack-netlib/LAPACKE/src/lapacke_chegst.c index c628017c2..ff7dd3532 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chegst.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chegst.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_chegst( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, - lapack_int lda, const lapack_complex_float* b, + lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_chegst_work.c b/lapack-netlib/LAPACKE/src/lapacke_chegst_work.c index 001863819..a29e01961 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chegst_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chegst_work.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_chegst_work( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_float* a, - lapack_int lda, const lapack_complex_float* b, + lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_chegvd.c b/lapack-netlib/LAPACKE/src/lapacke_chegvd.c index 2959cb0dc..98c901982 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chegvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chegvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_chegvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_chpevd.c b/lapack-netlib/LAPACKE/src/lapacke_chpevd.c index 47c7bbe23..fbdb73802 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chpevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chpevd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_chpevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_chpgvd.c b/lapack-netlib/LAPACKE/src/lapacke_chpgvd.c index 568882ec9..587d1509a 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_chpgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_chpgvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_chpgvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_clantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_clantr_work.c index 7f74a9789..8c4c21935 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_clantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_clantr_work.c @@ -43,12 +43,10 @@ float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a, &lda, work ); - if( info < 0 ) { - info = info - 1; - } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_complex_float* a_t = NULL; + float* work_lapack = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; @@ -62,12 +60,23 @@ float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } + /* Allocate memory for work array(s) */ + if( LAPACKE_lsame( norm, 'i' ) ) { + work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) ); + if( work_lapack == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + } /* Transpose input matrices */ LAPACKE_ctr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work ); - info = 0; /* LAPACK call is ok! */ + res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack ); /* Release memory and exit */ + if( work_lapack ) { + LAPACKE_free( work_lapack ); + } +exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_cstedc.c b/lapack-netlib/LAPACKE/src/lapacke_cstedc.c index 5be3cec70..3c0be27d5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cstedc.c @@ -73,7 +73,7 @@ lapack_int LAPACKE_cstedc( int matrix_layout, char compz, lapack_int n, float* d if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_cstegr.c b/lapack-netlib/LAPACKE/src/lapacke_cstegr.c index 986702e62..86a0cd72d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cstegr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cstegr.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_cstegr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_cstemr.c b/lapack-netlib/LAPACKE/src/lapacke_cstemr.c index 9b9b84e49..51e63c675 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cstemr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cstemr.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_cstemr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_csytrs2.c b/lapack-netlib/LAPACKE/src/lapacke_csytrs2.c index f4a0a4334..44405c993 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csytrs2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csytrs2.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_csytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_float* a, + lapack_int nrhs, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_csytrs2_work.c b/lapack-netlib/LAPACKE/src/lapacke_csytrs2_work.c index d914c1d69..8567a07d5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_csytrs2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_csytrs2_work.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_csytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_float* a, + lapack_int nrhs, lapack_complex_float* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* work ) diff --git a/lapack-netlib/LAPACKE/src/lapacke_ctgsen.c b/lapack-netlib/LAPACKE/src/lapacke_ctgsen.c index e2f38c87b..6bfcdc996 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ctgsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ctgsen.c @@ -84,7 +84,7 @@ lapack_int LAPACKE_ctgsen( int matrix_layout, lapack_int ijob, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_C2INT( work_query ); /* Allocate memory for work arrays */ if( ijob != 0 ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c b/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c index 9d2684e4c..fd49d6a7f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ctprfb.c @@ -41,7 +41,7 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { - lapack_int ncols_v, nrows_v; + lapack_int ncols_v, nrows_v, ncols_a, nrows_a; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -52,20 +52,33 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - /* Optionally check input matrices for NaNs */ + /* Optionally check input matrices for NaNs + * V is m-by-k (left, columnwise) + * or n-by-k (right, columnwise) + * or k-by-m (left, rowwise) + * or k-by-n (right, rowwise) + * T is k-by-k + * A is k-by-n (left) + * or m-by-k (right) + * B is m-by-n + */ if( LAPACKE_lsame( storev, 'C' ) ) { ncols_v = k; nrows_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; } else if( LAPACKE_lsame( storev, 'R' ) ) { ncols_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + LAPACKE_lsame( side, 'R' ) ? m : 0; + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + LAPACKE_lsame( side, 'R' ) ? k : 0; + if( LAPACKE_cge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { @@ -80,13 +93,13 @@ lapack_int LAPACKE_ctprfb( int matrix_layout, char side, char trans, char direct } #endif if (side=='l' || side=='L') { - ldwork = k; - work_size = MAX(1,ldwork) * MAX(1,n); - } + ldwork = k; + work_size = MAX(1,ldwork) * MAX(1,n); + } else { - ldwork = m; - work_size = MAX(1,ldwork) * MAX(1,k); - } + ldwork = m; + work_size = MAX(1,ldwork) * MAX(1,k); + } /* Allocate memory for working array(s) */ work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * work_size ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_cunmhr.c b/lapack-netlib/LAPACKE/src/lapacke_cunmhr.c index 592c6de45..127dd8c57 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_cunmhr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_cunmhr.c @@ -58,7 +58,7 @@ lapack_int LAPACKE_cunmhr( int matrix_layout, char side, char trans, if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) { + if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) { return -10; } } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgeesx.c b/lapack-netlib/LAPACKE/src/lapacke_dgeesx.c index 27647954b..193d65737 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgeesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgeesx.c @@ -76,7 +76,7 @@ lapack_int LAPACKE_dgeesx( int matrix_layout, char jobvs, char sort, if( info != 0 ) { goto exit_level_1; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c index 444a07b35..d9709bf89 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgejsv.c @@ -74,7 +74,6 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, lapack_int* iwork = NULL; double* work = NULL; lapack_int i; - lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dgejsv", -1 ); return -1; @@ -82,8 +81,6 @@ lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; - nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgelsd.c b/lapack-netlib/LAPACKE/src/lapacke_dgelsd.c index 6750597bb..790119596 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dgelsd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dgelsd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_dgelsd( int matrix_layout, lapack_int m, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c new file mode 100644 index 000000000..7bf831f8b --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq.c @@ -0,0 +1,106 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgesvdq +* Author: Intel Corporation +* Generated November 2018 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgesvdq( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, double* a, + lapack_int lda, double* s, double* u, lapack_int ldu, + double* v, lapack_int ldv, lapack_int* numrank) +{ + lapack_int info = 0; + lapack_int liwork = -1; + lapack_int* iwork = NULL; + lapack_int iwork_query; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + lapack_int lrwork = -1; + double* rwork = NULL; + double rwork_query; + lapack_int i; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgesvdq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + &iwork_query, liwork, &work_query, lwork, + &rwork_query, lrwork ); + if( info != 0 ) { + goto exit_level_0; + } + liwork = iwork_query; + lwork = (lapack_int)work_query; + lrwork = (lapack_int)rwork_query; + /* Allocate memory for work arrays */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + iwork, liwork, work, lwork, rwork, lrwork ); + + /* Release memory and exit */ + LAPACKE_free( iwork ); + LAPACKE_free( work ); + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgesvdq", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_dgesvdq_work.c b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq_work.c new file mode 100644 index 000000000..0de92a254 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_dgesvdq_work.c @@ -0,0 +1,149 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgesvdq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, double* a, + lapack_int lda, double* s, double* u, lapack_int ldu, + double* v, lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + double* work, lapack_int lwork, + double* rwork, lapack_int lrwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, + numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || + LAPACKE_lsame( jobu, 's' ) ) ? m : 1; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : + (LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'a' ) ? n : + ( LAPACKE_lsame( jobv, 's' ) ? MIN(m,n) : 1); + lapack_int lda_t = MAX(1,m); + lapack_int ldu_t = MAX(1,nrows_u); + lapack_int ldv_t = MAX(1,nrows_v); + double* a_t = NULL; + double* u_t = NULL; + double* v_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); + return info; + } + if( ldu < ncols_u ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); + return info; + } + if( ldv < n ) { + info = -14; + LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + work, &lwork, rwork, &lrwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + u_t = (double*) + LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + v_t = (double*) + LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + work, &lwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, + u, ldu ); + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, + ldv ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_free( v_t ); + } +exit_level_2: + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_free( u_t ); + } +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_dggesx.c b/lapack-netlib/LAPACKE/src/lapacke_dggesx.c index 36addda74..91eb7bf8c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dggesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dggesx.c @@ -82,7 +82,7 @@ lapack_int LAPACKE_dggesx( int matrix_layout, char jobvsl, char jobvsr, if( info != 0 ) { goto exit_level_1; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c index 2d570ce42..5b2a6c535 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dlantr_work.c @@ -42,12 +42,10 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work ); - if( info < 0 ) { - info = info - 1; - } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); double* a_t = NULL; + double* work_lapack = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; @@ -60,12 +58,23 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } + /* Allocate memory for work array(s) */ + if( LAPACKE_lsame( norm, 'i' ) ) { + work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) ); + if( work_lapack == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + } /* Transpose input matrices */ LAPACKE_dtr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work ); - info = 0; /* LAPACK call is ok! */ + res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack ); /* Release memory and exit */ + if( work_lapack ) { + LAPACKE_free( work_lapack ); + } +exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dormhr.c b/lapack-netlib/LAPACKE/src/lapacke_dormhr.c index de4355a74..4b9526f14 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dormhr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dormhr.c @@ -57,7 +57,7 @@ lapack_int LAPACKE_dormhr( int matrix_layout, char side, char trans, if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_d_nancheck( m-1, tau, 1 ) ) { + if( LAPACKE_d_nancheck( r-1, tau, 1 ) ) { return -10; } } diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsbevd.c b/lapack-netlib/LAPACKE/src/lapacke_dsbevd.c index 4ecd1b522..3a9abbbe1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsbevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsbevd.c @@ -62,7 +62,7 @@ lapack_int LAPACKE_dsbevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsbevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_dsbevd_2stage.c index b0ccc0b1e..4d42b6208 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsbevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsbevd_2stage.c @@ -62,7 +62,7 @@ lapack_int LAPACKE_dsbevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsbgvd.c b/lapack-netlib/LAPACKE/src/lapacke_dsbgvd.c index 36f912ee5..cab2a64bb 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsbgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsbgvd.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_dsbgvd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dspevd.c b/lapack-netlib/LAPACKE/src/lapacke_dspevd.c index 3b6b25d5e..c7d93b6b3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dspevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dspevd.c @@ -61,7 +61,7 @@ lapack_int LAPACKE_dspevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dspgvd.c b/lapack-netlib/LAPACKE/src/lapacke_dspgvd.c index 8ca478ed1..b49ce95ec 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dspgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dspgvd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_dspgvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstedc.c b/lapack-netlib/LAPACKE/src/lapacke_dstedc.c index 4f88a04c4..16e308450 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstedc.c @@ -69,7 +69,7 @@ lapack_int LAPACKE_dstedc( int matrix_layout, char compz, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstegr.c b/lapack-netlib/LAPACKE/src/lapacke_dstegr.c index 9191f0a9f..7e4f9d694 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstegr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstegr.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_dstegr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstemr.c b/lapack-netlib/LAPACKE/src/lapacke_dstemr.c index 8dc2bd237..1a3b0ac7b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstemr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstemr.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstevd.c b/lapack-netlib/LAPACKE/src/lapacke_dstevd.c index e824a164b..251a2ae2e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstevd.c @@ -64,7 +64,7 @@ lapack_int LAPACKE_dstevd( int matrix_layout, char jobz, lapack_int n, double* d if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dstevr.c b/lapack-netlib/LAPACKE/src/lapacke_dstevr.c index fd53e0ac0..d49e0ff1c 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dstevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dstevr.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_dstevr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyev_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsyev_work.c index 9dc67f022..5a416ff45 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyev_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyev_work.c @@ -65,14 +65,14 @@ lapack_int LAPACKE_dsyev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevd.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevd.c index 870148b31..d6772ea01 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevd.c @@ -50,7 +50,7 @@ lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -61,7 +61,7 @@ lapack_int LAPACKE_dsyevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage.c index a5507394c..e866451a5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage.c @@ -50,7 +50,7 @@ lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapac #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_dge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -61,7 +61,7 @@ lapack_int LAPACKE_dsyevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage_work.c index 1d06250d1..90d8ce8dc 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_2stage_work.c @@ -68,7 +68,7 @@ lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_dsyevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_work.c index 925912619..fff476445 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevd_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevd_work.c @@ -68,7 +68,7 @@ lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_dsyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_dsyevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevr.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevr.c index bae72f6c3..290ae0bd4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevr.c @@ -78,7 +78,7 @@ lapack_int LAPACKE_dsyevr( int matrix_layout, char jobz, char range, char uplo, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsyevr_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_dsyevr_2stage.c index dad20209e..7ee7dbc0b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsyevr_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsyevr_2stage.c @@ -78,7 +78,7 @@ lapack_int LAPACKE_dsyevr_2stage( int matrix_layout, char jobz, char range, char if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsygvd.c b/lapack-netlib/LAPACKE/src/lapacke_dsygvd.c index 907ad50bd..51f333359 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsygvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsygvd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_dsygvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsytrs2.c b/lapack-netlib/LAPACKE/src/lapacke_dsytrs2.c index 46c90190f..4d73ef3c1 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsytrs2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsytrs2.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_dsytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const double* a, lapack_int lda, + lapack_int nrhs, double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dsytrs2_work.c b/lapack-netlib/LAPACKE/src/lapacke_dsytrs2_work.c index c937c39c5..caffa5b4b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dsytrs2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dsytrs2_work.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_dsytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const double* a, + lapack_int nrhs, double* a, lapack_int lda, const lapack_int* ipiv, double* b, lapack_int ldb, double* work ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtgsen.c b/lapack-netlib/LAPACKE/src/lapacke_dtgsen.c index 2cb7fce4b..baa63abe7 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtgsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtgsen.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_dtgsen( int matrix_layout, lapack_int ijob, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( ijob != 0 ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c b/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c index 5191f79bb..11031b9bb 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtprfb.c @@ -39,7 +39,7 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb ) { - lapack_int ncols_v, nrows_v; + lapack_int ncols_v, nrows_v, ncols_a, nrows_a; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -50,20 +50,33 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - /* Optionally check input matrices for NaNs */ + /* Optionally check input matrices for NaNs + * V is m-by-k (left, columnwise) + * or n-by-k (right, columnwise) + * or k-by-m (left, rowwise) + * or k-by-n (right, rowwise) + * T is k-by-k + * A is k-by-n (left) + * or m-by-k (right) + * B is m-by-n + */ if( LAPACKE_lsame( storev, 'C' ) ) { ncols_v = k; nrows_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; } else if( LAPACKE_lsame( storev, 'R' ) ) { ncols_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + LAPACKE_lsame( side, 'R' ) ? m : 0; + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + LAPACKE_lsame( side, 'R' ) ? k : 0; + if( LAPACKE_dge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { @@ -78,16 +91,16 @@ lapack_int LAPACKE_dtprfb( int matrix_layout, char side, char trans, char direct } #endif if (side=='l' || side=='L') { - ldwork = k; - work_size = MAX(1,ldwork) * MAX(1,n); - } + ldwork = k; + work_size = MAX(1,ldwork) * MAX(1,n); + } else { - ldwork = m; - work_size = MAX(1,ldwork) * MAX(1,k); - } + ldwork = m; + work_size = MAX(1,ldwork) * MAX(1,k); + } /* Allocate memory for working array(s) */ work = (double*) - LAPACKE_malloc( sizeof(double) * work_size ); + LAPACKE_malloc( sizeof(double) * work_size ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtrsen.c b/lapack-netlib/LAPACKE/src/lapacke_dtrsen.c index 521bc2701..67932fd98 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtrsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtrsen.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_dtrsen( int matrix_layout, char job, char compq, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgeesx.c b/lapack-netlib/LAPACKE/src/lapacke_sgeesx.c index 91cfc4fa5..0bc14b33e 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgeesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgeesx.c @@ -76,7 +76,7 @@ lapack_int LAPACKE_sgeesx( int matrix_layout, char jobvs, char sort, if( info != 0 ) { goto exit_level_1; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( LAPACKE_lsame( sense, 'b' ) || LAPACKE_lsame( sense, 'v' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c index aa0eeb746..0703e902f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgejsv.c @@ -74,7 +74,6 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, lapack_int* iwork = NULL; float* work = NULL; lapack_int i; - lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_sgejsv", -1 ); return -1; @@ -82,8 +81,6 @@ lapack_int LAPACKE_sgejsv( int matrix_layout, char joba, char jobu, char jobv, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; - nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgelsd.c b/lapack-netlib/LAPACKE/src/lapacke_sgelsd.c index fc42b1eec..9d00ded10 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sgelsd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sgelsd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_sgelsd( int matrix_layout, lapack_int m, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c new file mode 100644 index 000000000..5ff543d10 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq.c @@ -0,0 +1,106 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgesvdq +* Author: Intel Corporation +* Generated November 2018 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgesvdq( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, float* a, + lapack_int lda, float* s, float* u, lapack_int ldu, + float* v, lapack_int ldv, lapack_int* numrank) +{ + lapack_int info = 0; + lapack_int liwork = -1; + lapack_int* iwork = NULL; + lapack_int iwork_query; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + lapack_int lrwork = -1; + float* rwork = NULL; + float rwork_query; + lapack_int i; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgesvdq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + &iwork_query, liwork, &work_query, lwork, + &rwork_query, lrwork ); + if( info != 0 ) { + goto exit_level_0; + } + liwork = iwork_query; + lwork = (lapack_int)work_query; + lrwork = (lapack_int)rwork_query; + /* Allocate memory for work arrays */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + iwork, liwork, work, lwork, rwork, lrwork ); + + /* Release memory and exit */ + LAPACKE_free( iwork ); + LAPACKE_free( work ); + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgesvdq", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_sgesvdq_work.c b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq_work.c new file mode 100644 index 000000000..9eab982c2 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_sgesvdq_work.c @@ -0,0 +1,148 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgesvdq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, float* a, + lapack_int lda, float* s, float* u, lapack_int ldu, + float* v, lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + float* work, lapack_int lwork, + float* rwork, lapack_int lrwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, + numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || + LAPACKE_lsame( jobu, 's' ) ) ? m : 1; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : + (LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'a' ) ? n : 1; + lapack_int lda_t = MAX(1,m); + lapack_int ldu_t = MAX(1,nrows_u); + lapack_int ldv_t = MAX(1,nrows_v); + float* a_t = NULL; + float* u_t = NULL; + float* v_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); + return info; + } + if( ldu < ncols_u ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); + return info; + } + if( ldv < n ) { + info = -14; + LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + work, &lwork, rwork, &lrwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + u_t = (float*) + LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + v_t = (float*) + LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + work, &lwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, + u, ldu ); + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, + ldv ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_free( v_t ); + } +exit_level_2: + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_free( u_t ); + } +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_sggesx.c b/lapack-netlib/LAPACKE/src/lapacke_sggesx.c index f0acb70a4..d552a2010 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sggesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sggesx.c @@ -82,7 +82,7 @@ lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr, if( info != 0 ) { goto exit_level_1; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c index e9f84b55c..e1d4c270d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_slantr_work.c @@ -42,12 +42,10 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a, &lda, work ); - if( info < 0 ) { - info = info - 1; - } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); float* a_t = NULL; + float* work_lapack = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; @@ -60,12 +58,23 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } + /* Allocate memory for work array(s) */ + if( LAPACKE_lsame( norm, 'i' ) ) { + work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) ); + if( work_lapack == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + } /* Transpose input matrices */ LAPACKE_str_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work ); - info = 0; /* LAPACK call is ok! */ + res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack ); /* Release memory and exit */ + if( work_lapack ) { + LAPACKE_free( work_lapack ); + } +exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_sormhr.c b/lapack-netlib/LAPACKE/src/lapacke_sormhr.c index a5cca2c45..fba215a19 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sormhr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sormhr.c @@ -57,7 +57,7 @@ lapack_int LAPACKE_sormhr( int matrix_layout, char side, char trans, if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_s_nancheck( m-1, tau, 1 ) ) { + if( LAPACKE_s_nancheck( r-1, tau, 1 ) ) { return -10; } } diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssbevd.c b/lapack-netlib/LAPACKE/src/lapacke_ssbevd.c index 3acdeb95d..b41e5b156 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssbevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssbevd.c @@ -62,7 +62,7 @@ lapack_int LAPACKE_ssbevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssbevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_ssbevd_2stage.c index 2eda9cde9..a76d92c71 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssbevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssbevd_2stage.c @@ -62,7 +62,7 @@ lapack_int LAPACKE_ssbevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssbgvd.c b/lapack-netlib/LAPACKE/src/lapacke_ssbgvd.c index a6c036846..b40ccb9e5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssbgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssbgvd.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_ssbgvd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sspevd.c b/lapack-netlib/LAPACKE/src/lapacke_sspevd.c index bd06a8ba6..9b518751b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sspevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sspevd.c @@ -61,7 +61,7 @@ lapack_int LAPACKE_sspevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sspgvd.c b/lapack-netlib/LAPACKE/src/lapacke_sspgvd.c index 749abb0b1..e80e24647 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sspgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sspgvd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_sspgvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstedc.c b/lapack-netlib/LAPACKE/src/lapacke_sstedc.c index 157874668..f902e8c30 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstedc.c @@ -69,7 +69,7 @@ lapack_int LAPACKE_sstedc( int matrix_layout, char compz, lapack_int n, float* d if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstegr.c b/lapack-netlib/LAPACKE/src/lapacke_sstegr.c index c6a73b2b4..c02372ba2 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstegr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstegr.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_sstegr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstemr.c b/lapack-netlib/LAPACKE/src/lapacke_sstemr.c index 4229819ab..65dcc9170 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstemr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstemr.c @@ -74,7 +74,7 @@ lapack_int LAPACKE_sstemr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstevd.c b/lapack-netlib/LAPACKE/src/lapacke_sstevd.c index 9f9e2e79e..c5db5d79d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstevd.c @@ -64,7 +64,7 @@ lapack_int LAPACKE_sstevd( int matrix_layout, char jobz, lapack_int n, float* d, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_sstevr.c b/lapack-netlib/LAPACKE/src/lapacke_sstevr.c index f45c49087..4043e3090 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_sstevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_sstevr.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_sstevr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyev_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssyev_work.c index fb8c8971b..6a2f8fce3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyev_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyev_work.c @@ -65,14 +65,14 @@ lapack_int LAPACKE_ssyev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevd.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevd.c index 1995e7950..f5924bd94 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevd.c @@ -50,7 +50,7 @@ lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -61,7 +61,7 @@ lapack_int LAPACKE_ssyevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage.c index 6d6785acc..40ef1bcc2 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage.c @@ -50,7 +50,7 @@ lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapac #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -61,7 +61,7 @@ lapack_int LAPACKE_ssyevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage_work.c index 5942a9abb..9394f822f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_2stage_work.c @@ -68,7 +68,7 @@ lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_work.c index 7b2e19adc..12d9e84e6 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevd_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevd_work.c @@ -68,7 +68,7 @@ lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); @@ -76,7 +76,7 @@ lapack_int LAPACKE_ssyevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevr.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevr.c index d7e050143..3274f6bab 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevr.c @@ -78,7 +78,7 @@ lapack_int LAPACKE_ssyevr( int matrix_layout, char jobz, char range, char uplo, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssyevr_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_ssyevr_2stage.c index cbc3014e9..8958be31d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssyevr_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssyevr_2stage.c @@ -78,7 +78,7 @@ lapack_int LAPACKE_ssyevr_2stage( int matrix_layout, char jobz, char range, char if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssygvd.c b/lapack-netlib/LAPACKE/src/lapacke_ssygvd.c index 2a1c62aef..5afe8d2de 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssygvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssygvd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_ssygvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssytrs2.c b/lapack-netlib/LAPACKE/src/lapacke_ssytrs2.c index a95a71469..19f447cd8 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssytrs2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssytrs2.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_ssytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const float* a, lapack_int lda, + lapack_int nrhs, float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_ssytrs2_work.c b/lapack-netlib/LAPACKE/src/lapacke_ssytrs2_work.c index cf98f443d..7d348b382 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ssytrs2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ssytrs2_work.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_ssytrs2_work( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const float* a, + lapack_int nrhs, float* a, lapack_int lda, const lapack_int* ipiv, float* b, lapack_int ldb, float* work ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_stgsen.c b/lapack-netlib/LAPACKE/src/lapacke_stgsen.c index 5464fd22b..d0250eb63 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stgsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stgsen.c @@ -81,7 +81,7 @@ lapack_int LAPACKE_stgsen( int matrix_layout, lapack_int ijob, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( ijob != 0 ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_stprfb.c b/lapack-netlib/LAPACKE/src/lapacke_stprfb.c index 846d4ccb3..2ea20f08d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stprfb.c @@ -39,7 +39,7 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, float* b, lapack_int ldb) { - lapack_int ncols_v, nrows_v; + lapack_int ncols_v, nrows_v, ncols_a, nrows_a; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -50,20 +50,33 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - /* Optionally check input matrices for NaNs */ + /* Optionally check input matrices for NaNs + * V is m-by-k (left, columnwise) + * or n-by-k (right, columnwise) + * or k-by-m (left, rowwise) + * or k-by-n (right, rowwise) + * T is k-by-k + * A is k-by-n (left) + * or m-by-k (right) + * B is m-by-n + */ if( LAPACKE_lsame( storev, 'C' ) ) { ncols_v = k; nrows_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; } else if( LAPACKE_lsame( storev, 'R' ) ) { ncols_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + LAPACKE_lsame( side, 'R' ) ? m : 0; + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + LAPACKE_lsame( side, 'R' ) ? k : 0; + if( LAPACKE_sge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { @@ -78,14 +91,14 @@ lapack_int LAPACKE_stprfb( int matrix_layout, char side, char trans, char direct } #endif if (side=='l' || side=='L') { - ldwork = k; - work_size = MAX(1,ldwork) * MAX(1,n); - } + ldwork = k; + work_size = MAX(1,ldwork) * MAX(1,n); + } else { - ldwork = m; - work_size = MAX(1,ldwork) * MAX(1,k); - } - /* Allocate memory for working array(s) */ + ldwork = m; + work_size = MAX(1,ldwork) * MAX(1,k); + } + /* Allocate memory for working array(s) */ work = (float*) LAPACKE_malloc( sizeof(float) * work_size ); if( work == NULL ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_strsen.c b/lapack-netlib/LAPACKE/src/lapacke_strsen.c index efba91af8..0ec3ee907 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_strsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_strsen.c @@ -69,7 +69,7 @@ lapack_int LAPACKE_strsen( int matrix_layout, char job, char compq, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'v' ) ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c index f3b5110a7..153efb371 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c @@ -124,7 +124,6 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, double* rwork = NULL; lapack_complex_double* cwork = NULL; lapack_int i; - lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zgejsv", -1 ); return -1; @@ -132,8 +131,6 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; - nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c b/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c index 6d111c69f..eca145090 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c new file mode 100644 index 000000000..f58a5c4e9 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c @@ -0,0 +1,106 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgesvdq +* Author: Intel Corporation +* Generated November 2018 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgesvdq( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, lapack_int* numrank) +{ + lapack_int info = 0; + lapack_int liwork = -1; + lapack_int* iwork = NULL; + lapack_int iwork_query; + lapack_int lcwork = -1; + lapack_complex_double* cwork = NULL; + lapack_complex_double cwork_query; + lapack_int lrwork = -1; + double* rwork = NULL; + double rwork_query; + lapack_int i; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgesvdq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + &iwork_query, liwork, &cwork_query, lcwork, + &rwork_query, lrwork ); + if( info != 0 ) { + goto exit_level_0; + } + liwork = iwork_query; + lcwork = LAPACK_C2INT(cwork_query); + lrwork = (lapack_int)rwork_query; + /* Allocate memory for work arrays */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + cwork = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lcwork ); + if( cwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + iwork, liwork, cwork, lcwork, rwork, lrwork ); + + /* Release memory and exit */ + LAPACKE_free( iwork ); + LAPACKE_free( cwork ); + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgesvdq", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c new file mode 100644 index 000000000..5824de4e0 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c @@ -0,0 +1,149 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgesvdq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgesvdq_work( int matrix_layout, char joba, char jobp, + char jobr, char jobu, char jobv, + lapack_int m, lapack_int n, lapack_complex_double* a, + lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, lapack_int* numrank, + lapack_int* iwork, lapack_int liwork, + lapack_complex_double* cwork, lapack_int lcwork, + double* rwork, lapack_int lrwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, + numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || + LAPACKE_lsame( jobu, 's' ) ) ? m : 1; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : + (LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'a' ) ? n : + ( LAPACKE_lsame( jobv, 's' ) ? MIN(m,n) : 1); + lapack_int lda_t = MAX(1,m); + lapack_int ldu_t = MAX(1,nrows_u); + lapack_int ldv_t = MAX(1,nrows_v); + lapack_complex_double* a_t = NULL; + lapack_complex_double* u_t = NULL; + lapack_complex_double* v_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); + return info; + } + if( ldu < ncols_u ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); + return info; + } + if( ldv < n ) { + info = -14; + LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lcwork == -1 ) { + LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + cwork, &lcwork, rwork, &lrwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + u_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + v_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, + s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, + cwork, &lcwork, rwork, &lrwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, + u, ldu ); + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, + ldv ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + LAPACKE_free( v_t ); + } +exit_level_2: + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + LAPACKE_free( u_t ); + } +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_zggesx.c b/lapack-netlib/LAPACKE/src/lapacke_zggesx.c index 6b4d27045..53e086753 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zggesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zggesx.c @@ -91,7 +91,7 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, if( info != 0 ) { goto exit_level_2; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c b/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c index 95c6d3a54..ac9467496 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c index eca867b28..9b6005b2d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c index 91bfc0a73..76c3bac3a 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c index 32b4a76f0..ce278b272 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd.c index 4b1afb95c..1305ebfb3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c index 9016da54c..63f139435 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c index d4b648ee1..bf2e2c828 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c index 9672e6a22..f09cfe49d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevr.c b/lapack-netlib/LAPACKE/src/lapacke_zheevr.c index 52e7a5bee..0d26dc2f9 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevr.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c index faf949aef..6fa69c44b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegst.c b/lapack-netlib/LAPACKE/src/lapacke_zhegst.c index aa2d84d84..8c4a5c374 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegst.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegst.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zhegst( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c b/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c index f77894204..62fce1f27 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c index 81c3d29b4..1242a0eda 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c b/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c index 948bb9c10..a470ca3bb 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c index be18d3313..91fa26443 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c index 0d8bcf550..e62f8a4e3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c @@ -43,12 +43,10 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work ); - if( info < 0 ) { - info = info - 1; - } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_complex_double* a_t = NULL; + double* work_lapack = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; @@ -62,12 +60,23 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } + /* Allocate memory for work array(s) */ + if( LAPACKE_lsame( norm, 'i' ) ) { + work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) ); + if( work_lapack == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + } /* Transpose input matrices */ LAPACKE_ztr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work ); - info = 0; /* LAPACK call is ok! */ + res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack ); /* Release memory and exit */ + if( work_lapack ) { + LAPACKE_free( work_lapack ); + } +exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c index 1bd7274c1..665c4414f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c @@ -74,7 +74,7 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstegr.c b/lapack-netlib/LAPACKE/src/lapacke_zstegr.c index 2a65dcc4d..07b5ce81d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstegr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstegr.c @@ -82,7 +82,7 @@ lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstemr.c b/lapack-netlib/LAPACKE/src/lapacke_zstemr.c index c1144488e..d1d1d5692 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstemr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstemr.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c index 3c85f9796..7442702aa 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_double* a, + lapack_int nrhs, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c index cdc97fa02..ec05ce6d5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, - const lapack_complex_double* a, lapack_int lda, + lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* work ) diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c b/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c index 60f48ba8f..f6f58becd 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c @@ -84,7 +84,7 @@ lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ if( ijob != 0 ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c index fce801762..7a791c0d4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c @@ -41,7 +41,7 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb) { - lapack_int ncols_v, nrows_v; + lapack_int ncols_v, nrows_v, ncols_a, nrows_a; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -52,20 +52,33 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - /* Optionally check input matrices for NaNs */ + /* Optionally check input matrices for NaNs + * V is m-by-k (left, columnwise) + * or n-by-k (right, columnwise) + * or k-by-m (left, rowwise) + * or k-by-n (right, rowwise) + * T is k-by-k + * A is k-by-n (left) + * or m-by-k (right) + * B is m-by-n + */ if( LAPACKE_lsame( storev, 'C' ) ) { ncols_v = k; nrows_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; } else if( LAPACKE_lsame( storev, 'R' ) ) { ncols_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + LAPACKE_lsame( side, 'R' ) ? m : 0; + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + LAPACKE_lsame( side, 'R' ) ? k : 0; + if( LAPACKE_zge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { @@ -80,17 +93,16 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct } #endif if (side=='l' || side=='L') { - ldwork = k; - work_size = MAX(1,ldwork) * MAX(1,n); - } + ldwork = k; + work_size = MAX(1,ldwork) * MAX(1,n); + } else { - ldwork = m; - work_size = MAX(1,ldwork) * MAX(1,k); - } - + ldwork = m; + work_size = MAX(1,ldwork) * MAX(1,k); + } /* Allocate memory for working array(s) */ work = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * work_size ); + LAPACKE_malloc( sizeof(lapack_complex_double) * work_size ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c b/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c index 357d71184..61ed6f6f2 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c @@ -58,7 +58,7 @@ lapack_int LAPACKE_zunmhr( int matrix_layout, char side, char trans, if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) { + if( LAPACKE_z_nancheck( r-1, tau, 1 ) ) { return -10; } } diff --git a/lapack-netlib/LAPACKE/utils/Makefile b/lapack-netlib/LAPACKE/utils/Makefile index 1f639c6ea..648a8c141 100644 --- a/lapack-netlib/LAPACKE/utils/Makefile +++ b/lapack-netlib/LAPACKE/utils/Makefile @@ -32,7 +32,12 @@ ############################################################################## # makefile for LAPACKE, used to build lapacke binary. # -include ../../make.inc +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + +.SUFFIXES: .c .o +.c.o: + $(CC) $(CFLAGS) -I../include -c -o $@ $< OBJ = lapacke_cgb_nancheck.o \ lapacke_cgb_trans.o \ @@ -183,15 +188,15 @@ OBJ = lapacke_cgb_nancheck.o \ lapacke_make_complex_float.o \ lapacke_make_complex_double.o +.PHONY: all all: lib +.PHONY: lib lib: $(OBJ) - $(ARCH) $(ARCHFLAGS) ../../$(LAPACKELIB) $^ - $(RANLIB) ../../$(LAPACKELIB) + $(AR) $(ARFLAGS) $(LAPACKELIB) $^ + $(RANLIB) $(LAPACKELIB) +.PHONY: clean cleanobj clean: cleanobj cleanobj: rm -f *.o - -.c.o: - $(CC) $(CFLAGS) -I../include -c -o $@ $< diff --git a/lapack-netlib/LAPACKE/utils/lapacke_chp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_chp_nancheck.c index 5e51e237c..0a7e6a2e2 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_chp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_chp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_cpf_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_cpf_nancheck.c index a1f14fd69..5e058418e 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_cpf_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_cpf_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo, transr or * matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_cpp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_cpp_nancheck.c index fc00ce2df..23174d68b 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_cpp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_cpp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_csp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_csp_nancheck.c index 56d53c74b..d1a8aa290 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_csp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_csp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_ctp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_ctp_nancheck.c index 97d1ab083..35c48a409 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_ctp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_ctp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_dpf_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_dpf_nancheck.c index 69c4cfdb4..df95f1318 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_dpf_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_dpf_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo, transr or * matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_dpp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_dpp_nancheck.c index 214496710..0ba66f96c 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_dpp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_dpp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_dsp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_dsp_nancheck.c index 2eada7c99..69d24611c 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_dsp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_dsp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_dtp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_dtp_nancheck.c index 29666e273..43f33bdd2 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_dtp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_dtp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_spf_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_spf_nancheck.c index 0e5b4659f..20666c4d6 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_spf_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_spf_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo, transr or * matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_spp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_spp_nancheck.c index eae73fa5c..c1098de70 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_spp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_spp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_ssp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_ssp_nancheck.c index 447724b01..35ffe6522 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_ssp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_ssp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_stp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_stp_nancheck.c index 2932d4040..4dfef0200 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_stp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_stp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_zhp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_zhp_nancheck.c index 694e1310e..bcf331fe1 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_zhp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_zhp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_zpf_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_zpf_nancheck.c index a0682290b..c510b1d1a 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_zpf_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_zpf_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo, transr or * matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_zpp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_zpp_nancheck.c index 141a796aa..450878bcf 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_zpp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_zpp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_zsp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_zsp_nancheck.c index d1a88641c..2d7795166 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_zsp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_zsp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/LAPACKE/utils/lapacke_ztp_nancheck.c b/lapack-netlib/LAPACKE/utils/lapacke_ztp_nancheck.c index 8e1eec971..d3a06c381 100644 --- a/lapack-netlib/LAPACKE/utils/lapacke_ztp_nancheck.c +++ b/lapack-netlib/LAPACKE/utils/lapacke_ztp_nancheck.c @@ -33,7 +33,7 @@ #include "lapacke_utils.h" /* Check a matrix for NaN entries. - * Since matrix in packed format stored continiously it just required to + * Since matrix in packed format stored continuously it just required to * check 1d array for NaNs. It doesn't depend upon uplo or matrix_layout. */ diff --git a/lapack-netlib/Makefile b/lapack-netlib/Makefile index 1d7e82c34..d5e75b69e 100644 --- a/lapack-netlib/Makefile +++ b/lapack-netlib/Makefile @@ -4,89 +4,120 @@ # April 2012 # -include make.inc +TOPSRCDIR = . +include $(TOPSRCDIR)/make.inc +.PHONY: all all: lapack_install lib blas_testing lapack_testing +.PHONY: lib lib: lapacklib tmglib #lib: blaslib variants lapacklib tmglib +.PHONY: blaslib blaslib: $(MAKE) -C BLAS +.PHONY: cblaslib cblaslib: $(MAKE) -C CBLAS +.PHONY: lapacklib lapacklib: $(MAKE) -C SRC +.PHONY: lapackelib lapackelib: $(MAKE) -C LAPACKE +.PHONY: blaspplib +blaspplib: + @echo "Thank you for your interest in BLAS++, a newly developed C++ API for BLAS library" + @echo "The objective of BLAS++ is to provide a convenient, performance oriented API for development in the C++ language, that, for the most part, preserves established conventions, while, at the same time, takes advantages of modern C++ features, such as: namespaces, templates, exceptions, etc." + @echo "We are still working on integrating BLAS++ in our library. For the moment, you can download directly blas++ from https://bitbucket.org/icl/blaspp" + @echo "For support BLAS++ related question, please email: slate-user@icl.utk.edu" + +.PHONY: lapackpplib +lapackpplib: + @echo "Thank you for your interest in LAPACK++, a newly developed C++ API for LAPACK library" + @echo "The objective of LAPACK++ is to provide a convenient, performance oriented API for development in the C++ language, that, for the most part, preserves established conventions, while, at the same time, takes advantages of modern C++ features, such as: namespaces, templates, exceptions, etc." + @echo "We are still working on integrating LAPACK++ in our library. For the moment, you can download directly lapack++ from https://bitbucket.org/icl/lapackpp" + @echo "For support LAPACK++ related question, please email: slate-user@icl.utk.edu" + +.PHONY: tmglib tmglib: $(MAKE) -C TESTING/MATGEN +.PHONY: variants variants: $(MAKE) -C SRC/VARIANTS +.PHONY: lapack_install lapack_install: $(MAKE) -C INSTALL run +.PHONY: blas_testing blas_testing: blaslib $(MAKE) -C BLAS blas_testing +.PHONY: cblas_testing cblas_testing: cblaslib blaslib $(MAKE) -C CBLAS cblas_testing +.PHONY: lapack_testing lapack_testing: tmglib lapacklib blaslib $(MAKE) -C TESTING/LIN cleanexe $(MAKE) -C TESTING ./lapack_testing.py +.PHONY: variants_testing variants_testing: tmglib variants lapacklib blaslib $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/cholrl.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/cholrl.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_cholrl.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_cholrl.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_cholrl.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_cholrl.out $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/choltop.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/choltop.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_choltop.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_choltop.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_choltop.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_choltop.out $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lucr.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/lucr.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lucr.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lucr.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lucr.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lucr.out $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lull.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/lull.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lull.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lull.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lull.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lull.out $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/lurec.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/lurec.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_lurec.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_lurec.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_lurec.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_lurec.out $(MAKE) -C TESTING/LIN cleanexe - $(MAKE) -C TESTING/LIN VARLIB='SRC/VARIANTS/qrll.a' + $(MAKE) -C TESTING/LIN VARLIB='../../SRC/VARIANTS/qrll.a' $(MAKE) -C TESTING stest.out && mv TESTING/stest.out TESTING/stest_qrll.out $(MAKE) -C TESTING dtest.out && mv TESTING/dtest.out TESTING/dtest_qrll.out $(MAKE) -C TESTING ctest.out && mv TESTING/ctest.out TESTING/ctest_qrll.out $(MAKE) -C TESTING ztest.out && mv TESTING/ztest.out TESTING/ztest_qrll.out +.PHONY: cblas_example cblas_example: cblaslib blaslib $(MAKE) -C CBLAS cblas_example +.PHONY: lapacke_example lapacke_example: lapackelib lapacklib blaslib $(MAKE) -C LAPACKE lapacke_example +.PHONY: html html: @echo "LAPACK HTML PAGES GENERATION with Doxygen" doxygen DOCS/Doxyfile @@ -96,6 +127,7 @@ html: @echo "Online version available at http://www.netlib.org/lapack/explore-html/" @echo "==================" +.PHONY: man man: @echo "LAPACK MAN PAGES GENERATION with Doxygen" doxygen DOCS/Doxyfile_man @@ -105,6 +137,7 @@ man: @echo "Usage: man dgetrf.f" @echo "==================" +.PHONY: clean cleanobj cleanlib cleanexe cleantest clean: $(MAKE) -C INSTALL clean $(MAKE) -C BLAS clean @@ -146,4 +179,4 @@ cleantest: $(MAKE) -C INSTALL cleantest $(MAKE) -C BLAS cleantest $(MAKE) -C CBLAS cleantest - $(MAKE) -C TESTING cleantest + $(MAKE) -C TESTING cleantest \ No newline at end of file diff --git a/lapack-netlib/README.md b/lapack-netlib/README.md index e5ac2d9c8..f0aed6c18 100644 --- a/lapack-netlib/README.md +++ b/lapack-netlib/README.md @@ -3,6 +3,7 @@ [![Build Status](https://travis-ci.org/Reference-LAPACK/lapack.svg?branch=master)](https://travis-ci.org/Reference-LAPACK/lapack) [![Appveyor](https://ci.appveyor.com/api/projects/status/bh38iin398msrbtr?svg=true)](https://ci.appveyor.com/project/langou/lapack/) [![codecov](https://codecov.io/gh/Reference-LAPACK/lapack/branch/master/graph/badge.svg)](https://codecov.io/gh/Reference-LAPACK/lapack) +[![Packaging status](https://repology.org/badge/tiny-repos/lapack.svg)](https://repology.org/metapackage/lapack/versions) * VERSION 1.0 : February 29, 1992 @@ -29,6 +30,7 @@ * VERSION 3.7.0 : December 2016 * VERSION 3.7.1 : June 2017 * VERSION 3.8.0 : November 2017 +* VERSION 3.9.0 : November 2019 LAPACK is a library of Fortran subroutines for solving the most commonly occurring problems in numerical linear algebra. @@ -70,6 +72,14 @@ CBLAS, a C interface to the BLAS, and (5) LAPACKE, a C interface to LAPACK. - LAPACK includes also the CMake build. You will need to have CMake installed on your machine (CMake is available at http://www.cmake.org/). CMake will allow an easy installation on a Windows Machine. + An example CMake build is: + ```sh + mkdir build + cd build + cmake -DCMAKE_INSTALL_LIBDIR=$HOME/.local/lapack .. + cmake --build -j . --target install + ``` + That installs the LAPACK library under $HOME/.local/lapack/ - Specific information to run LAPACK under Windows is available at http://icl.cs.utk.edu/lapack-for-windows/lapack/. @@ -99,7 +109,7 @@ You can also contact directly the LAPACK team at lapack@icl.utk.edu. ## Testing LAPACK includes a thorough test suite. We recommend that, after compilation, -you run the test suite. +you run the test suite. For complete information on the LAPACK Testing please consult LAPACK Working Note 41 "Installation Guide for LAPACK". @@ -115,4 +125,3 @@ LAPACK now includes the LAPACKE package. LAPACKE is a Standard C language API for LAPACK This was born from a collaboration of the LAPACK and INTEL Math Kernel Library teams. See: http://www.netlib.org/lapack/#_standard_c_language_apis_for_lapack. - diff --git a/lapack-netlib/SRC/CMakeLists.txt b/lapack-netlib/SRC/CMakeLists.txt index 944401beb..f19bdd302 100644 --- a/lapack-netlib/SRC/CMakeLists.txt +++ b/lapack-netlib/SRC/CMakeLists.txt @@ -106,7 +106,7 @@ set(SLASRC slatbs.f slatdf.f slatps.f slatrd.f slatrs.f slatrz.f slauu2.f slauum.f sopgtr.f sopmtr.f sorg2l.f sorg2r.f sorgbr.f sorghr.f sorgl2.f sorglq.f sorgql.f sorgqr.f sorgr2.f - sorgrq.f sorgtr.f sorm2l.f sorm2r.f sorm22.f + sorgrq.f sorgtr.f sorgtsqr.f sorm2l.f sorm2r.f sorm22.f sormbr.f sormhr.f sorml2.f sormlq.f sormql.f sormqr.f sormr2.f sormr3.f sormrq.f sormrz.f sormtr.f spbcon.f spbequ.f spbrfs.f spbstf.f spbsv.f spbsvx.f @@ -148,9 +148,11 @@ set(SLASRC sgetsls.f sgeqr.f slatsqr.f slamtsqr.f sgemqr.f sgelq.f slaswlq.f slamswlq.f sgemlq.f stplqt.f stplqt2.f stpmlqt.f + sorhr_col.f slaorhr_col_getrfnp.f slaorhr_col_getrfnp2.f ssytrd_2stage.f ssytrd_sy2sb.f ssytrd_sb2st.F ssb2st_kernels.f ssyevd_2stage.f ssyev_2stage.f ssyevx_2stage.f ssyevr_2stage.f - ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f) + ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f + sgesvdq.f scombssq.f) set(DSLASRC spotrs.f sgetrs.f spotrf.f sgetrf.f) @@ -233,7 +235,7 @@ set(CLASRC ctptrs.f ctrcon.f ctrevc.f ctrevc3.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f ctrsyl.f ctrti2.f ctrtri.f ctrtrs.f ctzrzf.f cung2l.f cung2r.f cungbr.f cunghr.f cungl2.f cunglq.f cungql.f cungqr.f cungr2.f - cungrq.f cungtr.f cunm2l.f cunm2r.f cunmbr.f cunmhr.f cunml2.f cunm22.f + cungrq.f cungtr.f cungtsqr.f cunm2l.f cunm2r.f cunmbr.f cunmhr.f cunml2.f cunm22.f cunmlq.f cunmql.f cunmqr.f cunmr2.f cunmr3.f cunmrq.f cunmrz.f cunmtr.f cupgtr.f cupmtr.f icmax1.f scsum1.f cstemr.f chfrk.f ctfttp.f clanhf.f cpftrf.f cpftri.f cpftrs.f ctfsm.f ctftri.f @@ -247,9 +249,11 @@ set(CLASRC cgetsls.f cgeqr.f clatsqr.f clamtsqr.f cgemqr.f cgelq.f claswlq.f clamswlq.f cgemlq.f ctplqt.f ctplqt2.f ctpmlqt.f + cunhr_col.f claunhr_col_getrfnp.f claunhr_col_getrfnp2.f chetrd_2stage.f chetrd_he2hb.f chetrd_hb2st.F chb2st_kernels.f cheevd_2stage.f cheev_2stage.f cheevx_2stage.f cheevr_2stage.f - chbev_2stage.f chbevx_2stage.f chbevd_2stage.f chegv_2stage.f) + chbev_2stage.f chbevx_2stage.f chbevd_2stage.f chegv_2stage.f + cgesvdq.f) set(CXLASRC cgesvxx.f cgerfsx.f cla_gerfsx_extended.f cla_geamv.f cla_gercond_c.f cla_gercond_x.f cla_gerpvgrw.f @@ -295,7 +299,7 @@ set(DLASRC dlatbs.f dlatdf.f dlatps.f dlatrd.f dlatrs.f dlatrz.f dlauu2.f dlauum.f dopgtr.f dopmtr.f dorg2l.f dorg2r.f dorgbr.f dorghr.f dorgl2.f dorglq.f dorgql.f dorgqr.f dorgr2.f - dorgrq.f dorgtr.f dorm2l.f dorm2r.f dorm22.f + dorgrq.f dorgtr.f dorgtsqr.f dorm2l.f dorm2r.f dorm22.f dormbr.f dormhr.f dorml2.f dormlq.f dormql.f dormqr.f dormr2.f dormr3.f dormrq.f dormrz.f dormtr.f dpbcon.f dpbequ.f dpbrfs.f dpbstf.f dpbsv.f dpbsvx.f @@ -339,9 +343,11 @@ set(DLASRC dgetsls.f dgeqr.f dlatsqr.f dlamtsqr.f dgemqr.f dgelq.f dlaswlq.f dlamswlq.f dgemlq.f dtplqt.f dtplqt2.f dtpmlqt.f + dorhr_col.f dlaorhr_col_getrfnp.f dlaorhr_col_getrfnp2.f dsytrd_2stage.f dsytrd_sy2sb.f dsytrd_sb2st.F dsb2st_kernels.f dsyevd_2stage.f dsyev_2stage.f dsyevx_2stage.f dsyevr_2stage.f - dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f) + dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f + dgesvdq.f dcombssq.f) set(DXLASRC dgesvxx.f dgerfsx.f dla_gerfsx_extended.f dla_geamv.f dla_gercond.f dla_gerpvgrw.f dsysvxx.f dsyrfsx.f @@ -424,7 +430,7 @@ set(ZLASRC ztptrs.f ztrcon.f ztrevc.f ztrevc3.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f ztrsyl.f ztrti2.f ztrtri.f ztrtrs.f ztzrzf.f zung2l.f zung2r.f zungbr.f zunghr.f zungl2.f zunglq.f zungql.f zungqr.f zungr2.f - zungrq.f zungtr.f zunm2l.f zunm2r.f zunmbr.f zunmhr.f zunml2.f zunm22.f + zungrq.f zungtr.f zungtsqr.f zunm2l.f zunm2r.f zunmbr.f zunmhr.f zunml2.f zunm22.f zunmlq.f zunmql.f zunmqr.f zunmr2.f zunmr3.f zunmrq.f zunmrz.f zunmtr.f zupgtr.f zupmtr.f izmax1.f dzsum1.f zstemr.f @@ -440,9 +446,11 @@ set(ZLASRC zgelqt.f zgelqt3.f zgemlqt.f zgetsls.f zgeqr.f zlatsqr.f zlamtsqr.f zgemqr.f zgelq.f zlaswlq.f zlamswlq.f zgemlq.f + zunhr_col.f zlaunhr_col_getrfnp.f zlaunhr_col_getrfnp2.f zhetrd_2stage.f zhetrd_he2hb.f zhetrd_hb2st.F zhb2st_kernels.f zheevd_2stage.f zheev_2stage.f zheevx_2stage.f zheevr_2stage.f - zhbev_2stage.f zhbevx_2stage.f zhbevd_2stage.f zhegv_2stage.f) + zhbev_2stage.f zhbevx_2stage.f zhbevd_2stage.f zhegv_2stage.f + zgesvdq.f) set(ZXLASRC zgesvxx.f zgerfsx.f zla_gerfsx_extended.f zla_geamv.f zla_gercond_c.f zla_gercond_x.f zla_gerpvgrw.f zsysvxx.f zsyrfsx.f @@ -504,7 +512,7 @@ if(USE_XBLAS) endif() target_link_libraries(lapack PRIVATE ${BLAS_LIBRARIES}) -if (${CMAKE_BUILD_TYPE_UPPER} STREQUAL "COVERAGE") +if(_is_coverage_build) target_link_libraries(lapack PRIVATE gcov) add_coverage(lapack) endif() diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index 1c276aff6..9f79e20e9 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -1,5 +1,3 @@ -include ../make.inc - ####################################################################### # This is the makefile to create a library for LAPACK. # The files are organized as follows: @@ -44,7 +42,7 @@ include ../make.inc # and is created at the next higher directory level. # # To remove the object files after the library is created, enter -# make clean +# make cleanobj # On some systems, you can force the source files to be recompiled by # entering (for example) # make single FRC=FRC @@ -56,6 +54,13 @@ include ../make.inc # ####################################################################### +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc + +.SUFFIXES: .F .o +.F.o: + $(FC) $(FFLAGS) -c -o $@ $< + ALLAUX_O = ilaenv.o ilaenv2stage.o ieeeck.o lsamen.o xerbla.o xerbla_array.o \ iparmq.o iparam2stage.o \ ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \ @@ -128,7 +133,7 @@ SLASRC_O = \ slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrz.o \ slauu2.o slauum.o sopgtr.o sopmtr.o sorg2l.o sorg2r.o \ sorgbr.o sorghr.o sorgl2.o sorglq.o sorgql.o sorgqr.o sorgr2.o \ - sorgrq.o sorgtr.o sorm2l.o sorm2r.o sorm22.o \ + sorgrq.o sorgtr.o sorgtsqr.o sorm2l.o sorm2r.o sorm22.o \ sormbr.o sormhr.o sorml2.o sormlq.o sormql.o sormqr.o sormr2.o \ sormr3.o sormrq.o sormrz.o sormtr.o spbcon.o spbequ.o spbrfs.o \ spbstf.o spbsv.o spbsvx.o \ @@ -171,9 +176,11 @@ SLASRC_O = \ sgetsls.o sgeqr.o slatsqr.o slamtsqr.o sgemqr.o \ sgelq.o slaswlq.o slamswlq.o sgemlq.o \ stplqt.o stplqt2.o stpmlqt.o \ + sorhr_col.o slaorhr_col_getrfnp.o slaorhr_col_getrfnp2.o \ ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o \ ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o \ - ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o + ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o \ + sgesvdq.o scombssq.o DSLASRC_O = spotrs.o sgetrs.o spotrf.o sgetrf.o @@ -258,7 +265,7 @@ CLASRC_O = \ ctptrs.o ctrcon.o ctrevc.o ctrevc3.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o \ ctrsyl.o ctrti2.o ctrtri.o ctrtrs.o ctzrzf.o cung2l.o cung2r.o \ cungbr.o cunghr.o cungl2.o cunglq.o cungql.o cungqr.o cungr2.o \ - cungrq.o cungtr.o cunm2l.o cunm2r.o cunmbr.o cunmhr.o cunml2.o cunm22.o \ + cungrq.o cungtr.o cungtsqr.o cunm2l.o cunm2r.o cunmbr.o cunmhr.o cunml2.o cunm22.o \ cunmlq.o cunmql.o cunmqr.o cunmr2.o cunmr3.o cunmrq.o cunmrz.o \ cunmtr.o cupgtr.o cupmtr.o icmax1.o scsum1.o cstemr.o \ chfrk.o ctfttp.o clanhf.o cpftrf.o cpftri.o cpftrs.o ctfsm.o ctftri.o \ @@ -272,9 +279,11 @@ CLASRC_O = \ cgetsls.o cgeqr.o clatsqr.o clamtsqr.o cgemqr.o \ cgelq.o claswlq.o clamswlq.o cgemlq.o \ ctplqt.o ctplqt2.o ctpmlqt.o \ + cunhr_col.o claunhr_col_getrfnp.o claunhr_col_getrfnp2.o \ chetrd_2stage.o chetrd_he2hb.o chetrd_hb2st.o chb2st_kernels.o \ cheevd_2stage.o cheev_2stage.o cheevx_2stage.o cheevr_2stage.o \ - chbev_2stage.o chbevx_2stage.o chbevd_2stage.o chegv_2stage.o + chbev_2stage.o chbevx_2stage.o chbevd_2stage.o chegv_2stage.o \ + cgesvdq.o ifdef USEXBLAS CXLASRC = cgesvxx.o cgerfsx.o cla_gerfsx_extended.o cla_geamv.o \ @@ -324,7 +333,7 @@ DLASRC_O = \ dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrz.o dlauu2.o \ dlauum.o dopgtr.o dopmtr.o dorg2l.o dorg2r.o \ dorgbr.o dorghr.o dorgl2.o dorglq.o dorgql.o dorgqr.o dorgr2.o \ - dorgrq.o dorgtr.o dorm2l.o dorm2r.o dorm22.o \ + dorgrq.o dorgtr.o dorgtsqr.o dorm2l.o dorm2r.o dorm22.o \ dormbr.o dormhr.o dorml2.o dormlq.o dormql.o dormqr.o dormr2.o \ dormr3.o dormrq.o dormrz.o dormtr.o dpbcon.o dpbequ.o dpbrfs.o \ dpbstf.o dpbsv.o dpbsvx.o \ @@ -368,9 +377,11 @@ DLASRC_O = \ dgetsls.o dgeqr.o dlatsqr.o dlamtsqr.o dgemqr.o \ dgelq.o dlaswlq.o dlamswlq.o dgemlq.o \ dtplqt.o dtplqt2.o dtpmlqt.o \ + dorhr_col.o dlaorhr_col_getrfnp.o dlaorhr_col_getrfnp2.o \ dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o \ dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o \ - dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o + dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o \ + dgesvdq.o dcombssq.o ifdef USEXBLAS DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o \ @@ -456,7 +467,7 @@ ZLASRC_O = \ ztptrs.o ztrcon.o ztrevc.o ztrevc3.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o \ ztrsyl.o ztrti2.o ztrtri.o ztrtrs.o ztzrzf.o zung2l.o \ zung2r.o zungbr.o zunghr.o zungl2.o zunglq.o zungql.o zungqr.o zungr2.o \ - zungrq.o zungtr.o zunm2l.o zunm2r.o zunmbr.o zunmhr.o zunml2.o zunm22.o \ + zungrq.o zungtr.o zungtsqr.o zunm2l.o zunm2r.o zunmbr.o zunmhr.o zunml2.o zunm22.o \ zunmlq.o zunmql.o zunmqr.o zunmr2.o zunmr3.o zunmrq.o zunmrz.o \ zunmtr.o zupgtr.o \ zupmtr.o izmax1.o dzsum1.o zstemr.o \ @@ -472,9 +483,11 @@ ZLASRC_O = \ zgelqt.o zgelqt3.o zgemlqt.o \ zgetsls.o zgeqr.o zlatsqr.o zlamtsqr.o zgemqr.o \ zgelq.o zlaswlq.o zlamswlq.o zgemlq.o \ + zunhr_col.o zlaunhr_col_getrfnp.o zlaunhr_col_getrfnp2.o \ zhetrd_2stage.o zhetrd_he2hb.o zhetrd_hb2st.o zhb2st_kernels.o \ zheevd_2stage.o zheev_2stage.o zheevx_2stage.o zheevr_2stage.o \ - zhbev_2stage.o zhbevx_2stage.o zhbevd_2stage.o zhegv_2stage.o + zhbev_2stage.o zhbevx_2stage.o zhbevd_2stage.o zhegv_2stage.o \ + zgesvdq.o ifdef USEXBLAS ZXLASRC = zgesvxx.o zgerfsx.o zla_gerfsx_extended.o zla_geamv.o \ @@ -550,33 +563,29 @@ ifdef BUILD_DEPRECATED DEPRECATED = $(DEPRECSRC) endif -all: ../$(LAPACKLIB) +.PHONY: all +all: $(LAPACKLIB) -.PHONY: ../$(LAPACKLIB) - -../$(LAPACKLIB): $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED) - $(ARCH) $(ARCHFLAGS) $@ $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED) +$(LAPACKLIB): $(ALLOBJ) $(ALLXOBJ) $(DEPRECATED) + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +.PHONY: single complex double complex16 single: $(SLASRC) $(DSLASRC) $(SXLASRC) $(SCLAUX) $(ALLAUX) - $(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(SLASRC) $(DSLASRC) \ - $(SXLASRC) $(SCLAUX) $(ALLAUX) - $(RANLIB) ../$(LAPACKLIB) + $(AR) $(ARFLAGS) $(LAPACKLIB) $^ + $(RANLIB) $(LAPACKLIB) complex: $(CLASRC) $(ZCLASRC) $(CXLASRC) $(SCLAUX) $(ALLAUX) - $(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(CLASRC) $(ZCLASRC) \ - $(CXLASRC) $(SCLAUX) $(ALLAUX) - $(RANLIB) ../$(LAPACKLIB) + $(AR) $(ARFLAGS) $(LAPACKLIB) $^ + $(RANLIB) $(LAPACKLIB) double: $(DLASRC) $(DSLASRC) $(DXLASRC) $(DZLAUX) $(ALLAUX) - $(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(DLASRC) $(DSLASRC) \ - $(DXLASRC) $(DZLAUX) $(ALLAUX) - $(RANLIB) ../$(LAPACKLIB) + $(AR) $(ARFLAGS) $(LAPACKLIB) $^ + $(RANLIB) $(LAPACKLIB) complex16: $(ZLASRC) $(ZCLASRC) $(ZXLASRC) $(DZLAUX) $(ALLAUX) - $(ARCH) $(ARCHFLAGS) ../$(LAPACKLIB) $(ZLASRC) $(ZCLASRC) \ - $(ZXLASRC) $(DZLAUX) $(ALLAUX) - $(RANLIB) ../$(LAPACKLIB) + $(AR) $(ARFLAGS) $(LAPACKLIB) $^ + $(RANLIB) $(LAPACKLIB) $(ALLAUX): $(FRC) $(SCLAUX): $(FRC) @@ -597,18 +606,16 @@ endif FRC: @FRC=$(FRC) -clean: +.PHONY: clean cleanobj cleanlib +clean: cleanobj cleanlib +cleanobj: rm -f *.o DEPRECATED/*.o - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< - -.F.o: - $(FORTRAN) $(OPTS) -c $< -o $@ - -slaruv.o: slaruv.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -dlaruv.o: dlaruv.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -sla_wwaddw.o: sla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -dla_wwaddw.o: dla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -cla_wwaddw.o: cla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -zla_wwaddw.o: zla_wwaddw.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< +cleanlib: + rm -f $(LAPACKLIB) + +slaruv.o: slaruv.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +dlaruv.o: dlaruv.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +sla_wwaddw.o: sla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +dla_wwaddw.o: dla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +cla_wwaddw.o: cla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +zla_wwaddw.o: zla_wwaddw.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< diff --git a/lapack-netlib/SRC/VARIANTS/Makefile b/lapack-netlib/SRC/VARIANTS/Makefile index 9f1410755..25d8ee175 100644 --- a/lapack-netlib/SRC/VARIANTS/Makefile +++ b/lapack-netlib/SRC/VARIANTS/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ####################################################################### # This is the makefile to create a the variants libraries for LAPACK. # The files are organized as follows: @@ -17,6 +15,9 @@ include ../../make.inc # 1065-1081. http://dx.doi.org/10.1137/S0895479896297744 ####################################################################### +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + CHOLRL = cholesky/RL/cpotrf.o cholesky/RL/dpotrf.o cholesky/RL/spotrf.o cholesky/RL/zpotrf.o CHOLTOP = cholesky/TOP/cpotrf.o cholesky/TOP/dpotrf.o cholesky/TOP/spotrf.o cholesky/TOP/zpotrf.o @@ -30,37 +31,36 @@ LUREC = lu/REC/cgetrf.o lu/REC/dgetrf.o lu/REC/sgetrf.o lu/REC/zgetrf.o QRLL = qr/LL/cgeqrf.o qr/LL/dgeqrf.o qr/LL/sgeqrf.o qr/LL/zgeqrf.o qr/LL/sceil.o +.PHONY: all all: cholrl.a choltop.a lucr.a lull.a lurec.a qrll.a cholrl.a: $(CHOLRL) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ choltop.a: $(CHOLTOP) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ lucr.a: $(LUCR) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ lull.a: $(LULL) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ lurec.a: $(LUREC) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ qrll.a: $(QRLL) - $(ARCH) $(ARCHFLAGS) $@ $^ + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +.PHONY: clean cleanobj cleanlib clean: cleanobj cleanlib cleanobj: rm -f $(CHOLRL) $(CHOLTOP) $(LUCR) $(LULL) $(LUREC) $(QRLL) cleanlib: rm -f *.a - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< diff --git a/lapack-netlib/SRC/VARIANTS/README b/lapack-netlib/SRC/VARIANTS/README index 4d301cc6e..ef7626deb 100644 --- a/lapack-netlib/SRC/VARIANTS/README +++ b/lapack-netlib/SRC/VARIANTS/README @@ -34,7 +34,7 @@ References:For a more detailed description please refer to ========= These variants are compiled by default in the build process but they are not tested by default. -The build process creates one new library per variants in the four arithmetics (single real/double real/single complex/double complex). +The build process creates one new library per variants in the four arithmetic (single real/double real/single complex/double complex). The libraries are in the SRC/VARIANTS directory. Corresponding libraries created in SRC/VARIANTS: @@ -64,16 +64,16 @@ You should then see the following files in the TESTING directory: = LINKING YOUR PROGRAM = ======================== -You just need to add the variants methods library in your linking sequence before your lapack libary. +You just need to add the variants methods library in your linking sequence before your lapack library. Here is a quick example for LU Default using LU Right Looking version: - $(FORTRAN) -c myprog.f - $(FORTRAN) -o myexe myprog.o $(LAPACKLIB) $(BLASLIB) + $(FC) $(FFLAGS) -c myprog.f + $(FC) $(FFLAGS) $(LDFLAGS) -o myexe myprog.o $(LAPACKLIB) $(BLASLIB) Using LU Left Looking version: - $(FORTRAN) -c myprog.f - $(FORTRAN) -o myexe myprog.o $(PATH TO LAPACK/SRC/VARIANTS)/lull.a $(LAPACKLIB) $(BLASLIB) + $(FC) $(FFLAGS) -c myprog.f + $(FC) $(FFLAGS) $(LDFLAGS) -o myexe myprog.o $(PATH TO LAPACK/SRC/VARIANTS)/lull.a $(LAPACKLIB) $(BLASLIB) =========== = SUPPORT = diff --git a/lapack-netlib/SRC/cgbrfsx.f b/lapack-netlib/SRC/cgbrfsx.f index 041b6a1b6..c23608afb 100644 --- a/lapack-netlib/SRC/cgbrfsx.f +++ b/lapack-netlib/SRC/cgbrfsx.f @@ -75,7 +75,7 @@ *> Specifies the form of the system of equations: *> = 'N': A * X = B (No transpose) *> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose = Transpose) +*> = 'C': A**H * X = B (Conjugate transpose) *> \endverbatim *> *> \param[in] EQUED @@ -308,7 +308,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -344,14 +344,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -359,9 +359,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cgbsvxx.f b/lapack-netlib/SRC/cgbsvxx.f index 2e113f99c..9f2bbbc1c 100644 --- a/lapack-netlib/SRC/cgbsvxx.f +++ b/lapack-netlib/SRC/cgbsvxx.f @@ -431,7 +431,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -467,14 +467,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -482,9 +482,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cgebak.f b/lapack-netlib/SRC/cgebak.f index 63c73bfa7..9b6402622 100644 --- a/lapack-netlib/SRC/cgebak.f +++ b/lapack-netlib/SRC/cgebak.f @@ -48,10 +48,10 @@ *> \verbatim *> JOB is CHARACTER*1 *> Specifies the type of backward transformation required: -*> = 'N', do nothing, return immediately; -*> = 'P', do backward transformation for permutation only; -*> = 'S', do backward transformation for scaling only; -*> = 'B', do backward transformations for both permutation and +*> = 'N': do nothing, return immediately; +*> = 'P': do backward transformation for permutation only; +*> = 'S': do backward transformation for scaling only; +*> = 'B': do backward transformations for both permutation and *> scaling. *> JOB must be the same as the argument JOB supplied to CGEBAL. *> \endverbatim diff --git a/lapack-netlib/SRC/cgeev.f b/lapack-netlib/SRC/cgeev.f index bdd75e4f1..f07d9b755 100644 --- a/lapack-netlib/SRC/cgeev.f +++ b/lapack-netlib/SRC/cgeev.f @@ -157,7 +157,7 @@ *> < 0: if INFO = -i, the i-th argument had an illegal value. *> > 0: if INFO = i, the QR algorithm failed to compute all the *> eigenvalues, and no eigenvectors have been computed; -*> elements and i+1:N of W contain eigenvalues which have +*> elements i+1:N of W contain eigenvalues which have *> converged. *> \endverbatim * diff --git a/lapack-netlib/SRC/cgejsv.f b/lapack-netlib/SRC/cgejsv.f index a7b1c451c..350da4c40 100644 --- a/lapack-netlib/SRC/cgejsv.f +++ b/lapack-netlib/SRC/cgejsv.f @@ -80,13 +80,13 @@ *> desirable, then this option is advisable. The input matrix A *> is preprocessed with QR factorization with FULL (row and *> column) pivoting. -*> = 'G' Computation as with 'F' with an additional estimate of the +*> = 'G': Computation as with 'F' with an additional estimate of the *> condition number of B, where A=B*D. If A has heavily weighted *> rows, then using this condition number gives too pessimistic *> error bound. *> = 'A': Small singular values are not well determined by the data *> and are considered as noisy; the matrix is treated as -*> numerically rank defficient. The error in the computed +*> numerically rank deficient. The error in the computed *> singular values is bounded by f(m,n)*epsilon*||A||. *> The computed SVD A = U * S * V^* restores A up to *> f(m,n)*epsilon*||A||. @@ -117,7 +117,7 @@ *> = 'V': N columns of V are returned in the array V; Jacobi rotations *> are not explicitly accumulated. *> = 'J': N columns of V are returned in the array V, but they are -*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'. +*> computed as the product of Jacobi rotations, if JOBT = 'N'. *> = 'W': V may be used as workspace of length N*N. See the description *> of V. *> = 'N': V is not computed. @@ -131,7 +131,7 @@ *> specified range. If A .NE. 0 is scaled so that the largest singular *> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues *> the licence to kill columns of A whose norm in c*A is less than -*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN, +*> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, *> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). *> = 'N': Do not kill small columns of c*A. This option assumes that *> BLAS and QR factorizations and triangular solvers are @@ -229,7 +229,7 @@ *> If JOBU = 'F', then U contains on exit the M-by-M matrix of *> the left singular vectors, including an ONB *> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N), +*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), *> then U is used as workspace if the procedure *> replaces A with A^*. In that case, [V] is computed *> in U as left singular vectors of A^* and then @@ -251,7 +251,7 @@ *> V is COMPLEX array, dimension ( LDV, N ) *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> the right singular vectors; -*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), +*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), *> then V is used as workspace if the pprocedure *> replaces A with A^*. In that case, [U] is computed *> in V as right singular vectors of A^* and then @@ -282,7 +282,7 @@ *> Length of CWORK to confirm proper allocation of workspace. *> LWORK depends on the job: *> -*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and +*> 1. If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and *> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): *> LWORK >= 2*N+1. This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value @@ -298,9 +298,9 @@ *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CGEQRF), LWORK(CGESVJ), *> N*N+LWORK(CPOCON)). -*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), -*> (JOBU.EQ.'N') -*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): +*> 2. If SIGMA and the right singular vectors are needed (JOBV = 'V'), +*> (JOBU = 'N') +*> 2.1 .. no scaled condition estimate requested (JOBE = 'N'): *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, *> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, @@ -318,10 +318,10 @@ *> LWORK >= max(N+LWORK(CGEQP3), LWORK(CPOCON), N+LWORK(CGESVJ), *> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). *> 3. If SIGMA and the left singular vectors are needed -*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): +*> 3.1 .. no scaled condition estimate requested (JOBE = 'N'): *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, +*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, *> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(CGEQP3), 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)). @@ -329,16 +329,16 @@ *> required (JOBA='E', or 'G'). *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, +*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, *> where NB is the optimal block size for CGEQP3, CGEQRF, CUNMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(CGEQP3),N+LWORK(CPOCON), *> 2*N+LWORK(CGEQRF), N+LWORK(CUNMQR)). *> -*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and -*> 4.1. if JOBV.EQ.'V' +*> 4. If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and +*> 4.1. if JOBV = 'V' *> the minimal requirement is LWORK >= 5*N+2*N*N. -*> 4.2. if JOBV.EQ.'J' the minimal requirement is +*> 4.2. if JOBV = 'J' the minimal requirement is *> LWORK >= 4*N+N*N. *> In both cases, the allocated CWORK can accommodate blocked runs *> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ. @@ -357,7 +357,7 @@ *> of A. (See the description of SVA().) *> RWORK(2) = See the description of RWORK(1). *> RWORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA .EQ. 'E' or 'G') +*> column equilibrated A. (If JOBA = 'E' or 'G') *> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). *> It is computed using SPOCON. It holds *> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA @@ -376,7 +376,7 @@ *> triangular factor in the first QR factorization. *> RWORK(5) = an estimate of the scaled condition number of the *> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT .EQ. 'T'. +*> The following two parameters are computed if JOBT = 'T'. *> They are provided for a developer/implementer who is familiar *> with the details of the method. *> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy @@ -457,23 +457,23 @@ *> of JOBA and JOBR. *> IWORK(2) = the number of the computed nonzero singular values *> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3).EQ.1 then some of the column norms of A +*> If IWORK(3) = 1 then some of the column norms of A *> were denormalized floats. The requested high accuracy *> is not warranted by the data. -*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to +*> IWORK(4) = 1 or -1. If IWORK(4) = 1, then the procedure used A^* to *> do the job as specified by the JOB parameters. -*> If the call to CGEJSV is a workspace query (indicated by LWORK .EQ. -1 and -*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of +*> If the call to CGEJSV is a workspace query (indicated by LWORK = -1 and +*> LRWORK = -1), then on exit IWORK(1) contains the required length of *> IWORK for the job parameters used in the call. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> < 0 : if INFO = -i, then the i-th argument had an illegal value. -*> = 0 : successful exit; -*> > 0 : CGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. +*> < 0: if INFO = -i, then the i-th argument had an illegal value. +*> = 0: successful exit; +*> > 0: CGEJSV did not converge in the maximal allowed number +*> of sweeps. The computed values may be inaccurate. *> \endverbatim * * Authors: @@ -1336,7 +1336,7 @@ IF ( L2ABER ) THEN * Standard absolute error bound suffices. All sigma_i with * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* agressive enforcement of lower numerical rank by introducing a +* aggressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. TEMP1 = SQRT(REAL(N))*EPSLN DO 3001 p = 2, N @@ -1348,9 +1348,9 @@ 3001 CONTINUE 3002 CONTINUE ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less agressive). +* .. similarly as above, only slightly more gentle (less aggressive). * Sudden drop on the diagonal of R1 is used as the criterion for -* close-to-rank-defficient. +* close-to-rank-deficient. TEMP1 = SQRT(SFMIN) DO 3401 p = 2, N IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. @@ -1718,7 +1718,7 @@ CALL CPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1, $ CWORK(2*N+NR*NR+1),RWORK,IERR) CONDR1 = ONE / SQRT(TEMP1) -* .. here need a second oppinion on the condition number +* .. here need a second opinion on the condition number * .. then assume worst case scenario * R1 is OK for inverse <=> CONDR1 .LT. REAL(N) * more conservative <=> CONDR1 .LT. SQRT(REAL(N)) @@ -1763,7 +1763,7 @@ ELSE * * .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equaly good +* Note that windowed pivoting would be equally good * numerically, and more run-time efficient. So, in * an optimal implementation, the next call to CGEQP3 * should be replaced with eg. CALL CGEQPX (ACM TOMS #782) @@ -1821,7 +1821,7 @@ * IF ( CONDR2 .GE. COND_OK ) THEN * .. save the Householder vectors used for Q3 -* (this overwrittes the copy of R2, as it will not be +* (this overwrites the copy of R2, as it will not be * needed in this branch, but it does not overwritte the * Huseholder vectors of Q2.). CALL CLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N ) @@ -2077,7 +2077,7 @@ * * This branch deploys a preconditioned Jacobi SVD with explicitly * accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perfom well, and can also be used. +* experimental purposes. It does perform well, and can also be used. * In this implementation, this branch will be automatically activated * if the condition number sigma_max(A) / sigma_min(A) is predicted * to be greater than the overflow threshold. This is because the diff --git a/lapack-netlib/SRC/cgelq.f b/lapack-netlib/SRC/cgelq.f index 909162ebc..c3b2238bf 100644 --- a/lapack-netlib/SRC/cgelq.f +++ b/lapack-netlib/SRC/cgelq.f @@ -1,3 +1,4 @@ +*> \brief \b CGELQ * * Definition: * =========== @@ -17,7 +18,17 @@ * ============= *> *> \verbatim -*> CGELQ computes a LQ factorization of an M-by-N matrix A. +*> +*> CGELQ computes an LQ factorization of a complex M-by-N matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -138,7 +149,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -159,10 +170,10 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/cgelq2.f b/lapack-netlib/SRC/cgelq2.f index 9742d359b..3fab2c396 100644 --- a/lapack-netlib/SRC/cgelq2.f +++ b/lapack-netlib/SRC/cgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> CGELQ2 computes an LQ factorization of a complex m by n matrix A: -*> A = L * Q. +*> CGELQ2 computes an LQ factorization of a complex m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is an lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,7 +104,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -121,10 +129,10 @@ * ===================================================================== SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/cgelqf.f b/lapack-netlib/SRC/cgelqf.f index 216630e88..030ac0b4d 100644 --- a/lapack-netlib/SRC/cgelqf.f +++ b/lapack-netlib/SRC/cgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> CGELQF computes an LQ factorization of a complex M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,7 +118,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -135,10 +143,10 @@ * ===================================================================== SUBROUTINE CGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/cgelqt.f b/lapack-netlib/SRC/cgelqt.f index e151f10fe..f40db0b02 100644 --- a/lapack-netlib/SRC/cgelqt.f +++ b/lapack-netlib/SRC/cgelqt.f @@ -1,3 +1,4 @@ +*> \brief \b CGELQT * * Definition: * =========== diff --git a/lapack-netlib/SRC/cgelqt3.f b/lapack-netlib/SRC/cgelqt3.f index f64379722..80a9a9fc7 100644 --- a/lapack-netlib/SRC/cgelqt3.f +++ b/lapack-netlib/SRC/cgelqt3.f @@ -1,3 +1,5 @@ +*> \brief \b CGELQT3 +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/cgemlq.f b/lapack-netlib/SRC/cgemlq.f index 2f44e7cfb..4e374077e 100644 --- a/lapack-netlib/SRC/cgemlq.f +++ b/lapack-netlib/SRC/cgemlq.f @@ -1,3 +1,4 @@ +*> \brief \b CGEMLQ * * Definition: * =========== @@ -143,7 +144,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/cgemlqt.f b/lapack-netlib/SRC/cgemlqt.f index e35e421b1..66b186bff 100644 --- a/lapack-netlib/SRC/cgemlqt.f +++ b/lapack-netlib/SRC/cgemlqt.f @@ -1,3 +1,5 @@ +*> \brief \b CGEMLQT +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/cgemqr.f b/lapack-netlib/SRC/cgemqr.f index a43d7be5b..54ab7aa74 100644 --- a/lapack-netlib/SRC/cgemqr.f +++ b/lapack-netlib/SRC/cgemqr.f @@ -1,3 +1,4 @@ +*> \brief \b CGEMQR * * Definition: * =========== @@ -144,7 +145,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/cgeqr.f b/lapack-netlib/SRC/cgeqr.f index a00ef45c0..e0aea88b1 100644 --- a/lapack-netlib/SRC/cgeqr.f +++ b/lapack-netlib/SRC/cgeqr.f @@ -1,3 +1,4 @@ +*> \brief \b CGEQR * * Definition: * =========== @@ -17,7 +18,18 @@ * ============= *> *> \verbatim -*> CGEQR computes a QR factorization of an M-by-N matrix A. +*> +*> CGEQR computes a QR factorization of a complex M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -138,7 +150,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -160,10 +172,10 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/cgeqr2.f b/lapack-netlib/SRC/cgeqr2.f index 1b2030b47..8cb2fa119 100644 --- a/lapack-netlib/SRC/cgeqr2.f +++ b/lapack-netlib/SRC/cgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> CGEQR2 computes a QR factorization of a complex m by n matrix A: -*> A = Q * R. +*> CGEQR2 computes a QR factorization of a complex m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,7 +105,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -121,10 +130,10 @@ * ===================================================================== SUBROUTINE CGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/cgeqr2p.f b/lapack-netlib/SRC/cgeqr2p.f index 3c64255d9..1e7b980df 100644 --- a/lapack-netlib/SRC/cgeqr2p.f +++ b/lapack-netlib/SRC/cgeqr2p.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> CGEQR2P computes a QR factorization of a complex m by n matrix A: -*> A = Q * R. The diagonal entries of R are real and nonnegative. +*> CGEQR2P computes a QR factorization of a complex m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix with nonnegative diagonal +*> entries; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -97,7 +107,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -124,10 +134,10 @@ * ===================================================================== SUBROUTINE CGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/cgeqrf.f b/lapack-netlib/SRC/cgeqrf.f index 833384707..ff0c53f2f 100644 --- a/lapack-netlib/SRC/cgeqrf.f +++ b/lapack-netlib/SRC/cgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> CGEQRF computes a QR factorization of a complex M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -111,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -136,10 +145,10 @@ * ===================================================================== SUBROUTINE CGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/cgeqrfp.f b/lapack-netlib/SRC/cgeqrfp.f index a56508b4e..9c29ac90b 100644 --- a/lapack-netlib/SRC/cgeqrfp.f +++ b/lapack-netlib/SRC/cgeqrfp.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> CGEQRFP computes a QR factorization of a complex M-by-N matrix A: -*> A = Q * R. The diagonal entries of R are real and nonnegative. +*> CGEQR2P computes a QR factorization of a complex M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix with nonnegative diagonal +*> entries; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -112,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complexGEcomputational * @@ -139,10 +149,10 @@ * ===================================================================== SUBROUTINE CGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/cgerfsx.f b/lapack-netlib/SRC/cgerfsx.f index 7b72f9c9a..a6e24ae4f 100644 --- a/lapack-netlib/SRC/cgerfsx.f +++ b/lapack-netlib/SRC/cgerfsx.f @@ -74,7 +74,7 @@ *> Specifies the form of the system of equations: *> = 'N': A * X = B (No transpose) *> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose = Transpose) +*> = 'C': A**H * X = B (Conjugate transpose) *> \endverbatim *> *> \param[in] EQUED @@ -283,7 +283,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -319,14 +319,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -334,9 +334,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cgesc2.f b/lapack-netlib/SRC/cgesc2.f index c0b91107e..6f45a09a6 100644 --- a/lapack-netlib/SRC/cgesc2.f +++ b/lapack-netlib/SRC/cgesc2.f @@ -91,7 +91,7 @@ *> \verbatim *> SCALE is REAL *> On exit, SCALE contains the scale factor. SCALE is chosen -*> 0 <= SCALE <= 1 to prevent owerflow in the solution. +*> 0 <= SCALE <= 1 to prevent overflow in the solution. *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/cgesvdq.f b/lapack-netlib/SRC/cgesvdq.f new file mode 100644 index 000000000..77c883dde --- /dev/null +++ b/lapack-netlib/SRC/cgesvdq.f @@ -0,0 +1,1391 @@ +*> \brief CGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CGESVDQ + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, +* S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, +* CWORK, LCWORK, RWORK, LRWORK, INFO ) +* +* .. Scalar Arguments .. +* IMPLICIT NONE +* CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV +* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK, +* INFO +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * ) +* REAL S( * ), RWORK( * ) +* INTEGER IWORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CGESVDQ computes the singular value decomposition (SVD) of a complex +*> M-by-N matrix A, where M >= N. The SVD of A is written as +*> [++] [xx] [x0] [xx] +*> A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx] +*> [++] [xx] +*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal +*> matrix, and V is an N-by-N unitary matrix. The diagonal elements +*> of SIGMA are the singular values of A. The columns of U and V are the +*> left and the right singular vectors of A, respectively. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] JOBA +*> \verbatim +*> JOBA is CHARACTER*1 +*> Specifies the level of accuracy in the computed SVD +*> = 'A' The requested accuracy corresponds to having the backward +*> error bounded by || delta A ||_F <= f(m,n) * EPS * || A ||_F, +*> where EPS = SLAMCH('Epsilon'). This authorises CGESVDQ to +*> truncate the computed triangular factor in a rank revealing +*> QR factorization whenever the truncated part is below the +*> threshold of the order of EPS * ||A||_F. This is aggressive +*> truncation level. +*> = 'M' Similarly as with 'A', but the truncation is more gentle: it +*> is allowed only when there is a drop on the diagonal of the +*> triangular factor in the QR factorization. This is medium +*> truncation level. +*> = 'H' High accuracy requested. No numerical rank determination based +*> on the rank revealing QR factorization is attempted. +*> = 'E' Same as 'H', and in addition the condition number of column +*> scaled A is estimated and returned in RWORK(1). +*> N^(-1/4)*RWORK(1) <= ||pinv(A_scaled)||_2 <= N^(1/4)*RWORK(1) +*> \endverbatim +*> +*> \param[in] JOBP +*> \verbatim +*> JOBP is CHARACTER*1 +*> = 'P' The rows of A are ordered in decreasing order with respect to +*> ||A(i,:)||_\infty. This enhances numerical accuracy at the cost +*> of extra data movement. Recommended for numerical robustness. +*> = 'N' No row pivoting. +*> \endverbatim +*> +*> \param[in] JOBR +*> \verbatim +*> JOBR is CHARACTER*1 +*> = 'T' After the initial pivoted QR factorization, CGESVD is applied to +*> the adjoint R**H of the computed triangular factor R. This involves +*> some extra data movement (matrix transpositions). Useful for +*> experiments, research and development. +*> = 'N' The triangular factor R is given as input to CGESVD. This may be +*> preferred as it involves less data movement. +*> \endverbatim +*> +*> \param[in] JOBU +*> \verbatim +*> JOBU is CHARACTER*1 +*> = 'A' All M left singular vectors are computed and returned in the +*> matrix U. See the description of U. +*> = 'S' or 'U' N = min(M,N) left singular vectors are computed and returned +*> in the matrix U. See the description of U. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK left singular +*> vectors are computed and returned in the matrix U. +*> = 'F' The N left singular vectors are returned in factored form as the +*> product of the Q factor from the initial QR factorization and the +*> N left singular vectors of (R**H , 0)**H. If row pivoting is used, +*> then the necessary information on the row pivoting is stored in +*> IWORK(N+1:N+M-1). +*> = 'N' The left singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] JOBV +*> \verbatim +*> JOBV is CHARACTER*1 +*> = 'A', 'V' All N right singular vectors are computed and returned in +*> the matrix V. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK right singular +*> vectors are computed and returned in the matrix V. This option is +*> allowed only if JOBU = 'R' or JOBU = 'N'; otherwise it is illegal. +*> = 'N' The right singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the input matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the input matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX array of dimensions LDA x N +*> On entry, the input matrix A. +*> On exit, if JOBU .NE. 'N' or JOBV .NE. 'N', the lower triangle of A contains +*> the Householder vectors as stored by CGEQP3. If JOBU = 'F', these Householder +*> vectors together with CWORK(1:N) can be used to restore the Q factors from +*> the initial pivoted QR factorization of A. See the description of U. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER. +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] S +*> \verbatim +*> S is REAL array of dimension N. +*> The singular values of A, ordered so that S(i) >= S(i+1). +*> \endverbatim +*> +*> \param[out] U +*> \verbatim +*> U is COMPLEX array, dimension +*> LDU x M if JOBU = 'A'; see the description of LDU. In this case, +*> on exit, U contains the M left singular vectors. +*> LDU x N if JOBU = 'S', 'U', 'R' ; see the description of LDU. In this +*> case, U contains the leading N or the leading NUMRANK left singular vectors. +*> LDU x N if JOBU = 'F' ; see the description of LDU. In this case U +*> contains N x N unitary matrix that can be used to form the left +*> singular vectors. +*> If JOBU = 'N', U is not referenced. +*> \endverbatim +*> +*> \param[in] LDU +*> \verbatim +*> LDU is INTEGER. +*> The leading dimension of the array U. +*> If JOBU = 'A', 'S', 'U', 'R', LDU >= max(1,M). +*> If JOBU = 'F', LDU >= max(1,N). +*> Otherwise, LDU >= 1. +*> \endverbatim +*> +*> \param[out] V +*> \verbatim +*> V is COMPLEX array, dimension +*> LDV x N if JOBV = 'A', 'V', 'R' or if JOBA = 'E' . +*> If JOBV = 'A', or 'V', V contains the N-by-N unitary matrix V**H; +*> If JOBV = 'R', V contains the first NUMRANK rows of V**H (the right +*> singular vectors, stored rowwise, of the NUMRANK largest singular values). +*> If JOBV = 'N' and JOBA = 'E', V is used as a workspace. +*> If JOBV = 'N', and JOBA.NE.'E', V is not referenced. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If JOBV = 'A', 'V', 'R', or JOBA = 'E', LDV >= max(1,N). +*> Otherwise, LDV >= 1. +*> \endverbatim +*> +*> \param[out] NUMRANK +*> \verbatim +*> NUMRANK is INTEGER +*> NUMRANK is the numerical rank first determined after the rank +*> revealing QR factorization, following the strategy specified by the +*> value of JOBA. If JOBV = 'R' and JOBU = 'R', only NUMRANK +*> leading singular values and vectors are then requested in the call +*> of CGESVD. The final value of NUMRANK might be further reduced if +*> some singular values are computed as zeros. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (max(1, LIWORK)). +*> On exit, IWORK(1:N) contains column pivoting permutation of the +*> rank revealing QR factorization. +*> If JOBP = 'P', IWORK(N+1:N+M-1) contains the indices of the sequence +*> of row swaps used in row pivoting. These can be used to restore the +*> left singular vectors in the case JOBU = 'F'. +*> +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> LIWORK(1) returns the minimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> LIWORK >= N + M - 1, if JOBP = 'P'; +*> LIWORK >= N if JOBP = 'N'. +*> +*> If LIWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] CWORK +*> \verbatim +*> CWORK is COMPLEX array, dimension (max(2, LCWORK)), used as a workspace. +*> On exit, if, on entry, LCWORK.NE.-1, CWORK(1:N) contains parameters +*> needed to recover the Q factor from the QR factorization computed by +*> CGEQP3. +*> +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> CWORK(1) returns the optimal LCWORK, and +*> CWORK(2) returns the minimal LCWORK. +*> \endverbatim +*> +*> \param[in,out] LCWORK +*> \verbatim +*> LCWORK is INTEGER +*> The dimension of the array CWORK. It is determined as follows: +*> Let LWQP3 = N+1, LWCON = 2*N, and let +*> LWUNQ = { MAX( N, 1 ), if JOBU = 'R', 'S', or 'U' +*> { MAX( M, 1 ), if JOBU = 'A' +*> LWSVD = MAX( 3*N, 1 ) +*> LWLQF = MAX( N/2, 1 ), LWSVD2 = MAX( 3*(N/2), 1 ), LWUNLQ = MAX( N, 1 ), +*> LWQRF = MAX( N/2, 1 ), LWUNQ2 = MAX( N, 1 ) +*> Then the minimal value of LCWORK is: +*> = MAX( N + LWQP3, LWSVD ) if only the singular values are needed; +*> = MAX( N + LWQP3, LWCON, LWSVD ) if only the singular values are needed, +*> and a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWUNQ ) if the singular values and the left +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) if the singular values and the left +*> singular vectors are requested, and also +*> a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD ) if the singular values and the right +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD ) if the singular values and the right +*> singular vectors are requested, and also +*> a scaled condition etimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWUNQ ) if the full SVD is requested with JOBV = 'R'; +*> independent of JOBR; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) if the full SVD is requested, +*> JOBV = 'R' and, also a scaled condition +*> estimate requested; independent of JOBR; +*> = MAX( N + MAX( LWQP3, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, N/2+LWUNLQ, LWUNQ) ) if the +*> full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWLQF, N/2+LWSVD2, N/2+LWUNLQ, LWUNQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N', and also a scaled condition number estimate +*> requested. +*> = MAX( N + MAX( LWQP3, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, N/2+LWUNQ2, LWUNQ ) ) if the +*> full SVD is requested with JOBV = 'A', 'V', and JOBR ='T' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWQRF, N/2+LWSVD2, N/2+LWUNQ2, LWUNQ ) ) +*> if the full SVD is requested with JOBV = 'A', 'V' and +*> JOBR ='T', and also a scaled condition number estimate +*> requested. +*> Finally, LCWORK must be at least two: LCWORK = MAX( 2, LCWORK ). +*> +*> If LCWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is REAL array, dimension (max(1, LRWORK)). +*> On exit, +*> 1. If JOBA = 'E', RWORK(1) contains an estimate of the condition +*> number of column scaled A. If A = C * D where D is diagonal and C +*> has unit columns in the Euclidean norm, then, assuming full column rank, +*> N^(-1/4) * RWORK(1) <= ||pinv(C)||_2 <= N^(1/4) * RWORK(1). +*> Otherwise, RWORK(1) = -1. +*> 2. RWORK(2) contains the number of singular values computed as +*> exact zeros in CGESVD applied to the upper triangular or trapeziodal +*> R (from the initial QR factorization). In case of early exit (no call to +*> CGESVD, such as in the case of zero matrix) RWORK(2) = -1. +*> +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> RWORK(1) returns the minimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER. +*> The dimension of the array RWORK. +*> If JOBP ='P', then LRWORK >= MAX(2, M, 5*N); +*> Otherwise, LRWORK >= MAX(2, 5*N). +*> +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: if CBDSQR did not converge, INFO specifies how many superdiagonals +*> of an intermediate bidiagonal form B (computed in CGESVD) did not +*> converge to zero. +*> \endverbatim +* +*> \par Further Details: +* ======================== +*> +*> \verbatim +*> +*> 1. The data movement (matrix transpose) is coded using simple nested +*> DO-loops because BLAS and LAPACK do not provide corresponding subroutines. +*> Those DO-loops are easily identified in this source code - by the CONTINUE +*> statements labeled with 11**. In an optimized version of this code, the +*> nested DO loops should be replaced with calls to an optimized subroutine. +*> 2. This code scales A by 1/SQRT(M) if the largest ABS(A(i,j)) could cause +*> column norm overflow. This is the minial precaution and it is left to the +*> SVD routine (CGESVD) to do its own preemptive scaling if potential over- +*> or underflows are detected. To avoid repeated scanning of the array A, +*> an optimal implementation would do all necessary scaling before calling +*> CGESVD and the scaling in CGESVD can be switched off. +*> 3. Other comments related to code optimization are given in comments in the +*> code, enlosed in [[double brackets]]. +*> \endverbatim +* +*> \par Bugs, examples and comments +* =========================== +* +*> \verbatim +*> Please report all bugs and send interesting examples and/or comments to +*> drmac@math.hr. Thank you. +*> \endverbatim +* +*> \par References +* =============== +* +*> \verbatim +*> [1] Zlatko Drmac, Algorithm 977: A QR-Preconditioned QR SVD Method for +*> Computing the SVD with High Accuracy. ACM Trans. Math. Softw. +*> 44(1): 11:1-11:30 (2017) +*> +*> SIGMA library, xGESVDQ section updated February 2016. +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup complexGEsing +* +* ===================================================================== + SUBROUTINE CGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, + $ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, + $ CWORK, LCWORK, RWORK, LRWORK, INFO ) +* .. Scalar Arguments .. + IMPLICIT NONE + CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV + INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK, + $ INFO +* .. +* .. Array Arguments .. + COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * ) + REAL S( * ), RWORK( * ) + INTEGER IWORK( * ) +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) + COMPLEX CZERO, CONE + PARAMETER ( CZERO = ( 0.0E0, 0.0E0 ), CONE = ( 1.0E0, 0.0E0 ) ) +* .. +* .. Local Scalars .. + INTEGER IERR, NR, N1, OPTRATIO, p, q + INTEGER LWCON, LWQP3, LWRK_CGELQF, LWRK_CGESVD, LWRK_CGESVD2, + $ LWRK_CGEQP3, LWRK_CGEQRF, LWRK_CUNMLQ, LWRK_CUNMQR, + $ LWRK_CUNMQR2, LWLQF, LWQRF, LWSVD, LWSVD2, LWUNQ, + $ LWUNQ2, LWUNLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2, + $ IMINWRK, RMINWRK + LOGICAL ACCLA, ACCLM, ACCLH, ASCALED, CONDA, DNTWU, DNTWV, + $ LQUERY, LSVC0, LSVEC, ROWPRM, RSVEC, RTRANS, WNTUA, + $ WNTUF, WNTUR, WNTUS, WNTVA, WNTVR + REAL BIG, EPSLN, RTMP, SCONDA, SFMIN + COMPLEX CTMP +* .. +* .. Local Arrays + COMPLEX CDUMMY(1) + REAL RDUMMY(1) +* .. +* .. External Subroutines (BLAS, LAPACK) + EXTERNAL CGELQF, CGEQP3, CGEQRF, CGESVD, CLACPY, CLAPMT, + $ CLASCL, CLASET, CLASWP, CSSCAL, SLASET, SLASCL, + $ CPOCON, CUNMLQ, CUNMQR, XERBLA +* .. +* .. External Functions (BLAS, LAPACK) + LOGICAL LSAME + INTEGER ISAMAX + REAL CLANGE, SCNRM2, SLAMCH + EXTERNAL CLANGE, LSAME, ISAMAX, SCNRM2, SLAMCH +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, CONJG, MAX, MIN, REAL, SQRT +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + WNTUS = LSAME( JOBU, 'S' ) .OR. LSAME( JOBU, 'U' ) + WNTUR = LSAME( JOBU, 'R' ) + WNTUA = LSAME( JOBU, 'A' ) + WNTUF = LSAME( JOBU, 'F' ) + LSVC0 = WNTUS .OR. WNTUR .OR. WNTUA + LSVEC = LSVC0 .OR. WNTUF + DNTWU = LSAME( JOBU, 'N' ) +* + WNTVR = LSAME( JOBV, 'R' ) + WNTVA = LSAME( JOBV, 'A' ) .OR. LSAME( JOBV, 'V' ) + RSVEC = WNTVR .OR. WNTVA + DNTWV = LSAME( JOBV, 'N' ) +* + ACCLA = LSAME( JOBA, 'A' ) + ACCLM = LSAME( JOBA, 'M' ) + CONDA = LSAME( JOBA, 'E' ) + ACCLH = LSAME( JOBA, 'H' ) .OR. CONDA +* + ROWPRM = LSAME( JOBP, 'P' ) + RTRANS = LSAME( JOBR, 'T' ) +* + IF ( ROWPRM ) THEN + IMINWRK = MAX( 1, N + M - 1 ) + RMINWRK = MAX( 2, M, 5*N ) + ELSE + IMINWRK = MAX( 1, N ) + RMINWRK = MAX( 2, 5*N ) + END IF + LQUERY = (LIWORK .EQ. -1 .OR. LCWORK .EQ. -1 .OR. LRWORK .EQ. -1) + INFO = 0 + IF ( .NOT. ( ACCLA .OR. ACCLM .OR. ACCLH ) ) THEN + INFO = -1 + ELSE IF ( .NOT.( ROWPRM .OR. LSAME( JOBP, 'N' ) ) ) THEN + INFO = -2 + ELSE IF ( .NOT.( RTRANS .OR. LSAME( JOBR, 'N' ) ) ) THEN + INFO = -3 + ELSE IF ( .NOT.( LSVEC .OR. DNTWU ) ) THEN + INFO = -4 + ELSE IF ( WNTUR .AND. WNTVA ) THEN + INFO = -5 + ELSE IF ( .NOT.( RSVEC .OR. DNTWV )) THEN + INFO = -5 + ELSE IF ( M.LT.0 ) THEN + INFO = -6 + ELSE IF ( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN + INFO = -7 + ELSE IF ( LDA.LT.MAX( 1, M ) ) THEN + INFO = -9 + ELSE IF ( LDU.LT.1 .OR. ( LSVC0 .AND. LDU.LT.M ) .OR. + $ ( WNTUF .AND. LDU.LT.N ) ) THEN + INFO = -12 + ELSE IF ( LDV.LT.1 .OR. ( RSVEC .AND. LDV.LT.N ) .OR. + $ ( CONDA .AND. LDV.LT.N ) ) THEN + INFO = -14 + ELSE IF ( LIWORK .LT. IMINWRK .AND. .NOT. LQUERY ) THEN + INFO = -17 + END IF +* +* + IF ( INFO .EQ. 0 ) THEN +* +* Compute workspace +* .. compute the minimal and the optimal workspace lengths +* [[The expressions for computing the minimal and the optimal +* values of LCWORK are written with a lot of redundancy and +* can be simplified. However, this detailed form is easier for +* maintenance and modifications of the code.]] +* +* .. minimal workspace length for CGEQP3 of an M x N matrix + LWQP3 = N+1 +* .. minimal workspace length for CUNMQR to build left singular vectors + IF ( WNTUS .OR. WNTUR ) THEN + LWUNQ = MAX( N , 1 ) + ELSE IF ( WNTUA ) THEN + LWUNQ = MAX( M , 1 ) + END IF +* .. minimal workspace length for CPOCON of an N x N matrix + LWCON = 2 * N +* .. CGESVD of an N x N matrix + LWSVD = MAX( 3 * N, 1 ) + IF ( LQUERY ) THEN + CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, + $ RDUMMY, IERR ) + LWRK_CGEQP3 = INT( CDUMMY(1) ) + IF ( WNTUS .OR. WNTUR ) THEN + CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, + $ LDU, CDUMMY, -1, IERR ) + LWRK_CUNMQR = INT( CDUMMY(1) ) + ELSE IF ( WNTUA ) THEN + CALL CUNMQR( 'L', 'N', M, M, N, A, LDA, CDUMMY, U, + $ LDU, CDUMMY, -1, IERR ) + LWRK_CUNMQR = INT( CDUMMY(1) ) + ELSE + LWRK_CUNMQR = 0 + END IF + END IF + MINWRK = 2 + OPTWRK = 2 + IF ( .NOT. (LSVEC .OR. RSVEC )) THEN +* .. minimal and optimal sizes of the complex workspace if +* only the singular values are requested + IF ( CONDA ) THEN + MINWRK = MAX( N+LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = MAX( N+LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + CALL CGESVD( 'N', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_CGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, LWRK_CGESVD ) + ELSE + OPTWRK = MAX( N+LWRK_CGEQP3, LWRK_CGESVD ) + END IF + END IF + ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN +* .. minimal and optimal sizes of the complex workspace if the +* singular values and the left singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD, LWUNQ ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL CGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + ELSE + CALL CGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + END IF + LWRK_CGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, LWRK_CGESVD, + $ LWRK_CUNMQR ) + ELSE + OPTWRK = N + MAX( LWRK_CGEQP3, LWRK_CGESVD, + $ LWRK_CUNMQR ) + END IF + END IF + ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN +* .. minimal and optimal sizes of the complex workspace if the +* singular values and the right singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL CGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + ELSE + CALL CGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + END IF + LWRK_CGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, LWRK_CGESVD ) + ELSE + OPTWRK = N + MAX( LWRK_CGEQP3, LWRK_CGESVD ) + END IF + END IF + ELSE +* .. minimal and optimal sizes of the complex workspace if the +* full SVD is requested + IF ( RTRANS ) THEN + MINWRK = MAX( LWQP3, LWSVD, LWUNQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N x N/2 CGEQRF + LWQRF = MAX( N/2, 1 ) +* .. minimal workspace lengt for N/2 x N/2 CGESVD + LWSVD2 = MAX( 3 * (N/2), 1 ) + LWUNQ2 = MAX( N, 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, + $ N/2+LWUNQ2, LWUNQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + ELSE + MINWRK = MAX( LWQP3, LWSVD, LWUNQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N/2 x N CGELQF + LWLQF = MAX( N/2, 1 ) + LWSVD2 = MAX( 3 * (N/2), 1 ) + LWUNLQ = MAX( N , 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, + $ N/2+LWUNLQ, LWUNQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL CGESVD( 'O', 'A', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_CGESVD = INT( CDUMMY(1) ) + OPTWRK = MAX(LWRK_CGEQP3,LWRK_CGESVD,LWRK_CUNMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL CGEQRF(N,N/2,U,LDU,CDUMMY,CDUMMY,-1,IERR) + LWRK_CGEQRF = INT( CDUMMY(1) ) + CALL CGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_CGESVD2 = INT( CDUMMY(1) ) + CALL CUNMQR( 'R', 'C', N, N, N/2, U, LDU, CDUMMY, + $ V, LDV, CDUMMY, -1, IERR ) + LWRK_CUNMQR2 = INT( CDUMMY(1) ) + OPTWRK2 = MAX( LWRK_CGEQP3, N/2+LWRK_CGEQRF, + $ N/2+LWRK_CGESVD2, N/2+LWRK_CUNMQR2 ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + ELSE + CALL CGESVD( 'S', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_CGESVD = INT( CDUMMY(1) ) + OPTWRK = MAX(LWRK_CGEQP3,LWRK_CGESVD,LWRK_CUNMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL CGELQF(N/2,N,U,LDU,CDUMMY,CDUMMY,-1,IERR) + LWRK_CGELQF = INT( CDUMMY(1) ) + CALL CGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_CGESVD2 = INT( CDUMMY(1) ) + CALL CUNMLQ( 'R', 'N', N, N, N/2, U, LDU, CDUMMY, + $ V, LDV, CDUMMY,-1,IERR ) + LWRK_CUNMLQ = INT( CDUMMY(1) ) + OPTWRK2 = MAX( LWRK_CGEQP3, N/2+LWRK_CGELQF, + $ N/2+LWRK_CGESVD2, N/2+LWRK_CUNMLQ ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + END IF + END IF + END IF +* + MINWRK = MAX( 2, MINWRK ) + OPTWRK = MAX( 2, OPTWRK ) + IF ( LCWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = -19 +* + END IF +* + IF (INFO .EQ. 0 .AND. LRWORK .LT. RMINWRK .AND. .NOT. LQUERY) THEN + INFO = -21 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CGESVDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +* +* Return optimal workspace +* + IWORK(1) = IMINWRK + CWORK(1) = OPTWRK + CWORK(2) = MINWRK + RWORK(1) = RMINWRK + RETURN + END IF +* +* Quick return if the matrix is void. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) THEN +* .. all output is void. + RETURN + END IF +* + BIG = SLAMCH('O') + ASCALED = .FALSE. + IF ( ROWPRM ) THEN +* .. reordering the rows in decreasing sequence in the +* ell-infinity norm - this enhances numerical robustness in +* the case of differently scaled rows. + DO 1904 p = 1, M +* RWORK(p) = ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) +* [[CLANGE will return NaN if an entry of the p-th row is Nan]] + RWORK(p) = CLANGE( 'M', 1, N, A(p,1), LDA, RDUMMY ) +* .. check for NaN's and Inf's + IF ( ( RWORK(p) .NE. RWORK(p) ) .OR. + $ ( (RWORK(p)*ZERO) .NE. ZERO ) ) THEN + INFO = - 8 + CALL XERBLA( 'CGESVDQ', -INFO ) + RETURN + END IF + 1904 CONTINUE + DO 1952 p = 1, M - 1 + q = ISAMAX( M-p+1, RWORK(p), 1 ) + p - 1 + IWORK(N+p) = q + IF ( p .NE. q ) THEN + RTMP = RWORK(p) + RWORK(p) = RWORK(q) + RWORK(q) = RTMP + END IF + 1952 CONTINUE +* + IF ( RWORK(1) .EQ. ZERO ) THEN +* Quick return: A is the M x N zero matrix. + NUMRANK = 0 + CALL SLASET( 'G', N, 1, ZERO, ZERO, S, N ) + IF ( WNTUS ) CALL CLASET('G', M, N, CZERO, CONE, U, LDU) + IF ( WNTUA ) CALL CLASET('G', M, M, CZERO, CONE, U, LDU) + IF ( WNTVA ) CALL CLASET('G', N, N, CZERO, CONE, V, LDV) + IF ( WNTUF ) THEN + CALL CLASET( 'G', N, 1, CZERO, CZERO, CWORK, N ) + CALL CLASET( 'G', M, N, CZERO, CONE, U, LDU ) + END IF + DO 5001 p = 1, N + IWORK(p) = p + 5001 CONTINUE + IF ( ROWPRM ) THEN + DO 5002 p = N + 1, N + M - 1 + IWORK(p) = p - N + 5002 CONTINUE + END IF + IF ( CONDA ) RWORK(1) = -1 + RWORK(2) = -1 + RETURN + END IF +* + IF ( RWORK(1) .GT. BIG / SQRT(REAL(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL CLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + CALL CLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) + END IF +* +* .. At this stage, preemptive scaling is done only to avoid column +* norms overflows during the QR factorization. The SVD procedure should +* have its own scaling to save the singular values from overflows and +* underflows. That depends on the SVD procedure. +* + IF ( .NOT.ROWPRM ) THEN + RTMP = CLANGE( 'M', M, N, A, LDA, RWORK ) + IF ( ( RTMP .NE. RTMP ) .OR. + $ ( (RTMP*ZERO) .NE. ZERO ) ) THEN + INFO = - 8 + CALL XERBLA( 'CGESVDQ', -INFO ) + RETURN + END IF + IF ( RTMP .GT. BIG / SQRT(REAL(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL CLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + END IF +* +* .. QR factorization with column pivoting +* +* A * P = Q * [ R ] +* [ 0 ] +* + DO 1963 p = 1, N +* .. all columns are free columns + IWORK(p) = 0 + 1963 CONTINUE + CALL CGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LCWORK-N, + $ RWORK, IERR ) +* +* If the user requested accuracy level allows truncation in the +* computed upper triangular factor, the matrix R is examined and, +* if possible, replaced with its leading upper trapezoidal part. +* + EPSLN = SLAMCH('E') + SFMIN = SLAMCH('S') +* SMALL = SFMIN / EPSLN + NR = N +* + IF ( ACCLA ) THEN +* +* Standard absolute error bound suffices. All sigma_i with +* sigma_i < N*EPS*||A||_F are flushed to zero. This is an +* aggressive enforcement of lower numerical rank by introducing a +* backward error of the order of N*EPS*||A||_F. + NR = 1 + RTMP = SQRT(REAL(N))*EPSLN + DO 3001 p = 2, N + IF ( ABS(A(p,p)) .LT. (RTMP*ABS(A(1,1))) ) GO TO 3002 + NR = NR + 1 + 3001 CONTINUE + 3002 CONTINUE +* + ELSEIF ( ACCLM ) THEN +* .. similarly as above, only slightly more gentle (less aggressive). +* Sudden drop on the diagonal of R is used as the criterion for being +* close-to-rank-deficient. The threshold is set to EPSLN=SLAMCH('E'). +* [[This can be made more flexible by replacing this hard-coded value +* with a user specified threshold.]] Also, the values that underflow +* will be truncated. + NR = 1 + DO 3401 p = 2, N + IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. + $ ( ABS(A(p,p)) .LT. SFMIN ) ) GO TO 3402 + NR = NR + 1 + 3401 CONTINUE + 3402 CONTINUE +* + ELSE +* .. RRQR not authorized to determine numerical rank except in the +* obvious case of zero pivots. +* .. inspect R for exact zeros on the diagonal; +* R(i,i)=0 => R(i:N,i:N)=0. + NR = 1 + DO 3501 p = 2, N + IF ( ABS(A(p,p)) .EQ. ZERO ) GO TO 3502 + NR = NR + 1 + 3501 CONTINUE + 3502 CONTINUE +* + IF ( CONDA ) THEN +* Estimate the scaled condition number of A. Use the fact that it is +* the same as the scaled condition number of R. +* .. V is used as workspace + CALL CLACPY( 'U', N, N, A, LDA, V, LDV ) +* Only the leading NR x NR submatrix of the triangular factor +* is considered. Only if NR=N will this give a reliable error +* bound. However, even for NR < N, this can be used on an +* expert level and obtain useful information in the sense of +* perturbation theory. + DO 3053 p = 1, NR + RTMP = SCNRM2( p, V(1,p), 1 ) + CALL CSSCAL( p, ONE/RTMP, V(1,p), 1 ) + 3053 CONTINUE + IF ( .NOT. ( LSVEC .OR. RSVEC ) ) THEN + CALL CPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ CWORK, RWORK, IERR ) + ELSE + CALL CPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ CWORK(N+1), RWORK, IERR ) + END IF + SCONDA = ONE / SQRT(RTMP) +* For NR=N, SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1), +* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA +* See the reference [1] for more details. + END IF +* + ENDIF +* + IF ( WNTUR ) THEN + N1 = NR + ELSE IF ( WNTUS .OR. WNTUF) THEN + N1 = N + ELSE IF ( WNTUA ) THEN + N1 = M + END IF +* + IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN +*....................................................................... +* .. only the singular values are requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. compute the singular values of R**H = [A](1:NR,1:N)**H +* .. set the lower triangle of [A] to [A](1:NR,1:N)**H and +* the upper triangle of [A] to zero. + DO 1146 p = 1, MIN( N, NR ) + A(p,p) = CONJG(A(p,p)) + DO 1147 q = p + 1, N + A(q,p) = CONJG(A(p,q)) + IF ( q .LE. NR ) A(p,q) = CZERO + 1147 CONTINUE + 1146 CONTINUE +* + CALL CGESVD( 'N', 'N', N, NR, A, LDA, S, U, LDU, + $ V, LDV, CWORK, LCWORK, RWORK, INFO ) +* + ELSE +* +* .. compute the singular values of R = [A](1:NR,1:N) +* + IF ( NR .GT. 1 ) + $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), LDA ) + CALL CGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, + $ V, LDV, CWORK, LCWORK, RWORK, INFO ) +* + END IF +* + ELSE IF ( LSVEC .AND. ( .NOT. RSVEC) ) THEN +*....................................................................... +* .. the singular values and the left singular vectors requested +*......................................................................."""""""" + IF ( RTRANS ) THEN +* .. apply CGESVD to R**H +* .. copy R**H into [U] and overwrite [U] with the right singular +* vectors of R + DO 1192 p = 1, NR + DO 1193 q = p, N + U(q,p) = CONJG(A(p,q)) + 1193 CONTINUE + 1192 CONTINUE + IF ( NR .GT. 1 ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), LDU ) +* .. the left singular vectors not computed, the NR right singular +* vectors overwrite [U](1:NR,1:NR) as conjugate transposed. These +* will be pre-multiplied by Q to build the left singular vectors of A. + CALL CGESVD( 'N', 'O', N, NR, U, LDU, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1119 p = 1, NR + U(p,p) = CONJG(U(p,p)) + DO 1120 q = p + 1, NR + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1120 CONTINUE + 1119 CONTINUE +* + ELSE +* .. apply CGESVD to R +* .. copy R into [U] and overwrite [U] with the left singular vectors + CALL CLACPY( 'U', NR, N, A, LDA, U, LDU ) + IF ( NR .GT. 1 ) + $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), LDU ) +* .. the right singular vectors not computed, the NR left singular +* vectors overwrite [U](1:NR,1:NR) + CALL CGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* .. now [U](1:NR,1:NR) contains the NR left singular vectors of +* R. These will be pre-multiplied by Q to build the left singular +* vectors of A. + END IF +* +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN + CALL CLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL CLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), LDU ) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT.WNTUF ) + $ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, + $ LDU, CWORK(N+1), LCWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* + ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN +*....................................................................... +* .. the singular values and the right singular vectors requested +*....................................................................... + IF ( RTRANS ) THEN +* .. apply CGESVD to R**H +* .. copy R**H into V and overwrite V with the left singular vectors + DO 1165 p = 1, NR + DO 1166 q = p, N + V(q,p) = CONJG(A(p,q)) + 1166 CONTINUE + 1165 CONTINUE + IF ( NR .GT. 1 ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) +* .. the left singular vectors of R**H overwrite V, the right singular +* vectors not computed + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL CGESVD( 'O', 'N', N, NR, V, LDV, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1121 p = 1, NR + V(p,p) = CONJG(V(p,p)) + DO 1122 q = p + 1, NR + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1122 CONTINUE + 1121 CONTINUE +* + IF ( NR .LT. N ) THEN + DO 1103 p = 1, NR + DO 1104 q = NR + 1, N + V(p,q) = CONJG(V(q,p)) + 1104 CONTINUE + 1103 CONTINUE + END IF + CALL CLAPMT( .FALSE., NR, N, V, LDV, IWORK ) + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:N,1:NR) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the QR factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL CLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), LDV) + CALL CGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1123 p = 1, N + V(p,p) = CONJG(V(p,p)) + DO 1124 q = p + 1, N + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1124 CONTINUE + 1123 CONTINUE + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* + ELSE +* .. aply CGESVD to R +* .. copy R into V and overwrite V with the right singular vectors + CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL CLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), LDV ) +* .. the right singular vectors overwrite V, the NR left singular +* vectors stored in U(1:NR,1:NR) + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL CGESVD( 'N', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL CLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**H + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:NR,1:N) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the LQ factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL CLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), LDV) + CALL CGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* .. now [V] contains the adjoint of the matrix of the right singular +* vectors of A. + END IF +* + ELSE +*....................................................................... +* .. FULL SVD requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. apply CGESVD to R**H [[this option is left for R&D&T]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R**H into [V] and overwrite [V] with the left singular +* vectors of R**H + DO 1168 p = 1, NR + DO 1169 q = p, N + V(q,p) = CONJG(A(p,q)) + 1169 CONTINUE + 1168 CONTINUE + IF ( NR .GT. 1 ) + $ CALL CLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) +* +* .. the left singular vectors of R**H overwrite [V], the NR right +* singular vectors of R**H stored in [U](1:NR,1:NR) as conjugate +* transposed + CALL CGESVD( 'O', 'A', N, NR, V, LDV, S, V, LDV, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* .. assemble V + DO 1115 p = 1, NR + V(p,p) = CONJG(V(p,p)) + DO 1116 q = p + 1, NR + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1116 CONTINUE + 1115 CONTINUE + IF ( NR .LT. N ) THEN + DO 1101 p = 1, NR + DO 1102 q = NR+1, N + V(p,q) = CONJG(V(q,p)) + 1102 CONTINUE + 1101 CONTINUE + END IF + CALL CLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* + DO 1117 p = 1, NR + U(p,p) = CONJG(U(p,p)) + DO 1118 q = p + 1, NR + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1118 CONTINUE + 1117 CONTINUE +* + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. copy R**H into [V] and overwrite [V] with the left singular +* vectors of R**H +* [[The optimal ratio N/NR for using QRF instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'CGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO*NR .GT. N ) THEN + DO 1198 p = 1, NR + DO 1199 q = p, N + V(q,p) = CONJG(A(p,q)) + 1199 CONTINUE + 1198 CONTINUE + IF ( NR .GT. 1 ) + $ CALL CLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2),LDV) +* + CALL CLASET('A',N,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL CGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1113 p = 1, N + V(p,p) = CONJG(V(p,p)) + DO 1114 q = p + 1, N + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1114 CONTINUE + 1113 CONTINUE + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). +* + DO 1111 p = 1, N + U(p,p) = CONJG(U(p,p)) + DO 1112 q = p + 1, N + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1112 CONTINUE + 1111 CONTINUE +* + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL CLASET('A',M-N,N1-N,CZERO,CONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE +* .. copy R**H into [U] and overwrite [U] with the right +* singular vectors of R + DO 1196 p = 1, NR + DO 1197 q = p, N + U(q,NR+p) = CONJG(A(p,q)) + 1197 CONTINUE + 1196 CONTINUE + IF ( NR .GT. 1 ) + $ CALL CLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2),LDU) + CALL CGEQRF( N, NR, U(1,NR+1), LDU, CWORK(N+1), + $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) + DO 1143 p = 1, NR + DO 1144 q = 1, N + V(q,p) = CONJG(U(p,NR+q)) + 1144 CONTINUE + 1143 CONTINUE + CALL CLASET('U',NR-1,NR-1,CZERO,CZERO,V(1,2),LDV) + CALL CGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V,LDV, CWORK(N+NR+1),LCWORK-N-NR,RWORK, INFO ) + CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) + CALL CUNMQR('R','C', N, N, NR, U(1,NR+1), LDU, + $ CWORK(N+1),V,LDV,CWORK(N+NR+1),LCWORK-N-NR,IERR) + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1),LDU) + END IF + END IF + END IF + END IF +* + ELSE +* +* .. apply CGESVD to R [[this is the recommended option]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R into [V] and overwrite V with the right singular vectors + CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL CLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), LDV ) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL CGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL CLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**H +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. the requested number of the left singular vectors +* is then N1 (N or M) +* [[The optimal ratio N/NR for using LQ instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'CGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO * NR .GT. N ) THEN + CALL CLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL CLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1),LDV) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL CLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1),LDV) + CALL CGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. now [V] contains the adjoint of the matrix of the right +* singular vectors of A. The leading N left singular vectors +* are in [U](1:N,1:N) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL CLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL CLASET( 'A',M-N,N1-N,CZERO,CONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE + CALL CLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) + IF ( NR .GT. 1 ) + $ CALL CLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1),LDU) + CALL CGELQF( NR, N, U(NR+1,1), LDU, CWORK(N+1), + $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) + CALL CLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) + IF ( NR .GT. 1 ) + $ CALL CLASET('U',NR-1,NR-1,CZERO,CZERO,V(1,2),LDV) + CALL CGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+NR+1), LCWORK-N-NR, RWORK, INFO ) + CALL CLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL CLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL CLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) + CALL CUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU,CWORK(N+1), + $ V, LDV, CWORK(N+NR+1),LCWORK-N-NR,IERR) + CALL CLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL CLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL CLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL CLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF + END IF + END IF +* .. end of the "R**H or R" branch + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT. WNTUF ) + $ CALL CUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, + $ LDU, CWORK(N+1), LCWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL CLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* +* ... end of the "full SVD" branch + END IF +* +* Check whether some singular values are returned as zeros, e.g. +* due to underflow, and update the numerical rank. + p = NR + DO 4001 q = p, 1, -1 + IF ( S(q) .GT. ZERO ) GO TO 4002 + NR = NR - 1 + 4001 CONTINUE + 4002 CONTINUE +* +* .. if numerical rank deficiency is detected, the truncated +* singular values are set to zero. + IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) +* .. undo scaling; this may cause overflow in the largest singular +* values. + IF ( ASCALED ) + $ CALL SLASCL( 'G',0,0, ONE,SQRT(REAL(M)), NR,1, S, N, IERR ) + IF ( CONDA ) RWORK(1) = SCONDA + RWORK(2) = p - NR +* .. p-NR is the number of singular values that are computed as +* exact zeros in CGESVD() applied to the (possibly truncated) +* full row rank triangular (trapezoidal) factor of A. + NUMRANK = NR +* + RETURN +* +* End of CGESVDQ +* + END diff --git a/lapack-netlib/SRC/cgesvj.f b/lapack-netlib/SRC/cgesvj.f index 2a5ced225..81e40efef 100644 --- a/lapack-netlib/SRC/cgesvj.f +++ b/lapack-netlib/SRC/cgesvj.f @@ -89,12 +89,12 @@ *> Specifies whether to compute the right singular vectors, that *> is, the matrix V: *> = 'V' or 'J': the matrix V is computed and returned in the array V -*> = 'A' : the Jacobi rotations are applied to the MV-by-N +*> = 'A': the Jacobi rotations are applied to the MV-by-N *> array V. In other words, the right singular vector *> matrix V is not computed explicitly; instead it is *> applied to an MV-by-N matrix initially stored in the *> first MV rows of V. -*> = 'N' : the matrix V is not computed and the array V is not +*> = 'N': the matrix V is not computed and the array V is not *> referenced *> \endverbatim *> @@ -116,8 +116,8 @@ *> A is COMPLEX array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, -*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C': -*> If INFO .EQ. 0 : +*> If JOBU = 'U' .OR. JOBU = 'C': +*> If INFO = 0 : *> RANKA orthonormal columns of U are returned in the *> leading RANKA columns of the array A. Here RANKA <= N *> is the number of computed singular values of A that are @@ -127,9 +127,9 @@ *> in the array RWORK as RANKA=NINT(RWORK(2)). Also see the *> descriptions of SVA and RWORK. The computed columns of U *> are mutually numerically orthogonal up to approximately -*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'), +*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU = 'C'), *> see the description of JOBU. -*> If INFO .GT. 0, +*> If INFO > 0, *> the procedure CGESVJ did not converge in the given number *> of iterations (sweeps). In that case, the computed *> columns of U may not be orthogonal up to TOL. The output @@ -137,8 +137,8 @@ *> values in SVA(1:N)) and V is still a decomposition of the *> input matrix A in the sense that the residual *> || A - SCALE * U * SIGMA * V^* ||_2 / ||A||_2 is small. -*> If JOBU .EQ. 'N': -*> If INFO .EQ. 0 : +*> If JOBU = 'N': +*> If INFO = 0 : *> Note that the left singular vectors are 'for free' in the *> one-sided Jacobi SVD algorithm. However, if only the *> singular values are needed, the level of numerical @@ -147,7 +147,7 @@ *> numerically orthogonal up to approximately M*EPS. Thus, *> on exit, A contains the columns of U scaled with the *> corresponding singular values. -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure CGESVJ did not converge in the given number *> of iterations (sweeps). *> \endverbatim @@ -162,9 +162,9 @@ *> \verbatim *> SVA is REAL array, dimension (N) *> On exit, -*> If INFO .EQ. 0 : +*> If INFO = 0 : *> depending on the value SCALE = RWORK(1), we have: -*> If SCALE .EQ. ONE: +*> If SCALE = ONE: *> SVA(1:N) contains the computed singular values of A. *> During the computation SVA contains the Euclidean column *> norms of the iterated matrices in the array A. @@ -173,7 +173,7 @@ *> factored representation is due to the fact that some of the *> singular values of A might underflow or overflow. *> -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure CGESVJ did not converge in the given number of *> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate. *> \endverbatim @@ -181,7 +181,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then the product of Jacobi rotations in CGESVJ +*> If JOBV = 'A', then the product of Jacobi rotations in CGESVJ *> is applied to the first MV rows of V. See the description of JOBV. *> \endverbatim *> @@ -199,16 +199,16 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V, LDV .GE. 1. -*> If JOBV .EQ. 'V', then LDV .GE. max(1,N). -*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) . +*> The leading dimension of the array V, LDV >= 1. +*> If JOBV = 'V', then LDV >= max(1,N). +*> If JOBV = 'A', then LDV >= max(1,MV) . *> \endverbatim *> *> \param[in,out] CWORK *> \verbatim *> CWORK is COMPLEX array, dimension (max(1,LWORK)) *> Used as workspace. -*> If on entry LWORK .EQ. -1, then a workspace query is assumed and +*> If on entry LWORK = -1, then a workspace query is assumed and *> no computation is done; CWORK(1) is set to the minial (and optimal) *> length of CWORK. *> \endverbatim @@ -223,7 +223,7 @@ *> \verbatim *> RWORK is REAL array, dimension (max(6,LRWORK)) *> On entry, -*> If JOBU .EQ. 'C' : +*> If JOBU = 'C' : *> RWORK(1) = CTOL, where CTOL defines the threshold for convergence. *> The process stops if all columns of A are mutually *> orthogonal up to CTOL*EPS, EPS=SLAMCH('E'). @@ -243,11 +243,11 @@ *> RWORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep. *> This is useful information in cases when CGESVJ did *> not converge, as it can be used to estimate whether -*> the output is stil useful and for post festum analysis. +*> the output is still useful and for post festum analysis. *> RWORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. -*> If on entry LRWORK .EQ. -1, then a workspace query is assumed and +*> If on entry LRWORK = -1, then a workspace query is assumed and *> no computation is done; RWORK(1) is set to the minial (and optimal) *> length of RWORK. *> \endverbatim @@ -261,9 +261,9 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value -*> > 0 : CGESVJ did not converge in the maximal allowed number +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value +*> > 0: CGESVJ did not converge in the maximal allowed number *> (NSWEEP=30) of sweeps. The output may still be useful. *> See the description of RWORK. *> \endverbatim diff --git a/lapack-netlib/SRC/cgesvxx.f b/lapack-netlib/SRC/cgesvxx.f index 30d1beb33..383e4d011 100644 --- a/lapack-netlib/SRC/cgesvxx.f +++ b/lapack-netlib/SRC/cgesvxx.f @@ -411,7 +411,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -447,14 +447,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -462,9 +462,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cgetsls.f b/lapack-netlib/SRC/cgetsls.f index e7c5d8120..3d783be66 100644 --- a/lapack-netlib/SRC/cgetsls.f +++ b/lapack-netlib/SRC/cgetsls.f @@ -1,3 +1,5 @@ +*> \brief \b CGETSLS +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/cggesx.f b/lapack-netlib/SRC/cggesx.f index 74169ff80..acc4eda36 100644 --- a/lapack-netlib/SRC/cggesx.f +++ b/lapack-netlib/SRC/cggesx.f @@ -120,10 +120,10 @@ *> \verbatim *> SENSE is CHARACTER*1 *> Determines which reciprocal condition numbers are computed. -*> = 'N' : None are computed; -*> = 'E' : Computed for average of selected eigenvalues only; -*> = 'V' : Computed for selected deflating subspaces only; -*> = 'B' : Computed for both. +*> = 'N': None are computed; +*> = 'E': Computed for average of selected eigenvalues only; +*> = 'V': Computed for selected deflating subspaces only; +*> = 'B': Computed for both. *> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'. *> \endverbatim *> diff --git a/lapack-netlib/SRC/cgsvj0.f b/lapack-netlib/SRC/cgsvj0.f index 80e67a06e..810df3367 100644 --- a/lapack-netlib/SRC/cgsvj0.f +++ b/lapack-netlib/SRC/cgsvj0.f @@ -117,7 +117,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -125,9 +125,9 @@ *> \param[in,out] V *> \verbatim *> V is COMPLEX array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -136,8 +136,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -157,7 +157,7 @@ *> TOL is REAL *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -175,14 +175,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/cgsvj1.f b/lapack-netlib/SRC/cgsvj1.f index bebcd5c45..06b417cf2 100644 --- a/lapack-netlib/SRC/cgsvj1.f +++ b/lapack-netlib/SRC/cgsvj1.f @@ -61,7 +61,7 @@ *> In terms of the columns of A, the first N1 columns are rotated 'against' *> the remaining N-N1 columns, trying to increase the angle between the *> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is -*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter. +*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parameter. *> The number of sweeps is given in NSWEEP and the orthogonality threshold *> is given in TOL. *> \endverbatim @@ -147,7 +147,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -155,9 +155,9 @@ *> \param[in,out] V *> \verbatim *> V is COMPLEX array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -166,8 +166,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -187,7 +187,7 @@ *> TOL is REAL *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -205,14 +205,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/chb2st_kernels.f b/lapack-netlib/SRC/chb2st_kernels.f index 25c9ab717..01ea217bb 100644 --- a/lapack-netlib/SRC/chb2st_kernels.f +++ b/lapack-netlib/SRC/chb2st_kernels.f @@ -1,26 +1,26 @@ *> \brief \b CHB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> c, Wed Dec 7 08:22:40 2016 -* +* * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download CHB2ST_KERNELS + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download CHB2ST_KERNELS + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, +* SUBROUTINE CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, * ST, ED, SWEEP, N, NB, IB, * A, LDA, V, TAU, LDVT, WORK) * @@ -32,9 +32,9 @@ * INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. -* COMPLEX A( LDA, * ), V( * ), +* COMPLEX A( LDA, * ), V( * ), * TAU( * ), WORK( * ) -* +* *> \par Purpose: * ============= *> @@ -124,7 +124,7 @@ *> LDVT is INTEGER. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array. Workspace of size nb. *> \endverbatim @@ -147,7 +147,7 @@ *> http://doi.acm.org/10.1145/2063384.2063394 *> *> A. Haidar, J. Kurzak, P. Luszczek, 2013. -*> An improved parallel singular value algorithm and its implementation +*> An improved parallel singular value algorithm and its implementation *> for multicore hardware, In Proceedings of 2013 International Conference *> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> Denver, Colorado, USA, 2013. @@ -155,16 +155,16 @@ *> http://doi.acm.org/10.1145/2503210.2503292 *> *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. -*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure +*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> calculations based on fine-grained memory aware tasks. *> International Journal of High Performance Computing Applications. *> Volume 28 Issue 2, Pages 196-209, May 2014. -*> http://hpc.sagepub.com/content/28/2/196 +*> http://hpc.sagepub.com/content/28/2/196 *> *> \endverbatim *> * ===================================================================== - SUBROUTINE CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, + SUBROUTINE CHB2ST_KERNELS( UPLO, WANTZ, TTYPE, $ ST, ED, SWEEP, N, NB, IB, $ A, LDA, V, TAU, LDVT, WORK) * @@ -181,7 +181,7 @@ INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. - COMPLEX A( LDA, * ), V( * ), + COMPLEX A( LDA, * ), V( * ), $ TAU( * ), WORK( * ) * .. * @@ -195,8 +195,8 @@ * .. Local Scalars .. LOGICAL UPPER INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS, - $ DPOS, OFDPOS, AJETER - COMPLEX CTMP + $ DPOS, OFDPOS, AJETER + COMPLEX CTMP * .. * .. External Subroutines .. EXTERNAL CLARFG, CLARFX, CLARFY @@ -209,7 +209,7 @@ * .. * .. * .. Executable Statements .. -* +* AJETER = IB + LDVT UPPER = LSAME( UPLO, 'U' ) @@ -240,10 +240,10 @@ V( VPOS ) = ONE DO 10 I = 1, LM-1 V( VPOS+I ) = CONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO + A( OFDPOS-I, ST+I ) = ZERO 10 CONTINUE CTMP = CONJG( A( OFDPOS, ST ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) A( OFDPOS, ST ) = CTMP * @@ -281,14 +281,14 @@ * V( VPOS ) = ONE DO 30 I = 1, LM-1 - V( VPOS+I ) = + V( VPOS+I ) = $ CONJG( A( DPOS-NB-I, J1+I ) ) A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = CONJG( A( DPOS-NB, J1 ) ) CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP -* +* CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), $ TAU( TAUPOS ), $ A( DPOS-NB+1, J1 ), LDA-1, WORK) @@ -296,9 +296,9 @@ ENDIF * * Lower case -* +* ELSE -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -313,9 +313,9 @@ V( VPOS ) = ONE DO 20 I = 1, LM-1 V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO + A( OFDPOS+I, ST-1 ) = ZERO 20 CONTINUE - CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * LM = ED - ST + 1 @@ -342,7 +342,7 @@ LM = J2-J1+1 * IF( LM.GT.0) THEN - CALL CLARFX( 'Right', LM, LN, V( VPOS ), + CALL CLARFX( 'Right', LM, LN, V( VPOS ), $ TAU( TAUPOS ), A( DPOS+NB, ST ), $ LDA-1, WORK) * @@ -359,13 +359,13 @@ V( VPOS+I ) = A( DPOS+NB+I, ST ) A( DPOS+NB+I, ST ) = ZERO 40 CONTINUE - CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * - CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), + CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), $ CONJG( TAU( TAUPOS ) ), $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) - + ENDIF ENDIF ENDIF @@ -374,4 +374,4 @@ * * END OF CHB2ST_KERNELS * - END + END diff --git a/lapack-netlib/SRC/checon_3.f b/lapack-netlib/SRC/checon_3.f index 6427dd594..5d9ed97e9 100644 --- a/lapack-netlib/SRC/checon_3.f +++ b/lapack-netlib/SRC/checon_3.f @@ -19,7 +19,7 @@ * =========== * * SUBROUTINE CHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, -* WORK, IWORK, INFO ) +* WORK, INFO ) * * .. Scalar Arguments .. * CHARACTER UPLO @@ -27,7 +27,7 @@ * REAL ANORM, RCOND * .. * .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) +* INTEGER IPIV( * ) * COMPLEX A( LDA, * ), E ( * ), WORK( * ) * .. * @@ -129,11 +129,6 @@ *> WORK is COMPLEX array, dimension (2*N) *> \endverbatim *> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> *> \param[out] INFO *> \verbatim *> INFO is INTEGER diff --git a/lapack-netlib/SRC/cheevr.f b/lapack-netlib/SRC/cheevr.f index 0b055baf6..c5deb1166 100644 --- a/lapack-netlib/SRC/cheevr.f +++ b/lapack-netlib/SRC/cheevr.f @@ -210,7 +210,7 @@ *> eigenvalues are computed to high relative accuracy when *> possible in future releases. The current code does not *> make any guarantees about high relative accuracy, but -*> furutre releases will. See J. Barlow and J. Demmel, +*> future releases will. See J. Barlow and J. Demmel, *> "Computing Accurate Eigensystems of Scaled Diagonally *> Dominant Matrices", LAPACK Working Note #7, for a discussion *> of which matrices define their eigenvalues to high relative diff --git a/lapack-netlib/SRC/cheevr_2stage.f b/lapack-netlib/SRC/cheevr_2stage.f index 20a1cb3f3..1489a322e 100644 --- a/lapack-netlib/SRC/cheevr_2stage.f +++ b/lapack-netlib/SRC/cheevr_2stage.f @@ -217,7 +217,7 @@ *> eigenvalues are computed to high relative accuracy when *> possible in future releases. The current code does not *> make any guarantees about high relative accuracy, but -*> furutre releases will. See J. Barlow and J. Demmel, +*> future releases will. See J. Barlow and J. Demmel, *> "Computing Accurate Eigensystems of Scaled Diagonally *> Dominant Matrices", LAPACK Working Note #7, for a discussion *> of which matrices define their eigenvalues to high relative diff --git a/lapack-netlib/SRC/chegs2.f b/lapack-netlib/SRC/chegs2.f index 68d2f6625..55a895fc3 100644 --- a/lapack-netlib/SRC/chegs2.f +++ b/lapack-netlib/SRC/chegs2.f @@ -97,6 +97,7 @@ *> B is COMPLEX array, dimension (LDB,N) *> The triangular factor from the Cholesky factorization of B, *> as returned by CPOTRF. +*> B is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDB diff --git a/lapack-netlib/SRC/chegst.f b/lapack-netlib/SRC/chegst.f index 2f933729c..b3fdff2d5 100644 --- a/lapack-netlib/SRC/chegst.f +++ b/lapack-netlib/SRC/chegst.f @@ -97,6 +97,7 @@ *> B is COMPLEX array, dimension (LDB,N) *> The triangular factor from the Cholesky factorization of B, *> as returned by CPOTRF. +*> B is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDB diff --git a/lapack-netlib/SRC/cherfsx.f b/lapack-netlib/SRC/cherfsx.f index 4ed2c99f7..76cef7cd1 100644 --- a/lapack-netlib/SRC/cherfsx.f +++ b/lapack-netlib/SRC/cherfsx.f @@ -102,7 +102,7 @@ *> \param[in] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular *> part of the matrix A, and the strictly lower triangular *> part of A is not referenced. If UPLO = 'L', the leading @@ -270,7 +270,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -306,14 +306,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -321,9 +321,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/chesv_aa.f b/lapack-netlib/SRC/chesv_aa.f index 470f910bc..b934e624b 100644 --- a/lapack-netlib/SRC/chesv_aa.f +++ b/lapack-netlib/SRC/chesv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or +*> A = U**H * T * U, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is Hermitian and tridiagonal. The factored form @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**H or A = L*T*L**H as computed by +*> factorization A = U**H*T*U or A = L*T*L**H as computed by *> CHETRF_AA. *> \endverbatim *> @@ -230,7 +230,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**H*T*U or A = L*T*L**H. * CALL CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/chesv_aa_2stage.f b/lapack-netlib/SRC/chesv_aa_2stage.f index 05f6b7bb7..ab5786d57 100644 --- a/lapack-netlib/SRC/chesv_aa_2stage.f +++ b/lapack-netlib/SRC/chesv_aa_2stage.f @@ -43,7 +43,7 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or +*> A = U**H * T * U, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is Hermitian and band. The matrix T is @@ -257,7 +257,7 @@ END IF * * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**H*T*U or A = L*T*L**H. * CALL CHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/chesvxx.f b/lapack-netlib/SRC/chesvxx.f index 3f4466d41..c59e72bbf 100644 --- a/lapack-netlib/SRC/chesvxx.f +++ b/lapack-netlib/SRC/chesvxx.f @@ -46,7 +46,7 @@ *> *> CHESVXX uses the diagonal pivoting factorization to compute the *> solution to a complex system of linear equations A * X = B, where -*> A is an N-by-N symmetric matrix and X and B are N-by-NRHS +*> A is an N-by-N Hermitian matrix and X and B are N-by-NRHS *> matrices. *> *> If requested, both normwise and maximum componentwise error bounds @@ -88,7 +88,7 @@ *> A = L * D * L**T, if UPLO = 'L', *> *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and D is symmetric and block diagonal with +*> triangular matrices, and D is Hermitian and block diagonal with *> 1-by-1 and 2-by-2 diagonal blocks. *> *> 3. If some D(i,i)=0, so that D is exactly singular, then the @@ -161,7 +161,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular *> part of the matrix A, and the strictly lower triangular *> part of A is not referenced. If UPLO = 'L', the leading @@ -378,7 +378,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -414,14 +414,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -429,9 +429,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/chetf2_rk.f b/lapack-netlib/SRC/chetf2_rk.f index 38a0ce373..80e2f61b7 100644 --- a/lapack-netlib/SRC/chetf2_rk.f +++ b/lapack-netlib/SRC/chetf2_rk.f @@ -322,7 +322,7 @@ * * Factorize A as U*D*U**H using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -676,7 +676,7 @@ * * Factorize A as L*D*L**H using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/chetrd_2stage.f b/lapack-netlib/SRC/chetrd_2stage.f index e7370a4dd..4575a5e90 100644 --- a/lapack-netlib/SRC/chetrd_2stage.f +++ b/lapack-netlib/SRC/chetrd_2stage.f @@ -123,23 +123,22 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is COMPLEX array, dimension LHOUS2, that -*> store the Householder representation of the stage2 +*> HOUS2 is COMPLEX array, dimension (LHOUS2) +*> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim *> *> \param[in] LHOUS2 *> \verbatim *> LHOUS2 is INTEGER -*> The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension) +*> The dimension of the array HOUS2. *> If LWORK = -1, or LHOUS2=-1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns *> this value as the first entry of the HOUS2 array, and no error *> message related to LHOUS2 is issued by XERBLA. -*> LHOUS2 = MAX(1, dimension) where -*> dimension = 4*N if VECT='N' -*> not available now if VECT='H' +*> If VECT='N', LHOUS2 = max(1, 4*n); +*> if VECT='V', option not yet available. *> \endverbatim *> *> \param[out] WORK @@ -151,7 +150,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> If LWORK = -1, or LHOUS2 = -1, *> then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK array, returns *> this value as the first entry of the WORK array, and no error diff --git a/lapack-netlib/SRC/chetrd_hb2st.F b/lapack-netlib/SRC/chetrd_hb2st.F index 43da45640..a3d8259d3 100644 --- a/lapack-netlib/SRC/chetrd_hb2st.F +++ b/lapack-netlib/SRC/chetrd_hb2st.F @@ -50,9 +50,9 @@ * Arguments: * ========== * -*> \param[in] STAGE +*> \param[in] STAGE1 *> \verbatim -*> STAGE is CHARACTER*1 +*> STAGE1 is CHARACTER*1 *> = 'N': "No": to mention that the stage 1 of the reduction *> from dense to band using the chetrd_he2hb routine *> was not called before this routine to reproduce AB. diff --git a/lapack-netlib/SRC/chetrd_he2hb.f b/lapack-netlib/SRC/chetrd_he2hb.f index e334532fe..e85c1fd01 100644 --- a/lapack-netlib/SRC/chetrd_he2hb.f +++ b/lapack-netlib/SRC/chetrd_he2hb.f @@ -363,7 +363,7 @@ * * * Set the workspace of the triangular matrix T to zero once such a -* way everytime T is generated the upper/lower portion will be always zero +* way every time T is generated the upper/lower portion will be always zero * CALL CLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT ) * diff --git a/lapack-netlib/SRC/chetrf_aa.f b/lapack-netlib/SRC/chetrf_aa.f index 2c5564893..c6f548d42 100644 --- a/lapack-netlib/SRC/chetrf_aa.f +++ b/lapack-netlib/SRC/chetrf_aa.f @@ -37,7 +37,7 @@ *> CHETRF_AA computes the factorization of a complex hermitian matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**H or A = L*T*L**H +*> A = U**H*T*U or A = L*T*L**H *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a hermitian tridiagonal matrix. @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**H using the upper triangle of A +* Factorize A as U**H*D*U using the upper triangle of A * ..................................................... * * copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -376,7 +376,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/chetrf_aa_2stage.f b/lapack-netlib/SRC/chetrf_aa_2stage.f index ce34d73cc..d2e0e0023 100644 --- a/lapack-netlib/SRC/chetrf_aa_2stage.f +++ b/lapack-netlib/SRC/chetrf_aa_2stage.f @@ -38,7 +38,7 @@ *> CHETRF_AA_2STAGE computes the factorization of a real hermitian matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a hermitian band matrix with the @@ -277,7 +277,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -453,14 +453,17 @@ c END IF * > Apply pivots to previous columns of L CALL CSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) THEN + CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) + CALL CLACGV( I2-I1-1, A( I1+1, I2 ), 1 ) + END IF CALL CLACGV( I2-I1, A( I1, I1+1 ), LDA ) - CALL CLACGV( I2-I1-1, A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL CSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL CSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -630,14 +633,17 @@ c END IF * > Apply pivots to previous columns of L CALL CSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) THEN + CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) + CALL CLACGV( I2-I1-1, A( I2, I1+1 ), LDA ) + END IF CALL CLACGV( I2-I1, A( I1+1, I1 ), 1 ) - CALL CLACGV( I2-I1-1, A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL CSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL CSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/chetri2.f b/lapack-netlib/SRC/chetri2.f index 722d13008..1e18202cf 100644 --- a/lapack-netlib/SRC/chetri2.f +++ b/lapack-netlib/SRC/chetri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by CHETRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by CHETRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/chetrs_aa.f b/lapack-netlib/SRC/chetrs_aa.f index 50e5692db..877517031 100644 --- a/lapack-netlib/SRC/chetrs_aa.f +++ b/lapack-netlib/SRC/chetrs_aa.f @@ -37,7 +37,7 @@ *> \verbatim *> *> CHETRS_AA solves a system of linear equations A*X = B with a complex -*> hermitian matrix A using the factorization A = U*T*U**H or +*> hermitian matrix A using the factorization A = U**H*T*U or *> A = L*T*L**H computed by CHETRF_AA. *> \endverbatim * @@ -49,7 +49,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**H; +*> = 'U': Upper triangular, form is A = U**H*T*U; *> = 'L': Lower triangular, form is A = L*T*L**H. *> \endverbatim *> @@ -97,14 +97,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -198,24 +200,31 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**H*T*U. +* +* 1) Forward substitution with U**H +* + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* P**T * B + K = 1 + DO WHILE ( K.LE.N ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K + 1 + END DO * - K = 1 - DO WHILE ( K.LE.N ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K + 1 - END DO +* Compute U**H \ B -> B [ (U**H \P**T * B) ] * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] + CALL CTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL CTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute T \ B -> B [ T \ (U**H \P**T * B) ] * CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN @@ -226,65 +235,82 @@ CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* 3) Backward substitution with U +* + IF( N.GT.1 ) THEN * - CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B(2, 1), LDB) +* Compute U \ B -> B [ U \ (T \ (U**H \P**T * B) ) ] * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] + CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B(2, 1), LDB) * - K = N - DO WHILE ( K.GE.1 ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K - 1 - END DO +* Pivot, P * B -> B [ P * (U \ (T \ (U**H \P**T * B) )) ] +* + K = N + DO WHILE ( K.GE.1 ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K - 1 + END DO + END IF * ELSE * -* Solve A*X = B, where A = L*T*L**T. +* Solve A*X = B, where A = L*T*L**H. * -* Pivot, P**T * B +* 1) Forward substitution with L * - K = 1 - DO WHILE ( K.LE.N ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K + 1 - END DO + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B +* + K = 1 + DO WHILE ( K.LE.N ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K + 1 + END DO * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute L \ B -> B [ (L \P**T * B) ] +* + CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), + $ LDA, B(2, 1), LDB ) + END IF * - CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, - $ B(2, 1), LDB) +* 2) Solve with triangular matrix T * * Compute T \ B -> B [ T \ (L \P**T * B) ] * CALL CLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN - CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1) + CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 1 ), 1 ) CALL CLACPY( 'F', 1, N-1, A( 2, 1 ), LDA+1, WORK( 2*N ), 1) CALL CLACGV( N-1, WORK( 2*N ), 1 ) END IF CALL CGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**H * - CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) + IF( N.GT.1 ) THEN +* +* Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ] * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] + CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB ) * - K = N - DO WHILE ( K.GE.1 ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K - 1 - END DO +* Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ] +* + K = N + DO WHILE ( K.GE.1 ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K - 1 + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/chetrs_aa_2stage.f b/lapack-netlib/SRC/chetrs_aa_2stage.f index 05d09275b..979d80a7c 100644 --- a/lapack-netlib/SRC/chetrs_aa_2stage.f +++ b/lapack-netlib/SRC/chetrs_aa_2stage.f @@ -38,7 +38,7 @@ *> \verbatim *> *> CHETRS_AA_2STAGE solves a system of linear equations A*X = B with a real -*> hermitian matrix A using the factorization A = U*T*U**T or +*> hermitian matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by CHETRF_AA_2STAGE. *> \endverbatim * @@ -50,7 +50,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -210,15 +210,15 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * CALL CTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) diff --git a/lapack-netlib/SRC/chseqr.f b/lapack-netlib/SRC/chseqr.f index 34bf49249..cfcf725b2 100644 --- a/lapack-netlib/SRC/chseqr.f +++ b/lapack-netlib/SRC/chseqr.f @@ -69,7 +69,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -86,7 +86,7 @@ *> set by a previous call to CGEBAL, and then passed to ZGEHRD *> when the matrix output by CGEBAL is reduced to Hessenberg *> form. Otherwise ILO and IHI should be set to 1 and N -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -98,17 +98,17 @@ *> triangular matrix T from the Schur decomposition (the *> Schur form). If INFO = 0 and JOB = 'E', the contents of *> H are unspecified on exit. (The output value of H when -*> INFO.GT.0 is given under the description of INFO below.) +*> INFO > 0 is given under the description of INFO below.) *> *> Unlike earlier versions of CHSEQR, this subroutine may -*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 +*> explicitly H(i,j) = 0 for i > j and j = 1, 2, ... ILO-1 *> or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -131,7 +131,7 @@ *> if INFO = 0, Z contains Q*Z. *> Normally Q is the unitary matrix generated by CUNGHR *> after the call to CGEHRD which formed the Hessenberg matrix -*> H. (The output value of Z when INFO.GT.0 is given under +*> H. (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -139,7 +139,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if COMPZ = 'I' or -*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. +*> COMPZ = 'V', then LDZ >= MAX(1,N). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -152,7 +152,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient and delivers very good and sometimes *> optimal performance. However, LWORK as large as 11*N *> may be required for optimal performance. A workspace @@ -170,21 +170,21 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .LT. 0: if INFO = -i, the i-th argument had an illegal +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal *> value -*> .GT. 0: if INFO = i, CHSEQR failed to compute all of -*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR -*> and WI contain those eigenvalues which have been +*> > 0: if INFO = i, CHSEQR failed to compute all of +*> the eigenvalues. Elements 1:ilo-1 and i+1:n of W +*> contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and JOB = 'E', then on exit, the +*> If INFO > 0 and JOB = 'E', then on exit, the *> remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and JOB = 'S', then on exit +*> If INFO > 0 and JOB = 'S', then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -192,19 +192,19 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and COMPZ = 'V', then on exit +*> If INFO > 0 and COMPZ = 'V', then on exit *> *> (final value of Z) = (initial value of Z)*U *> *> where U is the unitary matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'I', then on exit +*> If INFO > 0 and COMPZ = 'I', then on exit *> (final value of Z) = U *> where U is the unitary matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'N', then Z is not +*> If INFO > 0 and COMPZ = 'N', then Z is not *> accessed. *> \endverbatim * @@ -244,8 +244,8 @@ *> This depends on ILO, IHI and NS. NS is the *> number of simultaneous shifts returned *> by ILAENV(ISPEC=15). (See ISPEC=15 below.) -*> The default for (IHI-ILO+1).LE.500 is NS. -*> The default for (IHI-ILO+1).GT.500 is 3*NS/2. +*> The default for (IHI-ILO+1) <= 500 is NS. +*> The default for (IHI-ILO+1) > 500 is 3*NS/2. *> *> ISPEC=14: Nibble crossover point. (See IPARMQ for *> details.) Default: 14% of deflation window @@ -323,8 +323,8 @@ PARAMETER ( NTINY = 11 ) * * ==== NL allocates some local workspace to help small matrices -* . through a rare CLAHQR failure. NL .GT. NTINY = 11 is -* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- +* . through a rare CLAHQR failure. NL > NTINY = 11 is +* . required and NL <= NMIN = ILAENV(ISPEC=12,...) is recom- * . mended. (The default value of NMIN is 75.) Using NL = 49 * . allows up to six simultaneous shifts and a 16-by-16 * . deflation window. ==== diff --git a/lapack-netlib/SRC/cla_gbrcond_c.f b/lapack-netlib/SRC/cla_gbrcond_c.f index 123aee26e..c382ac210 100644 --- a/lapack-netlib/SRC/cla_gbrcond_c.f +++ b/lapack-netlib/SRC/cla_gbrcond_c.f @@ -132,13 +132,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_gbrcond_x.f b/lapack-netlib/SRC/cla_gbrcond_x.f index d04aa7fb8..46991ea14 100644 --- a/lapack-netlib/SRC/cla_gbrcond_x.f +++ b/lapack-netlib/SRC/cla_gbrcond_x.f @@ -125,13 +125,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_gbrfsx_extended.f b/lapack-netlib/SRC/cla_gbrfsx_extended.f index 888ecd4f7..9f066137b 100644 --- a/lapack-netlib/SRC/cla_gbrfsx_extended.f +++ b/lapack-netlib/SRC/cla_gbrfsx_extended.f @@ -65,19 +65,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -269,7 +269,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/cla_gercond_c.f b/lapack-netlib/SRC/cla_gercond_c.f index aabdc0bb9..1a2e8230e 100644 --- a/lapack-netlib/SRC/cla_gercond_c.f +++ b/lapack-netlib/SRC/cla_gercond_c.f @@ -21,7 +21,7 @@ * REAL FUNCTION CLA_GERCOND_C( TRANS, N, A, LDA, AF, LDAF, IPIV, C, * CAPPLY, INFO, WORK, RWORK ) * -* .. Scalar Aguments .. +* .. Scalar Arguments .. * CHARACTER TRANS * LOGICAL CAPPLY * INTEGER N, LDA, LDAF, INFO @@ -114,13 +114,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. @@ -147,7 +147,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * -* .. Scalar Aguments .. +* .. Scalar Arguments .. CHARACTER TRANS LOGICAL CAPPLY INTEGER N, LDA, LDAF, INFO diff --git a/lapack-netlib/SRC/cla_gercond_x.f b/lapack-netlib/SRC/cla_gercond_x.f index 6dce99f62..46e9b039f 100644 --- a/lapack-netlib/SRC/cla_gercond_x.f +++ b/lapack-netlib/SRC/cla_gercond_x.f @@ -107,13 +107,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_gerfsx_extended.f b/lapack-netlib/SRC/cla_gerfsx_extended.f index 2e0596334..d231733e6 100644 --- a/lapack-netlib/SRC/cla_gerfsx_extended.f +++ b/lapack-netlib/SRC/cla_gerfsx_extended.f @@ -65,19 +65,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -257,7 +257,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERRS_C is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERRS_C is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERRS_C(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/cla_hercond_c.f b/lapack-netlib/SRC/cla_hercond_c.f index a5ebaf8a2..5f26822af 100644 --- a/lapack-netlib/SRC/cla_hercond_c.f +++ b/lapack-netlib/SRC/cla_hercond_c.f @@ -110,13 +110,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_hercond_x.f b/lapack-netlib/SRC/cla_hercond_x.f index f0004102f..91c80a668 100644 --- a/lapack-netlib/SRC/cla_hercond_x.f +++ b/lapack-netlib/SRC/cla_hercond_x.f @@ -103,13 +103,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_herfsx_extended.f b/lapack-netlib/SRC/cla_herfsx_extended.f index c69589dfa..d1aa8462c 100644 --- a/lapack-netlib/SRC/cla_herfsx_extended.f +++ b/lapack-netlib/SRC/cla_herfsx_extended.f @@ -66,11 +66,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -254,7 +254,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/cla_porcond_c.f b/lapack-netlib/SRC/cla_porcond_c.f index 7a2bcfe63..c2356590f 100644 --- a/lapack-netlib/SRC/cla_porcond_c.f +++ b/lapack-netlib/SRC/cla_porcond_c.f @@ -102,13 +102,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_porcond_x.f b/lapack-netlib/SRC/cla_porcond_x.f index f0844ec89..a5ff3aa61 100644 --- a/lapack-netlib/SRC/cla_porcond_x.f +++ b/lapack-netlib/SRC/cla_porcond_x.f @@ -95,13 +95,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_porfsx_extended.f b/lapack-netlib/SRC/cla_porfsx_extended.f index 3a3409c9e..545bdc445 100644 --- a/lapack-netlib/SRC/cla_porfsx_extended.f +++ b/lapack-netlib/SRC/cla_porfsx_extended.f @@ -65,11 +65,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -246,7 +246,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/cla_porpvgrw.f b/lapack-netlib/SRC/cla_porpvgrw.f index bd2e7af1c..f10299c5a 100644 --- a/lapack-netlib/SRC/cla_porpvgrw.f +++ b/lapack-netlib/SRC/cla_porpvgrw.f @@ -85,7 +85,7 @@ *> The leading dimension of the array AF. LDAF >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/cla_syrcond_c.f b/lapack-netlib/SRC/cla_syrcond_c.f index fc52bf23b..e59e83aa6 100644 --- a/lapack-netlib/SRC/cla_syrcond_c.f +++ b/lapack-netlib/SRC/cla_syrcond_c.f @@ -110,13 +110,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_syrcond_x.f b/lapack-netlib/SRC/cla_syrcond_x.f index f8fb566e7..3edf58f83 100644 --- a/lapack-netlib/SRC/cla_syrcond_x.f +++ b/lapack-netlib/SRC/cla_syrcond_x.f @@ -103,13 +103,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/cla_syrfsx_extended.f b/lapack-netlib/SRC/cla_syrfsx_extended.f index 5d2fa0cbb..92243abcb 100644 --- a/lapack-netlib/SRC/cla_syrfsx_extended.f +++ b/lapack-netlib/SRC/cla_syrfsx_extended.f @@ -66,11 +66,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -254,7 +254,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/cla_syrpvgrw.f b/lapack-netlib/SRC/cla_syrpvgrw.f index ccea462c7..15e55ea7d 100644 --- a/lapack-netlib/SRC/cla_syrpvgrw.f +++ b/lapack-netlib/SRC/cla_syrpvgrw.f @@ -102,7 +102,7 @@ *> as determined by CSYTRF. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/cla_wwaddw.f b/lapack-netlib/SRC/cla_wwaddw.f index 9267c6df2..08e45ac79 100644 --- a/lapack-netlib/SRC/cla_wwaddw.f +++ b/lapack-netlib/SRC/cla_wwaddw.f @@ -36,7 +36,7 @@ *> CLA_WWADDW adds a vector W into a doubled-single vector (X, Y). *> *> This works for all extant IBM's hex and binary floating point -*> arithmetics, but not for decimal. +*> arithmetic, but not for decimal. *> \endverbatim * * Arguments: diff --git a/lapack-netlib/SRC/clahef_aa.f b/lapack-netlib/SRC/clahef_aa.f index 88bc3d216..934aa92f9 100644 --- a/lapack-netlib/SRC/clahef_aa.f +++ b/lapack-netlib/SRC/clahef_aa.f @@ -288,8 +288,9 @@ * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -329,13 +330,15 @@ * Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -440,8 +443,9 @@ * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -481,13 +485,15 @@ * Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/clahef_rk.f b/lapack-netlib/SRC/clahef_rk.f index 4d9dfbe8e..cc4603e9b 100644 --- a/lapack-netlib/SRC/clahef_rk.f +++ b/lapack-netlib/SRC/clahef_rk.f @@ -331,7 +331,7 @@ * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 (note that conjg(W) is actually stored) * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -789,7 +789,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 (note that conjg(W) is actually stored) * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/clahqr.f b/lapack-netlib/SRC/clahqr.f index de2b3938b..ef50b5a56 100644 --- a/lapack-netlib/SRC/clahqr.f +++ b/lapack-netlib/SRC/clahqr.f @@ -138,26 +138,26 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, CLAHQR failed to compute all the +*> = 0: successful exit +*> > 0: if INFO = i, CLAHQR failed to compute all the *> eigenvalues ILO to IHI in a total of 30 iterations *> per eigenvalue; elements i+1:ihi of W contain *> those eigenvalues which have been successfully *> computed. *> -*> If INFO .GT. 0 and WANTT is .FALSE., then on exit, +*> If INFO > 0 and WANTT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the *> eigenvalues of the upper Hessenberg matrix -*> rows and columns ILO thorugh INFO of the final, +*> rows and columns ILO through INFO of the final, *> output value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> (*) (initial value of H)*U = U*(final value of H) -*> where U is an orthognal matrix. The final +*> where U is an orthogonal matrix. The final *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> (final value of Z) = (initial value of Z)*U *> where U is the orthogonal matrix in (*) *> (regardless of the value of WANTT.) diff --git a/lapack-netlib/SRC/clamswlq.f b/lapack-netlib/SRC/clamswlq.f index f2f9ab7f9..f6909b666 100644 --- a/lapack-netlib/SRC/clamswlq.f +++ b/lapack-netlib/SRC/clamswlq.f @@ -1,3 +1,4 @@ +*> \brief \b CLAMSWLQ * * Definition: * =========== diff --git a/lapack-netlib/SRC/clamtsqr.f b/lapack-netlib/SRC/clamtsqr.f index 77d09a573..c71e4aa7d 100644 --- a/lapack-netlib/SRC/clamtsqr.f +++ b/lapack-netlib/SRC/clamtsqr.f @@ -1,3 +1,4 @@ +*> \brief \b CLAMTSQR * * Definition: * =========== diff --git a/lapack-netlib/SRC/clangb.f b/lapack-netlib/SRC/clangb.f index 14a163ea7..9818360fe 100644 --- a/lapack-netlib/SRC/clangb.f +++ b/lapack-netlib/SRC/clangb.f @@ -130,6 +130,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER KL, KU, LDAB, N @@ -147,14 +148,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - REAL SCALE, SUM, VALUE, TEMP + REAL SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -207,15 +211,22 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANGB = VALUE diff --git a/lapack-netlib/SRC/clange.f b/lapack-netlib/SRC/clange.f index 50f705a18..00895c8bc 100644 --- a/lapack-netlib/SRC/clange.f +++ b/lapack-netlib/SRC/clange.f @@ -120,6 +120,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, M, N @@ -137,14 +138,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE, TEMP + REAL SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -196,13 +200,19 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL CLASSQ( M, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANGE = VALUE diff --git a/lapack-netlib/SRC/clanhb.f b/lapack-netlib/SRC/clanhb.f index 2b034b19b..f78de23df 100644 --- a/lapack-netlib/SRC/clanhb.f +++ b/lapack-netlib/SRC/clanhb.f @@ -137,6 +137,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -154,14 +155,17 @@ * .. * .. Local Scalars .. INTEGER I, J, L - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, REAL, SQRT @@ -233,39 +237,57 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 J = 1, N IF( REAL( AB( L, J ) ).NE.ZERO ) THEN ABSA = ABS( REAL( AB( L, J ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANHB = VALUE diff --git a/lapack-netlib/SRC/clanhe.f b/lapack-netlib/SRC/clanhe.f index 101d778eb..33d6c8b01 100644 --- a/lapack-netlib/SRC/clanhe.f +++ b/lapack-netlib/SRC/clanhe.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -146,14 +147,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, SQRT @@ -223,31 +227,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J-1, A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J, A( J+1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* DO 130 I = 1, N IF( REAL( A( I, I ) ).NE.ZERO ) THEN ABSA = ABS( REAL( A( I, I ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( SSQ( 1 ).LT.ABSA ) THEN + SSQ( 2 ) = ONE + SSQ( 2 )*( SSQ( 1 ) / ABSA )**2 + SSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + SSQ( 2 ) = SSQ( 2 ) + ( ABSA / SSQ( 1 ) )**2 END IF END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANHE = VALUE diff --git a/lapack-netlib/SRC/clanhp.f b/lapack-netlib/SRC/clanhp.f index c8927d503..e0e23abc7 100644 --- a/lapack-netlib/SRC/clanhp.f +++ b/lapack-netlib/SRC/clanhp.f @@ -122,6 +122,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -139,14 +140,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, SQRT @@ -225,31 +229,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( REAL( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( REAL( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -258,7 +279,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANHP = VALUE diff --git a/lapack-netlib/SRC/clanhs.f b/lapack-netlib/SRC/clanhs.f index 35623b73d..661b4f901 100644 --- a/lapack-netlib/SRC/clanhs.f +++ b/lapack-netlib/SRC/clanhs.f @@ -114,6 +114,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, N @@ -131,14 +132,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -190,13 +194,20 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL CLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N, J+1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANHS = VALUE diff --git a/lapack-netlib/SRC/clansb.f b/lapack-netlib/SRC/clansb.f index fbc50674c..1085fd880 100644 --- a/lapack-netlib/SRC/clansb.f +++ b/lapack-netlib/SRC/clansb.f @@ -135,6 +135,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -152,14 +153,17 @@ * .. * .. Local Scalars .. INTEGER I, J, L - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -227,29 +231,47 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF - CALL CLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N, AB( L, 1 ), LDAB, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANSB = VALUE diff --git a/lapack-netlib/SRC/clansp.f b/lapack-netlib/SRC/clansp.f index fd64366c6..628dc0a75 100644 --- a/lapack-netlib/SRC/clansp.f +++ b/lapack-netlib/SRC/clansp.f @@ -120,6 +120,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -137,14 +138,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, REAL, SQRT @@ -219,40 +223,57 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( REAL( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( REAL( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( AIMAG( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( AIMAG( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -261,7 +282,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANSP = VALUE diff --git a/lapack-netlib/SRC/clansy.f b/lapack-netlib/SRC/clansy.f index 3aa787410..537fb7ba9 100644 --- a/lapack-netlib/SRC/clansy.f +++ b/lapack-netlib/SRC/clansy.f @@ -128,6 +128,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -145,14 +146,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -218,21 +222,39 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL CLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL CLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM - CALL CLASSQ( N, A, LDA+1, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANSY = VALUE diff --git a/lapack-netlib/SRC/clantb.f b/lapack-netlib/SRC/clantb.f index 4b4361c79..8066d0ef6 100644 --- a/lapack-netlib/SRC/clantb.f +++ b/lapack-netlib/SRC/clantb.f @@ -146,6 +146,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER K, LDAB, N @@ -164,14 +165,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, L - REAL SCALE, SUM, VALUE + REAL SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -313,46 +317,61 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 280 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL CLASSQ( MIN( J-1, K ), - $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, - $ SUM ) + $ AB( MAX( K+2-J, 1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 280 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 290 J = 1, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 310 J = 1, N - CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANTB = VALUE diff --git a/lapack-netlib/SRC/clantp.f b/lapack-netlib/SRC/clantp.f index 148ac5436..b0c48eb46 100644 --- a/lapack-netlib/SRC/clantp.f +++ b/lapack-netlib/SRC/clantp.f @@ -130,6 +130,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER N @@ -148,14 +149,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, K - REAL SCALE, SUM, VALUE + REAL SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -308,45 +312,64 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 280 J = 2, N - CALL CLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J-1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 280 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 290 J = 1, N - CALL CLASSQ( J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 300 J = 1, N - 1 - CALL CLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 300 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 310 J = 1, N - CALL CLASSQ( N-J+1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( N-J+1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANTP = VALUE diff --git a/lapack-netlib/SRC/clantr.f b/lapack-netlib/SRC/clantr.f index 4e1843d3d..3b361cc97 100644 --- a/lapack-netlib/SRC/clantr.f +++ b/lapack-netlib/SRC/clantr.f @@ -147,6 +147,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER LDA, M, N @@ -165,14 +166,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SUM, VALUE +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. - EXTERNAL CLASSQ + EXTERNAL CLASSQ, SCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -283,7 +287,7 @@ END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - DO 210 I = 1, N + DO 210 I = 1, MIN( M, N ) WORK( I ) = ONE 210 CONTINUE DO 220 I = N + 1, M @@ -313,38 +317,56 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 290 J = 2, N - CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 300 J = 1, N - CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 310 J = 1, N - CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 320 J = 1, N - CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL CLASSQ( M-J+1, A( J, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 320 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * CLANTR = VALUE diff --git a/lapack-netlib/SRC/claqps.f b/lapack-netlib/SRC/claqps.f index f47e852a0..d0b7efcd5 100644 --- a/lapack-netlib/SRC/claqps.f +++ b/lapack-netlib/SRC/claqps.f @@ -127,7 +127,7 @@ *> \param[in,out] AUXV *> \verbatim *> AUXV is COMPLEX array, dimension (NB) -*> Auxiliar vector. +*> Auxiliary vector. *> \endverbatim *> *> \param[in,out] F diff --git a/lapack-netlib/SRC/claqr0.f b/lapack-netlib/SRC/claqr0.f index b61c9f1e9..2f0ea20db 100644 --- a/lapack-netlib/SRC/claqr0.f +++ b/lapack-netlib/SRC/claqr0.f @@ -66,7 +66,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -78,12 +78,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to CGEBAL, and then passed to CGEHRD when the *> matrix output by CGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -95,17 +95,17 @@ *> contains the upper triangular matrix T from the Schur *> decomposition (the Schur form). If INFO = 0 and WANT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -127,7 +127,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -137,7 +137,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -145,7 +145,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -158,7 +158,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -174,19 +174,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, CLAQR0 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, CLAQR0 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -194,7 +194,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -202,7 +202,7 @@ *> where U is the unitary matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -639,7 +639,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/claqr1.f b/lapack-netlib/SRC/claqr1.f index 977947196..87d53871a 100644 --- a/lapack-netlib/SRC/claqr1.f +++ b/lapack-netlib/SRC/claqr1.f @@ -64,7 +64,7 @@ *> \verbatim *> LDH is INTEGER *> The leading dimension of H as declared in -*> the calling procedure. LDH.GE.N +*> the calling procedure. LDH >= N *> \endverbatim *> *> \param[in] S1 diff --git a/lapack-netlib/SRC/claqr2.f b/lapack-netlib/SRC/claqr2.f index 03e9760cf..fc282b2d6 100644 --- a/lapack-netlib/SRC/claqr2.f +++ b/lapack-netlib/SRC/claqr2.f @@ -102,7 +102,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -120,7 +120,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -132,7 +132,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -148,7 +148,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -185,13 +185,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -203,14 +203,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -222,7 +222,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/claqr3.f b/lapack-netlib/SRC/claqr3.f index 660a58376..84d57d4d6 100644 --- a/lapack-netlib/SRC/claqr3.f +++ b/lapack-netlib/SRC/claqr3.f @@ -99,7 +99,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -117,7 +117,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -129,7 +129,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -145,7 +145,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -182,13 +182,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -200,14 +200,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -219,7 +219,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/claqr4.f b/lapack-netlib/SRC/claqr4.f index 647fa6774..fba286df7 100644 --- a/lapack-netlib/SRC/claqr4.f +++ b/lapack-netlib/SRC/claqr4.f @@ -74,7 +74,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -86,12 +86,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to CGEBAL, and then passed to CGEHRD when the *> matrix output by CGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -103,17 +103,17 @@ *> contains the upper triangular matrix T from the Schur *> decomposition (the Schur form). If INFO = 0 and WANT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -135,7 +135,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -145,7 +145,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -153,7 +153,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -166,7 +166,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -182,19 +182,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, CLAQR4 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, CLAQR4 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -202,7 +202,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -210,7 +210,7 @@ *> where U is the unitary matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -643,7 +643,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/claqr5.f b/lapack-netlib/SRC/claqr5.f index 4c897895d..e4317a3ad 100644 --- a/lapack-netlib/SRC/claqr5.f +++ b/lapack-netlib/SRC/claqr5.f @@ -125,7 +125,7 @@ *> \verbatim *> LDH is INTEGER *> LDH is the leading dimension of H just as declared in the -*> calling procedure. LDH.GE.MAX(1,N). +*> calling procedure. LDH >= MAX(1,N). *> \endverbatim *> *> \param[in] ILOZ @@ -137,7 +137,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N *> \endverbatim *> *> \param[in,out] Z @@ -153,7 +153,7 @@ *> \verbatim *> LDZ is INTEGER *> LDA is the leading dimension of Z just as declared in -*> the calling procedure. LDZ.GE.N. +*> the calling procedure. LDZ >= N. *> \endverbatim *> *> \param[out] V @@ -165,7 +165,7 @@ *> \verbatim *> LDV is INTEGER *> LDV is the leading dimension of V as declared in the -*> calling procedure. LDV.GE.3. +*> calling procedure. LDV >= 3. *> \endverbatim *> *> \param[out] U @@ -177,33 +177,14 @@ *> \verbatim *> LDU is INTEGER *> LDU is the leading dimension of U just as declared in the -*> in the calling subroutine. LDU.GE.3*NSHFTS-3. -*> \endverbatim -*> -*> \param[in] NH -*> \verbatim -*> NH is INTEGER -*> NH is the number of columns in array WH available for -*> workspace. NH.GE.1. -*> \endverbatim -*> -*> \param[out] WH -*> \verbatim -*> WH is COMPLEX array, dimension (LDWH,NH) -*> \endverbatim -*> -*> \param[in] LDWH -*> \verbatim -*> LDWH is INTEGER -*> Leading dimension of WH just as declared in the -*> calling procedure. LDWH.GE.3*NSHFTS-3. +*> in the calling subroutine. LDU >= 3*NSHFTS-3. *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> NV is the number of rows in WV agailable for workspace. -*> NV.GE.1. +*> NV >= 1. *> \endverbatim *> *> \param[out] WV @@ -215,9 +196,28 @@ *> \verbatim *> LDWV is INTEGER *> LDWV is the leading dimension of WV as declared in the -*> in the calling subroutine. LDWV.GE.NV. +*> in the calling subroutine. LDWV >= NV. *> \endverbatim * +*> \param[in] NH +*> \verbatim +*> NH is INTEGER +*> NH is the number of columns in array WH available for +*> workspace. NH >= 1. +*> \endverbatim +*> +*> \param[out] WH +*> \verbatim +*> WH is COMPLEX array, dimension (LDWH,NH) +*> \endverbatim +*> +*> \param[in] LDWH +*> \verbatim +*> LDWH is INTEGER +*> Leading dimension of WH just as declared in the +*> calling procedure. LDWH >= 3*NSHFTS-3. +*> \endverbatim +*> * Authors: * ======== * diff --git a/lapack-netlib/SRC/clarfb.f b/lapack-netlib/SRC/clarfb.f index 8fdd5c89c..a4d429c09 100644 --- a/lapack-netlib/SRC/clarfb.f +++ b/lapack-netlib/SRC/clarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V diff --git a/lapack-netlib/SRC/clarfx.f b/lapack-netlib/SRC/clarfx.f index 1111c80f7..ad284883d 100644 --- a/lapack-netlib/SRC/clarfx.f +++ b/lapack-netlib/SRC/clarfx.f @@ -94,7 +94,7 @@ *> \param[in] LDC *> \verbatim *> LDC is INTEGER -*> The leading dimension of the array C. LDA >= max(1,M). +*> The leading dimension of the array C. LDC >= max(1,M). *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/clarfy.f b/lapack-netlib/SRC/clarfy.f index a5743858c..fccd136a8 100644 --- a/lapack-netlib/SRC/clarfy.f +++ b/lapack-netlib/SRC/clarfy.f @@ -103,7 +103,7 @@ * *> \date December 2016 * -*> \ingroup complex_eig +*> \ingroup complexOTHERauxiliary * * ===================================================================== SUBROUTINE CLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK ) diff --git a/lapack-netlib/SRC/clarrv.f b/lapack-netlib/SRC/clarrv.f index 72fe1f948..a45f55ac3 100644 --- a/lapack-netlib/SRC/clarrv.f +++ b/lapack-netlib/SRC/clarrv.f @@ -143,7 +143,7 @@ *> RTOL2 is REAL *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in,out] W diff --git a/lapack-netlib/SRC/classq.f b/lapack-netlib/SRC/classq.f index 28398596f..92e407ff3 100644 --- a/lapack-netlib/SRC/classq.f +++ b/lapack-netlib/SRC/classq.f @@ -41,7 +41,7 @@ *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is *> assumed to be at least unity and the value of ssq will then satisfy *> -*> 1.0 .le. ssq .le. ( sumsq + 2*n ). +*> 1.0 <= ssq <= ( sumsq + 2*n ). *> *> scale is assumed to be non-negative and scl returns the value *> @@ -65,7 +65,7 @@ *> *> \param[in] X *> \verbatim -*> X is COMPLEX array, dimension (N) +*> X is COMPLEX array, dimension (1+(N-1)*INCX) *> The vector x as described above. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. *> \endverbatim diff --git a/lapack-netlib/SRC/claswlq.f b/lapack-netlib/SRC/claswlq.f index 5fa2276e8..dcbdc0d52 100644 --- a/lapack-netlib/SRC/claswlq.f +++ b/lapack-netlib/SRC/claswlq.f @@ -1,3 +1,4 @@ +*> \brief \b CLASWLQ * * Definition: * =========== @@ -18,9 +19,20 @@ *> *> \verbatim *> -*> CLASWLQ computes a blocked Short-Wide LQ factorization of a -*> M-by-N matrix A, where N >= M: -*> A = L * Q +*> CLASWLQ computes a blocked Tall-Skinny LQ factorization of +*> a complex M-by-N matrix A for M <= N: +*> +*> A = ( L 0 ) * Q, +*> +*> where: +*> +*> Q is a n-by-N orthogonal matrix, stored on exit in an implicit +*> form in the elements above the digonal of the array A and in +*> the elemenst of the array T; +*> L is an lower-triangular M-by-M matrix stored on exit in +*> the elements on and below the diagonal of the array A. +*> 0 is a M-by-(N-M) zero matrix, if M < N, and is not stored. +*> *> \endverbatim * * Arguments: @@ -150,7 +162,7 @@ SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * June 2017 diff --git a/lapack-netlib/SRC/clasyf_aa.f b/lapack-netlib/SRC/clasyf_aa.f index 1bc96ee1b..a44a8f5b1 100644 --- a/lapack-netlib/SRC/clasyf_aa.f +++ b/lapack-netlib/SRC/clasyf_aa.f @@ -84,7 +84,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is REAL array, dimension (LDA,M) for +*> A is COMPLEX array, dimension (LDA,M) for *> the first panel, while dimension (LDA,M+1) for the *> remaining panels. *> @@ -112,7 +112,7 @@ *> *> \param[in,out] H *> \verbatim -*> H is REAL workspace, dimension (LDH,NB). +*> H is COMPLEX workspace, dimension (LDH,NB). *> *> \endverbatim *> @@ -124,7 +124,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL workspace, dimension (M). +*> WORK is COMPLEX workspace, dimension (M). *> \endverbatim *> * @@ -284,8 +284,9 @@ * * Swap A(I1, I2+1:M) with A(I2, I2+1:M) * - CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -325,13 +326,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -432,8 +435,9 @@ * * Swap A(I2+1:M, I1) with A(I2+1:M, I2) * - CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -473,13 +477,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/clasyf_rk.f b/lapack-netlib/SRC/clasyf_rk.f index 0700c5cc2..bd7a0fb45 100644 --- a/lapack-netlib/SRC/clasyf_rk.f +++ b/lapack-netlib/SRC/clasyf_rk.f @@ -330,7 +330,7 @@ * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -658,7 +658,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/clatdf.f b/lapack-netlib/SRC/clatdf.f index 357f66422..557830d1c 100644 --- a/lapack-netlib/SRC/clatdf.f +++ b/lapack-netlib/SRC/clatdf.f @@ -261,7 +261,7 @@ * * Solve for U- part, lockahead for RHS(N) = +-1. This is not done * In BSOLVE and will hopefully give us a better estimate because -* any ill-conditioning of the original matrix is transfered to U +* any ill-conditioning of the original matrix is transferred to U * and not to L. U(N, N) is an approximation to sigma_min(LU). * CALL CCOPY( N-1, RHS, 1, WORK, 1 ) diff --git a/lapack-netlib/SRC/clatsqr.f b/lapack-netlib/SRC/clatsqr.f index dab5774c1..e9c6d77c2 100644 --- a/lapack-netlib/SRC/clatsqr.f +++ b/lapack-netlib/SRC/clatsqr.f @@ -1,3 +1,4 @@ +*> \brief \b CLATSQR * * Definition: * =========== @@ -18,9 +19,23 @@ *> *> \verbatim *> -*> SLATSQR computes a blocked Tall-Skinny QR factorization of -*> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> CLATSQR computes a blocked Tall-Skinny QR factorization of +*> a complex M-by-N matrix A for M >= N: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix, stored on exit in an implicit +*> form in the elements below the digonal of the array A and in +*> the elemenst of the array T; +*> +*> R is an upper-triangular N-by-N matrix, stored on exit in +*> the elements on and above the diagonal of the array A. +*> +*> 0 is a (M-N)-by-N zero matrix, and is not stored. +*> *> \endverbatim * * Arguments: @@ -149,10 +164,10 @@ SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK diff --git a/lapack-netlib/SRC/claunhr_col_getrfnp.f b/lapack-netlib/SRC/claunhr_col_getrfnp.f new file mode 100644 index 000000000..66b9c0407 --- /dev/null +++ b/lapack-netlib/SRC/claunhr_col_getrfnp.f @@ -0,0 +1,248 @@ +*> \brief \b CLAUNHR_COL_GETRFNP +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CLAUNHR_COL_GETRFNP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CLAUNHR_COL_GETRFNP computes the modified LU factorization without +*> pivoting of a complex general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is +*> at least one in absolute value (so that division-by-zero not +*> not possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine CUNHR_COL. In CUNHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the blocked right-looking version of the algorithm, +*> calling Level 3 BLAS to update the submatrix. To factorize a block, +*> this routine calls the recursive routine CLAUNHR_COL_GETRFNP2. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can be +*> only ( +1.0, 0.0 ) or (-1.0, 0.0 ). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complexGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE CLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + COMPLEX A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX CONE + PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + INTEGER IINFO, J, JB, NB +* .. +* .. External Subroutines .. + EXTERNAL CGEMM, CLAUNHR_COL_GETRFNP2, CTRSM, XERBLA +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CLAUNHR_COL_GETRFNP', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN +* +* Determine the block size for this environment. +* + + NB = ILAENV( 1, 'CLAUNHR_COL_GETRFNP', ' ', M, N, -1, -1 ) + + IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN +* +* Use unblocked code. +* + CALL CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + ELSE +* +* Use blocked code. +* + DO J = 1, MIN( M, N ), NB + JB = MIN( MIN( M, N )-J+1, NB ) +* +* Factor diagonal and subdiagonal blocks. +* + CALL CLAUNHR_COL_GETRFNP2( M-J+1, JB, A( J, J ), LDA, + $ D( J ), IINFO ) +* + IF( J+JB.LE.N ) THEN +* +* Compute block row of U. +* + CALL CTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + $ N-J-JB+1, CONE, A( J, J ), LDA, A( J, J+JB ), + $ LDA ) + IF( J+JB.LE.M ) THEN +* +* Update trailing submatrix. +* + CALL CGEMM( 'No transpose', 'No transpose', M-J-JB+1, + $ N-J-JB+1, JB, -CONE, A( J+JB, J ), LDA, + $ A( J, J+JB ), LDA, CONE, A( J+JB, J+JB ), + $ LDA ) + END IF + END IF + END DO + END IF + RETURN +* +* End of CLAUNHR_COL_GETRFNP +* + END diff --git a/lapack-netlib/SRC/claunhr_col_getrfnp2.f b/lapack-netlib/SRC/claunhr_col_getrfnp2.f new file mode 100644 index 000000000..82fc329ee --- /dev/null +++ b/lapack-netlib/SRC/claunhr_col_getrfnp2.f @@ -0,0 +1,314 @@ +*> \brief \b CLAUNHR_COL_GETRFNP2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CLAUNHR_COL_GETRFNP2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* RECURSIVE SUBROUTINE CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CLAUNHR_COL_GETRFNP2 computes the modified LU factorization without +*> pivoting of a complex general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is at +*> least one in absolute value (so that division-by-zero not +*> possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine CUNHR_COL. In CUNHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the recursive version of the LU factorization algorithm. +*> Denote A - S by B. The algorithm divides the matrix B into four +*> submatrices: +*> +*> [ B11 | B12 ] where B11 is n1 by n1, +*> B = [ -----|----- ] B21 is (m-n1) by n1, +*> [ B21 | B22 ] B12 is n1 by n2, +*> B22 is (m-n1) by n2, +*> with n1 = min(m,n)/2, n2 = n-n1. +*> +*> +*> The subroutine calls itself to factor B11, solves for B21, +*> solves for B12, updates B22, then calls itself to factor B22. +*> +*> For more details on the recursive LU algorithm, see [2]. +*> +*> CLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked +*> routine CLAUNHR_COL_GETRFNP, which uses blocked code calling +*. Level 3 BLAS to update the submatrix. However, CLAUNHR_COL_GETRFNP2 +*> is self-sufficient and can be used without CLAUNHR_COL_GETRFNP. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> +*> [2] "Recursion leads to automatic variable blocking for dense linear +*> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev., +*> vol. 41, no. 6, pp. 737-755, 1997. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can be +*> only ( +1.0, 0.0 ) or (-1.0, 0.0 ). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complexGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + RECURSIVE SUBROUTINE CLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + COMPLEX A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE + PARAMETER ( ONE = 1.0E+0 ) + COMPLEX CONE + PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + REAL SFMIN + INTEGER I, IINFO, N1, N2 + COMPLEX Z +* .. +* .. External Functions .. + REAL SLAMCH + EXTERNAL SLAMCH +* .. +* .. External Subroutines .. + EXTERNAL CGEMM, CSCAL, CTRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, REAL, CMPLX, AIMAG, SIGN, MAX, MIN +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( Z ) = ABS( REAL( Z ) ) + ABS( AIMAG( Z ) ) +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CLAUNHR_COL_GETRFNP2', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN + + IF ( M.EQ.1 ) THEN +* +* One row case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = CMPLX( -SIGN( ONE, REAL( A( 1, 1 ) ) ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* + ELSE IF( N.EQ.1 ) THEN +* +* One column case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = CMPLX( -SIGN( ONE, REAL( A( 1, 1 ) ) ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* +* Scale the elements 2:M of the column +* +* Determine machine safe minimum +* + SFMIN = SLAMCH('S') +* +* Construct the subdiagonal elements of L +* + IF( CABS1( A( 1, 1 ) ) .GE. SFMIN ) THEN + CALL CSCAL( M-1, CONE / A( 1, 1 ), A( 2, 1 ), 1 ) + ELSE + DO I = 2, M + A( I, 1 ) = A( I, 1 ) / A( 1, 1 ) + END DO + END IF +* + ELSE +* +* Divide the matrix B into four submatrices +* + N1 = MIN( M, N ) / 2 + N2 = N-N1 + +* +* Factor B11, recursive call +* + CALL CLAUNHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO ) +* +* Solve for B21 +* + CALL CTRSM( 'R', 'U', 'N', 'N', M-N1, N1, CONE, A, LDA, + $ A( N1+1, 1 ), LDA ) +* +* Solve for B12 +* + CALL CTRSM( 'L', 'L', 'N', 'U', N1, N2, CONE, A, LDA, + $ A( 1, N1+1 ), LDA ) +* +* Update B22, i.e. compute the Schur complement +* B22 := B22 - B21*B12 +* + CALL CGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), LDA, + $ A( 1, N1+1 ), LDA, CONE, A( N1+1, N1+1 ), LDA ) +* +* Factor B22, recursive call +* + CALL CLAUNHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA, + $ D( N1+1 ), IINFO ) +* + END IF + RETURN +* +* End of CLAUNHR_COL_GETRFNP2 +* + END diff --git a/lapack-netlib/SRC/cporfsx.f b/lapack-netlib/SRC/cporfsx.f index 872bad36c..3a2db7135 100644 --- a/lapack-netlib/SRC/cporfsx.f +++ b/lapack-netlib/SRC/cporfsx.f @@ -44,7 +44,7 @@ *> \verbatim *> *> CPORFSX improves the computed solution to a system of linear -*> equations when the coefficient matrix is symmetric positive +*> equations when the coefficient matrix is Hermitian positive *> definite, and provides error bounds and backward error estimates *> for the solution. In addition to normwise error bound, the code *> provides maximum componentwise error bound if possible. See @@ -103,7 +103,7 @@ *> \param[in] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular part *> of the matrix A, and the strictly lower triangular part of A *> is not referenced. If UPLO = 'L', the leading N-by-N lower @@ -134,7 +134,7 @@ *> \param[in,out] S *> \verbatim *> S is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'Y', A is multiplied on +*> The scale factors for A. If EQUED = 'Y', A is multiplied on *> the left and right by diag(S). S is an input argument if FACT = *> 'F'; otherwise, S is an output argument. If FACT = 'F' and EQUED *> = 'Y', each element of S must be positive. If S is output, each @@ -262,7 +262,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -298,14 +298,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -313,9 +313,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cposvxx.f b/lapack-netlib/SRC/cposvxx.f index 64d1b67fa..57c2d3feb 100644 --- a/lapack-netlib/SRC/cposvxx.f +++ b/lapack-netlib/SRC/cposvxx.f @@ -45,7 +45,7 @@ *> *> CPOSVXX uses the Cholesky factorization A = U**T*U or A = L*L**T *> to compute the solution to a complex system of linear equations -*> A * X = B, where A is an N-by-N symmetric positive definite matrix +*> A * X = B, where A is an N-by-N Hermitian positive definite matrix *> and X and B are N-by-NRHS matrices. *> *> If requested, both normwise and maximum componentwise error bounds @@ -157,7 +157,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> On entry, the symmetric matrix A, except if FACT = 'F' and EQUED = +*> On entry, the Hermitian matrix A, except if FACT = 'F' and EQUED = *> 'Y', then A must contain the equilibrated matrix *> diag(S)*A*diag(S). If UPLO = 'U', the leading N-by-N upper *> triangular part of A contains the upper triangular part of the @@ -365,7 +365,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -401,14 +401,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -416,9 +416,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/cpotrf2.f b/lapack-netlib/SRC/cpotrf2.f index 789843c41..ed4f12cba 100644 --- a/lapack-netlib/SRC/cpotrf2.f +++ b/lapack-netlib/SRC/cpotrf2.f @@ -24,7 +24,7 @@ *> *> \verbatim *> -*> CPOTRF2 computes the Cholesky factorization of a real symmetric +*> CPOTRF2 computes the Cholesky factorization of a Hermitian *> positive definite matrix A using the recursive algorithm. *> *> The factorization has the form @@ -63,7 +63,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> On entry, the symmetric matrix A. If UPLO = 'U', the leading +*> On entry, the Hermitian matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower *> triangular part of A is not referenced. If UPLO = 'L', the diff --git a/lapack-netlib/SRC/cstemr.f b/lapack-netlib/SRC/cstemr.f index 22ac842c9..8fb8131d8 100644 --- a/lapack-netlib/SRC/cstemr.f +++ b/lapack-netlib/SRC/cstemr.f @@ -250,13 +250,13 @@ *> \param[in,out] TRYRAC *> \verbatim *> TRYRAC is LOGICAL -*> If TRYRAC.EQ..TRUE., indicates that the code should check whether +*> If TRYRAC = .TRUE., indicates that the code should check whether *> the tridiagonal matrix defines its eigenvalues to high relative *> accuracy. If so, the code uses relative-accuracy preserving *> algorithms that might be (a bit) slower depending on the matrix. *> If the matrix does not define its eigenvalues to high relative *> accuracy, the code can uses possibly faster algorithms. -*> If TRYRAC.EQ..FALSE., the code is not required to guarantee +*> If TRYRAC = .FALSE., the code is not required to guarantee *> relatively accurate eigenvalues and can use the fastest possible *> techniques. *> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix diff --git a/lapack-netlib/SRC/csycon_3.f b/lapack-netlib/SRC/csycon_3.f index 47d52dd15..5c1cb0491 100644 --- a/lapack-netlib/SRC/csycon_3.f +++ b/lapack-netlib/SRC/csycon_3.f @@ -19,7 +19,7 @@ * =========== * * SUBROUTINE CSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, -* WORK, IWORK, INFO ) +* WORK, INFO ) * * .. Scalar Arguments .. * CHARACTER UPLO @@ -27,7 +27,7 @@ * REAL ANORM, RCOND * .. * .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) +* INTEGER IPIV( * ) * COMPLEX A( LDA, * ), E ( * ), WORK( * ) * .. * @@ -129,11 +129,6 @@ *> WORK is COMPLEX array, dimension (2*N) *> \endverbatim *> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> *> \param[out] INFO *> \verbatim *> INFO is INTEGER diff --git a/lapack-netlib/SRC/csyconvf.f b/lapack-netlib/SRC/csyconvf.f index 77ecf46b5..fd5a5e47f 100644 --- a/lapack-netlib/SRC/csyconvf.f +++ b/lapack-netlib/SRC/csyconvf.f @@ -294,7 +294,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -347,7 +347,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -438,7 +438,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where k increases from 1 to N * I = 1 @@ -491,7 +491,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/csyconvf_rook.f b/lapack-netlib/SRC/csyconvf_rook.f index 1146a97c5..7ede26863 100644 --- a/lapack-netlib/SRC/csyconvf_rook.f +++ b/lapack-netlib/SRC/csyconvf_rook.f @@ -285,7 +285,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -336,7 +336,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -426,7 +426,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where i increases from 1 to N * I = 1 @@ -477,7 +477,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/csyrfsx.f b/lapack-netlib/SRC/csyrfsx.f index 7323ba8eb..4d1bc3ccc 100644 --- a/lapack-netlib/SRC/csyrfsx.f +++ b/lapack-netlib/SRC/csyrfsx.f @@ -271,7 +271,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -307,14 +307,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -322,9 +322,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/csysv_aa.f b/lapack-netlib/SRC/csysv_aa.f index 87be734cc..2081644b1 100644 --- a/lapack-netlib/SRC/csysv_aa.f +++ b/lapack-netlib/SRC/csysv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric tridiagonal. The factored @@ -75,7 +75,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is REAL array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> On entry, the symmetric matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**T or A = L*T*L**T as computed by +*> factorization A = U**T*T*U or A = L*T*L**T as computed by *> CSYTRF. *> \endverbatim *> @@ -106,7 +106,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is REAL array, dimension (LDB,NRHS) +*> B is COMPLEX array, dimension (LDB,NRHS) *> On entry, the N-by-NRHS right hand side matrix B. *> On exit, if INFO = 0, the N-by-NRHS solution matrix X. *> \endverbatim @@ -119,7 +119,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -230,7 +230,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/csysv_aa_2stage.f b/lapack-netlib/SRC/csysv_aa_2stage.f index a13349824..c5c328c63 100644 --- a/lapack-netlib/SRC/csysv_aa_2stage.f +++ b/lapack-netlib/SRC/csysv_aa_2stage.f @@ -43,8 +43,8 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or -*> A = L * T * L**H, if UPLO = 'L', +*> A = U**T * T * U, if UPLO = 'U', or +*> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric and band. The matrix T is *> then LU-factored with partial pivoting. The factored form of A @@ -257,7 +257,7 @@ END IF * * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL CSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/csysvxx.f b/lapack-netlib/SRC/csysvxx.f index 2fd2c8771..7a9aee105 100644 --- a/lapack-netlib/SRC/csysvxx.f +++ b/lapack-netlib/SRC/csysvxx.f @@ -378,7 +378,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -414,14 +414,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -429,9 +429,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/csytf2_rk.f b/lapack-netlib/SRC/csytf2_rk.f index 3b5e53a03..7e39c2dfd 100644 --- a/lapack-netlib/SRC/csytf2_rk.f +++ b/lapack-netlib/SRC/csytf2_rk.f @@ -321,7 +321,7 @@ * * Factorize A as U*D*U**T using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -632,7 +632,7 @@ * * Factorize A as L*D*L**T using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/csytrf.f b/lapack-netlib/SRC/csytrf.f index c389725e9..af913b8f4 100644 --- a/lapack-netlib/SRC/csytrf.f +++ b/lapack-netlib/SRC/csytrf.f @@ -43,7 +43,7 @@ *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and D is symmetric and block diagonal with -*> with 1-by-1 and 2-by-2 diagonal blocks. +*> 1-by-1 and 2-by-2 diagonal blocks. *> *> This is the blocked version of the algorithm, calling Level 3 BLAS. *> \endverbatim diff --git a/lapack-netlib/SRC/csytrf_aa.f b/lapack-netlib/SRC/csytrf_aa.f index 2f185b0c7..427235bda 100644 --- a/lapack-netlib/SRC/csytrf_aa.f +++ b/lapack-netlib/SRC/csytrf_aa.f @@ -37,7 +37,7 @@ *> CSYTRF_AA computes the factorization of a complex symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a complex symmetric tridiagonal matrix. @@ -63,7 +63,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is REAL array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> On entry, the symmetric matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower @@ -94,7 +94,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * * Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -375,7 +375,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/csytrf_aa_2stage.f b/lapack-netlib/SRC/csytrf_aa_2stage.f index 0d0bd156c..0946d61b0 100644 --- a/lapack-netlib/SRC/csytrf_aa_2stage.f +++ b/lapack-netlib/SRC/csytrf_aa_2stage.f @@ -38,7 +38,7 @@ *> CSYTRF_AA_2STAGE computes the factorization of a complex symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a complex symmetric band matrix with the @@ -275,7 +275,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -448,12 +448,14 @@ c END IF * > Apply pivots to previous columns of L CALL CSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) + $ CALL CSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL CSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL CSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -637,11 +639,13 @@ c END IF CALL CSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) * > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) + IF( I2.GT.(I1+1) ) + $ CALL CSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL CSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL CSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/csytri2.f b/lapack-netlib/SRC/csytri2.f index 4bd8e4f99..8bee149c4 100644 --- a/lapack-netlib/SRC/csytri2.f +++ b/lapack-netlib/SRC/csytri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by CSYTRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by CSYTRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/csytrs2.f b/lapack-netlib/SRC/csytrs2.f index 1002b5461..93f2d6a1b 100644 --- a/lapack-netlib/SRC/csytrs2.f +++ b/lapack-netlib/SRC/csytrs2.f @@ -36,7 +36,7 @@ *> *> \verbatim *> -*> CSYTRS2 solves a system of linear equations A*X = B with a COMPLEX +*> CSYTRS2 solves a system of linear equations A*X = B with a complex *> symmetric matrix A using the factorization A = U*D*U**T or *> A = L*D*L**T computed by CSYTRF and converted by CSYCONV. *> \endverbatim diff --git a/lapack-netlib/SRC/csytrs_aa.f b/lapack-netlib/SRC/csytrs_aa.f index 7cf950492..981f8722a 100644 --- a/lapack-netlib/SRC/csytrs_aa.f +++ b/lapack-netlib/SRC/csytrs_aa.f @@ -37,7 +37,7 @@ *> \verbatim *> *> CSYTRS_AA solves a system of linear equations A*X = B with a complex -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by CSYTRF_AA. *> \endverbatim * @@ -49,7 +49,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -68,7 +68,7 @@ *> *> \param[in] A *> \verbatim -*> A is REAL array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> Details of factors computed by CSYTRF_AA. *> \endverbatim *> @@ -86,7 +86,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is REAL array, dimension (LDB,NRHS) +*> B is COMPLEX array, dimension (LDB,NRHS) *> On entry, the right hand side matrix B. *> On exit, the solution matrix X. *> \endverbatim @@ -97,14 +97,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -198,22 +200,29 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. +* +* 1) Forward substitution with U**T +* + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* Pivot, P**T * B + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Compute U**T \ B -> B [ (U**T \P**T * B) ] * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] + CALL CTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL CTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute T \ B -> B [ T \ (U**T \P**T * B) ] * CALL CLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN @@ -223,35 +232,48 @@ CALL CGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, $ INFO ) * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* 3) Backward substitution with U +* + IF( N.GT.1 ) THEN * - CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] + CALL CTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Pivot, P * B -> B [ P * (U**T \ (T \ (U \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * ELSE * * Solve A*X = B, where A = L*T*L**T. * -* Pivot, P**T * B +* 1) Forward substitution with L * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B +* + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO +* +* Compute L \ B -> B [ (L \P**T * B) ] +* + CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) + END IF * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* 2) Solve with triangular matrix T * - CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) * * Compute T \ B -> B [ T \ (L \P**T * B) ] * @@ -263,18 +285,23 @@ CALL CGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**T +* + IF( N.GT.1 ) THEN * - CALL CTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) +* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] + CALL CTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL CSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/csytrs_aa_2stage.f b/lapack-netlib/SRC/csytrs_aa_2stage.f index d025c08fe..581910933 100644 --- a/lapack-netlib/SRC/csytrs_aa_2stage.f +++ b/lapack-netlib/SRC/csytrs_aa_2stage.f @@ -36,7 +36,7 @@ *> \verbatim *> *> CSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a complex -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by CSYTRF_AA_2STAGE. *> \endverbatim * @@ -48,7 +48,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -208,15 +208,15 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * CALL CTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) @@ -234,7 +234,7 @@ CALL CTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] * CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * @@ -246,11 +246,11 @@ * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute (L \ B) -> B [ (L \P**T * B) ] * CALL CTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) @@ -268,7 +268,7 @@ CALL CTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] * CALL CLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * diff --git a/lapack-netlib/SRC/ctgsy2.f b/lapack-netlib/SRC/ctgsy2.f index 66a8980d0..5ccdfb1e1 100644 --- a/lapack-netlib/SRC/ctgsy2.f +++ b/lapack-netlib/SRC/ctgsy2.f @@ -67,7 +67,7 @@ *> R * B**H + L * E**H = scale * -F *> *> This case is used to compute an estimate of Dif[(A, D), (B, E)] = -*> = sigma_min(Z) using reverse communicaton with CLACON. +*> = sigma_min(Z) using reverse communication with CLACON. *> *> CTGSY2 also (IJOB >= 1) contributes to the computation in CTGSYL *> of an upper bound on the separation between to matrix pairs. Then @@ -81,7 +81,7 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). +*> = 'N': solve the generalized Sylvester equation (1). *> = 'T': solve the 'transposed' system (3). *> \endverbatim *> @@ -89,13 +89,13 @@ *> \verbatim *> IJOB is INTEGER *> Specifies what kind of functionality to be performed. -*> =0: solve (1) only. -*> =1: A contribution from this subsystem to a Frobenius -*> norm-based estimate of the separation between two matrix -*> pairs is computed. (look ahead strategy is used). -*> =2: A contribution from this subsystem to a Frobenius -*> norm-based estimate of the separation between two matrix -*> pairs is computed. (SGECON on sub-systems is used.) +*> = 0: solve (1) only. +*> = 1: A contribution from this subsystem to a Frobenius +*> norm-based estimate of the separation between two matrix +*> pairs is computed. (look ahead strategy is used). +*> = 2: A contribution from this subsystem to a Frobenius +*> norm-based estimate of the separation between two matrix +*> pairs is computed. (SGECON on sub-systems is used.) *> Not referenced if TRANS = 'T'. *> \endverbatim *> diff --git a/lapack-netlib/SRC/ctplqt.f b/lapack-netlib/SRC/ctplqt.f index cb4d419b9..39893df48 100644 --- a/lapack-netlib/SRC/ctplqt.f +++ b/lapack-netlib/SRC/ctplqt.f @@ -1,3 +1,5 @@ +*> \brief \b CTPLQT +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/ctplqt2.f b/lapack-netlib/SRC/ctplqt2.f index b16d6149a..d18452aec 100644 --- a/lapack-netlib/SRC/ctplqt2.f +++ b/lapack-netlib/SRC/ctplqt2.f @@ -1,3 +1,5 @@ +*> \brief \b CTPLQT2 +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/ctpmlqt.f b/lapack-netlib/SRC/ctpmlqt.f index cb5f033ca..5899a5335 100644 --- a/lapack-netlib/SRC/ctpmlqt.f +++ b/lapack-netlib/SRC/ctpmlqt.f @@ -1,3 +1,5 @@ +*> \brief \b CTPMLQT +* * Definition: * =========== * @@ -77,7 +79,7 @@ *> *> \param[in] V *> \verbatim -*> V is COMPLEX array, dimension (LDA,K) +*> V is COMPLEX array, dimension (LDV,K) *> The i-th row must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DTPLQT in B. See Further Details. diff --git a/lapack-netlib/SRC/ctpmqrt.f b/lapack-netlib/SRC/ctpmqrt.f index fd3d1b109..8d4a36ca8 100644 --- a/lapack-netlib/SRC/ctpmqrt.f +++ b/lapack-netlib/SRC/ctpmqrt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is COMPLEX array, dimension (LDA,K) +*> V is COMPLEX array, dimension (LDV,K) *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> CTPQRT in B. See Further Details. diff --git a/lapack-netlib/SRC/ctprfb.f b/lapack-netlib/SRC/ctprfb.f index 1538deb56..0f45edaf8 100644 --- a/lapack-netlib/SRC/ctprfb.f +++ b/lapack-netlib/SRC/ctprfb.f @@ -152,8 +152,8 @@ *> \verbatim *> LDA is INTEGER *> The leading dimension of the array A. -*> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'L', LDA >= max(1,K); +*> If SIDE = 'R', LDA >= max(1,M). *> \endverbatim *> *> \param[in,out] B diff --git a/lapack-netlib/SRC/cungtsqr.f b/lapack-netlib/SRC/cungtsqr.f new file mode 100644 index 000000000..bc5305cf9 --- /dev/null +++ b/lapack-netlib/SRC/cungtsqr.f @@ -0,0 +1,307 @@ +*> \brief \b CUNGTSQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CUNGTSQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE CUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, +* $ INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal +*> columns, which are the first N columns of a product of comlpex unitary +*> matrices of order M which are returned by CLATSQR +*> +*> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). +*> +*> See the documentation for CLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] MB +*> \verbatim +*> MB is INTEGER +*> The row block size used by DLATSQR to return +*> arrays A and T. MB > N. +*> (Note that if MB > M, then M is used instead of MB +*> as the row block size). +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size used by CLATSQR to return +*> arrays A and T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size). +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX array, dimension (LDA,N) +*> +*> On entry: +*> +*> The elements on and above the diagonal are not accessed. +*> The elements below the diagonal represent the unit +*> lower-trapezoidal blocked matrix V computed by CLATSQR +*> that defines the input matrices Q_in(k) (ones on the +*> diagonal are not stored) (same format as the output A +*> below the diagonal in CLATSQR). +*> +*> On exit: +*> +*> The array A contains an M-by-N orthonormal matrix Q_out, +*> i.e the columns of A are orthogonal unit vectors. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is COMPLEX array, +*> dimension (LDT, N * NIRB) +*> where NIRB = Number_of_input_row_blocks +*> = MAX( 1, CEIL((M-N)/(MB-N)) ) +*> Let NICB = Number_of_input_col_blocks +*> = CEIL(N/NB) +*> +*> The upper-triangular block reflectors used to define the +*> input matrices Q_in(k), k=(1:NIRB*NICB). The block +*> reflectors are stored in compact form in NIRB block +*> reflector sequences. Each of NIRB block reflector sequences +*> is stored in a larger NB-by-N column block of T and consists +*> of NICB smaller NB-by-NB upper-triangular column blocks. +*> (same format as the output T in CLATSQR). +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB1,N)). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> (workspace) COMPLEX array, dimension (MAX(2,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> The dimension of the array WORK. LWORK >= (M+NB)*N. +*> If LWORK = -1, then a workspace query is assumed. +*> The routine only calculates the optimal size of the WORK +*> array, returns this value as the first entry of the WORK +*> array, and no error message related to LWORK is issued +*> by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup comlexOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE CUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + $ INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. + COMPLEX A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX CONE, CZERO + PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ), + $ CZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J +* .. +* .. External Subroutines .. + EXTERNAL CCOPY, CLAMTSQR, CLASET, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC CMPLX, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + LQUERY = LWORK.EQ.-1 + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. M.LT.N ) THEN + INFO = -2 + ELSE IF( MB.LE.N ) THEN + INFO = -3 + ELSE IF( NB.LT.1 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -6 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -8 + ELSE +* +* Test the input LWORK for the dimension of the array WORK. +* This workspace is used to store array C(LDC, N) and WORK(LWORK) +* in the call to CLAMTSQR. See the documentation for CLAMTSQR. +* + IF( LWORK.LT.2 .AND. (.NOT.LQUERY) ) THEN + INFO = -10 + ELSE +* +* Set block size for column blocks +* + NBLOCAL = MIN( NB, N ) +* +* LWORK = -1, then set the size for the array C(LDC,N) +* in CLAMTSQR call and set the optimal size of the work array +* WORK(LWORK) in CLAMTSQR call. +* + LDC = M + LC = LDC*N + LW = N * NBLOCAL +* + LWORKOPT = LC+LW +* + IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + INFO = -10 + END IF + END IF +* + END IF +* +* Handle error in the input parameters and return workspace query. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CUNGTSQR', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN + WORK( 1 ) = CMPLX( LWORKOPT ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + WORK( 1 ) = CMPLX( LWORKOPT ) + RETURN + END IF +* +* (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in +* of M-by-M orthogonal matrix Q_in, which is implicitly stored in +* the subdiagonal part of input array A and in the input array T. +* Perform by the following operation using the routine CLAMTSQR. +* +* Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix, +* ( 0 ) 0 is a (M-N)-by-N zero matrix. +* +* (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones +* on the diagonal and zeros elsewhere. +* + CALL CLASET( 'F', M, N, CZERO, CONE, WORK, LDC ) +* +* (1b) On input, WORK(1:LDC*N) stores ( I ); +* ( 0 ) +* +* On output, WORK(1:LDC*N) stores Q1_in. +* + CALL CLAMTSQR( 'L', 'N', M, N, N, MB, NBLOCAL, A, LDA, T, LDT, + $ WORK, LDC, WORK( LC+1 ), LW, IINFO ) +* +* (2) Copy the result from the part of the work array (1:M,1:N) +* with the leading dimension LDC that starts at WORK(1) into +* the output array A(1:M,1:N) column-by-column. +* + DO J = 1, N + CALL CCOPY( M, WORK( (J-1)*LDC + 1 ), 1, A( 1, J ), 1 ) + END DO +* + WORK( 1 ) = CMPLX( LWORKOPT ) + RETURN +* +* End of CUNGTSQR +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/cunhr_col.f b/lapack-netlib/SRC/cunhr_col.f new file mode 100644 index 000000000..15c31491e --- /dev/null +++ b/lapack-netlib/SRC/cunhr_col.f @@ -0,0 +1,441 @@ +*> \brief \b CUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CUNHR_COL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE CUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. +* COMPLEX A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns +*> as input, stored in A, and performs Householder Reconstruction (HR), +*> i.e. reconstructs Householder vectors V(i) implicitly representing +*> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, +*> where S is an N-by-N diagonal matrix with diagonal entries +*> equal to +1 or -1. The Householder vectors (columns V(i) of V) are +*> stored in A on output, and the diagonal entries of S are stored in D. +*> Block reflectors are also returned in T +*> (same output format as CGEQRT). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size to be used in the reconstruction +*> of Householder column vector blocks in the array A and +*> corresponding block reflectors in the array T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size.) +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX array, dimension (LDA,N) +*> +*> On entry: +*> +*> The array A contains an M-by-N orthonormal matrix Q_in, +*> i.e the columns of A are orthogonal unit vectors. +*> +*> On exit: +*> +*> The elements below the diagonal of A represent the unit +*> lower-trapezoidal matrix V of Householder column vectors +*> V(i). The unit diagonal entries of V are not stored +*> (same format as the output below the diagonal in A from +*> CGEQRT). The matrix T and the matrix V stored on output +*> in A implicitly define Q_out. +*> +*> The elements above the diagonal contain the factor U +*> of the "modified" LU-decomposition: +*> Q_in - ( S ) = V * U +*> ( 0 ) +*> where 0 is a (M-N)-by-(M-N) zero matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is COMPLEX array, +*> dimension (LDT, N) +*> +*> Let NOCB = Number_of_output_col_blocks +*> = CEIL(N/NB) +*> +*> On exit, T(1:NB, 1:N) contains NOCB upper-triangular +*> block reflectors used to define Q_out stored in compact +*> form as a sequence of upper-triangular NB-by-NB column +*> blocks (same format as the output T in CGEQRT). +*> The matrix T and the matrix V stored on output in A +*> implicitly define Q_out. NOTE: The lower triangles +*> below the upper-triangular blcoks will be filled with +*> zeros. See Further Details. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB,N)). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX array, dimension min(M,N). +*> The elements can be only plus or minus one. +*> +*> D(i) is constructed as D(i) = -SIGN(Q_in_i(i,i)), where +*> 1 <= i <= min(M,N), and Q_in_i is Q_in after performing +*> i-1 steps of “modified” Gaussian elimination. +*> See Further Details. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The computed M-by-M unitary factor Q_out is defined implicitly as +*> a product of unitary matrices Q_out(i). Each Q_out(i) is stored in +*> the compact WY-representation format in the corresponding blocks of +*> matrices V (stored in A) and T. +*> +*> The M-by-N unit lower-trapezoidal matrix V stored in the M-by-N +*> matrix A contains the column vectors V(i) in NB-size column +*> blocks VB(j). For example, VB(1) contains the columns +*> V(1), V(2), ... V(NB). NOTE: The unit entries on +*> the diagonal of Y are not stored in A. +*> +*> The number of column blocks is +*> +*> NOCB = Number_of_output_col_blocks = CEIL(N/NB) +*> +*> where each block is of order NB except for the last block, which +*> is of order LAST_NB = N - (NOCB-1)*NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix V is +*> +*> +*> V = ( VB(1), VB(2), VB(3) ) = +*> +*> = ( 1 ) +*> ( v21 1 ) +*> ( v31 v32 1 ) +*> ( v41 v42 v43 1 ) +*> ( v51 v52 v53 v54 1 ) +*> ( v61 v62 v63 v54 v65 ) +*> +*> +*> For each of the column blocks VB(i), an upper-triangular block +*> reflector TB(i) is computed. These blocks are stored as +*> a sequence of upper-triangular column blocks in the NB-by-N +*> matrix T. The size of each TB(i) block is NB-by-NB, except +*> for the last block, whose size is LAST_NB-by-LAST_NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix T is +*> +*> T = ( TB(1), TB(2), TB(3) ) = +*> +*> = ( t11 t12 t13 t14 t15 ) +*> ( t22 t24 ) +*> +*> +*> The M-by-M factor Q_out is given as a product of NOCB +*> unitary M-by-M matrices Q_out(i). +*> +*> Q_out = Q_out(1) * Q_out(2) * ... * Q_out(NOCB), +*> +*> where each matrix Q_out(i) is given by the WY-representation +*> using corresponding blocks from the matrices V and T: +*> +*> Q_out(i) = I - VB(i) * TB(i) * (VB(i))**T, +*> +*> where I is the identity matrix. Here is the formula with matrix +*> dimensions: +*> +*> Q(i){M-by-M} = I{M-by-M} - +*> VB(i){M-by-INB} * TB(i){INB-by-INB} * (VB(i))**T {INB-by-M}, +*> +*> where INB = NB, except for the last block NOCB +*> for which INB=LAST_NB. +*> +*> ===== +*> NOTE: +*> ===== +*> +*> If Q_in is the result of doing a QR factorization +*> B = Q_in * R_in, then: +*> +*> B = (Q_out*S) * R_in = Q_out * (S * R_in) = O_out * R_out. +*> +*> So if one wants to interpret Q_out as the result +*> of the QR factorization of B, then corresponding R_out +*> should be obtained by R_out = S * R_in, i.e. some rows of R_in +*> should be multiplied by -1. +*> +*> For the details of the algorithm, see [1]. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complexOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE CUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. + COMPLEX A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX CONE, CZERO + PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ), + $ CZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + INTEGER I, IINFO, J, JB, JBTEMP1, JBTEMP2, JNB, + $ NPLUSONE +* .. +* .. External Subroutines .. + EXTERNAL CCOPY, CLAUNHR_COL_GETRFNP, CSCAL, CTRSM, + $ XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( NB.LT.1 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -7 + END IF +* +* Handle error in the input parameters. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CUNHR_COL', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + RETURN + END IF +* +* On input, the M-by-N matrix A contains the unitary +* M-by-N matrix Q_in. +* +* (1) Compute the unit lower-trapezoidal V (ones on the diagonal +* are not stored) by performing the "modified" LU-decomposition. +* +* Q_in - ( S ) = V * U = ( V1 ) * U, +* ( 0 ) ( V2 ) +* +* where 0 is an (M-N)-by-N zero matrix. +* +* (1-1) Factor V1 and U. + + CALL CLAUNHR_COL_GETRFNP( N, N, A, LDA, D, IINFO ) +* +* (1-2) Solve for V2. +* + IF( M.GT.N ) THEN + CALL CTRSM( 'R', 'U', 'N', 'N', M-N, N, CONE, A, LDA, + $ A( N+1, 1 ), LDA ) + END IF +* +* (2) Reconstruct the block reflector T stored in T(1:NB, 1:N) +* as a sequence of upper-triangular blocks with NB-size column +* blocking. +* +* Loop over the column blocks of size NB of the array A(1:M,1:N) +* and the array T(1:NB,1:N), JB is the column index of a column +* block, JNB is the column block size at each step JB. +* + NPLUSONE = N + 1 + DO JB = 1, N, NB +* +* (2-0) Determine the column block size JNB. +* + JNB = MIN( NPLUSONE-JB, NB ) +* +* (2-1) Copy the upper-triangular part of the current JNB-by-JNB +* diagonal block U(JB) (of the N-by-N matrix U) stored +* in A(JB:JB+JNB-1,JB:JB+JNB-1) into the upper-triangular part +* of the current JNB-by-JNB block T(1:JNB,JB:JB+JNB-1) +* column-by-column, total JNB*(JNB+1)/2 elements. +* + JBTEMP1 = JB - 1 + DO J = JB, JB+JNB-1 + CALL CCOPY( J-JBTEMP1, A( JB, J ), 1, T( 1, J ), 1 ) + END DO +* +* (2-2) Perform on the upper-triangular part of the current +* JNB-by-JNB diagonal block U(JB) (of the N-by-N matrix U) stored +* in T(1:JNB,JB:JB+JNB-1) the following operation in place: +* (-1)*U(JB)*S(JB), i.e the result will be stored in the upper- +* triangular part of T(1:JNB,JB:JB+JNB-1). This multiplication +* of the JNB-by-JNB diagonal block U(JB) by the JNB-by-JNB +* diagonal block S(JB) of the N-by-N sign matrix S from the +* right means changing the sign of each J-th column of the block +* U(JB) according to the sign of the diagonal element of the block +* S(JB), i.e. S(J,J) that is stored in the array element D(J). +* + DO J = JB, JB+JNB-1 + IF( D( J ).EQ.CONE ) THEN + CALL CSCAL( J-JBTEMP1, -CONE, T( 1, J ), 1 ) + END IF + END DO +* +* (2-3) Perform the triangular solve for the current block +* matrix X(JB): +* +* X(JB) * (A(JB)**T) = B(JB), where: +* +* A(JB)**T is a JNB-by-JNB unit upper-triangular +* coefficient block, and A(JB)=V1(JB), which +* is a JNB-by-JNB unit lower-triangular block +* stored in A(JB:JB+JNB-1,JB:JB+JNB-1). +* The N-by-N matrix V1 is the upper part +* of the M-by-N lower-trapezoidal matrix V +* stored in A(1:M,1:N); +* +* B(JB) is a JNB-by-JNB upper-triangular right-hand +* side block, B(JB) = (-1)*U(JB)*S(JB), and +* B(JB) is stored in T(1:JNB,JB:JB+JNB-1); +* +* X(JB) is a JNB-by-JNB upper-triangular solution +* block, X(JB) is the upper-triangular block +* reflector T(JB), and X(JB) is stored +* in T(1:JNB,JB:JB+JNB-1). +* +* In other words, we perform the triangular solve for the +* upper-triangular block T(JB): +* +* T(JB) * (V1(JB)**T) = (-1)*U(JB)*S(JB). +* +* Even though the blocks X(JB) and B(JB) are upper- +* triangular, the routine CTRSM will access all JNB**2 +* elements of the square T(1:JNB,JB:JB+JNB-1). Therefore, +* we need to set to zero the elements of the block +* T(1:JNB,JB:JB+JNB-1) below the diagonal before the call +* to CTRSM. +* +* (2-3a) Set the elements to zero. +* + JBTEMP2 = JB - 2 + DO J = JB, JB+JNB-2 + DO I = J-JBTEMP2, NB + T( I, J ) = CZERO + END DO + END DO +* +* (2-3b) Perform the triangular solve. +* + CALL CTRSM( 'R', 'L', 'C', 'U', JNB, JNB, CONE, + $ A( JB, JB ), LDA, T( 1, JB ), LDT ) +* + END DO +* + RETURN +* +* End of CUNHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/dbdsqr.f b/lapack-netlib/SRC/dbdsqr.f index 93db95e7a..7d47fa282 100644 --- a/lapack-netlib/SRC/dbdsqr.f +++ b/lapack-netlib/SRC/dbdsqr.f @@ -166,7 +166,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (4*N) +*> WORK is DOUBLE PRECISION array, dimension (4*(N-1)) *> \endverbatim *> *> \param[out] INFO diff --git a/lapack-netlib/SRC/dbdsvdx.f b/lapack-netlib/SRC/dbdsvdx.f index 96fdb3d61..10d97a71f 100644 --- a/lapack-netlib/SRC/dbdsvdx.f +++ b/lapack-netlib/SRC/dbdsvdx.f @@ -165,7 +165,7 @@ *> *> \param[out] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension (2*N,K) ) +*> Z is DOUBLE PRECISION array, dimension (2*N,K) *> If JOBZ = 'V', then if INFO = 0 the first NS columns of Z *> contain the singular vectors of the matrix B corresponding to *> the selected singular values, with U in rows 1 to N and V diff --git a/lapack-netlib/SRC/dcombssq.f b/lapack-netlib/SRC/dcombssq.f new file mode 100644 index 000000000..79f6d95c9 --- /dev/null +++ b/lapack-netlib/SRC/dcombssq.f @@ -0,0 +1,92 @@ +*> \brief \b DCOMBSSQ adds two scaled sum of squares quantities. +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* +* Definition: +* =========== +* +* SUBROUTINE DCOMBSSQ( V1, V2 ) +* +* .. Array Arguments .. +* DOUBLE PRECISION V1( 2 ), V2( 2 ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DCOMBSSQ adds two scaled sum of squares quantities, V1 := V1 + V2. +*> That is, +*> +*> V1_scale**2 * V1_sumsq := V1_scale**2 * V1_sumsq +*> + V2_scale**2 * V2_sumsq +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in,out] V1 +*> \verbatim +*> V1 is DOUBLE PRECISION array, dimension (2). +*> The first scaled sum. +*> V1(1) = V1_scale, V1(2) = V1_sumsq. +*> \endverbatim +*> +*> \param[in] V2 +*> \verbatim +*> V2 is DOUBLE PRECISION array, dimension (2). +*> The second scaled sum. +*> V2(1) = V2_scale, V2(2) = V2_sumsq. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup OTHERauxiliary +* +* ===================================================================== + SUBROUTINE DCOMBSSQ( V1, V2 ) +* +* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2018 +* +* .. Array Arguments .. + DOUBLE PRECISION V1( 2 ), V2( 2 ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D+0 ) +* .. +* .. Executable Statements .. +* + IF( V1( 1 ).GE.V2( 1 ) ) THEN + IF( V1( 1 ).NE.ZERO ) THEN + V1( 2 ) = V1( 2 ) + ( V2( 1 ) / V1( 1 ) )**2 * V2( 2 ) + END IF + ELSE + V1( 2 ) = V2( 2 ) + ( V1( 1 ) / V2( 1 ) )**2 * V1( 2 ) + V1( 1 ) = V2( 1 ) + END IF + RETURN +* +* End of DCOMBSSQ +* + END diff --git a/lapack-netlib/SRC/dgbrfsx.f b/lapack-netlib/SRC/dgbrfsx.f index fb52d643f..76afb2d6a 100644 --- a/lapack-netlib/SRC/dgbrfsx.f +++ b/lapack-netlib/SRC/dgbrfsx.f @@ -308,7 +308,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -344,14 +344,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -359,9 +359,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/dgbsvxx.f b/lapack-netlib/SRC/dgbsvxx.f index 819d20c6d..058b20686 100644 --- a/lapack-netlib/SRC/dgbsvxx.f +++ b/lapack-netlib/SRC/dgbsvxx.f @@ -431,7 +431,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -467,14 +467,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -482,9 +482,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/dgebak.f b/lapack-netlib/SRC/dgebak.f index 45a86ee57..10a78aa1a 100644 --- a/lapack-netlib/SRC/dgebak.f +++ b/lapack-netlib/SRC/dgebak.f @@ -47,10 +47,10 @@ *> \verbatim *> JOB is CHARACTER*1 *> Specifies the type of backward transformation required: -*> = 'N', do nothing, return immediately; -*> = 'P', do backward transformation for permutation only; -*> = 'S', do backward transformation for scaling only; -*> = 'B', do backward transformations for both permutation and +*> = 'N': do nothing, return immediately; +*> = 'P': do backward transformation for permutation only; +*> = 'S': do backward transformation for scaling only; +*> = 'B': do backward transformations for both permutation and *> scaling. *> JOB must be the same as the argument JOB supplied to DGEBAL. *> \endverbatim diff --git a/lapack-netlib/SRC/dgeesx.f b/lapack-netlib/SRC/dgeesx.f index 26042a5f9..a08104d3d 100644 --- a/lapack-netlib/SRC/dgeesx.f +++ b/lapack-netlib/SRC/dgeesx.f @@ -583,7 +583,9 @@ IF( N.GT.I+1 ) $ CALL DSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) - CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + IF( WANTVS ) THEN + CALL DSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO END IF diff --git a/lapack-netlib/SRC/dgejsv.f b/lapack-netlib/SRC/dgejsv.f index 25ed248d0..a30cfab87 100644 --- a/lapack-netlib/SRC/dgejsv.f +++ b/lapack-netlib/SRC/dgejsv.f @@ -82,7 +82,7 @@ *> desirable, then this option is advisable. The input matrix A *> is preprocessed with QR factorization with FULL (row and *> column) pivoting. -*> = 'G' Computation as with 'F' with an additional estimate of the +*> = 'G': Computation as with 'F' with an additional estimate of the *> condition number of B, where A=D*B. If A has heavily weighted *> rows, then using this condition number gives too pessimistic *> error bound. @@ -133,7 +133,7 @@ *> specified range. If A .NE. 0 is scaled so that the largest singular *> value of c*A is around DSQRT(BIG), BIG=SLAMCH('O'), then JOBR issues *> the licence to kill columns of A whose norm in c*A is less than -*> DSQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN, +*> DSQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, *> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). *> = 'N': Do not kill small columns of c*A. This option assumes that *> BLAS and QR factorizations and triangular solvers are @@ -230,7 +230,7 @@ *> If JOBU = 'F', then U contains on exit the M-by-M matrix of *> the left singular vectors, including an ONB *> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N), +*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), *> then U is used as workspace if the procedure *> replaces A with A^t. In that case, [V] is computed *> in U as left singular vectors of A^t and then @@ -252,7 +252,7 @@ *> V is DOUBLE PRECISION array, dimension ( LDV, N ) *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> the right singular vectors; -*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), +*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), *> then V is used as workspace if the pprocedure *> replaces A with A^t. In that case, [U] is computed *> in V as right singular vectors of A^t and then @@ -272,13 +272,13 @@ *> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (LWORK) -*> On exit, if N.GT.0 .AND. M.GT.0 (else not referenced), +*> On exit, if N > 0 .AND. M > 0 (else not referenced), *> WORK(1) = SCALE = WORK(2) / WORK(1) is the scaling factor such *> that SCALE*SVA(1:N) are the computed singular values *> of A. (See the description of SVA().) *> WORK(2) = See the description of WORK(1). *> WORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA .EQ. 'E' or 'G') +*> column equilibrated A. (If JOBA = 'E' or 'G') *> SCONDA is an estimate of DSQRT(||(R^t * R)^(-1)||_1). *> It is computed using DPOCON. It holds *> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA @@ -297,7 +297,7 @@ *> triangular factor in the first QR factorization. *> WORK(5) = an estimate of the scaled condition number of the *> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT .EQ. 'T'. +*> The following two parameters are computed if JOBT = 'T'. *> They are provided for a developer/implementer who is familiar *> with the details of the method. *> @@ -313,8 +313,8 @@ *> Length of WORK to confirm proper allocation of work space. *> LWORK depends on the job: *> -*> If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> -> .. no scaled condition estimate required (JOBE.EQ.'N'): +*> If only SIGMA is needed (JOBU = 'N', JOBV = 'N') and +*> -> .. no scaled condition estimate required (JOBE = 'N'): *> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value *> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal @@ -330,7 +330,7 @@ *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), *> N+N*N+LWORK(DPOCON),7). *> -*> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), +*> If SIGMA and the right singular vectors are needed (JOBV = 'V'), *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7), *> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQF, @@ -341,19 +341,19 @@ *> If SIGMA and the left singular vectors are needed *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), -*> if JOBU.EQ.'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7), +*> if JOBU = 'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), +*> if JOBU = 'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7), *> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON), *> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)). -*> Here LWORK(DORMQR) equals N*NB (for JOBU.EQ.'U') or -*> M*NB (for JOBU.EQ.'F'). +*> Here LWORK(DORMQR) equals N*NB (for JOBU = 'U') or +*> M*NB (for JOBU = 'F'). *> -*> If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and -*> -> if JOBV.EQ.'V' +*> If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and +*> -> if JOBV = 'V' *> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N). -*> -> if JOBV.EQ.'J' the minimal requirement is +*> -> if JOBV = 'J' the minimal requirement is *> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6). *> -> For optimal performance, LWORK should be additionally *> larger than N+M*NB, where NB is the optimal block size @@ -369,7 +369,7 @@ *> of JOBA and JOBR. *> IWORK(2) = the number of the computed nonzero singular values *> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3).EQ.1 then some of the column norms of A +*> If IWORK(3) = 1 then some of the column norms of A *> were denormalized floats. The requested high accuracy *> is not warranted by the data. *> \endverbatim @@ -377,10 +377,10 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> < 0 : if INFO = -i, then the i-th argument had an illegal value. -*> = 0 : successful exit; -*> > 0 : DGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. +*> < 0: if INFO = -i, then the i-th argument had an illegal value. +*> = 0: successful exit; +*> > 0: DGEJSV did not converge in the maximal allowed number +*> of sweeps. The computed values may be inaccurate. *> \endverbatim * * Authors: @@ -953,7 +953,7 @@ IF ( L2ABER ) THEN * Standard absolute error bound suffices. All sigma_i with * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* agressive enforcement of lower numerical rank by introducing a +* aggressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. TEMP1 = DSQRT(DBLE(N))*EPSLN DO 3001 p = 2, N @@ -965,7 +965,7 @@ 3001 CONTINUE 3002 CONTINUE ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less agressive). +* .. similarly as above, only slightly more gentle (less aggressive). * Sudden drop on the diagonal of R1 is used as the criterion for * close-to-rank-deficient. TEMP1 = DSQRT(SFMIN) @@ -1294,7 +1294,7 @@ CALL DPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1, $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR) CONDR1 = ONE / DSQRT(TEMP1) -* .. here need a second oppinion on the condition number +* .. here need a second opinion on the condition number * .. then assume worst case scenario * R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) * more conservative <=> CONDR1 .LT. DSQRT(DBLE(N)) @@ -1335,7 +1335,7 @@ ELSE * * .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equaly good +* Note that windowed pivoting would be equally good * numerically, and more run-time efficient. So, in * an optimal implementation, the next call to DGEQP3 * should be replaced with eg. CALL SGEQPX (ACM TOMS #782) @@ -1388,7 +1388,7 @@ * IF ( CONDR2 .GE. COND_OK ) THEN * .. save the Householder vectors used for Q3 -* (this overwrittes the copy of R2, as it will not be +* (this overwrites the copy of R2, as it will not be * needed in this branch, but it does not overwritte the * Huseholder vectors of Q2.). CALL DLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N ) @@ -1638,7 +1638,7 @@ * * This branch deploys a preconditioned Jacobi SVD with explicitly * accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perfom well, and can also be used. +* experimental purposes. It does perform well, and can also be used. * In this implementation, this branch will be automatically activated * if the condition number sigma_max(A) / sigma_min(A) is predicted * to be greater than the overflow threshold. This is because the diff --git a/lapack-netlib/SRC/dgelq.f b/lapack-netlib/SRC/dgelq.f index ece645079..fc14d892f 100644 --- a/lapack-netlib/SRC/dgelq.f +++ b/lapack-netlib/SRC/dgelq.f @@ -1,3 +1,4 @@ +*> \brief \b DGELQ * * Definition: * =========== @@ -17,7 +18,17 @@ * ============= *> *> \verbatim -*> DGELQ computes a LQ factorization of an M-by-N matrix A. +*> +*> DGELQ computes an LQ factorization of a real M-by-N matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -138,7 +149,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -159,10 +170,10 @@ SUBROUTINE DGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/dgelq2.f b/lapack-netlib/SRC/dgelq2.f index 04aa57fc1..a6c835de4 100644 --- a/lapack-netlib/SRC/dgelq2.f +++ b/lapack-netlib/SRC/dgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> DGELQ2 computes an LQ factorization of a real m by n matrix A: -*> A = L * Q. +*> DGELQ2 computes an LQ factorization of a real m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is an lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,7 +104,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -121,10 +129,10 @@ * ===================================================================== SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/dgelqf.f b/lapack-netlib/SRC/dgelqf.f index 834c47168..4b11761f6 100644 --- a/lapack-netlib/SRC/dgelqf.f +++ b/lapack-netlib/SRC/dgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> DGELQF computes an LQ factorization of a real M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,7 +118,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -135,10 +143,10 @@ * ===================================================================== SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/dgemlq.f b/lapack-netlib/SRC/dgemlq.f index bb6b2868f..dea693c24 100644 --- a/lapack-netlib/SRC/dgemlq.f +++ b/lapack-netlib/SRC/dgemlq.f @@ -1,3 +1,4 @@ +*> \brief \b DGEMLQ * * Definition: * =========== @@ -144,7 +145,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/dgemqr.f b/lapack-netlib/SRC/dgemqr.f index 8509b13d9..0f7a42233 100644 --- a/lapack-netlib/SRC/dgemqr.f +++ b/lapack-netlib/SRC/dgemqr.f @@ -1,3 +1,4 @@ +*> \brief \b DGEMQR * * Definition: * =========== @@ -144,7 +145,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/dgeqr.f b/lapack-netlib/SRC/dgeqr.f index d0a1a18f9..0bff5d1f9 100644 --- a/lapack-netlib/SRC/dgeqr.f +++ b/lapack-netlib/SRC/dgeqr.f @@ -1,3 +1,4 @@ +*> \brief \b DGEQR * * Definition: * =========== @@ -17,7 +18,18 @@ * ============= *> *> \verbatim -*> DGEQR computes a QR factorization of an M-by-N matrix A. +*> +*> DGEQR computes a QR factorization of a real M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -138,7 +150,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -160,10 +172,10 @@ SUBROUTINE DGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/dgeqr2.f b/lapack-netlib/SRC/dgeqr2.f index c1e91e9bd..9ce1feb25 100644 --- a/lapack-netlib/SRC/dgeqr2.f +++ b/lapack-netlib/SRC/dgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> DGEQR2 computes a QR factorization of a real m by n matrix A: -*> A = Q * R. +*> DGEQR2 computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,7 +105,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -121,10 +130,10 @@ * ===================================================================== SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/dgeqr2p.f b/lapack-netlib/SRC/dgeqr2p.f index 921f79921..9b81ccb33 100644 --- a/lapack-netlib/SRC/dgeqr2p.f +++ b/lapack-netlib/SRC/dgeqr2p.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> DGEQR2P computes a QR factorization of a real m by n matrix A: -*> A = Q * R. The diagonal entries of R are nonnegative. +*> DGEQR2P computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix with nonnegative diagonal +*> entries; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -97,7 +107,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -124,10 +134,10 @@ * ===================================================================== SUBROUTINE DGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/dgeqrf.f b/lapack-netlib/SRC/dgeqrf.f index 83d7d8dd7..98666221f 100644 --- a/lapack-netlib/SRC/dgeqrf.f +++ b/lapack-netlib/SRC/dgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> DGEQRF computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -111,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -136,10 +145,10 @@ * ===================================================================== SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/dgeqrfp.f b/lapack-netlib/SRC/dgeqrfp.f index d182f98c9..5cf4069ed 100644 --- a/lapack-netlib/SRC/dgeqrfp.f +++ b/lapack-netlib/SRC/dgeqrfp.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> DGEQRFP computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. The diagonal entries of R are nonnegative. +*> DGEQR2P computes a QR factorization of a real M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix with nonnegative diagonal +*> entries; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -112,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup doubleGEcomputational * @@ -139,10 +149,10 @@ * ===================================================================== SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/dgerfsx.f b/lapack-netlib/SRC/dgerfsx.f index aafca8d10..495ea1726 100644 --- a/lapack-netlib/SRC/dgerfsx.f +++ b/lapack-netlib/SRC/dgerfsx.f @@ -283,7 +283,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -319,14 +319,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -334,9 +334,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/dgesc2.f b/lapack-netlib/SRC/dgesc2.f index 2f01a762f..72d8a38f0 100644 --- a/lapack-netlib/SRC/dgesc2.f +++ b/lapack-netlib/SRC/dgesc2.f @@ -90,7 +90,7 @@ *> \verbatim *> SCALE is DOUBLE PRECISION *> On exit, SCALE contains the scale factor. SCALE is chosen -*> 0 <= SCALE <= 1 to prevent owerflow in the solution. +*> 0 <= SCALE <= 1 to prevent overflow in the solution. *> \endverbatim * * Authors: @@ -151,7 +151,7 @@ * .. * .. Executable Statements .. * -* Set constant to control owerflow +* Set constant to control overflow * EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS diff --git a/lapack-netlib/SRC/dgesdd.f b/lapack-netlib/SRC/dgesdd.f index 926607f98..0218900d2 100644 --- a/lapack-netlib/SRC/dgesdd.f +++ b/lapack-netlib/SRC/dgesdd.f @@ -322,7 +322,7 @@ * IF( WNTQN ) THEN * dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N @@ -448,7 +448,7 @@ * IF( WNTQN ) THEN * dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M diff --git a/lapack-netlib/SRC/dgesvdq.f b/lapack-netlib/SRC/dgesvdq.f new file mode 100644 index 000000000..e495d2bf9 --- /dev/null +++ b/lapack-netlib/SRC/dgesvdq.f @@ -0,0 +1,1385 @@ +*> \brief DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DGESVDQ + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, +* S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, +* WORK, LWORK, RWORK, LRWORK, INFO ) +* +* .. Scalar Arguments .. +* IMPLICIT NONE +* CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV +* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LWORK, LRWORK, +* INFO +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A( LDA, * ), U( LDU, * ), V( LDV, * ), WORK( * ) +* DOUBLE PRECISION S( * ), RWORK( * ) +* INTEGER IWORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DGESVDQ computes the singular value decomposition (SVD) of a real +*> M-by-N matrix A, where M >= N. The SVD of A is written as +*> [++] [xx] [x0] [xx] +*> A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx] +*> [++] [xx] +*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal +*> matrix, and V is an N-by-N orthogonal matrix. The diagonal elements +*> of SIGMA are the singular values of A. The columns of U and V are the +*> left and the right singular vectors of A, respectively. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] JOBA +*> \verbatim +*> JOBA is CHARACTER*1 +*> Specifies the level of accuracy in the computed SVD +*> = 'A' The requested accuracy corresponds to having the backward +*> error bounded by || delta A ||_F <= f(m,n) * EPS * || A ||_F, +*> where EPS = DLAMCH('Epsilon'). This authorises DGESVDQ to +*> truncate the computed triangular factor in a rank revealing +*> QR factorization whenever the truncated part is below the +*> threshold of the order of EPS * ||A||_F. This is aggressive +*> truncation level. +*> = 'M' Similarly as with 'A', but the truncation is more gentle: it +*> is allowed only when there is a drop on the diagonal of the +*> triangular factor in the QR factorization. This is medium +*> truncation level. +*> = 'H' High accuracy requested. No numerical rank determination based +*> on the rank revealing QR factorization is attempted. +*> = 'E' Same as 'H', and in addition the condition number of column +*> scaled A is estimated and returned in RWORK(1). +*> N^(-1/4)*RWORK(1) <= ||pinv(A_scaled)||_2 <= N^(1/4)*RWORK(1) +*> \endverbatim +*> +*> \param[in] JOBP +*> \verbatim +*> JOBP is CHARACTER*1 +*> = 'P' The rows of A are ordered in decreasing order with respect to +*> ||A(i,:)||_\infty. This enhances numerical accuracy at the cost +*> of extra data movement. Recommended for numerical robustness. +*> = 'N' No row pivoting. +*> \endverbatim +*> +*> \param[in] JOBR +*> \verbatim +*> JOBR is CHARACTER*1 +*> = 'T' After the initial pivoted QR factorization, DGESVD is applied to +*> the transposed R**T of the computed triangular factor R. This involves +*> some extra data movement (matrix transpositions). Useful for +*> experiments, research and development. +*> = 'N' The triangular factor R is given as input to DGESVD. This may be +*> preferred as it involves less data movement. +*> \endverbatim +*> +*> \param[in] JOBU +*> \verbatim +*> JOBU is CHARACTER*1 +*> = 'A' All M left singular vectors are computed and returned in the +*> matrix U. See the description of U. +*> = 'S' or 'U' N = min(M,N) left singular vectors are computed and returned +*> in the matrix U. See the description of U. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK left singular +*> vectors are computed and returned in the matrix U. +*> = 'F' The N left singular vectors are returned in factored form as the +*> product of the Q factor from the initial QR factorization and the +*> N left singular vectors of (R**T , 0)**T. If row pivoting is used, +*> then the necessary information on the row pivoting is stored in +*> IWORK(N+1:N+M-1). +*> = 'N' The left singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] JOBV +*> \verbatim +*> JOBV is CHARACTER*1 +*> = 'A', 'V' All N right singular vectors are computed and returned in +*> the matrix V. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK right singular +*> vectors are computed and returned in the matrix V. This option is +*> allowed only if JOBU = 'R' or JOBU = 'N'; otherwise it is illegal. +*> = 'N' The right singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the input matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the input matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array of dimensions LDA x N +*> On entry, the input matrix A. +*> On exit, if JOBU .NE. 'N' or JOBV .NE. 'N', the lower triangle of A contains +*> the Householder vectors as stored by DGEQP3. If JOBU = 'F', these Householder +*> vectors together with WORK(1:N) can be used to restore the Q factors from +*> the initial pivoted QR factorization of A. See the description of U. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER. +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] S +*> \verbatim +*> S is DOUBLE PRECISION array of dimension N. +*> The singular values of A, ordered so that S(i) >= S(i+1). +*> \endverbatim +*> +*> \param[out] U +*> \verbatim +*> U is DOUBLE PRECISION array, dimension +*> LDU x M if JOBU = 'A'; see the description of LDU. In this case, +*> on exit, U contains the M left singular vectors. +*> LDU x N if JOBU = 'S', 'U', 'R' ; see the description of LDU. In this +*> case, U contains the leading N or the leading NUMRANK left singular vectors. +*> LDU x N if JOBU = 'F' ; see the description of LDU. In this case U +*> contains N x N orthogonal matrix that can be used to form the left +*> singular vectors. +*> If JOBU = 'N', U is not referenced. +*> \endverbatim +*> +*> \param[in] LDU +*> \verbatim +*> LDU is INTEGER. +*> The leading dimension of the array U. +*> If JOBU = 'A', 'S', 'U', 'R', LDU >= max(1,M). +*> If JOBU = 'F', LDU >= max(1,N). +*> Otherwise, LDU >= 1. +*> \endverbatim +*> +*> \param[out] V +*> \verbatim +*> V is DOUBLE PRECISION array, dimension +*> LDV x N if JOBV = 'A', 'V', 'R' or if JOBA = 'E' . +*> If JOBV = 'A', or 'V', V contains the N-by-N orthogonal matrix V**T; +*> If JOBV = 'R', V contains the first NUMRANK rows of V**T (the right +*> singular vectors, stored rowwise, of the NUMRANK largest singular values). +*> If JOBV = 'N' and JOBA = 'E', V is used as a workspace. +*> If JOBV = 'N', and JOBA.NE.'E', V is not referenced. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If JOBV = 'A', 'V', 'R', or JOBA = 'E', LDV >= max(1,N). +*> Otherwise, LDV >= 1. +*> \endverbatim +*> +*> \param[out] NUMRANK +*> \verbatim +*> NUMRANK is INTEGER +*> NUMRANK is the numerical rank first determined after the rank +*> revealing QR factorization, following the strategy specified by the +*> value of JOBA. If JOBV = 'R' and JOBU = 'R', only NUMRANK +*> leading singular values and vectors are then requested in the call +*> of DGESVD. The final value of NUMRANK might be further reduced if +*> some singular values are computed as zeros. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (max(1, LIWORK)). +*> On exit, IWORK(1:N) contains column pivoting permutation of the +*> rank revealing QR factorization. +*> If JOBP = 'P', IWORK(N+1:N+M-1) contains the indices of the sequence +*> of row swaps used in row pivoting. These can be used to restore the +*> left singular vectors in the case JOBU = 'F'. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> LIWORK(1) returns the minimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> LIWORK >= N + M - 1, if JOBP = 'P' and JOBA .NE. 'E'; +*> LIWORK >= N if JOBP = 'N' and JOBA .NE. 'E'; +*> LIWORK >= N + M - 1 + N, if JOBP = 'P' and JOBA = 'E'; +*> LIWORK >= N + N if JOBP = 'N' and JOBA = 'E'. +* +*> If LIWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension (max(2, LWORK)), used as a workspace. +*> On exit, if, on entry, LWORK.NE.-1, WORK(1:N) contains parameters +*> needed to recover the Q factor from the QR factorization computed by +*> DGEQP3. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> WORK(1) returns the optimal LWORK, and +*> WORK(2) returns the minimal LWORK. +*> \endverbatim +*> +*> \param[in,out] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. It is determined as follows: +*> Let LWQP3 = 3*N+1, LWCON = 3*N, and let +*> LWORQ = { MAX( N, 1 ), if JOBU = 'R', 'S', or 'U' +*> { MAX( M, 1 ), if JOBU = 'A' +*> LWSVD = MAX( 5*N, 1 ) +*> LWLQF = MAX( N/2, 1 ), LWSVD2 = MAX( 5*(N/2), 1 ), LWORLQ = MAX( N, 1 ), +*> LWQRF = MAX( N/2, 1 ), LWORQ2 = MAX( N, 1 ) +*> Then the minimal value of LWORK is: +*> = MAX( N + LWQP3, LWSVD ) if only the singular values are needed; +*> = MAX( N + LWQP3, LWCON, LWSVD ) if only the singular values are needed, +*> and a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWORQ ) if the singular values and the left +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) if the singular values and the left +*> singular vectors are requested, and also +*> a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD ) if the singular values and the right +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD ) if the singular values and the right +*> singular vectors are requested, and also +*> a scaled condition etimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWORQ ) if the full SVD is requested with JOBV = 'R'; +*> independent of JOBR; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) if the full SVD is requested, +*> JOBV = 'R' and, also a scaled condition +*> estimate requested; independent of JOBR; +*> = MAX( N + MAX( LWQP3, LWSVD, LWORQ ), +*> N + MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, N/2+LWORLQ, LWORQ) ) if the +*> full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWORQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWLQF, N/2+LWSVD2, N/2+LWORLQ, LWORQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N', and also a scaled condition number estimate +*> requested. +*> = MAX( N + MAX( LWQP3, LWSVD, LWORQ ), +*> N + MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, N/2+LWORQ2, LWORQ ) ) if the +*> full SVD is requested with JOBV = 'A', 'V', and JOBR ='T' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWORQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWQRF, N/2+LWSVD2, N/2+LWORQ2, LWORQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='T', and also a scaled condition number estimate +*> requested. +*> Finally, LWORK must be at least two: LWORK = MAX( 2, LWORK ). +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (max(1, LRWORK)). +*> On exit, +*> 1. If JOBA = 'E', RWORK(1) contains an estimate of the condition +*> number of column scaled A. If A = C * D where D is diagonal and C +*> has unit columns in the Euclidean norm, then, assuming full column rank, +*> N^(-1/4) * RWORK(1) <= ||pinv(C)||_2 <= N^(1/4) * RWORK(1). +*> Otherwise, RWORK(1) = -1. +*> 2. RWORK(2) contains the number of singular values computed as +*> exact zeros in DGESVD applied to the upper triangular or trapeziodal +*> R (from the initial QR factorization). In case of early exit (no call to +*> DGESVD, such as in the case of zero matrix) RWORK(2) = -1. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> RWORK(1) returns the minimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER. +*> The dimension of the array RWORK. +*> If JOBP ='P', then LRWORK >= MAX(2, M). +*> Otherwise, LRWORK >= 2 +* +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: if DBDSQR did not converge, INFO specifies how many superdiagonals +*> of an intermediate bidiagonal form B (computed in DGESVD) did not +*> converge to zero. +*> \endverbatim +* +*> \par Further Details: +* ======================== +*> +*> \verbatim +*> +*> 1. The data movement (matrix transpose) is coded using simple nested +*> DO-loops because BLAS and LAPACK do not provide corresponding subroutines. +*> Those DO-loops are easily identified in this source code - by the CONTINUE +*> statements labeled with 11**. In an optimized version of this code, the +*> nested DO loops should be replaced with calls to an optimized subroutine. +*> 2. This code scales A by 1/SQRT(M) if the largest ABS(A(i,j)) could cause +*> column norm overflow. This is the minial precaution and it is left to the +*> SVD routine (CGESVD) to do its own preemptive scaling if potential over- +*> or underflows are detected. To avoid repeated scanning of the array A, +*> an optimal implementation would do all necessary scaling before calling +*> CGESVD and the scaling in CGESVD can be switched off. +*> 3. Other comments related to code optimization are given in comments in the +*> code, enlosed in [[double brackets]]. +*> \endverbatim +* +*> \par Bugs, examples and comments +* =========================== +* +*> \verbatim +*> Please report all bugs and send interesting examples and/or comments to +*> drmac@math.hr. Thank you. +*> \endverbatim +* +*> \par References +* =============== +* +*> \verbatim +*> [1] Zlatko Drmac, Algorithm 977: A QR-Preconditioned QR SVD Method for +*> Computing the SVD with High Accuracy. ACM Trans. Math. Softw. +*> 44(1): 11:1-11:30 (2017) +*> +*> SIGMA library, xGESVDQ section updated February 2016. +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup doubleGEsing +* +* ===================================================================== + SUBROUTINE DGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, + $ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, INFO ) +* .. Scalar Arguments .. + IMPLICIT NONE + CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV + INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LWORK, LRWORK, + $ INFO +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), U( LDU, * ), V( LDV, * ), WORK( * ) + DOUBLE PRECISION S( * ), RWORK( * ) + INTEGER IWORK( * ) +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) +* .. Local Scalars .. + INTEGER IERR, IWOFF, NR, N1, OPTRATIO, p, q + INTEGER LWCON, LWQP3, LWRK_DGELQF, LWRK_DGESVD, LWRK_DGESVD2, + $ LWRK_DGEQP3, LWRK_DGEQRF, LWRK_DORMLQ, LWRK_DORMQR, + $ LWRK_DORMQR2, LWLQF, LWQRF, LWSVD, LWSVD2, LWORQ, + $ LWORQ2, LWORLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2, + $ IMINWRK, RMINWRK + LOGICAL ACCLA, ACCLM, ACCLH, ASCALED, CONDA, DNTWU, DNTWV, + $ LQUERY, LSVC0, LSVEC, ROWPRM, RSVEC, RTRANS, WNTUA, + $ WNTUF, WNTUR, WNTUS, WNTVA, WNTVR + DOUBLE PRECISION BIG, EPSLN, RTMP, SCONDA, SFMIN +* .. Local Arrays + DOUBLE PRECISION RDUMMY(1) +* .. +* .. External Subroutines (BLAS, LAPACK) + EXTERNAL DGELQF, DGEQP3, DGEQRF, DGESVD, DLACPY, DLAPMT, + $ DLASCL, DLASET, DLASWP, DSCAL, DPOCON, DORMLQ, + $ DORMQR, XERBLA +* .. +* .. External Functions (BLAS, LAPACK) + LOGICAL LSAME + INTEGER IDAMAX + DOUBLE PRECISION DLANGE, DNRM2, DLAMCH + EXTERNAL DLANGE, LSAME, IDAMAX, DNRM2, DLAMCH +* .. +* .. Intrinsic Functions .. +* + INTRINSIC ABS, MAX, MIN, DBLE, SQRT +* +* Test the input arguments +* + WNTUS = LSAME( JOBU, 'S' ) .OR. LSAME( JOBU, 'U' ) + WNTUR = LSAME( JOBU, 'R' ) + WNTUA = LSAME( JOBU, 'A' ) + WNTUF = LSAME( JOBU, 'F' ) + LSVC0 = WNTUS .OR. WNTUR .OR. WNTUA + LSVEC = LSVC0 .OR. WNTUF + DNTWU = LSAME( JOBU, 'N' ) +* + WNTVR = LSAME( JOBV, 'R' ) + WNTVA = LSAME( JOBV, 'A' ) .OR. LSAME( JOBV, 'V' ) + RSVEC = WNTVR .OR. WNTVA + DNTWV = LSAME( JOBV, 'N' ) +* + ACCLA = LSAME( JOBA, 'A' ) + ACCLM = LSAME( JOBA, 'M' ) + CONDA = LSAME( JOBA, 'E' ) + ACCLH = LSAME( JOBA, 'H' ) .OR. CONDA +* + ROWPRM = LSAME( JOBP, 'P' ) + RTRANS = LSAME( JOBR, 'T' ) +* + IF ( ROWPRM ) THEN + IF ( CONDA ) THEN + IMINWRK = MAX( 1, N + M - 1 + N ) + ELSE + IMINWRK = MAX( 1, N + M - 1 ) + END IF + RMINWRK = MAX( 2, M ) + ELSE + IF ( CONDA ) THEN + IMINWRK = MAX( 1, N + N ) + ELSE + IMINWRK = MAX( 1, N ) + END IF + RMINWRK = 2 + END IF + LQUERY = (LIWORK .EQ. -1 .OR. LWORK .EQ. -1 .OR. LRWORK .EQ. -1) + INFO = 0 + IF ( .NOT. ( ACCLA .OR. ACCLM .OR. ACCLH ) ) THEN + INFO = -1 + ELSE IF ( .NOT.( ROWPRM .OR. LSAME( JOBP, 'N' ) ) ) THEN + INFO = -2 + ELSE IF ( .NOT.( RTRANS .OR. LSAME( JOBR, 'N' ) ) ) THEN + INFO = -3 + ELSE IF ( .NOT.( LSVEC .OR. DNTWU ) ) THEN + INFO = -4 + ELSE IF ( WNTUR .AND. WNTVA ) THEN + INFO = -5 + ELSE IF ( .NOT.( RSVEC .OR. DNTWV )) THEN + INFO = -5 + ELSE IF ( M.LT.0 ) THEN + INFO = -6 + ELSE IF ( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN + INFO = -7 + ELSE IF ( LDA.LT.MAX( 1, M ) ) THEN + INFO = -9 + ELSE IF ( LDU.LT.1 .OR. ( LSVC0 .AND. LDU.LT.M ) .OR. + $ ( WNTUF .AND. LDU.LT.N ) ) THEN + INFO = -12 + ELSE IF ( LDV.LT.1 .OR. ( RSVEC .AND. LDV.LT.N ) .OR. + $ ( CONDA .AND. LDV.LT.N ) ) THEN + INFO = -14 + ELSE IF ( LIWORK .LT. IMINWRK .AND. .NOT. LQUERY ) THEN + INFO = -17 + END IF +* +* + IF ( INFO .EQ. 0 ) THEN +* .. compute the minimal and the optimal workspace lengths +* [[The expressions for computing the minimal and the optimal +* values of LWORK are written with a lot of redundancy and +* can be simplified. However, this detailed form is easier for +* maintenance and modifications of the code.]] +* +* .. minimal workspace length for DGEQP3 of an M x N matrix + LWQP3 = 3 * N + 1 +* .. minimal workspace length for DORMQR to build left singular vectors + IF ( WNTUS .OR. WNTUR ) THEN + LWORQ = MAX( N , 1 ) + ELSE IF ( WNTUA ) THEN + LWORQ = MAX( M , 1 ) + END IF +* .. minimal workspace length for DPOCON of an N x N matrix + LWCON = 3 * N +* .. DGESVD of an N x N matrix + LWSVD = MAX( 5 * N, 1 ) + IF ( LQUERY ) THEN + CALL DGEQP3( M, N, A, LDA, IWORK, RDUMMY, RDUMMY, -1, + $ IERR ) + LWRK_DGEQP3 = INT( RDUMMY(1) ) + IF ( WNTUS .OR. WNTUR ) THEN + CALL DORMQR( 'L', 'N', M, N, N, A, LDA, RDUMMY, U, + $ LDU, RDUMMY, -1, IERR ) + LWRK_DORMQR = INT( RDUMMY(1) ) + ELSE IF ( WNTUA ) THEN + CALL DORMQR( 'L', 'N', M, M, N, A, LDA, RDUMMY, U, + $ LDU, RDUMMY, -1, IERR ) + LWRK_DORMQR = INT( RDUMMY(1) ) + ELSE + LWRK_DORMQR = 0 + END IF + END IF + MINWRK = 2 + OPTWRK = 2 + IF ( .NOT. (LSVEC .OR. RSVEC )) THEN +* .. minimal and optimal sizes of the workspace if +* only the singular values are requested + IF ( CONDA ) THEN + MINWRK = MAX( N+LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = MAX( N+LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + CALL DGESVD( 'N', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = MAX( N+LWRK_DGEQP3, N+LWCON, LWRK_DGESVD ) + ELSE + OPTWRK = MAX( N+LWRK_DGEQP3, LWRK_DGESVD ) + END IF + END IF + ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN +* .. minimal and optimal sizes of the workspace if the +* singular values and the left singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD, LWORQ ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL DGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + ELSE + CALL DGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + END IF + LWRK_DGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_DGEQP3, LWCON, LWRK_DGESVD, + $ LWRK_DORMQR ) + ELSE + OPTWRK = N + MAX( LWRK_DGEQP3, LWRK_DGESVD, + $ LWRK_DORMQR ) + END IF + END IF + ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN +* .. minimal and optimal sizes of the workspace if the +* singular values and the right singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL DGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + ELSE + CALL DGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + END IF + LWRK_DGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_DGEQP3, LWCON, LWRK_DGESVD ) + ELSE + OPTWRK = N + MAX( LWRK_DGEQP3, LWRK_DGESVD ) + END IF + END IF + ELSE +* .. minimal and optimal sizes of the workspace if the +* full SVD is requested + IF ( RTRANS ) THEN + MINWRK = MAX( LWQP3, LWSVD, LWORQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N x N/2 DGEQRF + LWQRF = MAX( N/2, 1 ) +* .. minimal workspace lengt for N/2 x N/2 DGESVD + LWSVD2 = MAX( 5 * (N/2), 1 ) + LWORQ2 = MAX( N, 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, + $ N/2+LWORQ2, LWORQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + ELSE + MINWRK = MAX( LWQP3, LWSVD, LWORQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N/2 x N DGELQF + LWLQF = MAX( N/2, 1 ) + LWSVD2 = MAX( 5 * (N/2), 1 ) + LWORLQ = MAX( N , 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, + $ N/2+LWORLQ, LWORQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL DGESVD( 'O', 'A', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DGESVD = INT( RDUMMY(1) ) + OPTWRK = MAX(LWRK_DGEQP3,LWRK_DGESVD,LWRK_DORMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL DGEQRF(N,N/2,U,LDU,RDUMMY,RDUMMY,-1,IERR) + LWRK_DGEQRF = INT( RDUMMY(1) ) + CALL DGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DGESVD2 = INT( RDUMMY(1) ) + CALL DORMQR( 'R', 'C', N, N, N/2, U, LDU, RDUMMY, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DORMQR2 = INT( RDUMMY(1) ) + OPTWRK2 = MAX( LWRK_DGEQP3, N/2+LWRK_DGEQRF, + $ N/2+LWRK_DGESVD2, N/2+LWRK_DORMQR2 ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + ELSE + CALL DGESVD( 'S', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DGESVD = INT( RDUMMY(1) ) + OPTWRK = MAX(LWRK_DGEQP3,LWRK_DGESVD,LWRK_DORMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL DGELQF(N/2,N,U,LDU,RDUMMY,RDUMMY,-1,IERR) + LWRK_DGELQF = INT( RDUMMY(1) ) + CALL DGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_DGESVD2 = INT( RDUMMY(1) ) + CALL DORMLQ( 'R', 'N', N, N, N/2, U, LDU, RDUMMY, + $ V, LDV, RDUMMY,-1,IERR ) + LWRK_DORMLQ = INT( RDUMMY(1) ) + OPTWRK2 = MAX( LWRK_DGEQP3, N/2+LWRK_DGELQF, + $ N/2+LWRK_DGESVD2, N/2+LWRK_DORMLQ ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + END IF + END IF + END IF +* + MINWRK = MAX( 2, MINWRK ) + OPTWRK = MAX( 2, OPTWRK ) + IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = -19 +* + END IF +* + IF (INFO .EQ. 0 .AND. LRWORK .LT. RMINWRK .AND. .NOT. LQUERY) THEN + INFO = -21 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DGESVDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +* +* Return optimal workspace +* + IWORK(1) = IMINWRK + WORK(1) = OPTWRK + WORK(2) = MINWRK + RWORK(1) = RMINWRK + RETURN + END IF +* +* Quick return if the matrix is void. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) THEN +* .. all output is void. + RETURN + END IF +* + BIG = DLAMCH('O') + ASCALED = .FALSE. + IWOFF = 1 + IF ( ROWPRM ) THEN + IWOFF = M +* .. reordering the rows in decreasing sequence in the +* ell-infinity norm - this enhances numerical robustness in +* the case of differently scaled rows. + DO 1904 p = 1, M +* RWORK(p) = ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) +* [[DLANGE will return NaN if an entry of the p-th row is Nan]] + RWORK(p) = DLANGE( 'M', 1, N, A(p,1), LDA, RDUMMY ) +* .. check for NaN's and Inf's + IF ( ( RWORK(p) .NE. RWORK(p) ) .OR. + $ ( (RWORK(p)*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'DGESVDQ', -INFO ) + RETURN + END IF + 1904 CONTINUE + DO 1952 p = 1, M - 1 + q = IDAMAX( M-p+1, RWORK(p), 1 ) + p - 1 + IWORK(N+p) = q + IF ( p .NE. q ) THEN + RTMP = RWORK(p) + RWORK(p) = RWORK(q) + RWORK(q) = RTMP + END IF + 1952 CONTINUE +* + IF ( RWORK(1) .EQ. ZERO ) THEN +* Quick return: A is the M x N zero matrix. + NUMRANK = 0 + CALL DLASET( 'G', N, 1, ZERO, ZERO, S, N ) + IF ( WNTUS ) CALL DLASET('G', M, N, ZERO, ONE, U, LDU) + IF ( WNTUA ) CALL DLASET('G', M, M, ZERO, ONE, U, LDU) + IF ( WNTVA ) CALL DLASET('G', N, N, ZERO, ONE, V, LDV) + IF ( WNTUF ) THEN + CALL DLASET( 'G', N, 1, ZERO, ZERO, WORK, N ) + CALL DLASET( 'G', M, N, ZERO, ONE, U, LDU ) + END IF + DO 5001 p = 1, N + IWORK(p) = p + 5001 CONTINUE + IF ( ROWPRM ) THEN + DO 5002 p = N + 1, N + M - 1 + IWORK(p) = p - N + 5002 CONTINUE + END IF + IF ( CONDA ) RWORK(1) = -1 + RWORK(2) = -1 + RETURN + END IF +* + IF ( RWORK(1) .GT. BIG / SQRT(DBLE(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL DLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + CALL DLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) + END IF +* +* .. At this stage, preemptive scaling is done only to avoid column +* norms overflows during the QR factorization. The SVD procedure should +* have its own scaling to save the singular values from overflows and +* underflows. That depends on the SVD procedure. +* + IF ( .NOT.ROWPRM ) THEN + RTMP = DLANGE( 'M', M, N, A, LDA, RDUMMY ) + IF ( ( RTMP .NE. RTMP ) .OR. + $ ( (RTMP*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'DGESVDQ', -INFO ) + RETURN + END IF + IF ( RTMP .GT. BIG / SQRT(DBLE(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL DLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + END IF +* +* .. QR factorization with column pivoting +* +* A * P = Q * [ R ] +* [ 0 ] +* + DO 1963 p = 1, N +* .. all columns are free columns + IWORK(p) = 0 + 1963 CONTINUE + CALL DGEQP3( M, N, A, LDA, IWORK, WORK, WORK(N+1), LWORK-N, + $ IERR ) +* +* If the user requested accuracy level allows truncation in the +* computed upper triangular factor, the matrix R is examined and, +* if possible, replaced with its leading upper trapezoidal part. +* + EPSLN = DLAMCH('E') + SFMIN = DLAMCH('S') +* SMALL = SFMIN / EPSLN + NR = N +* + IF ( ACCLA ) THEN +* +* Standard absolute error bound suffices. All sigma_i with +* sigma_i < N*EPS*||A||_F are flushed to zero. This is an +* aggressive enforcement of lower numerical rank by introducing a +* backward error of the order of N*EPS*||A||_F. + NR = 1 + RTMP = SQRT(DBLE(N))*EPSLN + DO 3001 p = 2, N + IF ( ABS(A(p,p)) .LT. (RTMP*ABS(A(1,1))) ) GO TO 3002 + NR = NR + 1 + 3001 CONTINUE + 3002 CONTINUE +* + ELSEIF ( ACCLM ) THEN +* .. similarly as above, only slightly more gentle (less aggressive). +* Sudden drop on the diagonal of R is used as the criterion for being +* close-to-rank-deficient. The threshold is set to EPSLN=DLAMCH('E'). +* [[This can be made more flexible by replacing this hard-coded value +* with a user specified threshold.]] Also, the values that underflow +* will be truncated. + NR = 1 + DO 3401 p = 2, N + IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. + $ ( ABS(A(p,p)) .LT. SFMIN ) ) GO TO 3402 + NR = NR + 1 + 3401 CONTINUE + 3402 CONTINUE +* + ELSE +* .. RRQR not authorized to determine numerical rank except in the +* obvious case of zero pivots. +* .. inspect R for exact zeros on the diagonal; +* R(i,i)=0 => R(i:N,i:N)=0. + NR = 1 + DO 3501 p = 2, N + IF ( ABS(A(p,p)) .EQ. ZERO ) GO TO 3502 + NR = NR + 1 + 3501 CONTINUE + 3502 CONTINUE +* + IF ( CONDA ) THEN +* Estimate the scaled condition number of A. Use the fact that it is +* the same as the scaled condition number of R. +* .. V is used as workspace + CALL DLACPY( 'U', N, N, A, LDA, V, LDV ) +* Only the leading NR x NR submatrix of the triangular factor +* is considered. Only if NR=N will this give a reliable error +* bound. However, even for NR < N, this can be used on an +* expert level and obtain useful information in the sense of +* perturbation theory. + DO 3053 p = 1, NR + RTMP = DNRM2( p, V(1,p), 1 ) + CALL DSCAL( p, ONE/RTMP, V(1,p), 1 ) + 3053 CONTINUE + IF ( .NOT. ( LSVEC .OR. RSVEC ) ) THEN + CALL DPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ WORK, IWORK(N+IWOFF), IERR ) + ELSE + CALL DPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ WORK(N+1), IWORK(N+IWOFF), IERR ) + END IF + SCONDA = ONE / SQRT(RTMP) +* For NR=N, SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1), +* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA +* See the reference [1] for more details. + END IF +* + ENDIF +* + IF ( WNTUR ) THEN + N1 = NR + ELSE IF ( WNTUS .OR. WNTUF) THEN + N1 = N + ELSE IF ( WNTUA ) THEN + N1 = M + END IF +* + IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN +*....................................................................... +* .. only the singular values are requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. compute the singular values of R**T = [A](1:NR,1:N)**T +* .. set the lower triangle of [A] to [A](1:NR,1:N)**T and +* the upper triangle of [A] to zero. + DO 1146 p = 1, MIN( N, NR ) + DO 1147 q = p + 1, N + A(q,p) = A(p,q) + IF ( q .LE. NR ) A(p,q) = ZERO + 1147 CONTINUE + 1146 CONTINUE +* + CALL DGESVD( 'N', 'N', N, NR, A, LDA, S, U, LDU, + $ V, LDV, WORK, LWORK, INFO ) +* + ELSE +* +* .. compute the singular values of R = [A](1:NR,1:N) +* + IF ( NR .GT. 1 ) + $ CALL DLASET( 'L', NR-1,NR-1, ZERO,ZERO, A(2,1), LDA ) + CALL DGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, + $ V, LDV, WORK, LWORK, INFO ) +* + END IF +* + ELSE IF ( LSVEC .AND. ( .NOT. RSVEC) ) THEN +*....................................................................... +* .. the singular values and the left singular vectors requested +*......................................................................."""""""" + IF ( RTRANS ) THEN +* .. apply DGESVD to R**T +* .. copy R**T into [U] and overwrite [U] with the right singular +* vectors of R + DO 1192 p = 1, NR + DO 1193 q = p, N + U(q,p) = A(p,q) + 1193 CONTINUE + 1192 CONTINUE + IF ( NR .GT. 1 ) + $ CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, U(1,2), LDU ) +* .. the left singular vectors not computed, the NR right singular +* vectors overwrite [U](1:NR,1:NR) as transposed. These +* will be pre-multiplied by Q to build the left singular vectors of A. + CALL DGESVD( 'N', 'O', N, NR, U, LDU, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1119 p = 1, NR + DO 1120 q = p + 1, NR + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1120 CONTINUE + 1119 CONTINUE +* + ELSE +* .. apply DGESVD to R +* .. copy R into [U] and overwrite [U] with the left singular vectors + CALL DLACPY( 'U', NR, N, A, LDA, U, LDU ) + IF ( NR .GT. 1 ) + $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), LDU ) +* .. the right singular vectors not computed, the NR left singular +* vectors overwrite [U](1:NR,1:NR) + CALL DGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) +* .. now [U](1:NR,1:NR) contains the NR left singular vectors of +* R. These will be pre-multiplied by Q to build the left singular +* vectors of A. + END IF +* +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN + CALL DLASET('A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL DLASET( 'A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), LDU ) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT.WNTUF ) + $ CALL DORMQR( 'L', 'N', M, N1, N, A, LDA, WORK, U, + $ LDU, WORK(N+1), LWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* + ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN +*....................................................................... +* .. the singular values and the right singular vectors requested +*....................................................................... + IF ( RTRANS ) THEN +* .. apply DGESVD to R**T +* .. copy R**T into V and overwrite V with the left singular vectors + DO 1165 p = 1, NR + DO 1166 q = p, N + V(q,p) = (A(p,q)) + 1166 CONTINUE + 1165 CONTINUE + IF ( NR .GT. 1 ) + $ CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV ) +* .. the left singular vectors of R**T overwrite V, the right singular +* vectors not computed + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL DGESVD( 'O', 'N', N, NR, V, LDV, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1121 p = 1, NR + DO 1122 q = p + 1, NR + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1122 CONTINUE + 1121 CONTINUE +* + IF ( NR .LT. N ) THEN + DO 1103 p = 1, NR + DO 1104 q = NR + 1, N + V(p,q) = V(q,p) + 1104 CONTINUE + 1103 CONTINUE + END IF + CALL DLAPMT( .FALSE., NR, N, V, LDV, IWORK ) + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:N,1:NR) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the QR factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL DLASET('G', N, N-NR, ZERO, ZERO, V(1,NR+1), LDV) + CALL DGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1123 p = 1, N + DO 1124 q = p + 1, N + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1124 CONTINUE + 1123 CONTINUE + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* + ELSE +* .. aply DGESVD to R +* .. copy R into V and overwrite V with the right singular vectors + CALL DLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL DLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), LDV ) +* .. the right singular vectors overwrite V, the NR left singular +* vectors stored in U(1:NR,1:NR) + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL DGESVD( 'N', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL DLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**T + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:NR,1:N) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the LQ factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL DLASET('G', N-NR, N, ZERO,ZERO, V(NR+1,1), LDV) + CALL DGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* .. now [V] contains the transposed matrix of the right singular +* vectors of A. + END IF +* + ELSE +*....................................................................... +* .. FULL SVD requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. apply DGESVD to R**T [[this option is left for R&D&T]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R**T into [V] and overwrite [V] with the left singular +* vectors of R**T + DO 1168 p = 1, NR + DO 1169 q = p, N + V(q,p) = A(p,q) + 1169 CONTINUE + 1168 CONTINUE + IF ( NR .GT. 1 ) + $ CALL DLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV ) +* +* .. the left singular vectors of R**T overwrite [V], the NR right +* singular vectors of R**T stored in [U](1:NR,1:NR) as transposed + CALL DGESVD( 'O', 'A', N, NR, V, LDV, S, V, LDV, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* .. assemble V + DO 1115 p = 1, NR + DO 1116 q = p + 1, NR + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1116 CONTINUE + 1115 CONTINUE + IF ( NR .LT. N ) THEN + DO 1101 p = 1, NR + DO 1102 q = NR+1, N + V(p,q) = V(q,p) + 1102 CONTINUE + 1101 CONTINUE + END IF + CALL DLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* + DO 1117 p = 1, NR + DO 1118 q = p + 1, NR + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1118 CONTINUE + 1117 CONTINUE +* + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. copy R**T into [V] and overwrite [V] with the left singular +* vectors of R**T +* [[The optimal ratio N/NR for using QRF instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'DGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO*NR .GT. N ) THEN + DO 1198 p = 1, NR + DO 1199 q = p, N + V(q,p) = A(p,q) + 1199 CONTINUE + 1198 CONTINUE + IF ( NR .GT. 1 ) + $ CALL DLASET('U',NR-1,NR-1, ZERO,ZERO, V(1,2),LDV) +* + CALL DLASET('A',N,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL DGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1113 p = 1, N + DO 1114 q = p + 1, N + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1114 CONTINUE + 1113 CONTINUE + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). +* + DO 1111 p = 1, N + DO 1112 q = p + 1, N + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1112 CONTINUE + 1111 CONTINUE +* + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL DLASET('A',M-N,N1-N,ZERO,ONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE +* .. copy R**T into [U] and overwrite [U] with the right +* singular vectors of R + DO 1196 p = 1, NR + DO 1197 q = p, N + U(q,NR+p) = A(p,q) + 1197 CONTINUE + 1196 CONTINUE + IF ( NR .GT. 1 ) + $ CALL DLASET('U',NR-1,NR-1,ZERO,ZERO,U(1,NR+2),LDU) + CALL DGEQRF( N, NR, U(1,NR+1), LDU, WORK(N+1), + $ WORK(N+NR+1), LWORK-N-NR, IERR ) + DO 1143 p = 1, NR + DO 1144 q = 1, N + V(q,p) = U(p,NR+q) + 1144 CONTINUE + 1143 CONTINUE + CALL DLASET('U',NR-1,NR-1,ZERO,ZERO,V(1,2),LDV) + CALL DGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V,LDV, WORK(N+NR+1),LWORK-N-NR, INFO ) + CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) + CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL DORMQR('R','C', N, N, NR, U(1,NR+1), LDU, + $ WORK(N+1),V,LDV,WORK(N+NR+1),LWORK-N-NR,IERR) + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1),LDU) + END IF + END IF + END IF + END IF +* + ELSE +* +* .. apply DGESVD to R [[this is the recommended option]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R into [V] and overwrite V with the right singular vectors + CALL DLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL DLASET( 'L', NR-1,NR-1, ZERO,ZERO, V(2,1), LDV ) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL DGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL DLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**T +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. the requested number of the left singular vectors +* is then N1 (N or M) +* [[The optimal ratio N/NR for using LQ instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'DGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO * NR .GT. N ) THEN + CALL DLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL DLASET('L', NR-1,NR-1, ZERO,ZERO, V(2,1),LDV) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL DLASET('A', N-NR,N, ZERO,ZERO, V(NR+1,1),LDV) + CALL DGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. now [V] contains the transposed matrix of the right +* singular vectors of A. The leading N left singular vectors +* are in [U](1:N,1:N) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL DLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL DLASET( 'A',M-N,N1-N,ZERO,ONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE + CALL DLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) + IF ( NR .GT. 1 ) + $ CALL DLASET('L',NR-1,NR-1,ZERO,ZERO,U(NR+2,1),LDU) + CALL DGELQF( NR, N, U(NR+1,1), LDU, WORK(N+1), + $ WORK(N+NR+1), LWORK-N-NR, IERR ) + CALL DLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) + IF ( NR .GT. 1 ) + $ CALL DLASET('U',NR-1,NR-1,ZERO,ZERO,V(1,2),LDV) + CALL DGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+NR+1), LWORK-N-NR, INFO ) + CALL DLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) + CALL DLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL DLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL DORMLQ('R','N',N,N,NR,U(NR+1,1),LDU,WORK(N+1), + $ V, LDV, WORK(N+NR+1),LWORK-N-NR,IERR) + CALL DLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL DLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL DLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL DLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF + END IF + END IF +* .. end of the "R**T or R" branch + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT. WNTUF ) + $ CALL DORMQR( 'L', 'N', M, N1, N, A, LDA, WORK, U, + $ LDU, WORK(N+1), LWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL DLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* +* ... end of the "full SVD" branch + END IF +* +* Check whether some singular values are returned as zeros, e.g. +* due to underflow, and update the numerical rank. + p = NR + DO 4001 q = p, 1, -1 + IF ( S(q) .GT. ZERO ) GO TO 4002 + NR = NR - 1 + 4001 CONTINUE + 4002 CONTINUE +* +* .. if numerical rank deficiency is detected, the truncated +* singular values are set to zero. + IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) +* .. undo scaling; this may cause overflow in the largest singular +* values. + IF ( ASCALED ) + $ CALL DLASCL( 'G',0,0, ONE,SQRT(DBLE(M)), NR,1, S, N, IERR ) + IF ( CONDA ) RWORK(1) = SCONDA + RWORK(2) = p - NR +* .. p-NR is the number of singular values that are computed as +* exact zeros in DGESVD() applied to the (possibly truncated) +* full row rank triangular (trapezoidal) factor of A. + NUMRANK = NR +* + RETURN +* +* End of DGESVDQ +* + END diff --git a/lapack-netlib/SRC/dgesvj.f b/lapack-netlib/SRC/dgesvj.f index 2cbc5ce0e..cf7aac982 100644 --- a/lapack-netlib/SRC/dgesvj.f +++ b/lapack-netlib/SRC/dgesvj.f @@ -90,13 +90,13 @@ *> JOBV is CHARACTER*1 *> Specifies whether to compute the right singular vectors, that *> is, the matrix V: -*> = 'V' : the matrix V is computed and returned in the array V -*> = 'A' : the Jacobi rotations are applied to the MV-by-N +*> = 'V': the matrix V is computed and returned in the array V +*> = 'A': the Jacobi rotations are applied to the MV-by-N *> array V. In other words, the right singular vector *> matrix V is not computed explicitly, instead it is *> applied to an MV-by-N matrix initially stored in the *> first MV rows of V. -*> = 'N' : the matrix V is not computed and the array V is not +*> = 'N': the matrix V is not computed and the array V is not *> referenced *> \endverbatim *> @@ -118,8 +118,8 @@ *> A is DOUBLE PRECISION array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit : -*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C' : -*> If INFO .EQ. 0 : +*> If JOBU = 'U' .OR. JOBU = 'C' : +*> If INFO = 0 : *> RANKA orthonormal columns of U are returned in the *> leading RANKA columns of the array A. Here RANKA <= N *> is the number of computed singular values of A that are @@ -129,9 +129,9 @@ *> in the array WORK as RANKA=NINT(WORK(2)). Also see the *> descriptions of SVA and WORK. The computed columns of U *> are mutually numerically orthogonal up to approximately -*> TOL=DSQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'), +*> TOL=DSQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU = 'C'), *> see the description of JOBU. -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure DGESVJ did not converge in the given number *> of iterations (sweeps). In that case, the computed *> columns of U may not be orthogonal up to TOL. The output @@ -140,8 +140,8 @@ *> input matrix A in the sense that the residual *> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small. *> -*> If JOBU .EQ. 'N' : -*> If INFO .EQ. 0 : +*> If JOBU = 'N' : +*> If INFO = 0 : *> Note that the left singular vectors are 'for free' in the *> one-sided Jacobi SVD algorithm. However, if only the *> singular values are needed, the level of numerical @@ -150,7 +150,7 @@ *> numerically orthogonal up to approximately M*EPS. Thus, *> on exit, A contains the columns of U scaled with the *> corresponding singular values. -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure DGESVJ did not converge in the given number *> of iterations (sweeps). *> \endverbatim @@ -165,9 +165,9 @@ *> \verbatim *> SVA is DOUBLE PRECISION array, dimension (N) *> On exit : -*> If INFO .EQ. 0 : +*> If INFO = 0 : *> depending on the value SCALE = WORK(1), we have: -*> If SCALE .EQ. ONE : +*> If SCALE = ONE : *> SVA(1:N) contains the computed singular values of A. *> During the computation SVA contains the Euclidean column *> norms of the iterated matrices in the array A. @@ -175,7 +175,7 @@ *> The singular values of A are SCALE*SVA(1:N), and this *> factored representation is due to the fact that some of the *> singular values of A might underflow or overflow. -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure DGESVJ did not converge in the given number of *> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate. *> \endverbatim @@ -183,7 +183,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then the product of Jacobi rotations in DGESVJ +*> If JOBV = 'A', then the product of Jacobi rotations in DGESVJ *> is applied to the first MV rows of V. See the description of JOBV. *> \endverbatim *> @@ -201,16 +201,16 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V, LDV .GE. 1. -*> If JOBV .EQ. 'V', then LDV .GE. max(1,N). -*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) . +*> The leading dimension of the array V, LDV >= 1. +*> If JOBV = 'V', then LDV >= max(1,N). +*> If JOBV = 'A', then LDV >= max(1,MV) . *> \endverbatim *> *> \param[in,out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (LWORK) *> On entry : -*> If JOBU .EQ. 'C' : +*> If JOBU = 'C' : *> WORK(1) = CTOL, where CTOL defines the threshold for convergence. *> The process stops if all columns of A are mutually *> orthogonal up to CTOL*EPS, EPS=DLAMCH('E'). @@ -230,7 +230,7 @@ *> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep. *> This is useful information in cases when DGESVJ did *> not converge, as it can be used to estimate whether -*> the output is stil useful and for post festum analysis. +*> the output is still useful and for post festum analysis. *> WORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. @@ -245,9 +245,9 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value -*> > 0 : DGESVJ did not converge in the maximal allowed number (30) +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value +*> > 0: DGESVJ did not converge in the maximal allowed number (30) *> of sweeps. The output may still be useful. See the *> description of WORK. *> \endverbatim diff --git a/lapack-netlib/SRC/dgesvxx.f b/lapack-netlib/SRC/dgesvxx.f index afcd05d8e..21b56f61c 100644 --- a/lapack-netlib/SRC/dgesvxx.f +++ b/lapack-netlib/SRC/dgesvxx.f @@ -411,7 +411,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -447,14 +447,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -462,9 +462,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/dgetc2.f b/lapack-netlib/SRC/dgetc2.f index 0896a7013..5bf5b890f 100644 --- a/lapack-netlib/SRC/dgetc2.f +++ b/lapack-netlib/SRC/dgetc2.f @@ -85,7 +85,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: if INFO = k, U(k, k) is likely to produce owerflow if +*> > 0: if INFO = k, U(k, k) is likely to produce overflow if *> we try to solve for x in Ax = b. So U is perturbed to *> avoid the overflow. *> \endverbatim diff --git a/lapack-netlib/SRC/dgetsls.f b/lapack-netlib/SRC/dgetsls.f index 3b44a40ab..dfc72c8b2 100644 --- a/lapack-netlib/SRC/dgetsls.f +++ b/lapack-netlib/SRC/dgetsls.f @@ -1,3 +1,5 @@ +*> \brief \b DGETSLS +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/dggesx.f b/lapack-netlib/SRC/dggesx.f index 47022fbdf..0e57d636e 100644 --- a/lapack-netlib/SRC/dggesx.f +++ b/lapack-netlib/SRC/dggesx.f @@ -131,10 +131,10 @@ *> \verbatim *> SENSE is CHARACTER*1 *> Determines which reciprocal condition numbers are computed. -*> = 'N' : None are computed; -*> = 'E' : Computed for average of selected eigenvalues only; -*> = 'V' : Computed for selected deflating subspaces only; -*> = 'B' : Computed for both. +*> = 'N': None are computed; +*> = 'E': Computed for average of selected eigenvalues only; +*> = 'V': Computed for selected deflating subspaces only; +*> = 'B': Computed for both. *> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'. *> \endverbatim *> diff --git a/lapack-netlib/SRC/dgsvj0.f b/lapack-netlib/SRC/dgsvj0.f index 4fd38d37e..318e369fd 100644 --- a/lapack-netlib/SRC/dgsvj0.f +++ b/lapack-netlib/SRC/dgsvj0.f @@ -117,7 +117,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -125,9 +125,9 @@ *> \param[in,out] V *> \verbatim *> V is DOUBLE PRECISION array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -136,8 +136,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -157,7 +157,7 @@ *> TOL is DOUBLE PRECISION *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -175,14 +175,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: @@ -1045,7 +1045,7 @@ 1993 CONTINUE * end i=1:NSWEEP loop -* #:) Reaching this point means that the procedure has comleted the given +* #:) Reaching this point means that the procedure has completed the given * number of iterations. INFO = NSWEEP - 1 GO TO 1995 diff --git a/lapack-netlib/SRC/dgsvj1.f b/lapack-netlib/SRC/dgsvj1.f index 376682c7f..35a93619f 100644 --- a/lapack-netlib/SRC/dgsvj1.f +++ b/lapack-netlib/SRC/dgsvj1.f @@ -61,7 +61,7 @@ *> In terms of the columns of A, the first N1 columns are rotated 'against' *> the remaining N-N1 columns, trying to increase the angle between the *> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is -*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter. +*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parameter. *> The number of sweeps is given in NSWEEP and the orthogonality threshold *> is given in TOL. *> \endverbatim @@ -147,27 +147,27 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a -*> sequence of Jacobi rotations. -*> If JOBV = 'N', then MV is not referenced. +*> If JOBV = 'A', then MV rows of V are post-multipled by a +*> sequence of Jacobi rotations. +*> If JOBV = 'N', then MV is not referenced. *> \endverbatim *> *> \param[in,out] V *> \verbatim *> V is DOUBLE PRECISION array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a -*> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a -*> sequence of Jacobi rotations. -*> If JOBV = 'N', then V is not referenced. +*> If JOBV = 'V', then N rows of V are post-multipled by a +*> sequence of Jacobi rotations. +*> If JOBV = 'A', then MV rows of V are post-multipled by a +*> sequence of Jacobi rotations. +*> If JOBV = 'N', then V is not referenced. *> \endverbatim *> *> \param[in] LDV *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -187,7 +187,7 @@ *> TOL is DOUBLE PRECISION *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if DABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -205,14 +205,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/dhseqr.f b/lapack-netlib/SRC/dhseqr.f index 4444b955f..b4fc3af90 100644 --- a/lapack-netlib/SRC/dhseqr.f +++ b/lapack-netlib/SRC/dhseqr.f @@ -70,7 +70,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -87,7 +87,7 @@ *> set by a previous call to DGEBAL, and then passed to ZGEHRD *> when the matrix output by DGEBAL is reduced to Hessenberg *> form. Otherwise ILO and IHI should be set to 1 and N -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -100,20 +100,20 @@ *> (the Schur form); 2-by-2 diagonal blocks (corresponding to *> complex conjugate pairs of eigenvalues) are returned in *> standard form, with H(i,i) = H(i+1,i+1) and -*> H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the +*> H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and JOB = 'E', the *> contents of H are unspecified on exit. (The output value of -*> H when INFO.GT.0 is given under the description of INFO +*> H when INFO > 0 is given under the description of INFO *> below.) *> *> Unlike earlier versions of DHSEQR, this subroutine may -*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 +*> explicitly H(i,j) = 0 for i > j and j = 1, 2, ... ILO-1 *> or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -128,8 +128,8 @@ *> The real and imaginary parts, respectively, of the computed *> eigenvalues. If two eigenvalues are computed as a complex *> conjugate pair, they are stored in consecutive elements of -*> WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and -*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in +*> WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and +*> WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in *> the same order as on the diagonal of the Schur form returned *> in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 *> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and @@ -148,7 +148,7 @@ *> if INFO = 0, Z contains Q*Z. *> Normally Q is the orthogonal matrix generated by DORGHR *> after the call to DGEHRD which formed the Hessenberg matrix -*> H. (The output value of Z when INFO.GT.0 is given under +*> H. (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -156,7 +156,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if COMPZ = 'I' or -*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. +*> COMPZ = 'V', then LDZ >= MAX(1,N). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -169,7 +169,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient and delivers very good and sometimes *> optimal performance. However, LWORK as large as 11*N *> may be required for optimal performance. A workspace @@ -187,21 +187,21 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .LT. 0: if INFO = -i, the i-th argument had an illegal +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal *> value -*> .GT. 0: if INFO = i, DHSEQR failed to compute all of +*> > 0: if INFO = i, DHSEQR failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and JOB = 'E', then on exit, the +*> If INFO > 0 and JOB = 'E', then on exit, the *> remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and JOB = 'S', then on exit +*> If INFO > 0 and JOB = 'S', then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -209,19 +209,19 @@ *> value of H is upper Hessenberg and quasi-triangular *> in rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and COMPZ = 'V', then on exit +*> If INFO > 0 and COMPZ = 'V', then on exit *> *> (final value of Z) = (initial value of Z)*U *> *> where U is the orthogonal matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'I', then on exit +*> If INFO > 0 and COMPZ = 'I', then on exit *> (final value of Z) = U *> where U is the orthogonal matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'N', then Z is not +*> If INFO > 0 and COMPZ = 'N', then Z is not *> accessed. *> \endverbatim * @@ -261,8 +261,8 @@ *> This depends on ILO, IHI and NS. NS is the *> number of simultaneous shifts returned *> by ILAENV(ISPEC=15). (See ISPEC=15 below.) -*> The default for (IHI-ILO+1).LE.500 is NS. -*> The default for (IHI-ILO+1).GT.500 is 3*NS/2. +*> The default for (IHI-ILO+1) <= 500 is NS. +*> The default for (IHI-ILO+1) > 500 is 3*NS/2. *> *> ISPEC=14: Nibble crossover point. (See IPARMQ for *> details.) Default: 14% of deflation window @@ -341,8 +341,8 @@ PARAMETER ( NTINY = 11 ) * * ==== NL allocates some local workspace to help small matrices -* . through a rare DLAHQR failure. NL .GT. NTINY = 11 is -* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- +* . through a rare DLAHQR failure. NL > NTINY = 11 is +* . required and NL <= NMIN = ILAENV(ISPEC=12,...) is recom- * . mended. (The default value of NMIN is 75.) Using NL = 49 * . allows up to six simultaneous shifts and a 16-by-16 * . deflation window. ==== diff --git a/lapack-netlib/SRC/dla_gbrcond.f b/lapack-netlib/SRC/dla_gbrcond.f index e9713c9ca..c9eebcbea 100644 --- a/lapack-netlib/SRC/dla_gbrcond.f +++ b/lapack-netlib/SRC/dla_gbrcond.f @@ -141,13 +141,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (5*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/dla_gbrfsx_extended.f b/lapack-netlib/SRC/dla_gbrfsx_extended.f index 12b2a32a4..282a63f1c 100644 --- a/lapack-netlib/SRC/dla_gbrfsx_extended.f +++ b/lapack-netlib/SRC/dla_gbrfsx_extended.f @@ -66,19 +66,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -270,7 +270,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/dla_gercond.f b/lapack-netlib/SRC/dla_gercond.f index aa93ca5a4..6f7d70a6a 100644 --- a/lapack-netlib/SRC/dla_gercond.f +++ b/lapack-netlib/SRC/dla_gercond.f @@ -123,13 +123,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/dla_gerfsx_extended.f b/lapack-netlib/SRC/dla_gerfsx_extended.f index 082f810f0..4cb9ef4f9 100644 --- a/lapack-netlib/SRC/dla_gerfsx_extended.f +++ b/lapack-netlib/SRC/dla_gerfsx_extended.f @@ -64,19 +64,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -256,7 +256,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERRS_C is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERRS_C is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERRS_C(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/dla_porcond.f b/lapack-netlib/SRC/dla_porcond.f index 498e707e3..b2f9c4b1e 100644 --- a/lapack-netlib/SRC/dla_porcond.f +++ b/lapack-netlib/SRC/dla_porcond.f @@ -113,13 +113,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/dla_porfsx_extended.f b/lapack-netlib/SRC/dla_porfsx_extended.f index 8c0d6bebd..ece9b00ed 100644 --- a/lapack-netlib/SRC/dla_porfsx_extended.f +++ b/lapack-netlib/SRC/dla_porfsx_extended.f @@ -65,11 +65,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -246,7 +246,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/dla_porpvgrw.f b/lapack-netlib/SRC/dla_porpvgrw.f index 4fe1a1922..8a6f9e1a7 100644 --- a/lapack-netlib/SRC/dla_porpvgrw.f +++ b/lapack-netlib/SRC/dla_porpvgrw.f @@ -85,7 +85,7 @@ *> The leading dimension of the array AF. LDAF >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/dla_syrcond.f b/lapack-netlib/SRC/dla_syrcond.f index 91d557145..23ed82588 100644 --- a/lapack-netlib/SRC/dla_syrcond.f +++ b/lapack-netlib/SRC/dla_syrcond.f @@ -119,13 +119,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/dla_syrfsx_extended.f b/lapack-netlib/SRC/dla_syrfsx_extended.f index f54d15194..b390600c0 100644 --- a/lapack-netlib/SRC/dla_syrfsx_extended.f +++ b/lapack-netlib/SRC/dla_syrfsx_extended.f @@ -67,11 +67,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -255,7 +255,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/dla_syrpvgrw.f b/lapack-netlib/SRC/dla_syrpvgrw.f index c2e5cb018..5ba03093b 100644 --- a/lapack-netlib/SRC/dla_syrpvgrw.f +++ b/lapack-netlib/SRC/dla_syrpvgrw.f @@ -101,7 +101,7 @@ *> as determined by DSYTRF. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/dla_wwaddw.f b/lapack-netlib/SRC/dla_wwaddw.f index 99a86c553..4f50540d6 100644 --- a/lapack-netlib/SRC/dla_wwaddw.f +++ b/lapack-netlib/SRC/dla_wwaddw.f @@ -36,7 +36,7 @@ *> DLA_WWADDW adds a vector W into a doubled-single vector (X, Y). *> *> This works for all extant IBM's hex and binary floating point -*> arithmetics, but not for decimal. +*> arithmetic, but not for decimal. *> \endverbatim * * Arguments: diff --git a/lapack-netlib/SRC/dlaed4.f b/lapack-netlib/SRC/dlaed4.f index e7dc839df..033438d73 100644 --- a/lapack-netlib/SRC/dlaed4.f +++ b/lapack-netlib/SRC/dlaed4.f @@ -82,7 +82,7 @@ *> \param[out] DELTA *> \verbatim *> DELTA is DOUBLE PRECISION array, dimension (N) -*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th +*> If N > 2, DELTA contains (D(j) - lambda_I) in its j-th *> component. If N = 1, then DELTA(1) = 1. If N = 2, see DLAED5 *> for detail. The vector DELTA contains the information necessary *> to construct the eigenvectors by DLAED3 and DLAED9. diff --git a/lapack-netlib/SRC/dlaed8.f b/lapack-netlib/SRC/dlaed8.f index c053347b1..f64679dc0 100644 --- a/lapack-netlib/SRC/dlaed8.f +++ b/lapack-netlib/SRC/dlaed8.f @@ -353,7 +353,7 @@ Z( I ) = W( INDX( I ) ) 40 CONTINUE * -* Calculate the allowable deflation tolerence +* Calculate the allowable deflation tolerance * IMAX = IDAMAX( N, Z, 1 ) JMAX = IDAMAX( N, D, 1 ) diff --git a/lapack-netlib/SRC/dlagtf.f b/lapack-netlib/SRC/dlagtf.f index 4b257c64f..b92c84f39 100644 --- a/lapack-netlib/SRC/dlagtf.f +++ b/lapack-netlib/SRC/dlagtf.f @@ -125,7 +125,7 @@ *> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n) *> returns the smallest positive integer j such that *> -*> abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL, +*> abs( u(j,j) ) <= norm( (T - lambda*I)(j) )*TOL, *> *> where norm( A(j) ) denotes the sum of the absolute values of *> the jth row of the matrix A. If no such j exists then IN(n) @@ -137,8 +137,8 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> .lt. 0: if INFO = -k, the kth argument had an illegal value +*> = 0: successful exit +*> < 0: if INFO = -k, the kth argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/dlagts.f b/lapack-netlib/SRC/dlagts.f index 926075827..cbd35ae14 100644 --- a/lapack-netlib/SRC/dlagts.f +++ b/lapack-netlib/SRC/dlagts.f @@ -122,12 +122,12 @@ *> \param[in,out] TOL *> \verbatim *> TOL is DOUBLE PRECISION -*> On entry, with JOB .lt. 0, TOL should be the minimum +*> On entry, with JOB < 0, TOL should be the minimum *> perturbation to be made to very small diagonal elements of U. *> TOL should normally be chosen as about eps*norm(U), where eps *> is the relative machine precision, but if TOL is supplied as *> non-positive, then it is reset to eps*max( abs( u(i,j) ) ). -*> If JOB .gt. 0 then TOL is not referenced. +*> If JOB > 0 then TOL is not referenced. *> *> On exit, TOL is changed as described above, only if TOL is *> non-positive on entry. Otherwise TOL is unchanged. @@ -136,14 +136,14 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> .lt. 0: if INFO = -i, the i-th argument had an illegal value -*> .gt. 0: overflow would occur when computing the INFO(th) -*> element of the solution vector x. This can only occur -*> when JOB is supplied as positive and either means -*> that a diagonal element of U is very small, or that -*> the elements of the right-hand side vector y are very -*> large. +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> > 0: overflow would occur when computing the INFO(th) +*> element of the solution vector x. This can only occur +*> when JOB is supplied as positive and either means +*> that a diagonal element of U is very small, or that +*> the elements of the right-hand side vector y are very +*> large. *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/dlahqr.f b/lapack-netlib/SRC/dlahqr.f index f7365d21e..e863829ec 100644 --- a/lapack-netlib/SRC/dlahqr.f +++ b/lapack-netlib/SRC/dlahqr.f @@ -150,26 +150,26 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: If INFO = i, DLAHQR failed to compute all the +*> = 0: successful exit +*> > 0: If INFO = i, DLAHQR failed to compute all the *> eigenvalues ILO to IHI in a total of 30 iterations *> per eigenvalue; elements i+1:ihi of WR and WI *> contain those eigenvalues which have been *> successfully computed. *> -*> If INFO .GT. 0 and WANTT is .FALSE., then on exit, +*> If INFO > 0 and WANTT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the *> eigenvalues of the upper Hessenberg matrix rows -*> and columns ILO thorugh INFO of the final, output +*> and columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> (*) (initial value of H)*U = U*(final value of H) -*> where U is an orthognal matrix. The final +*> where U is an orthogonal matrix. The final *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> (final value of Z) = (initial value of Z)*U *> where U is the orthogonal matrix in (*) *> (regardless of the value of WANTT.) diff --git a/lapack-netlib/SRC/dlaln2.f b/lapack-netlib/SRC/dlaln2.f index a094b737b..0c94ea308 100644 --- a/lapack-netlib/SRC/dlaln2.f +++ b/lapack-netlib/SRC/dlaln2.f @@ -49,7 +49,7 @@ *> the first column of each being the real part and the second *> being the imaginary part. *> -*> "s" is a scaling factor (.LE. 1), computed by DLALN2, which is +*> "s" is a scaling factor (<= 1), computed by DLALN2, which is *> so chosen that X can be computed without overflow. X is further *> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less *> than overflow. diff --git a/lapack-netlib/SRC/dlamswlq.f b/lapack-netlib/SRC/dlamswlq.f index 19e32f888..306c3d3de 100644 --- a/lapack-netlib/SRC/dlamswlq.f +++ b/lapack-netlib/SRC/dlamswlq.f @@ -1,3 +1,4 @@ +*> \brief \b DLAMSWLQ * * Definition: * =========== diff --git a/lapack-netlib/SRC/dlamtsqr.f b/lapack-netlib/SRC/dlamtsqr.f index 6af89d28e..41a067780 100644 --- a/lapack-netlib/SRC/dlamtsqr.f +++ b/lapack-netlib/SRC/dlamtsqr.f @@ -1,3 +1,4 @@ +*> \brief \b DLAMTSQR * * Definition: * =========== diff --git a/lapack-netlib/SRC/dlangb.f b/lapack-netlib/SRC/dlangb.f index 078573b87..0c4f938f7 100644 --- a/lapack-netlib/SRC/dlangb.f +++ b/lapack-netlib/SRC/dlangb.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER KL, KU, LDAB, N @@ -139,22 +140,24 @@ * * ===================================================================== * -* * .. Parameters .. DOUBLE PRECISION ONE, ZERO PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) * .. * .. Local Scalars .. INTEGER I, J, K, L - DOUBLE PRECISION SCALE, SUM, VALUE, TEMP + DOUBLE PRECISION SUM, VALUE, TEMP * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -206,15 +209,22 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANGB = VALUE diff --git a/lapack-netlib/SRC/dlange.f b/lapack-netlib/SRC/dlange.f index 9dbf45e81..6b32fbefd 100644 --- a/lapack-netlib/SRC/dlange.f +++ b/lapack-netlib/SRC/dlange.f @@ -119,6 +119,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, M, N @@ -135,10 +136,13 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE, TEMP + DOUBLE PRECISION SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Subroutines .. - EXTERNAL DLASSQ + EXTERNAL DLASSQ, DCOMBSSQ * .. * .. External Functions .. LOGICAL LSAME, DISNAN @@ -194,13 +198,19 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL DLASSQ( M, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANGE = VALUE diff --git a/lapack-netlib/SRC/dlanhs.f b/lapack-netlib/SRC/dlanhs.f index 691dbc21e..a859d2216 100644 --- a/lapack-netlib/SRC/dlanhs.f +++ b/lapack-netlib/SRC/dlanhs.f @@ -113,6 +113,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, N @@ -129,15 +130,18 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT * .. @@ -188,13 +192,20 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANHS = VALUE diff --git a/lapack-netlib/SRC/dlansb.f b/lapack-netlib/SRC/dlansb.f index 4ccf5f27e..a82dc41b1 100644 --- a/lapack-netlib/SRC/dlansb.f +++ b/lapack-netlib/SRC/dlansb.f @@ -134,6 +134,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -150,15 +151,18 @@ * .. * .. Local Scalars .. INTEGER I, J, L - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -225,29 +229,47 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL DLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF - CALL DLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N, AB( L, 1 ), LDAB, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANSB = VALUE diff --git a/lapack-netlib/SRC/dlansp.f b/lapack-netlib/SRC/dlansp.f index a1829db75..b6ad1ffcf 100644 --- a/lapack-netlib/SRC/dlansp.f +++ b/lapack-netlib/SRC/dlansp.f @@ -119,6 +119,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -135,15 +136,18 @@ * .. * .. Local Scalars .. INTEGER I, J, K - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -217,31 +221,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( AP( K ).NE.ZERO ) THEN ABSA = ABS( AP( K ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -250,7 +271,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANSP = VALUE diff --git a/lapack-netlib/SRC/dlansy.f b/lapack-netlib/SRC/dlansy.f index 2372fce0a..87d514c11 100644 --- a/lapack-netlib/SRC/dlansy.f +++ b/lapack-netlib/SRC/dlansy.f @@ -127,6 +127,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -143,15 +144,18 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -216,21 +220,39 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL DLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL DLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM - CALL DLASSQ( N, A, LDA+1, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANSY = VALUE diff --git a/lapack-netlib/SRC/dlantb.f b/lapack-netlib/SRC/dlantb.f index 3d2bfe7e4..0d46f6cc8 100644 --- a/lapack-netlib/SRC/dlantb.f +++ b/lapack-netlib/SRC/dlantb.f @@ -145,6 +145,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER K, LDAB, N @@ -162,15 +163,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, L - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -311,46 +315,61 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 280 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL DLASSQ( MIN( J-1, K ), - $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, - $ SUM ) + $ AB( MAX( K+2-J, 1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 280 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 290 J = 1, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL DLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 310 J = 1, N - CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANTB = VALUE diff --git a/lapack-netlib/SRC/dlantp.f b/lapack-netlib/SRC/dlantp.f index f84a9e9d7..a7b89dec7 100644 --- a/lapack-netlib/SRC/dlantp.f +++ b/lapack-netlib/SRC/dlantp.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER N @@ -146,15 +147,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, K - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -306,45 +310,64 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 280 J = 2, N - CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( J-1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 280 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 290 J = 1, N - CALL DLASSQ( J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 300 J = 1, N - 1 - CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N-J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 300 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 310 J = 1, N - CALL DLASSQ( N-J+1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( N-J+1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANTP = VALUE diff --git a/lapack-netlib/SRC/dlantr.f b/lapack-netlib/SRC/dlantr.f index 8585b2f68..adc7da4c4 100644 --- a/lapack-netlib/SRC/dlantr.f +++ b/lapack-netlib/SRC/dlantr.f @@ -146,6 +146,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER LDA, M, N @@ -163,15 +164,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL DLASSQ +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. +* .. External Subroutines .. + EXTERNAL DLASSQ, DCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT * .. @@ -281,7 +285,7 @@ END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - DO 210 I = 1, N + DO 210 I = 1, MIN( M, N ) WORK( I ) = ONE 210 CONTINUE DO 220 I = N + 1, M @@ -311,38 +315,56 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 290 J = 2, N - CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 300 J = 1, N - CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 310 J = 1, N - CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 320 J = 1, N - CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL DLASSQ( M-J+1, A( J, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 320 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * DLANTR = VALUE diff --git a/lapack-netlib/SRC/dlanv2.f b/lapack-netlib/SRC/dlanv2.f index 91fa14ff2..d68481f7e 100644 --- a/lapack-netlib/SRC/dlanv2.f +++ b/lapack-netlib/SRC/dlanv2.f @@ -161,7 +161,6 @@ IF( C.EQ.ZERO ) THEN CS = ONE SN = ZERO - GO TO 10 * ELSE IF( B.EQ.ZERO ) THEN * @@ -174,12 +173,12 @@ A = TEMP B = -C C = ZERO - GO TO 10 +* ELSE IF( ( A-D ).EQ.ZERO .AND. SIGN( ONE, B ).NE.SIGN( ONE, C ) ) $ THEN CS = ONE SN = ZERO - GO TO 10 +* ELSE * TEMP = A - D @@ -207,6 +206,7 @@ SN = C / TAU B = B - C C = ZERO +* ELSE * * Complex eigenvalues, or real (almost) equal eigenvalues. @@ -268,8 +268,6 @@ END IF * END IF -* - 10 CONTINUE * * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). * diff --git a/lapack-netlib/SRC/dlaorhr_col_getrfnp.f b/lapack-netlib/SRC/dlaorhr_col_getrfnp.f new file mode 100644 index 000000000..6a7c629e8 --- /dev/null +++ b/lapack-netlib/SRC/dlaorhr_col_getrfnp.f @@ -0,0 +1,248 @@ +*> \brief \b DLAORHR_COL_GETRFNP +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLAORHR_COL_GETRFNP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLAORHR_COL_GETRFNP computes the modified LU factorization without +*> pivoting of a real general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is +*> at least one in absolute value (so that division-by-zero not +*> not possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine DORHR_COL. In DORHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the blocked right-looking version of the algorithm, +*> calling Level 3 BLAS to update the submatrix. To factorize a block, +*> this routine calls the recursive routine DLAORHR_COL_GETRFNP2. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can +*> be only plus or minus one. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup doubleGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE DLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D+0 ) +* .. +* .. Local Scalars .. + INTEGER IINFO, J, JB, NB +* .. +* .. External Subroutines .. + EXTERNAL DGEMM, DLAORHR_COL_GETRFNP2, DTRSM, XERBLA +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DLAORHR_COL_GETRFNP', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN +* +* Determine the block size for this environment. +* + + NB = ILAENV( 1, 'DLAORHR_COL_GETRFNP', ' ', M, N, -1, -1 ) + + IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN +* +* Use unblocked code. +* + CALL DLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + ELSE +* +* Use blocked code. +* + DO J = 1, MIN( M, N ), NB + JB = MIN( MIN( M, N )-J+1, NB ) +* +* Factor diagonal and subdiagonal blocks. +* + CALL DLAORHR_COL_GETRFNP2( M-J+1, JB, A( J, J ), LDA, + $ D( J ), IINFO ) +* + IF( J+JB.LE.N ) THEN +* +* Compute block row of U. +* + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), + $ LDA ) + IF( J+JB.LE.M ) THEN +* +* Update trailing submatrix. +* + CALL DGEMM( 'No transpose', 'No transpose', M-J-JB+1, + $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, + $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), + $ LDA ) + END IF + END IF + END DO + END IF + RETURN +* +* End of DLAORHR_COL_GETRFNP +* + END diff --git a/lapack-netlib/SRC/dlaorhr_col_getrfnp2.f b/lapack-netlib/SRC/dlaorhr_col_getrfnp2.f new file mode 100644 index 000000000..f7781f2e5 --- /dev/null +++ b/lapack-netlib/SRC/dlaorhr_col_getrfnp2.f @@ -0,0 +1,305 @@ +*> \brief \b DLAORHR_COL_GETRFNP2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLAORHR_GETRF2NP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* RECURSIVE SUBROUTINE DLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DLAORHR_COL_GETRFNP2 computes the modified LU factorization without +*> pivoting of a real general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is at +*> least one in absolute value (so that division-by-zero not +*> possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine DORHR_COL. In DORHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the recursive version of the LU factorization algorithm. +*> Denote A - S by B. The algorithm divides the matrix B into four +*> submatrices: +*> +*> [ B11 | B12 ] where B11 is n1 by n1, +*> B = [ -----|----- ] B21 is (m-n1) by n1, +*> [ B21 | B22 ] B12 is n1 by n2, +*> B22 is (m-n1) by n2, +*> with n1 = min(m,n)/2, n2 = n-n1. +*> +*> +*> The subroutine calls itself to factor B11, solves for B21, +*> solves for B12, updates B22, then calls itself to factor B22. +*> +*> For more details on the recursive LU algorithm, see [2]. +*> +*> DLAORHR_COL_GETRFNP2 is called to factorize a block by the blocked +*> routine DLAORHR_COL_GETRFNP, which uses blocked code calling +*. Level 3 BLAS to update the submatrix. However, DLAORHR_COL_GETRFNP2 +*> is self-sufficient and can be used without DLAORHR_COL_GETRFNP. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> +*> [2] "Recursion leads to automatic variable blocking for dense linear +*> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev., +*> vol. 41, no. 6, pp. 737-755, 1997. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can +*> be only plus or minus one. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup doubleGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + RECURSIVE SUBROUTINE DLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D+0 ) +* .. +* .. Local Scalars .. + DOUBLE PRECISION SFMIN + INTEGER I, IINFO, N1, N2 +* .. +* .. External Functions .. + DOUBLE PRECISION DLAMCH + EXTERNAL DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL DGEMM, DSCAL, DTRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DSIGN, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DLAORHR_COL_GETRFNP2', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN + + IF ( M.EQ.1 ) THEN +* +* One row case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = -DSIGN( ONE, A( 1, 1 ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* + ELSE IF( N.EQ.1 ) THEN +* +* One column case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = -DSIGN( ONE, A( 1, 1 ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* +* Scale the elements 2:M of the column +* +* Determine machine safe minimum +* + SFMIN = DLAMCH('S') +* +* Construct the subdiagonal elements of L +* + IF( ABS( A( 1, 1 ) ) .GE. SFMIN ) THEN + CALL DSCAL( M-1, ONE / A( 1, 1 ), A( 2, 1 ), 1 ) + ELSE + DO I = 2, M + A( I, 1 ) = A( I, 1 ) / A( 1, 1 ) + END DO + END IF +* + ELSE +* +* Divide the matrix B into four submatrices +* + N1 = MIN( M, N ) / 2 + N2 = N-N1 + +* +* Factor B11, recursive call +* + CALL DLAORHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO ) +* +* Solve for B21 +* + CALL DTRSM( 'R', 'U', 'N', 'N', M-N1, N1, ONE, A, LDA, + $ A( N1+1, 1 ), LDA ) +* +* Solve for B12 +* + CALL DTRSM( 'L', 'L', 'N', 'U', N1, N2, ONE, A, LDA, + $ A( 1, N1+1 ), LDA ) +* +* Update B22, i.e. compute the Schur complement +* B22 := B22 - B21*B12 +* + CALL DGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( N1+1, 1 ), LDA, + $ A( 1, N1+1 ), LDA, ONE, A( N1+1, N1+1 ), LDA ) +* +* Factor B22, recursive call +* + CALL DLAORHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA, + $ D( N1+1 ), IINFO ) +* + END IF + RETURN +* +* End of DLAORHR_COL_GETRFNP2 +* + END diff --git a/lapack-netlib/SRC/dlaqps.f b/lapack-netlib/SRC/dlaqps.f index 395d8e0b1..0009de951 100644 --- a/lapack-netlib/SRC/dlaqps.f +++ b/lapack-netlib/SRC/dlaqps.f @@ -127,7 +127,7 @@ *> \param[in,out] AUXV *> \verbatim *> AUXV is DOUBLE PRECISION array, dimension (NB) -*> Auxiliar vector. +*> Auxiliary vector. *> \endverbatim *> *> \param[in,out] F diff --git a/lapack-netlib/SRC/dlaqr0.f b/lapack-netlib/SRC/dlaqr0.f index 247d4ef30..f362c096c 100644 --- a/lapack-netlib/SRC/dlaqr0.f +++ b/lapack-netlib/SRC/dlaqr0.f @@ -67,7 +67,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -79,12 +79,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to DGEBAL, and then passed to DGEHRD when the *> matrix output by DGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -97,19 +97,19 @@ *> decomposition (the Schur form); 2-by-2 diagonal blocks *> (corresponding to complex conjugate pairs of eigenvalues) *> are returned in standard form, with H(i,i) = H(i+1,i+1) -*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is +*> and H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and WANTT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -125,7 +125,7 @@ *> and WI(ILO:IHI). If two eigenvalues are computed as a *> complex conjugate pair, they are stored in consecutive *> elements of WR and WI, say the i-th and (i+1)th, with -*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then +*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., then *> the eigenvalues are stored in the same order as on the *> diagonal of the Schur form returned in H, with *> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal @@ -143,7 +143,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -153,7 +153,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -161,7 +161,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -174,7 +174,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -190,19 +190,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, DLAQR0 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, DLAQR0 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -210,7 +210,7 @@ *> value of H is upper Hessenberg and quasi-triangular *> in rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -218,7 +218,7 @@ *> where U is the orthogonal matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -678,7 +678,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/dlaqr1.f b/lapack-netlib/SRC/dlaqr1.f index 795b072ab..4ccf997e7 100644 --- a/lapack-netlib/SRC/dlaqr1.f +++ b/lapack-netlib/SRC/dlaqr1.f @@ -69,7 +69,7 @@ *> \verbatim *> LDH is INTEGER *> The leading dimension of H as declared in -*> the calling procedure. LDH.GE.N +*> the calling procedure. LDH >= N *> \endverbatim *> *> \param[in] SR1 diff --git a/lapack-netlib/SRC/dlaqr2.f b/lapack-netlib/SRC/dlaqr2.f index 431b3f123..01fdf3046 100644 --- a/lapack-netlib/SRC/dlaqr2.f +++ b/lapack-netlib/SRC/dlaqr2.f @@ -103,7 +103,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -121,7 +121,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -133,7 +133,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -149,7 +149,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -194,13 +194,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -212,14 +212,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -231,7 +231,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/dlaqr3.f b/lapack-netlib/SRC/dlaqr3.f index aa23617c3..1dbf55c9e 100644 --- a/lapack-netlib/SRC/dlaqr3.f +++ b/lapack-netlib/SRC/dlaqr3.f @@ -100,7 +100,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -118,7 +118,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -130,7 +130,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -146,7 +146,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -191,13 +191,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -209,14 +209,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -228,7 +228,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/dlaqr4.f b/lapack-netlib/SRC/dlaqr4.f index 89b9b7f20..454bf9608 100644 --- a/lapack-netlib/SRC/dlaqr4.f +++ b/lapack-netlib/SRC/dlaqr4.f @@ -74,7 +74,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -86,12 +86,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to DGEBAL, and then passed to DGEHRD when the *> matrix output by DGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -104,19 +104,19 @@ *> decomposition (the Schur form); 2-by-2 diagonal blocks *> (corresponding to complex conjugate pairs of eigenvalues) *> are returned in standard form, with H(i,i) = H(i+1,i+1) -*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is +*> and H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and WANTT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -132,7 +132,7 @@ *> and WI(ILO:IHI). If two eigenvalues are computed as a *> complex conjugate pair, they are stored in consecutive *> elements of WR and WI, say the i-th and (i+1)th, with -*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then +*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., then *> the eigenvalues are stored in the same order as on the *> diagonal of the Schur form returned in H, with *> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal @@ -150,7 +150,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -160,7 +160,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -168,7 +168,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -181,7 +181,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -197,19 +197,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, DLAQR4 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, DLAQR4 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -217,7 +217,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -225,7 +225,7 @@ *> where U is the orthogonal matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -677,7 +677,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/dlaqr5.f b/lapack-netlib/SRC/dlaqr5.f index 5cc4eda1a..f58db9c89 100644 --- a/lapack-netlib/SRC/dlaqr5.f +++ b/lapack-netlib/SRC/dlaqr5.f @@ -133,7 +133,7 @@ *> \verbatim *> LDH is INTEGER *> LDH is the leading dimension of H just as declared in the -*> calling procedure. LDH.GE.MAX(1,N). +*> calling procedure. LDH >= MAX(1,N). *> \endverbatim *> *> \param[in] ILOZ @@ -145,7 +145,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N *> \endverbatim *> *> \param[in,out] Z @@ -161,7 +161,7 @@ *> \verbatim *> LDZ is INTEGER *> LDA is the leading dimension of Z just as declared in -*> the calling procedure. LDZ.GE.N. +*> the calling procedure. LDZ >= N. *> \endverbatim *> *> \param[out] V @@ -173,7 +173,7 @@ *> \verbatim *> LDV is INTEGER *> LDV is the leading dimension of V as declared in the -*> calling procedure. LDV.GE.3. +*> calling procedure. LDV >= 3. *> \endverbatim *> *> \param[out] U @@ -185,33 +185,14 @@ *> \verbatim *> LDU is INTEGER *> LDU is the leading dimension of U just as declared in the -*> in the calling subroutine. LDU.GE.3*NSHFTS-3. -*> \endverbatim -*> -*> \param[in] NH -*> \verbatim -*> NH is INTEGER -*> NH is the number of columns in array WH available for -*> workspace. NH.GE.1. -*> \endverbatim -*> -*> \param[out] WH -*> \verbatim -*> WH is DOUBLE PRECISION array, dimension (LDWH,NH) -*> \endverbatim -*> -*> \param[in] LDWH -*> \verbatim -*> LDWH is INTEGER -*> Leading dimension of WH just as declared in the -*> calling procedure. LDWH.GE.3*NSHFTS-3. +*> in the calling subroutine. LDU >= 3*NSHFTS-3. *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> NV is the number of rows in WV agailable for workspace. -*> NV.GE.1. +*> NV >= 1. *> \endverbatim *> *> \param[out] WV @@ -223,9 +204,28 @@ *> \verbatim *> LDWV is INTEGER *> LDWV is the leading dimension of WV as declared in the -*> in the calling subroutine. LDWV.GE.NV. +*> in the calling subroutine. LDWV >= NV. *> \endverbatim * +*> \param[in] NH +*> \verbatim +*> NH is INTEGER +*> NH is the number of columns in array WH available for +*> workspace. NH >= 1. +*> \endverbatim +*> +*> \param[out] WH +*> \verbatim +*> WH is DOUBLE PRECISION array, dimension (LDWH,NH) +*> \endverbatim +*> +*> \param[in] LDWH +*> \verbatim +*> LDWH is INTEGER +*> Leading dimension of WH just as declared in the +*> calling procedure. LDWH >= 3*NSHFTS-3. +*> \endverbatim +*> * Authors: * ======== * diff --git a/lapack-netlib/SRC/dlarfb.f b/lapack-netlib/SRC/dlarfb.f index 5b2cc2ba8..e63641213 100644 --- a/lapack-netlib/SRC/dlarfb.f +++ b/lapack-netlib/SRC/dlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V diff --git a/lapack-netlib/SRC/dlarfx.f b/lapack-netlib/SRC/dlarfx.f index 260d367d4..a9e4496f9 100644 --- a/lapack-netlib/SRC/dlarfx.f +++ b/lapack-netlib/SRC/dlarfx.f @@ -94,7 +94,7 @@ *> \param[in] LDC *> \verbatim *> LDC is INTEGER -*> The leading dimension of the array C. LDA >= (1,M). +*> The leading dimension of the array C. LDC >= (1,M). *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/dlarfy.f b/lapack-netlib/SRC/dlarfy.f index a0b0ebb31..3000b38bc 100644 --- a/lapack-netlib/SRC/dlarfy.f +++ b/lapack-netlib/SRC/dlarfy.f @@ -103,7 +103,7 @@ * *> \date December 2016 * -*> \ingroup double_eig +*> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK ) diff --git a/lapack-netlib/SRC/dlarrb.f b/lapack-netlib/SRC/dlarrb.f index 2b6389e25..ddf3888b9 100644 --- a/lapack-netlib/SRC/dlarrb.f +++ b/lapack-netlib/SRC/dlarrb.f @@ -91,7 +91,7 @@ *> RTOL2 is DOUBLE PRECISION *> Tolerance for the convergence of the bisection intervals. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> where GAP is the (estimated) distance to the nearest *> eigenvalue. *> \endverbatim @@ -117,7 +117,7 @@ *> WGAP is DOUBLE PRECISION array, dimension (N-1) *> On input, the (estimated) gaps between consecutive *> eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap between -*> eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST +*> eigenvalues I and I+1. Note that if IFIRST = ILAST *> then WGAP(IFIRST-OFFSET) must be set to ZERO. *> On output, these gaps are refined. *> \endverbatim diff --git a/lapack-netlib/SRC/dlarre.f b/lapack-netlib/SRC/dlarre.f index 0613efbc3..ce55442e2 100644 --- a/lapack-netlib/SRC/dlarre.f +++ b/lapack-netlib/SRC/dlarre.f @@ -150,7 +150,7 @@ *> RTOL2 is DOUBLE PRECISION *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in] SPLTOL diff --git a/lapack-netlib/SRC/dlarrj.f b/lapack-netlib/SRC/dlarrj.f index 097ba9f77..a4bfb210c 100644 --- a/lapack-netlib/SRC/dlarrj.f +++ b/lapack-netlib/SRC/dlarrj.f @@ -85,7 +85,7 @@ *> RTOL is DOUBLE PRECISION *> Tolerance for the convergence of the bisection intervals. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|). +*> RIGHT-LEFT < RTOL*MAX(|LEFT|,|RIGHT|). *> \endverbatim *> *> \param[in] OFFSET diff --git a/lapack-netlib/SRC/dlarrv.f b/lapack-netlib/SRC/dlarrv.f index cace17c0e..4a59a2bbf 100644 --- a/lapack-netlib/SRC/dlarrv.f +++ b/lapack-netlib/SRC/dlarrv.f @@ -149,7 +149,7 @@ *> RTOL2 is DOUBLE PRECISION *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in,out] W diff --git a/lapack-netlib/SRC/dlasd7.f b/lapack-netlib/SRC/dlasd7.f index e0ddedeb5..66f665cf8 100644 --- a/lapack-netlib/SRC/dlasd7.f +++ b/lapack-netlib/SRC/dlasd7.f @@ -400,7 +400,7 @@ VL( I ) = VLW( IDXI ) 50 CONTINUE * -* Calculate the allowable deflation tolerence +* Calculate the allowable deflation tolerance * EPS = DLAMCH( 'Epsilon' ) TOL = MAX( ABS( ALPHA ), ABS( BETA ) ) diff --git a/lapack-netlib/SRC/dlasr.f b/lapack-netlib/SRC/dlasr.f index 6059c6293..f707970e4 100644 --- a/lapack-netlib/SRC/dlasr.f +++ b/lapack-netlib/SRC/dlasr.f @@ -175,7 +175,7 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> The M-by-N matrix A. On exit, A is overwritten by P*A if -*> SIDE = 'R' or by A*P**T if SIDE = 'L'. +*> SIDE = 'L' or by A*P**T if SIDE = 'R'. *> \endverbatim *> *> \param[in] LDA diff --git a/lapack-netlib/SRC/dlassq.f b/lapack-netlib/SRC/dlassq.f index 885395e3c..5922360f9 100644 --- a/lapack-netlib/SRC/dlassq.f +++ b/lapack-netlib/SRC/dlassq.f @@ -60,7 +60,7 @@ *> *> \param[in] X *> \verbatim -*> X is DOUBLE PRECISION array, dimension (N) +*> X is DOUBLE PRECISION array, dimension (1+(N-1)*INCX) *> The vector for which a scaled sum of squares is computed. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. *> \endverbatim diff --git a/lapack-netlib/SRC/dlaswlq.f b/lapack-netlib/SRC/dlaswlq.f index 6e4ca20fd..619a1f1a2 100644 --- a/lapack-netlib/SRC/dlaswlq.f +++ b/lapack-netlib/SRC/dlaswlq.f @@ -1,3 +1,4 @@ +*> \brief \b DLASWLQ * * Definition: * =========== @@ -18,9 +19,20 @@ *> *> \verbatim *> -*> DLASWLQ computes a blocked Short-Wide LQ factorization of a -*> M-by-N matrix A, where N >= M: -*> A = L * Q +*> DLASWLQ computes a blocked Tall-Skinny LQ factorization of +*> a real M-by-N matrix A for M <= N: +*> +*> A = ( L 0 ) * Q, +*> +*> where: +*> +*> Q is a n-by-N orthogonal matrix, stored on exit in an implicit +*> form in the elements above the digonal of the array A and in +*> the elemenst of the array T; +*> L is an lower-triangular M-by-M matrix stored on exit in +*> the elements on and below the diagonal of the array A. +*> 0 is a M-by-(N-M) zero matrix, if M < N, and is not stored. +*> *> \endverbatim * * Arguments: @@ -150,7 +162,7 @@ SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * June 2017 diff --git a/lapack-netlib/SRC/dlasyf_aa.f b/lapack-netlib/SRC/dlasyf_aa.f index 6b75e46e0..793537e04 100644 --- a/lapack-netlib/SRC/dlasyf_aa.f +++ b/lapack-netlib/SRC/dlasyf_aa.f @@ -284,8 +284,9 @@ * * Swap A(I1, I2+1:M) with A(I2, I2+1:M) * - CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -325,13 +326,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -432,8 +435,9 @@ * * Swap A(I2+1:M, I1) with A(I2+1:M, I2) * - CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -473,13 +477,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/dlasyf_rk.f b/lapack-netlib/SRC/dlasyf_rk.f index 209b4c89d..d581eeedc 100644 --- a/lapack-netlib/SRC/dlasyf_rk.f +++ b/lapack-netlib/SRC/dlasyf_rk.f @@ -321,7 +321,7 @@ * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = ZERO @@ -649,7 +649,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = ZERO * diff --git a/lapack-netlib/SRC/dlasyf_rook.f b/lapack-netlib/SRC/dlasyf_rook.f index 49ee7a6c9..557032104 100644 --- a/lapack-netlib/SRC/dlasyf_rook.f +++ b/lapack-netlib/SRC/dlasyf_rook.f @@ -21,7 +21,7 @@ * SUBROUTINE DLASYF_ROOK( UPLO, N, NB, KB, A, LDA, IPIV, W, LDW, INFO ) * * .. Scalar Arguments .. -* CHARADLATER UPLO +* CHARACTER UPLO * INTEGER INFO, KB, LDA, LDW, N, NB * .. * .. Array Arguments .. diff --git a/lapack-netlib/SRC/dlatdf.f b/lapack-netlib/SRC/dlatdf.f index fd05059b3..8001e0830 100644 --- a/lapack-netlib/SRC/dlatdf.f +++ b/lapack-netlib/SRC/dlatdf.f @@ -85,7 +85,7 @@ *> RHS is DOUBLE PRECISION array, dimension (N) *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with -*> entries acoording to the value of IJOB (see above). +*> entries according to the value of IJOB (see above). *> \endverbatim *> *> \param[in,out] RDSUM @@ -260,7 +260,7 @@ * * Solve for U-part, look-ahead for RHS(N) = +-1. This is not done * in BSOLVE and will hopefully give us a better estimate because -* any ill-conditioning of the original matrix is transfered to U +* any ill-conditioning of the original matrix is transferred to U * and not to L. U(N, N) is an approximation to sigma_min(LU). * CALL DCOPY( N-1, RHS, 1, XP, 1 ) diff --git a/lapack-netlib/SRC/dlatsqr.f b/lapack-netlib/SRC/dlatsqr.f index 1ce7c4de0..598d2938e 100644 --- a/lapack-netlib/SRC/dlatsqr.f +++ b/lapack-netlib/SRC/dlatsqr.f @@ -1,3 +1,4 @@ +*> \brief \b DLATSQR * * Definition: * =========== @@ -19,8 +20,22 @@ *> \verbatim *> *> DLATSQR computes a blocked Tall-Skinny QR factorization of -*> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> a real M-by-N matrix A for M >= N: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix, stored on exit in an implicit +*> form in the elements below the digonal of the array A and in +*> the elemenst of the array T; +*> +*> R is an upper-triangular N-by-N matrix, stored on exit in +*> the elements on and above the diagonal of the array A. +*> +*> 0 is a (M-N)-by-N zero matrix, and is not stored. +*> *> \endverbatim * * Arguments: @@ -149,10 +164,10 @@ SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK diff --git a/lapack-netlib/SRC/dorgtsqr.f b/lapack-netlib/SRC/dorgtsqr.f new file mode 100644 index 000000000..85b05b6b5 --- /dev/null +++ b/lapack-netlib/SRC/dorgtsqr.f @@ -0,0 +1,306 @@ +*> \brief \b DORGTSQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DORGTSQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE DORGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, +* $ INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, +*> which are the first N columns of a product of real orthogonal +*> matrices of order M which are returned by DLATSQR +*> +*> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). +*> +*> See the documentation for DLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] MB +*> \verbatim +*> MB is INTEGER +*> The row block size used by DLATSQR to return +*> arrays A and T. MB > N. +*> (Note that if MB > M, then M is used instead of MB +*> as the row block size). +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size used by DLATSQR to return +*> arrays A and T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size). +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> +*> On entry: +*> +*> The elements on and above the diagonal are not accessed. +*> The elements below the diagonal represent the unit +*> lower-trapezoidal blocked matrix V computed by DLATSQR +*> that defines the input matrices Q_in(k) (ones on the +*> diagonal are not stored) (same format as the output A +*> below the diagonal in DLATSQR). +*> +*> On exit: +*> +*> The array A contains an M-by-N orthonormal matrix Q_out, +*> i.e the columns of A are orthogonal unit vectors. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is DOUBLE PRECISION array, +*> dimension (LDT, N * NIRB) +*> where NIRB = Number_of_input_row_blocks +*> = MAX( 1, CEIL((M-N)/(MB-N)) ) +*> Let NICB = Number_of_input_col_blocks +*> = CEIL(N/NB) +*> +*> The upper-triangular block reflectors used to define the +*> input matrices Q_in(k), k=(1:NIRB*NICB). The block +*> reflectors are stored in compact form in NIRB block +*> reflector sequences. Each of NIRB block reflector sequences +*> is stored in a larger NB-by-N column block of T and consists +*> of NICB smaller NB-by-NB upper-triangular column blocks. +*> (same format as the output T in DLATSQR). +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB1,N)). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> (workspace) DOUBLE PRECISION array, dimension (MAX(2,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> The dimension of the array WORK. LWORK >= (M+NB)*N. +*> If LWORK = -1, then a workspace query is assumed. +*> The routine only calculates the optimal size of the WORK +*> array, returns this value as the first entry of the WORK +*> array, and no error message related to LWORK is issued +*> by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup doubleOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE DORGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + $ INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DLAMTSQR, DLASET, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + LQUERY = LWORK.EQ.-1 + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. M.LT.N ) THEN + INFO = -2 + ELSE IF( MB.LE.N ) THEN + INFO = -3 + ELSE IF( NB.LT.1 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -6 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -8 + ELSE +* +* Test the input LWORK for the dimension of the array WORK. +* This workspace is used to store array C(LDC, N) and WORK(LWORK) +* in the call to DLAMTSQR. See the documentation for DLAMTSQR. +* + IF( LWORK.LT.2 .AND. (.NOT.LQUERY) ) THEN + INFO = -10 + ELSE +* +* Set block size for column blocks +* + NBLOCAL = MIN( NB, N ) +* +* LWORK = -1, then set the size for the array C(LDC,N) +* in DLAMTSQR call and set the optimal size of the work array +* WORK(LWORK) in DLAMTSQR call. +* + LDC = M + LC = LDC*N + LW = N * NBLOCAL +* + LWORKOPT = LC+LW +* + IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + INFO = -10 + END IF + END IF +* + END IF +* +* Handle error in the input parameters and return workspace query. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DORGTSQR', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN + WORK( 1 ) = DBLE( LWORKOPT ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + WORK( 1 ) = DBLE( LWORKOPT ) + RETURN + END IF +* +* (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in +* of M-by-M orthogonal matrix Q_in, which is implicitly stored in +* the subdiagonal part of input array A and in the input array T. +* Perform by the following operation using the routine DLAMTSQR. +* +* Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix, +* ( 0 ) 0 is a (M-N)-by-N zero matrix. +* +* (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones +* on the diagonal and zeros elsewhere. +* + CALL DLASET( 'F', M, N, ZERO, ONE, WORK, LDC ) +* +* (1b) On input, WORK(1:LDC*N) stores ( I ); +* ( 0 ) +* +* On output, WORK(1:LDC*N) stores Q1_in. +* + CALL DLAMTSQR( 'L', 'N', M, N, N, MB, NBLOCAL, A, LDA, T, LDT, + $ WORK, LDC, WORK( LC+1 ), LW, IINFO ) +* +* (2) Copy the result from the part of the work array (1:M,1:N) +* with the leading dimension LDC that starts at WORK(1) into +* the output array A(1:M,1:N) column-by-column. +* + DO J = 1, N + CALL DCOPY( M, WORK( (J-1)*LDC + 1 ), 1, A( 1, J ), 1 ) + END DO +* + WORK( 1 ) = DBLE( LWORKOPT ) + RETURN +* +* End of DORGTSQR +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/dorhr_col.f b/lapack-netlib/SRC/dorhr_col.f new file mode 100644 index 000000000..b5a65973d --- /dev/null +++ b/lapack-netlib/SRC/dorhr_col.f @@ -0,0 +1,440 @@ +*> \brief \b DORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DORHR_COL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE DORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. +* DOUBLE PRECISION A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns +*> as input, stored in A, and performs Householder Reconstruction (HR), +*> i.e. reconstructs Householder vectors V(i) implicitly representing +*> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, +*> where S is an N-by-N diagonal matrix with diagonal entries +*> equal to +1 or -1. The Householder vectors (columns V(i) of V) are +*> stored in A on output, and the diagonal entries of S are stored in D. +*> Block reflectors are also returned in T +*> (same output format as DGEQRT). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size to be used in the reconstruction +*> of Householder column vector blocks in the array A and +*> corresponding block reflectors in the array T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size.) +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> +*> On entry: +*> +*> The array A contains an M-by-N orthonormal matrix Q_in, +*> i.e the columns of A are orthogonal unit vectors. +*> +*> On exit: +*> +*> The elements below the diagonal of A represent the unit +*> lower-trapezoidal matrix V of Householder column vectors +*> V(i). The unit diagonal entries of V are not stored +*> (same format as the output below the diagonal in A from +*> DGEQRT). The matrix T and the matrix V stored on output +*> in A implicitly define Q_out. +*> +*> The elements above the diagonal contain the factor U +*> of the "modified" LU-decomposition: +*> Q_in - ( S ) = V * U +*> ( 0 ) +*> where 0 is a (M-N)-by-(M-N) zero matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is DOUBLE PRECISION array, +*> dimension (LDT, N) +*> +*> Let NOCB = Number_of_output_col_blocks +*> = CEIL(N/NB) +*> +*> On exit, T(1:NB, 1:N) contains NOCB upper-triangular +*> block reflectors used to define Q_out stored in compact +*> form as a sequence of upper-triangular NB-by-NB column +*> blocks (same format as the output T in DGEQRT). +*> The matrix T and the matrix V stored on output in A +*> implicitly define Q_out. NOTE: The lower triangles +*> below the upper-triangular blcoks will be filled with +*> zeros. See Further Details. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB,N)). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is DOUBLE PRECISION array, dimension min(M,N). +*> The elements can be only plus or minus one. +*> +*> D(i) is constructed as D(i) = -SIGN(Q_in_i(i,i)), where +*> 1 <= i <= min(M,N), and Q_in_i is Q_in after performing +*> i-1 steps of “modified” Gaussian elimination. +*> See Further Details. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The computed M-by-M orthogonal factor Q_out is defined implicitly as +*> a product of orthogonal matrices Q_out(i). Each Q_out(i) is stored in +*> the compact WY-representation format in the corresponding blocks of +*> matrices V (stored in A) and T. +*> +*> The M-by-N unit lower-trapezoidal matrix V stored in the M-by-N +*> matrix A contains the column vectors V(i) in NB-size column +*> blocks VB(j). For example, VB(1) contains the columns +*> V(1), V(2), ... V(NB). NOTE: The unit entries on +*> the diagonal of Y are not stored in A. +*> +*> The number of column blocks is +*> +*> NOCB = Number_of_output_col_blocks = CEIL(N/NB) +*> +*> where each block is of order NB except for the last block, which +*> is of order LAST_NB = N - (NOCB-1)*NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix V is +*> +*> +*> V = ( VB(1), VB(2), VB(3) ) = +*> +*> = ( 1 ) +*> ( v21 1 ) +*> ( v31 v32 1 ) +*> ( v41 v42 v43 1 ) +*> ( v51 v52 v53 v54 1 ) +*> ( v61 v62 v63 v54 v65 ) +*> +*> +*> For each of the column blocks VB(i), an upper-triangular block +*> reflector TB(i) is computed. These blocks are stored as +*> a sequence of upper-triangular column blocks in the NB-by-N +*> matrix T. The size of each TB(i) block is NB-by-NB, except +*> for the last block, whose size is LAST_NB-by-LAST_NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix T is +*> +*> T = ( TB(1), TB(2), TB(3) ) = +*> +*> = ( t11 t12 t13 t14 t15 ) +*> ( t22 t24 ) +*> +*> +*> The M-by-M factor Q_out is given as a product of NOCB +*> orthogonal M-by-M matrices Q_out(i). +*> +*> Q_out = Q_out(1) * Q_out(2) * ... * Q_out(NOCB), +*> +*> where each matrix Q_out(i) is given by the WY-representation +*> using corresponding blocks from the matrices V and T: +*> +*> Q_out(i) = I - VB(i) * TB(i) * (VB(i))**T, +*> +*> where I is the identity matrix. Here is the formula with matrix +*> dimensions: +*> +*> Q(i){M-by-M} = I{M-by-M} - +*> VB(i){M-by-INB} * TB(i){INB-by-INB} * (VB(i))**T {INB-by-M}, +*> +*> where INB = NB, except for the last block NOCB +*> for which INB=LAST_NB. +*> +*> ===== +*> NOTE: +*> ===== +*> +*> If Q_in is the result of doing a QR factorization +*> B = Q_in * R_in, then: +*> +*> B = (Q_out*S) * R_in = Q_out * (S * R_in) = O_out * R_out. +*> +*> So if one wants to interpret Q_out as the result +*> of the QR factorization of B, then corresponding R_out +*> should be obtained by R_out = S * R_in, i.e. some rows of R_in +*> should be multiplied by -1. +*> +*> For the details of the algorithm, see [1]. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup doubleOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE DORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. + DOUBLE PRECISION A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + INTEGER I, IINFO, J, JB, JBTEMP1, JBTEMP2, JNB, + $ NPLUSONE +* .. +* .. External Subroutines .. + EXTERNAL DCOPY, DLAORHR_COL_GETRFNP, DSCAL, DTRSM, + $ XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( NB.LT.1 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -7 + END IF +* +* Handle error in the input parameters. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DORHR_COL', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + RETURN + END IF +* +* On input, the M-by-N matrix A contains the orthogonal +* M-by-N matrix Q_in. +* +* (1) Compute the unit lower-trapezoidal V (ones on the diagonal +* are not stored) by performing the "modified" LU-decomposition. +* +* Q_in - ( S ) = V * U = ( V1 ) * U, +* ( 0 ) ( V2 ) +* +* where 0 is an (M-N)-by-N zero matrix. +* +* (1-1) Factor V1 and U. + + CALL DLAORHR_COL_GETRFNP( N, N, A, LDA, D, IINFO ) +* +* (1-2) Solve for V2. +* + IF( M.GT.N ) THEN + CALL DTRSM( 'R', 'U', 'N', 'N', M-N, N, ONE, A, LDA, + $ A( N+1, 1 ), LDA ) + END IF +* +* (2) Reconstruct the block reflector T stored in T(1:NB, 1:N) +* as a sequence of upper-triangular blocks with NB-size column +* blocking. +* +* Loop over the column blocks of size NB of the array A(1:M,1:N) +* and the array T(1:NB,1:N), JB is the column index of a column +* block, JNB is the column block size at each step JB. +* + NPLUSONE = N + 1 + DO JB = 1, N, NB +* +* (2-0) Determine the column block size JNB. +* + JNB = MIN( NPLUSONE-JB, NB ) +* +* (2-1) Copy the upper-triangular part of the current JNB-by-JNB +* diagonal block U(JB) (of the N-by-N matrix U) stored +* in A(JB:JB+JNB-1,JB:JB+JNB-1) into the upper-triangular part +* of the current JNB-by-JNB block T(1:JNB,JB:JB+JNB-1) +* column-by-column, total JNB*(JNB+1)/2 elements. +* + JBTEMP1 = JB - 1 + DO J = JB, JB+JNB-1 + CALL DCOPY( J-JBTEMP1, A( JB, J ), 1, T( 1, J ), 1 ) + END DO +* +* (2-2) Perform on the upper-triangular part of the current +* JNB-by-JNB diagonal block U(JB) (of the N-by-N matrix U) stored +* in T(1:JNB,JB:JB+JNB-1) the following operation in place: +* (-1)*U(JB)*S(JB), i.e the result will be stored in the upper- +* triangular part of T(1:JNB,JB:JB+JNB-1). This multiplication +* of the JNB-by-JNB diagonal block U(JB) by the JNB-by-JNB +* diagonal block S(JB) of the N-by-N sign matrix S from the +* right means changing the sign of each J-th column of the block +* U(JB) according to the sign of the diagonal element of the block +* S(JB), i.e. S(J,J) that is stored in the array element D(J). +* + DO J = JB, JB+JNB-1 + IF( D( J ).EQ.ONE ) THEN + CALL DSCAL( J-JBTEMP1, -ONE, T( 1, J ), 1 ) + END IF + END DO +* +* (2-3) Perform the triangular solve for the current block +* matrix X(JB): +* +* X(JB) * (A(JB)**T) = B(JB), where: +* +* A(JB)**T is a JNB-by-JNB unit upper-triangular +* coefficient block, and A(JB)=V1(JB), which +* is a JNB-by-JNB unit lower-triangular block +* stored in A(JB:JB+JNB-1,JB:JB+JNB-1). +* The N-by-N matrix V1 is the upper part +* of the M-by-N lower-trapezoidal matrix V +* stored in A(1:M,1:N); +* +* B(JB) is a JNB-by-JNB upper-triangular right-hand +* side block, B(JB) = (-1)*U(JB)*S(JB), and +* B(JB) is stored in T(1:JNB,JB:JB+JNB-1); +* +* X(JB) is a JNB-by-JNB upper-triangular solution +* block, X(JB) is the upper-triangular block +* reflector T(JB), and X(JB) is stored +* in T(1:JNB,JB:JB+JNB-1). +* +* In other words, we perform the triangular solve for the +* upper-triangular block T(JB): +* +* T(JB) * (V1(JB)**T) = (-1)*U(JB)*S(JB). +* +* Even though the blocks X(JB) and B(JB) are upper- +* triangular, the routine DTRSM will access all JNB**2 +* elements of the square T(1:JNB,JB:JB+JNB-1). Therefore, +* we need to set to zero the elements of the block +* T(1:JNB,JB:JB+JNB-1) below the diagonal before the call +* to DTRSM. +* +* (2-3a) Set the elements to zero. +* + JBTEMP2 = JB - 2 + DO J = JB, JB+JNB-2 + DO I = J-JBTEMP2, NB + T( I, J ) = ZERO + END DO + END DO +* +* (2-3b) Perform the triangular solve. +* + CALL DTRSM( 'R', 'L', 'T', 'U', JNB, JNB, ONE, + $ A( JB, JB ), LDA, T( 1, JB ), LDT ) +* + END DO +* + RETURN +* +* End of DORHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/dporfsx.f b/lapack-netlib/SRC/dporfsx.f index 53724925e..67cca9ccf 100644 --- a/lapack-netlib/SRC/dporfsx.f +++ b/lapack-netlib/SRC/dporfsx.f @@ -135,7 +135,7 @@ *> \param[in,out] S *> \verbatim *> S is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'Y', A is multiplied on +*> The scale factors for A. If EQUED = 'Y', A is multiplied on *> the left and right by diag(S). S is an input argument if FACT = *> 'F'; otherwise, S is an output argument. If FACT = 'F' and EQUED *> = 'Y', each element of S must be positive. If S is output, each @@ -263,7 +263,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -299,14 +299,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -314,9 +314,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/dposvxx.f b/lapack-netlib/SRC/dposvxx.f index 488e0b15a..b0de44910 100644 --- a/lapack-netlib/SRC/dposvxx.f +++ b/lapack-netlib/SRC/dposvxx.f @@ -366,7 +366,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -402,14 +402,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -417,9 +417,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/dsb2st_kernels.f b/lapack-netlib/SRC/dsb2st_kernels.f index 3bf126d5b..a9dc6b5ca 100644 --- a/lapack-netlib/SRC/dsb2st_kernels.f +++ b/lapack-netlib/SRC/dsb2st_kernels.f @@ -1,26 +1,26 @@ *> \brief \b DSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec 7 08:22:39 2016 -* +* * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DSB2ST_KERNELS + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DSB2ST_KERNELS + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, +* SUBROUTINE DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, * ST, ED, SWEEP, N, NB, IB, * A, LDA, V, TAU, LDVT, WORK) * @@ -32,9 +32,9 @@ * INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. -* DOUBLE PRECISION A( LDA, * ), V( * ), +* DOUBLE PRECISION A( LDA, * ), V( * ), * TAU( * ), WORK( * ) -* +* *> \par Purpose: * ============= *> @@ -124,7 +124,7 @@ *> LDVT is INTEGER. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array. Workspace of size nb. *> \endverbatim @@ -147,7 +147,7 @@ *> http://doi.acm.org/10.1145/2063384.2063394 *> *> A. Haidar, J. Kurzak, P. Luszczek, 2013. -*> An improved parallel singular value algorithm and its implementation +*> An improved parallel singular value algorithm and its implementation *> for multicore hardware, In Proceedings of 2013 International Conference *> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> Denver, Colorado, USA, 2013. @@ -155,16 +155,16 @@ *> http://doi.acm.org/10.1145/2503210.2503292 *> *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. -*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure +*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> calculations based on fine-grained memory aware tasks. *> International Journal of High Performance Computing Applications. *> Volume 28 Issue 2, Pages 196-209, May 2014. -*> http://hpc.sagepub.com/content/28/2/196 +*> http://hpc.sagepub.com/content/28/2/196 *> *> \endverbatim *> * ===================================================================== - SUBROUTINE DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, + SUBROUTINE DSB2ST_KERNELS( UPLO, WANTZ, TTYPE, $ ST, ED, SWEEP, N, NB, IB, $ A, LDA, V, TAU, LDVT, WORK) * @@ -181,7 +181,7 @@ INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. - DOUBLE PRECISION A( LDA, * ), V( * ), + DOUBLE PRECISION A( LDA, * ), V( * ), $ TAU( * ), WORK( * ) * .. * @@ -195,8 +195,8 @@ * .. Local Scalars .. LOGICAL UPPER INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS, - $ DPOS, OFDPOS, AJETER - DOUBLE PRECISION CTMP + $ DPOS, OFDPOS, AJETER + DOUBLE PRECISION CTMP * .. * .. External Subroutines .. EXTERNAL DLARFG, DLARFX, DLARFY @@ -209,7 +209,7 @@ * .. * .. * .. Executable Statements .. -* +* AJETER = IB + LDVT UPPER = LSAME( UPLO, 'U' ) @@ -240,10 +240,10 @@ V( VPOS ) = ONE DO 10 I = 1, LM-1 V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO + A( OFDPOS-I, ST+I ) = ZERO 10 CONTINUE CTMP = ( A( OFDPOS, ST ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) A( OFDPOS, ST ) = CTMP * @@ -281,14 +281,14 @@ * V( VPOS ) = ONE DO 30 I = 1, LM-1 - V( VPOS+I ) = + V( VPOS+I ) = $ ( A( DPOS-NB-I, J1+I ) ) A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = ( A( DPOS-NB, J1 ) ) CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP -* +* CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), $ TAU( TAUPOS ), $ A( DPOS-NB+1, J1 ), LDA-1, WORK) @@ -296,9 +296,9 @@ ENDIF * * Lower case -* +* ELSE -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -313,9 +313,9 @@ V( VPOS ) = ONE DO 20 I = 1, LM-1 V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO + A( OFDPOS+I, ST-1 ) = ZERO 20 CONTINUE - CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * LM = ED - ST + 1 @@ -342,7 +342,7 @@ LM = J2-J1+1 * IF( LM.GT.0) THEN - CALL DLARFX( 'Right', LM, LN, V( VPOS ), + CALL DLARFX( 'Right', LM, LN, V( VPOS ), $ TAU( TAUPOS ), A( DPOS+NB, ST ), $ LDA-1, WORK) * @@ -359,13 +359,13 @@ V( VPOS+I ) = A( DPOS+NB+I, ST ) A( DPOS+NB+I, ST ) = ZERO 40 CONTINUE - CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * - CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), + CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), $ ( TAU( TAUPOS ) ), $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) - + ENDIF ENDIF ENDIF @@ -374,4 +374,4 @@ * * END OF DSB2ST_KERNELS * - END + END diff --git a/lapack-netlib/SRC/dsbgvx.f b/lapack-netlib/SRC/dsbgvx.f index eab5ebcbb..6de1eb89b 100644 --- a/lapack-netlib/SRC/dsbgvx.f +++ b/lapack-netlib/SRC/dsbgvx.f @@ -261,11 +261,11 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> < 0 : if INFO = -i, the i-th argument had an illegal value +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value *> <= N: if INFO = i, then i eigenvectors failed to converge. *> Their indices are stored in IFAIL. -*> > N : DPBSTF returned an error code; i.e., +*> > N: DPBSTF returned an error code; i.e., *> if INFO = N + i, for 1 <= i <= N, then the leading *> minor of order i of B is not positive definite. *> The factorization of B could not be completed and diff --git a/lapack-netlib/SRC/dsgesv.f b/lapack-netlib/SRC/dsgesv.f index f47327d00..edbb87e7a 100644 --- a/lapack-netlib/SRC/dsgesv.f +++ b/lapack-netlib/SRC/dsgesv.f @@ -92,9 +92,9 @@ *> dimension (LDA,N) *> On entry, the N-by-N coefficient matrix A. *> On exit, if iterative refinement has been successfully used -*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is +*> (INFO = 0 and ITER >= 0, see description below), then A is *> unchanged, if double precision factorization has been used -*> (INFO.EQ.0 and ITER.LT.0, see description below), then the +*> (INFO = 0 and ITER < 0, see description below), then the *> array A contains the factors L and U from the factorization *> A = P*L*U; the unit diagonal elements of L are not stored. *> \endverbatim @@ -111,8 +111,8 @@ *> The pivot indices that define the permutation matrix P; *> row i of the matrix was interchanged with row IPIV(i). *> Corresponds either to the single precision factorization -*> (if INFO.EQ.0 and ITER.GE.0) or the double precision -*> factorization (if INFO.EQ.0 and ITER.LT.0). +*> (if INFO = 0 and ITER >= 0) or the double precision +*> factorization (if INFO = 0 and ITER < 0). *> \endverbatim *> *> \param[in] B @@ -406,7 +406,7 @@ 30 CONTINUE * * If we are at this place of the code, this is because we have -* performed ITER=ITERMAX iterations and never satisified the +* performed ITER=ITERMAX iterations and never satisfied the * stopping criterion, set up the ITER flag accordingly and follow up * on double precision routine. * diff --git a/lapack-netlib/SRC/dsposv.f b/lapack-netlib/SRC/dsposv.f index 4a8575241..6c8baa56b 100644 --- a/lapack-netlib/SRC/dsposv.f +++ b/lapack-netlib/SRC/dsposv.f @@ -106,9 +106,9 @@ *> triangular part of the matrix A, and the strictly upper *> triangular part of A is not referenced. *> On exit, if iterative refinement has been successfully used -*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is +*> (INFO = 0 and ITER >= 0, see description below), then A is *> unchanged, if double precision factorization has been used -*> (INFO.EQ.0 and ITER.LT.0, see description below), then the +*> (INFO = 0 and ITER < 0, see description below), then the *> array A contains the factor U or L from the Cholesky *> factorization A = U**T*U or A = L*L**T. *> \endverbatim @@ -413,7 +413,7 @@ 30 CONTINUE * * If we are at this place of the code, this is because we have -* performed ITER=ITERMAX iterations and never satisified the +* performed ITER=ITERMAX iterations and never satisfied the * stopping criterion, set up the ITER flag accordingly and follow * up on double precision routine. * diff --git a/lapack-netlib/SRC/dstemr.f b/lapack-netlib/SRC/dstemr.f index a1a8e3433..16c9d970d 100644 --- a/lapack-netlib/SRC/dstemr.f +++ b/lapack-netlib/SRC/dstemr.f @@ -233,13 +233,13 @@ *> \param[in,out] TRYRAC *> \verbatim *> TRYRAC is LOGICAL -*> If TRYRAC.EQ..TRUE., indicates that the code should check whether +*> If TRYRAC = .TRUE., indicates that the code should check whether *> the tridiagonal matrix defines its eigenvalues to high relative *> accuracy. If so, the code uses relative-accuracy preserving *> algorithms that might be (a bit) slower depending on the matrix. *> If the matrix does not define its eigenvalues to high relative *> accuracy, the code can uses possibly faster algorithms. -*> If TRYRAC.EQ..FALSE., the code is not required to guarantee +*> If TRYRAC = .FALSE., the code is not required to guarantee *> relatively accurate eigenvalues and can use the fastest possible *> techniques. *> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix diff --git a/lapack-netlib/SRC/dsyconvf.f b/lapack-netlib/SRC/dsyconvf.f index 37c8157ba..60cfd1e65 100644 --- a/lapack-netlib/SRC/dsyconvf.f +++ b/lapack-netlib/SRC/dsyconvf.f @@ -291,7 +291,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -344,7 +344,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -435,7 +435,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where k increases from 1 to N * I = 1 @@ -488,7 +488,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/dsyconvf_rook.f b/lapack-netlib/SRC/dsyconvf_rook.f index 5c774906e..bd683a087 100644 --- a/lapack-netlib/SRC/dsyconvf_rook.f +++ b/lapack-netlib/SRC/dsyconvf_rook.f @@ -282,7 +282,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -333,7 +333,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -423,7 +423,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where i increases from 1 to N * I = 1 @@ -474,7 +474,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/dsyev_2stage.f b/lapack-netlib/SRC/dsyev_2stage.f index fff0dedbc..9d802905c 100644 --- a/lapack-netlib/SRC/dsyev_2stage.f +++ b/lapack-netlib/SRC/dsyev_2stage.f @@ -317,7 +317,7 @@ IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE -* Not available in this release, and agrument checking should not +* Not available in this release, and argument checking should not * let it getting here RETURN CALL DORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), diff --git a/lapack-netlib/SRC/dsyevd_2stage.f b/lapack-netlib/SRC/dsyevd_2stage.f index 75a6da436..ff8e08d71 100644 --- a/lapack-netlib/SRC/dsyevd_2stage.f +++ b/lapack-netlib/SRC/dsyevd_2stage.f @@ -385,7 +385,7 @@ IF( .NOT.WANTZ ) THEN CALL DSTERF( N, W, WORK( INDE ), INFO ) ELSE -* Not available in this release, and agrument checking should not +* Not available in this release, and argument checking should not * let it getting here RETURN CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, diff --git a/lapack-netlib/SRC/dsyrfsx.f b/lapack-netlib/SRC/dsyrfsx.f index e128cd4e0..eb091e720 100644 --- a/lapack-netlib/SRC/dsyrfsx.f +++ b/lapack-netlib/SRC/dsyrfsx.f @@ -271,7 +271,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -307,14 +307,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -322,9 +322,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/dsysv_aa.f b/lapack-netlib/SRC/dsysv_aa.f index 7192928c6..4ee474448 100644 --- a/lapack-netlib/SRC/dsysv_aa.f +++ b/lapack-netlib/SRC/dsysv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric tridiagonal. The factored @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**T or A = L*T*L**T as computed by +*> factorization A = U**T*T*U or A = L*T*L**T as computed by *> DSYTRF. *> \endverbatim *> @@ -230,7 +230,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL DSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/dsysv_aa_2stage.f b/lapack-netlib/SRC/dsysv_aa_2stage.f index 05e538f0b..ef593bc7e 100644 --- a/lapack-netlib/SRC/dsysv_aa_2stage.f +++ b/lapack-netlib/SRC/dsysv_aa_2stage.f @@ -45,7 +45,7 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric and band. The matrix T is @@ -259,7 +259,7 @@ END IF * * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL DSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/dsysvxx.f b/lapack-netlib/SRC/dsysvxx.f index 6e167d81e..0be50bcd1 100644 --- a/lapack-netlib/SRC/dsysvxx.f +++ b/lapack-netlib/SRC/dsysvxx.f @@ -377,7 +377,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -413,14 +413,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension (NPARAMS) -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -428,9 +428,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/dsytf2_rk.f b/lapack-netlib/SRC/dsytf2_rk.f index 45cf62ab9..cc9e4616e 100644 --- a/lapack-netlib/SRC/dsytf2_rk.f +++ b/lapack-netlib/SRC/dsytf2_rk.f @@ -312,7 +312,7 @@ * * Factorize A as U*D*U**T using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = ZERO @@ -623,7 +623,7 @@ * * Factorize A as L*D*L**T using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = ZERO * diff --git a/lapack-netlib/SRC/dsytrd_2stage.f b/lapack-netlib/SRC/dsytrd_2stage.f index 522602bb2..fc4b92908 100644 --- a/lapack-netlib/SRC/dsytrd_2stage.f +++ b/lapack-netlib/SRC/dsytrd_2stage.f @@ -123,23 +123,22 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is DOUBLE PRECISION array, dimension LHOUS2, that -*> store the Householder representation of the stage2 +*> HOUS2 is DOUBLE PRECISION array, dimension (LHOUS2) +*> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim *> *> \param[in] LHOUS2 *> \verbatim *> LHOUS2 is INTEGER -*> The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array HOUS2. +*> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns *> this value as the first entry of the HOUS2 array, and no error *> message related to LHOUS2 is issued by XERBLA. -*> LHOUS2 = MAX(1, dimension) where -*> dimension = 4*N if VECT='N' -*> not available now if VECT='H' +*> If VECT='N', LHOUS2 = max(1, 4*n); +*> if VECT='V', option not yet available. *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/dsytrd_sb2st.F b/lapack-netlib/SRC/dsytrd_sb2st.F index 4d81fe226..0c0dbf125 100644 --- a/lapack-netlib/SRC/dsytrd_sb2st.F +++ b/lapack-netlib/SRC/dsytrd_sb2st.F @@ -50,9 +50,9 @@ * Arguments: * ========== * -*> \param[in] STAGE +*> \param[in] STAGE1 *> \verbatim -*> STAGE is CHARACTER*1 +*> STAGE1 is CHARACTER*1 *> = 'N': "No": to mention that the stage 1 of the reduction *> from dense to band using the dsytrd_sy2sb routine *> was not called before this routine to reproduce AB. diff --git a/lapack-netlib/SRC/dsytrd_sy2sb.f b/lapack-netlib/SRC/dsytrd_sy2sb.f index e0a5debc5..7f30817b0 100644 --- a/lapack-netlib/SRC/dsytrd_sy2sb.f +++ b/lapack-netlib/SRC/dsytrd_sy2sb.f @@ -363,7 +363,7 @@ * * * Set the workspace of the triangular matrix T to zero once such a -* way everytime T is generated the upper/lower portion will be always zero +* way every time T is generated the upper/lower portion will be always zero * CALL DLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT ) * diff --git a/lapack-netlib/SRC/dsytrf.f b/lapack-netlib/SRC/dsytrf.f index d8da4f122..a3bd30a2f 100644 --- a/lapack-netlib/SRC/dsytrf.f +++ b/lapack-netlib/SRC/dsytrf.f @@ -39,7 +39,7 @@ *> the Bunch-Kaufman diagonal pivoting method. The form of the *> factorization is *> -*> A = U*D*U**T or A = L*D*L**T +*> A = U**T*D*U or A = L*D*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and D is symmetric and block diagonal with @@ -144,7 +144,7 @@ *> *> \verbatim *> -*> If UPLO = 'U', then A = U*D*U**T, where +*> If UPLO = 'U', then A = U**T*D*U, where *> U = P(n)*U(n)* ... *P(k)U(k)* ..., *> i.e., U is a product of terms P(k)*U(k), where k decreases from n to *> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 @@ -262,7 +262,7 @@ * IF( UPPER ) THEN * -* Factorize A as U*D*U**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * * K is the main loop index, decreasing from N to 1 in steps of * KB, where KB is the number of columns factorized by DLASYF; diff --git a/lapack-netlib/SRC/dsytrf_aa.f b/lapack-netlib/SRC/dsytrf_aa.f index 24b3f393b..6df0da2cd 100644 --- a/lapack-netlib/SRC/dsytrf_aa.f +++ b/lapack-netlib/SRC/dsytrf_aa.f @@ -37,7 +37,7 @@ *> DSYTRF_AA computes the factorization of a real symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a symmetric tridiagonal matrix. @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * * Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -375,7 +375,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/dsytrf_aa_2stage.f b/lapack-netlib/SRC/dsytrf_aa_2stage.f index 25fc1a2eb..a37be5bdd 100644 --- a/lapack-netlib/SRC/dsytrf_aa_2stage.f +++ b/lapack-netlib/SRC/dsytrf_aa_2stage.f @@ -38,7 +38,7 @@ *> DSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a symmetric band matrix with the @@ -103,6 +103,22 @@ *> no error message related to LTB is issued by XERBLA. *> \endverbatim *> +*> \param[out] IPIV +*> \verbatim +*> IPIV is INTEGER array, dimension (N) +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the +*> row and column IPIV(k). +*> \endverbatim +*> +*> \param[out] IPIV2 +*> \verbatim +*> IPIV2 is INTEGER array, dimension (N) +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of T were interchanged with the +*> row and column IPIV2(k). +*> \endverbatim +*> *> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION workspace of size LWORK @@ -120,22 +136,6 @@ *> no error message related to LWORK is issued by XERBLA. *> \endverbatim *> -*> \param[out] IPIV -*> \verbatim -*> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the -*> row and column IPIV(k). -*> \endverbatim -*> -*> \param[out] IPIV2 -*> \verbatim -*> IPIV2 is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of T were interchanged with the -*> row and column IPIV2(k). -*> \endverbatim -*> *> \param[out] INFO *> \verbatim *> INFO is INTEGER @@ -275,7 +275,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -442,12 +442,14 @@ c END IF * > Apply pivots to previous columns of L CALL DSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL DSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) + $ CALL DSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL DSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL DSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -616,11 +618,13 @@ c END IF CALL DSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) * > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL DSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) + IF( I2.GT.(I1+1) ) + $ CALL DSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL DSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL DSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/dsytri2.f b/lapack-netlib/SRC/dsytri2.f index 23f8b9fa2..5c3a5ec76 100644 --- a/lapack-netlib/SRC/dsytri2.f +++ b/lapack-netlib/SRC/dsytri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by DSYTRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by DSYTRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/dsytrs_aa.f b/lapack-netlib/SRC/dsytrs_aa.f index 05ef31ff3..d9dc0a6d1 100644 --- a/lapack-netlib/SRC/dsytrs_aa.f +++ b/lapack-netlib/SRC/dsytrs_aa.f @@ -37,7 +37,7 @@ *> \verbatim *> *> DSYTRS_AA solves a system of linear equations A*X = B with a real -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by DSYTRF_AA. *> \endverbatim * @@ -49,7 +49,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -97,14 +97,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -198,22 +200,29 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. +* +* 1) Forward substitution with U**T +* + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* Pivot, P**T * B + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Compute U**T \ B -> B [ (U**T \P**T * B) ] * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] + CALL DTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL DTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute T \ B -> B [ T \ (U**T \P**T * B) ] * CALL DLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN @@ -223,35 +232,47 @@ CALL DGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, $ INFO ) * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* 3) Backward substitution with U +* + IF( N.GT.1 ) THEN * - CALL DTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] + CALL DTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * ELSE * * Solve A*X = B, where A = L*T*L**T. * -* Pivot, P**T * B +* 1) Forward substitution with L * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B +* + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute L \ B -> B [ (L \P**T * B) ] +* + CALL DTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL DTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * * Compute T \ B -> B [ T \ (L \P**T * B) ] * @@ -263,18 +284,23 @@ CALL DGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**T * - CALL DTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) + IF( N.GT.1 ) THEN +* +* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] + CALL DTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL DSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/dsytrs_aa_2stage.f b/lapack-netlib/SRC/dsytrs_aa_2stage.f index bb283cb95..69c702f8a 100644 --- a/lapack-netlib/SRC/dsytrs_aa_2stage.f +++ b/lapack-netlib/SRC/dsytrs_aa_2stage.f @@ -36,7 +36,7 @@ *> \verbatim *> *> DSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a real -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by DSYTRF_AA_2STAGE. *> \endverbatim * @@ -48,7 +48,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -208,15 +208,15 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * CALL DTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) @@ -234,7 +234,7 @@ CALL DTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] * CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * @@ -246,11 +246,11 @@ * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute (L \ B) -> B [ (L \P**T * B) ] * CALL DTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) @@ -268,7 +268,7 @@ CALL DTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] * CALL DLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * diff --git a/lapack-netlib/SRC/dtgsy2.f b/lapack-netlib/SRC/dtgsy2.f index 1c687b15e..e8c9b4001 100644 --- a/lapack-netlib/SRC/dtgsy2.f +++ b/lapack-netlib/SRC/dtgsy2.f @@ -71,7 +71,7 @@ *> R * B**T + L * E**T = scale * -F *> *> This case is used to compute an estimate of Dif[(A, D), (B, E)] = -*> sigma_min(Z) using reverse communicaton with DLACON. +*> sigma_min(Z) using reverse communication with DLACON. *> *> DTGSY2 also (IJOB >= 1) contributes to the computation in DTGSYL *> of an upper bound on the separation between to matrix pairs. Then @@ -85,7 +85,7 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). +*> = 'N': solve the generalized Sylvester equation (1). *> = 'T': solve the 'transposed' system (3). *> \endverbatim *> diff --git a/lapack-netlib/SRC/dtgsyl.f b/lapack-netlib/SRC/dtgsyl.f index 1cc3a1bf8..bb0751794 100644 --- a/lapack-netlib/SRC/dtgsyl.f +++ b/lapack-netlib/SRC/dtgsyl.f @@ -88,20 +88,20 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). -*> = 'T', solve the 'transposed' system (3). +*> = 'N': solve the generalized Sylvester equation (1). +*> = 'T': solve the 'transposed' system (3). *> \endverbatim *> *> \param[in] IJOB *> \verbatim *> IJOB is INTEGER *> Specifies what kind of functionality to be performed. -*> =0: solve (1) only. -*> =1: The functionality of 0 and 3. -*> =2: The functionality of 0 and 4. -*> =3: Only an estimate of Dif[(A,D), (B,E)] is computed. +*> = 0: solve (1) only. +*> = 1: The functionality of 0 and 3. +*> = 2: The functionality of 0 and 4. +*> = 3: Only an estimate of Dif[(A,D), (B,E)] is computed. *> (look ahead strategy IJOB = 1 is used). -*> =4: Only an estimate of Dif[(A,D), (B,E)] is computed. +*> = 4: Only an estimate of Dif[(A,D), (B,E)] is computed. *> ( DGECON on sub-systems is used ). *> Not referenced if TRANS = 'T'. *> \endverbatim diff --git a/lapack-netlib/SRC/dtpmlqt.f b/lapack-netlib/SRC/dtpmlqt.f index 3782d0c71..975ebdc27 100644 --- a/lapack-netlib/SRC/dtpmlqt.f +++ b/lapack-netlib/SRC/dtpmlqt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is DOUBLE PRECISION array, dimension (LDA,K) +*> V is DOUBLE PRECISION array, dimension (LDV,K) *> The i-th row must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DTPLQT in B. See Further Details. diff --git a/lapack-netlib/SRC/dtpmqrt.f b/lapack-netlib/SRC/dtpmqrt.f index 44985a80d..a7888e192 100644 --- a/lapack-netlib/SRC/dtpmqrt.f +++ b/lapack-netlib/SRC/dtpmqrt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is DOUBLE PRECISION array, dimension (LDA,K) +*> V is DOUBLE PRECISION array, dimension (LDV,K) *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> CTPQRT in B. See Further Details. diff --git a/lapack-netlib/SRC/dtprfb.f b/lapack-netlib/SRC/dtprfb.f index 6ae8fad8c..6d3b4dae1 100644 --- a/lapack-netlib/SRC/dtprfb.f +++ b/lapack-netlib/SRC/dtprfb.f @@ -152,8 +152,8 @@ *> \verbatim *> LDA is INTEGER *> The leading dimension of the array A. -*> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'L', LDA >= max(1,K); +*> If SIDE = 'R', LDA >= max(1,M). *> \endverbatim *> *> \param[in,out] B diff --git a/lapack-netlib/SRC/ilaenv.f b/lapack-netlib/SRC/ilaenv.f index a438ada38..7f68c383d 100644 --- a/lapack-netlib/SRC/ilaenv.f +++ b/lapack-netlib/SRC/ilaenv.f @@ -132,7 +132,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2017 +*> \date November 2019 * *> \ingroup OTHERauxiliary * @@ -162,10 +162,10 @@ * ===================================================================== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) * -* -- LAPACK auxiliary routine (version 3.8.0) -- +* -- LAPACK auxiliary routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2017 +* November 2019 * * .. Scalar Arguments .. CHARACTER*( * ) NAME, OPTS @@ -271,7 +271,16 @@ * NB = 1 * - IF( C2.EQ.'GE' ) THEN + IF( SUBNAM(2:6).EQ.'LAORH' ) THEN +* +* This is for *LAORHR_GETRFNP routine +* + IF( SNAME ) THEN + NB = 32 + ELSE + NB = 32 + END IF + ELSE IF( C2.EQ.'GE' ) THEN IF( C3.EQ.'TRF' ) THEN IF( SNAME ) THEN NB = 64 diff --git a/lapack-netlib/SRC/ilaenv2stage.f b/lapack-netlib/SRC/ilaenv2stage.f index 3c0d34a12..db30a1b4d 100644 --- a/lapack-netlib/SRC/ilaenv2stage.f +++ b/lapack-netlib/SRC/ilaenv2stage.f @@ -39,9 +39,9 @@ *> *> ILAENV2STAGE returns an INTEGER *> if ILAENV2STAGE >= 0: ILAENV2STAGE returns the value of the parameter -* specified by ISPEC +*> specified by ISPEC *> if ILAENV2STAGE < 0: if ILAENV2STAGE = -k, the k-th argument had an -* illegal value. +*> illegal value. *> *> This version provides a set of parameters which should give good, *> but not optimal, performance on many of the currently available diff --git a/lapack-netlib/SRC/iparam2stage.F b/lapack-netlib/SRC/iparam2stage.F index 836e20eed..1a37300a7 100644 --- a/lapack-netlib/SRC/iparam2stage.F +++ b/lapack-netlib/SRC/iparam2stage.F @@ -35,7 +35,7 @@ *> \verbatim *> *> This program sets problem and machine dependent parameters -*> useful for xHETRD_2STAGE, xHETRD_H@2HB, xHETRD_HB2ST, +*> useful for xHETRD_2STAGE, xHETRD_HE2HB, xHETRD_HB2ST, *> xGEBRD_2STAGE, xGEBRD_GE2GB, xGEBRD_GB2BD *> and related subroutines for eigenvalue problems. *> It is called whenever ILAENV is called with 17 <= ISPEC <= 21. @@ -53,7 +53,7 @@ *> return. *> *> ISPEC=17: the optimal blocksize nb for the reduction to -* BAND +*> BAND *> *> ISPEC=18: the optimal blocksize ib for the eigenvectors *> singular vectors update routine @@ -90,14 +90,14 @@ *> \param[in] NBI *> \verbatim *> NBI is INTEGER which is the used in the reduciton, -* (e.g., the size of the band), needed to compute workspace -* and LHOUS2. +*> (e.g., the size of the band), needed to compute workspace +*> and LHOUS2. *> \endverbatim *> *> \param[in] IBI *> \verbatim *> IBI is INTEGER which represent the IB of the reduciton, -* needed to compute workspace and LHOUS2. +*> needed to compute workspace and LHOUS2. *> \endverbatim *> *> \param[in] NXI diff --git a/lapack-netlib/SRC/iparmq.f b/lapack-netlib/SRC/iparmq.f index a9212b3e0..bb711243d 100644 --- a/lapack-netlib/SRC/iparmq.f +++ b/lapack-netlib/SRC/iparmq.f @@ -60,7 +60,7 @@ *> invest in an (expensive) multi-shift QR sweep. *> If the aggressive early deflation subroutine *> finds LD converged eigenvalues from an order -*> NW deflation window and LD.GT.(NW*NIBBLE)/100, +*> NW deflation window and LD > (NW*NIBBLE)/100, *> then the next QR sweep is skipped and early *> deflation is applied immediately to the *> remaining active diagonal block. Setting @@ -184,8 +184,8 @@ *> This depends on ILO, IHI and NS, the *> number of simultaneous shifts returned *> by IPARMQ(ISPEC=15). The default for -*> (IHI-ILO+1).LE.500 is NS. The default -*> for (IHI-ILO+1).GT.500 is 3*NS/2. +*> (IHI-ILO+1) <= 500 is NS. The default +*> for (IHI-ILO+1) > 500 is 3*NS/2. *> *> IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. *> diff --git a/lapack-netlib/SRC/meson.build b/lapack-netlib/SRC/meson.build new file mode 100644 index 000000000..bad682401 --- /dev/null +++ b/lapack-netlib/SRC/meson.build @@ -0,0 +1,11 @@ +ALLAUX = files('ilaenv.f', 'ilaenv2stage.f', 'ieeeck.f', 'lsamen.f', 'xerbla.f', 'xerbla_array.f', 'iparmq.f', 'iparam2stage.F', 'ilaprec.f', 'ilatrans.f', 'ilauplo.f', 'iladiag.f', 'chla_transtype.f', '../INSTALL/ilaver.f', '../INSTALL/lsame.f', '../INSTALL/slamch.f') + + +SCLAUX = files('sbdsdc.f', 'sbdsqr.f', 'sdisna.f', 'slabad.f', 'slacpy.f', 'sladiv.f', 'slae2.f', 'slaebz.f', 'slaed0.f', 'slaed1.f', 'slaed2.f', 'slaed3.f', 'slaed4.f', 'slaed5.f', 'slaed6.f', 'slaed7.f', 'slaed8.f', 'slaed9.f', 'slaeda.f', 'slaev2.f', 'slagtf.f', 'slagts.f', 'slamrg.f', 'slanst.f', 'slapy2.f', 'slapy3.f', 'slarnv.f', 'slarra.f', 'slarrb.f', 'slarrc.f', 'slarrd.f', 'slarre.f', 'slarrf.f', 'slarrj.f', 'slarrk.f', 'slarrr.f', 'slaneg.f', 'slartg.f', 'slaruv.f', 'slas2.f', 'slascl.f', 'slasd0.f', 'slasd1.f', 'slasd2.f', 'slasd3.f', 'slasd4.f', 'slasd5.f', 'slasd6.f', 'slasd7.f', 'slasd8.f', 'slasda.f', 'slasdq.f', 'slasdt.f', 'slaset.f', 'slasq1.f', 'slasq2.f', 'slasq3.f', 'slasq4.f', 'slasq5.f', 'slasq6.f', 'slasr.f', 'slasrt.f', 'slassq.f', 'slasv2.f', 'spttrf.f', 'sstebz.f', 'sstedc.f', 'ssteqr.f', 'ssterf.f', 'slaisnan.f', 'sisnan.f', 'slartgp.f', 'slartgs.f', '../INSTALL/second_INT_CPU_TIME.f') + +DZLAUX = files('dbdsdc.f', 'dbdsqr.f', 'ddisna.f', 'dlabad.f', 'dlacpy.f', 'dladiv.f', 'dlae2.f', 'dlaebz.f', 'dlaed0.f', 'dlaed1.f', 'dlaed2.f', 'dlaed3.f', 'dlaed4.f', 'dlaed5.f', 'dlaed6.f', 'dlaed7.f', 'dlaed8.f', 'dlaed9.f', 'dlaeda.f', 'dlaev2.f', 'dlagtf.f', 'dlagts.f', 'dlamrg.f', 'dlanst.f', 'dlapy2.f', 'dlapy3.f', 'dlarnv.f', 'dlarra.f', 'dlarrb.f', 'dlarrc.f', 'dlarrd.f', 'dlarre.f', 'dlarrf.f', 'dlarrj.f', 'dlarrk.f', 'dlarrr.f', 'dlaneg.f', 'dlartg.f', 'dlaruv.f', 'dlas2.f', 'dlascl.f', 'dlasd0.f', 'dlasd1.f', 'dlasd2.f', 'dlasd3.f', 'dlasd4.f', 'dlasd5.f', 'dlasd6.f', 'dlasd7.f', 'dlasd8.f', 'dlasda.f', 'dlasdq.f', 'dlasdt.f', 'dlaset.f', 'dlasq1.f', 'dlasq2.f', 'dlasq3.f', 'dlasq4.f', 'dlasq5.f', 'dlasq6.f', 'dlasr.f', 'dlasrt.f', 'dlassq.f', 'dlasv2.f', 'dpttrf.f', 'dstebz.f', 'dstedc.f', 'dsteqr.f', 'dsterf.f', 'dlaisnan.f', 'disnan.f', 'dlartgp.f', 'dlartgs.f', '../INSTALL/dlamch.f', '../INSTALL/dsecnd_INT_CPU_TIME.f') + + +SLASRC = files('sbdsvdx.f', 'spotrf2.f', 'sgetrf2.f', 'sgbbrd.f', 'sgbcon.f', 'sgbequ.f', 'sgbrfs.f', 'sgbsv.f', 'sgbsvx.f', 'sgbtf2.f', 'sgbtrf.f', 'sgbtrs.f', 'sgebak.f', 'sgebal.f', 'sgebd2.f', 'sgebrd.f', 'sgecon.f', 'sgeequ.f', 'sgees.f', 'sgeesx.f', 'sgeev.f', 'sgeevx.f', 'sgehd2.f', 'sgehrd.f', 'sgelq2.f', 'sgelqf.f', 'sgels.f', 'sgelsd.f', 'sgelss.f', 'sgelsy.f', 'sgeql2.f', 'sgeqlf.f', 'sgeqp3.f', 'sgeqr2.f', 'sgeqr2p.f', 'sgeqrf.f', 'sgeqrfp.f', 'sgerfs.f', 'sgerq2.f', 'sgerqf.f', 'sgesc2.f', 'sgesdd.f', 'sgesv.f', 'sgesvd.f', 'sgesvdx.f', 'sgesvx.f', 'sgetc2.f', 'sgetf2.f', 'sgetri.f', 'sggbak.f', 'sggbal.f', 'sgges.f', 'sgges3.f', 'sggesx.f', 'sggev.f', 'sggev3.f', 'sggevx.f', 'sggglm.f', 'sgghrd.f', 'sgghd3.f', 'sgglse.f', 'sggqrf.f', 'sggrqf.f', 'sggsvd3.f', 'sggsvp3.f', 'sgtcon.f', 'sgtrfs.f', 'sgtsv.f', 'sgtsvx.f', 'sgttrf.f', 'sgttrs.f', 'sgtts2.f', 'shgeqz.f', 'shsein.f', 'shseqr.f', 'slabrd.f', 'slacon.f', 'slacn2.f', 'slaein.f', 'slaexc.f', 'slag2.f', 'slags2.f', 'slagtm.f', 'slagv2.f', 'slahqr.f', 'slahr2.f', 'slaic1.f', 'slaln2.f', 'slals0.f', 'slalsa.f', 'slalsd.f', 'slangb.f', 'slange.f', 'slangt.f', 'slanhs.f', 'slansb.f', 'slansp.f', 'slansy.f', 'slantb.f', 'slantp.f', 'slantr.f', 'slanv2.f', 'slapll.f', 'slapmt.f', 'slaqgb.f', 'slaqge.f', 'slaqp2.f', 'slaqps.f', 'slaqsb.f', 'slaqsp.f', 'slaqsy.f', 'slaqr0.f', 'slaqr1.f', 'slaqr2.f', 'slaqr3.f', 'slaqr4.f', 'slaqr5.f', 'slaqtr.f', 'slar1v.f', 'slar2v.f', 'ilaslr.f', 'ilaslc.f', 'slarf.f', 'slarfb.f', 'slarfg.f', 'slarfgp.f', 'slarft.f', 'slarfx.f', 'slarfy.f', 'slargv.f', 'slarrv.f', 'slartv.f', 'slarz.f', 'slarzb.f', 'slarzt.f', 'slaswp.f', 'slasy2.f', 'slasyf.f', 'slasyf_rook.f', 'slasyf_rk.f', 'slatbs.f', 'slatdf.f', 'slatps.f', 'slatrd.f', 'slatrs.f', 'slatrz.f', 'slauu2.f', 'slauum.f', 'sopgtr.f', 'sopmtr.f', 'sorg2l.f', 'sorg2r.f', 'sorgbr.f', 'sorghr.f', 'sorgl2.f', 'sorglq.f', 'sorgql.f', 'sorgqr.f', 'sorgr2.f', 'sorgrq.f', 'sorgtr.f', 'sorm2l.f', 'sorm2r.f', 'sorm22.f', 'sormbr.f', 'sormhr.f', 'sorml2.f', 'sormlq.f', 'sormql.f', 'sormqr.f', 'sormr2.f', 'sormr3.f', 'sormrq.f', 'sormrz.f', 'sormtr.f', 'spbcon.f', 'spbequ.f', 'spbrfs.f', 'spbstf.f', 'spbsv.f', 'spbsvx.f', 'spbtf2.f', 'spbtrf.f', 'spbtrs.f', 'spocon.f', 'spoequ.f', 'sporfs.f', 'sposv.f', 'sposvx.f', 'spotf2.f', 'spotri.f', 'spstrf.f', 'spstf2.f', 'sppcon.f', 'sppequ.f', 'spprfs.f', 'sppsv.f', 'sppsvx.f', 'spptrf.f', 'spptri.f', 'spptrs.f', 'sptcon.f', 'spteqr.f', 'sptrfs.f', 'sptsv.f', 'sptsvx.f', 'spttrs.f', 'sptts2.f', 'srscl.f', 'ssbev.f', 'ssbevd.f', 'ssbevx.f', 'ssbgst.f', 'ssbgv.f', 'ssbgvd.f', 'ssbgvx.f', 'ssbtrd.f', 'sspcon.f', 'sspev.f', 'sspevd.f', 'sspevx.f', 'sspgst.f', 'sspgv.f', 'sspgvd.f', 'sspgvx.f', 'ssprfs.f', 'sspsv.f', 'sspsvx.f', 'ssptrd.f', 'ssptrf.f', 'ssptri.f', 'ssptrs.f', 'sstegr.f', 'sstein.f', 'sstev.f', 'sstevd.f', 'sstevr.f', 'sstevx.f', 'ssycon.f', 'ssyev.f', 'ssyevd.f', 'ssyevr.f', 'ssyevx.f', 'ssygs2.f', 'ssygst.f', 'ssygv.f', 'ssygvd.f', 'ssygvx.f', 'ssyrfs.f', 'ssysv.f', 'ssysvx.f', 'ssytd2.f', 'ssytf2.f', 'ssytrd.f', 'ssytrf.f', 'ssytri.f', 'ssytri2.f', 'ssytri2x.f', 'ssyswapr.f', 'ssytrs.f', 'ssytrs2.f', 'ssyconv.f', 'ssyconvf.f', 'ssyconvf_rook.f', 'ssytf2_rook.f', 'ssytrf_rook.f', 'ssytrs_rook.f', 'ssytri_rook.f', 'ssycon_rook.f', 'ssysv_rook.f', 'ssytf2_rk.f', 'ssytrf_rk.f', 'ssytrs_3.f', 'ssytri_3.f', 'ssytri_3x.f', 'ssycon_3.f', 'ssysv_rk.f', 'slasyf_aa.f', 'ssysv_aa.f', 'ssytrf_aa.f', 'ssytrs_aa.f', 'ssysv_aa_2stage.f', 'ssytrf_aa_2stage.f', 'ssytrs_aa_2stage.f', 'stbcon.f', 'stbrfs.f', 'stbtrs.f', 'stgevc.f', 'stgex2.f', 'stgexc.f', 'stgsen.f', 'stgsja.f', 'stgsna.f', 'stgsy2.f', 'stgsyl.f', 'stpcon.f', 'stprfs.f', 'stptri.f', 'stptrs.f', 'strcon.f', 'strevc.f', 'strevc3.f', 'strexc.f', 'strrfs.f', 'strsen.f', 'strsna.f', 'strsyl.f', 'strti2.f', 'strtri.f', 'strtrs.f', 'stzrzf.f', 'sstemr.f', 'slansf.f', 'spftrf.f', 'spftri.f', 'spftrs.f', 'ssfrk.f', 'stfsm.f', 'stftri.f', 'stfttp.f', 'stfttr.f', 'stpttf.f', 'stpttr.f', 'strttf.f', 'strttp.f', 'sgejsv.f', 'sgesvj.f', 'sgsvj0.f', 'sgsvj1.f', 'sgeequb.f', 'ssyequb.f', 'spoequb.f', 'sgbequb.f', 'sbbcsd.f', 'slapmr.f', 'sorbdb.f', 'sorbdb1.f', 'sorbdb2.f', 'sorbdb3.f', 'sorbdb4.f', 'sorbdb5.f', 'sorbdb6.f', 'sorcsd.f', 'sorcsd2by1.f', 'sgeqrt.f', 'sgeqrt2.f', 'sgeqrt3.f', 'sgemqrt.f', 'stpqrt.f', 'stpqrt2.f', 'stpmqrt.f', 'stprfb.f', 'sgelqt.f', 'sgelqt3.f', 'sgemlqt.f', 'sgetsls.f', 'sgeqr.f', 'slatsqr.f', 'slamtsqr.f', 'sgemqr.f', 'sgelq.f', 'slaswlq.f', 'slamswlq.f', 'sgemlq.f', 'stplqt.f', 'stplqt2.f', 'stpmlqt.f', 'ssytrd_2stage.f', 'ssytrd_sy2sb.f', 'ssytrd_sb2st.F', 'ssb2st_kernels.f', 'ssyevd_2stage.f', 'ssyev_2stage.f', 'ssyevx_2stage.f', 'ssyevr_2stage.f', 'ssbev_2stage.f', 'ssbevx_2stage.f', 'ssbevd_2stage.f', 'ssygv_2stage.f', 'sgesvdq.f', 'scombssq.f') + +DSLASRC = files('spotrs.f', 'sgetrs.f', 'spotrf.f', 'sgetrf.f') diff --git a/lapack-netlib/SRC/sbdsvdx.f b/lapack-netlib/SRC/sbdsvdx.f index a4b1887b2..c46674c47 100644 --- a/lapack-netlib/SRC/sbdsvdx.f +++ b/lapack-netlib/SRC/sbdsvdx.f @@ -165,7 +165,7 @@ *> *> \param[out] Z *> \verbatim -*> Z is REAL array, dimension (2*N,K) ) +*> Z is REAL array, dimension (2*N,K) *> If JOBZ = 'V', then if INFO = 0 the first NS columns of Z *> contain the singular vectors of the matrix B corresponding to *> the selected singular values, with U in rows 1 to N and V diff --git a/lapack-netlib/SRC/scombssq.f b/lapack-netlib/SRC/scombssq.f new file mode 100644 index 000000000..76bc0e320 --- /dev/null +++ b/lapack-netlib/SRC/scombssq.f @@ -0,0 +1,92 @@ +*> \brief \b SCOMBSSQ adds two scaled sum of squares quantities +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* +* Definition: +* =========== +* +* SUBROUTINE SCOMBSSQ( V1, V2 ) +* +* .. Array Arguments .. +* REAL V1( 2 ), V2( 2 ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SCOMBSSQ adds two scaled sum of squares quantities, V1 := V1 + V2. +*> That is, +*> +*> V1_scale**2 * V1_sumsq := V1_scale**2 * V1_sumsq +*> + V2_scale**2 * V2_sumsq +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in,out] V1 +*> \verbatim +*> V1 is REAL array, dimension (2). +*> The first scaled sum. +*> V1(1) = V1_scale, V1(2) = V1_sumsq. +*> \endverbatim +*> +*> \param[in] V2 +*> \verbatim +*> V2 is REAL array, dimension (2). +*> The second scaled sum. +*> V2(1) = V2_scale, V2(2) = V2_sumsq. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup OTHERauxiliary +* +* ===================================================================== + SUBROUTINE SCOMBSSQ( V1, V2 ) +* +* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2018 +* +* .. Array Arguments .. + REAL V1( 2 ), V2( 2 ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0D+0 ) +* .. +* .. Executable Statements .. +* + IF( V1( 1 ).GE.V2( 1 ) ) THEN + IF( V1( 1 ).NE.ZERO ) THEN + V1( 2 ) = V1( 2 ) + ( V2( 1 ) / V1( 1 ) )**2 * V2( 2 ) + END IF + ELSE + V1( 2 ) = V2( 2 ) + ( V1( 1 ) / V2( 1 ) )**2 * V1( 2 ) + V1( 1 ) = V2( 1 ) + END IF + RETURN +* +* End of SCOMBSSQ +* + END diff --git a/lapack-netlib/SRC/sgbrfsx.f b/lapack-netlib/SRC/sgbrfsx.f index 032b78b80..78ae584e1 100644 --- a/lapack-netlib/SRC/sgbrfsx.f +++ b/lapack-netlib/SRC/sgbrfsx.f @@ -308,7 +308,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -344,14 +344,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -359,9 +359,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/sgbsvxx.f b/lapack-netlib/SRC/sgbsvxx.f index b2132325e..3c3d737b3 100644 --- a/lapack-netlib/SRC/sgbsvxx.f +++ b/lapack-netlib/SRC/sgbsvxx.f @@ -431,7 +431,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -467,14 +467,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -482,9 +482,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/sgebak.f b/lapack-netlib/SRC/sgebak.f index ec58bf335..5c64c8b97 100644 --- a/lapack-netlib/SRC/sgebak.f +++ b/lapack-netlib/SRC/sgebak.f @@ -47,10 +47,10 @@ *> \verbatim *> JOB is CHARACTER*1 *> Specifies the type of backward transformation required: -*> = 'N', do nothing, return immediately; -*> = 'P', do backward transformation for permutation only; -*> = 'S', do backward transformation for scaling only; -*> = 'B', do backward transformations for both permutation and +*> = 'N': do nothing, return immediately; +*> = 'P': do backward transformation for permutation only; +*> = 'S': do backward transformation for scaling only; +*> = 'B': do backward transformations for both permutation and *> scaling. *> JOB must be the same as the argument JOB supplied to SGEBAL. *> \endverbatim diff --git a/lapack-netlib/SRC/sgeesx.f b/lapack-netlib/SRC/sgeesx.f index c90de9b81..5ffa3bc37 100644 --- a/lapack-netlib/SRC/sgeesx.f +++ b/lapack-netlib/SRC/sgeesx.f @@ -583,7 +583,9 @@ IF( N.GT.I+1 ) $ CALL SSWAP( N-I-1, A( I, I+2 ), LDA, $ A( I+1, I+2 ), LDA ) - CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + IF( WANTVS ) THEN + CALL SSWAP( N, VS( 1, I ), 1, VS( 1, I+1 ), 1 ) + END IF A( I, I+1 ) = A( I+1, I ) A( I+1, I ) = ZERO END IF diff --git a/lapack-netlib/SRC/sgejsv.f b/lapack-netlib/SRC/sgejsv.f index e4cbe8d0e..4ad316d99 100644 --- a/lapack-netlib/SRC/sgejsv.f +++ b/lapack-netlib/SRC/sgejsv.f @@ -82,7 +82,7 @@ *> desirable, then this option is advisable. The input matrix A *> is preprocessed with QR factorization with FULL (row and *> column) pivoting. -*> = 'G' Computation as with 'F' with an additional estimate of the +*> = 'G': Computation as with 'F' with an additional estimate of the *> condition number of B, where A=D*B. If A has heavily weighted *> rows, then using this condition number gives too pessimistic *> error bound. @@ -133,7 +133,7 @@ *> specified range. If A .NE. 0 is scaled so that the largest singular *> value of c*A is around SQRT(BIG), BIG=SLAMCH('O'), then JOBR issues *> the licence to kill columns of A whose norm in c*A is less than -*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN, +*> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, *> where SFMIN=SLAMCH('S'), EPSLN=SLAMCH('E'). *> = 'N': Do not kill small columns of c*A. This option assumes that *> BLAS and QR factorizations and triangular solvers are @@ -230,7 +230,7 @@ *> If JOBU = 'F', then U contains on exit the M-by-M matrix of *> the left singular vectors, including an ONB *> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N), +*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), *> then U is used as workspace if the procedure *> replaces A with A^t. In that case, [V] is computed *> in U as left singular vectors of A^t and then @@ -252,7 +252,7 @@ *> V is REAL array, dimension ( LDV, N ) *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> the right singular vectors; -*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), +*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), *> then V is used as workspace if the pprocedure *> replaces A with A^t. In that case, [U] is computed *> in V as right singular vectors of A^t and then @@ -278,7 +278,7 @@ *> of A. (See the description of SVA().) *> WORK(2) = See the description of WORK(1). *> WORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA .EQ. 'E' or 'G') +*> column equilibrated A. (If JOBA = 'E' or 'G') *> SCONDA is an estimate of SQRT(||(R^t * R)^(-1)||_1). *> It is computed using SPOCON. It holds *> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA @@ -297,7 +297,7 @@ *> triangular factor in the first QR factorization. *> WORK(5) = an estimate of the scaled condition number of the *> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT .EQ. 'T'. +*> The following two parameters are computed if JOBT = 'T'. *> They are provided for a developer/implementer who is familiar *> with the details of the method. *> @@ -313,8 +313,8 @@ *> Length of WORK to confirm proper allocation of work space. *> LWORK depends on the job: *> -*> If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> -> .. no scaled condition estimate required (JOBE.EQ.'N'): +*> If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and +*> -> .. no scaled condition estimate required (JOBE = 'N'): *> LWORK >= max(2*M+N,4*N+1,7). This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value *> is LWORK >= max(2*M+N,3*N+(N+1)*NB,7). Here NB is the optimal @@ -330,7 +330,7 @@ *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DGEQRF), *> N+N*N+LWORK(DPOCON),7). *> -*> If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), +*> If SIGMA and the right singular vectors are needed (JOBV = 'V'), *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> For optimal performance, LWORK >= max(2*M+N,3*N+(N+1)*NB,7), *> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQ, @@ -341,19 +341,19 @@ *> If SIGMA and the left singular vectors are needed *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), -*> if JOBU.EQ.'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7), +*> if JOBU = 'U' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,7), +*> if JOBU = 'F' :: LWORK >= max(2*M+N,3*N+(N+1)*NB,N+M*NB,7), *> where NB is the optimal block size for DGEQP3, DGEQRF, DORMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(2*M+N,N+LWORK(DGEQP3),N+LWORK(DPOCON), *> 2*N+LWORK(DGEQRF), N+LWORK(DORMQR)). -*> Here LWORK(DORMQR) equals N*NB (for JOBU.EQ.'U') or -*> M*NB (for JOBU.EQ.'F'). +*> Here LWORK(DORMQR) equals N*NB (for JOBU = 'U') or +*> M*NB (for JOBU = 'F'). *> -*> If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and -*> -> if JOBV.EQ.'V' +*> If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and +*> -> if JOBV = 'V' *> the minimal requirement is LWORK >= max(2*M+N,6*N+2*N*N). -*> -> if JOBV.EQ.'J' the minimal requirement is +*> -> if JOBV = 'J' the minimal requirement is *> LWORK >= max(2*M+N, 4*N+N*N,2*N+N*N+6). *> -> For optimal performance, LWORK should be additionally *> larger than N+M*NB, where NB is the optimal block size @@ -369,7 +369,7 @@ *> of JOBA and JOBR. *> IWORK(2) = the number of the computed nonzero singular values *> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3).EQ.1 then some of the column norms of A +*> If IWORK(3) = 1 then some of the column norms of A *> were denormalized floats. The requested high accuracy *> is not warranted by the data. *> \endverbatim @@ -377,10 +377,10 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> < 0 : if INFO = -i, then the i-th argument had an illegal value. -*> = 0 : successful exit; -*> > 0 : SGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. +*> < 0: if INFO = -i, then the i-th argument had an illegal value. +*> = 0: successful exit; +*> > 0: SGEJSV did not converge in the maximal allowed number +*> of sweeps. The computed values may be inaccurate. *> \endverbatim * * Authors: @@ -953,7 +953,7 @@ IF ( L2ABER ) THEN * Standard absolute error bound suffices. All sigma_i with * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* agressive enforcement of lower numerical rank by introducing a +* aggressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. TEMP1 = SQRT(FLOAT(N))*EPSLN DO 3001 p = 2, N @@ -965,7 +965,7 @@ 3001 CONTINUE 3002 CONTINUE ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less agressive). +* .. similarly as above, only slightly more gentle (less aggressive). * Sudden drop on the diagonal of R1 is used as the criterion for * close-to-rank-deficient. TEMP1 = SQRT(SFMIN) @@ -1294,7 +1294,7 @@ CALL SPOCON('Lower',NR,WORK(2*N+1),NR,ONE,TEMP1, $ WORK(2*N+NR*NR+1),IWORK(M+2*N+1),IERR) CONDR1 = ONE / SQRT(TEMP1) -* .. here need a second oppinion on the condition number +* .. here need a second opinion on the condition number * .. then assume worst case scenario * R1 is OK for inverse <=> CONDR1 .LT. FLOAT(N) * more conservative <=> CONDR1 .LT. SQRT(FLOAT(N)) @@ -1335,7 +1335,7 @@ ELSE * * .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equaly good +* Note that windowed pivoting would be equally good * numerically, and more run-time efficient. So, in * an optimal implementation, the next call to SGEQP3 * should be replaced with eg. CALL SGEQPX (ACM TOMS #782) @@ -1388,7 +1388,7 @@ * IF ( CONDR2 .GE. COND_OK ) THEN * .. save the Householder vectors used for Q3 -* (this overwrittes the copy of R2, as it will not be +* (this overwrites the copy of R2, as it will not be * needed in this branch, but it does not overwritte the * Huseholder vectors of Q2.). CALL SLACPY( 'U', NR, NR, V, LDV, WORK(2*N+1), N ) @@ -1638,7 +1638,7 @@ * * This branch deploys a preconditioned Jacobi SVD with explicitly * accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perfom well, and can also be used. +* experimental purposes. It does perform well, and can also be used. * In this implementation, this branch will be automatically activated * if the condition number sigma_max(A) / sigma_min(A) is predicted * to be greater than the overflow threshold. This is because the diff --git a/lapack-netlib/SRC/sgelq.f b/lapack-netlib/SRC/sgelq.f index 4fe4d191d..96c4097e8 100644 --- a/lapack-netlib/SRC/sgelq.f +++ b/lapack-netlib/SRC/sgelq.f @@ -1,3 +1,4 @@ +*> \brief \b SGELQ * * Definition: * =========== @@ -17,7 +18,17 @@ * ============= *> *> \verbatim -*> SGELQ computes a LQ factorization of an M-by-N matrix A. +*> +*> SGELQ computes an LQ factorization of a real M-by-N matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -138,7 +149,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -159,10 +170,10 @@ SUBROUTINE SGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/sgelq2.f b/lapack-netlib/SRC/sgelq2.f index 5b1ad215a..df8128d53 100644 --- a/lapack-netlib/SRC/sgelq2.f +++ b/lapack-netlib/SRC/sgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> SGELQ2 computes an LQ factorization of a real m by n matrix A: -*> A = L * Q. +*> SGELQ2 computes an LQ factorization of a real m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is an lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,7 +104,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -121,10 +129,10 @@ * ===================================================================== SUBROUTINE SGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/sgelqf.f b/lapack-netlib/SRC/sgelqf.f index 99c03c0a3..90357e623 100644 --- a/lapack-netlib/SRC/sgelqf.f +++ b/lapack-netlib/SRC/sgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> SGELQF computes an LQ factorization of a real M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,7 +118,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -135,10 +143,10 @@ * ===================================================================== SUBROUTINE SGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/sgelqt.f b/lapack-netlib/SRC/sgelqt.f index 9a93af332..64d46025c 100644 --- a/lapack-netlib/SRC/sgelqt.f +++ b/lapack-netlib/SRC/sgelqt.f @@ -1,3 +1,5 @@ +*> \brief \b SGELQT +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/sgelqt3.f b/lapack-netlib/SRC/sgelqt3.f index 292ae88a3..edf5d6d30 100644 --- a/lapack-netlib/SRC/sgelqt3.f +++ b/lapack-netlib/SRC/sgelqt3.f @@ -1,3 +1,5 @@ +*> \brief \b SGELQT3 +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/sgemlq.f b/lapack-netlib/SRC/sgemlq.f index dedbe7752..5f2e02a8e 100644 --- a/lapack-netlib/SRC/sgemlq.f +++ b/lapack-netlib/SRC/sgemlq.f @@ -1,3 +1,4 @@ +*> \brief \b SGEMLQ * * Definition: * =========== @@ -143,7 +144,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/sgemlqt.f b/lapack-netlib/SRC/sgemlqt.f index a8f022bdc..37850fdf5 100644 --- a/lapack-netlib/SRC/sgemlqt.f +++ b/lapack-netlib/SRC/sgemlqt.f @@ -1,3 +1,5 @@ +*> \brief \b SGEMLQT +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/sgemqr.f b/lapack-netlib/SRC/sgemqr.f index 307fc8ca9..66c5117c9 100644 --- a/lapack-netlib/SRC/sgemqr.f +++ b/lapack-netlib/SRC/sgemqr.f @@ -1,3 +1,4 @@ +*> \brief \b SGEMQR * * Definition: * =========== @@ -144,7 +145,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/sgeqr.f b/lapack-netlib/SRC/sgeqr.f index f939abd9d..4a6bb9ea5 100644 --- a/lapack-netlib/SRC/sgeqr.f +++ b/lapack-netlib/SRC/sgeqr.f @@ -1,3 +1,4 @@ +*> \brief \b SGEQR * * Definition: * =========== @@ -17,7 +18,18 @@ * ============= *> *> \verbatim -*> SGEQR computes a QR factorization of an M-by-N matrix A. +*> +*> SGEQR computes a QR factorization of a real M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -138,7 +150,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -160,10 +172,10 @@ SUBROUTINE SGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/sgeqr2.f b/lapack-netlib/SRC/sgeqr2.f index 3b990f825..0a1ff304f 100644 --- a/lapack-netlib/SRC/sgeqr2.f +++ b/lapack-netlib/SRC/sgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> SGEQR2 computes a QR factorization of a real m by n matrix A: -*> A = Q * R. +*> SGEQR2 computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,7 +105,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -121,10 +130,10 @@ * ===================================================================== SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/sgeqr2p.f b/lapack-netlib/SRC/sgeqr2p.f index f48af9d2d..08d124797 100644 --- a/lapack-netlib/SRC/sgeqr2p.f +++ b/lapack-netlib/SRC/sgeqr2p.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> SGEQR2P computes a QR factorization of a real m by n matrix A: -*> A = Q * R. The diagonal entries of R are nonnegative. +*> SGEQR2P computes a QR factorization of a real m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix with nonnegative diagonal +*> entries; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -97,7 +107,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -124,10 +134,10 @@ * ===================================================================== SUBROUTINE SGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/sgeqrf.f b/lapack-netlib/SRC/sgeqrf.f index 0f79c2ca5..7df495e04 100644 --- a/lapack-netlib/SRC/sgeqrf.f +++ b/lapack-netlib/SRC/sgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> SGEQRF computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -111,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -136,10 +145,10 @@ * ===================================================================== SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/sgeqrfp.f b/lapack-netlib/SRC/sgeqrfp.f index 654c0a13a..7f6741570 100644 --- a/lapack-netlib/SRC/sgeqrfp.f +++ b/lapack-netlib/SRC/sgeqrfp.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> SGEQRFP computes a QR factorization of a real M-by-N matrix A: -*> A = Q * R. The diagonal entries of R are nonnegative. +*> SGEQR2P computes a QR factorization of a real M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix with nonnegative diagonal +*> entries; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -112,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup realGEcomputational * @@ -139,10 +149,10 @@ * ===================================================================== SUBROUTINE SGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/sgerfsx.f b/lapack-netlib/SRC/sgerfsx.f index 3f518899e..b1a1eb13d 100644 --- a/lapack-netlib/SRC/sgerfsx.f +++ b/lapack-netlib/SRC/sgerfsx.f @@ -283,7 +283,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -319,14 +319,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -334,9 +334,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/sgesc2.f b/lapack-netlib/SRC/sgesc2.f index c78daa334..3a6f34584 100644 --- a/lapack-netlib/SRC/sgesc2.f +++ b/lapack-netlib/SRC/sgesc2.f @@ -90,7 +90,7 @@ *> \verbatim *> SCALE is REAL *> On exit, SCALE contains the scale factor. SCALE is chosen -*> 0 <= SCALE <= 1 to prevent owerflow in the solution. +*> 0 <= SCALE <= 1 to prevent overflow in the solution. *> \endverbatim * * Authors: @@ -151,7 +151,7 @@ * .. * .. Executable Statements .. * -* Set constant to control owerflow +* Set constant to control overflow * EPS = SLAMCH( 'P' ) SMLNUM = SLAMCH( 'S' ) / EPS diff --git a/lapack-netlib/SRC/sgesdd.f b/lapack-netlib/SRC/sgesdd.f index 0ba2a78c7..689494dd1 100644 --- a/lapack-netlib/SRC/sgesdd.f +++ b/lapack-netlib/SRC/sgesdd.f @@ -322,7 +322,7 @@ * IF( WNTQN ) THEN * sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N @@ -448,7 +448,7 @@ * IF( WNTQN ) THEN * sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) -* keep 7*N for backwards compatability. +* keep 7*N for backwards compatibility. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M diff --git a/lapack-netlib/SRC/sgesvdq.f b/lapack-netlib/SRC/sgesvdq.f new file mode 100644 index 000000000..73e34862f --- /dev/null +++ b/lapack-netlib/SRC/sgesvdq.f @@ -0,0 +1,1388 @@ +*> \brief SGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SGESVDQ + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, +* S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, +* WORK, LWORK, RWORK, LRWORK, INFO ) +* +* .. Scalar Arguments .. +* IMPLICIT NONE +* CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV +* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LWORK, LRWORK, +* INFO +* .. +* .. Array Arguments .. +* REAL A( LDA, * ), U( LDU, * ), V( LDV, * ), WORK( * ) +* REAL S( * ), RWORK( * ) +* INTEGER IWORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SGESVDQ computes the singular value decomposition (SVD) of a real +*> M-by-N matrix A, where M >= N. The SVD of A is written as +*> [++] [xx] [x0] [xx] +*> A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx] +*> [++] [xx] +*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal +*> matrix, and V is an N-by-N orthogonal matrix. The diagonal elements +*> of SIGMA are the singular values of A. The columns of U and V are the +*> left and the right singular vectors of A, respectively. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] JOBA +*> \verbatim +*> JOBA is CHARACTER*1 +*> Specifies the level of accuracy in the computed SVD +*> = 'A' The requested accuracy corresponds to having the backward +*> error bounded by || delta A ||_F <= f(m,n) * EPS * || A ||_F, +*> where EPS = SLAMCH('Epsilon'). This authorises CGESVDQ to +*> truncate the computed triangular factor in a rank revealing +*> QR factorization whenever the truncated part is below the +*> threshold of the order of EPS * ||A||_F. This is aggressive +*> truncation level. +*> = 'M' Similarly as with 'A', but the truncation is more gentle: it +*> is allowed only when there is a drop on the diagonal of the +*> triangular factor in the QR factorization. This is medium +*> truncation level. +*> = 'H' High accuracy requested. No numerical rank determination based +*> on the rank revealing QR factorization is attempted. +*> = 'E' Same as 'H', and in addition the condition number of column +*> scaled A is estimated and returned in RWORK(1). +*> N^(-1/4)*RWORK(1) <= ||pinv(A_scaled)||_2 <= N^(1/4)*RWORK(1) +*> \endverbatim +*> +*> \param[in] JOBP +*> \verbatim +*> JOBP is CHARACTER*1 +*> = 'P' The rows of A are ordered in decreasing order with respect to +*> ||A(i,:)||_\infty. This enhances numerical accuracy at the cost +*> of extra data movement. Recommended for numerical robustness. +*> = 'N' No row pivoting. +*> \endverbatim +*> +*> \param[in] JOBR +*> \verbatim +*> JOBR is CHARACTER*1 +*> = 'T' After the initial pivoted QR factorization, SGESVD is applied to +*> the transposed R**T of the computed triangular factor R. This involves +*> some extra data movement (matrix transpositions). Useful for +*> experiments, research and development. +*> = 'N' The triangular factor R is given as input to SGESVD. This may be +*> preferred as it involves less data movement. +*> \endverbatim +*> +*> \param[in] JOBU +*> \verbatim +*> JOBU is CHARACTER*1 +*> = 'A' All M left singular vectors are computed and returned in the +*> matrix U. See the description of U. +*> = 'S' or 'U' N = min(M,N) left singular vectors are computed and returned +*> in the matrix U. See the description of U. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK left singular +*> vectors are computed and returned in the matrix U. +*> = 'F' The N left singular vectors are returned in factored form as the +*> product of the Q factor from the initial QR factorization and the +*> N left singular vectors of (R**T , 0)**T. If row pivoting is used, +*> then the necessary information on the row pivoting is stored in +*> IWORK(N+1:N+M-1). +*> = 'N' The left singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] JOBV +*> \verbatim +*> JOBV is CHARACTER*1 +*> = 'A', 'V' All N right singular vectors are computed and returned in +*> the matrix V. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK right singular +*> vectors are computed and returned in the matrix V. This option is +*> allowed only if JOBU = 'R' or JOBU = 'N'; otherwise it is illegal. +*> = 'N' The right singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the input matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the input matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array of dimensions LDA x N +*> On entry, the input matrix A. +*> On exit, if JOBU .NE. 'N' or JOBV .NE. 'N', the lower triangle of A contains +*> the Householder vectors as stored by SGEQP3. If JOBU = 'F', these Householder +*> vectors together with WORK(1:N) can be used to restore the Q factors from +*> the initial pivoted QR factorization of A. See the description of U. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER. +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] S +*> \verbatim +*> S is REAL array of dimension N. +*> The singular values of A, ordered so that S(i) >= S(i+1). +*> \endverbatim +*> +*> \param[out] U +*> \verbatim +*> U is REAL array, dimension +*> LDU x M if JOBU = 'A'; see the description of LDU. In this case, +*> on exit, U contains the M left singular vectors. +*> LDU x N if JOBU = 'S', 'U', 'R' ; see the description of LDU. In this +*> case, U contains the leading N or the leading NUMRANK left singular vectors. +*> LDU x N if JOBU = 'F' ; see the description of LDU. In this case U +*> contains N x N orthogonal matrix that can be used to form the left +*> singular vectors. +*> If JOBU = 'N', U is not referenced. +*> \endverbatim +*> +*> \param[in] LDU +*> \verbatim +*> LDU is INTEGER. +*> The leading dimension of the array U. +*> If JOBU = 'A', 'S', 'U', 'R', LDU >= max(1,M). +*> If JOBU = 'F', LDU >= max(1,N). +*> Otherwise, LDU >= 1. +*> \endverbatim +*> +*> \param[out] V +*> \verbatim +*> V is REAL array, dimension +*> LDV x N if JOBV = 'A', 'V', 'R' or if JOBA = 'E' . +*> If JOBV = 'A', or 'V', V contains the N-by-N orthogonal matrix V**T; +*> If JOBV = 'R', V contains the first NUMRANK rows of V**T (the right +*> singular vectors, stored rowwise, of the NUMRANK largest singular values). +*> If JOBV = 'N' and JOBA = 'E', V is used as a workspace. +*> If JOBV = 'N', and JOBA.NE.'E', V is not referenced. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If JOBV = 'A', 'V', 'R', or JOBA = 'E', LDV >= max(1,N). +*> Otherwise, LDV >= 1. +*> \endverbatim +*> +*> \param[out] NUMRANK +*> \verbatim +*> NUMRANK is INTEGER +*> NUMRANK is the numerical rank first determined after the rank +*> revealing QR factorization, following the strategy specified by the +*> value of JOBA. If JOBV = 'R' and JOBU = 'R', only NUMRANK +*> leading singular values and vectors are then requested in the call +*> of SGESVD. The final value of NUMRANK might be further reduced if +*> some singular values are computed as zeros. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (max(1, LIWORK)). +*> On exit, IWORK(1:N) contains column pivoting permutation of the +*> rank revealing QR factorization. +*> If JOBP = 'P', IWORK(N+1:N+M-1) contains the indices of the sequence +*> of row swaps used in row pivoting. These can be used to restore the +*> left singular vectors in the case JOBU = 'F'. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> LIWORK(1) returns the minimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> LIWORK >= N + M - 1, if JOBP = 'P' and JOBA .NE. 'E'; +*> LIWORK >= N if JOBP = 'N' and JOBA .NE. 'E'; +*> LIWORK >= N + M - 1 + N, if JOBP = 'P' and JOBA = 'E'; +*> LIWORK >= N + N if JOBP = 'N' and JOBA = 'E'. +* +*> If LIWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is REAL array, dimension (max(2, LWORK)), used as a workspace. +*> On exit, if, on entry, LWORK.NE.-1, WORK(1:N) contains parameters +*> needed to recover the Q factor from the QR factorization computed by +*> SGEQP3. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> WORK(1) returns the optimal LWORK, and +*> WORK(2) returns the minimal LWORK. +*> \endverbatim +*> +*> \param[in,out] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of the array WORK. It is determined as follows: +*> Let LWQP3 = 3*N+1, LWCON = 3*N, and let +*> LWORQ = { MAX( N, 1 ), if JOBU = 'R', 'S', or 'U' +*> { MAX( M, 1 ), if JOBU = 'A' +*> LWSVD = MAX( 5*N, 1 ) +*> LWLQF = MAX( N/2, 1 ), LWSVD2 = MAX( 5*(N/2), 1 ), LWORLQ = MAX( N, 1 ), +*> LWQRF = MAX( N/2, 1 ), LWORQ2 = MAX( N, 1 ) +*> Then the minimal value of LWORK is: +*> = MAX( N + LWQP3, LWSVD ) if only the singular values are needed; +*> = MAX( N + LWQP3, LWCON, LWSVD ) if only the singular values are needed, +*> and a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWORQ ) if the singular values and the left +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) if the singular values and the left +*> singular vectors are requested, and also +*> a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD ) if the singular values and the right +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD ) if the singular values and the right +*> singular vectors are requested, and also +*> a scaled condition etimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWORQ ) if the full SVD is requested with JOBV = 'R'; +*> independent of JOBR; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) if the full SVD is requested, +*> JOBV = 'R' and, also a scaled condition +*> estimate requested; independent of JOBR; +*> = MAX( N + MAX( LWQP3, LWSVD, LWORQ ), +*> N + MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, N/2+LWORLQ, LWORQ) ) if the +*> full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWORQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWLQF, N/2+LWSVD2, N/2+LWORLQ, LWORQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N', and also a scaled condition number estimate +*> requested. +*> = MAX( N + MAX( LWQP3, LWSVD, LWORQ ), +*> N + MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, N/2+LWORQ2, LWORQ ) ) if the +*> full SVD is requested with JOBV = 'A', 'V', and JOBR ='T' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWORQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWQRF, N/2+LWSVD2, N/2+LWORQ2, LWORQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='T', and also a scaled condition number estimate +*> requested. +*> Finally, LWORK must be at least two: LWORK = MAX( 2, LWORK ). +*> +*> If LWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is REAL array, dimension (max(1, LRWORK)). +*> On exit, +*> 1. If JOBA = 'E', RWORK(1) contains an estimate of the condition +*> number of column scaled A. If A = C * D where D is diagonal and C +*> has unit columns in the Euclidean norm, then, assuming full column rank, +*> N^(-1/4) * RWORK(1) <= ||pinv(C)||_2 <= N^(1/4) * RWORK(1). +*> Otherwise, RWORK(1) = -1. +*> 2. RWORK(2) contains the number of singular values computed as +*> exact zeros in SGESVD applied to the upper triangular or trapeziodal +*> R (from the initial QR factorization). In case of early exit (no call to +*> SGESVD, such as in the case of zero matrix) RWORK(2) = -1. +*> +*> If LIWORK, LWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> RWORK(1) returns the minimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER. +*> The dimension of the array RWORK. +*> If JOBP ='P', then LRWORK >= MAX(2, M). +*> Otherwise, LRWORK >= 2 +* +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the WORK, IWORK, and RWORK arrays, and no error +*> message related to LWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: if SBDSQR did not converge, INFO specifies how many superdiagonals +*> of an intermediate bidiagonal form B (computed in SGESVD) did not +*> converge to zero. +*> \endverbatim +* +*> \par Further Details: +* ======================== +*> +*> \verbatim +*> +*> 1. The data movement (matrix transpose) is coded using simple nested +*> DO-loops because BLAS and LAPACK do not provide corresponding subroutines. +*> Those DO-loops are easily identified in this source code - by the CONTINUE +*> statements labeled with 11**. In an optimized version of this code, the +*> nested DO loops should be replaced with calls to an optimized subroutine. +*> 2. This code scales A by 1/SQRT(M) if the largest ABS(A(i,j)) could cause +*> column norm overflow. This is the minial precaution and it is left to the +*> SVD routine (CGESVD) to do its own preemptive scaling if potential over- +*> or underflows are detected. To avoid repeated scanning of the array A, +*> an optimal implementation would do all necessary scaling before calling +*> CGESVD and the scaling in CGESVD can be switched off. +*> 3. Other comments related to code optimization are given in comments in the +*> code, enlosed in [[double brackets]]. +*> \endverbatim +* +*> \par Bugs, examples and comments +* =========================== +* +*> \verbatim +*> Please report all bugs and send interesting examples and/or comments to +*> drmac@math.hr. Thank you. +*> \endverbatim +* +*> \par References +* =============== +* +*> \verbatim +*> [1] Zlatko Drmac, Algorithm 977: A QR-Preconditioned QR SVD Method for +*> Computing the SVD with High Accuracy. ACM Trans. Math. Softw. +*> 44(1): 11:1-11:30 (2017) +*> +*> SIGMA library, xGESVDQ section updated February 2016. +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup realGEsing +* +* ===================================================================== + SUBROUTINE SGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, + $ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, INFO ) +* .. Scalar Arguments .. + IMPLICIT NONE + CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV + INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LWORK, LRWORK, + $ INFO +* .. +* .. Array Arguments .. + REAL A( LDA, * ), U( LDU, * ), V( LDV, * ), WORK( * ) + REAL S( * ), RWORK( * ) + INTEGER IWORK( * ) +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) +* .. +* .. Local Scalars .. + INTEGER IERR, IWOFF, NR, N1, OPTRATIO, p, q + INTEGER LWCON, LWQP3, LWRK_SGELQF, LWRK_SGESVD, LWRK_SGESVD2, + $ LWRK_SGEQP3, LWRK_SGEQRF, LWRK_SORMLQ, LWRK_SORMQR, + $ LWRK_SORMQR2, LWLQF, LWQRF, LWSVD, LWSVD2, LWORQ, + $ LWORQ2, LWUNLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2, + $ IMINWRK, RMINWRK + LOGICAL ACCLA, ACCLM, ACCLH, ASCALED, CONDA, DNTWU, DNTWV, + $ LQUERY, LSVC0, LSVEC, ROWPRM, RSVEC, RTRANS, WNTUA, + $ WNTUF, WNTUR, WNTUS, WNTVA, WNTVR + REAL BIG, EPSLN, RTMP, SCONDA, SFMIN +* .. +* .. Local Arrays + REAL RDUMMY(1) +* .. +* .. External Subroutines (BLAS, LAPACK) + EXTERNAL SGELQF, SGEQP3, SGEQRF, SGESVD, SLACPY, SLAPMT, + $ SLASCL, SLASET, SLASWP, SSCAL, SPOCON, SORMLQ, + $ SORMQR, XERBLA +* .. +* .. External Functions (BLAS, LAPACK) + LOGICAL LSAME + INTEGER ISAMAX + REAL SLANGE, SNRM2, SLAMCH + EXTERNAL SLANGE, LSAME, ISAMAX, SNRM2, SLAMCH +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, MIN, REAL, SQRT +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + WNTUS = LSAME( JOBU, 'S' ) .OR. LSAME( JOBU, 'U' ) + WNTUR = LSAME( JOBU, 'R' ) + WNTUA = LSAME( JOBU, 'A' ) + WNTUF = LSAME( JOBU, 'F' ) + LSVC0 = WNTUS .OR. WNTUR .OR. WNTUA + LSVEC = LSVC0 .OR. WNTUF + DNTWU = LSAME( JOBU, 'N' ) +* + WNTVR = LSAME( JOBV, 'R' ) + WNTVA = LSAME( JOBV, 'A' ) .OR. LSAME( JOBV, 'V' ) + RSVEC = WNTVR .OR. WNTVA + DNTWV = LSAME( JOBV, 'N' ) +* + ACCLA = LSAME( JOBA, 'A' ) + ACCLM = LSAME( JOBA, 'M' ) + CONDA = LSAME( JOBA, 'E' ) + ACCLH = LSAME( JOBA, 'H' ) .OR. CONDA +* + ROWPRM = LSAME( JOBP, 'P' ) + RTRANS = LSAME( JOBR, 'T' ) +* + IF ( ROWPRM ) THEN + IF ( CONDA ) THEN + IMINWRK = MAX( 1, N + M - 1 + N ) + ELSE + IMINWRK = MAX( 1, N + M - 1 ) + END IF + RMINWRK = MAX( 2, M ) + ELSE + IF ( CONDA ) THEN + IMINWRK = MAX( 1, N + N ) + ELSE + IMINWRK = MAX( 1, N ) + END IF + RMINWRK = 2 + END IF + LQUERY = (LIWORK .EQ. -1 .OR. LWORK .EQ. -1 .OR. LRWORK .EQ. -1) + INFO = 0 + IF ( .NOT. ( ACCLA .OR. ACCLM .OR. ACCLH ) ) THEN + INFO = -1 + ELSE IF ( .NOT.( ROWPRM .OR. LSAME( JOBP, 'N' ) ) ) THEN + INFO = -2 + ELSE IF ( .NOT.( RTRANS .OR. LSAME( JOBR, 'N' ) ) ) THEN + INFO = -3 + ELSE IF ( .NOT.( LSVEC .OR. DNTWU ) ) THEN + INFO = -4 + ELSE IF ( WNTUR .AND. WNTVA ) THEN + INFO = -5 + ELSE IF ( .NOT.( RSVEC .OR. DNTWV )) THEN + INFO = -5 + ELSE IF ( M.LT.0 ) THEN + INFO = -6 + ELSE IF ( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN + INFO = -7 + ELSE IF ( LDA.LT.MAX( 1, M ) ) THEN + INFO = -9 + ELSE IF ( LDU.LT.1 .OR. ( LSVC0 .AND. LDU.LT.M ) .OR. + $ ( WNTUF .AND. LDU.LT.N ) ) THEN + INFO = -12 + ELSE IF ( LDV.LT.1 .OR. ( RSVEC .AND. LDV.LT.N ) .OR. + $ ( CONDA .AND. LDV.LT.N ) ) THEN + INFO = -14 + ELSE IF ( LIWORK .LT. IMINWRK .AND. .NOT. LQUERY ) THEN + INFO = -17 + END IF +* +* + IF ( INFO .EQ. 0 ) THEN +* .. compute the minimal and the optimal workspace lengths +* [[The expressions for computing the minimal and the optimal +* values of LWORK are written with a lot of redundancy and +* can be simplified. However, this detailed form is easier for +* maintenance and modifications of the code.]] +* +* .. minimal workspace length for SGEQP3 of an M x N matrix + LWQP3 = 3 * N + 1 +* .. minimal workspace length for SORMQR to build left singular vectors + IF ( WNTUS .OR. WNTUR ) THEN + LWORQ = MAX( N , 1 ) + ELSE IF ( WNTUA ) THEN + LWORQ = MAX( M , 1 ) + END IF +* .. minimal workspace length for SPOCON of an N x N matrix + LWCON = 3 * N +* .. SGESVD of an N x N matrix + LWSVD = MAX( 5 * N, 1 ) + IF ( LQUERY ) THEN + CALL SGEQP3( M, N, A, LDA, IWORK, RDUMMY, RDUMMY, -1, + $ IERR ) + LWRK_SGEQP3 = INT( RDUMMY(1) ) + IF ( WNTUS .OR. WNTUR ) THEN + CALL SORMQR( 'L', 'N', M, N, N, A, LDA, RDUMMY, U, + $ LDU, RDUMMY, -1, IERR ) + LWRK_SORMQR = INT( RDUMMY(1) ) + ELSE IF ( WNTUA ) THEN + CALL SORMQR( 'L', 'N', M, M, N, A, LDA, RDUMMY, U, + $ LDU, RDUMMY, -1, IERR ) + LWRK_SORMQR = INT( RDUMMY(1) ) + ELSE + LWRK_SORMQR = 0 + END IF + END IF + MINWRK = 2 + OPTWRK = 2 + IF ( .NOT. (LSVEC .OR. RSVEC )) THEN +* .. minimal and optimal sizes of the workspace if +* only the singular values are requested + IF ( CONDA ) THEN + MINWRK = MAX( N+LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = MAX( N+LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + CALL SGESVD( 'N', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = MAX( N+LWRK_SGEQP3, N+LWCON, LWRK_SGESVD ) + ELSE + OPTWRK = MAX( N+LWRK_SGEQP3, LWRK_SGESVD ) + END IF + END IF + ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN +* .. minimal and optimal sizes of the workspace if the +* singular values and the left singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD, LWORQ ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD, LWORQ ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL SGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + ELSE + CALL SGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + END IF + LWRK_SGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_SGEQP3, LWCON, LWRK_SGESVD, + $ LWRK_SORMQR ) + ELSE + OPTWRK = N + MAX( LWRK_SGEQP3, LWRK_SGESVD, + $ LWRK_SORMQR ) + END IF + END IF + ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN +* .. minimal and optimal sizes of the workspace if the +* singular values and the right singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL SGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + ELSE + CALL SGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + END IF + LWRK_SGESVD = INT( RDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_SGEQP3, LWCON, LWRK_SGESVD ) + ELSE + OPTWRK = N + MAX( LWRK_SGEQP3, LWRK_SGESVD ) + END IF + END IF + ELSE +* .. minimal and optimal sizes of the workspace if the +* full SVD is requested + IF ( RTRANS ) THEN + MINWRK = MAX( LWQP3, LWSVD, LWORQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N x N/2 SGEQRF + LWQRF = MAX( N/2, 1 ) +* .. minimal workspace lengt for N/2 x N/2 SGESVD + LWSVD2 = MAX( 5 * (N/2), 1 ) + LWORQ2 = MAX( N, 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, + $ N/2+LWORQ2, LWORQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + ELSE + MINWRK = MAX( LWQP3, LWSVD, LWORQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N/2 x N SGELQF + LWLQF = MAX( N/2, 1 ) + LWSVD2 = MAX( 5 * (N/2), 1 ) + LWUNLQ = MAX( N , 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, + $ N/2+LWUNLQ, LWORQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL SGESVD( 'O', 'A', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SGESVD = INT( RDUMMY(1) ) + OPTWRK = MAX(LWRK_SGEQP3,LWRK_SGESVD,LWRK_SORMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL SGEQRF(N,N/2,U,LDU,RDUMMY,RDUMMY,-1,IERR) + LWRK_SGEQRF = INT( RDUMMY(1) ) + CALL SGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SGESVD2 = INT( RDUMMY(1) ) + CALL SORMQR( 'R', 'C', N, N, N/2, U, LDU, RDUMMY, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SORMQR2 = INT( RDUMMY(1) ) + OPTWRK2 = MAX( LWRK_SGEQP3, N/2+LWRK_SGEQRF, + $ N/2+LWRK_SGESVD2, N/2+LWRK_SORMQR2 ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + ELSE + CALL SGESVD( 'S', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SGESVD = INT( RDUMMY(1) ) + OPTWRK = MAX(LWRK_SGEQP3,LWRK_SGESVD,LWRK_SORMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL SGELQF(N/2,N,U,LDU,RDUMMY,RDUMMY,-1,IERR) + LWRK_SGELQF = INT( RDUMMY(1) ) + CALL SGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + $ V, LDV, RDUMMY, -1, IERR ) + LWRK_SGESVD2 = INT( RDUMMY(1) ) + CALL SORMLQ( 'R', 'N', N, N, N/2, U, LDU, RDUMMY, + $ V, LDV, RDUMMY,-1,IERR ) + LWRK_SORMLQ = INT( RDUMMY(1) ) + OPTWRK2 = MAX( LWRK_SGEQP3, N/2+LWRK_SGELQF, + $ N/2+LWRK_SGESVD2, N/2+LWRK_SORMLQ ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + END IF + END IF + END IF +* + MINWRK = MAX( 2, MINWRK ) + OPTWRK = MAX( 2, OPTWRK ) + IF ( LWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = -19 +* + END IF +* + IF (INFO .EQ. 0 .AND. LRWORK .LT. RMINWRK .AND. .NOT. LQUERY) THEN + INFO = -21 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SGESVDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +* +* Return optimal workspace +* + IWORK(1) = IMINWRK + WORK(1) = OPTWRK + WORK(2) = MINWRK + RWORK(1) = RMINWRK + RETURN + END IF +* +* Quick return if the matrix is void. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) THEN +* .. all output is void. + RETURN + END IF +* + BIG = SLAMCH('O') + ASCALED = .FALSE. + IWOFF = 1 + IF ( ROWPRM ) THEN + IWOFF = M +* .. reordering the rows in decreasing sequence in the +* ell-infinity norm - this enhances numerical robustness in +* the case of differently scaled rows. + DO 1904 p = 1, M +* RWORK(p) = ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) +* [[SLANGE will return NaN if an entry of the p-th row is Nan]] + RWORK(p) = SLANGE( 'M', 1, N, A(p,1), LDA, RDUMMY ) +* .. check for NaN's and Inf's + IF ( ( RWORK(p) .NE. RWORK(p) ) .OR. + $ ( (RWORK(p)*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'SGESVDQ', -INFO ) + RETURN + END IF + 1904 CONTINUE + DO 1952 p = 1, M - 1 + q = ISAMAX( M-p+1, RWORK(p), 1 ) + p - 1 + IWORK(N+p) = q + IF ( p .NE. q ) THEN + RTMP = RWORK(p) + RWORK(p) = RWORK(q) + RWORK(q) = RTMP + END IF + 1952 CONTINUE +* + IF ( RWORK(1) .EQ. ZERO ) THEN +* Quick return: A is the M x N zero matrix. + NUMRANK = 0 + CALL SLASET( 'G', N, 1, ZERO, ZERO, S, N ) + IF ( WNTUS ) CALL SLASET('G', M, N, ZERO, ONE, U, LDU) + IF ( WNTUA ) CALL SLASET('G', M, M, ZERO, ONE, U, LDU) + IF ( WNTVA ) CALL SLASET('G', N, N, ZERO, ONE, V, LDV) + IF ( WNTUF ) THEN + CALL SLASET( 'G', N, 1, ZERO, ZERO, WORK, N ) + CALL SLASET( 'G', M, N, ZERO, ONE, U, LDU ) + END IF + DO 5001 p = 1, N + IWORK(p) = p + 5001 CONTINUE + IF ( ROWPRM ) THEN + DO 5002 p = N + 1, N + M - 1 + IWORK(p) = p - N + 5002 CONTINUE + END IF + IF ( CONDA ) RWORK(1) = -1 + RWORK(2) = -1 + RETURN + END IF +* + IF ( RWORK(1) .GT. BIG / SQRT(REAL(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL SLASCL('G',0,0,SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + CALL SLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) + END IF +* +* .. At this stage, preemptive scaling is done only to avoid column +* norms overflows during the QR factorization. The SVD procedure should +* have its own scaling to save the singular values from overflows and +* underflows. That depends on the SVD procedure. +* + IF ( .NOT.ROWPRM ) THEN + RTMP = SLANGE( 'M', M, N, A, LDA, RDUMMY ) + IF ( ( RTMP .NE. RTMP ) .OR. + $ ( (RTMP*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'SGESVDQ', -INFO ) + RETURN + END IF + IF ( RTMP .GT. BIG / SQRT(REAL(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL SLASCL('G',0,0, SQRT(REAL(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + END IF +* +* .. QR factorization with column pivoting +* +* A * P = Q * [ R ] +* [ 0 ] +* + DO 1963 p = 1, N +* .. all columns are free columns + IWORK(p) = 0 + 1963 CONTINUE + CALL SGEQP3( M, N, A, LDA, IWORK, WORK, WORK(N+1), LWORK-N, + $ IERR ) +* +* If the user requested accuracy level allows truncation in the +* computed upper triangular factor, the matrix R is examined and, +* if possible, replaced with its leading upper trapezoidal part. +* + EPSLN = SLAMCH('E') + SFMIN = SLAMCH('S') +* SMALL = SFMIN / EPSLN + NR = N +* + IF ( ACCLA ) THEN +* +* Standard absolute error bound suffices. All sigma_i with +* sigma_i < N*EPS*||A||_F are flushed to zero. This is an +* aggressive enforcement of lower numerical rank by introducing a +* backward error of the order of N*EPS*||A||_F. + NR = 1 + RTMP = SQRT(REAL(N))*EPSLN + DO 3001 p = 2, N + IF ( ABS(A(p,p)) .LT. (RTMP*ABS(A(1,1))) ) GO TO 3002 + NR = NR + 1 + 3001 CONTINUE + 3002 CONTINUE +* + ELSEIF ( ACCLM ) THEN +* .. similarly as above, only slightly more gentle (less aggressive). +* Sudden drop on the diagonal of R is used as the criterion for being +* close-to-rank-deficient. The threshold is set to EPSLN=SLAMCH('E'). +* [[This can be made more flexible by replacing this hard-coded value +* with a user specified threshold.]] Also, the values that underflow +* will be truncated. + NR = 1 + DO 3401 p = 2, N + IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. + $ ( ABS(A(p,p)) .LT. SFMIN ) ) GO TO 3402 + NR = NR + 1 + 3401 CONTINUE + 3402 CONTINUE +* + ELSE +* .. RRQR not authorized to determine numerical rank except in the +* obvious case of zero pivots. +* .. inspect R for exact zeros on the diagonal; +* R(i,i)=0 => R(i:N,i:N)=0. + NR = 1 + DO 3501 p = 2, N + IF ( ABS(A(p,p)) .EQ. ZERO ) GO TO 3502 + NR = NR + 1 + 3501 CONTINUE + 3502 CONTINUE +* + IF ( CONDA ) THEN +* Estimate the scaled condition number of A. Use the fact that it is +* the same as the scaled condition number of R. +* .. V is used as workspace + CALL SLACPY( 'U', N, N, A, LDA, V, LDV ) +* Only the leading NR x NR submatrix of the triangular factor +* is considered. Only if NR=N will this give a reliable error +* bound. However, even for NR < N, this can be used on an +* expert level and obtain useful information in the sense of +* perturbation theory. + DO 3053 p = 1, NR + RTMP = SNRM2( p, V(1,p), 1 ) + CALL SSCAL( p, ONE/RTMP, V(1,p), 1 ) + 3053 CONTINUE + IF ( .NOT. ( LSVEC .OR. RSVEC ) ) THEN + CALL SPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ WORK, IWORK(N+IWOFF), IERR ) + ELSE + CALL SPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ WORK(N+1), IWORK(N+IWOFF), IERR ) + END IF + SCONDA = ONE / SQRT(RTMP) +* For NR=N, SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1), +* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA +* See the reference [1] for more details. + END IF +* + ENDIF +* + IF ( WNTUR ) THEN + N1 = NR + ELSE IF ( WNTUS .OR. WNTUF) THEN + N1 = N + ELSE IF ( WNTUA ) THEN + N1 = M + END IF +* + IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN +*....................................................................... +* .. only the singular values are requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. compute the singular values of R**T = [A](1:NR,1:N)**T +* .. set the lower triangle of [A] to [A](1:NR,1:N)**T and +* the upper triangle of [A] to zero. + DO 1146 p = 1, MIN( N, NR ) + DO 1147 q = p + 1, N + A(q,p) = A(p,q) + IF ( q .LE. NR ) A(p,q) = ZERO + 1147 CONTINUE + 1146 CONTINUE +* + CALL SGESVD( 'N', 'N', N, NR, A, LDA, S, U, LDU, + $ V, LDV, WORK, LWORK, INFO ) +* + ELSE +* +* .. compute the singular values of R = [A](1:NR,1:N) +* + IF ( NR .GT. 1 ) + $ CALL SLASET( 'L', NR-1,NR-1, ZERO,ZERO, A(2,1), LDA ) + CALL SGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, + $ V, LDV, WORK, LWORK, INFO ) +* + END IF +* + ELSE IF ( LSVEC .AND. ( .NOT. RSVEC) ) THEN +*....................................................................... +* .. the singular values and the left singular vectors requested +*......................................................................."""""""" + IF ( RTRANS ) THEN +* .. apply SGESVD to R**T +* .. copy R**T into [U] and overwrite [U] with the right singular +* vectors of R + DO 1192 p = 1, NR + DO 1193 q = p, N + U(q,p) = A(p,q) + 1193 CONTINUE + 1192 CONTINUE + IF ( NR .GT. 1 ) + $ CALL SLASET( 'U', NR-1,NR-1, ZERO,ZERO, U(1,2), LDU ) +* .. the left singular vectors not computed, the NR right singular +* vectors overwrite [U](1:NR,1:NR) as transposed. These +* will be pre-multiplied by Q to build the left singular vectors of A. + CALL SGESVD( 'N', 'O', N, NR, U, LDU, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1119 p = 1, NR + DO 1120 q = p + 1, NR + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1120 CONTINUE + 1119 CONTINUE +* + ELSE +* .. apply SGESVD to R +* .. copy R into [U] and overwrite [U] with the left singular vectors + CALL SLACPY( 'U', NR, N, A, LDA, U, LDU ) + IF ( NR .GT. 1 ) + $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, U(2,1), LDU ) +* .. the right singular vectors not computed, the NR left singular +* vectors overwrite [U](1:NR,1:NR) + CALL SGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) +* .. now [U](1:NR,1:NR) contains the NR left singular vectors of +* R. These will be pre-multiplied by Q to build the left singular +* vectors of A. + END IF +* +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN + CALL SLASET('A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL SLASET( 'A',NR,N1-NR,ZERO,ZERO,U(1,NR+1), LDU ) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT.WNTUF ) + $ CALL SORMQR( 'L', 'N', M, N1, N, A, LDA, WORK, U, + $ LDU, WORK(N+1), LWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* + ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN +*....................................................................... +* .. the singular values and the right singular vectors requested +*....................................................................... + IF ( RTRANS ) THEN +* .. apply SGESVD to R**T +* .. copy R**T into V and overwrite V with the left singular vectors + DO 1165 p = 1, NR + DO 1166 q = p, N + V(q,p) = (A(p,q)) + 1166 CONTINUE + 1165 CONTINUE + IF ( NR .GT. 1 ) + $ CALL SLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV ) +* .. the left singular vectors of R**T overwrite V, the right singular +* vectors not computed + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL SGESVD( 'O', 'N', N, NR, V, LDV, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1121 p = 1, NR + DO 1122 q = p + 1, NR + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1122 CONTINUE + 1121 CONTINUE +* + IF ( NR .LT. N ) THEN + DO 1103 p = 1, NR + DO 1104 q = NR + 1, N + V(p,q) = V(q,p) + 1104 CONTINUE + 1103 CONTINUE + END IF + CALL SLAPMT( .FALSE., NR, N, V, LDV, IWORK ) + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:N,1:NR) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the QR factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL SLASET('G', N, N-NR, ZERO, ZERO, V(1,NR+1), LDV) + CALL SGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1123 p = 1, N + DO 1124 q = p + 1, N + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1124 CONTINUE + 1123 CONTINUE + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* + ELSE +* .. aply SGESVD to R +* .. copy R into V and overwrite V with the right singular vectors + CALL SLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL SLASET( 'L', NR-1, NR-1, ZERO, ZERO, V(2,1), LDV ) +* .. the right singular vectors overwrite V, the NR left singular +* vectors stored in U(1:NR,1:NR) + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL SGESVD( 'N', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL SLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**T + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:NR,1:N) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the LQ factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL SLASET('G', N-NR, N, ZERO,ZERO, V(NR+1,1), LDV) + CALL SGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* .. now [V] contains the transposed matrix of the right singular +* vectors of A. + END IF +* + ELSE +*....................................................................... +* .. FULL SVD requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. apply SGESVD to R**T [[this option is left for R&D&T]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R**T into [V] and overwrite [V] with the left singular +* vectors of R**T + DO 1168 p = 1, NR + DO 1169 q = p, N + V(q,p) = A(p,q) + 1169 CONTINUE + 1168 CONTINUE + IF ( NR .GT. 1 ) + $ CALL SLASET( 'U', NR-1,NR-1, ZERO,ZERO, V(1,2), LDV ) +* +* .. the left singular vectors of R**T overwrite [V], the NR right +* singular vectors of R**T stored in [U](1:NR,1:NR) as transposed + CALL SGESVD( 'O', 'A', N, NR, V, LDV, S, V, LDV, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* .. assemble V + DO 1115 p = 1, NR + DO 1116 q = p + 1, NR + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1116 CONTINUE + 1115 CONTINUE + IF ( NR .LT. N ) THEN + DO 1101 p = 1, NR + DO 1102 q = NR+1, N + V(p,q) = V(q,p) + 1102 CONTINUE + 1101 CONTINUE + END IF + CALL SLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* + DO 1117 p = 1, NR + DO 1118 q = p + 1, NR + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1118 CONTINUE + 1117 CONTINUE +* + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. copy R**T into [V] and overwrite [V] with the left singular +* vectors of R**T +* [[The optimal ratio N/NR for using QRF instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'SGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO*NR .GT. N ) THEN + DO 1198 p = 1, NR + DO 1199 q = p, N + V(q,p) = A(p,q) + 1199 CONTINUE + 1198 CONTINUE + IF ( NR .GT. 1 ) + $ CALL SLASET('U',NR-1,NR-1, ZERO,ZERO, V(1,2),LDV) +* + CALL SLASET('A',N,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL SGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, + $ U, LDU, WORK(N+1), LWORK-N, INFO ) +* + DO 1113 p = 1, N + DO 1114 q = p + 1, N + RTMP = V(q,p) + V(q,p) = V(p,q) + V(p,q) = RTMP + 1114 CONTINUE + 1113 CONTINUE + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). +* + DO 1111 p = 1, N + DO 1112 q = p + 1, N + RTMP = U(q,p) + U(q,p) = U(p,q) + U(p,q) = RTMP + 1112 CONTINUE + 1111 CONTINUE +* + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL SLASET('A',M-N,N1-N,ZERO,ONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE +* .. copy R**T into [U] and overwrite [U] with the right +* singular vectors of R + DO 1196 p = 1, NR + DO 1197 q = p, N + U(q,NR+p) = A(p,q) + 1197 CONTINUE + 1196 CONTINUE + IF ( NR .GT. 1 ) + $ CALL SLASET('U',NR-1,NR-1,ZERO,ZERO,U(1,NR+2),LDU) + CALL SGEQRF( N, NR, U(1,NR+1), LDU, WORK(N+1), + $ WORK(N+NR+1), LWORK-N-NR, IERR ) + DO 1143 p = 1, NR + DO 1144 q = 1, N + V(q,p) = U(p,NR+q) + 1144 CONTINUE + 1143 CONTINUE + CALL SLASET('U',NR-1,NR-1,ZERO,ZERO,V(1,2),LDV) + CALL SGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V,LDV, WORK(N+NR+1),LWORK-N-NR, INFO ) + CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) + CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL SORMQR('R','C', N, N, NR, U(1,NR+1), LDU, + $ WORK(N+1),V,LDV,WORK(N+NR+1),LWORK-N-NR,IERR) + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1),LDU) + END IF + END IF + END IF + END IF +* + ELSE +* +* .. apply SGESVD to R [[this is the recommended option]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R into [V] and overwrite V with the right singular vectors + CALL SLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL SLASET( 'L', NR-1,NR-1, ZERO,ZERO, V(2,1), LDV ) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL SGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL SLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**T +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A', M-NR,NR, ZERO,ZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. the requested number of the left singular vectors +* is then N1 (N or M) +* [[The optimal ratio N/NR for using LQ instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'SGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO * NR .GT. N ) THEN + CALL SLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL SLASET('L', NR-1,NR-1, ZERO,ZERO, V(2,1),LDV) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL SLASET('A', N-NR,N, ZERO,ZERO, V(NR+1,1),LDV) + CALL SGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+1), LWORK-N, INFO ) + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. now [V] contains the transposed matrix of the right +* singular vectors of A. The leading N left singular vectors +* are in [U](1:N,1:N) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A',M-N,N,ZERO,ZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL SLASET('A',N,N1-N,ZERO,ZERO,U(1,N+1),LDU) + CALL SLASET( 'A',M-N,N1-N,ZERO,ONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE + CALL SLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) + IF ( NR .GT. 1 ) + $ CALL SLASET('L',NR-1,NR-1,ZERO,ZERO,U(NR+2,1),LDU) + CALL SGELQF( NR, N, U(NR+1,1), LDU, WORK(N+1), + $ WORK(N+NR+1), LWORK-N-NR, IERR ) + CALL SLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) + IF ( NR .GT. 1 ) + $ CALL SLASET('U',NR-1,NR-1,ZERO,ZERO,V(1,2),LDV) + CALL SGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V, LDV, WORK(N+NR+1), LWORK-N-NR, INFO ) + CALL SLASET('A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV) + CALL SLASET('A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV) + CALL SLASET('A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV) + CALL SORMLQ('R','N',N,N,NR,U(NR+1,1),LDU,WORK(N+1), + $ V, LDV, WORK(N+NR+1),LWORK-N-NR,IERR) + CALL SLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL SLASET('A',M-NR,NR,ZERO,ZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL SLASET('A',NR,N1-NR,ZERO,ZERO,U(1,NR+1),LDU) + CALL SLASET( 'A',M-NR,N1-NR,ZERO,ONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF + END IF + END IF +* .. end of the "R**T or R" branch + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT. WNTUF ) + $ CALL SORMQR( 'L', 'N', M, N1, N, A, LDA, WORK, U, + $ LDU, WORK(N+1), LWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL SLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* +* ... end of the "full SVD" branch + END IF +* +* Check whether some singular values are returned as zeros, e.g. +* due to underflow, and update the numerical rank. + p = NR + DO 4001 q = p, 1, -1 + IF ( S(q) .GT. ZERO ) GO TO 4002 + NR = NR - 1 + 4001 CONTINUE + 4002 CONTINUE +* +* .. if numerical rank deficiency is detected, the truncated +* singular values are set to zero. + IF ( NR .LT. N ) CALL SLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) +* .. undo scaling; this may cause overflow in the largest singular +* values. + IF ( ASCALED ) + $ CALL SLASCL( 'G',0,0, ONE,SQRT(REAL(M)), NR,1, S, N, IERR ) + IF ( CONDA ) RWORK(1) = SCONDA + RWORK(2) = p - NR +* .. p-NR is the number of singular values that are computed as +* exact zeros in SGESVD() applied to the (possibly truncated) +* full row rank triangular (trapezoidal) factor of A. + NUMRANK = NR +* + RETURN +* +* End of SGESVDQ +* + END diff --git a/lapack-netlib/SRC/sgesvj.f b/lapack-netlib/SRC/sgesvj.f index 7a7901135..fee5aba4a 100644 --- a/lapack-netlib/SRC/sgesvj.f +++ b/lapack-netlib/SRC/sgesvj.f @@ -90,13 +90,13 @@ *> JOBV is CHARACTER*1 *> Specifies whether to compute the right singular vectors, that *> is, the matrix V: -*> = 'V' : the matrix V is computed and returned in the array V -*> = 'A' : the Jacobi rotations are applied to the MV-by-N +*> = 'V': the matrix V is computed and returned in the array V +*> = 'A': the Jacobi rotations are applied to the MV-by-N *> array V. In other words, the right singular vector *> matrix V is not computed explicitly; instead it is *> applied to an MV-by-N matrix initially stored in the *> first MV rows of V. -*> = 'N' : the matrix V is not computed and the array V is not +*> = 'N': the matrix V is not computed and the array V is not *> referenced *> \endverbatim *> @@ -118,8 +118,8 @@ *> A is REAL array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, -*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C': -*> If INFO .EQ. 0 : +*> If JOBU = 'U' .OR. JOBU = 'C': +*> If INFO = 0: *> RANKA orthonormal columns of U are returned in the *> leading RANKA columns of the array A. Here RANKA <= N *> is the number of computed singular values of A that are @@ -129,9 +129,9 @@ *> in the array WORK as RANKA=NINT(WORK(2)). Also see the *> descriptions of SVA and WORK. The computed columns of U *> are mutually numerically orthogonal up to approximately -*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'), +*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU = 'C'), *> see the description of JOBU. -*> If INFO .GT. 0, +*> If INFO > 0, *> the procedure SGESVJ did not converge in the given number *> of iterations (sweeps). In that case, the computed *> columns of U may not be orthogonal up to TOL. The output @@ -139,8 +139,8 @@ *> values in SVA(1:N)) and V is still a decomposition of the *> input matrix A in the sense that the residual *> ||A-SCALE*U*SIGMA*V^T||_2 / ||A||_2 is small. -*> If JOBU .EQ. 'N': -*> If INFO .EQ. 0 : +*> If JOBU = 'N': +*> If INFO = 0: *> Note that the left singular vectors are 'for free' in the *> one-sided Jacobi SVD algorithm. However, if only the *> singular values are needed, the level of numerical @@ -149,7 +149,7 @@ *> numerically orthogonal up to approximately M*EPS. Thus, *> on exit, A contains the columns of U scaled with the *> corresponding singular values. -*> If INFO .GT. 0 : +*> If INFO > 0: *> the procedure SGESVJ did not converge in the given number *> of iterations (sweeps). *> \endverbatim @@ -164,9 +164,9 @@ *> \verbatim *> SVA is REAL array, dimension (N) *> On exit, -*> If INFO .EQ. 0 : +*> If INFO = 0 : *> depending on the value SCALE = WORK(1), we have: -*> If SCALE .EQ. ONE: +*> If SCALE = ONE: *> SVA(1:N) contains the computed singular values of A. *> During the computation SVA contains the Euclidean column *> norms of the iterated matrices in the array A. @@ -175,7 +175,7 @@ *> factored representation is due to the fact that some of the *> singular values of A might underflow or overflow. *> -*> If INFO .GT. 0 : +*> If INFO > 0 : *> the procedure SGESVJ did not converge in the given number of *> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate. *> \endverbatim @@ -183,7 +183,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then the product of Jacobi rotations in SGESVJ +*> If JOBV = 'A', then the product of Jacobi rotations in SGESVJ *> is applied to the first MV rows of V. See the description of JOBV. *> \endverbatim *> @@ -201,16 +201,16 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V, LDV .GE. 1. -*> If JOBV .EQ. 'V', then LDV .GE. max(1,N). -*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) . +*> The leading dimension of the array V, LDV >= 1. +*> If JOBV = 'V', then LDV >= max(1,N). +*> If JOBV = 'A', then LDV >= max(1,MV) . *> \endverbatim *> *> \param[in,out] WORK *> \verbatim *> WORK is REAL array, dimension (LWORK) *> On entry, -*> If JOBU .EQ. 'C' : +*> If JOBU = 'C' : *> WORK(1) = CTOL, where CTOL defines the threshold for convergence. *> The process stops if all columns of A are mutually *> orthogonal up to CTOL*EPS, EPS=SLAMCH('E'). @@ -230,7 +230,7 @@ *> WORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep. *> This is useful information in cases when SGESVJ did *> not converge, as it can be used to estimate whether -*> the output is stil useful and for post festum analysis. +*> the output is still useful and for post festum analysis. *> WORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. @@ -245,9 +245,9 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value -*> > 0 : SGESVJ did not converge in the maximal allowed number (30) +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value +*> > 0: SGESVJ did not converge in the maximal allowed number (30) *> of sweeps. The output may still be useful. See the *> description of WORK. *> \endverbatim diff --git a/lapack-netlib/SRC/sgesvxx.f b/lapack-netlib/SRC/sgesvxx.f index 281f198d5..7cb29d5ab 100644 --- a/lapack-netlib/SRC/sgesvxx.f +++ b/lapack-netlib/SRC/sgesvxx.f @@ -411,7 +411,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -447,14 +447,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -462,9 +462,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/sgetc2.f b/lapack-netlib/SRC/sgetc2.f index b0301b953..6bf0a93c6 100644 --- a/lapack-netlib/SRC/sgetc2.f +++ b/lapack-netlib/SRC/sgetc2.f @@ -85,7 +85,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: if INFO = k, U(k, k) is likely to produce owerflow if +*> > 0: if INFO = k, U(k, k) is likely to produce overflow if *> we try to solve for x in Ax = b. So U is perturbed to *> avoid the overflow. *> \endverbatim diff --git a/lapack-netlib/SRC/sgetsls.f b/lapack-netlib/SRC/sgetsls.f index 35af66c19..53d2f9431 100644 --- a/lapack-netlib/SRC/sgetsls.f +++ b/lapack-netlib/SRC/sgetsls.f @@ -1,3 +1,5 @@ +*> \brief \b SGETSLS +* * Definition: * =========== * @@ -154,7 +156,7 @@ * *> \date June 2017 * -*> \ingroup doubleGEsolve +*> \ingroup realGEsolve * * ===================================================================== SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB, diff --git a/lapack-netlib/SRC/sggesx.f b/lapack-netlib/SRC/sggesx.f index 3c6273dcf..25691d164 100644 --- a/lapack-netlib/SRC/sggesx.f +++ b/lapack-netlib/SRC/sggesx.f @@ -131,10 +131,10 @@ *> \verbatim *> SENSE is CHARACTER*1 *> Determines which reciprocal condition numbers are computed. -*> = 'N' : None are computed; -*> = 'E' : Computed for average of selected eigenvalues only; -*> = 'V' : Computed for selected deflating subspaces only; -*> = 'B' : Computed for both. +*> = 'N': None are computed; +*> = 'E': Computed for average of selected eigenvalues only; +*> = 'V': Computed for selected deflating subspaces only; +*> = 'B': Computed for both. *> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'. *> \endverbatim *> diff --git a/lapack-netlib/SRC/sgsvj0.f b/lapack-netlib/SRC/sgsvj0.f index e580efc30..d9177d818 100644 --- a/lapack-netlib/SRC/sgsvj0.f +++ b/lapack-netlib/SRC/sgsvj0.f @@ -117,7 +117,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -125,9 +125,9 @@ *> \param[in,out] V *> \verbatim *> V is REAL array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -136,8 +136,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -157,7 +157,7 @@ *> TOL is REAL *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -175,14 +175,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: @@ -1045,7 +1045,7 @@ 1993 CONTINUE * end i=1:NSWEEP loop -* #:) Reaching this point means that the procedure has comleted the given +* #:) Reaching this point means that the procedure has completed the given * number of iterations. INFO = NSWEEP - 1 GO TO 1995 diff --git a/lapack-netlib/SRC/sgsvj1.f b/lapack-netlib/SRC/sgsvj1.f index 49b81cf4f..ea4ba2e0e 100644 --- a/lapack-netlib/SRC/sgsvj1.f +++ b/lapack-netlib/SRC/sgsvj1.f @@ -61,7 +61,7 @@ *> In terms of the columns of A, the first N1 columns are rotated 'against' *> the remaining N-N1 columns, trying to increase the angle between the *> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is -*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter. +*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parameter. *> The number of sweeps is given in NSWEEP and the orthogonality threshold *> is given in TOL. *> \endverbatim @@ -147,7 +147,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -155,9 +155,9 @@ *> \param[in,out] V *> \verbatim *> V is REAL array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -166,8 +166,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -187,7 +187,7 @@ *> TOL is REAL *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -205,14 +205,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/shseqr.f b/lapack-netlib/SRC/shseqr.f index 5654a4682..b5707f2c3 100644 --- a/lapack-netlib/SRC/shseqr.f +++ b/lapack-netlib/SRC/shseqr.f @@ -70,7 +70,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -87,7 +87,7 @@ *> set by a previous call to SGEBAL, and then passed to ZGEHRD *> when the matrix output by SGEBAL is reduced to Hessenberg *> form. Otherwise ILO and IHI should be set to 1 and N -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -100,20 +100,20 @@ *> (the Schur form); 2-by-2 diagonal blocks (corresponding to *> complex conjugate pairs of eigenvalues) are returned in *> standard form, with H(i,i) = H(i+1,i+1) and -*> H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and JOB = 'E', the +*> H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and JOB = 'E', the *> contents of H are unspecified on exit. (The output value of -*> H when INFO.GT.0 is given under the description of INFO +*> H when INFO > 0 is given under the description of INFO *> below.) *> *> Unlike earlier versions of SHSEQR, this subroutine may -*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 +*> explicitly H(i,j) = 0 for i > j and j = 1, 2, ... ILO-1 *> or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -128,8 +128,8 @@ *> The real and imaginary parts, respectively, of the computed *> eigenvalues. If two eigenvalues are computed as a complex *> conjugate pair, they are stored in consecutive elements of -*> WR and WI, say the i-th and (i+1)th, with WI(i) .GT. 0 and -*> WI(i+1) .LT. 0. If JOB = 'S', the eigenvalues are stored in +*> WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and +*> WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in *> the same order as on the diagonal of the Schur form returned *> in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 *> diagonal block, WI(i) = sqrt(-H(i+1,i)*H(i,i+1)) and @@ -148,7 +148,7 @@ *> if INFO = 0, Z contains Q*Z. *> Normally Q is the orthogonal matrix generated by SORGHR *> after the call to SGEHRD which formed the Hessenberg matrix -*> H. (The output value of Z when INFO.GT.0 is given under +*> H. (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -156,7 +156,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if COMPZ = 'I' or -*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. +*> COMPZ = 'V', then LDZ >= MAX(1,N). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -169,7 +169,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient and delivers very good and sometimes *> optimal performance. However, LWORK as large as 11*N *> may be required for optimal performance. A workspace @@ -187,21 +187,21 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .LT. 0: if INFO = -i, the i-th argument had an illegal +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal *> value -*> .GT. 0: if INFO = i, SHSEQR failed to compute all of +*> > 0: if INFO = i, SHSEQR failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and JOB = 'E', then on exit, the +*> If INFO > 0 and JOB = 'E', then on exit, the *> remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and JOB = 'S', then on exit +*> If INFO > 0 and JOB = 'S', then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -209,19 +209,19 @@ *> value of H is upper Hessenberg and quasi-triangular *> in rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and COMPZ = 'V', then on exit +*> If INFO > 0 and COMPZ = 'V', then on exit *> *> (final value of Z) = (initial value of Z)*U *> *> where U is the orthogonal matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'I', then on exit +*> If INFO > 0 and COMPZ = 'I', then on exit *> (final value of Z) = U *> where U is the orthogonal matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'N', then Z is not +*> If INFO > 0 and COMPZ = 'N', then Z is not *> accessed. *> \endverbatim * @@ -261,8 +261,8 @@ *> This depends on ILO, IHI and NS. NS is the *> number of simultaneous shifts returned *> by ILAENV(ISPEC=15). (See ISPEC=15 below.) -*> The default for (IHI-ILO+1).LE.500 is NS. -*> The default for (IHI-ILO+1).GT.500 is 3*NS/2. +*> The default for (IHI-ILO+1) <= 500 is NS. +*> The default for (IHI-ILO+1) > 500 is 3*NS/2. *> *> ISPEC=14: Nibble crossover point. (See IPARMQ for *> details.) Default: 14% of deflation window @@ -341,8 +341,8 @@ PARAMETER ( NTINY = 11 ) * * ==== NL allocates some local workspace to help small matrices -* . through a rare SLAHQR failure. NL .GT. NTINY = 11 is -* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- +* . through a rare SLAHQR failure. NL > NTINY = 11 is +* . required and NL <= NMIN = ILAENV(ISPEC=12,...) is recom- * . mended. (The default value of NMIN is 75.) Using NL = 49 * . allows up to six simultaneous shifts and a 16-by-16 * . deflation window. ==== diff --git a/lapack-netlib/SRC/sla_gbrcond.f b/lapack-netlib/SRC/sla_gbrcond.f index 36aa93dc9..7f2c4062e 100644 --- a/lapack-netlib/SRC/sla_gbrcond.f +++ b/lapack-netlib/SRC/sla_gbrcond.f @@ -140,13 +140,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (5*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/sla_gbrfsx_extended.f b/lapack-netlib/SRC/sla_gbrfsx_extended.f index a81feb45e..0fd1fd350 100644 --- a/lapack-netlib/SRC/sla_gbrfsx_extended.f +++ b/lapack-netlib/SRC/sla_gbrfsx_extended.f @@ -65,19 +65,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -269,7 +269,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/sla_gercond.f b/lapack-netlib/SRC/sla_gercond.f index 349a1b5be..e54e0d7b4 100644 --- a/lapack-netlib/SRC/sla_gercond.f +++ b/lapack-netlib/SRC/sla_gercond.f @@ -122,13 +122,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace.2 diff --git a/lapack-netlib/SRC/sla_gerfsx_extended.f b/lapack-netlib/SRC/sla_gerfsx_extended.f index 1795ea975..84d1ae31b 100644 --- a/lapack-netlib/SRC/sla_gerfsx_extended.f +++ b/lapack-netlib/SRC/sla_gerfsx_extended.f @@ -65,19 +65,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -257,7 +257,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERRS_C is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERRS_C is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERRS_C(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/sla_porcond.f b/lapack-netlib/SRC/sla_porcond.f index 9dd7c587b..729581f46 100644 --- a/lapack-netlib/SRC/sla_porcond.f +++ b/lapack-netlib/SRC/sla_porcond.f @@ -112,13 +112,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/sla_porfsx_extended.f b/lapack-netlib/SRC/sla_porfsx_extended.f index 27baa20d1..abbfebb83 100644 --- a/lapack-netlib/SRC/sla_porfsx_extended.f +++ b/lapack-netlib/SRC/sla_porfsx_extended.f @@ -65,11 +65,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -246,7 +246,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/sla_syrcond.f b/lapack-netlib/SRC/sla_syrcond.f index c4b204cc6..0c9e2b361 100644 --- a/lapack-netlib/SRC/sla_syrcond.f +++ b/lapack-netlib/SRC/sla_syrcond.f @@ -118,13 +118,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (3*N). *> Workspace. *> \endverbatim *> -*> \param[in] IWORK +*> \param[out] IWORK *> \verbatim *> IWORK is INTEGER array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/sla_syrfsx_extended.f b/lapack-netlib/SRC/sla_syrfsx_extended.f index f7b909ac0..a83a9db98 100644 --- a/lapack-netlib/SRC/sla_syrfsx_extended.f +++ b/lapack-netlib/SRC/sla_syrfsx_extended.f @@ -67,11 +67,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -255,7 +255,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/sla_syrpvgrw.f b/lapack-netlib/SRC/sla_syrpvgrw.f index f5eb81b1f..a0a235ee3 100644 --- a/lapack-netlib/SRC/sla_syrpvgrw.f +++ b/lapack-netlib/SRC/sla_syrpvgrw.f @@ -101,7 +101,7 @@ *> as determined by SSYTRF. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/sla_wwaddw.f b/lapack-netlib/SRC/sla_wwaddw.f index 96a7d3542..e390c9fab 100644 --- a/lapack-netlib/SRC/sla_wwaddw.f +++ b/lapack-netlib/SRC/sla_wwaddw.f @@ -36,7 +36,7 @@ *> SLA_WWADDW adds a vector W into a doubled-single vector (X, Y). *> *> This works for all extant IBM's hex and binary floating point -*> arithmetics, but not for decimal. +*> arithmetic, but not for decimal. *> \endverbatim * * Arguments: diff --git a/lapack-netlib/SRC/slaed4.f b/lapack-netlib/SRC/slaed4.f index c65cba75a..64260843f 100644 --- a/lapack-netlib/SRC/slaed4.f +++ b/lapack-netlib/SRC/slaed4.f @@ -82,7 +82,7 @@ *> \param[out] DELTA *> \verbatim *> DELTA is REAL array, dimension (N) -*> If N .GT. 2, DELTA contains (D(j) - lambda_I) in its j-th +*> If N > 2, DELTA contains (D(j) - lambda_I) in its j-th *> component. If N = 1, then DELTA(1) = 1. If N = 2, see SLAED5 *> for detail. The vector DELTA contains the information necessary *> to construct the eigenvectors by SLAED3 and SLAED9. diff --git a/lapack-netlib/SRC/slaed8.f b/lapack-netlib/SRC/slaed8.f index 5ec117cb5..2e3f6f51f 100644 --- a/lapack-netlib/SRC/slaed8.f +++ b/lapack-netlib/SRC/slaed8.f @@ -353,7 +353,7 @@ Z( I ) = W( INDX( I ) ) 40 CONTINUE * -* Calculate the allowable deflation tolerence +* Calculate the allowable deflation tolerance * IMAX = ISAMAX( N, Z, 1 ) JMAX = ISAMAX( N, D, 1 ) diff --git a/lapack-netlib/SRC/slagtf.f b/lapack-netlib/SRC/slagtf.f index d3f0b6813..59ef097a7 100644 --- a/lapack-netlib/SRC/slagtf.f +++ b/lapack-netlib/SRC/slagtf.f @@ -125,7 +125,7 @@ *> then IN(k) = 1, otherwise IN(k) = 0. The element IN(n) *> returns the smallest positive integer j such that *> -*> abs( u(j,j) ).le. norm( (T - lambda*I)(j) )*TOL, +*> abs( u(j,j) ) <= norm( (T - lambda*I)(j) )*TOL, *> *> where norm( A(j) ) denotes the sum of the absolute values of *> the jth row of the matrix A. If no such j exists then IN(n) @@ -137,8 +137,8 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> .lt. 0: if INFO = -k, the kth argument had an illegal value +*> = 0: successful exit +*> < 0: if INFO = -k, the kth argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/slagts.f b/lapack-netlib/SRC/slagts.f index 0c3c5239f..e0c8892d7 100644 --- a/lapack-netlib/SRC/slagts.f +++ b/lapack-netlib/SRC/slagts.f @@ -122,12 +122,12 @@ *> \param[in,out] TOL *> \verbatim *> TOL is REAL -*> On entry, with JOB .lt. 0, TOL should be the minimum +*> On entry, with JOB < 0, TOL should be the minimum *> perturbation to be made to very small diagonal elements of U. *> TOL should normally be chosen as about eps*norm(U), where eps *> is the relative machine precision, but if TOL is supplied as *> non-positive, then it is reset to eps*max( abs( u(i,j) ) ). -*> If JOB .gt. 0 then TOL is not referenced. +*> If JOB > 0 then TOL is not referenced. *> *> On exit, TOL is changed as described above, only if TOL is *> non-positive on entry. Otherwise TOL is unchanged. @@ -136,14 +136,14 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> .lt. 0: if INFO = -i, the i-th argument had an illegal value -*> .gt. 0: overflow would occur when computing the INFO(th) -*> element of the solution vector x. This can only occur -*> when JOB is supplied as positive and either means -*> that a diagonal element of U is very small, or that -*> the elements of the right-hand side vector y are very -*> large. +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> > 0: overflow would occur when computing the INFO(th) +*> element of the solution vector x. This can only occur +*> when JOB is supplied as positive and either means +*> that a diagonal element of U is very small, or that +*> the elements of the right-hand side vector y are very +*> large. *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/slahqr.f b/lapack-netlib/SRC/slahqr.f index d91826e61..e5642d2bf 100644 --- a/lapack-netlib/SRC/slahqr.f +++ b/lapack-netlib/SRC/slahqr.f @@ -150,26 +150,26 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: If INFO = i, SLAHQR failed to compute all the +*> = 0: successful exit +*> > 0: If INFO = i, SLAHQR failed to compute all the *> eigenvalues ILO to IHI in a total of 30 iterations *> per eigenvalue; elements i+1:ihi of WR and WI *> contain those eigenvalues which have been *> successfully computed. *> -*> If INFO .GT. 0 and WANTT is .FALSE., then on exit, +*> If INFO > 0 and WANTT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the *> eigenvalues of the upper Hessenberg matrix rows -*> and columns ILO thorugh INFO of the final, output +*> and columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> (*) (initial value of H)*U = U*(final value of H) -*> where U is an orthognal matrix. The final +*> where U is an orthogonal matrix. The final *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> (final value of Z) = (initial value of Z)*U *> where U is the orthogonal matrix in (*) *> (regardless of the value of WANTT.) diff --git a/lapack-netlib/SRC/slaln2.f b/lapack-netlib/SRC/slaln2.f index f9ceee7b7..4c6a55ec7 100644 --- a/lapack-netlib/SRC/slaln2.f +++ b/lapack-netlib/SRC/slaln2.f @@ -49,7 +49,7 @@ *> the first column of each being the real part and the second *> being the imaginary part. *> -*> "s" is a scaling factor (.LE. 1), computed by SLALN2, which is +*> "s" is a scaling factor (<= 1), computed by SLALN2, which is *> so chosen that X can be computed without overflow. X is further *> scaled if necessary to assure that norm(ca A - w D)*norm(X) is less *> than overflow. diff --git a/lapack-netlib/SRC/slamswlq.f b/lapack-netlib/SRC/slamswlq.f index b13d02b6c..59ab1a6ee 100644 --- a/lapack-netlib/SRC/slamswlq.f +++ b/lapack-netlib/SRC/slamswlq.f @@ -1,3 +1,4 @@ +*> \brief \b SLAMSWLQ * * Definition: * =========== diff --git a/lapack-netlib/SRC/slamtsqr.f b/lapack-netlib/SRC/slamtsqr.f index 84ac86ee2..58905ab46 100644 --- a/lapack-netlib/SRC/slamtsqr.f +++ b/lapack-netlib/SRC/slamtsqr.f @@ -1,3 +1,4 @@ +*> \brief \b SLAMTSQR * * Definition: * =========== diff --git a/lapack-netlib/SRC/slangb.f b/lapack-netlib/SRC/slangb.f index fd538b1b7..706e07501 100644 --- a/lapack-netlib/SRC/slangb.f +++ b/lapack-netlib/SRC/slangb.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER KL, KU, LDAB, N @@ -139,22 +140,24 @@ * * ===================================================================== * -* * .. Parameters .. REAL ONE, ZERO PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) * .. * .. Local Scalars .. INTEGER I, J, K, L - REAL SCALE, SUM, VALUE, TEMP + REAL SUM, VALUE, TEMP * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -206,15 +209,22 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANGB = VALUE diff --git a/lapack-netlib/SRC/slange.f b/lapack-netlib/SRC/slange.f index 2eb8d7d14..0c80f1d40 100644 --- a/lapack-netlib/SRC/slange.f +++ b/lapack-netlib/SRC/slange.f @@ -119,6 +119,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, M, N @@ -135,10 +136,13 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE, TEMP + REAL SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Subroutines .. - EXTERNAL SLASSQ + EXTERNAL SLASSQ, SCOMBSSQ * .. * .. External Functions .. LOGICAL LSAME, SISNAN @@ -194,13 +198,19 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANGE = VALUE diff --git a/lapack-netlib/SRC/slanhs.f b/lapack-netlib/SRC/slanhs.f index c5a077fbf..8913031a2 100644 --- a/lapack-netlib/SRC/slanhs.f +++ b/lapack-netlib/SRC/slanhs.f @@ -113,6 +113,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, N @@ -129,15 +130,18 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT * .. @@ -188,13 +192,20 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( N, J+1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANHS = VALUE diff --git a/lapack-netlib/SRC/slansb.f b/lapack-netlib/SRC/slansb.f index 8f3fe1eb9..23519025d 100644 --- a/lapack-netlib/SRC/slansb.f +++ b/lapack-netlib/SRC/slansb.f @@ -134,6 +134,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -150,15 +151,18 @@ * .. * .. Local Scalars .. INTEGER I, J, L - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -225,29 +229,47 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL SLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF - CALL SLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N, AB( L, 1 ), LDAB, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANSB = VALUE diff --git a/lapack-netlib/SRC/slansp.f b/lapack-netlib/SRC/slansp.f index 35390cd1c..7e29d778b 100644 --- a/lapack-netlib/SRC/slansp.f +++ b/lapack-netlib/SRC/slansp.f @@ -119,6 +119,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -135,15 +136,18 @@ * .. * .. Local Scalars .. INTEGER I, J, K - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -217,31 +221,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( AP( K ).NE.ZERO ) THEN ABSA = ABS( AP( K ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -250,7 +271,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANSP = VALUE diff --git a/lapack-netlib/SRC/slansy.f b/lapack-netlib/SRC/slansy.f index c8400e530..66ff1c5c7 100644 --- a/lapack-netlib/SRC/slansy.f +++ b/lapack-netlib/SRC/slansy.f @@ -127,6 +127,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -143,15 +144,18 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL ABSA, SCALE, SUM, VALUE + REAL ABSA, SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -216,21 +220,39 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL SLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL SLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM - CALL SLASSQ( N, A, LDA+1, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANSY = VALUE diff --git a/lapack-netlib/SRC/slantb.f b/lapack-netlib/SRC/slantb.f index 3588779cb..5b94618e1 100644 --- a/lapack-netlib/SRC/slantb.f +++ b/lapack-netlib/SRC/slantb.f @@ -145,6 +145,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER K, LDAB, N @@ -162,15 +163,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, L - REAL SCALE, SUM, VALUE + REAL SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT * .. @@ -311,46 +315,61 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 280 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL SLASSQ( MIN( J-1, K ), - $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, - $ SUM ) + $ AB( MAX( K+2-J, 1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 280 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 290 J = 1, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL SLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 310 J = 1, N - CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANTB = VALUE diff --git a/lapack-netlib/SRC/slantp.f b/lapack-netlib/SRC/slantp.f index 1423f5ca3..ab781deac 100644 --- a/lapack-netlib/SRC/slantp.f +++ b/lapack-netlib/SRC/slantp.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER N @@ -146,15 +147,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, K - REAL SCALE, SUM, VALUE + REAL SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. @@ -306,45 +310,64 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 280 J = 2, N - CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( J-1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 280 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 290 J = 1, N - CALL SLASSQ( J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + J 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 300 J = 1, N - 1 - CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N-J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 300 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 310 J = 1, N - CALL SLASSQ( N-J+1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( N-J+1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANTP = VALUE diff --git a/lapack-netlib/SRC/slantr.f b/lapack-netlib/SRC/slantr.f index 63b855892..04d29f537 100644 --- a/lapack-netlib/SRC/slantr.f +++ b/lapack-netlib/SRC/slantr.f @@ -146,6 +146,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER LDA, M, N @@ -163,15 +164,18 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SUM, VALUE * .. -* .. External Subroutines .. - EXTERNAL SLASSQ +* .. Local Arrays .. + REAL SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, SISNAN EXTERNAL LSAME, SISNAN * .. +* .. External Subroutines .. + EXTERNAL SLASSQ, SCOMBSSQ +* .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT * .. @@ -281,7 +285,7 @@ END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - DO 210 I = 1, N + DO 210 I = 1, MIN( M, N ) WORK( I ) = ONE 210 CONTINUE DO 220 I = N + 1, M @@ -311,38 +315,56 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 290 J = 2, N - CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 300 J = 1, N - CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 310 J = 1, N - CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 320 J = 1, N - CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL SLASSQ( M-J+1, A( J, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL SCOMBSSQ( SSQ, COLSSQ ) 320 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * SLANTR = VALUE diff --git a/lapack-netlib/SRC/slanv2.f b/lapack-netlib/SRC/slanv2.f index e73e5455c..1163446fa 100644 --- a/lapack-netlib/SRC/slanv2.f +++ b/lapack-netlib/SRC/slanv2.f @@ -161,7 +161,6 @@ IF( C.EQ.ZERO ) THEN CS = ONE SN = ZERO - GO TO 10 * ELSE IF( B.EQ.ZERO ) THEN * @@ -174,12 +173,12 @@ A = TEMP B = -C C = ZERO - GO TO 10 +* ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE. $ SIGN( ONE, C ) ) THEN CS = ONE SN = ZERO - GO TO 10 +* ELSE * TEMP = A - D @@ -207,6 +206,7 @@ SN = C / TAU B = B - C C = ZERO +* ELSE * * Complex eigenvalues, or real (almost) equal eigenvalues. @@ -268,8 +268,6 @@ END IF * END IF -* - 10 CONTINUE * * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). * diff --git a/lapack-netlib/SRC/slaorhr_col_getrfnp.f b/lapack-netlib/SRC/slaorhr_col_getrfnp.f new file mode 100644 index 000000000..6cc59e538 --- /dev/null +++ b/lapack-netlib/SRC/slaorhr_col_getrfnp.f @@ -0,0 +1,248 @@ +*> \brief \b SLAORHR_COL_GETRFNP +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SLAORHR_COL_GETRFNP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* REAL A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SLAORHR_COL_GETRFNP computes the modified LU factorization without +*> pivoting of a real general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is +*> at least one in absolute value (so that division-by-zero not +*> not possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine SORHR_COL. In SORHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the blocked right-looking version of the algorithm, +*> calling Level 3 BLAS to update the submatrix. To factorize a block, +*> this routine calls the recursive routine SLAORHR_COL_GETRFNP2. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is REAL array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can +*> be only plus or minus one. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup realGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE SLAORHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + REAL A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE + PARAMETER ( ONE = 1.0E+0 ) +* .. +* .. Local Scalars .. + INTEGER IINFO, J, JB, NB +* .. +* .. External Subroutines .. + EXTERNAL SGEMM, SLAORHR_COL_GETRFNP2, STRSM, XERBLA +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SLAORHR_COL_GETRFNP', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN +* +* Determine the block size for this environment. +* + + NB = ILAENV( 1, 'SLAORHR_COL_GETRFNP', ' ', M, N, -1, -1 ) + + IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN +* +* Use unblocked code. +* + CALL SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + ELSE +* +* Use blocked code. +* + DO J = 1, MIN( M, N ), NB + JB = MIN( MIN( M, N )-J+1, NB ) +* +* Factor diagonal and subdiagonal blocks. +* + CALL SLAORHR_COL_GETRFNP2( M-J+1, JB, A( J, J ), LDA, + $ D( J ), IINFO ) +* + IF( J+JB.LE.N ) THEN +* +* Compute block row of U. +* + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + $ N-J-JB+1, ONE, A( J, J ), LDA, A( J, J+JB ), + $ LDA ) + IF( J+JB.LE.M ) THEN +* +* Update trailing submatrix. +* + CALL SGEMM( 'No transpose', 'No transpose', M-J-JB+1, + $ N-J-JB+1, JB, -ONE, A( J+JB, J ), LDA, + $ A( J, J+JB ), LDA, ONE, A( J+JB, J+JB ), + $ LDA ) + END IF + END IF + END DO + END IF + RETURN +* +* End of SLAORHR_COL_GETRFNP +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/slaorhr_col_getrfnp2.f b/lapack-netlib/SRC/slaorhr_col_getrfnp2.f new file mode 100644 index 000000000..de604602f --- /dev/null +++ b/lapack-netlib/SRC/slaorhr_col_getrfnp2.f @@ -0,0 +1,305 @@ +*> \brief \b SLAORHR_COL_GETRFNP2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DLAORHR_GETRF2NP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* REAL A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SLAORHR_COL_GETRFNP2 computes the modified LU factorization without +*> pivoting of a real general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is at +*> least one in absolute value (so that division-by-zero not +*> possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine SORHR_COL. In SORHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the recursive version of the LU factorization algorithm. +*> Denote A - S by B. The algorithm divides the matrix B into four +*> submatrices: +*> +*> [ B11 | B12 ] where B11 is n1 by n1, +*> B = [ -----|----- ] B21 is (m-n1) by n1, +*> [ B21 | B22 ] B12 is n1 by n2, +*> B22 is (m-n1) by n2, +*> with n1 = min(m,n)/2, n2 = n-n1. +*> +*> +*> The subroutine calls itself to factor B11, solves for B21, +*> solves for B12, updates B22, then calls itself to factor B22. +*> +*> For more details on the recursive LU algorithm, see [2]. +*> +*> SLAORHR_COL_GETRFNP2 is called to factorize a block by the blocked +*> routine SLAORHR_COL_GETRFNP, which uses blocked code calling +*. Level 3 BLAS to update the submatrix. However, SLAORHR_COL_GETRFNP2 +*> is self-sufficient and can be used without SLAORHR_COL_GETRFNP. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> +*> [2] "Recursion leads to automatic variable blocking for dense linear +*> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev., +*> vol. 41, no. 6, pp. 737-755, 1997. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is REAL array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can +*> be only plus or minus one. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup realGEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + RECURSIVE SUBROUTINE SLAORHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + REAL A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE + PARAMETER ( ONE = 1.0E+0 ) +* .. +* .. Local Scalars .. + REAL SFMIN + INTEGER I, IINFO, N1, N2 +* .. +* .. External Functions .. + REAL SLAMCH + EXTERNAL SLAMCH +* .. +* .. External Subroutines .. + EXTERNAL SGEMM, SSCAL, STRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, SIGN, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SLAORHR_COL_GETRFNP2', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN + + IF ( M.EQ.1 ) THEN +* +* One row case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = -SIGN( ONE, A( 1, 1 ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* + ELSE IF( N.EQ.1 ) THEN +* +* One column case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = -SIGN( ONE, A( 1, 1 ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* +* Scale the elements 2:M of the column +* +* Determine machine safe minimum +* + SFMIN = SLAMCH('S') +* +* Construct the subdiagonal elements of L +* + IF( ABS( A( 1, 1 ) ) .GE. SFMIN ) THEN + CALL SSCAL( M-1, ONE / A( 1, 1 ), A( 2, 1 ), 1 ) + ELSE + DO I = 2, M + A( I, 1 ) = A( I, 1 ) / A( 1, 1 ) + END DO + END IF +* + ELSE +* +* Divide the matrix B into four submatrices +* + N1 = MIN( M, N ) / 2 + N2 = N-N1 + +* +* Factor B11, recursive call +* + CALL SLAORHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO ) +* +* Solve for B21 +* + CALL STRSM( 'R', 'U', 'N', 'N', M-N1, N1, ONE, A, LDA, + $ A( N1+1, 1 ), LDA ) +* +* Solve for B12 +* + CALL STRSM( 'L', 'L', 'N', 'U', N1, N2, ONE, A, LDA, + $ A( 1, N1+1 ), LDA ) +* +* Update B22, i.e. compute the Schur complement +* B22 := B22 - B21*B12 +* + CALL SGEMM( 'N', 'N', M-N1, N2, N1, -ONE, A( N1+1, 1 ), LDA, + $ A( 1, N1+1 ), LDA, ONE, A( N1+1, N1+1 ), LDA ) +* +* Factor B22, recursive call +* + CALL SLAORHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA, + $ D( N1+1 ), IINFO ) +* + END IF + RETURN +* +* End of SLAORHR_COL_GETRFNP2 +* + END diff --git a/lapack-netlib/SRC/slaqps.f b/lapack-netlib/SRC/slaqps.f index 9c62ec8b6..3f8af304f 100644 --- a/lapack-netlib/SRC/slaqps.f +++ b/lapack-netlib/SRC/slaqps.f @@ -127,7 +127,7 @@ *> \param[in,out] AUXV *> \verbatim *> AUXV is REAL array, dimension (NB) -*> Auxiliar vector. +*> Auxiliary vector. *> \endverbatim *> *> \param[in,out] F diff --git a/lapack-netlib/SRC/slaqr0.f b/lapack-netlib/SRC/slaqr0.f index 1dcd3d176..318b46943 100644 --- a/lapack-netlib/SRC/slaqr0.f +++ b/lapack-netlib/SRC/slaqr0.f @@ -67,7 +67,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -79,12 +79,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to SGEBAL, and then passed to SGEHRD when the *> matrix output by SGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -97,19 +97,19 @@ *> decomposition (the Schur form); 2-by-2 diagonal blocks *> (corresponding to complex conjugate pairs of eigenvalues) *> are returned in standard form, with H(i,i) = H(i+1,i+1) -*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is +*> and H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and WANTT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -125,7 +125,7 @@ *> and WI(ILO:IHI). If two eigenvalues are computed as a *> complex conjugate pair, they are stored in consecutive *> elements of WR and WI, say the i-th and (i+1)th, with -*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then +*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., then *> the eigenvalues are stored in the same order as on the *> diagonal of the Schur form returned in H, with *> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal @@ -143,7 +143,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -153,7 +153,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -161,7 +161,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -174,7 +174,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -190,19 +190,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, SLAQR0 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, SLAQR0 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -210,7 +210,7 @@ *> value of H is upper Hessenberg and quasi-triangular *> in rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -218,7 +218,7 @@ *> where U is the orthogonal matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -677,7 +677,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/slaqr1.f b/lapack-netlib/SRC/slaqr1.f index 2de33849d..6bb88c794 100644 --- a/lapack-netlib/SRC/slaqr1.f +++ b/lapack-netlib/SRC/slaqr1.f @@ -69,7 +69,7 @@ *> \verbatim *> LDH is INTEGER *> The leading dimension of H as declared in -*> the calling procedure. LDH.GE.N +*> the calling procedure. LDH >= N *> \endverbatim *> *> \param[in] SR1 diff --git a/lapack-netlib/SRC/slaqr2.f b/lapack-netlib/SRC/slaqr2.f index 8e1f34910..f4f8ca7f2 100644 --- a/lapack-netlib/SRC/slaqr2.f +++ b/lapack-netlib/SRC/slaqr2.f @@ -103,7 +103,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -121,7 +121,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -133,7 +133,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -149,7 +149,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -194,13 +194,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -212,14 +212,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -231,7 +231,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/slaqr3.f b/lapack-netlib/SRC/slaqr3.f index 534e2c489..ccad338b9 100644 --- a/lapack-netlib/SRC/slaqr3.f +++ b/lapack-netlib/SRC/slaqr3.f @@ -100,7 +100,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -118,7 +118,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -130,7 +130,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -146,7 +146,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -191,13 +191,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -209,14 +209,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -228,7 +228,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/slaqr4.f b/lapack-netlib/SRC/slaqr4.f index 12b6b2fb1..cd642e07f 100644 --- a/lapack-netlib/SRC/slaqr4.f +++ b/lapack-netlib/SRC/slaqr4.f @@ -74,7 +74,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -86,12 +86,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to SGEBAL, and then passed to SGEHRD when the *> matrix output by SGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -104,19 +104,19 @@ *> decomposition (the Schur form); 2-by-2 diagonal blocks *> (corresponding to complex conjugate pairs of eigenvalues) *> are returned in standard form, with H(i,i) = H(i+1,i+1) -*> and H(i+1,i)*H(i,i+1).LT.0. If INFO = 0 and WANTT is +*> and H(i+1,i)*H(i,i+1) < 0. If INFO = 0 and WANTT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] WR @@ -132,7 +132,7 @@ *> and WI(ILO:IHI). If two eigenvalues are computed as a *> complex conjugate pair, they are stored in consecutive *> elements of WR and WI, say the i-th and (i+1)th, with -*> WI(i) .GT. 0 and WI(i+1) .LT. 0. If WANTT is .TRUE., then +*> WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., then *> the eigenvalues are stored in the same order as on the *> diagonal of the Schur form returned in H, with *> WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal @@ -150,7 +150,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -160,7 +160,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -168,7 +168,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -181,7 +181,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -199,19 +199,19 @@ *> INFO is INTEGER *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, SLAQR4 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, SLAQR4 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -219,7 +219,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -227,7 +227,7 @@ *> where U is the orthogonal matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -680,7 +680,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/slaqr5.f b/lapack-netlib/SRC/slaqr5.f index 65278e355..f04ee577e 100644 --- a/lapack-netlib/SRC/slaqr5.f +++ b/lapack-netlib/SRC/slaqr5.f @@ -133,7 +133,7 @@ *> \verbatim *> LDH is INTEGER *> LDH is the leading dimension of H just as declared in the -*> calling procedure. LDH.GE.MAX(1,N). +*> calling procedure. LDH >= MAX(1,N). *> \endverbatim *> *> \param[in] ILOZ @@ -145,7 +145,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N *> \endverbatim *> *> \param[in,out] Z @@ -161,7 +161,7 @@ *> \verbatim *> LDZ is INTEGER *> LDA is the leading dimension of Z just as declared in -*> the calling procedure. LDZ.GE.N. +*> the calling procedure. LDZ >= N. *> \endverbatim *> *> \param[out] V @@ -173,7 +173,7 @@ *> \verbatim *> LDV is INTEGER *> LDV is the leading dimension of V as declared in the -*> calling procedure. LDV.GE.3. +*> calling procedure. LDV >= 3. *> \endverbatim *> *> \param[out] U @@ -185,33 +185,14 @@ *> \verbatim *> LDU is INTEGER *> LDU is the leading dimension of U just as declared in the -*> in the calling subroutine. LDU.GE.3*NSHFTS-3. -*> \endverbatim -*> -*> \param[in] NH -*> \verbatim -*> NH is INTEGER -*> NH is the number of columns in array WH available for -*> workspace. NH.GE.1. -*> \endverbatim -*> -*> \param[out] WH -*> \verbatim -*> WH is REAL array, dimension (LDWH,NH) -*> \endverbatim -*> -*> \param[in] LDWH -*> \verbatim -*> LDWH is INTEGER -*> Leading dimension of WH just as declared in the -*> calling procedure. LDWH.GE.3*NSHFTS-3. +*> in the calling subroutine. LDU >= 3*NSHFTS-3. *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> NV is the number of rows in WV agailable for workspace. -*> NV.GE.1. +*> NV >= 1. *> \endverbatim *> *> \param[out] WV @@ -223,9 +204,28 @@ *> \verbatim *> LDWV is INTEGER *> LDWV is the leading dimension of WV as declared in the -*> in the calling subroutine. LDWV.GE.NV. +*> in the calling subroutine. LDWV >= NV. *> \endverbatim * +*> \param[in] NH +*> \verbatim +*> NH is INTEGER +*> NH is the number of columns in array WH available for +*> workspace. NH >= 1. +*> \endverbatim +*> +*> \param[out] WH +*> \verbatim +*> WH is REAL array, dimension (LDWH,NH) +*> \endverbatim +*> +*> \param[in] LDWH +*> \verbatim +*> LDWH is INTEGER +*> Leading dimension of WH just as declared in the +*> calling procedure. LDWH >= 3*NSHFTS-3. +*> \endverbatim +*> * Authors: * ======== * diff --git a/lapack-netlib/SRC/slarfb.f b/lapack-netlib/SRC/slarfb.f index c51f69534..d853a54ec 100644 --- a/lapack-netlib/SRC/slarfb.f +++ b/lapack-netlib/SRC/slarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V diff --git a/lapack-netlib/SRC/slarfx.f b/lapack-netlib/SRC/slarfx.f index 590e99e70..3175068b8 100644 --- a/lapack-netlib/SRC/slarfx.f +++ b/lapack-netlib/SRC/slarfx.f @@ -94,7 +94,7 @@ *> \param[in] LDC *> \verbatim *> LDC is INTEGER -*> The leading dimension of the array C. LDA >= (1,M). +*> The leading dimension of the array C. LDC >= (1,M). *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/slarfy.f b/lapack-netlib/SRC/slarfy.f index 340c54413..f9ba011a2 100644 --- a/lapack-netlib/SRC/slarfy.f +++ b/lapack-netlib/SRC/slarfy.f @@ -103,7 +103,7 @@ * *> \date December 2016 * -*> \ingroup single_eig +*> \ingroup realOTHERauxiliary * * ===================================================================== SUBROUTINE SLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK ) diff --git a/lapack-netlib/SRC/slarrb.f b/lapack-netlib/SRC/slarrb.f index 988e25ff0..ac9d7bc8c 100644 --- a/lapack-netlib/SRC/slarrb.f +++ b/lapack-netlib/SRC/slarrb.f @@ -91,7 +91,7 @@ *> RTOL2 is REAL *> Tolerance for the convergence of the bisection intervals. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> where GAP is the (estimated) distance to the nearest *> eigenvalue. *> \endverbatim @@ -117,7 +117,7 @@ *> WGAP is REAL array, dimension (N-1) *> On input, the (estimated) gaps between consecutive *> eigenvalues of L D L^T, i.e., WGAP(I-OFFSET) is the gap between -*> eigenvalues I and I+1. Note that if IFIRST.EQ.ILAST +*> eigenvalues I and I+1. Note that if IFIRST = ILAST *> then WGAP(IFIRST-OFFSET) must be set to ZERO. *> On output, these gaps are refined. *> \endverbatim diff --git a/lapack-netlib/SRC/slarre.f b/lapack-netlib/SRC/slarre.f index ea9b8fcbc..6636235d0 100644 --- a/lapack-netlib/SRC/slarre.f +++ b/lapack-netlib/SRC/slarre.f @@ -150,7 +150,7 @@ *> RTOL2 is REAL *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in] SPLTOL diff --git a/lapack-netlib/SRC/slarrj.f b/lapack-netlib/SRC/slarrj.f index a721d0751..fb867595c 100644 --- a/lapack-netlib/SRC/slarrj.f +++ b/lapack-netlib/SRC/slarrj.f @@ -85,7 +85,7 @@ *> RTOL is REAL *> Tolerance for the convergence of the bisection intervals. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.RTOL*MAX(|LEFT|,|RIGHT|). +*> RIGHT-LEFT < RTOL*MAX(|LEFT|,|RIGHT|). *> \endverbatim *> *> \param[in] OFFSET diff --git a/lapack-netlib/SRC/slarrv.f b/lapack-netlib/SRC/slarrv.f index f9e3cf2b9..04519fde8 100644 --- a/lapack-netlib/SRC/slarrv.f +++ b/lapack-netlib/SRC/slarrv.f @@ -149,7 +149,7 @@ *> RTOL2 is REAL *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in,out] W diff --git a/lapack-netlib/SRC/slasd7.f b/lapack-netlib/SRC/slasd7.f index 2adaa5ee7..d8775b6c6 100644 --- a/lapack-netlib/SRC/slasd7.f +++ b/lapack-netlib/SRC/slasd7.f @@ -400,7 +400,7 @@ VL( I ) = VLW( IDXI ) 50 CONTINUE * -* Calculate the allowable deflation tolerence +* Calculate the allowable deflation tolerance * EPS = SLAMCH( 'Epsilon' ) TOL = MAX( ABS( ALPHA ), ABS( BETA ) ) diff --git a/lapack-netlib/SRC/slassq.f b/lapack-netlib/SRC/slassq.f index 35b40f07f..d9930a597 100644 --- a/lapack-netlib/SRC/slassq.f +++ b/lapack-netlib/SRC/slassq.f @@ -60,7 +60,7 @@ *> *> \param[in] X *> \verbatim -*> X is REAL array, dimension (N) +*> X is REAL array, dimension (1+(N-1)*INCX) *> The vector for which a scaled sum of squares is computed. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. *> \endverbatim diff --git a/lapack-netlib/SRC/slaswlq.f b/lapack-netlib/SRC/slaswlq.f index 27b5b8067..5eb9cc5f9 100644 --- a/lapack-netlib/SRC/slaswlq.f +++ b/lapack-netlib/SRC/slaswlq.f @@ -1,3 +1,4 @@ +*> \brief \b SLASWLQ * * Definition: * =========== @@ -18,9 +19,20 @@ *> *> \verbatim *> -*> SLASWLQ computes a blocked Short-Wide LQ factorization of a -*> M-by-N matrix A, where N >= M: -*> A = L * Q +*> SLASWLQ computes a blocked Tall-Skinny LQ factorization of +*> a real M-by-N matrix A for M <= N: +*> +*> A = ( L 0 ) * Q, +*> +*> where: +*> +*> Q is a n-by-N orthogonal matrix, stored on exit in an implicit +*> form in the elements above the digonal of the array A and in +*> the elemenst of the array T; +*> L is an lower-triangular M-by-M matrix stored on exit in +*> the elements on and below the diagonal of the array A. +*> 0 is a M-by-(N-M) zero matrix, if M < N, and is not stored. +*> *> \endverbatim * * Arguments: @@ -150,10 +162,10 @@ SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * -* -- LAPACK computational routine (version 3.8.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* November 2017 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, MB, NB, LWORK, LDT diff --git a/lapack-netlib/SRC/slasyf_aa.f b/lapack-netlib/SRC/slasyf_aa.f index ed4ef6291..76f632602 100644 --- a/lapack-netlib/SRC/slasyf_aa.f +++ b/lapack-netlib/SRC/slasyf_aa.f @@ -284,8 +284,9 @@ * * Swap A(I1, I2+1:M) with A(I2, I2+1:M) * - CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -325,13 +326,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL SCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL SSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL SCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL SSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -432,8 +435,9 @@ * * Swap A(I2+1:M, I1) with A(I2+1:M, I2) * - CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -473,13 +477,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL SCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL SSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL SCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL SSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/slasyf_rk.f b/lapack-netlib/SRC/slasyf_rk.f index b1b37177f..c16708365 100644 --- a/lapack-netlib/SRC/slasyf_rk.f +++ b/lapack-netlib/SRC/slasyf_rk.f @@ -321,7 +321,7 @@ * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = ZERO @@ -649,7 +649,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = ZERO * diff --git a/lapack-netlib/SRC/slatdf.f b/lapack-netlib/SRC/slatdf.f index 5496f9db4..495d32502 100644 --- a/lapack-netlib/SRC/slatdf.f +++ b/lapack-netlib/SRC/slatdf.f @@ -85,7 +85,7 @@ *> RHS is REAL array, dimension N. *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with -*> entries acoording to the value of IJOB (see above). +*> entries according to the value of IJOB (see above). *> \endverbatim *> *> \param[in,out] RDSUM @@ -260,7 +260,7 @@ * * Solve for U-part, look-ahead for RHS(N) = +-1. This is not done * in BSOLVE and will hopefully give us a better estimate because -* any ill-conditioning of the original matrix is transfered to U +* any ill-conditioning of the original matrix is transferred to U * and not to L. U(N, N) is an approximation to sigma_min(LU). * CALL SCOPY( N-1, RHS, 1, XP, 1 ) diff --git a/lapack-netlib/SRC/slatsqr.f b/lapack-netlib/SRC/slatsqr.f index d6d682799..b56b0d41e 100644 --- a/lapack-netlib/SRC/slatsqr.f +++ b/lapack-netlib/SRC/slatsqr.f @@ -1,3 +1,4 @@ +*> \brief \b SLATSQR * * Definition: * =========== @@ -19,8 +20,22 @@ *> \verbatim *> *> SLATSQR computes a blocked Tall-Skinny QR factorization of -*> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> a real M-by-N matrix A for M >= N: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix, stored on exit in an implicit +*> form in the elements below the digonal of the array A and in +*> the elemenst of the array T; +*> +*> R is an upper-triangular N-by-N matrix, stored on exit in +*> the elements on and above the diagonal of the array A. +*> +*> 0 is a (M-N)-by-N zero matrix, and is not stored. +*> *> \endverbatim * * Arguments: @@ -149,10 +164,10 @@ SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK diff --git a/lapack-netlib/SRC/sorgtsqr.f b/lapack-netlib/SRC/sorgtsqr.f new file mode 100644 index 000000000..748760d63 --- /dev/null +++ b/lapack-netlib/SRC/sorgtsqr.f @@ -0,0 +1,306 @@ +*> \brief \b SORGTSQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SORGTSQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE SORGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, +* $ INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. +* REAL A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SORGTSQR generates an M-by-N real matrix Q_out with orthonormal columns, +*> which are the first N columns of a product of real orthogonal +*> matrices of order M which are returned by SLATSQR +*> +*> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). +*> +*> See the documentation for SLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] MB +*> \verbatim +*> MB is INTEGER +*> The row block size used by SLATSQR to return +*> arrays A and T. MB > N. +*> (Note that if MB > M, then M is used instead of MB +*> as the row block size). +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size used by SLATSQR to return +*> arrays A and T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size). +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array, dimension (LDA,N) +*> +*> On entry: +*> +*> The elements on and above the diagonal are not accessed. +*> The elements below the diagonal represent the unit +*> lower-trapezoidal blocked matrix V computed by SLATSQR +*> that defines the input matrices Q_in(k) (ones on the +*> diagonal are not stored) (same format as the output A +*> below the diagonal in SLATSQR). +*> +*> On exit: +*> +*> The array A contains an M-by-N orthonormal matrix Q_out, +*> i.e the columns of A are orthogonal unit vectors. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is REAL array, +*> dimension (LDT, N * NIRB) +*> where NIRB = Number_of_input_row_blocks +*> = MAX( 1, CEIL((M-N)/(MB-N)) ) +*> Let NICB = Number_of_input_col_blocks +*> = CEIL(N/NB) +*> +*> The upper-triangular block reflectors used to define the +*> input matrices Q_in(k), k=(1:NIRB*NICB). The block +*> reflectors are stored in compact form in NIRB block +*> reflector sequences. Each of NIRB block reflector sequences +*> is stored in a larger NB-by-N column block of T and consists +*> of NICB smaller NB-by-NB upper-triangular column blocks. +*> (same format as the output T in SLATSQR). +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB1,N)). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> (workspace) REAL array, dimension (MAX(2,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> The dimension of the array WORK. LWORK >= (M+NB)*N. +*> If LWORK = -1, then a workspace query is assumed. +*> The routine only calculates the optimal size of the WORK +*> array, returns this value as the first entry of the WORK +*> array, and no error message related to LWORK is issued +*> by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup singleOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE SORGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + $ INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. + REAL A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE, ZERO + PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J +* .. +* .. External Subroutines .. + EXTERNAL SCOPY, SLAMTSQR, SLASET, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC REAL, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + LQUERY = LWORK.EQ.-1 + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. M.LT.N ) THEN + INFO = -2 + ELSE IF( MB.LE.N ) THEN + INFO = -3 + ELSE IF( NB.LT.1 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -6 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -8 + ELSE +* +* Test the input LWORK for the dimension of the array WORK. +* This workspace is used to store array C(LDC, N) and WORK(LWORK) +* in the call to DLAMTSQR. See the documentation for DLAMTSQR. +* + IF( LWORK.LT.2 .AND. (.NOT.LQUERY) ) THEN + INFO = -10 + ELSE +* +* Set block size for column blocks +* + NBLOCAL = MIN( NB, N ) +* +* LWORK = -1, then set the size for the array C(LDC,N) +* in DLAMTSQR call and set the optimal size of the work array +* WORK(LWORK) in DLAMTSQR call. +* + LDC = M + LC = LDC*N + LW = N * NBLOCAL +* + LWORKOPT = LC+LW +* + IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + INFO = -10 + END IF + END IF +* + END IF +* +* Handle error in the input parameters and return workspace query. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SORGTSQR', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN + WORK( 1 ) = REAL( LWORKOPT ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + WORK( 1 ) = REAL( LWORKOPT ) + RETURN + END IF +* +* (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in +* of M-by-M orthogonal matrix Q_in, which is implicitly stored in +* the subdiagonal part of input array A and in the input array T. +* Perform by the following operation using the routine DLAMTSQR. +* +* Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix, +* ( 0 ) 0 is a (M-N)-by-N zero matrix. +* +* (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones +* on the diagonal and zeros elsewhere. +* + CALL SLASET( 'F', M, N, ZERO, ONE, WORK, LDC ) +* +* (1b) On input, WORK(1:LDC*N) stores ( I ); +* ( 0 ) +* +* On output, WORK(1:LDC*N) stores Q1_in. +* + CALL SLAMTSQR( 'L', 'N', M, N, N, MB, NBLOCAL, A, LDA, T, LDT, + $ WORK, LDC, WORK( LC+1 ), LW, IINFO ) +* +* (2) Copy the result from the part of the work array (1:M,1:N) +* with the leading dimension LDC that starts at WORK(1) into +* the output array A(1:M,1:N) column-by-column. +* + DO J = 1, N + CALL SCOPY( M, WORK( (J-1)*LDC + 1 ), 1, A( 1, J ), 1 ) + END DO +* + WORK( 1 ) = REAL( LWORKOPT ) + RETURN +* +* End of SORGTSQR +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/sorhr_col.f b/lapack-netlib/SRC/sorhr_col.f new file mode 100644 index 000000000..38976245c --- /dev/null +++ b/lapack-netlib/SRC/sorhr_col.f @@ -0,0 +1,439 @@ +*> \brief \b SORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download SORHR_COL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE SORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. +* REAL A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SORHR_COL takes an M-by-N real matrix Q_in with orthonormal columns +*> as input, stored in A, and performs Householder Reconstruction (HR), +*> i.e. reconstructs Householder vectors V(i) implicitly representing +*> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, +*> where S is an N-by-N diagonal matrix with diagonal entries +*> equal to +1 or -1. The Householder vectors (columns V(i) of V) are +*> stored in A on output, and the diagonal entries of S are stored in D. +*> Block reflectors are also returned in T +*> (same output format as SGEQRT). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size to be used in the reconstruction +*> of Householder column vector blocks in the array A and +*> corresponding block reflectors in the array T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size.) +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is REAL array, dimension (LDA,N) +*> +*> On entry: +*> +*> The array A contains an M-by-N orthonormal matrix Q_in, +*> i.e the columns of A are orthogonal unit vectors. +*> +*> On exit: +*> +*> The elements below the diagonal of A represent the unit +*> lower-trapezoidal matrix V of Householder column vectors +*> V(i). The unit diagonal entries of V are not stored +*> (same format as the output below the diagonal in A from +*> SGEQRT). The matrix T and the matrix V stored on output +*> in A implicitly define Q_out. +*> +*> The elements above the diagonal contain the factor U +*> of the "modified" LU-decomposition: +*> Q_in - ( S ) = V * U +*> ( 0 ) +*> where 0 is a (M-N)-by-(M-N) zero matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is REAL array, +*> dimension (LDT, N) +*> +*> Let NOCB = Number_of_output_col_blocks +*> = CEIL(N/NB) +*> +*> On exit, T(1:NB, 1:N) contains NOCB upper-triangular +*> block reflectors used to define Q_out stored in compact +*> form as a sequence of upper-triangular NB-by-NB column +*> blocks (same format as the output T in SGEQRT). +*> The matrix T and the matrix V stored on output in A +*> implicitly define Q_out. NOTE: The lower triangles +*> below the upper-triangular blcoks will be filled with +*> zeros. See Further Details. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB,N)). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is REAL array, dimension min(M,N). +*> The elements can be only plus or minus one. +*> +*> D(i) is constructed as D(i) = -SIGN(Q_in_i(i,i)), where +*> 1 <= i <= min(M,N), and Q_in_i is Q_in after performing +*> i-1 steps of “modified” Gaussian elimination. +*> See Further Details. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The computed M-by-M orthogonal factor Q_out is defined implicitly as +*> a product of orthogonal matrices Q_out(i). Each Q_out(i) is stored in +*> the compact WY-representation format in the corresponding blocks of +*> matrices V (stored in A) and T. +*> +*> The M-by-N unit lower-trapezoidal matrix V stored in the M-by-N +*> matrix A contains the column vectors V(i) in NB-size column +*> blocks VB(j). For example, VB(1) contains the columns +*> V(1), V(2), ... V(NB). NOTE: The unit entries on +*> the diagonal of Y are not stored in A. +*> +*> The number of column blocks is +*> +*> NOCB = Number_of_output_col_blocks = CEIL(N/NB) +*> +*> where each block is of order NB except for the last block, which +*> is of order LAST_NB = N - (NOCB-1)*NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix V is +*> +*> +*> V = ( VB(1), VB(2), VB(3) ) = +*> +*> = ( 1 ) +*> ( v21 1 ) +*> ( v31 v32 1 ) +*> ( v41 v42 v43 1 ) +*> ( v51 v52 v53 v54 1 ) +*> ( v61 v62 v63 v54 v65 ) +*> +*> +*> For each of the column blocks VB(i), an upper-triangular block +*> reflector TB(i) is computed. These blocks are stored as +*> a sequence of upper-triangular column blocks in the NB-by-N +*> matrix T. The size of each TB(i) block is NB-by-NB, except +*> for the last block, whose size is LAST_NB-by-LAST_NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix T is +*> +*> T = ( TB(1), TB(2), TB(3) ) = +*> +*> = ( t11 t12 t13 t14 t15 ) +*> ( t22 t24 ) +*> +*> +*> The M-by-M factor Q_out is given as a product of NOCB +*> orthogonal M-by-M matrices Q_out(i). +*> +*> Q_out = Q_out(1) * Q_out(2) * ... * Q_out(NOCB), +*> +*> where each matrix Q_out(i) is given by the WY-representation +*> using corresponding blocks from the matrices V and T: +*> +*> Q_out(i) = I - VB(i) * TB(i) * (VB(i))**T, +*> +*> where I is the identity matrix. Here is the formula with matrix +*> dimensions: +*> +*> Q(i){M-by-M} = I{M-by-M} - +*> VB(i){M-by-INB} * TB(i){INB-by-INB} * (VB(i))**T {INB-by-M}, +*> +*> where INB = NB, except for the last block NOCB +*> for which INB=LAST_NB. +*> +*> ===== +*> NOTE: +*> ===== +*> +*> If Q_in is the result of doing a QR factorization +*> B = Q_in * R_in, then: +*> +*> B = (Q_out*S) * R_in = Q_out * (S * R_in) = O_out * R_out. +*> +*> So if one wants to interpret Q_out as the result +*> of the QR factorization of B, then corresponding R_out +*> should be obtained by R_out = S * R_in, i.e. some rows of R_in +*> should be multiplied by -1. +*> +*> For the details of the algorithm, see [1]. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup singleOTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE SORHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. + REAL A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ONE, ZERO + PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) +* .. +* .. Local Scalars .. + INTEGER I, IINFO, J, JB, JBTEMP1, JBTEMP2, JNB, + $ NPLUSONE +* .. +* .. External Subroutines .. + EXTERNAL SCOPY, SLAORHR_COL_GETRFNP, SSCAL, STRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( NB.LT.1 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -7 + END IF +* +* Handle error in the input parameters. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'SORHR_COL', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + RETURN + END IF +* +* On input, the M-by-N matrix A contains the orthogonal +* M-by-N matrix Q_in. +* +* (1) Compute the unit lower-trapezoidal V (ones on the diagonal +* are not stored) by performing the "modified" LU-decomposition. +* +* Q_in - ( S ) = V * U = ( V1 ) * U, +* ( 0 ) ( V2 ) +* +* where 0 is an (M-N)-by-N zero matrix. +* +* (1-1) Factor V1 and U. + + CALL SLAORHR_COL_GETRFNP( N, N, A, LDA, D, IINFO ) +* +* (1-2) Solve for V2. +* + IF( M.GT.N ) THEN + CALL STRSM( 'R', 'U', 'N', 'N', M-N, N, ONE, A, LDA, + $ A( N+1, 1 ), LDA ) + END IF +* +* (2) Reconstruct the block reflector T stored in T(1:NB, 1:N) +* as a sequence of upper-triangular blocks with NB-size column +* blocking. +* +* Loop over the column blocks of size NB of the array A(1:M,1:N) +* and the array T(1:NB,1:N), JB is the column index of a column +* block, JNB is the column block size at each step JB. +* + NPLUSONE = N + 1 + DO JB = 1, N, NB +* +* (2-0) Determine the column block size JNB. +* + JNB = MIN( NPLUSONE-JB, NB ) +* +* (2-1) Copy the upper-triangular part of the current JNB-by-JNB +* diagonal block U(JB) (of the N-by-N matrix U) stored +* in A(JB:JB+JNB-1,JB:JB+JNB-1) into the upper-triangular part +* of the current JNB-by-JNB block T(1:JNB,JB:JB+JNB-1) +* column-by-column, total JNB*(JNB+1)/2 elements. +* + JBTEMP1 = JB - 1 + DO J = JB, JB+JNB-1 + CALL SCOPY( J-JBTEMP1, A( JB, J ), 1, T( 1, J ), 1 ) + END DO +* +* (2-2) Perform on the upper-triangular part of the current +* JNB-by-JNB diagonal block U(JB) (of the N-by-N matrix U) stored +* in T(1:JNB,JB:JB+JNB-1) the following operation in place: +* (-1)*U(JB)*S(JB), i.e the result will be stored in the upper- +* triangular part of T(1:JNB,JB:JB+JNB-1). This multiplication +* of the JNB-by-JNB diagonal block U(JB) by the JNB-by-JNB +* diagonal block S(JB) of the N-by-N sign matrix S from the +* right means changing the sign of each J-th column of the block +* U(JB) according to the sign of the diagonal element of the block +* S(JB), i.e. S(J,J) that is stored in the array element D(J). +* + DO J = JB, JB+JNB-1 + IF( D( J ).EQ.ONE ) THEN + CALL SSCAL( J-JBTEMP1, -ONE, T( 1, J ), 1 ) + END IF + END DO +* +* (2-3) Perform the triangular solve for the current block +* matrix X(JB): +* +* X(JB) * (A(JB)**T) = B(JB), where: +* +* A(JB)**T is a JNB-by-JNB unit upper-triangular +* coefficient block, and A(JB)=V1(JB), which +* is a JNB-by-JNB unit lower-triangular block +* stored in A(JB:JB+JNB-1,JB:JB+JNB-1). +* The N-by-N matrix V1 is the upper part +* of the M-by-N lower-trapezoidal matrix V +* stored in A(1:M,1:N); +* +* B(JB) is a JNB-by-JNB upper-triangular right-hand +* side block, B(JB) = (-1)*U(JB)*S(JB), and +* B(JB) is stored in T(1:JNB,JB:JB+JNB-1); +* +* X(JB) is a JNB-by-JNB upper-triangular solution +* block, X(JB) is the upper-triangular block +* reflector T(JB), and X(JB) is stored +* in T(1:JNB,JB:JB+JNB-1). +* +* In other words, we perform the triangular solve for the +* upper-triangular block T(JB): +* +* T(JB) * (V1(JB)**T) = (-1)*U(JB)*S(JB). +* +* Even though the blocks X(JB) and B(JB) are upper- +* triangular, the routine STRSM will access all JNB**2 +* elements of the square T(1:JNB,JB:JB+JNB-1). Therefore, +* we need to set to zero the elements of the block +* T(1:JNB,JB:JB+JNB-1) below the diagonal before the call +* to STRSM. +* +* (2-3a) Set the elements to zero. +* + JBTEMP2 = JB - 2 + DO J = JB, JB+JNB-2 + DO I = J-JBTEMP2, NB + T( I, J ) = ZERO + END DO + END DO +* +* (2-3b) Perform the triangular solve. +* + CALL STRSM( 'R', 'L', 'T', 'U', JNB, JNB, ONE, + $ A( JB, JB ), LDA, T( 1, JB ), LDT ) +* + END DO +* + RETURN +* +* End of SORHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/sporfsx.f b/lapack-netlib/SRC/sporfsx.f index 52fab6976..ce8c26569 100644 --- a/lapack-netlib/SRC/sporfsx.f +++ b/lapack-netlib/SRC/sporfsx.f @@ -135,7 +135,7 @@ *> \param[in,out] S *> \verbatim *> S is REAL array, dimension (N) -*> The row scale factors for A. If EQUED = 'Y', A is multiplied on +*> The scale factors for A. If EQUED = 'Y', A is multiplied on *> the left and right by diag(S). S is an input argument if FACT = *> 'F'; otherwise, S is an output argument. If FACT = 'F' and EQUED *> = 'Y', each element of S must be positive. If S is output, each @@ -263,7 +263,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -299,14 +299,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -314,9 +314,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/sposvxx.f b/lapack-netlib/SRC/sposvxx.f index 3cdfa749c..fa2c0d3f3 100644 --- a/lapack-netlib/SRC/sposvxx.f +++ b/lapack-netlib/SRC/sposvxx.f @@ -366,7 +366,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -402,14 +402,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -417,9 +417,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/ssb2st_kernels.f b/lapack-netlib/SRC/ssb2st_kernels.f index 54479f89e..08859169b 100644 --- a/lapack-netlib/SRC/ssb2st_kernels.f +++ b/lapack-netlib/SRC/ssb2st_kernels.f @@ -1,26 +1,26 @@ *> \brief \b SSB2ST_KERNELS * * @generated from zhb2st_kernels.f, fortran z -> s, Wed Dec 7 08:22:40 2016 -* +* * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download SSB2ST_KERNELS + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download SSB2ST_KERNELS + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, +* SUBROUTINE SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, * ST, ED, SWEEP, N, NB, IB, * A, LDA, V, TAU, LDVT, WORK) * @@ -32,9 +32,9 @@ * INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. -* REAL A( LDA, * ), V( * ), +* REAL A( LDA, * ), V( * ), * TAU( * ), WORK( * ) -* +* *> \par Purpose: * ============= *> @@ -124,7 +124,7 @@ *> LDVT is INTEGER. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is REAL array. Workspace of size nb. *> \endverbatim @@ -150,7 +150,7 @@ *> http://doi.acm.org/10.1145/2063384.2063394 *> *> A. Haidar, J. Kurzak, P. Luszczek, 2013. -*> An improved parallel singular value algorithm and its implementation +*> An improved parallel singular value algorithm and its implementation *> for multicore hardware, In Proceedings of 2013 International Conference *> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> Denver, Colorado, USA, 2013. @@ -158,16 +158,16 @@ *> http://doi.acm.org/10.1145/2503210.2503292 *> *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. -*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure +*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> calculations based on fine-grained memory aware tasks. *> International Journal of High Performance Computing Applications. *> Volume 28 Issue 2, Pages 196-209, May 2014. -*> http://hpc.sagepub.com/content/28/2/196 +*> http://hpc.sagepub.com/content/28/2/196 *> *> \endverbatim *> * ===================================================================== - SUBROUTINE SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, + SUBROUTINE SSB2ST_KERNELS( UPLO, WANTZ, TTYPE, $ ST, ED, SWEEP, N, NB, IB, $ A, LDA, V, TAU, LDVT, WORK) * @@ -184,7 +184,7 @@ INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. - REAL A( LDA, * ), V( * ), + REAL A( LDA, * ), V( * ), $ TAU( * ), WORK( * ) * .. * @@ -198,8 +198,8 @@ * .. Local Scalars .. LOGICAL UPPER INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS, - $ DPOS, OFDPOS, AJETER - REAL CTMP + $ DPOS, OFDPOS, AJETER + REAL CTMP * .. * .. External Subroutines .. EXTERNAL SLARFG, SLARFX, SLARFY @@ -212,7 +212,7 @@ * .. * .. * .. Executable Statements .. -* +* AJETER = IB + LDVT UPPER = LSAME( UPLO, 'U' ) @@ -243,10 +243,10 @@ V( VPOS ) = ONE DO 10 I = 1, LM-1 V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO + A( OFDPOS-I, ST+I ) = ZERO 10 CONTINUE CTMP = ( A( OFDPOS, ST ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) A( OFDPOS, ST ) = CTMP * @@ -284,14 +284,14 @@ * V( VPOS ) = ONE DO 30 I = 1, LM-1 - V( VPOS+I ) = + V( VPOS+I ) = $ ( A( DPOS-NB-I, J1+I ) ) A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = ( A( DPOS-NB, J1 ) ) CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP -* +* CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), $ TAU( TAUPOS ), $ A( DPOS-NB+1, J1 ), LDA-1, WORK) @@ -299,9 +299,9 @@ ENDIF * * Lower case -* +* ELSE -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -316,9 +316,9 @@ V( VPOS ) = ONE DO 20 I = 1, LM-1 V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO + A( OFDPOS+I, ST-1 ) = ZERO 20 CONTINUE - CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * LM = ED - ST + 1 @@ -345,7 +345,7 @@ LM = J2-J1+1 * IF( LM.GT.0) THEN - CALL SLARFX( 'Right', LM, LN, V( VPOS ), + CALL SLARFX( 'Right', LM, LN, V( VPOS ), $ TAU( TAUPOS ), A( DPOS+NB, ST ), $ LDA-1, WORK) * @@ -362,13 +362,13 @@ V( VPOS+I ) = A( DPOS+NB+I, ST ) A( DPOS+NB+I, ST ) = ZERO 40 CONTINUE - CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * - CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), + CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), $ ( TAU( TAUPOS ) ), $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) - + ENDIF ENDIF ENDIF @@ -377,4 +377,4 @@ * * END OF SSB2ST_KERNELS * - END + END diff --git a/lapack-netlib/SRC/ssbgvx.f b/lapack-netlib/SRC/ssbgvx.f index 3408810bd..22f96729e 100644 --- a/lapack-netlib/SRC/ssbgvx.f +++ b/lapack-netlib/SRC/ssbgvx.f @@ -261,11 +261,11 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit -*> < 0 : if INFO = -i, the i-th argument had an illegal value +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value *> <= N: if INFO = i, then i eigenvectors failed to converge. *> Their indices are stored in IFAIL. -*> > N : SPBSTF returned an error code; i.e., +*> > N: SPBSTF returned an error code; i.e., *> if INFO = N + i, for 1 <= i <= N, then the leading *> minor of order i of B is not positive definite. *> The factorization of B could not be completed and diff --git a/lapack-netlib/SRC/sstemr.f b/lapack-netlib/SRC/sstemr.f index 228538161..d550f87e0 100644 --- a/lapack-netlib/SRC/sstemr.f +++ b/lapack-netlib/SRC/sstemr.f @@ -233,13 +233,13 @@ *> \param[in,out] TRYRAC *> \verbatim *> TRYRAC is LOGICAL -*> If TRYRAC.EQ..TRUE., indicates that the code should check whether +*> If TRYRAC = .TRUE., indicates that the code should check whether *> the tridiagonal matrix defines its eigenvalues to high relative *> accuracy. If so, the code uses relative-accuracy preserving *> algorithms that might be (a bit) slower depending on the matrix. *> If the matrix does not define its eigenvalues to high relative *> accuracy, the code can uses possibly faster algorithms. -*> If TRYRAC.EQ..FALSE., the code is not required to guarantee +*> If TRYRAC = .FALSE., the code is not required to guarantee *> relatively accurate eigenvalues and can use the fastest possible *> techniques. *> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix diff --git a/lapack-netlib/SRC/ssyconvf.f b/lapack-netlib/SRC/ssyconvf.f index d43b9473f..c6f08428f 100644 --- a/lapack-netlib/SRC/ssyconvf.f +++ b/lapack-netlib/SRC/ssyconvf.f @@ -291,7 +291,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -344,7 +344,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -435,7 +435,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where k increases from 1 to N * I = 1 @@ -488,7 +488,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/ssyconvf_rook.f b/lapack-netlib/SRC/ssyconvf_rook.f index 833b9c632..a7e0d5258 100644 --- a/lapack-netlib/SRC/ssyconvf_rook.f +++ b/lapack-netlib/SRC/ssyconvf_rook.f @@ -282,7 +282,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -333,7 +333,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -423,7 +423,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where i increases from 1 to N * I = 1 @@ -474,7 +474,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/ssyev_2stage.f b/lapack-netlib/SRC/ssyev_2stage.f index 166766919..5d354c1b3 100644 --- a/lapack-netlib/SRC/ssyev_2stage.f +++ b/lapack-netlib/SRC/ssyev_2stage.f @@ -317,7 +317,7 @@ IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE -* Not available in this release, and agrument checking should not +* Not available in this release, and argument checking should not * let it getting here RETURN CALL SORGTR( UPLO, N, A, LDA, WORK( INDTAU ), WORK( INDWRK ), diff --git a/lapack-netlib/SRC/ssyevd_2stage.f b/lapack-netlib/SRC/ssyevd_2stage.f index 8ab90b641..625713b85 100644 --- a/lapack-netlib/SRC/ssyevd_2stage.f +++ b/lapack-netlib/SRC/ssyevd_2stage.f @@ -385,7 +385,7 @@ IF( .NOT.WANTZ ) THEN CALL SSTERF( N, W, WORK( INDE ), INFO ) ELSE -* Not available in this release, and agrument checking should not +* Not available in this release, and argument checking should not * let it getting here RETURN CALL SSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N, diff --git a/lapack-netlib/SRC/ssyrfsx.f b/lapack-netlib/SRC/ssyrfsx.f index b5dd0b2df..bfb7b6005 100644 --- a/lapack-netlib/SRC/ssyrfsx.f +++ b/lapack-netlib/SRC/ssyrfsx.f @@ -271,7 +271,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -307,14 +307,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -322,9 +322,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/ssysv_aa.f b/lapack-netlib/SRC/ssysv_aa.f index e470f5883..7e58d1e75 100644 --- a/lapack-netlib/SRC/ssysv_aa.f +++ b/lapack-netlib/SRC/ssysv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric tridiagonal. The factored @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**T or A = L*T*L**T as computed by +*> factorization A = U**T*T*U or A = L*T*L**T as computed by *> SSYTRF. *> \endverbatim *> @@ -229,7 +229,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL SSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/ssysv_aa_2stage.f b/lapack-netlib/SRC/ssysv_aa_2stage.f index 43d937141..5e2e0e340 100644 --- a/lapack-netlib/SRC/ssysv_aa_2stage.f +++ b/lapack-netlib/SRC/ssysv_aa_2stage.f @@ -44,7 +44,7 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric and band. The matrix T is @@ -258,7 +258,7 @@ END IF * * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL SSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/ssysvxx.f b/lapack-netlib/SRC/ssysvxx.f index 4762748c0..e2be0128b 100644 --- a/lapack-netlib/SRC/ssysvxx.f +++ b/lapack-netlib/SRC/ssysvxx.f @@ -377,7 +377,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -413,14 +413,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is REAL array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -428,9 +428,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/ssytf2_rk.f b/lapack-netlib/SRC/ssytf2_rk.f index bf113d1bd..400e48353 100644 --- a/lapack-netlib/SRC/ssytf2_rk.f +++ b/lapack-netlib/SRC/ssytf2_rk.f @@ -312,7 +312,7 @@ * * Factorize A as U*D*U**T using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = ZERO @@ -623,7 +623,7 @@ * * Factorize A as L*D*L**T using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = ZERO * diff --git a/lapack-netlib/SRC/ssytrd_2stage.f b/lapack-netlib/SRC/ssytrd_2stage.f index 7ddc0224e..d2502f483 100644 --- a/lapack-netlib/SRC/ssytrd_2stage.f +++ b/lapack-netlib/SRC/ssytrd_2stage.f @@ -123,23 +123,22 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is REAL array, dimension LHOUS2, that -*> store the Householder representation of the stage2 +*> HOUS2 is REAL array, dimension (LHOUS2) +*> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim *> *> \param[in] LHOUS2 *> \verbatim *> LHOUS2 is INTEGER -*> The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array HOUS2. +*> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns *> this value as the first entry of the HOUS2 array, and no error *> message related to LHOUS2 is issued by XERBLA. -*> LHOUS2 = MAX(1, dimension) where -*> dimension = 4*N if VECT='N' -*> not available now if VECT='H' +*> If VECT='N', LHOUS2 = max(1, 4*n); +*> if VECT='V', option not yet available. *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/ssytrd_sb2st.F b/lapack-netlib/SRC/ssytrd_sb2st.F index 0df1173e4..1d8c9f5c5 100644 --- a/lapack-netlib/SRC/ssytrd_sb2st.F +++ b/lapack-netlib/SRC/ssytrd_sb2st.F @@ -50,9 +50,9 @@ * Arguments: * ========== * -*> \param[in] STAGE +*> \param[in] STAGE1 *> \verbatim -*> STAGE is CHARACTER*1 +*> STAGE1 is CHARACTER*1 *> = 'N': "No": to mention that the stage 1 of the reduction *> from dense to band using the ssytrd_sy2sb routine *> was not called before this routine to reproduce AB. diff --git a/lapack-netlib/SRC/ssytrd_sy2sb.f b/lapack-netlib/SRC/ssytrd_sy2sb.f index 272876700..98169dc00 100644 --- a/lapack-netlib/SRC/ssytrd_sy2sb.f +++ b/lapack-netlib/SRC/ssytrd_sy2sb.f @@ -363,7 +363,7 @@ * * * Set the workspace of the triangular matrix T to zero once such a -* way everytime T is generated the upper/lower portion will be always zero +* way every time T is generated the upper/lower portion will be always zero * CALL SLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT ) * diff --git a/lapack-netlib/SRC/ssytrf.f b/lapack-netlib/SRC/ssytrf.f index 2c29475df..ae4550f28 100644 --- a/lapack-netlib/SRC/ssytrf.f +++ b/lapack-netlib/SRC/ssytrf.f @@ -39,7 +39,7 @@ *> the Bunch-Kaufman diagonal pivoting method. The form of the *> factorization is *> -*> A = U*D*U**T or A = L*D*L**T +*> A = U**T*D*U or A = L*D*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and D is symmetric and block diagonal with @@ -144,7 +144,7 @@ *> *> \verbatim *> -*> If UPLO = 'U', then A = U*D*U**T, where +*> If UPLO = 'U', then A = U**T*D*U, where *> U = P(n)*U(n)* ... *P(k)U(k)* ..., *> i.e., U is a product of terms P(k)*U(k), where k decreases from n to *> 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 @@ -262,7 +262,7 @@ * IF( UPPER ) THEN * -* Factorize A as U*D*U**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * * K is the main loop index, decreasing from N to 1 in steps of * KB, where KB is the number of columns factorized by SLASYF; diff --git a/lapack-netlib/SRC/ssytrf_aa.f b/lapack-netlib/SRC/ssytrf_aa.f index 4aaa978ad..7f428561c 100644 --- a/lapack-netlib/SRC/ssytrf_aa.f +++ b/lapack-netlib/SRC/ssytrf_aa.f @@ -37,7 +37,7 @@ *> SSYTRF_AA computes the factorization of a real symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a symmetric tridiagonal matrix. @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * * Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -375,7 +375,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/ssytrf_aa_2stage.f b/lapack-netlib/SRC/ssytrf_aa_2stage.f index 0e0f6edb7..03690815b 100644 --- a/lapack-netlib/SRC/ssytrf_aa_2stage.f +++ b/lapack-netlib/SRC/ssytrf_aa_2stage.f @@ -38,7 +38,7 @@ *> SSYTRF_AA_2STAGE computes the factorization of a real symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a symmetric band matrix with the @@ -275,7 +275,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -442,12 +442,14 @@ c END IF * > Apply pivots to previous columns of L CALL SSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL SSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) + $ CALL SSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL SSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL SSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -616,11 +618,13 @@ c END IF CALL SSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) * > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL SSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) + IF( I2.GT.(I1+1) ) + $ CALL SSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL SSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL SSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/ssytri2.f b/lapack-netlib/SRC/ssytri2.f index 4b9ea4e7b..897116c23 100644 --- a/lapack-netlib/SRC/ssytri2.f +++ b/lapack-netlib/SRC/ssytri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is REAL array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by SSYTRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by SSYTRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/ssytrs_aa.f b/lapack-netlib/SRC/ssytrs_aa.f index b05c9f7e6..ed4377ae7 100644 --- a/lapack-netlib/SRC/ssytrs_aa.f +++ b/lapack-netlib/SRC/ssytrs_aa.f @@ -37,7 +37,7 @@ *> \verbatim *> *> SSYTRS_AA solves a system of linear equations A*X = B with a real -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by SSYTRF_AA. *> \endverbatim * @@ -49,7 +49,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -97,14 +97,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -198,24 +200,31 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. +* +* 1) Forward substitution with U**T +* + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* Pivot, P**T * B + K = 1 + DO WHILE ( K.LE.N ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K + 1 + END DO * - K = 1 - DO WHILE ( K.LE.N ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K + 1 - END DO +* Compute U**T \ B -> B [ (U**T \P**T * B) ] * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] + CALL STRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL STRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute T \ B -> B [ T \ (U**T \P**T * B) ] * CALL SLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN @@ -224,41 +233,53 @@ END IF CALL SGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) +* +* 3) Backward substitution with U +* + IF( N.GT.1 ) THEN * * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - CALL STRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B(2, 1), LDB) + CALL STRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B(2, 1), LDB) * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] * - K = N - DO WHILE ( K.GE.1 ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K - 1 - END DO + K = N + DO WHILE ( K.GE.1 ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K - 1 + END DO + END IF * ELSE * * Solve A*X = B, where A = L*T*L**T. * -* Pivot, P**T * B +* 1) Forward substitution with L * - K = 1 - DO WHILE ( K.LE.N ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K + 1 - END DO + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B +* + K = 1 + DO WHILE ( K.LE.N ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K + 1 + END DO * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute L \ B -> B [ (L \P**T * B) ] +* + CALL STRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), + $ LDA, B(2, 1), LDB) + END IF * - CALL STRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, - $ B(2, 1), LDB) +* 2) Solve with triangular matrix T * * Compute T \ B -> B [ T \ (L \P**T * B) ] * @@ -270,20 +291,25 @@ CALL SGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**T * - CALL STRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) + IF( N.GT.1 ) THEN +* +* Compute L**T \ B -> B [ L**T \ (T \ (L \P**T * B) ) ] * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] + CALL STRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) * - K = N - DO WHILE ( K.GE.1 ) - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - K = K - 1 - END DO +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* + K = N + DO WHILE ( K.GE.1 ) + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL SSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + K = K - 1 + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/ssytrs_aa_2stage.f b/lapack-netlib/SRC/ssytrs_aa_2stage.f index d271b9481..cf2da529d 100644 --- a/lapack-netlib/SRC/ssytrs_aa_2stage.f +++ b/lapack-netlib/SRC/ssytrs_aa_2stage.f @@ -36,7 +36,7 @@ *> \verbatim *> *> SSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a real -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by SSYTRF_AA_2STAGE. *> \endverbatim * @@ -48,7 +48,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -208,15 +208,15 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * CALL STRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) @@ -234,7 +234,7 @@ CALL STRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] * CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * @@ -246,11 +246,11 @@ * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute (L \ B) -> B [ (L \P**T * B) ] * CALL STRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) @@ -268,7 +268,7 @@ CALL STRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] * CALL SLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * diff --git a/lapack-netlib/SRC/stgsy2.f b/lapack-netlib/SRC/stgsy2.f index ca9946a7e..2814889fc 100644 --- a/lapack-netlib/SRC/stgsy2.f +++ b/lapack-netlib/SRC/stgsy2.f @@ -71,7 +71,7 @@ *> R * B**T + L * E**T = scale * -F *> *> This case is used to compute an estimate of Dif[(A, D), (B, E)] = -*> sigma_min(Z) using reverse communicaton with SLACON. +*> sigma_min(Z) using reverse communication with SLACON. *> *> STGSY2 also (IJOB >= 1) contributes to the computation in STGSYL *> of an upper bound on the separation between to matrix pairs. Then @@ -85,7 +85,7 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). +*> = 'N': solve the generalized Sylvester equation (1). *> = 'T': solve the 'transposed' system (3). *> \endverbatim *> diff --git a/lapack-netlib/SRC/stgsyl.f b/lapack-netlib/SRC/stgsyl.f index cd597f37d..ff634b1de 100644 --- a/lapack-netlib/SRC/stgsyl.f +++ b/lapack-netlib/SRC/stgsyl.f @@ -88,20 +88,20 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). -*> = 'T', solve the 'transposed' system (3). +*> = 'N': solve the generalized Sylvester equation (1). +*> = 'T': solve the 'transposed' system (3). *> \endverbatim *> *> \param[in] IJOB *> \verbatim *> IJOB is INTEGER *> Specifies what kind of functionality to be performed. -*> =0: solve (1) only. -*> =1: The functionality of 0 and 3. -*> =2: The functionality of 0 and 4. -*> =3: Only an estimate of Dif[(A,D), (B,E)] is computed. +*> = 0: solve (1) only. +*> = 1: The functionality of 0 and 3. +*> = 2: The functionality of 0 and 4. +*> = 3: Only an estimate of Dif[(A,D), (B,E)] is computed. *> (look ahead strategy IJOB = 1 is used). -*> =4: Only an estimate of Dif[(A,D), (B,E)] is computed. +*> = 4: Only an estimate of Dif[(A,D), (B,E)] is computed. *> ( SGECON on sub-systems is used ). *> Not referenced if TRANS = 'T'. *> \endverbatim diff --git a/lapack-netlib/SRC/stpmlqt.f b/lapack-netlib/SRC/stpmlqt.f index 565dadd0c..8fc7823c2 100644 --- a/lapack-netlib/SRC/stpmlqt.f +++ b/lapack-netlib/SRC/stpmlqt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is REAL array, dimension (LDA,K) +*> V is REAL array, dimension (LDV,K) *> The i-th row must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DTPLQT in B. See Further Details. diff --git a/lapack-netlib/SRC/stpmqrt.f b/lapack-netlib/SRC/stpmqrt.f index b1813b7dd..6a5cbb981 100644 --- a/lapack-netlib/SRC/stpmqrt.f +++ b/lapack-netlib/SRC/stpmqrt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is REAL array, dimension (LDA,K) +*> V is REAL array, dimension (LDV,K) *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> CTPQRT in B. See Further Details. diff --git a/lapack-netlib/SRC/stprfb.f b/lapack-netlib/SRC/stprfb.f index 66e67252f..fcd164183 100644 --- a/lapack-netlib/SRC/stprfb.f +++ b/lapack-netlib/SRC/stprfb.f @@ -152,8 +152,8 @@ *> \verbatim *> LDA is INTEGER *> The leading dimension of the array A. -*> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'L', LDA >= max(1,K); +*> If SIDE = 'R', LDA >= max(1,M). *> \endverbatim *> *> \param[in,out] B diff --git a/lapack-netlib/SRC/zcgesv.f b/lapack-netlib/SRC/zcgesv.f index bb12d4f3a..b71018638 100644 --- a/lapack-netlib/SRC/zcgesv.f +++ b/lapack-netlib/SRC/zcgesv.f @@ -93,9 +93,9 @@ *> dimension (LDA,N) *> On entry, the N-by-N coefficient matrix A. *> On exit, if iterative refinement has been successfully used -*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is +*> (INFO = 0 and ITER >= 0, see description below), then A is *> unchanged, if double precision factorization has been used -*> (INFO.EQ.0 and ITER.LT.0, see description below), then the +*> (INFO = 0 and ITER < 0, see description below), then the *> array A contains the factors L and U from the factorization *> A = P*L*U; the unit diagonal elements of L are not stored. *> \endverbatim @@ -112,8 +112,8 @@ *> The pivot indices that define the permutation matrix P; *> row i of the matrix was interchanged with row IPIV(i). *> Corresponds either to the single precision factorization -*> (if INFO.EQ.0 and ITER.GE.0) or the double precision -*> factorization (if INFO.EQ.0 and ITER.LT.0). +*> (if INFO = 0 and ITER >= 0) or the double precision +*> factorization (if INFO = 0 and ITER < 0). *> \endverbatim *> *> \param[in] B @@ -421,7 +421,7 @@ 30 CONTINUE * * If we are at this place of the code, this is because we have -* performed ITER=ITERMAX iterations and never satisified the stopping +* performed ITER=ITERMAX iterations and never satisfied the stopping * criterion, set up the ITER flag accordingly and follow up on double * precision routine. * diff --git a/lapack-netlib/SRC/zcposv.f b/lapack-netlib/SRC/zcposv.f index eafcce623..101d25f5d 100644 --- a/lapack-netlib/SRC/zcposv.f +++ b/lapack-netlib/SRC/zcposv.f @@ -111,9 +111,9 @@ *> elements need not be set and are assumed to be zero. *> *> On exit, if iterative refinement has been successfully used -*> (INFO.EQ.0 and ITER.GE.0, see description below), then A is +*> (INFO = 0 and ITER >= 0, see description below), then A is *> unchanged, if double precision factorization has been used -*> (INFO.EQ.0 and ITER.LT.0, see description below), then the +*> (INFO = 0 and ITER < 0, see description below), then the *> array A contains the factor U or L from the Cholesky *> factorization A = U**H*U or A = L*L**H. *> \endverbatim @@ -431,7 +431,7 @@ 30 CONTINUE * * If we are at this place of the code, this is because we have -* performed ITER=ITERMAX iterations and never satisified the +* performed ITER=ITERMAX iterations and never satisfied the * stopping criterion, set up the ITER flag accordingly and follow * up on double precision routine. * diff --git a/lapack-netlib/SRC/zgbrfsx.f b/lapack-netlib/SRC/zgbrfsx.f index e40d7d23e..872709899 100644 --- a/lapack-netlib/SRC/zgbrfsx.f +++ b/lapack-netlib/SRC/zgbrfsx.f @@ -75,7 +75,7 @@ *> Specifies the form of the system of equations: *> = 'N': A * X = B (No transpose) *> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose = Transpose) +*> = 'C': A**H * X = B (Conjugate transpose) *> \endverbatim *> *> \param[in] EQUED @@ -308,7 +308,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -344,14 +344,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -359,9 +359,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/zgbsvxx.f b/lapack-netlib/SRC/zgbsvxx.f index 9ba9c2ee3..0d916fd62 100644 --- a/lapack-netlib/SRC/zgbsvxx.f +++ b/lapack-netlib/SRC/zgbsvxx.f @@ -431,7 +431,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -467,14 +467,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -482,9 +482,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/zgebak.f b/lapack-netlib/SRC/zgebak.f index a9761fde2..70c265e05 100644 --- a/lapack-netlib/SRC/zgebak.f +++ b/lapack-netlib/SRC/zgebak.f @@ -48,10 +48,10 @@ *> \verbatim *> JOB is CHARACTER*1 *> Specifies the type of backward transformation required: -*> = 'N', do nothing, return immediately; -*> = 'P', do backward transformation for permutation only; -*> = 'S', do backward transformation for scaling only; -*> = 'B', do backward transformations for both permutation and +*> = 'N': do nothing, return immediately; +*> = 'P': do backward transformation for permutation only; +*> = 'S': do backward transformation for scaling only; +*> = 'B': do backward transformations for both permutation and *> scaling. *> JOB must be the same as the argument JOB supplied to ZGEBAL. *> \endverbatim diff --git a/lapack-netlib/SRC/zgeev.f b/lapack-netlib/SRC/zgeev.f index 22b04469f..1ba542587 100644 --- a/lapack-netlib/SRC/zgeev.f +++ b/lapack-netlib/SRC/zgeev.f @@ -157,7 +157,7 @@ *> < 0: if INFO = -i, the i-th argument had an illegal value. *> > 0: if INFO = i, the QR algorithm failed to compute all the *> eigenvalues, and no eigenvectors have been computed; -*> elements and i+1:N of W contain eigenvalues which have +*> elements i+1:N of W contain eigenvalues which have *> converged. *> \endverbatim * diff --git a/lapack-netlib/SRC/zgejsv.f b/lapack-netlib/SRC/zgejsv.f index d553da90b..91a20416e 100644 --- a/lapack-netlib/SRC/zgejsv.f +++ b/lapack-netlib/SRC/zgejsv.f @@ -80,13 +80,13 @@ *> desirable, then this option is advisable. The input matrix A *> is preprocessed with QR factorization with FULL (row and *> column) pivoting. -*> = 'G' Computation as with 'F' with an additional estimate of the +*> = 'G': Computation as with 'F' with an additional estimate of the *> condition number of B, where A=B*D. If A has heavily weighted *> rows, then using this condition number gives too pessimistic *> error bound. *> = 'A': Small singular values are not well determined by the data *> and are considered as noisy; the matrix is treated as -*> numerically rank defficient. The error in the computed +*> numerically rank deficient. The error in the computed *> singular values is bounded by f(m,n)*epsilon*||A||. *> The computed SVD A = U * S * V^* restores A up to *> f(m,n)*epsilon*||A||. @@ -117,7 +117,7 @@ *> = 'V': N columns of V are returned in the array V; Jacobi rotations *> are not explicitly accumulated. *> = 'J': N columns of V are returned in the array V, but they are -*> computed as the product of Jacobi rotations, if JOBT .EQ. 'N'. +*> computed as the product of Jacobi rotations, if JOBT = 'N'. *> = 'W': V may be used as workspace of length N*N. See the description *> of V. *> = 'N': V is not computed. @@ -131,7 +131,7 @@ *> specified range. If A .NE. 0 is scaled so that the largest singular *> value of c*A is around SQRT(BIG), BIG=DLAMCH('O'), then JOBR issues *> the licence to kill columns of A whose norm in c*A is less than -*> SQRT(SFMIN) (for JOBR.EQ.'R'), or less than SMALL=SFMIN/EPSLN, +*> SQRT(SFMIN) (for JOBR = 'R'), or less than SMALL=SFMIN/EPSLN, *> where SFMIN=DLAMCH('S'), EPSLN=DLAMCH('E'). *> = 'N': Do not kill small columns of c*A. This option assumes that *> BLAS and QR factorizations and triangular solvers are @@ -229,7 +229,7 @@ *> If JOBU = 'F', then U contains on exit the M-by-M matrix of *> the left singular vectors, including an ONB *> of the orthogonal complement of the Range(A). -*> If JOBU = 'W' .AND. (JOBV.EQ.'V' .AND. JOBT.EQ.'T' .AND. M.EQ.N), +*> If JOBU = 'W' .AND. (JOBV = 'V' .AND. JOBT = 'T' .AND. M = N), *> then U is used as workspace if the procedure *> replaces A with A^*. In that case, [V] is computed *> in U as left singular vectors of A^* and then @@ -251,7 +251,7 @@ *> V is COMPLEX*16 array, dimension ( LDV, N ) *> If JOBV = 'V', 'J' then V contains on exit the N-by-N matrix of *> the right singular vectors; -*> If JOBV = 'W', AND (JOBU.EQ.'U' AND JOBT.EQ.'T' AND M.EQ.N), +*> If JOBV = 'W', AND (JOBU = 'U' AND JOBT = 'T' AND M = N), *> then V is used as workspace if the pprocedure *> replaces A with A^*. In that case, [U] is computed *> in V as right singular vectors of A^* and then @@ -282,7 +282,7 @@ *> Length of CWORK to confirm proper allocation of workspace. *> LWORK depends on the job: *> -*> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and +*> 1. If only SIGMA is needed ( JOBU = 'N', JOBV = 'N' ) and *> 1.1 .. no scaled condition estimate required (JOBA.NE.'E'.AND.JOBA.NE.'G'): *> LWORK >= 2*N+1. This is the minimal requirement. *> ->> For optimal performance (blocked code) the optimal value @@ -298,9 +298,9 @@ *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), LWORK(ZGESVJ), *> N*N+LWORK(ZPOCON)). -*> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), -*> (JOBU.EQ.'N') -*> 2.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): +*> 2. If SIGMA and the right singular vectors are needed (JOBV = 'V'), +*> (JOBU = 'N') +*> 2.1 .. no scaled condition estimate requested (JOBE = 'N'): *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, *> LWORK >= max(N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, @@ -318,10 +318,10 @@ *> LWORK >= max(N+LWORK(ZGEQP3), LWORK(ZPOCON), N+LWORK(ZGESVJ), *> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMLQ)). *> 3. If SIGMA and the left singular vectors are needed -*> 3.1 .. no scaled condition estimate requested (JOBE.EQ.'N'): +*> 3.1 .. no scaled condition estimate requested (JOBE = 'N'): *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, +*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, *> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(ZGEQP3), 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). @@ -329,15 +329,15 @@ *> required (JOBA='E', or 'G'). *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance: -*> if JOBU.EQ.'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, +*> if JOBU = 'U' :: LWORK >= max(3*N, N+(N+1)*NB, 2*N+N*NB)=2*N+N*NB, *> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZUNMQR. *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZPOCON), *> 2*N+LWORK(ZGEQRF), N+LWORK(ZUNMQR)). -*> 4. If the full SVD is needed: (JOBU.EQ.'U' or JOBU.EQ.'F') and -*> 4.1. if JOBV.EQ.'V' +*> 4. If the full SVD is needed: (JOBU = 'U' or JOBU = 'F') and +*> 4.1. if JOBV = 'V' *> the minimal requirement is LWORK >= 5*N+2*N*N. -*> 4.2. if JOBV.EQ.'J' the minimal requirement is +*> 4.2. if JOBV = 'J' the minimal requirement is *> LWORK >= 4*N+N*N. *> In both cases, the allocated CWORK can accommodate blocked runs *> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, ZUNMLQ. @@ -356,7 +356,7 @@ *> of A. (See the description of SVA().) *> RWORK(2) = See the description of RWORK(1). *> RWORK(3) = SCONDA is an estimate for the condition number of -*> column equilibrated A. (If JOBA .EQ. 'E' or 'G') +*> column equilibrated A. (If JOBA = 'E' or 'G') *> SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1). *> It is computed using SPOCON. It holds *> N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA @@ -375,7 +375,7 @@ *> triangular factor in the first QR factorization. *> RWORK(5) = an estimate of the scaled condition number of the *> triangular factor in the second QR factorization. -*> The following two parameters are computed if JOBT .EQ. 'T'. +*> The following two parameters are computed if JOBT = 'T'. *> They are provided for a developer/implementer who is familiar *> with the details of the method. *> RWORK(6) = the entropy of A^* * A :: this is the Shannon entropy @@ -456,23 +456,23 @@ *> of JOBA and JOBR. *> IWORK(2) = the number of the computed nonzero singular values *> IWORK(3) = if nonzero, a warning message: -*> If IWORK(3).EQ.1 then some of the column norms of A +*> If IWORK(3) = 1 then some of the column norms of A *> were denormalized floats. The requested high accuracy *> is not warranted by the data. -*> IWORK(4) = 1 or -1. If IWORK(4) .EQ. 1, then the procedure used A^* to +*> IWORK(4) = 1 or -1. If IWORK(4) = 1, then the procedure used A^* to *> do the job as specified by the JOB parameters. -*> If the call to ZGEJSV is a workspace query (indicated by LWORK .EQ. -1 or -*> LRWORK .EQ. -1), then on exit IWORK(1) contains the required length of +*> If the call to ZGEJSV is a workspace query (indicated by LWORK = -1 or +*> LRWORK = -1), then on exit IWORK(1) contains the required length of *> IWORK for the job parameters used in the call. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> < 0 : if INFO = -i, then the i-th argument had an illegal value. -*> = 0 : successful exit; -*> > 0 : ZGEJSV did not converge in the maximal allowed number -*> of sweeps. The computed values may be inaccurate. +*> < 0: if INFO = -i, then the i-th argument had an illegal value. +*> = 0: successful exit; +*> > 0: ZGEJSV did not converge in the maximal allowed number +*> of sweeps. The computed values may be inaccurate. *> \endverbatim * * Authors: @@ -1338,7 +1338,7 @@ IF ( L2ABER ) THEN * Standard absolute error bound suffices. All sigma_i with * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an -* agressive enforcement of lower numerical rank by introducing a +* aggressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. TEMP1 = SQRT(DBLE(N))*EPSLN DO 3001 p = 2, N @@ -1350,7 +1350,7 @@ 3001 CONTINUE 3002 CONTINUE ELSE IF ( L2RANK ) THEN -* .. similarly as above, only slightly more gentle (less agressive). +* .. similarly as above, only slightly more gentle (less aggressive). * Sudden drop on the diagonal of R1 is used as the criterion for * close-to-rank-deficient. TEMP1 = SQRT(SFMIN) @@ -1720,7 +1720,7 @@ CALL ZPOCON('L',NR,CWORK(2*N+1),NR,ONE,TEMP1, $ CWORK(2*N+NR*NR+1),RWORK,IERR) CONDR1 = ONE / SQRT(TEMP1) -* .. here need a second oppinion on the condition number +* .. here need a second opinion on the condition number * .. then assume worst case scenario * R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) * more conservative <=> CONDR1 .LT. SQRT(DBLE(N)) @@ -1765,7 +1765,7 @@ ELSE * * .. ill-conditioned case: second QRF with pivoting -* Note that windowed pivoting would be equaly good +* Note that windowed pivoting would be equally good * numerically, and more run-time efficient. So, in * an optimal implementation, the next call to ZGEQP3 * should be replaced with eg. CALL ZGEQPX (ACM TOMS #782) @@ -1823,7 +1823,7 @@ * IF ( CONDR2 .GE. COND_OK ) THEN * .. save the Householder vectors used for Q3 -* (this overwrittes the copy of R2, as it will not be +* (this overwrites the copy of R2, as it will not be * needed in this branch, but it does not overwritte the * Huseholder vectors of Q2.). CALL ZLACPY( 'U', NR, NR, V, LDV, CWORK(2*N+1), N ) @@ -2079,7 +2079,7 @@ * * This branch deploys a preconditioned Jacobi SVD with explicitly * accumulated rotations. It is included as optional, mainly for -* experimental purposes. It does perfom well, and can also be used. +* experimental purposes. It does perform well, and can also be used. * In this implementation, this branch will be automatically activated * if the condition number sigma_max(A) / sigma_min(A) is predicted * to be greater than the overflow threshold. This is because the diff --git a/lapack-netlib/SRC/zgelq.f b/lapack-netlib/SRC/zgelq.f index 656396536..4e7e7e38e 100644 --- a/lapack-netlib/SRC/zgelq.f +++ b/lapack-netlib/SRC/zgelq.f @@ -1,3 +1,4 @@ +*> \brief \b ZGELQ * * Definition: * =========== @@ -17,7 +18,17 @@ * ============= *> *> \verbatim -*> ZGELQ computes a LQ factorization of an M-by-N matrix A. +*> +*> ZGELQ computes an LQ factorization of a complex M-by-N matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -138,7 +149,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -159,10 +170,10 @@ SUBROUTINE ZGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/zgelq2.f b/lapack-netlib/SRC/zgelq2.f index 188c8f8c8..a825ac17b 100644 --- a/lapack-netlib/SRC/zgelq2.f +++ b/lapack-netlib/SRC/zgelq2.f @@ -33,8 +33,16 @@ *> *> \verbatim *> -*> ZGELQ2 computes an LQ factorization of a complex m by n matrix A: -*> A = L * Q. +*> ZGELQ2 computes an LQ factorization of a complex m-by-n matrix A: +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a n-by-n orthogonal matrix; +*> L is an lower-triangular m-by-m matrix; +*> 0 is a m-by-(n-m) zero matrix, if m < n. +*> *> \endverbatim * * Arguments: @@ -96,7 +104,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -121,10 +129,10 @@ * ===================================================================== SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/zgelqf.f b/lapack-netlib/SRC/zgelqf.f index 8d9341a61..3a5e5fd4a 100644 --- a/lapack-netlib/SRC/zgelqf.f +++ b/lapack-netlib/SRC/zgelqf.f @@ -34,7 +34,15 @@ *> \verbatim *> *> ZGELQF computes an LQ factorization of a complex M-by-N matrix A: -*> A = L * Q. +*> +*> A = ( L 0 ) * Q +*> +*> where: +*> +*> Q is a N-by-N orthogonal matrix; +*> L is an lower-triangular M-by-M matrix; +*> 0 is a M-by-(N-M) zero matrix, if M < N. +*> *> \endverbatim * * Arguments: @@ -110,7 +118,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -135,10 +143,10 @@ * ===================================================================== SUBROUTINE ZGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/zgemlq.f b/lapack-netlib/SRC/zgemlq.f index aa07e0feb..6fb2be3d8 100644 --- a/lapack-netlib/SRC/zgemlq.f +++ b/lapack-netlib/SRC/zgemlq.f @@ -1,3 +1,4 @@ +*> \brief \b ZGEMLQ * * Definition: * =========== @@ -142,7 +143,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/zgemqr.f b/lapack-netlib/SRC/zgemqr.f index 32f1bf4d5..aec9321bb 100644 --- a/lapack-netlib/SRC/zgemqr.f +++ b/lapack-netlib/SRC/zgemqr.f @@ -1,3 +1,4 @@ +*> \brief \b ZGEMQR * * Definition: * =========== @@ -144,7 +145,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> diff --git a/lapack-netlib/SRC/zgeqr.f b/lapack-netlib/SRC/zgeqr.f index 1aa457f56..cea686b98 100644 --- a/lapack-netlib/SRC/zgeqr.f +++ b/lapack-netlib/SRC/zgeqr.f @@ -1,3 +1,4 @@ +*> \brief \b ZGEQR * * Definition: * =========== @@ -17,7 +18,18 @@ * ============= *> *> \verbatim -*> ZGEQR computes a QR factorization of an M-by-N matrix A. +*> +*> ZGEQR computes a QR factorization of a complex M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -138,7 +150,7 @@ *> \verbatim *> *> These details are particular for this LAPACK implementation. Users should not -*> take them for granted. These details may change in the future, and are unlikely not +*> take them for granted. These details may change in the future, and are not likely *> true for another LAPACK implementation. These details are relevant if one wants *> to try to understand the code. They are not part of the interface. *> @@ -160,10 +172,10 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, TSIZE, LWORK diff --git a/lapack-netlib/SRC/zgeqr2.f b/lapack-netlib/SRC/zgeqr2.f index d2774d788..0384c1d42 100644 --- a/lapack-netlib/SRC/zgeqr2.f +++ b/lapack-netlib/SRC/zgeqr2.f @@ -33,8 +33,17 @@ *> *> \verbatim *> -*> ZGEQR2 computes a QR factorization of a complex m by n matrix A: -*> A = Q * R. +*> ZGEQR2 computes a QR factorization of a complex m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -96,7 +105,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -121,10 +130,10 @@ * ===================================================================== SUBROUTINE ZGEQR2( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/zgeqr2p.f b/lapack-netlib/SRC/zgeqr2p.f index 0e5e55486..7bbd81da9 100644 --- a/lapack-netlib/SRC/zgeqr2p.f +++ b/lapack-netlib/SRC/zgeqr2p.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> ZGEQR2P computes a QR factorization of a complex m by n matrix A: -*> A = Q * R. The diagonal entries of R are real and nonnegative. +*> ZGEQR2P computes a QR factorization of a complex m-by-n matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a m-by-m orthogonal matrix; +*> R is an upper-triangular n-by-n matrix with nonnegative diagonal +*> entries; +*> 0 is a (m-n)-by-n zero matrix, if m > n. +*> *> \endverbatim * * Arguments: @@ -97,7 +107,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -124,10 +134,10 @@ * ===================================================================== SUBROUTINE ZGEQR2P( M, N, A, LDA, TAU, WORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/zgeqrf.f b/lapack-netlib/SRC/zgeqrf.f index 3ea1e71e1..2c03ebe73 100644 --- a/lapack-netlib/SRC/zgeqrf.f +++ b/lapack-netlib/SRC/zgeqrf.f @@ -34,7 +34,16 @@ *> \verbatim *> *> ZGEQRF computes a QR factorization of a complex M-by-N matrix A: -*> A = Q * R. +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -111,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -136,10 +145,10 @@ * ===================================================================== SUBROUTINE ZGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/zgeqrfp.f b/lapack-netlib/SRC/zgeqrfp.f index cdc4bfa94..80ead21ca 100644 --- a/lapack-netlib/SRC/zgeqrfp.f +++ b/lapack-netlib/SRC/zgeqrfp.f @@ -33,8 +33,18 @@ *> *> \verbatim *> -*> ZGEQRFP computes a QR factorization of a complex M-by-N matrix A: -*> A = Q * R. The diagonal entries of R are real and nonnegative. +*> ZGEQR2P computes a QR factorization of a complex M-by-N matrix A: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix; +*> R is an upper-triangular N-by-N matrix with nonnegative diagonal +*> entries; +*> 0 is a (M-N)-by-N zero matrix, if M > N. +*> *> \endverbatim * * Arguments: @@ -112,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 +*> \date November 2019 * *> \ingroup complex16GEcomputational * @@ -139,10 +149,10 @@ * ===================================================================== SUBROUTINE ZGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, LWORK, M, N diff --git a/lapack-netlib/SRC/zgerfsx.f b/lapack-netlib/SRC/zgerfsx.f index 5aabe50ed..3af7f8b6b 100644 --- a/lapack-netlib/SRC/zgerfsx.f +++ b/lapack-netlib/SRC/zgerfsx.f @@ -74,7 +74,7 @@ *> Specifies the form of the system of equations: *> = 'N': A * X = B (No transpose) *> = 'T': A**T * X = B (Transpose) -*> = 'C': A**H * X = B (Conjugate transpose = Transpose) +*> = 'C': A**H * X = B (Conjugate transpose) *> \endverbatim *> *> \param[in] EQUED @@ -283,7 +283,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -319,14 +319,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -334,9 +334,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/zgesc2.f b/lapack-netlib/SRC/zgesc2.f index 72ef99dba..cdf15e4f4 100644 --- a/lapack-netlib/SRC/zgesc2.f +++ b/lapack-netlib/SRC/zgesc2.f @@ -91,7 +91,7 @@ *> \verbatim *> SCALE is DOUBLE PRECISION *> On exit, SCALE contains the scale factor. SCALE is chosen -*> 0 <= SCALE <= 1 to prevent owerflow in the solution. +*> 0 <= SCALE <= 1 to prevent overflow in the solution. *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/zgesvdq.f b/lapack-netlib/SRC/zgesvdq.f new file mode 100644 index 000000000..e0fb920bb --- /dev/null +++ b/lapack-netlib/SRC/zgesvdq.f @@ -0,0 +1,1389 @@ +*> \brief ZGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE matrices +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZGESVDQ + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, +* S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, +* CWORK, LCWORK, RWORK, LRWORK, INFO ) +* +* .. Scalar Arguments .. +* IMPLICIT NONE +* CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV +* INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK, +* INFO +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * ) +* DOUBLE PRECISION S( * ), RWORK( * ) +* INTEGER IWORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +* ZCGESVDQ computes the singular value decomposition (SVD) of a complex +*> M-by-N matrix A, where M >= N. The SVD of A is written as +*> [++] [xx] [x0] [xx] +*> A = U * SIGMA * V^*, [++] = [xx] * [ox] * [xx] +*> [++] [xx] +*> where SIGMA is an N-by-N diagonal matrix, U is an M-by-N orthonormal +*> matrix, and V is an N-by-N unitary matrix. The diagonal elements +*> of SIGMA are the singular values of A. The columns of U and V are the +*> left and the right singular vectors of A, respectively. +*> \endverbatim +* +* Arguments +* ========= +* +*> \param[in] JOBA +*> \verbatim +*> JOBA is CHARACTER*1 +*> Specifies the level of accuracy in the computed SVD +*> = 'A' The requested accuracy corresponds to having the backward +*> error bounded by || delta A ||_F <= f(m,n) * EPS * || A ||_F, +*> where EPS = DLAMCH('Epsilon'). This authorises ZGESVDQ to +*> truncate the computed triangular factor in a rank revealing +*> QR factorization whenever the truncated part is below the +*> threshold of the order of EPS * ||A||_F. This is aggressive +*> truncation level. +*> = 'M' Similarly as with 'A', but the truncation is more gentle: it +*> is allowed only when there is a drop on the diagonal of the +*> triangular factor in the QR factorization. This is medium +*> truncation level. +*> = 'H' High accuracy requested. No numerical rank determination based +*> on the rank revealing QR factorization is attempted. +*> = 'E' Same as 'H', and in addition the condition number of column +*> scaled A is estimated and returned in RWORK(1). +*> N^(-1/4)*RWORK(1) <= ||pinv(A_scaled)||_2 <= N^(1/4)*RWORK(1) +*> \endverbatim +*> +*> \param[in] JOBP +*> \verbatim +*> JOBP is CHARACTER*1 +*> = 'P' The rows of A are ordered in decreasing order with respect to +*> ||A(i,:)||_\infty. This enhances numerical accuracy at the cost +*> of extra data movement. Recommended for numerical robustness. +*> = 'N' No row pivoting. +*> \endverbatim +*> +*> \param[in] JOBR +*> \verbatim +*> JOBR is CHARACTER*1 +*> = 'T' After the initial pivoted QR factorization, ZGESVD is applied to +*> the adjoint R**H of the computed triangular factor R. This involves +*> some extra data movement (matrix transpositions). Useful for +*> experiments, research and development. +*> = 'N' The triangular factor R is given as input to CGESVD. This may be +*> preferred as it involves less data movement. +*> \endverbatim +*> +*> \param[in] JOBU +*> \verbatim +*> JOBU is CHARACTER*1 +*> = 'A' All M left singular vectors are computed and returned in the +*> matrix U. See the description of U. +*> = 'S' or 'U' N = min(M,N) left singular vectors are computed and returned +*> in the matrix U. See the description of U. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK left singular +*> vectors are computed and returned in the matrix U. +*> = 'F' The N left singular vectors are returned in factored form as the +*> product of the Q factor from the initial QR factorization and the +*> N left singular vectors of (R**H , 0)**H. If row pivoting is used, +*> then the necessary information on the row pivoting is stored in +*> IWORK(N+1:N+M-1). +*> = 'N' The left singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] JOBV +*> \verbatim +*> JOBV is CHARACTER*1 +*> = 'A', 'V' All N right singular vectors are computed and returned in +*> the matrix V. +*> = 'R' Numerical rank NUMRANK is determined and only NUMRANK right singular +*> vectors are computed and returned in the matrix V. This option is +*> allowed only if JOBU = 'R' or JOBU = 'N'; otherwise it is illegal. +*> = 'N' The right singular vectors are not computed. +*> \endverbatim +*> +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the input matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the input matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array of dimensions LDA x N +*> On entry, the input matrix A. +*> On exit, if JOBU .NE. 'N' or JOBV .NE. 'N', the lower triangle of A contains +*> the Householder vectors as stored by ZGEQP3. If JOBU = 'F', these Householder +*> vectors together with CWORK(1:N) can be used to restore the Q factors from +*> the initial pivoted QR factorization of A. See the description of U. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER. +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] S +*> \verbatim +*> S is DOUBLE PRECISION array of dimension N. +*> The singular values of A, ordered so that S(i) >= S(i+1). +*> \endverbatim +*> +*> \param[out] U +*> \verbatim +*> U is COMPLEX*16 array, dimension +*> LDU x M if JOBU = 'A'; see the description of LDU. In this case, +*> on exit, U contains the M left singular vectors. +*> LDU x N if JOBU = 'S', 'U', 'R' ; see the description of LDU. In this +*> case, U contains the leading N or the leading NUMRANK left singular vectors. +*> LDU x N if JOBU = 'F' ; see the description of LDU. In this case U +*> contains N x N unitary matrix that can be used to form the left +*> singular vectors. +*> If JOBU = 'N', U is not referenced. +*> \endverbatim +*> +*> \param[in] LDU +*> \verbatim +*> LDU is INTEGER. +*> The leading dimension of the array U. +*> If JOBU = 'A', 'S', 'U', 'R', LDU >= max(1,M). +*> If JOBU = 'F', LDU >= max(1,N). +*> Otherwise, LDU >= 1. +*> \endverbatim +*> +*> \param[out] V +*> \verbatim +*> V is COMPLEX*16 array, dimension +*> LDV x N if JOBV = 'A', 'V', 'R' or if JOBA = 'E' . +*> If JOBV = 'A', or 'V', V contains the N-by-N unitary matrix V**H; +*> If JOBV = 'R', V contains the first NUMRANK rows of V**H (the right +*> singular vectors, stored rowwise, of the NUMRANK largest singular values). +*> If JOBV = 'N' and JOBA = 'E', V is used as a workspace. +*> If JOBV = 'N', and JOBA.NE.'E', V is not referenced. +*> \endverbatim +*> +*> \param[in] LDV +*> \verbatim +*> LDV is INTEGER +*> The leading dimension of the array V. +*> If JOBV = 'A', 'V', 'R', or JOBA = 'E', LDV >= max(1,N). +*> Otherwise, LDV >= 1. +*> \endverbatim +*> +*> \param[out] NUMRANK +*> \verbatim +*> NUMRANK is INTEGER +*> NUMRANK is the numerical rank first determined after the rank +*> revealing QR factorization, following the strategy specified by the +*> value of JOBA. If JOBV = 'R' and JOBU = 'R', only NUMRANK +*> leading singular values and vectors are then requested in the call +*> of CGESVD. The final value of NUMRANK might be further reduced if +*> some singular values are computed as zeros. +*> \endverbatim +*> +*> \param[out] IWORK +*> \verbatim +*> IWORK is INTEGER array, dimension (max(1, LIWORK)). +*> On exit, IWORK(1:N) contains column pivoting permutation of the +*> rank revealing QR factorization. +*> If JOBP = 'P', IWORK(N+1:N+M-1) contains the indices of the sequence +*> of row swaps used in row pivoting. These can be used to restore the +*> left singular vectors in the case JOBU = 'F'. +* +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> LIWORK(1) returns the minimal LIWORK. +*> \endverbatim +*> +*> \param[in] LIWORK +*> \verbatim +*> LIWORK is INTEGER +*> The dimension of the array IWORK. +*> LIWORK >= N + M - 1, if JOBP = 'P'; +*> LIWORK >= N if JOBP = 'N'. +*> +*> If LIWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] CWORK +*> \verbatim +*> CWORK is COMPLEX*12 array, dimension (max(2, LCWORK)), used as a workspace. +*> On exit, if, on entry, LCWORK.NE.-1, CWORK(1:N) contains parameters +*> needed to recover the Q factor from the QR factorization computed by +*> ZGEQP3. +* +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> CWORK(1) returns the optimal LCWORK, and +*> CWORK(2) returns the minimal LCWORK. +*> \endverbatim +*> +*> \param[in,out] LCWORK +*> \verbatim +*> LCWORK is INTEGER +*> The dimension of the array CWORK. It is determined as follows: +*> Let LWQP3 = N+1, LWCON = 2*N, and let +*> LWUNQ = { MAX( N, 1 ), if JOBU = 'R', 'S', or 'U' +*> { MAX( M, 1 ), if JOBU = 'A' +*> LWSVD = MAX( 3*N, 1 ) +*> LWLQF = MAX( N/2, 1 ), LWSVD2 = MAX( 3*(N/2), 1 ), LWUNLQ = MAX( N, 1 ), +*> LWQRF = MAX( N/2, 1 ), LWUNQ2 = MAX( N, 1 ) +*> Then the minimal value of LCWORK is: +*> = MAX( N + LWQP3, LWSVD ) if only the singular values are needed; +*> = MAX( N + LWQP3, LWCON, LWSVD ) if only the singular values are needed, +*> and a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWUNQ ) if the singular values and the left +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) if the singular values and the left +*> singular vectors are requested, and also +*> a scaled condition estimate requested; +*> +*> = N + MAX( LWQP3, LWSVD ) if the singular values and the right +*> singular vectors are requested; +*> = N + MAX( LWQP3, LWCON, LWSVD ) if the singular values and the right +*> singular vectors are requested, and also +*> a scaled condition etimate requested; +*> +*> = N + MAX( LWQP3, LWSVD, LWUNQ ) if the full SVD is requested with JOBV = 'R'; +*> independent of JOBR; +*> = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) if the full SVD is requested, +*> JOBV = 'R' and, also a scaled condition +*> estimate requested; independent of JOBR; +*> = MAX( N + MAX( LWQP3, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, N/2+LWUNLQ, LWUNQ) ) if the +*> full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWLQF, N/2+LWSVD2, N/2+LWUNLQ, LWUNQ ) ) +*> if the full SVD is requested with JOBV = 'A' or 'V', and +*> JOBR ='N', and also a scaled condition number estimate +*> requested. +*> = MAX( N + MAX( LWQP3, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, N/2+LWUNQ2, LWUNQ ) ) if the +*> full SVD is requested with JOBV = 'A', 'V', and JOBR ='T' +*> = MAX( N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ), +*> N + MAX( LWQP3, LWCON, N/2+LWQRF, N/2+LWSVD2, N/2+LWUNQ2, LWUNQ ) ) +*> if the full SVD is requested with JOBV = 'A', 'V' and +*> JOBR ='T', and also a scaled condition number estimate +*> requested. +*> Finally, LCWORK must be at least two: LCWORK = MAX( 2, LCWORK ). +*> +*> If LCWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (max(1, LRWORK)). +*> On exit, +*> 1. If JOBA = 'E', RWORK(1) contains an estimate of the condition +*> number of column scaled A. If A = C * D where D is diagonal and C +*> has unit columns in the Euclidean norm, then, assuming full column rank, +*> N^(-1/4) * RWORK(1) <= ||pinv(C)||_2 <= N^(1/4) * RWORK(1). +*> Otherwise, RWORK(1) = -1. +*> 2. RWORK(2) contains the number of singular values computed as +*> exact zeros in ZGESVD applied to the upper triangular or trapeziodal +*> R (from the initial QR factorization). In case of early exit (no call to +*> ZGESVD, such as in the case of zero matrix) RWORK(2) = -1. +* +*> If LIWORK, LCWORK, or LRWORK = -1, then on exit, if INFO = 0, +*> RWORK(1) returns the minimal LRWORK. +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER. +*> The dimension of the array RWORK. +*> If JOBP ='P', then LRWORK >= MAX(2, M, 5*N); +*> Otherwise, LRWORK >= MAX(2, 5*N). +* +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates and returns the optimal and minimal sizes +*> for the CWORK, IWORK, and RWORK arrays, and no error +*> message related to LCWORK is issued by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit. +*> < 0: if INFO = -i, the i-th argument had an illegal value. +*> > 0: if ZBDSQR did not converge, INFO specifies how many superdiagonals +*> of an intermediate bidiagonal form B (computed in ZGESVD) did not +*> converge to zero. +*> \endverbatim +* +*> \par Further Details: +* ======================== +*> +*> \verbatim +*> +*> 1. The data movement (matrix transpose) is coded using simple nested +*> DO-loops because BLAS and LAPACK do not provide corresponding subroutines. +*> Those DO-loops are easily identified in this source code - by the CONTINUE +*> statements labeled with 11**. In an optimized version of this code, the +*> nested DO loops should be replaced with calls to an optimized subroutine. +*> 2. This code scales A by 1/SQRT(M) if the largest ABS(A(i,j)) could cause +*> column norm overflow. This is the minial precaution and it is left to the +*> SVD routine (CGESVD) to do its own preemptive scaling if potential over- +*> or underflows are detected. To avoid repeated scanning of the array A, +*> an optimal implementation would do all necessary scaling before calling +*> CGESVD and the scaling in CGESVD can be switched off. +*> 3. Other comments related to code optimization are given in comments in the +*> code, enlosed in [[double brackets]]. +*> \endverbatim +* +*> \par Bugs, examples and comments +* =========================== +* +*> \verbatim +*> Please report all bugs and send interesting examples and/or comments to +*> drmac@math.hr. Thank you. +*> \endverbatim +* +*> \par References +* =============== +* +*> \verbatim +*> [1] Zlatko Drmac, Algorithm 977: A QR-Preconditioned QR SVD Method for +*> Computing the SVD with High Accuracy. ACM Trans. Math. Softw. +*> 44(1): 11:1-11:30 (2017) +*> +*> SIGMA library, xGESVDQ section updated February 2016. +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> Developed and coded by Zlatko Drmac, Department of Mathematics +*> University of Zagreb, Croatia, drmac@math.hr +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2018 +* +*> \ingroup complex16GEsing +* +* ===================================================================== + SUBROUTINE ZGESVDQ( JOBA, JOBP, JOBR, JOBU, JOBV, M, N, A, LDA, + $ S, U, LDU, V, LDV, NUMRANK, IWORK, LIWORK, + $ CWORK, LCWORK, RWORK, LRWORK, INFO ) +* .. Scalar Arguments .. + IMPLICIT NONE + CHARACTER JOBA, JOBP, JOBR, JOBU, JOBV + INTEGER M, N, LDA, LDU, LDV, NUMRANK, LIWORK, LCWORK, LRWORK, + $ INFO +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( * ) + DOUBLE PRECISION S( * ), RWORK( * ) + INTEGER IWORK( * ) +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) + COMPLEX*16 CZERO, CONE + PARAMETER ( CZERO = (0.0D0,0.0D0), CONE = (1.0D0,0.0D0) ) +* .. +* .. Local Scalars .. + INTEGER IERR, NR, N1, OPTRATIO, p, q + INTEGER LWCON, LWQP3, LWRK_ZGELQF, LWRK_ZGESVD, LWRK_ZGESVD2, + $ LWRK_ZGEQP3, LWRK_ZGEQRF, LWRK_ZUNMLQ, LWRK_ZUNMQR, + $ LWRK_ZUNMQR2, LWLQF, LWQRF, LWSVD, LWSVD2, LWUNQ, + $ LWUNQ2, LWUNLQ, MINWRK, MINWRK2, OPTWRK, OPTWRK2, + $ IMINWRK, RMINWRK + LOGICAL ACCLA, ACCLM, ACCLH, ASCALED, CONDA, DNTWU, DNTWV, + $ LQUERY, LSVC0, LSVEC, ROWPRM, RSVEC, RTRANS, WNTUA, + $ WNTUF, WNTUR, WNTUS, WNTVA, WNTVR + DOUBLE PRECISION BIG, EPSLN, RTMP, SCONDA, SFMIN + COMPLEX*16 CTMP +* .. +* .. Local Arrays + COMPLEX*16 CDUMMY(1) + DOUBLE PRECISION RDUMMY(1) +* .. +* .. External Subroutines (BLAS, LAPACK) + EXTERNAL ZGELQF, ZGEQP3, ZGEQRF, ZGESVD, ZLACPY, ZLAPMT, + $ ZLASCL, ZLASET, ZLASWP, ZDSCAL, DLASET, DLASCL, + $ ZPOCON, ZUNMLQ, ZUNMQR, XERBLA +* .. +* .. External Functions (BLAS, LAPACK) + LOGICAL LSAME + INTEGER IDAMAX + DOUBLE PRECISION ZLANGE, DZNRM2, DLAMCH + EXTERNAL LSAME, ZLANGE, IDAMAX, DZNRM2, DLAMCH +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, CONJG, MAX, MIN, DBLE, SQRT +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + WNTUS = LSAME( JOBU, 'S' ) .OR. LSAME( JOBU, 'U' ) + WNTUR = LSAME( JOBU, 'R' ) + WNTUA = LSAME( JOBU, 'A' ) + WNTUF = LSAME( JOBU, 'F' ) + LSVC0 = WNTUS .OR. WNTUR .OR. WNTUA + LSVEC = LSVC0 .OR. WNTUF + DNTWU = LSAME( JOBU, 'N' ) +* + WNTVR = LSAME( JOBV, 'R' ) + WNTVA = LSAME( JOBV, 'A' ) .OR. LSAME( JOBV, 'V' ) + RSVEC = WNTVR .OR. WNTVA + DNTWV = LSAME( JOBV, 'N' ) +* + ACCLA = LSAME( JOBA, 'A' ) + ACCLM = LSAME( JOBA, 'M' ) + CONDA = LSAME( JOBA, 'E' ) + ACCLH = LSAME( JOBA, 'H' ) .OR. CONDA +* + ROWPRM = LSAME( JOBP, 'P' ) + RTRANS = LSAME( JOBR, 'T' ) +* + IF ( ROWPRM ) THEN + IMINWRK = MAX( 1, N + M - 1 ) + RMINWRK = MAX( 2, M, 5*N ) + ELSE + IMINWRK = MAX( 1, N ) + RMINWRK = MAX( 2, 5*N ) + END IF + LQUERY = (LIWORK .EQ. -1 .OR. LCWORK .EQ. -1 .OR. LRWORK .EQ. -1) + INFO = 0 + IF ( .NOT. ( ACCLA .OR. ACCLM .OR. ACCLH ) ) THEN + INFO = -1 + ELSE IF ( .NOT.( ROWPRM .OR. LSAME( JOBP, 'N' ) ) ) THEN + INFO = -2 + ELSE IF ( .NOT.( RTRANS .OR. LSAME( JOBR, 'N' ) ) ) THEN + INFO = -3 + ELSE IF ( .NOT.( LSVEC .OR. DNTWU ) ) THEN + INFO = -4 + ELSE IF ( WNTUR .AND. WNTVA ) THEN + INFO = -5 + ELSE IF ( .NOT.( RSVEC .OR. DNTWV )) THEN + INFO = -5 + ELSE IF ( M.LT.0 ) THEN + INFO = -6 + ELSE IF ( ( N.LT.0 ) .OR. ( N.GT.M ) ) THEN + INFO = -7 + ELSE IF ( LDA.LT.MAX( 1, M ) ) THEN + INFO = -9 + ELSE IF ( LDU.LT.1 .OR. ( LSVC0 .AND. LDU.LT.M ) .OR. + $ ( WNTUF .AND. LDU.LT.N ) ) THEN + INFO = -12 + ELSE IF ( LDV.LT.1 .OR. ( RSVEC .AND. LDV.LT.N ) .OR. + $ ( CONDA .AND. LDV.LT.N ) ) THEN + INFO = -14 + ELSE IF ( LIWORK .LT. IMINWRK .AND. .NOT. LQUERY ) THEN + INFO = -17 + END IF +* +* + IF ( INFO .EQ. 0 ) THEN +* .. compute the minimal and the optimal workspace lengths +* [[The expressions for computing the minimal and the optimal +* values of LCWORK are written with a lot of redundancy and +* can be simplified. However, this detailed form is easier for +* maintenance and modifications of the code.]] +* +* .. minimal workspace length for ZGEQP3 of an M x N matrix + LWQP3 = N+1 +* .. minimal workspace length for ZUNMQR to build left singular vectors + IF ( WNTUS .OR. WNTUR ) THEN + LWUNQ = MAX( N , 1 ) + ELSE IF ( WNTUA ) THEN + LWUNQ = MAX( M , 1 ) + END IF +* .. minimal workspace length for ZPOCON of an N x N matrix + LWCON = 2 * N +* .. ZGESVD of an N x N matrix + LWSVD = MAX( 3 * N, 1 ) + IF ( LQUERY ) THEN + CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, + $ RDUMMY, IERR ) + LWRK_ZGEQP3 = INT( CDUMMY(1) ) + IF ( WNTUS .OR. WNTUR ) THEN + CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, + $ LDU, CDUMMY, -1, IERR ) + LWRK_ZUNMQR = INT( CDUMMY(1) ) + ELSE IF ( WNTUA ) THEN + CALL ZUNMQR( 'L', 'N', M, M, N, A, LDA, CDUMMY, U, + $ LDU, CDUMMY, -1, IERR ) + LWRK_ZUNMQR = INT( CDUMMY(1) ) + ELSE + LWRK_ZUNMQR = 0 + END IF + END IF + MINWRK = 2 + OPTWRK = 2 + IF ( .NOT. (LSVEC .OR. RSVEC ) ) THEN +* .. minimal and optimal sizes of the complex workspace if +* only the singular values are requested + IF ( CONDA ) THEN + MINWRK = MAX( N+LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = MAX( N+LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + CALL ZGESVD( 'N', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_ZGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, LWRK_ZGESVD ) + ELSE + OPTWRK = MAX( N+LWRK_ZGEQP3, LWRK_ZGESVD ) + END IF + END IF + ELSE IF ( LSVEC .AND. (.NOT.RSVEC) ) THEN +* .. minimal and optimal sizes of the complex workspace if the +* singular values and the left singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD, LWUNQ ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD, LWUNQ ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL ZGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + ELSE + CALL ZGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + END IF + LWRK_ZGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, LWRK_ZGESVD, + $ LWRK_ZUNMQR ) + ELSE + OPTWRK = N + MAX( LWRK_ZGEQP3, LWRK_ZGESVD, + $ LWRK_ZUNMQR ) + END IF + END IF + ELSE IF ( RSVEC .AND. (.NOT.LSVEC) ) THEN +* .. minimal and optimal sizes of the complex workspace if the +* singular values and the right singular vectors are requested + IF ( CONDA ) THEN + MINWRK = N + MAX( LWQP3, LWCON, LWSVD ) + ELSE + MINWRK = N + MAX( LWQP3, LWSVD ) + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL ZGESVD( 'O', 'N', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + ELSE + CALL ZGESVD( 'N', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + END IF + LWRK_ZGESVD = INT( CDUMMY(1) ) + IF ( CONDA ) THEN + OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, LWRK_ZGESVD ) + ELSE + OPTWRK = N + MAX( LWRK_ZGEQP3, LWRK_ZGESVD ) + END IF + END IF + ELSE +* .. minimal and optimal sizes of the complex workspace if the +* full SVD is requested + IF ( RTRANS ) THEN + MINWRK = MAX( LWQP3, LWSVD, LWUNQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N x N/2 ZGEQRF + LWQRF = MAX( N/2, 1 ) +* .. minimal workspace lengt for N/2 x N/2 ZGESVD + LWSVD2 = MAX( 3 * (N/2), 1 ) + LWUNQ2 = MAX( N, 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWQRF, N/2+LWSVD2, + $ N/2+LWUNQ2, LWUNQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + ELSE + MINWRK = MAX( LWQP3, LWSVD, LWUNQ ) + IF ( CONDA ) MINWRK = MAX( MINWRK, LWCON ) + MINWRK = MINWRK + N + IF ( WNTVA ) THEN +* .. minimal workspace length for N/2 x N ZGELQF + LWLQF = MAX( N/2, 1 ) + LWSVD2 = MAX( 3 * (N/2), 1 ) + LWUNLQ = MAX( N , 1 ) + MINWRK2 = MAX( LWQP3, N/2+LWLQF, N/2+LWSVD2, + $ N/2+LWUNLQ, LWUNQ ) + IF ( CONDA ) MINWRK2 = MAX( MINWRK2, LWCON ) + MINWRK2 = N + MINWRK2 + MINWRK = MAX( MINWRK, MINWRK2 ) + END IF + END IF + IF ( LQUERY ) THEN + IF ( RTRANS ) THEN + CALL ZGESVD( 'O', 'A', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_ZGESVD = INT( CDUMMY(1) ) + OPTWRK = MAX(LWRK_ZGEQP3,LWRK_ZGESVD,LWRK_ZUNMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL ZGEQRF(N,N/2,U,LDU,CDUMMY,CDUMMY,-1,IERR) + LWRK_ZGEQRF = INT( CDUMMY(1) ) + CALL ZGESVD( 'S', 'O', N/2,N/2, V,LDV, S, U,LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_ZGESVD2 = INT( CDUMMY(1) ) + CALL ZUNMQR( 'R', 'C', N, N, N/2, U, LDU, CDUMMY, + $ V, LDV, CDUMMY, -1, IERR ) + LWRK_ZUNMQR2 = INT( CDUMMY(1) ) + OPTWRK2 = MAX( LWRK_ZGEQP3, N/2+LWRK_ZGEQRF, + $ N/2+LWRK_ZGESVD2, N/2+LWRK_ZUNMQR2 ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + ELSE + CALL ZGESVD( 'S', 'O', N, N, A, LDA, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_ZGESVD = INT( CDUMMY(1) ) + OPTWRK = MAX(LWRK_ZGEQP3,LWRK_ZGESVD,LWRK_ZUNMQR) + IF ( CONDA ) OPTWRK = MAX( OPTWRK, LWCON ) + OPTWRK = N + OPTWRK + IF ( WNTVA ) THEN + CALL ZGELQF(N/2,N,U,LDU,CDUMMY,CDUMMY,-1,IERR) + LWRK_ZGELQF = INT( CDUMMY(1) ) + CALL ZGESVD( 'S','O', N/2,N/2, V, LDV, S, U, LDU, + $ V, LDV, CDUMMY, -1, RDUMMY, IERR ) + LWRK_ZGESVD2 = INT( CDUMMY(1) ) + CALL ZUNMLQ( 'R', 'N', N, N, N/2, U, LDU, CDUMMY, + $ V, LDV, CDUMMY,-1,IERR ) + LWRK_ZUNMLQ = INT( CDUMMY(1) ) + OPTWRK2 = MAX( LWRK_ZGEQP3, N/2+LWRK_ZGELQF, + $ N/2+LWRK_ZGESVD2, N/2+LWRK_ZUNMLQ ) + IF ( CONDA ) OPTWRK2 = MAX( OPTWRK2, LWCON ) + OPTWRK2 = N + OPTWRK2 + OPTWRK = MAX( OPTWRK, OPTWRK2 ) + END IF + END IF + END IF + END IF +* + MINWRK = MAX( 2, MINWRK ) + OPTWRK = MAX( 2, OPTWRK ) + IF ( LCWORK .LT. MINWRK .AND. (.NOT.LQUERY) ) INFO = -19 +* + END IF +* + IF (INFO .EQ. 0 .AND. LRWORK .LT. RMINWRK .AND. .NOT. LQUERY) THEN + INFO = -21 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZGESVDQ', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN +* +* Return optimal workspace +* + IWORK(1) = IMINWRK + CWORK(1) = OPTWRK + CWORK(2) = MINWRK + RWORK(1) = RMINWRK + RETURN + END IF +* +* Quick return if the matrix is void. +* + IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) THEN +* .. all output is void. + RETURN + END IF +* + BIG = DLAMCH('O') + ASCALED = .FALSE. + IF ( ROWPRM ) THEN +* .. reordering the rows in decreasing sequence in the +* ell-infinity norm - this enhances numerical robustness in +* the case of differently scaled rows. + DO 1904 p = 1, M +* RWORK(p) = ABS( A(p,IZAMAX(N,A(p,1),LDA)) ) +* [[ZLANGE will return NaN if an entry of the p-th row is Nan]] + RWORK(p) = ZLANGE( 'M', 1, N, A(p,1), LDA, RDUMMY ) +* .. check for NaN's and Inf's + IF ( ( RWORK(p) .NE. RWORK(p) ) .OR. + $ ( (RWORK(p)*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'ZGESVDQ', -INFO ) + RETURN + END IF + 1904 CONTINUE + DO 1952 p = 1, M - 1 + q = IDAMAX( M-p+1, RWORK(p), 1 ) + p - 1 + IWORK(N+p) = q + IF ( p .NE. q ) THEN + RTMP = RWORK(p) + RWORK(p) = RWORK(q) + RWORK(q) = RTMP + END IF + 1952 CONTINUE +* + IF ( RWORK(1) .EQ. ZERO ) THEN +* Quick return: A is the M x N zero matrix. + NUMRANK = 0 + CALL DLASET( 'G', N, 1, ZERO, ZERO, S, N ) + IF ( WNTUS ) CALL ZLASET('G', M, N, CZERO, CONE, U, LDU) + IF ( WNTUA ) CALL ZLASET('G', M, M, CZERO, CONE, U, LDU) + IF ( WNTVA ) CALL ZLASET('G', N, N, CZERO, CONE, V, LDV) + IF ( WNTUF ) THEN + CALL ZLASET( 'G', N, 1, CZERO, CZERO, CWORK, N ) + CALL ZLASET( 'G', M, N, CZERO, CONE, U, LDU ) + END IF + DO 5001 p = 1, N + IWORK(p) = p + 5001 CONTINUE + IF ( ROWPRM ) THEN + DO 5002 p = N + 1, N + M - 1 + IWORK(p) = p - N + 5002 CONTINUE + END IF + IF ( CONDA ) RWORK(1) = -1 + RWORK(2) = -1 + RETURN + END IF +* + IF ( RWORK(1) .GT. BIG / SQRT(DBLE(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL ZLASCL('G',0,0,SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + CALL ZLASWP( N, A, LDA, 1, M-1, IWORK(N+1), 1 ) + END IF +* +* .. At this stage, preemptive scaling is done only to avoid column +* norms overflows during the QR factorization. The SVD procedure should +* have its own scaling to save the singular values from overflows and +* underflows. That depends on the SVD procedure. +* + IF ( .NOT.ROWPRM ) THEN + RTMP = ZLANGE( 'M', M, N, A, LDA, RWORK ) + IF ( ( RTMP .NE. RTMP ) .OR. + $ ( (RTMP*ZERO) .NE. ZERO ) ) THEN + INFO = -8 + CALL XERBLA( 'ZGESVDQ', -INFO ) + RETURN + END IF + IF ( RTMP .GT. BIG / SQRT(DBLE(M)) ) THEN +* .. to prevent overflow in the QR factorization, scale the +* matrix by 1/sqrt(M) if too large entry detected + CALL ZLASCL('G',0,0, SQRT(DBLE(M)),ONE, M,N, A,LDA, IERR) + ASCALED = .TRUE. + END IF + END IF +* +* .. QR factorization with column pivoting +* +* A * P = Q * [ R ] +* [ 0 ] +* + DO 1963 p = 1, N +* .. all columns are free columns + IWORK(p) = 0 + 1963 CONTINUE + CALL ZGEQP3( M, N, A, LDA, IWORK, CWORK, CWORK(N+1), LCWORK-N, + $ RWORK, IERR ) +* +* If the user requested accuracy level allows truncation in the +* computed upper triangular factor, the matrix R is examined and, +* if possible, replaced with its leading upper trapezoidal part. +* + EPSLN = DLAMCH('E') + SFMIN = DLAMCH('S') +* SMALL = SFMIN / EPSLN + NR = N +* + IF ( ACCLA ) THEN +* +* Standard absolute error bound suffices. All sigma_i with +* sigma_i < N*EPS*||A||_F are flushed to zero. This is an +* aggressive enforcement of lower numerical rank by introducing a +* backward error of the order of N*EPS*||A||_F. + NR = 1 + RTMP = SQRT(DBLE(N))*EPSLN + DO 3001 p = 2, N + IF ( ABS(A(p,p)) .LT. (RTMP*ABS(A(1,1))) ) GO TO 3002 + NR = NR + 1 + 3001 CONTINUE + 3002 CONTINUE +* + ELSEIF ( ACCLM ) THEN +* .. similarly as above, only slightly more gentle (less aggressive). +* Sudden drop on the diagonal of R is used as the criterion for being +* close-to-rank-deficient. The threshold is set to EPSLN=DLAMCH('E'). +* [[This can be made more flexible by replacing this hard-coded value +* with a user specified threshold.]] Also, the values that underflow +* will be truncated. + NR = 1 + DO 3401 p = 2, N + IF ( ( ABS(A(p,p)) .LT. (EPSLN*ABS(A(p-1,p-1))) ) .OR. + $ ( ABS(A(p,p)) .LT. SFMIN ) ) GO TO 3402 + NR = NR + 1 + 3401 CONTINUE + 3402 CONTINUE +* + ELSE +* .. RRQR not authorized to determine numerical rank except in the +* obvious case of zero pivots. +* .. inspect R for exact zeros on the diagonal; +* R(i,i)=0 => R(i:N,i:N)=0. + NR = 1 + DO 3501 p = 2, N + IF ( ABS(A(p,p)) .EQ. ZERO ) GO TO 3502 + NR = NR + 1 + 3501 CONTINUE + 3502 CONTINUE +* + IF ( CONDA ) THEN +* Estimate the scaled condition number of A. Use the fact that it is +* the same as the scaled condition number of R. +* .. V is used as workspace + CALL ZLACPY( 'U', N, N, A, LDA, V, LDV ) +* Only the leading NR x NR submatrix of the triangular factor +* is considered. Only if NR=N will this give a reliable error +* bound. However, even for NR < N, this can be used on an +* expert level and obtain useful information in the sense of +* perturbation theory. + DO 3053 p = 1, NR + RTMP = DZNRM2( p, V(1,p), 1 ) + CALL ZDSCAL( p, ONE/RTMP, V(1,p), 1 ) + 3053 CONTINUE + IF ( .NOT. ( LSVEC .OR. RSVEC ) ) THEN + CALL ZPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ CWORK, RWORK, IERR ) + ELSE + CALL ZPOCON( 'U', NR, V, LDV, ONE, RTMP, + $ CWORK(N+1), RWORK, IERR ) + END IF + SCONDA = ONE / SQRT(RTMP) +* For NR=N, SCONDA is an estimate of SQRT(||(R^* * R)^(-1)||_1), +* N^(-1/4) * SCONDA <= ||R^(-1)||_2 <= N^(1/4) * SCONDA +* See the reference [1] for more details. + END IF +* + ENDIF +* + IF ( WNTUR ) THEN + N1 = NR + ELSE IF ( WNTUS .OR. WNTUF) THEN + N1 = N + ELSE IF ( WNTUA ) THEN + N1 = M + END IF +* + IF ( .NOT. ( RSVEC .OR. LSVEC ) ) THEN +*....................................................................... +* .. only the singular values are requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. compute the singular values of R**H = [A](1:NR,1:N)**H +* .. set the lower triangle of [A] to [A](1:NR,1:N)**H and +* the upper triangle of [A] to zero. + DO 1146 p = 1, MIN( N, NR ) + A(p,p) = CONJG(A(p,p)) + DO 1147 q = p + 1, N + A(q,p) = CONJG(A(p,q)) + IF ( q .LE. NR ) A(p,q) = CZERO + 1147 CONTINUE + 1146 CONTINUE +* + CALL ZGESVD( 'N', 'N', N, NR, A, LDA, S, U, LDU, + $ V, LDV, CWORK, LCWORK, RWORK, INFO ) +* + ELSE +* +* .. compute the singular values of R = [A](1:NR,1:N) +* + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, A(2,1), LDA ) + CALL ZGESVD( 'N', 'N', NR, N, A, LDA, S, U, LDU, + $ V, LDV, CWORK, LCWORK, RWORK, INFO ) +* + END IF +* + ELSE IF ( LSVEC .AND. ( .NOT. RSVEC) ) THEN +*....................................................................... +* .. the singular values and the left singular vectors requested +*......................................................................."""""""" + IF ( RTRANS ) THEN +* .. apply ZGESVD to R**H +* .. copy R**H into [U] and overwrite [U] with the right singular +* vectors of R + DO 1192 p = 1, NR + DO 1193 q = p, N + U(q,p) = CONJG(A(p,q)) + 1193 CONTINUE + 1192 CONTINUE + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, U(1,2), LDU ) +* .. the left singular vectors not computed, the NR right singular +* vectors overwrite [U](1:NR,1:NR) as conjugate transposed. These +* will be pre-multiplied by Q to build the left singular vectors of A. + CALL ZGESVD( 'N', 'O', N, NR, U, LDU, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1119 p = 1, NR + U(p,p) = CONJG(U(p,p)) + DO 1120 q = p + 1, NR + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1120 CONTINUE + 1119 CONTINUE +* + ELSE +* .. apply ZGESVD to R +* .. copy R into [U] and overwrite [U] with the left singular vectors + CALL ZLACPY( 'U', NR, N, A, LDA, U, LDU ) + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, U(2,1), LDU ) +* .. the right singular vectors not computed, the NR left singular +* vectors overwrite [U](1:NR,1:NR) + CALL ZGESVD( 'O', 'N', NR, N, U, LDU, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* .. now [U](1:NR,1:NR) contains the NR left singular vectors of +* R. These will be pre-multiplied by Q to build the left singular +* vectors of A. + END IF +* +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. ( .NOT.WNTUF ) ) THEN + CALL ZLASET('A', M-NR, NR, CZERO, CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL ZLASET( 'A',NR,N1-NR,CZERO,CZERO,U(1,NR+1), LDU ) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT.WNTUF ) + $ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, + $ LDU, CWORK(N+1), LCWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* + ELSE IF ( RSVEC .AND. ( .NOT. LSVEC ) ) THEN +*....................................................................... +* .. the singular values and the right singular vectors requested +*....................................................................... + IF ( RTRANS ) THEN +* .. apply ZGESVD to R**H +* .. copy R**H into V and overwrite V with the left singular vectors + DO 1165 p = 1, NR + DO 1166 q = p, N + V(q,p) = CONJG(A(p,q)) + 1166 CONTINUE + 1165 CONTINUE + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) +* .. the left singular vectors of R**H overwrite V, the right singular +* vectors not computed + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL ZGESVD( 'O', 'N', N, NR, V, LDV, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1121 p = 1, NR + V(p,p) = CONJG(V(p,p)) + DO 1122 q = p + 1, NR + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1122 CONTINUE + 1121 CONTINUE +* + IF ( NR .LT. N ) THEN + DO 1103 p = 1, NR + DO 1104 q = NR + 1, N + V(p,q) = CONJG(V(q,p)) + 1104 CONTINUE + 1103 CONTINUE + END IF + CALL ZLAPMT( .FALSE., NR, N, V, LDV, IWORK ) + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:N,1:NR) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the QR factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL ZLASET('G', N, N-NR, CZERO, CZERO, V(1,NR+1), LDV) + CALL ZGESVD( 'O', 'N', N, N, V, LDV, S, U, LDU, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1123 p = 1, N + V(p,p) = CONJG(V(p,p)) + DO 1124 q = p + 1, N + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1124 CONTINUE + 1123 CONTINUE + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* + ELSE +* .. aply ZGESVD to R +* .. copy R into V and overwrite V with the right singular vectors + CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'L', NR-1, NR-1, CZERO, CZERO, V(2,1), LDV ) +* .. the right singular vectors overwrite V, the NR left singular +* vectors stored in U(1:NR,1:NR) + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN + CALL ZGESVD( 'N', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL ZLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**H + ELSE +* .. need all N right singular vectors and NR < N +* [!] This is simple implementation that augments [V](1:NR,1:N) +* by padding a zero block. In the case NR << N, a more efficient +* way is to first use the LQ factorization. For more details +* how to implement this, see the " FULL SVD " branch. + CALL ZLASET('G', N-NR, N, CZERO,CZERO, V(NR+1,1), LDV) + CALL ZGESVD( 'N', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) + END IF +* .. now [V] contains the adjoint of the matrix of the right singular +* vectors of A. + END IF +* + ELSE +*....................................................................... +* .. FULL SVD requested +*....................................................................... + IF ( RTRANS ) THEN +* +* .. apply ZGESVD to R**H [[this option is left for R&D&T]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R**H into [V] and overwrite [V] with the left singular +* vectors of R**H + DO 1168 p = 1, NR + DO 1169 q = p, N + V(q,p) = CONJG(A(p,q)) + 1169 CONTINUE + 1168 CONTINUE + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'U', NR-1,NR-1, CZERO,CZERO, V(1,2), LDV ) +* +* .. the left singular vectors of R**H overwrite [V], the NR right +* singular vectors of R**H stored in [U](1:NR,1:NR) as conjugate +* transposed + CALL ZGESVD( 'O', 'A', N, NR, V, LDV, S, V, LDV, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* .. assemble V + DO 1115 p = 1, NR + V(p,p) = CONJG(V(p,p)) + DO 1116 q = p + 1, NR + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1116 CONTINUE + 1115 CONTINUE + IF ( NR .LT. N ) THEN + DO 1101 p = 1, NR + DO 1102 q = NR+1, N + V(p,q) = CONJG(V(q,p)) + 1102 CONTINUE + 1101 CONTINUE + END IF + CALL ZLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* + DO 1117 p = 1, NR + U(p,p) = CONJG(U(p,p)) + DO 1118 q = p + 1, NR + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1118 CONTINUE + 1117 CONTINUE +* + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. copy R**H into [V] and overwrite [V] with the left singular +* vectors of R**H +* [[The optimal ratio N/NR for using QRF instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'ZGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO*NR .GT. N ) THEN + DO 1198 p = 1, NR + DO 1199 q = p, N + V(q,p) = CONJG(A(p,q)) + 1199 CONTINUE + 1198 CONTINUE + IF ( NR .GT. 1 ) + $ CALL ZLASET('U',NR-1,NR-1, CZERO,CZERO, V(1,2),LDV) +* + CALL ZLASET('A',N,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL ZGESVD( 'O', 'A', N, N, V, LDV, S, V, LDV, + $ U, LDU, CWORK(N+1), LCWORK-N, RWORK, INFO ) +* + DO 1113 p = 1, N + V(p,p) = CONJG(V(p,p)) + DO 1114 q = p + 1, N + CTMP = CONJG(V(q,p)) + V(q,p) = CONJG(V(p,q)) + V(p,q) = CTMP + 1114 CONTINUE + 1113 CONTINUE + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). +* + DO 1111 p = 1, N + U(p,p) = CONJG(U(p,p)) + DO 1112 q = p + 1, N + CTMP = CONJG(U(q,p)) + U(q,p) = CONJG(U(p,q)) + U(p,q) = CTMP + 1112 CONTINUE + 1111 CONTINUE +* + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL ZLASET('A',M-N,N1-N,CZERO,CONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE +* .. copy R**H into [U] and overwrite [U] with the right +* singular vectors of R + DO 1196 p = 1, NR + DO 1197 q = p, N + U(q,NR+p) = CONJG(A(p,q)) + 1197 CONTINUE + 1196 CONTINUE + IF ( NR .GT. 1 ) + $ CALL ZLASET('U',NR-1,NR-1,CZERO,CZERO,U(1,NR+2),LDU) + CALL ZGEQRF( N, NR, U(1,NR+1), LDU, CWORK(N+1), + $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) + DO 1143 p = 1, NR + DO 1144 q = 1, N + V(q,p) = CONJG(U(p,NR+q)) + 1144 CONTINUE + 1143 CONTINUE + CALL ZLASET('U',NR-1,NR-1,CZERO,CZERO,V(1,2),LDV) + CALL ZGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V,LDV, CWORK(N+NR+1),LCWORK-N-NR,RWORK, INFO ) + CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) + CALL ZUNMQR('R','C', N, N, NR, U(1,NR+1), LDU, + $ CWORK(N+1),V,LDV,CWORK(N+NR+1),LCWORK-N-NR,IERR) + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1),LDU) + END IF + END IF + END IF + END IF +* + ELSE +* +* .. apply ZGESVD to R [[this is the recommended option]] +* + IF ( WNTVR .OR. ( NR .EQ. N ) ) THEN +* .. copy R into [V] and overwrite V with the right singular vectors + CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL ZLASET( 'L', NR-1,NR-1, CZERO,CZERO, V(2,1), LDV ) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL ZGESVD( 'S', 'O', NR, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL ZLAPMT( .FALSE., NR, N, V, LDV, IWORK ) +* .. now [V](1:NR,1:N) contains V(1:N,1:NR)**H +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A', M-NR,NR, CZERO,CZERO, U(NR+1,1), LDU) + IF ( NR .LT. N1 ) THEN + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF +* + ELSE +* .. need all N right singular vectors and NR < N +* .. the requested number of the left singular vectors +* is then N1 (N or M) +* [[The optimal ratio N/NR for using LQ instead of padding +* with zeros. Here hard coded to 2; it must be at least +* two due to work space constraints.]] +* OPTRATIO = ILAENV(6, 'ZGESVD', 'S' // 'O', NR,N,0,0) +* OPTRATIO = MAX( OPTRATIO, 2 ) + OPTRATIO = 2 + IF ( OPTRATIO * NR .GT. N ) THEN + CALL ZLACPY( 'U', NR, N, A, LDA, V, LDV ) + IF ( NR .GT. 1 ) + $ CALL ZLASET('L', NR-1,NR-1, CZERO,CZERO, V(2,1),LDV) +* .. the right singular vectors of R overwrite [V], the NR left +* singular vectors of R stored in [U](1:NR,1:NR) + CALL ZLASET('A', N-NR,N, CZERO,CZERO, V(NR+1,1),LDV) + CALL ZGESVD( 'S', 'O', N, N, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+1), LCWORK-N, RWORK, INFO ) + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. now [V] contains the adjoint of the matrix of the right +* singular vectors of A. The leading N left singular vectors +* are in [U](1:N,1:N) +* .. assemble the left singular vector matrix U of dimensions +* (M x N1), i.e. (M x N) or (M x M). + IF ( ( N .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A',M-N,N,CZERO,CZERO,U(N+1,1),LDU) + IF ( N .LT. N1 ) THEN + CALL ZLASET('A',N,N1-N,CZERO,CZERO,U(1,N+1),LDU) + CALL ZLASET( 'A',M-N,N1-N,CZERO,CONE, + $ U(N+1,N+1), LDU ) + END IF + END IF + ELSE + CALL ZLACPY( 'U', NR, N, A, LDA, U(NR+1,1), LDU ) + IF ( NR .GT. 1 ) + $ CALL ZLASET('L',NR-1,NR-1,CZERO,CZERO,U(NR+2,1),LDU) + CALL ZGELQF( NR, N, U(NR+1,1), LDU, CWORK(N+1), + $ CWORK(N+NR+1), LCWORK-N-NR, IERR ) + CALL ZLACPY('L',NR,NR,U(NR+1,1),LDU,V,LDV) + IF ( NR .GT. 1 ) + $ CALL ZLASET('U',NR-1,NR-1,CZERO,CZERO,V(1,2),LDV) + CALL ZGESVD( 'S', 'O', NR, NR, V, LDV, S, U, LDU, + $ V, LDV, CWORK(N+NR+1), LCWORK-N-NR, RWORK, INFO ) + CALL ZLASET('A',N-NR,NR,CZERO,CZERO,V(NR+1,1),LDV) + CALL ZLASET('A',NR,N-NR,CZERO,CZERO,V(1,NR+1),LDV) + CALL ZLASET('A',N-NR,N-NR,CZERO,CONE,V(NR+1,NR+1),LDV) + CALL ZUNMLQ('R','N',N,N,NR,U(NR+1,1),LDU,CWORK(N+1), + $ V, LDV, CWORK(N+NR+1),LCWORK-N-NR,IERR) + CALL ZLAPMT( .FALSE., N, N, V, LDV, IWORK ) +* .. assemble the left singular vector matrix U of dimensions +* (M x NR) or (M x N) or (M x M). + IF ( ( NR .LT. M ) .AND. .NOT.(WNTUF)) THEN + CALL ZLASET('A',M-NR,NR,CZERO,CZERO,U(NR+1,1),LDU) + IF ( NR .LT. N1 ) THEN + CALL ZLASET('A',NR,N1-NR,CZERO,CZERO,U(1,NR+1),LDU) + CALL ZLASET( 'A',M-NR,N1-NR,CZERO,CONE, + $ U(NR+1,NR+1), LDU ) + END IF + END IF + END IF + END IF +* .. end of the "R**H or R" branch + END IF +* +* The Q matrix from the first QRF is built into the left singular +* vectors matrix U. +* + IF ( .NOT. WNTUF ) + $ CALL ZUNMQR( 'L', 'N', M, N1, N, A, LDA, CWORK, U, + $ LDU, CWORK(N+1), LCWORK-N, IERR ) + IF ( ROWPRM .AND. .NOT.WNTUF ) + $ CALL ZLASWP( N1, U, LDU, 1, M-1, IWORK(N+1), -1 ) +* +* ... end of the "full SVD" branch + END IF +* +* Check whether some singular values are returned as zeros, e.g. +* due to underflow, and update the numerical rank. + p = NR + DO 4001 q = p, 1, -1 + IF ( S(q) .GT. ZERO ) GO TO 4002 + NR = NR - 1 + 4001 CONTINUE + 4002 CONTINUE +* +* .. if numerical rank deficiency is detected, the truncated +* singular values are set to zero. + IF ( NR .LT. N ) CALL DLASET( 'G', N-NR,1, ZERO,ZERO, S(NR+1), N ) +* .. undo scaling; this may cause overflow in the largest singular +* values. + IF ( ASCALED ) + $ CALL DLASCL( 'G',0,0, ONE,SQRT(DBLE(M)), NR,1, S, N, IERR ) + IF ( CONDA ) RWORK(1) = SCONDA + RWORK(2) = p - NR +* .. p-NR is the number of singular values that are computed as +* exact zeros in ZGESVD() applied to the (possibly truncated) +* full row rank triangular (trapezoidal) factor of A. + NUMRANK = NR +* + RETURN +* +* End of ZGESVDQ +* + END diff --git a/lapack-netlib/SRC/zgesvdx.f b/lapack-netlib/SRC/zgesvdx.f index 56b5cd4f2..12b20c0ba 100644 --- a/lapack-netlib/SRC/zgesvdx.f +++ b/lapack-netlib/SRC/zgesvdx.f @@ -18,7 +18,7 @@ * Definition: * =========== * -* SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, +* SUBROUTINE ZGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, * $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, * $ LWORK, RWORK, IWORK, INFO ) * diff --git a/lapack-netlib/SRC/zgesvj.f b/lapack-netlib/SRC/zgesvj.f index fd32f92d8..7c25a3495 100644 --- a/lapack-netlib/SRC/zgesvj.f +++ b/lapack-netlib/SRC/zgesvj.f @@ -89,12 +89,12 @@ *> Specifies whether to compute the right singular vectors, that *> is, the matrix V: *> = 'V' or 'J': the matrix V is computed and returned in the array V -*> = 'A' : the Jacobi rotations are applied to the MV-by-N +*> = 'A': the Jacobi rotations are applied to the MV-by-N *> array V. In other words, the right singular vector *> matrix V is not computed explicitly; instead it is *> applied to an MV-by-N matrix initially stored in the *> first MV rows of V. -*> = 'N' : the matrix V is not computed and the array V is not +*> = 'N': the matrix V is not computed and the array V is not *> referenced *> \endverbatim *> @@ -116,8 +116,8 @@ *> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, -*> If JOBU .EQ. 'U' .OR. JOBU .EQ. 'C': -*> If INFO .EQ. 0 : +*> If JOBU = 'U' .OR. JOBU = 'C': +*> If INFO = 0 : *> RANKA orthonormal columns of U are returned in the *> leading RANKA columns of the array A. Here RANKA <= N *> is the number of computed singular values of A that are @@ -127,9 +127,9 @@ *> in the array RWORK as RANKA=NINT(RWORK(2)). Also see the *> descriptions of SVA and RWORK. The computed columns of U *> are mutually numerically orthogonal up to approximately -*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU.EQ.'C'), +*> TOL=SQRT(M)*EPS (default); or TOL=CTOL*EPS (JOBU = 'C'), *> see the description of JOBU. -*> If INFO .GT. 0, +*> If INFO > 0, *> the procedure ZGESVJ did not converge in the given number *> of iterations (sweeps). In that case, the computed *> columns of U may not be orthogonal up to TOL. The output @@ -137,8 +137,8 @@ *> values in SVA(1:N)) and V is still a decomposition of the *> input matrix A in the sense that the residual *> || A - SCALE * U * SIGMA * V^* ||_2 / ||A||_2 is small. -*> If JOBU .EQ. 'N': -*> If INFO .EQ. 0 : +*> If JOBU = 'N': +*> If INFO = 0 : *> Note that the left singular vectors are 'for free' in the *> one-sided Jacobi SVD algorithm. However, if only the *> singular values are needed, the level of numerical @@ -147,7 +147,7 @@ *> numerically orthogonal up to approximately M*EPS. Thus, *> on exit, A contains the columns of U scaled with the *> corresponding singular values. -*> If INFO .GT. 0 : +*> If INFO > 0: *> the procedure ZGESVJ did not converge in the given number *> of iterations (sweeps). *> \endverbatim @@ -162,9 +162,9 @@ *> \verbatim *> SVA is DOUBLE PRECISION array, dimension (N) *> On exit, -*> If INFO .EQ. 0 : +*> If INFO = 0 : *> depending on the value SCALE = RWORK(1), we have: -*> If SCALE .EQ. ONE: +*> If SCALE = ONE: *> SVA(1:N) contains the computed singular values of A. *> During the computation SVA contains the Euclidean column *> norms of the iterated matrices in the array A. @@ -173,7 +173,7 @@ *> factored representation is due to the fact that some of the *> singular values of A might underflow or overflow. *> -*> If INFO .GT. 0 : +*> If INFO > 0: *> the procedure ZGESVJ did not converge in the given number of *> iterations (sweeps) and SCALE*SVA(1:N) may not be accurate. *> \endverbatim @@ -181,7 +181,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then the product of Jacobi rotations in ZGESVJ +*> If JOBV = 'A', then the product of Jacobi rotations in ZGESVJ *> is applied to the first MV rows of V. See the description of JOBV. *> \endverbatim *> @@ -199,16 +199,16 @@ *> \param[in] LDV *> \verbatim *> LDV is INTEGER -*> The leading dimension of the array V, LDV .GE. 1. -*> If JOBV .EQ. 'V', then LDV .GE. max(1,N). -*> If JOBV .EQ. 'A', then LDV .GE. max(1,MV) . +*> The leading dimension of the array V, LDV >= 1. +*> If JOBV = 'V', then LDV >= max(1,N). +*> If JOBV = 'A', then LDV >= max(1,MV) . *> \endverbatim *> *> \param[in,out] CWORK *> \verbatim *> CWORK is COMPLEX*16 array, dimension (max(1,LWORK)) *> Used as workspace. -*> If on entry LWORK .EQ. -1, then a workspace query is assumed and +*> If on entry LWORK = -1, then a workspace query is assumed and *> no computation is done; CWORK(1) is set to the minial (and optimal) *> length of CWORK. *> \endverbatim @@ -223,7 +223,7 @@ *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (max(6,LRWORK)) *> On entry, -*> If JOBU .EQ. 'C' : +*> If JOBU = 'C' : *> RWORK(1) = CTOL, where CTOL defines the threshold for convergence. *> The process stops if all columns of A are mutually *> orthogonal up to CTOL*EPS, EPS=DLAMCH('E'). @@ -243,11 +243,11 @@ *> RWORK(5) = max_{i.NE.j} |COS(A(:,i),A(:,j))| in the last sweep. *> This is useful information in cases when ZGESVJ did *> not converge, as it can be used to estimate whether -*> the output is stil useful and for post festum analysis. +*> the output is still useful and for post festum analysis. *> RWORK(6) = the largest absolute value over all sines of the *> Jacobi rotation angles in the last sweep. It can be *> useful for a post festum analysis. -*> If on entry LRWORK .EQ. -1, then a workspace query is assumed and +*> If on entry LRWORK = -1, then a workspace query is assumed and *> no computation is done; RWORK(1) is set to the minial (and optimal) *> length of RWORK. *> \endverbatim @@ -261,9 +261,9 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value -*> > 0 : ZGESVJ did not converge in the maximal allowed number +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value +*> > 0: ZGESVJ did not converge in the maximal allowed number *> (NSWEEP=30) of sweeps. The output may still be useful. *> See the description of RWORK. *> \endverbatim diff --git a/lapack-netlib/SRC/zgesvxx.f b/lapack-netlib/SRC/zgesvxx.f index c3727b70e..60bb71cd3 100644 --- a/lapack-netlib/SRC/zgesvxx.f +++ b/lapack-netlib/SRC/zgesvxx.f @@ -411,7 +411,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -447,14 +447,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -462,9 +462,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/zgetsls.f b/lapack-netlib/SRC/zgetsls.f index 5ce11efef..1aab3c662 100644 --- a/lapack-netlib/SRC/zgetsls.f +++ b/lapack-netlib/SRC/zgetsls.f @@ -1,3 +1,5 @@ +*> \brief \b ZGETSLS +* * Definition: * =========== * diff --git a/lapack-netlib/SRC/zggesx.f b/lapack-netlib/SRC/zggesx.f index 661523465..c546e61f1 100644 --- a/lapack-netlib/SRC/zggesx.f +++ b/lapack-netlib/SRC/zggesx.f @@ -120,10 +120,10 @@ *> \verbatim *> SENSE is CHARACTER*1 *> Determines which reciprocal condition numbers are computed. -*> = 'N' : None are computed; -*> = 'E' : Computed for average of selected eigenvalues only; -*> = 'V' : Computed for selected deflating subspaces only; -*> = 'B' : Computed for both. +*> = 'N': None are computed; +*> = 'E': Computed for average of selected eigenvalues only; +*> = 'V': Computed for selected deflating subspaces only; +*> = 'B': Computed for both. *> If SENSE = 'E', 'V', or 'B', SORT must equal 'S'. *> \endverbatim *> diff --git a/lapack-netlib/SRC/zgsvj0.f b/lapack-netlib/SRC/zgsvj0.f index c4a6bd38a..ab7e31725 100644 --- a/lapack-netlib/SRC/zgsvj0.f +++ b/lapack-netlib/SRC/zgsvj0.f @@ -117,7 +117,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -125,9 +125,9 @@ *> \param[in,out] V *> \verbatim *> V is COMPLEX*16 array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -136,8 +136,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -157,7 +157,7 @@ *> TOL is DOUBLE PRECISION *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -175,14 +175,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/zgsvj1.f b/lapack-netlib/SRC/zgsvj1.f index 91e39ca8a..f0a23034b 100644 --- a/lapack-netlib/SRC/zgsvj1.f +++ b/lapack-netlib/SRC/zgsvj1.f @@ -61,7 +61,7 @@ *> In terms of the columns of A, the first N1 columns are rotated 'against' *> the remaining N-N1 columns, trying to increase the angle between the *> corresponding subspaces. The off-diagonal block is N1-by(N-N1) and it is -*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parmeter. +*> tiled using quadratic tiles of side KBL. Here, KBL is a tunning parameter. *> The number of sweeps is given in NSWEEP and the orthogonality threshold *> is given in TOL. *> \endverbatim @@ -147,7 +147,7 @@ *> \param[in] MV *> \verbatim *> MV is INTEGER -*> If JOBV .EQ. 'A', then MV rows of V are post-multipled by a +*> If JOBV = 'A', then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then MV is not referenced. *> \endverbatim @@ -155,9 +155,9 @@ *> \param[in,out] V *> \verbatim *> V is COMPLEX*16 array, dimension (LDV,N) -*> If JOBV .EQ. 'V' then N rows of V are post-multipled by a +*> If JOBV = 'V' then N rows of V are post-multipled by a *> sequence of Jacobi rotations. -*> If JOBV .EQ. 'A' then MV rows of V are post-multipled by a +*> If JOBV = 'A' then MV rows of V are post-multipled by a *> sequence of Jacobi rotations. *> If JOBV = 'N', then V is not referenced. *> \endverbatim @@ -166,8 +166,8 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of the array V, LDV >= 1. -*> If JOBV = 'V', LDV .GE. N. -*> If JOBV = 'A', LDV .GE. MV. +*> If JOBV = 'V', LDV >= N. +*> If JOBV = 'A', LDV >= MV. *> \endverbatim *> *> \param[in] EPS @@ -187,7 +187,7 @@ *> TOL is DOUBLE PRECISION *> TOL is the threshold for Jacobi rotations. For a pair *> A(:,p), A(:,q) of pivot columns, the Jacobi rotation is -*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) .GT. TOL. +*> applied only if ABS(COS(angle(A(:,p),A(:,q)))) > TOL. *> \endverbatim *> *> \param[in] NSWEEP @@ -205,14 +205,14 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> LWORK is the dimension of WORK. LWORK .GE. M. +*> LWORK is the dimension of WORK. LWORK >= M. *> \endverbatim *> *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0 : successful exit. -*> < 0 : if INFO = -i, then the i-th argument had an illegal value +*> = 0: successful exit. +*> < 0: if INFO = -i, then the i-th argument had an illegal value *> \endverbatim * * Authors: diff --git a/lapack-netlib/SRC/zhb2st_kernels.f b/lapack-netlib/SRC/zhb2st_kernels.f index a440b5c0d..2c0cb6870 100644 --- a/lapack-netlib/SRC/zhb2st_kernels.f +++ b/lapack-netlib/SRC/zhb2st_kernels.f @@ -1,26 +1,26 @@ *> \brief \b ZHB2ST_KERNELS * * @precisions fortran z -> s d c -* +* * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download ZHB2ST_KERNELS + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZHB2ST_KERNELS + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, +* SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, * ST, ED, SWEEP, N, NB, IB, * A, LDA, V, TAU, LDVT, WORK) * @@ -32,9 +32,9 @@ * INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. -* COMPLEX*16 A( LDA, * ), V( * ), +* COMPLEX*16 A( LDA, * ), V( * ), * TAU( * ), WORK( * ) -* +* *> \par Purpose: * ============= *> @@ -124,7 +124,7 @@ *> LDVT is INTEGER. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array. Workspace of size nb. *> \endverbatim @@ -147,7 +147,7 @@ *> http://doi.acm.org/10.1145/2063384.2063394 *> *> A. Haidar, J. Kurzak, P. Luszczek, 2013. -*> An improved parallel singular value algorithm and its implementation +*> An improved parallel singular value algorithm and its implementation *> for multicore hardware, In Proceedings of 2013 International Conference *> for High Performance Computing, Networking, Storage and Analysis (SC '13). *> Denver, Colorado, USA, 2013. @@ -155,16 +155,16 @@ *> http://doi.acm.org/10.1145/2503210.2503292 *> *> A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra. -*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure +*> A novel hybrid CPU-GPU generalized eigensolver for electronic structure *> calculations based on fine-grained memory aware tasks. *> International Journal of High Performance Computing Applications. *> Volume 28 Issue 2, Pages 196-209, May 2014. -*> http://hpc.sagepub.com/content/28/2/196 +*> http://hpc.sagepub.com/content/28/2/196 *> *> \endverbatim *> * ===================================================================== - SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, + SUBROUTINE ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE, $ ST, ED, SWEEP, N, NB, IB, $ A, LDA, V, TAU, LDVT, WORK) * @@ -181,7 +181,7 @@ INTEGER TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), V( * ), + COMPLEX*16 A( LDA, * ), V( * ), $ TAU( * ), WORK( * ) * .. * @@ -195,8 +195,8 @@ * .. Local Scalars .. LOGICAL UPPER INTEGER I, J1, J2, LM, LN, VPOS, TAUPOS, - $ DPOS, OFDPOS, AJETER - COMPLEX*16 CTMP + $ DPOS, OFDPOS, AJETER + COMPLEX*16 CTMP * .. * .. External Subroutines .. EXTERNAL ZLARFG, ZLARFX, ZLARFY @@ -209,7 +209,7 @@ * .. * .. * .. Executable Statements .. -* +* AJETER = IB + LDVT UPPER = LSAME( UPLO, 'U' ) @@ -240,10 +240,10 @@ V( VPOS ) = ONE DO 10 I = 1, LM-1 V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO + A( OFDPOS-I, ST+I ) = ZERO 10 CONTINUE CTMP = DCONJG( A( OFDPOS, ST ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) A( OFDPOS, ST ) = CTMP * @@ -281,14 +281,14 @@ * V( VPOS ) = ONE DO 30 I = 1, LM-1 - V( VPOS+I ) = + V( VPOS+I ) = $ DCONJG( A( DPOS-NB-I, J1+I ) ) A( DPOS-NB-I, J1+I ) = ZERO 30 CONTINUE CTMP = DCONJG( A( DPOS-NB, J1 ) ) CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) A( DPOS-NB, J1 ) = CTMP -* +* CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), $ TAU( TAUPOS ), $ A( DPOS-NB+1, J1 ), LDA-1, WORK) @@ -296,9 +296,9 @@ ENDIF * * Lower case -* +* ELSE -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -313,9 +313,9 @@ V( VPOS ) = ONE DO 20 I = 1, LM-1 V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO + A( OFDPOS+I, ST-1 ) = ZERO 20 CONTINUE - CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * LM = ED - ST + 1 @@ -342,7 +342,7 @@ LM = J2-J1+1 * IF( LM.GT.0) THEN - CALL ZLARFX( 'Right', LM, LN, V( VPOS ), + CALL ZLARFX( 'Right', LM, LN, V( VPOS ), $ TAU( TAUPOS ), A( DPOS+NB, ST ), $ LDA-1, WORK) * @@ -359,13 +359,13 @@ V( VPOS+I ) = A( DPOS+NB+I, ST ) A( DPOS+NB+I, ST ) = ZERO 40 CONTINUE - CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, $ TAU( TAUPOS ) ) * - CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), + CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), $ DCONJG( TAU( TAUPOS ) ), $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) - + ENDIF ENDIF ENDIF @@ -374,4 +374,4 @@ * * END OF ZHB2ST_KERNELS * - END + END diff --git a/lapack-netlib/SRC/zhecon_3.f b/lapack-netlib/SRC/zhecon_3.f index 8c3a9f32b..9d2a240b6 100644 --- a/lapack-netlib/SRC/zhecon_3.f +++ b/lapack-netlib/SRC/zhecon_3.f @@ -19,7 +19,7 @@ * =========== * * SUBROUTINE ZHECON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, -* WORK, IWORK, INFO ) +* WORK, INFO ) * * .. Scalar Arguments .. * CHARACTER UPLO @@ -27,7 +27,7 @@ * DOUBLE PRECISION ANORM, RCOND * .. * .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) +* INTEGER IPIV( * ) * COMPLEX*16 A( LDA, * ), E ( * ), WORK( * ) * .. * @@ -129,11 +129,6 @@ *> WORK is COMPLEX*16 array, dimension (2*N) *> \endverbatim *> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> *> \param[out] INFO *> \verbatim *> INFO is INTEGER diff --git a/lapack-netlib/SRC/zheevr.f b/lapack-netlib/SRC/zheevr.f index 810373c83..def2d1f9d 100644 --- a/lapack-netlib/SRC/zheevr.f +++ b/lapack-netlib/SRC/zheevr.f @@ -210,7 +210,7 @@ *> eigenvalues are computed to high relative accuracy when *> possible in future releases. The current code does not *> make any guarantees about high relative accuracy, but -*> furutre releases will. See J. Barlow and J. Demmel, +*> future releases will. See J. Barlow and J. Demmel, *> "Computing Accurate Eigensystems of Scaled Diagonally *> Dominant Matrices", LAPACK Working Note #7, for a discussion *> of which matrices define their eigenvalues to high relative diff --git a/lapack-netlib/SRC/zheevr_2stage.f b/lapack-netlib/SRC/zheevr_2stage.f index ab7f3374e..fe4a72160 100644 --- a/lapack-netlib/SRC/zheevr_2stage.f +++ b/lapack-netlib/SRC/zheevr_2stage.f @@ -217,7 +217,7 @@ *> eigenvalues are computed to high relative accuracy when *> possible in future releases. The current code does not *> make any guarantees about high relative accuracy, but -*> furutre releases will. See J. Barlow and J. Demmel, +*> future releases will. See J. Barlow and J. Demmel, *> "Computing Accurate Eigensystems of Scaled Diagonally *> Dominant Matrices", LAPACK Working Note #7, for a discussion *> of which matrices define their eigenvalues to high relative diff --git a/lapack-netlib/SRC/zhegs2.f b/lapack-netlib/SRC/zhegs2.f index 0bdc653b9..aec526353 100644 --- a/lapack-netlib/SRC/zhegs2.f +++ b/lapack-netlib/SRC/zhegs2.f @@ -97,6 +97,7 @@ *> B is COMPLEX*16 array, dimension (LDB,N) *> The triangular factor from the Cholesky factorization of B, *> as returned by ZPOTRF. +*> B is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDB diff --git a/lapack-netlib/SRC/zhegst.f b/lapack-netlib/SRC/zhegst.f index d0c08a8f6..dcf5fe8b5 100644 --- a/lapack-netlib/SRC/zhegst.f +++ b/lapack-netlib/SRC/zhegst.f @@ -97,6 +97,7 @@ *> B is COMPLEX*16 array, dimension (LDB,N) *> The triangular factor from the Cholesky factorization of B, *> as returned by ZPOTRF. +*> B is modified by the routine but restored on exit. *> \endverbatim *> *> \param[in] LDB diff --git a/lapack-netlib/SRC/zherfsx.f b/lapack-netlib/SRC/zherfsx.f index d176b102c..fa11702a8 100644 --- a/lapack-netlib/SRC/zherfsx.f +++ b/lapack-netlib/SRC/zherfsx.f @@ -102,7 +102,7 @@ *> \param[in] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular *> part of the matrix A, and the strictly lower triangular *> part of A is not referenced. If UPLO = 'L', the leading @@ -270,7 +270,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -306,14 +306,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -321,9 +321,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/zhesv_aa.f b/lapack-netlib/SRC/zhesv_aa.f index 8511f0e7d..5f1a9f4b3 100644 --- a/lapack-netlib/SRC/zhesv_aa.f +++ b/lapack-netlib/SRC/zhesv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or +*> A = U**H * T * U, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is Hermitian and tridiagonal. The factored form @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**H or A = L*T*L**H as computed by +*> factorization A = U**H*T*U or A = L*T*L**H as computed by *> ZHETRF_AA. *> \endverbatim *> @@ -230,7 +230,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**H*T*U or A = L*T*L**H. * CALL ZHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/zhesv_aa_2stage.f b/lapack-netlib/SRC/zhesv_aa_2stage.f index ed221dc69..7a4e35f45 100644 --- a/lapack-netlib/SRC/zhesv_aa_2stage.f +++ b/lapack-netlib/SRC/zhesv_aa_2stage.f @@ -44,7 +44,7 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or +*> A = U**H * T * U, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is Hermitian and band. The matrix T is @@ -211,9 +211,7 @@ * * .. Local Scalars .. LOGICAL UPPER, TQUERY, WQUERY - INTEGER I, J, K, I1, I2, TD - INTEGER LDTB, LWKOPT, NB, KB, NT, IINFO - COMPLEX PIV + INTEGER LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -263,7 +261,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**H*T*U or A = L*T*L**H. * CALL ZHETRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/zhesvxx.f b/lapack-netlib/SRC/zhesvxx.f index 375fc072d..20168185c 100644 --- a/lapack-netlib/SRC/zhesvxx.f +++ b/lapack-netlib/SRC/zhesvxx.f @@ -46,7 +46,7 @@ *> *> ZHESVXX uses the diagonal pivoting factorization to compute the *> solution to a complex*16 system of linear equations A * X = B, where -*> A is an N-by-N symmetric matrix and X and B are N-by-NRHS +*> A is an N-by-N Hermitian matrix and X and B are N-by-NRHS *> matrices. *> *> If requested, both normwise and maximum componentwise error bounds @@ -88,7 +88,7 @@ *> A = L * D * L**T, if UPLO = 'L', *> *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and D is symmetric and block diagonal with +*> triangular matrices, and D is Hermitian and block diagonal with *> 1-by-1 and 2-by-2 diagonal blocks. *> *> 3. If some D(i,i)=0, so that D is exactly singular, then the @@ -161,7 +161,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular *> part of the matrix A, and the strictly lower triangular *> part of A is not referenced. If UPLO = 'L', the leading @@ -378,7 +378,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -414,14 +414,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -429,9 +429,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/zhetf2_rk.f b/lapack-netlib/SRC/zhetf2_rk.f index 84d3a0248..6578214df 100644 --- a/lapack-netlib/SRC/zhetf2_rk.f +++ b/lapack-netlib/SRC/zhetf2_rk.f @@ -322,7 +322,7 @@ * * Factorize A as U*D*U**H using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -676,7 +676,7 @@ * * Factorize A as L*D*L**H using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/zhetrd_2stage.f b/lapack-netlib/SRC/zhetrd_2stage.f index 9d6a426a3..1a2c00a2f 100644 --- a/lapack-netlib/SRC/zhetrd_2stage.f +++ b/lapack-netlib/SRC/zhetrd_2stage.f @@ -123,23 +123,22 @@ *> *> \param[out] HOUS2 *> \verbatim -*> HOUS2 is COMPLEX*16 array, dimension LHOUS2, that -*> store the Householder representation of the stage2 +*> HOUS2 is COMPLEX*16 array, dimension (LHOUS2) +*> Stores the Householder representation of the stage2 *> band to tridiagonal. *> \endverbatim *> *> \param[in] LHOUS2 *> \verbatim *> LHOUS2 is INTEGER -*> The dimension of the array HOUS2. LHOUS2 = MAX(1, dimension) -*> If LWORK = -1, or LHOUS2=-1, +*> The dimension of the array HOUS2. +*> If LWORK = -1, or LHOUS2 = -1, *> then a query is assumed; the routine *> only calculates the optimal size of the HOUS2 array, returns *> this value as the first entry of the HOUS2 array, and no error *> message related to LHOUS2 is issued by XERBLA. -*> LHOUS2 = MAX(1, dimension) where -*> dimension = 4*N if VECT='N' -*> not available now if VECT='H' +*> If VECT='N', LHOUS2 = max(1, 4*n); +*> if VECT='V', option not yet available. *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/zhetrd_hb2st.F b/lapack-netlib/SRC/zhetrd_hb2st.F index 86122cccc..4ba7bfc21 100644 --- a/lapack-netlib/SRC/zhetrd_hb2st.F +++ b/lapack-netlib/SRC/zhetrd_hb2st.F @@ -50,9 +50,9 @@ * Arguments: * ========== * -*> \param[in] STAGE +*> \param[in] STAGE1 *> \verbatim -*> STAGE is CHARACTER*1 +*> STAGE1 is CHARACTER*1 *> = 'N': "No": to mention that the stage 1 of the reduction *> from dense to band using the zhetrd_he2hb routine *> was not called before this routine to reproduce AB. diff --git a/lapack-netlib/SRC/zhetrd_he2hb.f b/lapack-netlib/SRC/zhetrd_he2hb.f index e33bf4b2b..b85b3889a 100644 --- a/lapack-netlib/SRC/zhetrd_he2hb.f +++ b/lapack-netlib/SRC/zhetrd_he2hb.f @@ -363,7 +363,7 @@ * * * Set the workspace of the triangular matrix T to zero once such a -* way everytime T is generated the upper/lower portion will be always zero +* way every time T is generated the upper/lower portion will be always zero * CALL ZLASET( "A", LDT, KD, ZERO, ZERO, WORK( TPOS ), LDT ) * diff --git a/lapack-netlib/SRC/zhetrf_aa.f b/lapack-netlib/SRC/zhetrf_aa.f index e355aed14..b80a84118 100644 --- a/lapack-netlib/SRC/zhetrf_aa.f +++ b/lapack-netlib/SRC/zhetrf_aa.f @@ -37,7 +37,7 @@ *> ZHETRF_AA computes the factorization of a complex hermitian matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**H or A = L*T*L**H +*> A = U**H*T*U or A = L*T*L**H *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a hermitian tridiagonal matrix. @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**H using the upper triangle of A +* Factorize A as U**H*D*U using the upper triangle of A * ..................................................... * * copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -376,7 +376,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/zhetrf_aa_2stage.f b/lapack-netlib/SRC/zhetrf_aa_2stage.f index 73c0ebe9a..f63713664 100644 --- a/lapack-netlib/SRC/zhetrf_aa_2stage.f +++ b/lapack-netlib/SRC/zhetrf_aa_2stage.f @@ -38,7 +38,7 @@ *> ZHETRF_AA_2STAGE computes the factorization of a double hermitian matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**H*T*U or A = L*T*L**H *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a hermitian band matrix with the @@ -66,7 +66,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is COMPLEX array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the hermitian matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower @@ -87,7 +87,7 @@ *> *> \param[out] TB *> \verbatim -*> TB is COMPLEX array, dimension (LTB) +*> TB is COMPLEX*16 array, dimension (LTB) *> On exit, details of the LU factorization of the band matrix. *> \endverbatim *> @@ -121,7 +121,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is COMPLEX workspace of size LWORK +*> WORK is COMPLEX*16 workspace of size LWORK *> \endverbatim *> *> \param[in] LWORK @@ -276,7 +276,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**H*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -452,14 +452,17 @@ c END IF * > Apply pivots to previous columns of L CALL ZSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) THEN + CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) + CALL ZLACGV( I2-I1-1, A( I1+1, I2 ), 1 ) + END IF CALL ZLACGV( I2-I1, A( I1, I1+1 ), LDA ) - CALL ZLACGV( I2-I1-1, A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -476,7 +479,7 @@ c END IF ELSE * * ..................................................... -* Factorize A as L*D*L**T using the lower triangle of A +* Factorize A as L*D*L**H using the lower triangle of A * ..................................................... * DO J = 0, NT-1 @@ -629,14 +632,17 @@ c END IF * > Apply pivots to previous columns of L CALL ZSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) THEN + CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) + CALL ZLACGV( I2-I1-1, A( I2, I1+1 ), LDA ) + END IF CALL ZLACGV( I2-I1, A( I1+1, I1 ), 1 ) - CALL ZLACGV( I2-I1-1, A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL ZSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL ZSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/zhetri2.f b/lapack-netlib/SRC/zhetri2.f index a7acff49f..ae43b14fe 100644 --- a/lapack-netlib/SRC/zhetri2.f +++ b/lapack-netlib/SRC/zhetri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by ZHETRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by ZHETRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/zhetrs_aa.f b/lapack-netlib/SRC/zhetrs_aa.f index 9d302b9cd..4b3253abc 100644 --- a/lapack-netlib/SRC/zhetrs_aa.f +++ b/lapack-netlib/SRC/zhetrs_aa.f @@ -38,8 +38,8 @@ *> \verbatim *> *> ZHETRS_AA solves a system of linear equations A*X = B with a complex -*> hermitian matrix A using the factorization A = U*T*U**H or -*> A = L*T*L**T computed by ZHETRF_AA. +*> hermitian matrix A using the factorization A = U**H*T*U or +*> A = L*T*L**H computed by ZHETRF_AA. *> \endverbatim * * Arguments: @@ -50,7 +50,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**H; +*> = 'U': Upper triangular, form is A = U**H*T*U; *> = 'L': Lower triangular, form is A = L*T*L**H. *> \endverbatim *> @@ -98,14 +98,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -199,61 +201,80 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**H*T*U. * -* Pivot, P**T * B +* 1) Forward substitution with U**H * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + IF( N.GT.1 ) THEN * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] +* Pivot, P**T * B -> B * - CALL ZTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute U**H \ B -> B [ (U**H \P**T * B) ] * - CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) + CALL ZTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB ) + END IF +* +* 2) Solve with triangular matrix T +* +* Compute T \ B -> B [ T \ (U**H \P**T * B) ] +* + CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1 ) IF( N.GT.1 ) THEN CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1) - CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1) + CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 ) CALL ZLACGV( N-1, WORK( 1 ), 1 ) END IF - CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, - $ INFO) + CALL ZGTSV( N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, + $ INFO ) +* +* 3) Backward substitution with U +* + IF( N.GT.1 ) THEN * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* Compute U \ B -> B [ U \ (T \ (U**H \P**T * B) ) ] * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B(2, 1), LDB) + CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B(2, 1), LDB) * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] +* Pivot, P * B [ P * (U**H \ (T \ (U \P**T * B) )) ] * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * ELSE * -* Solve A*X = B, where A = L*T*L**T. +* Solve A*X = B, where A = L*T*L**H. +* +* 1) Forward substitution with L * -* Pivot, P**T * B + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute L \ B -> B [ (L \P**T * B) ] * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B(2, 1), LDB) + CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B(2, 1), LDB) + END IF +* +* 2) Solve with triangular matrix T * * Compute T \ B -> B [ T \ (L \P**T * B) ] * @@ -266,18 +287,23 @@ CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**H +* + IF( N.GT.1 ) THEN * - CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) +* Compute L**H \ B -> B [ L**H \ (T \ (L \P**T * B) ) ] * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] + CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Pivot, P * B [ P * (L**H \ (T \ (L \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/zhetrs_aa_2stage.f b/lapack-netlib/SRC/zhetrs_aa_2stage.f index 7fcee1118..c621bd571 100644 --- a/lapack-netlib/SRC/zhetrs_aa_2stage.f +++ b/lapack-netlib/SRC/zhetrs_aa_2stage.f @@ -38,8 +38,8 @@ *> \verbatim *> *> ZHETRS_AA_2STAGE solves a system of linear equations A*X = B with a -*> hermitian matrix A using the factorization A = U*T*U**T or -*> A = L*T*L**T computed by ZHETRF_AA_2STAGE. +*> hermitian matrix A using the factorization A = U**H*T*U or +*> A = L*T*L**H computed by ZHETRF_AA_2STAGE. *> \endverbatim * * Arguments: @@ -50,8 +50,8 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; -*> = 'L': Lower triangular, form is A = L*T*L**T. +*> = 'U': Upper triangular, form is A = U**H*T*U; +*> = 'L': Lower triangular, form is A = L*T*L**H. *> \endverbatim *> *> \param[in] N @@ -210,33 +210,33 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**H*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**H \ B) -> B [ (U**H \P**T * B) ] * CALL ZTRSM( 'L', 'U', 'C', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * END IF * -* Compute T \ B -> B [ T \ (U**T \P**T * B) ] +* Compute T \ B -> B [ T \ (U**H \P**T * B) ] * CALL ZGBTRS( 'N', N, NB, NB, NRHS, TB, LDTB, IPIV2, B, LDB, $ INFO) IF( N.GT.NB ) THEN * -* Compute (U \ B) -> B [ U \ (T \ (U**T \P**T * B) ) ] +* Compute (U \ B) -> B [ U \ (T \ (U**H \P**T * B) ) ] * CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**H \P**T * B) )) ] * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * @@ -244,15 +244,15 @@ * ELSE * -* Solve A*X = B, where A = L*T*L**T. +* Solve A*X = B, where A = L*T*L**H. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute (L \ B) -> B [ (L \P**T * B) ] * CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) @@ -265,12 +265,12 @@ $ INFO) IF( N.GT.NB ) THEN * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* Compute (L**H \ B) -> B [ L**H \ (T \ (L \P**T * B) ) ] * CALL ZTRSM( 'L', 'L', 'C', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Pivot, P * B -> B [ P * (L**H \ (T \ (L \P**T * B) )) ] * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * diff --git a/lapack-netlib/SRC/zhseqr.f b/lapack-netlib/SRC/zhseqr.f index 1e8134c39..2ee874dfd 100644 --- a/lapack-netlib/SRC/zhseqr.f +++ b/lapack-netlib/SRC/zhseqr.f @@ -69,7 +69,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -86,7 +86,7 @@ *> set by a previous call to ZGEBAL, and then passed to ZGEHRD *> when the matrix output by ZGEBAL is reduced to Hessenberg *> form. Otherwise ILO and IHI should be set to 1 and N -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -98,17 +98,17 @@ *> triangular matrix T from the Schur decomposition (the *> Schur form). If INFO = 0 and JOB = 'E', the contents of *> H are unspecified on exit. (The output value of H when -*> INFO.GT.0 is given under the description of INFO below.) +*> INFO > 0 is given under the description of INFO below.) *> *> Unlike earlier versions of ZHSEQR, this subroutine may -*> explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1 +*> explicitly H(i,j) = 0 for i > j and j = 1, 2, ... ILO-1 *> or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -131,7 +131,7 @@ *> if INFO = 0, Z contains Q*Z. *> Normally Q is the unitary matrix generated by ZUNGHR *> after the call to ZGEHRD which formed the Hessenberg matrix -*> H. (The output value of Z when INFO.GT.0 is given under +*> H. (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -139,7 +139,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if COMPZ = 'I' or -*> COMPZ = 'V', then LDZ.GE.MAX(1,N). Otherwize, LDZ.GE.1. +*> COMPZ = 'V', then LDZ >= MAX(1,N). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -152,7 +152,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient and delivers very good and sometimes *> optimal performance. However, LWORK as large as 11*N *> may be required for optimal performance. A workspace @@ -170,21 +170,21 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .LT. 0: if INFO = -i, the i-th argument had an illegal +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal *> value -*> .GT. 0: if INFO = i, ZHSEQR failed to compute all of -*> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR -*> and WI contain those eigenvalues which have been +*> > 0: if INFO = i, ZHSEQR failed to compute all of +*> the eigenvalues. Elements 1:ilo-1 and i+1:n of W +*> contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and JOB = 'E', then on exit, the +*> If INFO > 0 and JOB = 'E', then on exit, the *> remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and JOB = 'S', then on exit +*> If INFO > 0 and JOB = 'S', then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -192,19 +192,19 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and COMPZ = 'V', then on exit +*> If INFO > 0 and COMPZ = 'V', then on exit *> *> (final value of Z) = (initial value of Z)*U *> *> where U is the unitary matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'I', then on exit +*> If INFO > 0 and COMPZ = 'I', then on exit *> (final value of Z) = U *> where U is the unitary matrix in (*) (regard- *> less of the value of JOB.) *> -*> If INFO .GT. 0 and COMPZ = 'N', then Z is not +*> If INFO > 0 and COMPZ = 'N', then Z is not *> accessed. *> \endverbatim * @@ -244,8 +244,8 @@ *> This depends on ILO, IHI and NS. NS is the *> number of simultaneous shifts returned *> by ILAENV(ISPEC=15). (See ISPEC=15 below.) -*> The default for (IHI-ILO+1).LE.500 is NS. -*> The default for (IHI-ILO+1).GT.500 is 3*NS/2. +*> The default for (IHI-ILO+1) <= 500 is NS. +*> The default for (IHI-ILO+1) > 500 is 3*NS/2. *> *> ISPEC=14: Nibble crossover point. (See IPARMQ for *> details.) Default: 14% of deflation window @@ -323,8 +323,8 @@ PARAMETER ( NTINY = 11 ) * * ==== NL allocates some local workspace to help small matrices -* . through a rare ZLAHQR failure. NL .GT. NTINY = 11 is -* . required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom- +* . through a rare ZLAHQR failure. NL > NTINY = 11 is +* . required and NL <= NMIN = ILAENV(ISPEC=12,...) is recom- * . mended. (The default value of NMIN is 75.) Using NL = 49 * . allows up to six simultaneous shifts and a 16-by-16 * . deflation window. ==== diff --git a/lapack-netlib/SRC/zla_gbrcond_c.f b/lapack-netlib/SRC/zla_gbrcond_c.f index 20109124b..5b2dc46fc 100644 --- a/lapack-netlib/SRC/zla_gbrcond_c.f +++ b/lapack-netlib/SRC/zla_gbrcond_c.f @@ -133,13 +133,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_gbrcond_x.f b/lapack-netlib/SRC/zla_gbrcond_x.f index 7e6c12ea5..17e9eede7 100644 --- a/lapack-netlib/SRC/zla_gbrcond_x.f +++ b/lapack-netlib/SRC/zla_gbrcond_x.f @@ -126,13 +126,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_gbrfsx_extended.f b/lapack-netlib/SRC/zla_gbrfsx_extended.f index 7a850f1aa..a22b5592e 100644 --- a/lapack-netlib/SRC/zla_gbrfsx_extended.f +++ b/lapack-netlib/SRC/zla_gbrfsx_extended.f @@ -65,19 +65,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -269,7 +269,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/zla_gercond_c.f b/lapack-netlib/SRC/zla_gercond_c.f index e629f90e8..a1c0df588 100644 --- a/lapack-netlib/SRC/zla_gercond_c.f +++ b/lapack-netlib/SRC/zla_gercond_c.f @@ -22,7 +22,7 @@ * LDAF, IPIV, C, CAPPLY, * INFO, WORK, RWORK ) * -* .. Scalar Aguments .. +* .. Scalar Arguments .. * CHARACTER TRANS * LOGICAL CAPPLY * INTEGER N, LDA, LDAF, INFO @@ -114,13 +114,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. @@ -148,7 +148,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * -* .. Scalar Aguments .. +* .. Scalar Arguments .. CHARACTER TRANS LOGICAL CAPPLY INTEGER N, LDA, LDAF, INFO diff --git a/lapack-netlib/SRC/zla_gercond_x.f b/lapack-netlib/SRC/zla_gercond_x.f index 244bf58a3..3aa63ea84 100644 --- a/lapack-netlib/SRC/zla_gercond_x.f +++ b/lapack-netlib/SRC/zla_gercond_x.f @@ -107,13 +107,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_gerfsx_extended.f b/lapack-netlib/SRC/zla_gerfsx_extended.f index 2e93e265e..e42ffa8e2 100644 --- a/lapack-netlib/SRC/zla_gerfsx_extended.f +++ b/lapack-netlib/SRC/zla_gerfsx_extended.f @@ -64,19 +64,19 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] TRANS_TYPE *> \verbatim *> TRANS_TYPE is INTEGER *> Specifies the transposition operation on A. -*> The value is defined by ILATRANS(T) where T is a CHARACTER and -*> T = 'N': No transpose +*> The value is defined by ILATRANS(T) where T is a CHARACTER and T +*> = 'N': No transpose *> = 'T': Transpose *> = 'C': Conjugate transpose *> \endverbatim @@ -256,7 +256,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERRS_C is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERRS_C is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERRS_C(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/zla_hercond_c.f b/lapack-netlib/SRC/zla_hercond_c.f index 61cfe95f1..7c933cc3c 100644 --- a/lapack-netlib/SRC/zla_hercond_c.f +++ b/lapack-netlib/SRC/zla_hercond_c.f @@ -111,13 +111,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_hercond_x.f b/lapack-netlib/SRC/zla_hercond_x.f index 9c19b487d..ee283c0b5 100644 --- a/lapack-netlib/SRC/zla_hercond_x.f +++ b/lapack-netlib/SRC/zla_hercond_x.f @@ -104,13 +104,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_herfsx_extended.f b/lapack-netlib/SRC/zla_herfsx_extended.f index 5b43a58b9..8329080ef 100644 --- a/lapack-netlib/SRC/zla_herfsx_extended.f +++ b/lapack-netlib/SRC/zla_herfsx_extended.f @@ -66,11 +66,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -254,7 +254,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/zla_herpvgrw.f b/lapack-netlib/SRC/zla_herpvgrw.f index 557d6e830..d414c371f 100644 --- a/lapack-netlib/SRC/zla_herpvgrw.f +++ b/lapack-netlib/SRC/zla_herpvgrw.f @@ -102,7 +102,7 @@ *> as determined by ZHETRF. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/zla_porcond_c.f b/lapack-netlib/SRC/zla_porcond_c.f index a74295b41..2e591dd09 100644 --- a/lapack-netlib/SRC/zla_porcond_c.f +++ b/lapack-netlib/SRC/zla_porcond_c.f @@ -103,13 +103,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_porcond_x.f b/lapack-netlib/SRC/zla_porcond_x.f index 0b2c84f42..4f409544f 100644 --- a/lapack-netlib/SRC/zla_porcond_x.f +++ b/lapack-netlib/SRC/zla_porcond_x.f @@ -96,13 +96,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_porfsx_extended.f b/lapack-netlib/SRC/zla_porfsx_extended.f index 85dd42780..169a9a5d4 100644 --- a/lapack-netlib/SRC/zla_porfsx_extended.f +++ b/lapack-netlib/SRC/zla_porfsx_extended.f @@ -65,11 +65,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -246,7 +246,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/zla_porpvgrw.f b/lapack-netlib/SRC/zla_porpvgrw.f index cd71635ec..f669b2864 100644 --- a/lapack-netlib/SRC/zla_porpvgrw.f +++ b/lapack-netlib/SRC/zla_porpvgrw.f @@ -86,7 +86,7 @@ *> The leading dimension of the array AF. LDAF >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/zla_syrcond_c.f b/lapack-netlib/SRC/zla_syrcond_c.f index be9d14bd0..ff44d6c3b 100644 --- a/lapack-netlib/SRC/zla_syrcond_c.f +++ b/lapack-netlib/SRC/zla_syrcond_c.f @@ -111,13 +111,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_syrcond_x.f b/lapack-netlib/SRC/zla_syrcond_x.f index 2d0269092..53022bbfb 100644 --- a/lapack-netlib/SRC/zla_syrcond_x.f +++ b/lapack-netlib/SRC/zla_syrcond_x.f @@ -104,13 +104,13 @@ *> i > 0: The ith argument is invalid. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is COMPLEX*16 array, dimension (2*N). *> Workspace. *> \endverbatim *> -*> \param[in] RWORK +*> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (N). *> Workspace. diff --git a/lapack-netlib/SRC/zla_syrfsx_extended.f b/lapack-netlib/SRC/zla_syrfsx_extended.f index a9716fd23..69844c94b 100644 --- a/lapack-netlib/SRC/zla_syrfsx_extended.f +++ b/lapack-netlib/SRC/zla_syrfsx_extended.f @@ -66,11 +66,11 @@ *> \verbatim *> PREC_TYPE is INTEGER *> Specifies the intermediate precision to be used in refinement. -*> The value is defined by ILAPREC(P) where P is a CHARACTER and -*> P = 'S': Single +*> The value is defined by ILAPREC(P) where P is a CHARACTER and P +*> = 'S': Single *> = 'D': Double *> = 'I': Indigenous -*> = 'X', 'E': Extra +*> = 'X' or 'E': Extra *> \endverbatim *> *> \param[in] UPLO @@ -254,7 +254,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith diff --git a/lapack-netlib/SRC/zla_syrpvgrw.f b/lapack-netlib/SRC/zla_syrpvgrw.f index ccf4fc2d6..82c9f52f8 100644 --- a/lapack-netlib/SRC/zla_syrpvgrw.f +++ b/lapack-netlib/SRC/zla_syrpvgrw.f @@ -102,7 +102,7 @@ *> as determined by ZSYTRF. *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim *> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim diff --git a/lapack-netlib/SRC/zla_wwaddw.f b/lapack-netlib/SRC/zla_wwaddw.f index b4f9df332..f06113a95 100644 --- a/lapack-netlib/SRC/zla_wwaddw.f +++ b/lapack-netlib/SRC/zla_wwaddw.f @@ -36,7 +36,7 @@ *> ZLA_WWADDW adds a vector W into a doubled-single vector (X, Y). *> *> This works for all extant IBM's hex and binary floating point -*> arithmetics, but not for decimal. +*> arithmetic, but not for decimal. *> \endverbatim * * Arguments: diff --git a/lapack-netlib/SRC/zlahef_aa.f b/lapack-netlib/SRC/zlahef_aa.f index 8bad4aba9..ddd1e9493 100644 --- a/lapack-netlib/SRC/zlahef_aa.f +++ b/lapack-netlib/SRC/zlahef_aa.f @@ -288,8 +288,9 @@ * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -329,13 +330,15 @@ * Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -440,8 +443,9 @@ * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -481,13 +485,15 @@ * Compute L(J+2, J+1) = WORK( 3:N ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:N, J) = L(J+2:N, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/zlahef_rk.f b/lapack-netlib/SRC/zlahef_rk.f index d8d54f4ce..6a8549cf5 100644 --- a/lapack-netlib/SRC/zlahef_rk.f +++ b/lapack-netlib/SRC/zlahef_rk.f @@ -331,7 +331,7 @@ * Factorize the trailing columns of A using the upper triangle * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 (note that conjg(W) is actually stored) -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -789,7 +789,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 (note that conjg(W) is actually stored) * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/zlahqr.f b/lapack-netlib/SRC/zlahqr.f index 19015b3fa..0a8318874 100644 --- a/lapack-netlib/SRC/zlahqr.f +++ b/lapack-netlib/SRC/zlahqr.f @@ -138,26 +138,26 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, ZLAHQR failed to compute all the +*> = 0: successful exit +*> > 0: if INFO = i, ZLAHQR failed to compute all the *> eigenvalues ILO to IHI in a total of 30 iterations *> per eigenvalue; elements i+1:ihi of W contain *> those eigenvalues which have been successfully *> computed. *> -*> If INFO .GT. 0 and WANTT is .FALSE., then on exit, +*> If INFO > 0 and WANTT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the *> eigenvalues of the upper Hessenberg matrix -*> rows and columns ILO thorugh INFO of the final, +*> rows and columns ILO through INFO of the final, *> output value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> (*) (initial value of H)*U = U*(final value of H) -*> where U is an orthognal matrix. The final +*> where U is an orthogonal matrix. The final *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> (final value of Z) = (initial value of Z)*U *> where U is the orthogonal matrix in (*) *> (regardless of the value of WANTT.) diff --git a/lapack-netlib/SRC/zlamswlq.f b/lapack-netlib/SRC/zlamswlq.f index 0e0b0a1da..f32f5667c 100644 --- a/lapack-netlib/SRC/zlamswlq.f +++ b/lapack-netlib/SRC/zlamswlq.f @@ -1,3 +1,4 @@ +*> \brief \b ZLAMSWLQ * * Definition: * =========== diff --git a/lapack-netlib/SRC/zlamtsqr.f b/lapack-netlib/SRC/zlamtsqr.f index 1ee732425..034c45505 100644 --- a/lapack-netlib/SRC/zlamtsqr.f +++ b/lapack-netlib/SRC/zlamtsqr.f @@ -1,3 +1,4 @@ +*> \brief \b ZLAMTSQR * * Definition: * =========== diff --git a/lapack-netlib/SRC/zlangb.f b/lapack-netlib/SRC/zlangb.f index 949bb2c01..e40a470fd 100644 --- a/lapack-netlib/SRC/zlangb.f +++ b/lapack-netlib/SRC/zlangb.f @@ -130,6 +130,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER KL, KU, LDAB, N @@ -147,14 +148,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - DOUBLE PRECISION SCALE, SUM, VALUE, TEMP + DOUBLE PRECISION SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -207,15 +211,22 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N L = MAX( 1, J-KU ) K = KU + 1 - J + L - CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANGB = VALUE diff --git a/lapack-netlib/SRC/zlange.f b/lapack-netlib/SRC/zlange.f index 5407decef..8162786fb 100644 --- a/lapack-netlib/SRC/zlange.f +++ b/lapack-netlib/SRC/zlange.f @@ -120,6 +120,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, M, N @@ -137,14 +138,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE, TEMP + DOUBLE PRECISION SUM, VALUE, TEMP +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -196,13 +200,19 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL ZLASSQ( M, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANGE = VALUE diff --git a/lapack-netlib/SRC/zlanhb.f b/lapack-netlib/SRC/zlanhb.f index b3717804f..16b5c117c 100644 --- a/lapack-netlib/SRC/zlanhb.f +++ b/lapack-netlib/SRC/zlanhb.f @@ -137,6 +137,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -154,14 +155,17 @@ * .. * .. Local Scalars .. INTEGER I, J, L - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN, SQRT @@ -233,39 +237,57 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 J = 1, N IF( DBLE( AB( L, J ) ).NE.ZERO ) THEN ABSA = ABS( DBLE( AB( L, J ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANHB = VALUE diff --git a/lapack-netlib/SRC/zlanhe.f b/lapack-netlib/SRC/zlanhe.f index 7c7f7f3be..5aef9a756 100644 --- a/lapack-netlib/SRC/zlanhe.f +++ b/lapack-netlib/SRC/zlanhe.f @@ -129,6 +129,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -146,14 +147,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, SQRT @@ -223,31 +227,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J-1, A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J, A( J+1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* DO 130 I = 1, N IF( DBLE( A( I, I ) ).NE.ZERO ) THEN ABSA = ABS( DBLE( A( I, I ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( SSQ( 1 ).LT.ABSA ) THEN + SSQ( 2 ) = ONE + SSQ( 2 )*( SSQ( 1 ) / ABSA )**2 + SSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + SSQ( 2 ) = SSQ( 2 ) + ( ABSA / SSQ( 1 ) )**2 END IF END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANHE = VALUE diff --git a/lapack-netlib/SRC/zlanhp.f b/lapack-netlib/SRC/zlanhp.f index 9ded60746..d795aeca9 100644 --- a/lapack-netlib/SRC/zlanhp.f +++ b/lapack-netlib/SRC/zlanhp.f @@ -122,6 +122,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -139,14 +140,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, SQRT @@ -225,31 +229,48 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( DBLE( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( DBLE( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -258,7 +279,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANHP = VALUE diff --git a/lapack-netlib/SRC/zlanhs.f b/lapack-netlib/SRC/zlanhs.f index f2d36b304..bd8e86be9 100644 --- a/lapack-netlib/SRC/zlanhs.f +++ b/lapack-netlib/SRC/zlanhs.f @@ -114,6 +114,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM INTEGER LDA, N @@ -131,14 +132,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -190,13 +194,20 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 90 J = 1, N - CALL ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 90 CONTINUE - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANHS = VALUE diff --git a/lapack-netlib/SRC/zlansb.f b/lapack-netlib/SRC/zlansb.f index 3468c49b3..245dcaf4b 100644 --- a/lapack-netlib/SRC/zlansb.f +++ b/lapack-netlib/SRC/zlansb.f @@ -135,6 +135,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER K, LDAB, N @@ -152,14 +153,17 @@ * .. * .. Local Scalars .. INTEGER I, J, L - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -227,29 +231,47 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( K.GT.0 ) THEN IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE L = K + 1 ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE L = 1 END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) ELSE L = 1 END IF - CALL ZLASSQ( N, AB( L, 1 ), LDAB, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N, AB( L, 1 ), LDAB, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANSB = VALUE diff --git a/lapack-netlib/SRC/zlansp.f b/lapack-netlib/SRC/zlansp.f index 84fb972bb..fa9220487 100644 --- a/lapack-netlib/SRC/zlansp.f +++ b/lapack-netlib/SRC/zlansp.f @@ -120,6 +120,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER N @@ -137,14 +138,17 @@ * .. * .. Local Scalars .. INTEGER I, J, K - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG, SQRT @@ -219,40 +223,57 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE K = 2 IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J-1, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J, AP( K ), 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 120 CONTINUE END IF - SUM = 2*SUM + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* K = 1 + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE DO 130 I = 1, N IF( DBLE( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( DBLE( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( DIMAG( AP( K ) ).NE.ZERO ) THEN ABSA = ABS( DIMAG( AP( K ) ) ) - IF( SCALE.LT.ABSA ) THEN - SUM = ONE + SUM*( SCALE / ABSA )**2 - SCALE = ABSA + IF( COLSSQ( 1 ).LT.ABSA ) THEN + COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2 + COLSSQ( 1 ) = ABSA ELSE - SUM = SUM + ( ABSA / SCALE )**2 + COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2 END IF END IF IF( LSAME( UPLO, 'U' ) ) THEN @@ -261,7 +282,8 @@ K = K + N - I + 1 END IF 130 CONTINUE - VALUE = SCALE*SQRT( SUM ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANSP = VALUE diff --git a/lapack-netlib/SRC/zlansy.f b/lapack-netlib/SRC/zlansy.f index 58269a911..e022f85e1 100644 --- a/lapack-netlib/SRC/zlansy.f +++ b/lapack-netlib/SRC/zlansy.f @@ -128,6 +128,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER NORM, UPLO INTEGER LDA, N @@ -145,14 +146,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION ABSA, SCALE, SUM, VALUE + DOUBLE PRECISION ABSA, SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -218,21 +222,39 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. +* + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE +* +* Sum off-diagonals * - SCALE = ZERO - SUM = ONE IF( LSAME( UPLO, 'U' ) ) THEN DO 110 J = 2, N - CALL ZLASSQ( J-1, A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 110 CONTINUE ELSE DO 120 J = 1, N - 1 - CALL ZLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 120 CONTINUE END IF - SUM = 2*SUM - CALL ZLASSQ( N, A, LDA+1, SCALE, SUM ) - VALUE = SCALE*SQRT( SUM ) + SSQ( 2 ) = 2*SSQ( 2 ) +* +* Sum diagonal +* + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANSY = VALUE diff --git a/lapack-netlib/SRC/zlantb.f b/lapack-netlib/SRC/zlantb.f index 3077ba151..f02509223 100644 --- a/lapack-netlib/SRC/zlantb.f +++ b/lapack-netlib/SRC/zlantb.f @@ -146,6 +146,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER K, LDAB, N @@ -164,14 +165,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, L - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -313,46 +317,61 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 280 J = 2, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL ZLASSQ( MIN( J-1, K ), - $ AB( MAX( K+2-J, 1 ), J ), 1, SCALE, - $ SUM ) + $ AB( MAX( K+2-J, 1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 280 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 290 J = 1, N + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE CALL ZLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ), - $ 1, SCALE, SUM ) + $ 1, COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N IF( K.GT.0 ) THEN DO 300 J = 1, N - 1 - CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 310 J = 1, N - CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANTB = VALUE diff --git a/lapack-netlib/SRC/zlantp.f b/lapack-netlib/SRC/zlantp.f index 69dbaa5bc..d32a00f13 100644 --- a/lapack-netlib/SRC/zlantp.f +++ b/lapack-netlib/SRC/zlantp.f @@ -130,6 +130,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER N @@ -148,14 +149,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J, K - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT @@ -308,45 +312,64 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 280 J = 2, N - CALL ZLASSQ( J-1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J-1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 280 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 290 J = 1, N - CALL ZLASSQ( J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + J 290 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = N + SSQ( 1 ) = ONE + SSQ( 2 ) = N K = 2 DO 300 J = 1, N - 1 - CALL ZLASSQ( N-J, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 300 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE K = 1 DO 310 J = 1, N - CALL ZLASSQ( N-J+1, AP( K ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( N-J+1, AP( K ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) K = K + N - J + 1 310 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANTP = VALUE diff --git a/lapack-netlib/SRC/zlantr.f b/lapack-netlib/SRC/zlantr.f index 04ee482f7..7d63c972e 100644 --- a/lapack-netlib/SRC/zlantr.f +++ b/lapack-netlib/SRC/zlantr.f @@ -147,6 +147,7 @@ * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * December 2016 * + IMPLICIT NONE * .. Scalar Arguments .. CHARACTER DIAG, NORM, UPLO INTEGER LDA, M, N @@ -165,14 +166,17 @@ * .. Local Scalars .. LOGICAL UDIAG INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SUM, VALUE +* .. +* .. Local Arrays .. + DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 ) * .. * .. External Functions .. LOGICAL LSAME, DISNAN EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. - EXTERNAL ZLASSQ + EXTERNAL ZLASSQ, DCOMBSSQ * .. * .. Intrinsic Functions .. INTRINSIC ABS, MIN, SQRT @@ -283,7 +287,7 @@ END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - DO 210 I = 1, N + DO 210 I = 1, MIN( M, N ) WORK( I ) = ONE 210 CONTINUE DO 220 I = N + 1, M @@ -313,38 +317,56 @@ ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). +* SSQ(1) is scale +* SSQ(2) is sum-of-squares +* For better accuracy, sum each column separately. * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 290 J = 2, N - CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 290 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 300 J = 1, N - CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN - SCALE = ONE - SUM = MIN( M, N ) + SSQ( 1 ) = ONE + SSQ( 2 ) = MIN( M, N ) DO 310 J = 1, N - CALL ZLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, - $ SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 310 CONTINUE ELSE - SCALE = ZERO - SUM = ONE + SSQ( 1 ) = ZERO + SSQ( 2 ) = ONE DO 320 J = 1, N - CALL ZLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) + COLSSQ( 1 ) = ZERO + COLSSQ( 2 ) = ONE + CALL ZLASSQ( M-J+1, A( J, J ), 1, + $ COLSSQ( 1 ), COLSSQ( 2 ) ) + CALL DCOMBSSQ( SSQ, COLSSQ ) 320 CONTINUE END IF END IF - VALUE = SCALE*SQRT( SUM ) + VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) ) END IF * ZLANTR = VALUE diff --git a/lapack-netlib/SRC/zlaqps.f b/lapack-netlib/SRC/zlaqps.f index c142e8c69..66c721517 100644 --- a/lapack-netlib/SRC/zlaqps.f +++ b/lapack-netlib/SRC/zlaqps.f @@ -127,7 +127,7 @@ *> \param[in,out] AUXV *> \verbatim *> AUXV is COMPLEX*16 array, dimension (NB) -*> Auxiliar vector. +*> Auxiliary vector. *> \endverbatim *> *> \param[in,out] F diff --git a/lapack-netlib/SRC/zlaqr0.f b/lapack-netlib/SRC/zlaqr0.f index 59b8ed7a6..feffe9782 100644 --- a/lapack-netlib/SRC/zlaqr0.f +++ b/lapack-netlib/SRC/zlaqr0.f @@ -66,7 +66,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -79,12 +79,12 @@ *> IHI is INTEGER *> *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to ZGEBAL, and then passed to ZGEHRD when the *> matrix output by ZGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -96,17 +96,17 @@ *> contains the upper triangular matrix T from the Schur *> decomposition (the Schur form). If INFO = 0 and WANT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -128,7 +128,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -138,7 +138,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -146,7 +146,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -159,7 +159,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -175,19 +175,19 @@ *> \param[out] INFO *> \verbatim *> INFO is INTEGER -*> = 0: successful exit -*> .GT. 0: if INFO = i, ZLAQR0 failed to compute all of +*> = 0: successful exit +*> > 0: if INFO = i, ZLAQR0 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -195,7 +195,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -203,7 +203,7 @@ *> where U is the unitary matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -641,7 +641,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/zlaqr1.f b/lapack-netlib/SRC/zlaqr1.f index 34341cb10..fc2df3cb4 100644 --- a/lapack-netlib/SRC/zlaqr1.f +++ b/lapack-netlib/SRC/zlaqr1.f @@ -64,7 +64,7 @@ *> \verbatim *> LDH is INTEGER *> The leading dimension of H as declared in -*> the calling procedure. LDH.GE.N +*> the calling procedure. LDH >= N *> \endverbatim *> *> \param[in] S1 diff --git a/lapack-netlib/SRC/zlaqr2.f b/lapack-netlib/SRC/zlaqr2.f index e6e2ea48c..b5434e899 100644 --- a/lapack-netlib/SRC/zlaqr2.f +++ b/lapack-netlib/SRC/zlaqr2.f @@ -103,7 +103,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -121,7 +121,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -133,7 +133,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -149,7 +149,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -186,13 +186,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -204,14 +204,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -223,7 +223,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/zlaqr3.f b/lapack-netlib/SRC/zlaqr3.f index 64ab59f31..dfb798ca9 100644 --- a/lapack-netlib/SRC/zlaqr3.f +++ b/lapack-netlib/SRC/zlaqr3.f @@ -100,7 +100,7 @@ *> \param[in] NW *> \verbatim *> NW is INTEGER -*> Deflation window size. 1 .LE. NW .LE. (KBOT-KTOP+1). +*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1). *> \endverbatim *> *> \param[in,out] H @@ -118,7 +118,7 @@ *> \verbatim *> LDH is INTEGER *> Leading dimension of H just as declared in the calling -*> subroutine. N .LE. LDH +*> subroutine. N <= LDH *> \endverbatim *> *> \param[in] ILOZ @@ -130,7 +130,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N. +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -146,7 +146,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of Z just as declared in the -*> calling subroutine. 1 .LE. LDZ. +*> calling subroutine. 1 <= LDZ. *> \endverbatim *> *> \param[out] NS @@ -183,13 +183,13 @@ *> \verbatim *> LDV is INTEGER *> The leading dimension of V just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[in] NH *> \verbatim *> NH is INTEGER -*> The number of columns of T. NH.GE.NW. +*> The number of columns of T. NH >= NW. *> \endverbatim *> *> \param[out] T @@ -201,14 +201,14 @@ *> \verbatim *> LDT is INTEGER *> The leading dimension of T just as declared in the -*> calling subroutine. NW .LE. LDT +*> calling subroutine. NW <= LDT *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> The number of rows of work array WV available for -*> workspace. NV.GE.NW. +*> workspace. NV >= NW. *> \endverbatim *> *> \param[out] WV @@ -220,7 +220,7 @@ *> \verbatim *> LDWV is INTEGER *> The leading dimension of W just as declared in the -*> calling subroutine. NW .LE. LDV +*> calling subroutine. NW <= LDV *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/zlaqr4.f b/lapack-netlib/SRC/zlaqr4.f index 012fa37e2..a88f6508e 100644 --- a/lapack-netlib/SRC/zlaqr4.f +++ b/lapack-netlib/SRC/zlaqr4.f @@ -73,7 +73,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix H. N .GE. 0. +*> The order of the matrix H. N >= 0. *> \endverbatim *> *> \param[in] ILO @@ -85,12 +85,12 @@ *> \verbatim *> IHI is INTEGER *> It is assumed that H is already upper triangular in rows -*> and columns 1:ILO-1 and IHI+1:N and, if ILO.GT.1, +*> and columns 1:ILO-1 and IHI+1:N and, if ILO > 1, *> H(ILO,ILO-1) is zero. ILO and IHI are normally set by a *> previous call to ZGEBAL, and then passed to ZGEHRD when the *> matrix output by ZGEBAL is reduced to Hessenberg form. *> Otherwise, ILO and IHI should be set to 1 and N, -*> respectively. If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N. +*> respectively. If N > 0, then 1 <= ILO <= IHI <= N. *> If N = 0, then ILO = 1 and IHI = 0. *> \endverbatim *> @@ -102,17 +102,17 @@ *> contains the upper triangular matrix T from the Schur *> decomposition (the Schur form). If INFO = 0 and WANT is *> .FALSE., then the contents of H are unspecified on exit. -*> (The output value of H when INFO.GT.0 is given under the +*> (The output value of H when INFO > 0 is given under the *> description of INFO below.) *> -*> This subroutine may explicitly set H(i,j) = 0 for i.GT.j and +*> This subroutine may explicitly set H(i,j) = 0 for i > j and *> j = 1, 2, ... ILO-1 or j = IHI+1, IHI+2, ... N. *> \endverbatim *> *> \param[in] LDH *> \verbatim *> LDH is INTEGER -*> The leading dimension of the array H. LDH .GE. max(1,N). +*> The leading dimension of the array H. LDH >= max(1,N). *> \endverbatim *> *> \param[out] W @@ -134,7 +134,7 @@ *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be *> applied if WANTZ is .TRUE.. -*> 1 .LE. ILOZ .LE. ILO; IHI .LE. IHIZ .LE. N. +*> 1 <= ILOZ <= ILO; IHI <= IHIZ <= N. *> \endverbatim *> *> \param[in,out] Z @@ -144,7 +144,7 @@ *> If WANTZ is .TRUE., then Z(ILO:IHI,ILOZ:IHIZ) is *> replaced by Z(ILO:IHI,ILOZ:IHIZ)*U where U is the *> orthogonal Schur factor of H(ILO:IHI,ILO:IHI). -*> (The output value of Z when INFO.GT.0 is given under +*> (The output value of Z when INFO > 0 is given under *> the description of INFO below.) *> \endverbatim *> @@ -152,7 +152,7 @@ *> \verbatim *> LDZ is INTEGER *> The leading dimension of the array Z. if WANTZ is .TRUE. -*> then LDZ.GE.MAX(1,IHIZ). Otherwize, LDZ.GE.1. +*> then LDZ >= MAX(1,IHIZ). Otherwise, LDZ >= 1. *> \endverbatim *> *> \param[out] WORK @@ -165,7 +165,7 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The dimension of the array WORK. LWORK .GE. max(1,N) +*> The dimension of the array WORK. LWORK >= max(1,N) *> is sufficient, but LWORK typically as large as 6*N may *> be required for optimal performance. A workspace query *> to determine the optimal workspace size is recommended. @@ -182,18 +182,18 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> .GT. 0: if INFO = i, ZLAQR4 failed to compute all of +*> > 0: if INFO = i, ZLAQR4 failed to compute all of *> the eigenvalues. Elements 1:ilo-1 and i+1:n of WR *> and WI contain those eigenvalues which have been *> successfully computed. (Failures are rare.) *> -*> If INFO .GT. 0 and WANT is .FALSE., then on exit, +*> If INFO > 0 and WANT is .FALSE., then on exit, *> the remaining unconverged eigenvalues are the eigen- *> values of the upper Hessenberg matrix rows and *> columns ILO through INFO of the final, output *> value of H. *> -*> If INFO .GT. 0 and WANTT is .TRUE., then on exit +*> If INFO > 0 and WANTT is .TRUE., then on exit *> *> (*) (initial value of H)*U = U*(final value of H) *> @@ -201,7 +201,7 @@ *> value of H is upper Hessenberg and triangular in *> rows and columns INFO+1 through IHI. *> -*> If INFO .GT. 0 and WANTZ is .TRUE., then on exit +*> If INFO > 0 and WANTZ is .TRUE., then on exit *> *> (final value of Z(ILO:IHI,ILOZ:IHIZ) *> = (initial value of Z(ILO:IHI,ILOZ:IHIZ)*U @@ -209,7 +209,7 @@ *> where U is the unitary matrix in (*) (regard- *> less of the value of WANTT.) *> -*> If INFO .GT. 0 and WANTZ is .FALSE., then Z is not +*> If INFO > 0 and WANTZ is .FALSE., then Z is not *> accessed. *> \endverbatim * @@ -641,7 +641,7 @@ END IF END IF * -* ==== Use up to NS of the the smallest magnatiude +* ==== Use up to NS of the the smallest magnitude * . shifts. If there aren't NS shifts available, * . then use them all, possibly dropping one to * . make the number of shifts even. ==== diff --git a/lapack-netlib/SRC/zlaqr5.f b/lapack-netlib/SRC/zlaqr5.f index 0dfbce82c..9ff7e7eca 100644 --- a/lapack-netlib/SRC/zlaqr5.f +++ b/lapack-netlib/SRC/zlaqr5.f @@ -125,7 +125,7 @@ *> \verbatim *> LDH is INTEGER *> LDH is the leading dimension of H just as declared in the -*> calling procedure. LDH.GE.MAX(1,N). +*> calling procedure. LDH >= MAX(1,N). *> \endverbatim *> *> \param[in] ILOZ @@ -137,7 +137,7 @@ *> \verbatim *> IHIZ is INTEGER *> Specify the rows of Z to which transformations must be -*> applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N +*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N *> \endverbatim *> *> \param[in,out] Z @@ -153,7 +153,7 @@ *> \verbatim *> LDZ is INTEGER *> LDA is the leading dimension of Z just as declared in -*> the calling procedure. LDZ.GE.N. +*> the calling procedure. LDZ >= N. *> \endverbatim *> *> \param[out] V @@ -165,7 +165,7 @@ *> \verbatim *> LDV is INTEGER *> LDV is the leading dimension of V as declared in the -*> calling procedure. LDV.GE.3. +*> calling procedure. LDV >= 3. *> \endverbatim *> *> \param[out] U @@ -177,33 +177,14 @@ *> \verbatim *> LDU is INTEGER *> LDU is the leading dimension of U just as declared in the -*> in the calling subroutine. LDU.GE.3*NSHFTS-3. -*> \endverbatim -*> -*> \param[in] NH -*> \verbatim -*> NH is INTEGER -*> NH is the number of columns in array WH available for -*> workspace. NH.GE.1. -*> \endverbatim -*> -*> \param[out] WH -*> \verbatim -*> WH is COMPLEX*16 array, dimension (LDWH,NH) -*> \endverbatim -*> -*> \param[in] LDWH -*> \verbatim -*> LDWH is INTEGER -*> Leading dimension of WH just as declared in the -*> calling procedure. LDWH.GE.3*NSHFTS-3. +*> in the calling subroutine. LDU >= 3*NSHFTS-3. *> \endverbatim *> *> \param[in] NV *> \verbatim *> NV is INTEGER *> NV is the number of rows in WV agailable for workspace. -*> NV.GE.1. +*> NV >= 1. *> \endverbatim *> *> \param[out] WV @@ -215,9 +196,28 @@ *> \verbatim *> LDWV is INTEGER *> LDWV is the leading dimension of WV as declared in the -*> in the calling subroutine. LDWV.GE.NV. +*> in the calling subroutine. LDWV >= NV. *> \endverbatim * +*> \param[in] NH +*> \verbatim +*> NH is INTEGER +*> NH is the number of columns in array WH available for +*> workspace. NH >= 1. +*> \endverbatim +*> +*> \param[out] WH +*> \verbatim +*> WH is COMPLEX*16 array, dimension (LDWH,NH) +*> \endverbatim +*> +*> \param[in] LDWH +*> \verbatim +*> LDWH is INTEGER +*> Leading dimension of WH just as declared in the +*> calling procedure. LDWH >= 3*NSHFTS-3. +*> \endverbatim +*> * Authors: * ======== * diff --git a/lapack-netlib/SRC/zlarfb.f b/lapack-netlib/SRC/zlarfb.f index b4a2b4d1a..3da49f2fc 100644 --- a/lapack-netlib/SRC/zlarfb.f +++ b/lapack-netlib/SRC/zlarfb.f @@ -92,6 +92,8 @@ *> K is INTEGER *> The order of the matrix T (= the number of elementary *> reflectors whose product defines the block reflector). +*> If SIDE = 'L', M >= K >= 0; +*> if SIDE = 'R', N >= K >= 0. *> \endverbatim *> *> \param[in] V diff --git a/lapack-netlib/SRC/zlarfx.f b/lapack-netlib/SRC/zlarfx.f index 685d164eb..ba6d4ed74 100644 --- a/lapack-netlib/SRC/zlarfx.f +++ b/lapack-netlib/SRC/zlarfx.f @@ -94,7 +94,7 @@ *> \param[in] LDC *> \verbatim *> LDC is INTEGER -*> The leading dimension of the array C. LDA >= max(1,M). +*> The leading dimension of the array C. LDC >= max(1,M). *> \endverbatim *> *> \param[out] WORK diff --git a/lapack-netlib/SRC/zlarfy.f b/lapack-netlib/SRC/zlarfy.f index 57605731b..4c9e08bac 100644 --- a/lapack-netlib/SRC/zlarfy.f +++ b/lapack-netlib/SRC/zlarfy.f @@ -103,7 +103,7 @@ * *> \date December 2016 * -*> \ingroup complex16_eig +*> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK ) diff --git a/lapack-netlib/SRC/zlarrv.f b/lapack-netlib/SRC/zlarrv.f index 67a67584c..23976dbef 100644 --- a/lapack-netlib/SRC/zlarrv.f +++ b/lapack-netlib/SRC/zlarrv.f @@ -143,7 +143,7 @@ *> RTOL2 is DOUBLE PRECISION *> Parameters for bisection. *> An interval [LEFT,RIGHT] has converged if -*> RIGHT-LEFT.LT.MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) +*> RIGHT-LEFT < MAX( RTOL1*GAP, RTOL2*MAX(|LEFT|,|RIGHT|) ) *> \endverbatim *> *> \param[in,out] W diff --git a/lapack-netlib/SRC/zlassq.f b/lapack-netlib/SRC/zlassq.f index fd13811bd..dccec988d 100644 --- a/lapack-netlib/SRC/zlassq.f +++ b/lapack-netlib/SRC/zlassq.f @@ -41,7 +41,7 @@ *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is *> assumed to be at least unity and the value of ssq will then satisfy *> -*> 1.0 .le. ssq .le. ( sumsq + 2*n ). +*> 1.0 <= ssq <= ( sumsq + 2*n ). *> *> scale is assumed to be non-negative and scl returns the value *> @@ -65,7 +65,7 @@ *> *> \param[in] X *> \verbatim -*> X is COMPLEX*16 array, dimension (N) +*> X is COMPLEX*16 array, dimension (1+(N-1)*INCX) *> The vector x as described above. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. *> \endverbatim diff --git a/lapack-netlib/SRC/zlaswlq.f b/lapack-netlib/SRC/zlaswlq.f index 24dd41d79..990630925 100644 --- a/lapack-netlib/SRC/zlaswlq.f +++ b/lapack-netlib/SRC/zlaswlq.f @@ -1,3 +1,4 @@ +*> \brief \b ZLASWLQ * * Definition: * =========== @@ -18,9 +19,20 @@ *> *> \verbatim *> -*> ZLASWLQ computes a blocked Short-Wide LQ factorization of a -*> M-by-N matrix A, where N >= M: -*> A = L * Q +*> ZLASWLQ computes a blocked Tall-Skinny LQ factorization of +*> a complexx M-by-N matrix A for M <= N: +*> +*> A = ( L 0 ) * Q, +*> +*> where: +*> +*> Q is a n-by-N orthogonal matrix, stored on exit in an implicit +*> form in the elements above the digonal of the array A and in +*> the elemenst of the array T; +*> L is an lower-triangular M-by-M matrix stored on exit in +*> the elements on and below the diagonal of the array A. +*> 0 is a M-by-(N-M) zero matrix, if M < N, and is not stored. +*> *> \endverbatim * * Arguments: @@ -150,7 +162,7 @@ SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * -* -- LAPACK computational routine (version 3.7.1) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- * June 2017 diff --git a/lapack-netlib/SRC/zlasyf_aa.f b/lapack-netlib/SRC/zlasyf_aa.f index f321b72de..b1f1c2790 100644 --- a/lapack-netlib/SRC/zlasyf_aa.f +++ b/lapack-netlib/SRC/zlasyf_aa.f @@ -284,8 +284,9 @@ * * Swap A(I1, I2+1:M) with A(I2, I2+1:M) * - CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -325,13 +326,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -432,8 +435,9 @@ * * Swap A(I2+1:M, I1) with A(I2+1:M, I2) * - CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -473,13 +477,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1 diff --git a/lapack-netlib/SRC/zlasyf_rk.f b/lapack-netlib/SRC/zlasyf_rk.f index 664ed93f3..b6c5a27c6 100644 --- a/lapack-netlib/SRC/zlasyf_rk.f +++ b/lapack-netlib/SRC/zlasyf_rk.f @@ -330,7 +330,7 @@ * of A and working backwards, and compute the matrix W = U12*D * for use in updating A11 * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -658,7 +658,7 @@ * of A and working forwards, and compute the matrix W = L21*D * for use in updating A22 * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/zlatdf.f b/lapack-netlib/SRC/zlatdf.f index ab88570c5..4b8b5e330 100644 --- a/lapack-netlib/SRC/zlatdf.f +++ b/lapack-netlib/SRC/zlatdf.f @@ -261,7 +261,7 @@ * * Solve for U- part, lockahead for RHS(N) = +-1. This is not done * In BSOLVE and will hopefully give us a better estimate because -* any ill-conditioning of the original matrix is transfered to U +* any ill-conditioning of the original matrix is transferred to U * and not to L. U(N, N) is an approximation to sigma_min(LU). * CALL ZCOPY( N-1, RHS, 1, WORK, 1 ) diff --git a/lapack-netlib/SRC/zlatsqr.f b/lapack-netlib/SRC/zlatsqr.f index 1fdf3be24..0f98cae93 100644 --- a/lapack-netlib/SRC/zlatsqr.f +++ b/lapack-netlib/SRC/zlatsqr.f @@ -1,3 +1,4 @@ +*> \brief \b ZLATSQR * * Definition: * =========== @@ -18,9 +19,23 @@ *> *> \verbatim *> -*> SLATSQR computes a blocked Tall-Skinny QR factorization of -*> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> ZLATSQR computes a blocked Tall-Skinny QR factorization of +*> a complex M-by-N matrix A for M >= N: +*> +*> A = Q * ( R ), +*> ( 0 ) +*> +*> where: +*> +*> Q is a M-by-M orthogonal matrix, stored on exit in an implicit +*> form in the elements below the digonal of the array A and in +*> the elemenst of the array T; +*> +*> R is an upper-triangular N-by-N matrix, stored on exit in +*> the elements on and above the diagonal of the array A. +*> +*> 0 is a (M-N)-by-N zero matrix, and is not stored. +*> *> \endverbatim * * Arguments: @@ -149,10 +164,10 @@ SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * -* -- LAPACK computational routine (version 3.7.0) -- +* -- LAPACK computational routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. -- -* December 2016 +* November 2019 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK diff --git a/lapack-netlib/SRC/zlaunhr_col_getrfnp.f b/lapack-netlib/SRC/zlaunhr_col_getrfnp.f new file mode 100644 index 000000000..0ab7f0349 --- /dev/null +++ b/lapack-netlib/SRC/zlaunhr_col_getrfnp.f @@ -0,0 +1,248 @@ +*> \brief \b ZLAUNHR_COL_GETRFNP +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAUNHR_COL_GETRFNP + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAUNHR_COL_GETRFNP computes the modified LU factorization without +*> pivoting of a complex general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is +*> at least one in absolute value (so that division-by-zero not +*> not possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine ZUNHR_COL. In ZUNHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the blocked right-looking version of the algorithm, +*> calling Level 3 BLAS to update the submatrix. To factorize a block, +*> this routine calls the recursive routine ZLAUNHR_COL_GETRFNP2. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX*16 array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can be +*> only ( +1.0, 0.0 ) or (-1.0, 0.0 ). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16GEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE ZLAUNHR_COL_GETRFNP( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 CONE + PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + INTEGER IINFO, J, JB, NB +* .. +* .. External Subroutines .. + EXTERNAL ZGEMM, ZLAUNHR_COL_GETRFNP2, ZTRSM, XERBLA +* .. +* .. External Functions .. + INTEGER ILAENV + EXTERNAL ILAENV +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAUNHR_COL_GETRFNP', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN +* +* Determine the block size for this environment. +* + + NB = ILAENV( 1, 'ZLAUNHR_COL_GETRFNP', ' ', M, N, -1, -1 ) + + IF( NB.LE.1 .OR. NB.GE.MIN( M, N ) ) THEN +* +* Use unblocked code. +* + CALL ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + ELSE +* +* Use blocked code. +* + DO J = 1, MIN( M, N ), NB + JB = MIN( MIN( M, N )-J+1, NB ) +* +* Factor diagonal and subdiagonal blocks. +* + CALL ZLAUNHR_COL_GETRFNP2( M-J+1, JB, A( J, J ), LDA, + $ D( J ), IINFO ) +* + IF( J+JB.LE.N ) THEN +* +* Compute block row of U. +* + CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', JB, + $ N-J-JB+1, CONE, A( J, J ), LDA, A( J, J+JB ), + $ LDA ) + IF( J+JB.LE.M ) THEN +* +* Update trailing submatrix. +* + CALL ZGEMM( 'No transpose', 'No transpose', M-J-JB+1, + $ N-J-JB+1, JB, -CONE, A( J+JB, J ), LDA, + $ A( J, J+JB ), LDA, CONE, A( J+JB, J+JB ), + $ LDA ) + END IF + END IF + END DO + END IF + RETURN +* +* End of ZLAUNHR_COL_GETRFNP +* + END diff --git a/lapack-netlib/SRC/zlaunhr_col_getrfnp2.f b/lapack-netlib/SRC/zlaunhr_col_getrfnp2.f new file mode 100644 index 000000000..0057e430d --- /dev/null +++ b/lapack-netlib/SRC/zlaunhr_col_getrfnp2.f @@ -0,0 +1,314 @@ +*> \brief \b ZLAUNHR_COL_GETRFNP2 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZLAUNHR_COL_GETRFNP2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), D( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZLAUNHR_COL_GETRFNP2 computes the modified LU factorization without +*> pivoting of a complex general M-by-N matrix A. The factorization has +*> the form: +*> +*> A - S = L * U, +*> +*> where: +*> S is a m-by-n diagonal sign matrix with the diagonal D, so that +*> D(i) = S(i,i), 1 <= i <= min(M,N). The diagonal D is constructed +*> as D(i)=-SIGN(A(i,i)), where A(i,i) is the value after performing +*> i-1 steps of Gaussian elimination. This means that the diagonal +*> element at each step of "modified" Gaussian elimination is at +*> least one in absolute value (so that division-by-zero not +*> possible during the division by the diagonal element); +*> +*> L is a M-by-N lower triangular matrix with unit diagonal elements +*> (lower trapezoidal if M > N); +*> +*> and U is a M-by-N upper triangular matrix +*> (upper trapezoidal if M < N). +*> +*> This routine is an auxiliary routine used in the Householder +*> reconstruction routine ZUNHR_COL. In ZUNHR_COL, this routine is +*> applied to an M-by-N matrix A with orthonormal columns, where each +*> element is bounded by one in absolute value. With the choice of +*> the matrix S above, one can show that the diagonal element at each +*> step of Gaussian elimination is the largest (in absolute value) in +*> the column on or below the diagonal, so that no pivoting is required +*> for numerical stability [1]. +*> +*> For more details on the Householder reconstruction algorithm, +*> including the modified LU factorization, see [1]. +*> +*> This is the recursive version of the LU factorization algorithm. +*> Denote A - S by B. The algorithm divides the matrix B into four +*> submatrices: +*> +*> [ B11 | B12 ] where B11 is n1 by n1, +*> B = [ -----|----- ] B21 is (m-n1) by n1, +*> [ B21 | B22 ] B12 is n1 by n2, +*> B22 is (m-n1) by n2, +*> with n1 = min(m,n)/2, n2 = n-n1. +*> +*> +*> The subroutine calls itself to factor B11, solves for B21, +*> solves for B12, updates B22, then calls itself to factor B22. +*> +*> For more details on the recursive LU algorithm, see [2]. +*> +*> ZLAUNHR_COL_GETRFNP2 is called to factorize a block by the blocked +*> routine ZLAUNHR_COL_GETRFNP, which uses blocked code calling +*. Level 3 BLAS to update the submatrix. However, ZLAUNHR_COL_GETRFNP2 +*> is self-sufficient and can be used without ZLAUNHR_COL_GETRFNP. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> +*> [2] "Recursion leads to automatic variable blocking for dense linear +*> algebra algorithms", F. Gustavson, IBM J. of Res. and Dev., +*> vol. 41, no. 6, pp. 737-755, 1997. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. N >= 0. +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> On entry, the M-by-N matrix to be factored. +*> On exit, the factors L and U from the factorization +*> A-S=L*U; the unit diagonal elements of L are not stored. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX*16 array, dimension min(M,N) +*> The diagonal elements of the diagonal M-by-N sign matrix S, +*> D(i) = S(i,i), where 1 <= i <= min(M,N). The elements can be +*> only ( +1.0, 0.0 ) or (-1.0, 0.0 ). +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16GEcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + RECURSIVE SUBROUTINE ZLAUNHR_COL_GETRFNP2( M, N, A, LDA, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), D( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ONE + PARAMETER ( ONE = 1.0D+0 ) + COMPLEX*16 CONE + PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + DOUBLE PRECISION SFMIN + INTEGER I, IINFO, N1, N2 + COMPLEX*16 Z +* .. +* .. External Functions .. + DOUBLE PRECISION DLAMCH + EXTERNAL DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL ZGEMM, ZSCAL, ZTRSM, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DCMPLX, DIMAG, DSIGN, MAX, MIN +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( Z ) = ABS( DBLE( Z ) ) + ABS( DIMAG( Z ) ) +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -4 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZLAUNHR_COL_GETRFNP2', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) + $ RETURN + + IF ( M.EQ.1 ) THEN +* +* One row case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = DCMPLX( -DSIGN( ONE, DBLE( A( 1, 1 ) ) ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* + ELSE IF( N.EQ.1 ) THEN +* +* One column case, (also recursion termination case), +* use unblocked code +* +* Transfer the sign +* + D( 1 ) = DCMPLX( -DSIGN( ONE, DBLE( A( 1, 1 ) ) ) ) +* +* Construct the row of U +* + A( 1, 1 ) = A( 1, 1 ) - D( 1 ) +* +* Scale the elements 2:M of the column +* +* Determine machine safe minimum +* + SFMIN = DLAMCH('S') +* +* Construct the subdiagonal elements of L +* + IF( CABS1( A( 1, 1 ) ) .GE. SFMIN ) THEN + CALL ZSCAL( M-1, CONE / A( 1, 1 ), A( 2, 1 ), 1 ) + ELSE + DO I = 2, M + A( I, 1 ) = A( I, 1 ) / A( 1, 1 ) + END DO + END IF +* + ELSE +* +* Divide the matrix B into four submatrices +* + N1 = MIN( M, N ) / 2 + N2 = N-N1 + +* +* Factor B11, recursive call +* + CALL ZLAUNHR_COL_GETRFNP2( N1, N1, A, LDA, D, IINFO ) +* +* Solve for B21 +* + CALL ZTRSM( 'R', 'U', 'N', 'N', M-N1, N1, CONE, A, LDA, + $ A( N1+1, 1 ), LDA ) +* +* Solve for B12 +* + CALL ZTRSM( 'L', 'L', 'N', 'U', N1, N2, CONE, A, LDA, + $ A( 1, N1+1 ), LDA ) +* +* Update B22, i.e. compute the Schur complement +* B22 := B22 - B21*B12 +* + CALL ZGEMM( 'N', 'N', M-N1, N2, N1, -CONE, A( N1+1, 1 ), LDA, + $ A( 1, N1+1 ), LDA, CONE, A( N1+1, N1+1 ), LDA ) +* +* Factor B22, recursive call +* + CALL ZLAUNHR_COL_GETRFNP2( M-N1, N2, A( N1+1, N1+1 ), LDA, + $ D( N1+1 ), IINFO ) +* + END IF + RETURN +* +* End of ZLAUNHR_COL_GETRFNP2 +* + END diff --git a/lapack-netlib/SRC/zporfsx.f b/lapack-netlib/SRC/zporfsx.f index ee8cfbc6a..bbff4331e 100644 --- a/lapack-netlib/SRC/zporfsx.f +++ b/lapack-netlib/SRC/zporfsx.f @@ -44,7 +44,7 @@ *> \verbatim *> *> ZPORFSX improves the computed solution to a system of linear -*> equations when the coefficient matrix is symmetric positive +*> equations when the coefficient matrix is Hermitian positive *> definite, and provides error bounds and backward error estimates *> for the solution. In addition to normwise error bound, the code *> provides maximum componentwise error bound if possible. See @@ -103,7 +103,7 @@ *> \param[in] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> The symmetric matrix A. If UPLO = 'U', the leading N-by-N +*> The Hermitian matrix A. If UPLO = 'U', the leading N-by-N *> upper triangular part of A contains the upper triangular part *> of the matrix A, and the strictly lower triangular part of A *> is not referenced. If UPLO = 'L', the leading N-by-N lower @@ -134,7 +134,7 @@ *> \param[in,out] S *> \verbatim *> S is DOUBLE PRECISION array, dimension (N) -*> The row scale factors for A. If EQUED = 'Y', A is multiplied on +*> The scale factors for A. If EQUED = 'Y', A is multiplied on *> the left and right by diag(S). S is an input argument if FACT = *> 'F'; otherwise, S is an output argument. If FACT = 'F' and EQUED *> = 'Y', each element of S must be positive. If S is output, each @@ -262,7 +262,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -298,14 +298,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -313,9 +313,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/zposvxx.f b/lapack-netlib/SRC/zposvxx.f index 8126f14be..913d16cb2 100644 --- a/lapack-netlib/SRC/zposvxx.f +++ b/lapack-netlib/SRC/zposvxx.f @@ -45,7 +45,7 @@ *> *> ZPOSVXX uses the Cholesky factorization A = U**T*U or A = L*L**T *> to compute the solution to a complex*16 system of linear equations -*> A * X = B, where A is an N-by-N symmetric positive definite matrix +*> A * X = B, where A is an N-by-N Hermitian positive definite matrix *> and X and B are N-by-NRHS matrices. *> *> If requested, both normwise and maximum componentwise error bounds @@ -157,7 +157,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the symmetric matrix A, except if FACT = 'F' and EQUED = +*> On entry, the Hermitian matrix A, except if FACT = 'F' and EQUED = *> 'Y', then A must contain the equilibrated matrix *> diag(S)*A*diag(S). If UPLO = 'U', the leading N-by-N upper *> triangular part of A contains the upper triangular part of the @@ -365,7 +365,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -401,14 +401,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -416,9 +416,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/zpotrf2.f b/lapack-netlib/SRC/zpotrf2.f index e37c9f6d6..85c434d47 100644 --- a/lapack-netlib/SRC/zpotrf2.f +++ b/lapack-netlib/SRC/zpotrf2.f @@ -24,7 +24,7 @@ *> *> \verbatim *> -*> ZPOTRF2 computes the Cholesky factorization of a real symmetric +*> ZPOTRF2 computes the Cholesky factorization of a Hermitian *> positive definite matrix A using the recursive algorithm. *> *> The factorization has the form @@ -63,7 +63,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the symmetric matrix A. If UPLO = 'U', the leading +*> On entry, the Hermitian matrix A. If UPLO = 'U', the leading *> N-by-N upper triangular part of A contains the upper *> triangular part of the matrix A, and the strictly lower *> triangular part of A is not referenced. If UPLO = 'L', the diff --git a/lapack-netlib/SRC/zstemr.f b/lapack-netlib/SRC/zstemr.f index ac7552a6a..8685542de 100644 --- a/lapack-netlib/SRC/zstemr.f +++ b/lapack-netlib/SRC/zstemr.f @@ -250,13 +250,13 @@ *> \param[in,out] TRYRAC *> \verbatim *> TRYRAC is LOGICAL -*> If TRYRAC.EQ..TRUE., indicates that the code should check whether +*> If TRYRAC = .TRUE., indicates that the code should check whether *> the tridiagonal matrix defines its eigenvalues to high relative *> accuracy. If so, the code uses relative-accuracy preserving *> algorithms that might be (a bit) slower depending on the matrix. *> If the matrix does not define its eigenvalues to high relative *> accuracy, the code can uses possibly faster algorithms. -*> If TRYRAC.EQ..FALSE., the code is not required to guarantee +*> If TRYRAC = .FALSE., the code is not required to guarantee *> relatively accurate eigenvalues and can use the fastest possible *> techniques. *> On exit, a .TRUE. TRYRAC will be set to .FALSE. if the matrix diff --git a/lapack-netlib/SRC/zsycon_3.f b/lapack-netlib/SRC/zsycon_3.f index 856845960..33bd23849 100644 --- a/lapack-netlib/SRC/zsycon_3.f +++ b/lapack-netlib/SRC/zsycon_3.f @@ -19,7 +19,7 @@ * =========== * * SUBROUTINE ZSYCON_3( UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, -* WORK, IWORK, INFO ) +* WORK, INFO ) * * .. Scalar Arguments .. * CHARACTER UPLO @@ -27,7 +27,7 @@ * DOUBLE PRECISION ANORM, RCOND * .. * .. Array Arguments .. -* INTEGER IPIV( * ), IWORK( * ) +* INTEGER IPIV( * ) * COMPLEX*16 A( LDA, * ), E ( * ), WORK( * ) * .. * @@ -129,11 +129,6 @@ *> WORK is COMPLEX*16 array, dimension (2*N) *> \endverbatim *> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (N) -*> \endverbatim -*> *> \param[out] INFO *> \verbatim *> INFO is INTEGER diff --git a/lapack-netlib/SRC/zsyconvf.f b/lapack-netlib/SRC/zsyconvf.f index b26bfd63b..2d5ce882e 100644 --- a/lapack-netlib/SRC/zsyconvf.f +++ b/lapack-netlib/SRC/zsyconvf.f @@ -294,7 +294,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -347,7 +347,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -438,7 +438,7 @@ * * Convert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where k increases from 1 to N * I = 1 @@ -491,7 +491,7 @@ * * Revert PERMUTATIONS and IPIV * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/zsyconvf_rook.f b/lapack-netlib/SRC/zsyconvf_rook.f index 5c36f4bcd..410d2eb34 100644 --- a/lapack-netlib/SRC/zsyconvf_rook.f +++ b/lapack-netlib/SRC/zsyconvf_rook.f @@ -285,7 +285,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in factorization order where i decreases from N to 1 * I = N @@ -336,7 +336,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of upper part of A +* Apply permutations to submatrices of upper part of A * in reverse factorization order where i increases from 1 to N * I = 1 @@ -426,7 +426,7 @@ * * Convert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in factorization order where i increases from 1 to N * I = 1 @@ -477,7 +477,7 @@ * * Revert PERMUTATIONS * -* Apply permutaions to submatrices of lower part of A +* Apply permutations to submatrices of lower part of A * in reverse factorization order where i decreases from N to 1 * I = N diff --git a/lapack-netlib/SRC/zsyrfsx.f b/lapack-netlib/SRC/zsyrfsx.f index 3420d70cd..d086510d8 100644 --- a/lapack-netlib/SRC/zsyrfsx.f +++ b/lapack-netlib/SRC/zsyrfsx.f @@ -271,7 +271,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -307,14 +307,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -322,9 +322,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the double-precision refinement algorithm, +*> = 1.0: Use the double-precision refinement algorithm, *> possibly with doubled-single computations if the *> compilation environment does not support DOUBLE *> PRECISION. diff --git a/lapack-netlib/SRC/zsysv_aa.f b/lapack-netlib/SRC/zsysv_aa.f index 325d07c54..4e87bd105 100644 --- a/lapack-netlib/SRC/zsysv_aa.f +++ b/lapack-netlib/SRC/zsysv_aa.f @@ -42,7 +42,7 @@ *> matrices. *> *> Aasen's algorithm is used to factor A as -*> A = U * T * U**T, if UPLO = 'U', or +*> A = U**T * T * U, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric tridiagonal. The factored @@ -86,7 +86,7 @@ *> *> On exit, if INFO = 0, the tridiagonal matrix T and the *> multipliers used to obtain the factor U or L from the -*> factorization A = U*T*U**T or A = L*T*L**T as computed by +*> factorization A = U**T*T*U or A = L*T*L**T as computed by *> ZSYTRF. *> \endverbatim *> @@ -230,7 +230,7 @@ RETURN END IF * -* Compute the factorization A = U*T*U**T or A = L*T*L**T. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL ZSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) IF( INFO.EQ.0 ) THEN diff --git a/lapack-netlib/SRC/zsysv_aa_2stage.f b/lapack-netlib/SRC/zsysv_aa_2stage.f index 029ed587d..923eaaec0 100644 --- a/lapack-netlib/SRC/zsysv_aa_2stage.f +++ b/lapack-netlib/SRC/zsysv_aa_2stage.f @@ -43,8 +43,8 @@ *> matrices. *> *> Aasen's 2-stage algorithm is used to factor A as -*> A = U * T * U**H, if UPLO = 'U', or -*> A = L * T * L**H, if UPLO = 'L', +*> A = U**T * T * U, if UPLO = 'U', or +*> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is symmetric and band. The matrix T is *> then LU-factored with partial pivoting. The factored form of A @@ -257,7 +257,7 @@ END IF * * -* Compute the factorization A = U*T*U**H or A = L*T*L**H. +* Compute the factorization A = U**T*T*U or A = L*T*L**T. * CALL ZSYTRF_AA_2STAGE( UPLO, N, A, LDA, TB, LTB, IPIV, IPIV2, $ WORK, LWORK, INFO ) diff --git a/lapack-netlib/SRC/zsysvxx.f b/lapack-netlib/SRC/zsysvxx.f index ef44d09d3..e29439385 100644 --- a/lapack-netlib/SRC/zsysvxx.f +++ b/lapack-netlib/SRC/zsysvxx.f @@ -378,7 +378,7 @@ *> information as described below. There currently are up to three *> pieces of information returned for each right-hand side. If *> componentwise accuracy is not requested (PARAMS(3) = 0.0), then -*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS .LT. 3, then at most +*> ERR_BNDS_COMP is not accessed. If N_ERR_BNDS < 3, then at most *> the first (:,N_ERR_BNDS) entries are returned. *> *> The first index in ERR_BNDS_COMP(i,:) corresponds to the ith @@ -414,14 +414,14 @@ *> \param[in] NPARAMS *> \verbatim *> NPARAMS is INTEGER -*> Specifies the number of parameters set in PARAMS. If .LE. 0, the +*> Specifies the number of parameters set in PARAMS. If <= 0, the *> PARAMS array is never referenced and default values are used. *> \endverbatim *> *> \param[in,out] PARAMS *> \verbatim *> PARAMS is DOUBLE PRECISION array, dimension NPARAMS -*> Specifies algorithm parameters. If an entry is .LT. 0.0, then +*> Specifies algorithm parameters. If an entry is < 0.0, then *> that entry will be filled with default value used for that *> parameter. Only positions up to NPARAMS are accessed; defaults *> are used for higher-numbered parameters. @@ -429,9 +429,9 @@ *> PARAMS(LA_LINRX_ITREF_I = 1) : Whether to perform iterative *> refinement or not. *> Default: 1.0D+0 -*> = 0.0 : No refinement is performed, and no error bounds are +*> = 0.0: No refinement is performed, and no error bounds are *> computed. -*> = 1.0 : Use the extra-precise refinement algorithm. +*> = 1.0: Use the extra-precise refinement algorithm. *> (other values are reserved for future use) *> *> PARAMS(LA_LINRX_ITHRESH_I = 2) : Maximum number of residual diff --git a/lapack-netlib/SRC/zsytf2_rk.f b/lapack-netlib/SRC/zsytf2_rk.f index b1a02f4a5..4ae1a4a22 100644 --- a/lapack-netlib/SRC/zsytf2_rk.f +++ b/lapack-netlib/SRC/zsytf2_rk.f @@ -321,7 +321,7 @@ * * Factorize A as U*D*U**T using the upper triangle of A * -* Initilize the first entry of array E, where superdiagonal +* Initialize the first entry of array E, where superdiagonal * elements of D are stored * E( 1 ) = CZERO @@ -632,7 +632,7 @@ * * Factorize A as L*D*L**T using the lower triangle of A * -* Initilize the unused last entry of the subdiagonal array E. +* Initialize the unused last entry of the subdiagonal array E. * E( N ) = CZERO * diff --git a/lapack-netlib/SRC/zsytrf.f b/lapack-netlib/SRC/zsytrf.f index 663199c8a..54e22cca1 100644 --- a/lapack-netlib/SRC/zsytrf.f +++ b/lapack-netlib/SRC/zsytrf.f @@ -43,7 +43,7 @@ *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and D is symmetric and block diagonal with -*> with 1-by-1 and 2-by-2 diagonal blocks. +*> 1-by-1 and 2-by-2 diagonal blocks. *> *> This is the blocked version of the algorithm, calling Level 3 BLAS. *> \endverbatim diff --git a/lapack-netlib/SRC/zsytrf_aa.f b/lapack-netlib/SRC/zsytrf_aa.f index b25b1fbce..e547c6a60 100644 --- a/lapack-netlib/SRC/zsytrf_aa.f +++ b/lapack-netlib/SRC/zsytrf_aa.f @@ -37,7 +37,7 @@ *> ZSYTRF_AA computes the factorization of a complex symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a complex symmetric tridiagonal matrix. @@ -223,7 +223,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * * Copy first row A(1, 1:N) into H(1:n) (stored in WORK(1:N)) @@ -256,7 +256,7 @@ $ A( MAX(1, J), J+1 ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J @@ -375,7 +375,7 @@ $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) ) * -* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) +* Adjust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J diff --git a/lapack-netlib/SRC/zsytrf_aa_2stage.f b/lapack-netlib/SRC/zsytrf_aa_2stage.f index d3486c1a7..67a1c1f6f 100644 --- a/lapack-netlib/SRC/zsytrf_aa_2stage.f +++ b/lapack-netlib/SRC/zsytrf_aa_2stage.f @@ -38,7 +38,7 @@ *> ZSYTRF_AA_2STAGE computes the factorization of a complex symmetric matrix A *> using the Aasen's algorithm. The form of the factorization is *> -*> A = U*T*U**T or A = L*T*L**T +*> A = U**T*T*U or A = L*T*L**T *> *> where U (or L) is a product of permutation and unit upper (lower) *> triangular matrices, and T is a complex symmetric band matrix with the @@ -275,7 +275,7 @@ IF( UPPER ) THEN * * ..................................................... -* Factorize A as L*D*L**T using the upper triangle of A +* Factorize A as U**T*D*U using the upper triangle of A * ..................................................... * DO J = 0, NT-1 @@ -448,12 +448,14 @@ c END IF * > Apply pivots to previous columns of L CALL ZSWAP( K-1, A( (J+1)*NB+1, I1 ), 1, $ A( (J+1)*NB+1, I2 ), 1 ) -* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA, - $ A( I1+1, I2 ), 1 ) +* > Swap A(I1+1:M, I1) with A(I2, I1+1:M) + IF( I2.GT.(I1+1) ) + $ CALL ZSWAP( I2-I1-1, A( I1, I1+1 ), LDA, + $ A( I1+1, I2 ), 1 ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA, - $ A( I2, I2+1 ), LDA ) + IF( I2.LT.N ) + $ CALL ZSWAP( N-I2, A( I1, I2+1 ), LDA, + $ A( I2, I2+1 ), LDA ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) @@ -637,11 +639,13 @@ c END IF CALL ZSWAP( K-1, A( I1, (J+1)*NB+1 ), LDA, $ A( I2, (J+1)*NB+1 ), LDA ) * > Swap A(I1+1:M, I1) with A(I2, I1+1:M) - CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1, - $ A( I2, I1+1 ), LDA ) + IF( I2.GT.(I1+1) ) + $ CALL ZSWAP( I2-I1-1, A( I1+1, I1 ), 1, + $ A( I2, I1+1 ), LDA ) * > Swap A(I2+1:M, I1) with A(I2+1:M, I2) - CALL ZSWAP( N-I2, A( I2+1, I1 ), 1, - $ A( I2+1, I2 ), 1 ) + IF( I2.LT.N ) + $ CALL ZSWAP( N-I2, A( I2+1, I1 ), 1, + $ A( I2+1, I2 ), 1 ) * > Swap A(I1, I1) with A(I2, I2) PIV = A( I1, I1 ) A( I1, I1 ) = A( I2, I2 ) diff --git a/lapack-netlib/SRC/zsytri2.f b/lapack-netlib/SRC/zsytri2.f index e7303c90b..9929eb2c6 100644 --- a/lapack-netlib/SRC/zsytri2.f +++ b/lapack-netlib/SRC/zsytri2.f @@ -62,7 +62,7 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) -*> On entry, the NB diagonal matrix D and the multipliers +*> On entry, the block diagonal matrix D and the multipliers *> used to obtain the factor U or L as computed by ZSYTRF. *> *> On exit, if INFO = 0, the (symmetric) inverse of the original @@ -82,7 +82,7 @@ *> \param[in] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> Details of the interchanges and the NB structure of D +*> Details of the interchanges and the block structure of D *> as determined by ZSYTRF. *> \endverbatim *> diff --git a/lapack-netlib/SRC/zsytrs2.f b/lapack-netlib/SRC/zsytrs2.f index c0ee206a5..6e9cca425 100644 --- a/lapack-netlib/SRC/zsytrs2.f +++ b/lapack-netlib/SRC/zsytrs2.f @@ -36,7 +36,7 @@ *> *> \verbatim *> -*> ZSYTRS2 solves a system of linear equations A*X = B with a real +*> ZSYTRS2 solves a system of linear equations A*X = B with a complex *> symmetric matrix A using the factorization A = U*D*U**T or *> A = L*D*L**T computed by ZSYTRF and converted by ZSYCONV. *> \endverbatim diff --git a/lapack-netlib/SRC/zsytrs_aa.f b/lapack-netlib/SRC/zsytrs_aa.f index e62e9e486..0f0664009 100644 --- a/lapack-netlib/SRC/zsytrs_aa.f +++ b/lapack-netlib/SRC/zsytrs_aa.f @@ -37,7 +37,7 @@ *> \verbatim *> *> ZSYTRS_AA solves a system of linear equations A*X = B with a complex -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by ZSYTRF_AA. *> \endverbatim * @@ -49,7 +49,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -97,14 +97,16 @@ *> The leading dimension of the array B. LDB >= max(1,N). *> \endverbatim *> -*> \param[in] WORK +*> \param[out] WORK *> \verbatim -*> WORK is DOUBLE array, dimension (MAX(1,LWORK)) +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK *> \verbatim -*> LWORK is INTEGER, LWORK >= MAX(1,3*N-2). +*> LWORK is INTEGER +*> The dimension of the array WORK. LWORK >= max(1,3*N-2). +*> \endverbatim *> *> \param[out] INFO *> \verbatim @@ -198,22 +200,29 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. +* +* 1) Forward substitution with U**T +* + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* Pivot, P**T * B + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO +* Compute U**T \ B -> B [ (U**T \P**T * B) ] * -* Compute (U \P**T * B) -> B [ (U \P**T * B) ] + CALL ZTRSM( 'L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL ZTRSM('L', 'U', 'T', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * -* Compute T \ B -> B [ T \ (U \P**T * B) ] +* Compute T \ B -> B [ T \ (U**T \P**T * B) ] * CALL ZLACPY( 'F', 1, N, A( 1, 1 ), LDA+1, WORK( N ), 1) IF( N.GT.1 ) THEN @@ -223,35 +232,47 @@ CALL ZGTSV( N, NRHS, WORK( 1 ), WORK( N ), WORK( 2*N ), B, LDB, $ INFO ) * -* Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] +* 3) Backward substitution with U * - CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, - $ B( 2, 1 ), LDB) + IF( N.GT.1 ) THEN * -* Pivot, P * B [ P * (U**T \ (T \ (U \P**T * B) )) ] +* Compute U \ B -> B [ U \ (T \ (U**T \P**T * B) ) ] * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), + $ LDA, B( 2, 1 ), LDB) +* +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * ELSE * * Solve A*X = B, where A = L*T*L**T. * -* Pivot, P**T * B +* 1) Forward substitution with L * - DO K = 1, N - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + IF( N.GT.1 ) THEN +* +* Pivot, P**T * B -> B * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] + DO K = 1, N + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO +* +* Compute L \ B -> B [ (L \P**T * B) ] +* + CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) + END IF * - CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) +* 2) Solve with triangular matrix T * * Compute T \ B -> B [ T \ (L \P**T * B) ] * @@ -263,18 +284,23 @@ CALL ZGTSV( N, NRHS, WORK( 1 ), WORK(N), WORK( 2*N ), B, LDB, $ INFO) * -* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] +* 3) Backward substitution with L**T * - CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, - $ B( 2, 1 ), LDB) + IF( N.GT.1 ) THEN * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] * - DO K = N, 1, -1 - KP = IPIV( K ) - IF( KP.NE.K ) - $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) - END DO + CALL ZTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), + $ LDA, B( 2, 1 ), LDB) +* +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* + DO K = N, 1, -1 + KP = IPIV( K ) + IF( KP.NE.K ) + $ CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB ) + END DO + END IF * END IF * diff --git a/lapack-netlib/SRC/zsytrs_aa_2stage.f b/lapack-netlib/SRC/zsytrs_aa_2stage.f index fa15eee90..bf060b2d3 100644 --- a/lapack-netlib/SRC/zsytrs_aa_2stage.f +++ b/lapack-netlib/SRC/zsytrs_aa_2stage.f @@ -36,7 +36,7 @@ *> \verbatim *> *> ZSYTRS_AA_2STAGE solves a system of linear equations A*X = B with a complex -*> symmetric matrix A using the factorization A = U*T*U**T or +*> symmetric matrix A using the factorization A = U**T*T*U or *> A = L*T*L**T computed by ZSYTRF_AA_2STAGE. *> \endverbatim * @@ -48,7 +48,7 @@ *> UPLO is CHARACTER*1 *> Specifies whether the details of the factorization are stored *> as an upper or lower triangular matrix. -*> = 'U': Upper triangular, form is A = U*T*U**T; +*> = 'U': Upper triangular, form is A = U**T*T*U; *> = 'L': Lower triangular, form is A = L*T*L**T. *> \endverbatim *> @@ -208,15 +208,15 @@ * IF( UPPER ) THEN * -* Solve A*X = B, where A = U*T*U**T. +* Solve A*X = B, where A = U**T*T*U. * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (U**T \P**T * B) -> B [ (U**T \P**T * B) ] +* Compute (U**T \ B) -> B [ (U**T \P**T * B) ] * CALL ZTRSM( 'L', 'U', 'T', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) @@ -234,7 +234,7 @@ CALL ZTRSM( 'L', 'U', 'N', 'U', N-NB, NRHS, ONE, A(1, NB+1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (U \ (T \ (U**T \P**T * B) )) ] +* Pivot, P * B -> B [ P * (U \ (T \ (U**T \P**T * B) )) ] * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * @@ -246,11 +246,11 @@ * IF( N.GT.NB ) THEN * -* Pivot, P**T * B +* Pivot, P**T * B -> B * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, 1 ) * -* Compute (L \P**T * B) -> B [ (L \P**T * B) ] +* Compute (L \ B) -> B [ (L \P**T * B) ] * CALL ZTRSM( 'L', 'L', 'N', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) @@ -268,7 +268,7 @@ CALL ZTRSM( 'L', 'L', 'T', 'U', N-NB, NRHS, ONE, A(NB+1, 1), $ LDA, B(NB+1, 1), LDB) * -* Pivot, P * B [ P * (L**T \ (T \ (L \P**T * B) )) ] +* Pivot, P * B -> B [ P * (L**T \ (T \ (L \P**T * B) )) ] * CALL ZLASWP( NRHS, B, LDB, NB+1, N, IPIV, -1 ) * diff --git a/lapack-netlib/SRC/ztgsy2.f b/lapack-netlib/SRC/ztgsy2.f index f89effd6c..028ddfd3d 100644 --- a/lapack-netlib/SRC/ztgsy2.f +++ b/lapack-netlib/SRC/ztgsy2.f @@ -67,7 +67,7 @@ *> R * B**H + L * E**H = scale * -F *> *> This case is used to compute an estimate of Dif[(A, D), (B, E)] = -*> = sigma_min(Z) using reverse communicaton with ZLACON. +*> = sigma_min(Z) using reverse communication with ZLACON. *> *> ZTGSY2 also (IJOB >= 1) contributes to the computation in ZTGSYL *> of an upper bound on the separation between to matrix pairs. Then @@ -81,7 +81,7 @@ *> \param[in] TRANS *> \verbatim *> TRANS is CHARACTER*1 -*> = 'N', solve the generalized Sylvester equation (1). +*> = 'N': solve the generalized Sylvester equation (1). *> = 'T': solve the 'transposed' system (3). *> \endverbatim *> diff --git a/lapack-netlib/SRC/ztpmlqt.f b/lapack-netlib/SRC/ztpmlqt.f index 6a67e4443..cc333f5a2 100644 --- a/lapack-netlib/SRC/ztpmlqt.f +++ b/lapack-netlib/SRC/ztpmlqt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is COMPLEX*16 array, dimension (LDA,K) +*> V is COMPLEX*16 array, dimension (LDV,K) *> The i-th row must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> DTPLQT in B. See Further Details. diff --git a/lapack-netlib/SRC/ztpmqrt.f b/lapack-netlib/SRC/ztpmqrt.f index aca7ff00f..530dca458 100644 --- a/lapack-netlib/SRC/ztpmqrt.f +++ b/lapack-netlib/SRC/ztpmqrt.f @@ -94,7 +94,7 @@ *> *> \param[in] V *> \verbatim -*> V is COMPLEX*16 array, dimension (LDA,K) +*> V is COMPLEX*16 array, dimension (LDV,K) *> The i-th column must contain the vector which defines the *> elementary reflector H(i), for i = 1,2,...,k, as returned by *> CTPQRT in B. See Further Details. diff --git a/lapack-netlib/SRC/ztprfb.f b/lapack-netlib/SRC/ztprfb.f index 1a62829d5..f96c237ee 100644 --- a/lapack-netlib/SRC/ztprfb.f +++ b/lapack-netlib/SRC/ztprfb.f @@ -152,8 +152,8 @@ *> \verbatim *> LDA is INTEGER *> The leading dimension of the array A. -*> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'L', LDA >= max(1,K); +*> If SIDE = 'R', LDA >= max(1,M). *> \endverbatim *> *> \param[in,out] B diff --git a/lapack-netlib/SRC/zungtsqr.f b/lapack-netlib/SRC/zungtsqr.f new file mode 100644 index 000000000..7b04e9a29 --- /dev/null +++ b/lapack-netlib/SRC/zungtsqr.f @@ -0,0 +1,307 @@ +*> \brief \b ZUNGTSQR +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNGTSQR + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE ZUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, +* $ INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNGTSQR generates an M-by-N complex matrix Q_out with orthonormal +*> columns, which are the first N columns of a product of comlpex unitary +*> matrices of order M which are returned by ZLATSQR +*> +*> Q_out = first_N_columns_of( Q(1)_in * Q(2)_in * ... * Q(k)_in ). +*> +*> See the documentation for ZLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] MB +*> \verbatim +*> MB is INTEGER +*> The row block size used by DLATSQR to return +*> arrays A and T. MB > N. +*> (Note that if MB > M, then M is used instead of MB +*> as the row block size). +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size used by ZLATSQR to return +*> arrays A and T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size). +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> +*> On entry: +*> +*> The elements on and above the diagonal are not accessed. +*> The elements below the diagonal represent the unit +*> lower-trapezoidal blocked matrix V computed by ZLATSQR +*> that defines the input matrices Q_in(k) (ones on the +*> diagonal are not stored) (same format as the output A +*> below the diagonal in ZLATSQR). +*> +*> On exit: +*> +*> The array A contains an M-by-N orthonormal matrix Q_out, +*> i.e the columns of A are orthogonal unit vectors. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is COMPLEX*16 array, +*> dimension (LDT, N * NIRB) +*> where NIRB = Number_of_input_row_blocks +*> = MAX( 1, CEIL((M-N)/(MB-N)) ) +*> Let NICB = Number_of_input_col_blocks +*> = CEIL(N/NB) +*> +*> The upper-triangular block reflectors used to define the +*> input matrices Q_in(k), k=(1:NIRB*NICB). The block +*> reflectors are stored in compact form in NIRB block +*> reflector sequences. Each of NIRB block reflector sequences +*> is stored in a larger NB-by-N column block of T and consists +*> of NICB smaller NB-by-NB upper-triangular column blocks. +*> (same format as the output T in ZLATSQR). +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB1,N)). +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> (workspace) COMPLEX*16 array, dimension (MAX(2,LWORK)) +*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> The dimension of the array WORK. LWORK >= (M+NB)*N. +*> If LWORK = -1, then a workspace query is assumed. +*> The routine only calculates the optimal size of the WORK +*> array, returns this value as the first entry of the WORK +*> array, and no error message related to LWORK is issued +*> by XERBLA. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup comlex16OTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE ZUNGTSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + $ INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, LWORK, M, N, MB, NB +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 CONE, CZERO + PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ), + $ CZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL LQUERY + INTEGER IINFO, LDC, LWORKOPT, LC, LW, NBLOCAL, J +* .. +* .. External Subroutines .. + EXTERNAL ZCOPY, ZLAMTSQR, ZLASET, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC DCMPLX, MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + LQUERY = LWORK.EQ.-1 + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. M.LT.N ) THEN + INFO = -2 + ELSE IF( MB.LE.N ) THEN + INFO = -3 + ELSE IF( NB.LT.1 ) THEN + INFO = -4 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -6 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -8 + ELSE +* +* Test the input LWORK for the dimension of the array WORK. +* This workspace is used to store array C(LDC, N) and WORK(LWORK) +* in the call to ZLAMTSQR. See the documentation for ZLAMTSQR. +* + IF( LWORK.LT.2 .AND. (.NOT.LQUERY) ) THEN + INFO = -10 + ELSE +* +* Set block size for column blocks +* + NBLOCAL = MIN( NB, N ) +* +* LWORK = -1, then set the size for the array C(LDC,N) +* in ZLAMTSQR call and set the optimal size of the work array +* WORK(LWORK) in ZLAMTSQR call. +* + LDC = M + LC = LDC*N + LW = N * NBLOCAL +* + LWORKOPT = LC+LW +* + IF( ( LWORK.LT.MAX( 1, LWORKOPT ) ).AND.(.NOT.LQUERY) ) THEN + INFO = -10 + END IF + END IF +* + END IF +* +* Handle error in the input parameters and return workspace query. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNGTSQR', -INFO ) + RETURN + ELSE IF ( LQUERY ) THEN + WORK( 1 ) = DCMPLX( LWORKOPT ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + WORK( 1 ) = DCMPLX( LWORKOPT ) + RETURN + END IF +* +* (1) Form explicitly the tall-skinny M-by-N left submatrix Q1_in +* of M-by-M orthogonal matrix Q_in, which is implicitly stored in +* the subdiagonal part of input array A and in the input array T. +* Perform by the following operation using the routine ZLAMTSQR. +* +* Q1_in = Q_in * ( I ), where I is a N-by-N identity matrix, +* ( 0 ) 0 is a (M-N)-by-N zero matrix. +* +* (1a) Form M-by-N matrix in the array WORK(1:LDC*N) with ones +* on the diagonal and zeros elsewhere. +* + CALL ZLASET( 'F', M, N, CZERO, CONE, WORK, LDC ) +* +* (1b) On input, WORK(1:LDC*N) stores ( I ); +* ( 0 ) +* +* On output, WORK(1:LDC*N) stores Q1_in. +* + CALL ZLAMTSQR( 'L', 'N', M, N, N, MB, NBLOCAL, A, LDA, T, LDT, + $ WORK, LDC, WORK( LC+1 ), LW, IINFO ) +* +* (2) Copy the result from the part of the work array (1:M,1:N) +* with the leading dimension LDC that starts at WORK(1) into +* the output array A(1:M,1:N) column-by-column. +* + DO J = 1, N + CALL ZCOPY( M, WORK( (J-1)*LDC + 1 ), 1, A( 1, J ), 1 ) + END DO +* + WORK( 1 ) = DCMPLX( LWORKOPT ) + RETURN +* +* End of ZUNGTSQR +* + END \ No newline at end of file diff --git a/lapack-netlib/SRC/zunhr_col.f b/lapack-netlib/SRC/zunhr_col.f new file mode 100644 index 000000000..71039fddb --- /dev/null +++ b/lapack-netlib/SRC/zunhr_col.f @@ -0,0 +1,441 @@ +*> \brief \b ZUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZUNHR_COL + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> +* Definition: +* =========== +* +* SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) +* +* .. Scalar Arguments .. +* INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. +* COMPLEX*16 A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNHR_COL takes an M-by-N complex matrix Q_in with orthonormal columns +*> as input, stored in A, and performs Householder Reconstruction (HR), +*> i.e. reconstructs Householder vectors V(i) implicitly representing +*> another M-by-N matrix Q_out, with the property that Q_in = Q_out*S, +*> where S is an N-by-N diagonal matrix with diagonal entries +*> equal to +1 or -1. The Householder vectors (columns V(i) of V) are +*> stored in A on output, and the diagonal entries of S are stored in D. +*> Block reflectors are also returned in T +*> (same output format as ZGEQRT). +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> The number of rows of the matrix A. M >= 0. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The number of columns of the matrix A. M >= N >= 0. +*> \endverbatim +*> +*> \param[in] NB +*> \verbatim +*> NB is INTEGER +*> The column block size to be used in the reconstruction +*> of Householder column vector blocks in the array A and +*> corresponding block reflectors in the array T. NB >= 1. +*> (Note that if NB > N, then N is used instead of NB +*> as the column block size.) +*> \endverbatim +*> +*> \param[in,out] A +*> \verbatim +*> A is COMPLEX*16 array, dimension (LDA,N) +*> +*> On entry: +*> +*> The array A contains an M-by-N orthonormal matrix Q_in, +*> i.e the columns of A are orthogonal unit vectors. +*> +*> On exit: +*> +*> The elements below the diagonal of A represent the unit +*> lower-trapezoidal matrix V of Householder column vectors +*> V(i). The unit diagonal entries of V are not stored +*> (same format as the output below the diagonal in A from +*> ZGEQRT). The matrix T and the matrix V stored on output +*> in A implicitly define Q_out. +*> +*> The elements above the diagonal contain the factor U +*> of the "modified" LU-decomposition: +*> Q_in - ( S ) = V * U +*> ( 0 ) +*> where 0 is a (M-N)-by-(M-N) zero matrix. +*> \endverbatim +*> +*> \param[in] LDA +*> \verbatim +*> LDA is INTEGER +*> The leading dimension of the array A. LDA >= max(1,M). +*> \endverbatim +*> +*> \param[out] T +*> \verbatim +*> T is COMPLEX*16 array, +*> dimension (LDT, N) +*> +*> Let NOCB = Number_of_output_col_blocks +*> = CEIL(N/NB) +*> +*> On exit, T(1:NB, 1:N) contains NOCB upper-triangular +*> block reflectors used to define Q_out stored in compact +*> form as a sequence of upper-triangular NB-by-NB column +*> blocks (same format as the output T in ZGEQRT). +*> The matrix T and the matrix V stored on output in A +*> implicitly define Q_out. NOTE: The lower triangles +*> below the upper-triangular blcoks will be filled with +*> zeros. See Further Details. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. +*> LDT >= max(1,min(NB,N)). +*> \endverbatim +*> +*> \param[out] D +*> \verbatim +*> D is COMPLEX*16 array, dimension min(M,N). +*> The elements can be only plus or minus one. +*> +*> D(i) is constructed as D(i) = -SIGN(Q_in_i(i,i)), where +*> 1 <= i <= min(M,N), and Q_in_i is Q_in after performing +*> i-1 steps of “modified” Gaussian elimination. +*> See Further Details. +*> \endverbatim +*> +*> \param[out] INFO +*> \verbatim +*> INFO is INTEGER +*> = 0: successful exit +*> < 0: if INFO = -i, the i-th argument had an illegal value +*> \endverbatim +*> +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The computed M-by-M unitary factor Q_out is defined implicitly as +*> a product of unitary matrices Q_out(i). Each Q_out(i) is stored in +*> the compact WY-representation format in the corresponding blocks of +*> matrices V (stored in A) and T. +*> +*> The M-by-N unit lower-trapezoidal matrix V stored in the M-by-N +*> matrix A contains the column vectors V(i) in NB-size column +*> blocks VB(j). For example, VB(1) contains the columns +*> V(1), V(2), ... V(NB). NOTE: The unit entries on +*> the diagonal of Y are not stored in A. +*> +*> The number of column blocks is +*> +*> NOCB = Number_of_output_col_blocks = CEIL(N/NB) +*> +*> where each block is of order NB except for the last block, which +*> is of order LAST_NB = N - (NOCB-1)*NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix V is +*> +*> +*> V = ( VB(1), VB(2), VB(3) ) = +*> +*> = ( 1 ) +*> ( v21 1 ) +*> ( v31 v32 1 ) +*> ( v41 v42 v43 1 ) +*> ( v51 v52 v53 v54 1 ) +*> ( v61 v62 v63 v54 v65 ) +*> +*> +*> For each of the column blocks VB(i), an upper-triangular block +*> reflector TB(i) is computed. These blocks are stored as +*> a sequence of upper-triangular column blocks in the NB-by-N +*> matrix T. The size of each TB(i) block is NB-by-NB, except +*> for the last block, whose size is LAST_NB-by-LAST_NB. +*> +*> For example, if M=6, N=5 and NB=2, the matrix T is +*> +*> T = ( TB(1), TB(2), TB(3) ) = +*> +*> = ( t11 t12 t13 t14 t15 ) +*> ( t22 t24 ) +*> +*> +*> The M-by-M factor Q_out is given as a product of NOCB +*> unitary M-by-M matrices Q_out(i). +*> +*> Q_out = Q_out(1) * Q_out(2) * ... * Q_out(NOCB), +*> +*> where each matrix Q_out(i) is given by the WY-representation +*> using corresponding blocks from the matrices V and T: +*> +*> Q_out(i) = I - VB(i) * TB(i) * (VB(i))**T, +*> +*> where I is the identity matrix. Here is the formula with matrix +*> dimensions: +*> +*> Q(i){M-by-M} = I{M-by-M} - +*> VB(i){M-by-INB} * TB(i){INB-by-INB} * (VB(i))**T {INB-by-M}, +*> +*> where INB = NB, except for the last block NOCB +*> for which INB=LAST_NB. +*> +*> ===== +*> NOTE: +*> ===== +*> +*> If Q_in is the result of doing a QR factorization +*> B = Q_in * R_in, then: +*> +*> B = (Q_out*S) * R_in = Q_out * (S * R_in) = O_out * R_out. +*> +*> So if one wants to interpret Q_out as the result +*> of the QR factorization of B, then corresponding R_out +*> should be obtained by R_out = S * R_in, i.e. some rows of R_in +*> should be multiplied by -1. +*> +*> For the details of the algorithm, see [1]. +*> +*> [1] "Reconstructing Householder vectors from tall-skinny QR", +*> G. Ballard, J. Demmel, L. Grigori, M. Jacquelin, H.D. Nguyen, +*> E. Solomonik, J. Parallel Distrib. Comput., +*> vol. 85, pp. 3-31, 2015. +*> \endverbatim +*> +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16OTHERcomputational +* +*> \par Contributors: +* ================== +*> +*> \verbatim +*> +*> November 2019, Igor Kozachenko, +*> Computer Science Division, +*> University of California, Berkeley +*> +*> \endverbatim +* +* ===================================================================== + SUBROUTINE ZUNHR_COL( M, N, NB, A, LDA, T, LDT, D, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER INFO, LDA, LDT, M, N, NB +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), D( * ), T( LDT, * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 CONE, CZERO + PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ), + $ CZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + INTEGER I, IINFO, J, JB, JBTEMP1, JBTEMP2, JNB, + $ NPLUSONE +* .. +* .. External Subroutines .. + EXTERNAL ZCOPY, ZLAUNHR_COL_GETRFNP, ZSCAL, ZTRSM, + $ XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Executable Statements .. +* +* Test the input parameters +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( NB.LT.1 ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + ELSE IF( LDT.LT.MAX( 1, MIN( NB, N ) ) ) THEN + INFO = -7 + END IF +* +* Handle error in the input parameters. +* + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNHR_COL', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( MIN( M, N ).EQ.0 ) THEN + RETURN + END IF +* +* On input, the M-by-N matrix A contains the unitary +* M-by-N matrix Q_in. +* +* (1) Compute the unit lower-trapezoidal V (ones on the diagonal +* are not stored) by performing the "modified" LU-decomposition. +* +* Q_in - ( S ) = V * U = ( V1 ) * U, +* ( 0 ) ( V2 ) +* +* where 0 is an (M-N)-by-N zero matrix. +* +* (1-1) Factor V1 and U. + + CALL ZLAUNHR_COL_GETRFNP( N, N, A, LDA, D, IINFO ) +* +* (1-2) Solve for V2. +* + IF( M.GT.N ) THEN + CALL ZTRSM( 'R', 'U', 'N', 'N', M-N, N, CONE, A, LDA, + $ A( N+1, 1 ), LDA ) + END IF +* +* (2) Reconstruct the block reflector T stored in T(1:NB, 1:N) +* as a sequence of upper-triangular blocks with NB-size column +* blocking. +* +* Loop over the column blocks of size NB of the array A(1:M,1:N) +* and the array T(1:NB,1:N), JB is the column index of a column +* block, JNB is the column block size at each step JB. +* + NPLUSONE = N + 1 + DO JB = 1, N, NB +* +* (2-0) Determine the column block size JNB. +* + JNB = MIN( NPLUSONE-JB, NB ) +* +* (2-1) Copy the upper-triangular part of the current JNB-by-JNB +* diagonal block U(JB) (of the N-by-N matrix U) stored +* in A(JB:JB+JNB-1,JB:JB+JNB-1) into the upper-triangular part +* of the current JNB-by-JNB block T(1:JNB,JB:JB+JNB-1) +* column-by-column, total JNB*(JNB+1)/2 elements. +* + JBTEMP1 = JB - 1 + DO J = JB, JB+JNB-1 + CALL ZCOPY( J-JBTEMP1, A( JB, J ), 1, T( 1, J ), 1 ) + END DO +* +* (2-2) Perform on the upper-triangular part of the current +* JNB-by-JNB diagonal block U(JB) (of the N-by-N matrix U) stored +* in T(1:JNB,JB:JB+JNB-1) the following operation in place: +* (-1)*U(JB)*S(JB), i.e the result will be stored in the upper- +* triangular part of T(1:JNB,JB:JB+JNB-1). This multiplication +* of the JNB-by-JNB diagonal block U(JB) by the JNB-by-JNB +* diagonal block S(JB) of the N-by-N sign matrix S from the +* right means changing the sign of each J-th column of the block +* U(JB) according to the sign of the diagonal element of the block +* S(JB), i.e. S(J,J) that is stored in the array element D(J). +* + DO J = JB, JB+JNB-1 + IF( D( J ).EQ.CONE ) THEN + CALL ZSCAL( J-JBTEMP1, -CONE, T( 1, J ), 1 ) + END IF + END DO +* +* (2-3) Perform the triangular solve for the current block +* matrix X(JB): +* +* X(JB) * (A(JB)**T) = B(JB), where: +* +* A(JB)**T is a JNB-by-JNB unit upper-triangular +* coefficient block, and A(JB)=V1(JB), which +* is a JNB-by-JNB unit lower-triangular block +* stored in A(JB:JB+JNB-1,JB:JB+JNB-1). +* The N-by-N matrix V1 is the upper part +* of the M-by-N lower-trapezoidal matrix V +* stored in A(1:M,1:N); +* +* B(JB) is a JNB-by-JNB upper-triangular right-hand +* side block, B(JB) = (-1)*U(JB)*S(JB), and +* B(JB) is stored in T(1:JNB,JB:JB+JNB-1); +* +* X(JB) is a JNB-by-JNB upper-triangular solution +* block, X(JB) is the upper-triangular block +* reflector T(JB), and X(JB) is stored +* in T(1:JNB,JB:JB+JNB-1). +* +* In other words, we perform the triangular solve for the +* upper-triangular block T(JB): +* +* T(JB) * (V1(JB)**T) = (-1)*U(JB)*S(JB). +* +* Even though the blocks X(JB) and B(JB) are upper- +* triangular, the routine ZTRSM will access all JNB**2 +* elements of the square T(1:JNB,JB:JB+JNB-1). Therefore, +* we need to set to zero the elements of the block +* T(1:JNB,JB:JB+JNB-1) below the diagonal before the call +* to ZTRSM. +* +* (2-3a) Set the elements to zero. +* + JBTEMP2 = JB - 2 + DO J = JB, JB+JNB-2 + DO I = J-JBTEMP2, NB + T( I, J ) = CZERO + END DO + END DO +* +* (2-3b) Perform the triangular solve. +* + CALL ZTRSM( 'R', 'L', 'C', 'U', JNB, JNB, CONE, + $ A( JB, JB ), LDA, T( 1, JB ), LDT ) +* + END DO +* + RETURN +* +* End of ZUNHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/TESTING/CMakeLists.txt b/lapack-netlib/TESTING/CMakeLists.txt index ec3d85221..d5ca95013 100644 --- a/lapack-netlib/TESTING/CMakeLists.txt +++ b/lapack-netlib/TESTING/CMakeLists.txt @@ -161,7 +161,7 @@ endif() # Only run this test if python 2.7 or greater is found if(PYTHONINTERP_FOUND) message(STATUS "Running Summary") - execute_process(COMMAND ${CMAKE_COMMAND} -E copy ${LAPACK_SOURCE_DIR}/lapack_testing.py ${LAPACK_BINARY_DIR}) + file(COPY ${LAPACK_SOURCE_DIR}/lapack_testing.py DESTINATION ${LAPACK_BINARY_DIR}) add_test( NAME LAPACK_Test_Summary WORKING_DIRECTORY ${LAPACK_BINARY_DIR} diff --git a/lapack-netlib/TESTING/EIG/Makefile b/lapack-netlib/TESTING/EIG/Makefile index 78046125a..b3efebcd0 100644 --- a/lapack-netlib/TESTING/EIG/Makefile +++ b/lapack-netlib/TESTING/EIG/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ######################################################################## # This is the makefile for the eigenvalue test program from LAPACK. # The test files are organized as follows: @@ -33,6 +31,9 @@ include ../../make.inc # ######################################################################## +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + AEIGTST = \ alahdg.o \ alasum.o \ @@ -117,24 +118,26 @@ ZEIGTST = zchkee.o \ zsgt01.o zslect.o \ zstt21.o zstt22.o zunt01.o zunt03.o +.PHONY: all all: single complex double complex16 +.PHONY: single complex double complex16 single: xeigtsts complex: xeigtstc double: xeigtstd complex16: xeigtstz -xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) $(TMGLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) $(TMGLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) $(TMGLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) $(TMGLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ $(AEIGTST): $(FRC) $(SCIGTST): $(FRC) @@ -147,6 +150,7 @@ $(ZEIGTST): $(FRC) FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanexe clean: cleanobj cleanexe cleanobj: rm -f *.o @@ -154,13 +158,10 @@ cleanexe: rm -f xeigtst* schkee.o: schkee.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< dchkee.o: dchkee.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< cchkee.o: cchkee.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< zchkee.o: zchkee.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< diff --git a/lapack-netlib/TESTING/EIG/cbdt05.f b/lapack-netlib/TESTING/EIG/cbdt05.f index 192a8d0b6..5a08ccce3 100644 --- a/lapack-netlib/TESTING/EIG/cbdt05.f +++ b/lapack-netlib/TESTING/EIG/cbdt05.f @@ -52,6 +52,7 @@ *> \verbatim *> A is COMPLEX array, dimension (LDA,N) *> The m by n matrix A. +*> \endverbatim *> *> \param[in] LDA *> \verbatim diff --git a/lapack-netlib/TESTING/EIG/cchkst.f b/lapack-netlib/TESTING/EIG/cchkst.f index 471fe9c92..2d25f3fb1 100644 --- a/lapack-netlib/TESTING/EIG/cchkst.f +++ b/lapack-netlib/TESTING/EIG/cchkst.f @@ -167,7 +167,7 @@ *> CSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because CSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/cchkst2stg.f b/lapack-netlib/TESTING/EIG/cchkst2stg.f index df610c207..5c478577f 100644 --- a/lapack-netlib/TESTING/EIG/cchkst2stg.f +++ b/lapack-netlib/TESTING/EIG/cchkst2stg.f @@ -188,7 +188,7 @@ *> CSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because CSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/cdrgsx.f b/lapack-netlib/TESTING/EIG/cdrgsx.f index 4e0f8b468..746946d07 100644 --- a/lapack-netlib/TESTING/EIG/cdrgsx.f +++ b/lapack-netlib/TESTING/EIG/cdrgsx.f @@ -737,7 +737,7 @@ CALL CLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL CLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) * -* Compute the Schur factorization while swaping the +* Compute the Schur factorization while swapping the * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * CALL CGGESX( 'V', 'V', 'S', CLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, diff --git a/lapack-netlib/TESTING/EIG/cdrvbd.f b/lapack-netlib/TESTING/EIG/cdrvbd.f index 64bed3b13..7b7b01b47 100644 --- a/lapack-netlib/TESTING/EIG/cdrvbd.f +++ b/lapack-netlib/TESTING/EIG/cdrvbd.f @@ -33,8 +33,9 @@ *> *> \verbatim *> -*> CDRVBD checks the singular value decomposition (SVD) driver CGESVD -*> and CGESDD. +*> CDRVBD checks the singular value decomposition (SVD) driver CGESVD, +*> CGESDD, CGESVJ, CGEJSV, CGESVDX, and CGESVDQ. +*> *> CGESVD and CGESDD factors A = U diag(S) VT, where U and VT are *> unitary and diag(S) is diagonal with the entries of the array S on *> its diagonal. The entries of S are the singular values, nonnegative @@ -73,81 +74,92 @@ *> *> Test for CGESDD: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (9) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (10) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (11) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> -*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially +*> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially *> computed U. *> -*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially +*> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially *> computed VT. *> -*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the +*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> +*> Test for CGESVDQ: +*> +*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> +*> (37) | I - U'U | / ( M ulp ) +*> +*> (38) | I - VT VT' | / ( N ulp ) +*> +*> (39) S contains MNMIN nonnegative values in decreasing order. +*> (Return 0 if true, 1/ULP if false.) +*> *> Test for CGESVJ: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (16) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (17) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (18) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> *> Test for CGEJSV: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (20) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (21) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (22) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> *> Test for CGESVDX( 'V', 'V', 'A' )/CGESVDX( 'N', 'N', 'A' ) *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (24) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (25) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (26) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> -*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially +*> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially *> computed U. *> -*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially +*> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially *> computed VT. *> -*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the +*> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> *> Test for CGESVDX( 'V', 'V', 'I' ) *> -*> (8) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) +*> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> -*> (9) | I - U'U | / ( M ulp ) +*> (31) | I - U'U | / ( M ulp ) *> -*> (10) | I - VT VT' | / ( N ulp ) +*> (32) | I - VT VT' | / ( N ulp ) *> *> Test for CGESVDX( 'V', 'V', 'V' ) *> -*> (11) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) +*> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> -*> (12) | I - U'U | / ( M ulp ) +*> (34) | I - U'U | / ( M ulp ) *> -*> (13) | I - VT VT' | / ( N ulp ) +*> (35) | I - VT VT' | / ( N ulp ) *> *> The "sizes" are specified by the arrays MM(1:NSIZES) and *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j)) @@ -393,6 +405,8 @@ * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * June 2016 +* + IMPLICIT NONE * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, @@ -411,7 +425,7 @@ * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE, TWO, HALF + REAL ZERO, ONE, TWO, HALF PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0, $ HALF = 0.5E0 ) COMPLEX CZERO, CONE @@ -431,10 +445,13 @@ REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, $ UNFL, VL, VU * .. +* .. Local Scalars for CGESVDQ .. + INTEGER LIWORK, NUMRANK +* .. * .. Local Arrays .. CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) INTEGER IOLDSD( 4 ), ISEED2( 4 ) - REAL RESULT( 35 ) + REAL RESULT( 39 ) * .. * .. External Functions .. REAL SLAMCH, SLARND @@ -442,8 +459,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD, - $ CGESVD, CGESVJ, CGEJSV, CGESVDX, CLACPY, - $ CLASET, CLATMS, CUNT01, CUNT03 + $ CGESVD, CGESVDQ, CGESVJ, CGEJSV, CGESVDX, + $ CLACPY, CLASET, CLATMS, CUNT01, CUNT03 * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, MAX, MIN @@ -838,8 +855,64 @@ 130 CONTINUE * -* Test CGESVJ: Factorize A -* Note: CGESVJ does not work for M < N +* Test CGESVDQ +* Note: CGESVDQ only works for M >= N +* + RESULT( 36 ) = ZERO + RESULT( 37 ) = ZERO + RESULT( 38 ) = ZERO + RESULT( 39 ) = ZERO +* + IF( M.GE.N ) THEN + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK +* + CALL CLACPY( 'F', M, N, ASAV, LDA, A, LDA ) + SRNAMT = 'CGESVDQ' +* + LRWORK = MAX(2, M, 5*N) + LIWORK = MAX( N, 1 ) + CALL CGESVDQ( 'H', 'N', 'N', 'A', 'A', + $ M, N, A, LDA, SSAV, USAV, LDU, + $ VTSAV, LDVT, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, IINFO ) +* + IF( IINFO.NE.0 ) THEN + WRITE( NOUNIT, FMT = 9995 )'CGESVDQ', IINFO, M, N, + $ JTYPE, LSWORK, IOLDSD + INFO = ABS( IINFO ) + RETURN + END IF +* +* Do tests 36--39 +* + CALL CBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E, + $ VTSAV, LDVT, WORK, RWORK, RESULT( 36 ) ) + IF( M.NE.0 .AND. N.NE.0 ) THEN + CALL CUNT01( 'Columns', M, M, USAV, LDU, WORK, + $ LWORK, RWORK, RESULT( 37 ) ) + CALL CUNT01( 'Rows', N, N, VTSAV, LDVT, WORK, + $ LWORK, RWORK, RESULT( 38 ) ) + END IF + RESULT( 39 ) = ZERO + DO 199 I = 1, MNMIN - 1 + IF( SSAV( I ).LT.SSAV( I+1 ) ) + $ RESULT( 39 ) = ULPINV + IF( SSAV( I ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + 199 CONTINUE + IF( MNMIN.GE.1 ) THEN + IF( SSAV( MNMIN ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + END IF + END IF +* +* Test CGESVJ +* Note: CGESVJ only works for M >= N * RESULT( 15 ) = ZERO RESULT( 16 ) = ZERO @@ -847,13 +920,13 @@ RESULT( 18 ) = ZERO * IF( M.GE.N ) THEN - IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) - LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 - LSWORK = MIN( LSWORK, LWORK ) - LSWORK = MAX( LSWORK, 1 ) - LRWORK = MAX(6,N) - IF( IWSPC.EQ.4 ) - $ LSWORK = LWORK + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + LRWORK = MAX(6,N) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK * CALL CLACPY( 'F', M, N, ASAV, LDA, USAV, LDA ) SRNAMT = 'CGESVJ' @@ -861,8 +934,7 @@ & 0, A, LDVT, WORK, LWORK, RWORK, & LRWORK, IINFO ) * -* CGESVJ retuns V not VT, so we transpose to use the same -* test suite. +* CGESVJ returns V not VH * DO J=1,N DO I=1,N @@ -900,31 +972,30 @@ END IF END IF * -* Test CGEJSV: Factorize A -* Note: CGEJSV does not work for M < N +* Test CGEJSV +* Note: CGEJSV only works for M >= N * RESULT( 19 ) = ZERO RESULT( 20 ) = ZERO RESULT( 21 ) = ZERO RESULT( 22 ) = ZERO IF( M.GE.N ) THEN - IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) - LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 - LSWORK = MIN( LSWORK, LWORK ) - LSWORK = MAX( LSWORK, 1 ) - IF( IWSPC.EQ.4 ) - $ LSWORK = LWORK - LRWORK = MAX( 7, N + 2*M) -* - CALL CLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA ) + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK + LRWORK = MAX( 7, N + 2*M) +* + CALL CLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA ) SRNAMT = 'CGEJSV' CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & WORK, LWORK, RWORK, & LRWORK, IWORK, IINFO ) * -* CGEJSV retuns V not VT, so we transpose to use the same -* test suite. +* CGEJSV returns V not VH * DO 133 J=1,N DO 132 I=1,N @@ -933,7 +1004,7 @@ 133 END DO * IF( IINFO.NE.0 ) THEN - WRITE( NOUNIT, FMT = 9995 )'GESVJ', IINFO, M, N, + WRITE( NOUNIT, FMT = 9995 )'GEJSV', IINFO, M, N, $ JTYPE, LSWORK, IOLDSD INFO = ABS( IINFO ) RETURN @@ -1160,7 +1231,7 @@ * NTEST = 0 NFAIL = 0 - DO 190 J = 1, 35 + DO 190 J = 1, 39 IF( RESULT( J ).GE.ZERO ) $ NTEST = NTEST + 1 IF( RESULT( J ).GE.THRESH ) @@ -1175,7 +1246,7 @@ NTESTF = 2 END IF * - DO 200 J = 1, 35 + DO 200 J = 1, 39 IF( RESULT( J ).GE.THRESH ) THEN WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC, $ IOLDSD, J, RESULT( J ) @@ -1251,6 +1322,12 @@ $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )', $ / '34 = | I - U**T U | / ( M ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ', + $ ' CGESVDQ(H,N,N,A,A', + $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ', + $ / '37 = | I - U**T U | / ( M ulp ) ', + $ / '38 = | I - VT VT**T | / ( N ulp ) ', + $ / '39 = 0 if S contains min(M,N) nonnegative values in', + $ ' decreasing order, else 1/ulp', $ / / ) 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) diff --git a/lapack-netlib/TESTING/EIG/cerred.f b/lapack-netlib/TESTING/EIG/cerred.f index f1670e983..a0ceff76e 100644 --- a/lapack-netlib/TESTING/EIG/cerred.f +++ b/lapack-netlib/TESTING/EIG/cerred.f @@ -36,6 +36,8 @@ *> CGEJSV compute SVD of an M-by-N matrix A where M >= N *> CGESVDX compute SVD of an M-by-N matrix A(by bisection *> and inverse iteration) +*> CGESVDQ compute SVD of an M-by-N matrix A(with a +*> QR-Preconditioned ) *> \endverbatim * * Arguments: @@ -101,7 +103,7 @@ * .. * .. External Subroutines .. EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV, - $ CGESDD, CGESVD + $ CGESDD, CGESVD, CGESVDX, CGESVDQ * .. * .. External Functions .. LOGICAL LSAMEN, CSLECT @@ -495,6 +497,61 @@ ELSE WRITE( NOUT, FMT = 9998 ) END IF +* +* Test CGESVDQ +* + SRNAMT = 'CGESVDQ' + INFOT = 1 + CALL CGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL CGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL CGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL CGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ -1, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 14 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, -1, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 17 + CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, 1, NS, IW, -5, W, 1, RW, 1, INFO ) + CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK ) + NT = 11 + IF( OK ) THEN + WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), + $ NT + ELSE + WRITE( NOUT, FMT = 9998 ) + END IF END IF * * Print a summary line. diff --git a/lapack-netlib/TESTING/EIG/cget51.f b/lapack-netlib/TESTING/EIG/cget51.f index ce1108aa4..ec58086d4 100644 --- a/lapack-netlib/TESTING/EIG/cget51.f +++ b/lapack-netlib/TESTING/EIG/cget51.f @@ -29,12 +29,13 @@ *> *> CGET51 generally checks a decomposition of the form *> -*> A = U B VC> -*> where * means conjugate transpose and U and V are unitary. +*> A = U B V**H +*> +*> where **H means conjugate transpose and U and V are unitary. *> *> Specifically, if ITYPE=1 *> -*> RESULT = | A - U B V* | / ( |A| n ulp ) +*> RESULT = | A - U B V**H | / ( |A| n ulp ) *> *> If ITYPE=2, then: *> @@ -42,7 +43,7 @@ *> *> If ITYPE=3, then: *> -*> RESULT = | I - UU* | / ( n ulp ) +*> RESULT = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -52,9 +53,9 @@ *> \verbatim *> ITYPE is INTEGER *> Specifies the type of tests to be performed. -*> =1: RESULT = | A - U B V* | / ( |A| n ulp ) +*> =1: RESULT = | A - U B V**H | / ( |A| n ulp ) *> =2: RESULT = | A - B | / ( |A| n ulp ) -*> =3: RESULT = | I - UU* | / ( n ulp ) +*> =3: RESULT = | I - U U**H | / ( n ulp ) *> \endverbatim *> *> \param[in] N @@ -218,7 +219,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: Compute W = A - UBV' +* ITYPE=1: Compute W = A - U B V**H * CALL CLACPY( ' ', N, N, A, LDA, WORK, N ) CALL CGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO, @@ -259,7 +260,7 @@ * * Tests not scaled by norm(A) * -* ITYPE=3: Compute UU' - I +* ITYPE=3: Compute U U**H - I * CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, $ WORK, N ) diff --git a/lapack-netlib/TESTING/EIG/chbt21.f b/lapack-netlib/TESTING/EIG/chbt21.f index 90ec74c23..76eb7d115 100644 --- a/lapack-netlib/TESTING/EIG/chbt21.f +++ b/lapack-netlib/TESTING/EIG/chbt21.f @@ -28,14 +28,16 @@ *> *> CHBT21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian banded, U is +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian banded, U is *> unitary, and S is diagonal (if KS=0) or symmetric *> tridiagonal (if KS=1). *> *> Specifically: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -220,7 +222,7 @@ * ANORM = MAX( CLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL ) * -* Compute error matrix: Error = A - U S U* +* Compute error matrix: Error = A - U S U**H * * Copy A from SB to SP storage format. * @@ -271,7 +273,7 @@ * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/EIG/chet21.f b/lapack-netlib/TESTING/EIG/chet21.f index 5aff64904..d5c4f1348 100644 --- a/lapack-netlib/TESTING/EIG/chet21.f +++ b/lapack-netlib/TESTING/EIG/chet21.f @@ -29,8 +29,9 @@ *> *> CHET21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian, U is unitary, and +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian, U is unitary, and *> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if *> KBAND=1). *> @@ -42,18 +43,19 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> *> For ITYPE > 1, the transformation U is expressed as a product -*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)C> and each +*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**H and each *> vector v(j) has its first j elements 0 and the remaining n-j elements *> stored in V(j+1:n,j). *> \endverbatim @@ -66,14 +68,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense unitary matrix: -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> 3: U expressed both as a dense unitary matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -171,7 +174,7 @@ *> \verbatim *> TAU is COMPLEX array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)* in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -294,7 +297,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U* +* ITYPE=1: error = A - U S U**H * CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CLACPY( CUPLO, N, N, A, LDA, WORK, N ) @@ -304,7 +307,6 @@ 10 CONTINUE * IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN -CMK DO 20 J = 1, N - 1 DO 20 J = 2, N - 1 CALL CHER2( CUPLO, N, -CMPLX( E( J ) ), U( 1, J ), 1, $ U( 1, J-1 ), 1, WORK, N ) @@ -314,7 +316,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V* - A +* ITYPE=2: error = V S V**H - A * CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) * @@ -371,7 +373,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V* - I +* ITYPE=3: error = U V**H - I * IF( N.LT.2 ) $ RETURN @@ -407,7 +409,7 @@ CMK DO 20 J = 1, N - 1 * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * IF( ITYPE.EQ.1 ) THEN CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, diff --git a/lapack-netlib/TESTING/EIG/chet22.f b/lapack-netlib/TESTING/EIG/chet22.f index 5087ecbca..354387f2a 100644 --- a/lapack-netlib/TESTING/EIG/chet22.f +++ b/lapack-netlib/TESTING/EIG/chet22.f @@ -42,7 +42,8 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) +*> RESULT(1) = | U**H A U - S | / ( |A| m ulp ) and +*> RESULT(2) = | I - U**H U | / ( m ulp ) *> \endverbatim * * Arguments: @@ -52,7 +53,8 @@ *> ITYPE INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> UPLO CHARACTER *> If UPLO='U', the upper triangle of A will be used and the @@ -122,7 +124,7 @@ *> *> TAU COMPLEX array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> Not modified. @@ -215,7 +217,7 @@ * * Compute error matrix: * -* ITYPE=1: error = U' A U - S +* ITYPE=1: error = U**H A U - S * CALL CHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK, $ N ) @@ -249,7 +251,7 @@ * * Do Test 2 * -* Compute U'U - I +* Compute U**H U - I * IF( ITYPE.EQ.1 ) $ CALL CUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK, diff --git a/lapack-netlib/TESTING/EIG/chpt21.f b/lapack-netlib/TESTING/EIG/chpt21.f index e151a8bd8..f20921bd9 100644 --- a/lapack-netlib/TESTING/EIG/chpt21.f +++ b/lapack-netlib/TESTING/EIG/chpt21.f @@ -29,8 +29,9 @@ *> *> CHPT21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian, U is +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian, U is *> unitary, and S is diagonal (if KBAND=0) or (real) symmetric *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as *> a dense matrix, otherwise the U is expressed as a product of @@ -41,15 +42,16 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> *> Packed storage means that, for example, if UPLO='U', then the columns *> of the upper triangle of A are stored one after another, so that @@ -70,14 +72,16 @@ *> *> If UPLO='U', then V = H(n-1)...H(1), where *> -*> H(j) = I - tau(j) v(j) v(j)C> +*> H(j) = I - tau(j) v(j) v(j)**H +*> *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> the j-th element is 1, and the last n-j elements are 0. *> *> If UPLO='L', then V = H(1)...H(n-1), where *> -*> H(j) = I - tau(j) v(j) v(j)C> +*> H(j) = I - tau(j) v(j) v(j)**H +*> *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .) @@ -91,14 +95,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense unitary matrix: -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> 3: U expressed both as a dense unitary matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -181,7 +186,7 @@ *> \verbatim *> TAU is COMPLEX array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)* in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -313,7 +318,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U* +* ITYPE=1: error = A - U S U**H * CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CCOPY( LAP, AP, 1, WORK, 1 ) @@ -332,7 +337,7 @@ * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V* - A +* ITYPE=2: error = V S V**H - A * CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) * @@ -400,7 +405,7 @@ * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V* - I +* ITYPE=3: error = U V**H - I * IF( N.LT.2 ) $ RETURN @@ -431,7 +436,7 @@ * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * IF( ITYPE.EQ.1 ) THEN CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, diff --git a/lapack-netlib/TESTING/EIG/cstt21.f b/lapack-netlib/TESTING/EIG/cstt21.f index 47d99ac49..3fdfa1675 100644 --- a/lapack-netlib/TESTING/EIG/cstt21.f +++ b/lapack-netlib/TESTING/EIG/cstt21.f @@ -28,14 +28,15 @@ *> *> CSTT21 checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is real symmetric tridiagonal, +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is real symmetric tridiagonal, *> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric *> tridiagonal (if KBAND=1). Two tests are performed: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) *> -*> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -201,7 +202,7 @@ WORK( N**2 ) = AD( N ) ANORM = MAX( ANORM, ABS( AD( N ) )+TEMP1, UNFL ) * -* Norm of A - USU* +* Norm of A - U S U**H * DO 20 J = 1, N CALL CHER( 'L', N, -SD( J ), U( 1, J ), 1, WORK, N ) @@ -228,7 +229,7 @@ * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/EIG/dbdt05.f b/lapack-netlib/TESTING/EIG/dbdt05.f index 3580aec81..356bb5fc8 100644 --- a/lapack-netlib/TESTING/EIG/dbdt05.f +++ b/lapack-netlib/TESTING/EIG/dbdt05.f @@ -52,6 +52,7 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> The m by n matrix A. +*> \endverbatim *> *> \param[in] LDA *> \verbatim diff --git a/lapack-netlib/TESTING/EIG/dchkst.f b/lapack-netlib/TESTING/EIG/dchkst.f index f08deb529..1b4d85f79 100644 --- a/lapack-netlib/TESTING/EIG/dchkst.f +++ b/lapack-netlib/TESTING/EIG/dchkst.f @@ -166,7 +166,7 @@ *> DSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because DSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/dchkst2stg.f b/lapack-netlib/TESTING/EIG/dchkst2stg.f index fc015334d..ca31c9d1f 100644 --- a/lapack-netlib/TESTING/EIG/dchkst2stg.f +++ b/lapack-netlib/TESTING/EIG/dchkst2stg.f @@ -187,7 +187,7 @@ *> DSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because DSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/ddrgsx.f b/lapack-netlib/TESTING/EIG/ddrgsx.f index 44c36407f..7fe9dfc14 100644 --- a/lapack-netlib/TESTING/EIG/ddrgsx.f +++ b/lapack-netlib/TESTING/EIG/ddrgsx.f @@ -769,7 +769,7 @@ CALL DLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL DLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) * -* Compute the Schur factorization while swaping the +* Compute the Schur factorization while swapping the * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * CALL DGGESX( 'V', 'V', 'S', DLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, diff --git a/lapack-netlib/TESTING/EIG/ddrvbd.f b/lapack-netlib/TESTING/EIG/ddrvbd.f index 868679052..bd4ae60da 100644 --- a/lapack-netlib/TESTING/EIG/ddrvbd.f +++ b/lapack-netlib/TESTING/EIG/ddrvbd.f @@ -32,7 +32,7 @@ *> \verbatim *> *> DDRVBD checks the singular value decomposition (SVD) drivers -*> DGESVD, DGESDD, DGESVJ, and DGEJSV. +*> DGESVD, DGESDD, DGESVDQ, DGESVJ, DGEJSV, and DGESVDX. *> *> Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are *> orthogonal and diag(S) is diagonal with the entries of the array S @@ -90,6 +90,17 @@ *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> +*> Test for DGESVDQ: +*> +*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> +*> (37) | I - U'U | / ( M ulp ) +*> +*> (38) | I - VT VT' | / ( N ulp ) +*> +*> (39) S contains MNMIN nonnegative values in decreasing order. +*> (Return 0 if true, 1/ULP if false.) +*> *> Test for DGESVJ: *> *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) @@ -354,6 +365,8 @@ SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO ) +* + IMPLICIT NONE * * -- LAPACK test routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -390,13 +403,19 @@ $ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK, $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL, $ NMAX, NS, NSI, NSV, NTEST - DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, - $ ULPINV, UNFL, VL, VU + DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, + $ ULPINV, UNFL, VL, VU +* .. +* .. Local Scalars for DGESVDQ .. + INTEGER LIWORK, LRWORK, NUMRANK +* .. +* .. Local Arrays for DGESVDQ .. + DOUBLE PRECISION RWORK( 2 ) * .. * .. Local Arrays .. CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) INTEGER IOLDSD( 4 ), ISEED2( 4 ) - DOUBLE PRECISION RESULT( 40 ) + DOUBLE PRECISION RESULT( 39 ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DLARND @@ -404,8 +423,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD, - $ DGESVDX, DGESVJ, DLABAD, DLACPY, DLASET, - $ DLATMS, DORT01, DORT03, XERBLA + $ DGESVDQ, DGESVDX, DGESVJ, DLABAD, DLACPY, + $ DLASET, DLATMS, DORT01, DORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, INT, MAX, MIN @@ -781,8 +800,64 @@ RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) 110 CONTINUE * -* Test DGESVJ: Factorize A -* Note: DGESVJ does not work for M < N +* Test DGESVDQ +* Note: DGESVDQ only works for M >= N +* + RESULT( 36 ) = ZERO + RESULT( 37 ) = ZERO + RESULT( 38 ) = ZERO + RESULT( 39 ) = ZERO +* + IF( M.GE.N ) THEN + IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWS.EQ.4 ) + $ LSWORK = LWORK +* + CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA ) + SRNAMT = 'DGESVDQ' +* + LRWORK = 2 + LIWORK = MAX( N, 1 ) + CALL DGESVDQ( 'H', 'N', 'N', 'A', 'A', + $ M, N, A, LDA, SSAV, USAV, LDU, + $ VTSAV, LDVT, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, IINFO ) +* + IF( IINFO.NE.0 ) THEN + WRITE( NOUT, FMT = 9995 )'DGESVDQ', IINFO, M, N, + $ JTYPE, LSWORK, IOLDSD + INFO = ABS( IINFO ) + RETURN + END IF +* +* Do tests 36--39 +* + CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E, + $ VTSAV, LDVT, WORK, RESULT( 36 ) ) + IF( M.NE.0 .AND. N.NE.0 ) THEN + CALL DORT01( 'Columns', M, M, USAV, LDU, WORK, + $ LWORK, RESULT( 37 ) ) + CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK, + $ LWORK, RESULT( 38 ) ) + END IF + RESULT( 39 ) = ZERO + DO 199 I = 1, MNMIN - 1 + IF( SSAV( I ).LT.SSAV( I+1 ) ) + $ RESULT( 39 ) = ULPINV + IF( SSAV( I ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + 199 CONTINUE + IF( MNMIN.GE.1 ) THEN + IF( SSAV( MNMIN ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + END IF + END IF +* +* Test DGESVJ +* Note: DGESVJ only works for M >= N * RESULT( 15 ) = ZERO RESULT( 16 ) = ZERO @@ -802,8 +877,7 @@ CALL DGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV, & 0, A, LDVT, WORK, LWORK, INFO ) * -* DGESVJ retuns V not VT, so we transpose to use the same -* test suite. +* DGESVJ returns V not VT * DO J=1,N DO I=1,N @@ -841,8 +915,8 @@ END IF END IF * -* Test DGEJSV: Factorize A -* Note: DGEJSV does not work for M < N +* Test DGEJSV +* Note: DGEJSV only works for M >= N * RESULT( 19 ) = ZERO RESULT( 20 ) = ZERO @@ -862,8 +936,7 @@ & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & WORK, LWORK, IWORK, INFO ) * -* DGEJSV retuns V not VT, so we transpose to use the same -* test suite. +* DGEJSV returns V not VT * DO 140 J=1,N DO 130 I=1,N @@ -872,7 +945,7 @@ 140 END DO * IF( IINFO.NE.0 ) THEN - WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N, + WRITE( NOUT, FMT = 9995 )'GEJSV', IINFO, M, N, $ JTYPE, LSWORK, IOLDSD INFO = ABS( IINFO ) RETURN @@ -1086,7 +1159,7 @@ * * End of Loop -- Check for RESULT(j) > THRESH * - DO 210 J = 1, 35 + DO 210 J = 1, 39 IF( RESULT( J ).GE.THRESH ) THEN IF( NFAIL.EQ.0 ) THEN WRITE( NOUT, FMT = 9999 ) @@ -1097,7 +1170,7 @@ NFAIL = NFAIL + 1 END IF 210 CONTINUE - NTEST = NTEST + 35 + NTEST = NTEST + 39 220 CONTINUE 230 CONTINUE 240 CONTINUE @@ -1158,6 +1231,12 @@ $ ' DGESVDX(V,V,V) ', $ / '34 = | I - U**T U | / ( M ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ', + $ ' DGESVDQ(H,N,N,A,A', + $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ', + $ / '37 = | I - U**T U | / ( M ulp ) ', + $ / '38 = | I - VT VT**T | / ( N ulp ) ', + $ / '39 = 0 if S contains min(M,N) nonnegative values in', + $ ' decreasing order, else 1/ulp', $ / / ) 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) diff --git a/lapack-netlib/TESTING/EIG/derred.f b/lapack-netlib/TESTING/EIG/derred.f index 5bde7f67d..94264e256 100644 --- a/lapack-netlib/TESTING/EIG/derred.f +++ b/lapack-netlib/TESTING/EIG/derred.f @@ -36,6 +36,8 @@ *> DGEJSV compute SVD of an M-by-N matrix A where M >= N *> DGESVDX compute SVD of an M-by-N matrix A(by bisection *> and inverse iteration) +*> DGESVDQ compute SVD of an M-by-N matrix A(with a +*> QR-Preconditioned ) *> \endverbatim * * Arguments: @@ -100,7 +102,7 @@ * .. * .. External Subroutines .. EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV, - $ DGESDD, DGESVD + $ DGESDD, DGESVD, DGESVDX, DGESVQ * .. * .. External Functions .. LOGICAL DSLECT, LSAMEN @@ -486,6 +488,61 @@ ELSE WRITE( NOUT, FMT = 9998 ) END IF +* +* Test DGESVDQ +* + SRNAMT = 'DGESVDQ' + INFOT = 1 + CALL DGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL DGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL DGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL DGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 14 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 17 + CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO ) + CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) + NT = 11 + IF( OK ) THEN + WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), + $ NT + ELSE + WRITE( NOUT, FMT = 9998 ) + END IF END IF * * Print a summary line. diff --git a/lapack-netlib/TESTING/EIG/dget39.f b/lapack-netlib/TESTING/EIG/dget39.f index 1d0ec1f45..17e66c8e6 100644 --- a/lapack-netlib/TESTING/EIG/dget39.f +++ b/lapack-netlib/TESTING/EIG/dget39.f @@ -194,7 +194,7 @@ VM5( 2 ) = EPS VM5( 3 ) = SQRT( SMLNUM ) * -* Initalization +* Initialization * KNT = 0 RMAX = ZERO diff --git a/lapack-netlib/TESTING/EIG/dsbt21.f b/lapack-netlib/TESTING/EIG/dsbt21.f index e7db231a9..54795623b 100644 --- a/lapack-netlib/TESTING/EIG/dsbt21.f +++ b/lapack-netlib/TESTING/EIG/dsbt21.f @@ -28,15 +28,16 @@ *> *> DSBT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric banded, U is +*> where **T means transpose, A is symmetric banded, U is *> orthogonal, and S is diagonal (if KS=0) or symmetric *> tridiagonal (if KS=1). *> *> Specifically: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> \endverbatim * * Arguments: @@ -214,7 +215,7 @@ * ANORM = MAX( DLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL ) * -* Compute error matrix: Error = A - U S U' +* Compute error matrix: Error = A - U S U**T * * Copy A from SB to SP storage format. * @@ -265,7 +266,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/EIG/dspt21.f b/lapack-netlib/TESTING/EIG/dspt21.f index 9f87959fe..4b1d360c5 100644 --- a/lapack-netlib/TESTING/EIG/dspt21.f +++ b/lapack-netlib/TESTING/EIG/dspt21.f @@ -28,9 +28,9 @@ *> *> DSPT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric (stored in packed format), U +*> where **T means transpose, A is symmetric (stored in packed format), U *> is orthogonal, and S is diagonal (if KBAND=0) or symmetric *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a *> dense matrix, otherwise the U is expressed as a product of @@ -41,15 +41,16 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> *> Packed storage means that, for example, if UPLO='U', then the columns *> of the upper triangle of A are stored one after another, so that @@ -70,7 +71,7 @@ *> *> If UPLO='U', then V = H(n-1)...H(1), where *> -*> H(j) = I - tau(j) v(j) v(j)' +*> H(j) = I - tau(j) v(j) v(j)**T *> *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), @@ -78,7 +79,7 @@ *> *> If UPLO='L', then V = H(1)...H(n-1), where *> -*> H(j) = I - tau(j) v(j) v(j)' +*> H(j) = I - tau(j) v(j) v(j)**T *> *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., @@ -93,14 +94,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> 3: U expressed both as a dense orthogonal matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -183,7 +185,7 @@ *> \verbatim *> TAU is DOUBLE PRECISION array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -303,7 +305,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U' +* ITYPE=1: error = A - U S U**T * CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DCOPY( LAP, AP, 1, WORK, 1 ) @@ -322,7 +324,7 @@ * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V' - A +* ITYPE=2: error = V S V**T - A * CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) * @@ -389,7 +391,7 @@ * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V' - I +* ITYPE=3: error = U V**T - I * IF( N.LT.2 ) $ RETURN @@ -420,7 +422,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * IF( ITYPE.EQ.1 ) THEN CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, diff --git a/lapack-netlib/TESTING/EIG/dsyt21.f b/lapack-netlib/TESTING/EIG/dsyt21.f index 0da3e5882..e00bd0db2 100644 --- a/lapack-netlib/TESTING/EIG/dsyt21.f +++ b/lapack-netlib/TESTING/EIG/dsyt21.f @@ -28,9 +28,9 @@ *> *> DSYT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric, U is orthogonal, and S is +*> where **T means transpose, A is symmetric, U is orthogonal, and S is *> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). *> *> If ITYPE=1, then U is represented as a dense matrix; otherwise U is @@ -41,18 +41,19 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> *> For ITYPE > 1, the transformation U is expressed as a product -*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)' and each +*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**T and each *> vector v(j) has its first j elements 0 and the remaining n-j elements *> stored in V(j+1:n,j). *> \endverbatim @@ -65,14 +66,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> 3: U expressed both as a dense orthogonal matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -170,7 +172,7 @@ *> \verbatim *> TAU is DOUBLE PRECISION array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -283,7 +285,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U' +* ITYPE=1: error = A - U S U**T * CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DLACPY( CUPLO, N, N, A, LDA, WORK, N ) @@ -302,7 +304,7 @@ * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V' - A +* ITYPE=2: error = V S V**T - A * CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) * @@ -359,7 +361,7 @@ * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V' - I +* ITYPE=3: error = U V**T - I * IF( N.LT.2 ) $ RETURN @@ -395,7 +397,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * IF( ITYPE.EQ.1 ) THEN CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, diff --git a/lapack-netlib/TESTING/EIG/dsyt22.f b/lapack-netlib/TESTING/EIG/dsyt22.f index 479b3ba5e..09e4aeb82 100644 --- a/lapack-netlib/TESTING/EIG/dsyt22.f +++ b/lapack-netlib/TESTING/EIG/dsyt22.f @@ -41,7 +41,8 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) +*> RESULT(1) = | U**T A U - S | / ( |A| m ulp ) and +*> RESULT(2) = | I - U**T U | / ( m ulp ) *> \endverbatim * * Arguments: @@ -51,7 +52,8 @@ *> ITYPE INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> UPLO CHARACTER *> If UPLO='U', the upper triangle of A will be used and the @@ -122,7 +124,7 @@ *> *> TAU DOUBLE PRECISION array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> Not modified. @@ -207,7 +209,7 @@ * * Compute error matrix: * -* ITYPE=1: error = U' A U - S +* ITYPE=1: error = U**T A U - S * CALL DSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N ) NN = N*N @@ -240,7 +242,7 @@ * * Do Test 2 * -* Compute U'U - I +* Compute U**T U - I * IF( ITYPE.EQ.1 ) $ CALL DORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, diff --git a/lapack-netlib/TESTING/EIG/sbdt05.f b/lapack-netlib/TESTING/EIG/sbdt05.f index 972ff952f..e3e79e91e 100644 --- a/lapack-netlib/TESTING/EIG/sbdt05.f +++ b/lapack-netlib/TESTING/EIG/sbdt05.f @@ -52,6 +52,7 @@ *> \verbatim *> A is REAL array, dimension (LDA,N) *> The m by n matrix A. +*> \endverbatim *> *> \param[in] LDA *> \verbatim diff --git a/lapack-netlib/TESTING/EIG/schkst.f b/lapack-netlib/TESTING/EIG/schkst.f index f4ae46832..a851bbbbf 100644 --- a/lapack-netlib/TESTING/EIG/schkst.f +++ b/lapack-netlib/TESTING/EIG/schkst.f @@ -166,7 +166,7 @@ *> SSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because SSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/schkst2stg.f b/lapack-netlib/TESTING/EIG/schkst2stg.f index 1c18e21bc..f386ab43c 100644 --- a/lapack-netlib/TESTING/EIG/schkst2stg.f +++ b/lapack-netlib/TESTING/EIG/schkst2stg.f @@ -187,7 +187,7 @@ *> SSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because SSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/sdrgsx.f b/lapack-netlib/TESTING/EIG/sdrgsx.f index bb5af0fd6..58e63e793 100644 --- a/lapack-netlib/TESTING/EIG/sdrgsx.f +++ b/lapack-netlib/TESTING/EIG/sdrgsx.f @@ -770,7 +770,7 @@ c MINWRK = MAX( 10*( NSIZE+1 ), 5*NSIZE*NSIZE / 2-2 ) CALL SLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL SLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) * -* Compute the Schur factorization while swaping the +* Compute the Schur factorization while swapping the * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, diff --git a/lapack-netlib/TESTING/EIG/sdrvbd.f b/lapack-netlib/TESTING/EIG/sdrvbd.f index b5d8a9b9a..101c8ba09 100644 --- a/lapack-netlib/TESTING/EIG/sdrvbd.f +++ b/lapack-netlib/TESTING/EIG/sdrvbd.f @@ -32,7 +32,7 @@ *> \verbatim *> *> SDRVBD checks the singular value decomposition (SVD) drivers -*> SGESVD, SGESDD, SGESVJ, and SGEJSV. +*> SGESVD, SGESDD, SGESVDQ, SGESVJ, SGEJSV, and DGESVDX. *> *> Both SGESVD and SGESDD factor A = U diag(S) VT, where U and VT are *> orthogonal and diag(S) is diagonal with the entries of the array S @@ -90,6 +90,17 @@ *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> +*> Test for SGESVDQ: +*> +*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> +*> (37) | I - U'U | / ( M ulp ) +*> +*> (38) | I - VT VT' | / ( N ulp ) +*> +*> (39) S contains MNMIN nonnegative values in decreasing order. +*> (Return 0 if true, 1/ULP if false.) +*> *> Test for SGESVJ: *> *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) @@ -359,6 +370,8 @@ * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * June 2016 +* + IMPLICIT NONE * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES, @@ -391,12 +404,18 @@ $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL, $ NMAX, NS, NSI, NSV, NTEST REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, - $ ULPINV, UNFL, VL, VU + $ ULPINV, UNFL, VL, VU +* .. +* .. Local Scalars for DGESVDQ .. + INTEGER LIWORK, LRWORK, NUMRANK +* .. +* .. Local Arrays for DGESVDQ .. + REAL RWORK( 2 ) * .. * .. Local Arrays .. CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) INTEGER IOLDSD( 4 ), ISEED2( 4 ) - REAL RESULT( 40 ) + REAL RESULT( 39 ) * .. * .. External Functions .. REAL SLAMCH, SLARND @@ -404,8 +423,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD, - $ SGESVDX, SGESVJ, SLABAD, SLACPY, SLASET, - $ SLATMS, SORT01, SORT03, XERBLA + $ SGESVDQ, SGESVDX, SGESVJ, SLABAD, SLACPY, + $ SLASET, SLATMS, SORT01, SORT03, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC ABS, REAL, INT, MAX, MIN @@ -781,8 +800,64 @@ RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) 110 CONTINUE * -* Test SGESVJ: Factorize A -* Note: SGESVJ does not work for M < N +* Test SGESVDQ +* Note: SGESVDQ only works for M >= N +* + RESULT( 36 ) = ZERO + RESULT( 37 ) = ZERO + RESULT( 38 ) = ZERO + RESULT( 39 ) = ZERO +* + IF( M.GE.N ) THEN + IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWS.EQ.4 ) + $ LSWORK = LWORK +* + CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA ) + SRNAMT = 'SGESVDQ' +* + LRWORK = 2 + LIWORK = MAX( N, 1 ) + CALL SGESVDQ( 'H', 'N', 'N', 'A', 'A', + $ M, N, A, LDA, SSAV, USAV, LDU, + $ VTSAV, LDVT, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, IINFO ) +* + IF( IINFO.NE.0 ) THEN + WRITE( NOUT, FMT = 9995 )'SGESVDQ', IINFO, M, N, + $ JTYPE, LSWORK, IOLDSD + INFO = ABS( IINFO ) + RETURN + END IF +* +* Do tests 36--39 +* + CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E, + $ VTSAV, LDVT, WORK, RESULT( 36 ) ) + IF( M.NE.0 .AND. N.NE.0 ) THEN + CALL SORT01( 'Columns', M, M, USAV, LDU, WORK, + $ LWORK, RESULT( 37 ) ) + CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK, + $ LWORK, RESULT( 38 ) ) + END IF + RESULT( 39 ) = ZERO + DO 199 I = 1, MNMIN - 1 + IF( SSAV( I ).LT.SSAV( I+1 ) ) + $ RESULT( 39 ) = ULPINV + IF( SSAV( I ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + 199 CONTINUE + IF( MNMIN.GE.1 ) THEN + IF( SSAV( MNMIN ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + END IF + END IF +* +* Test SGESVJ +* Note: SGESVJ only works for M >= N * RESULT( 15 ) = ZERO RESULT( 16 ) = ZERO @@ -802,8 +877,7 @@ CALL SGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV, & 0, A, LDVT, WORK, LWORK, INFO ) * -* SGESVJ retuns V not VT, so we transpose to use the same -* test suite. +* SGESVJ returns V not VT * DO J=1,N DO I=1,N @@ -841,8 +915,8 @@ END IF END IF * -* Test SGEJSV: Factorize A -* Note: SGEJSV does not work for M < N +* Test SGEJSV +* Note: SGEJSV only works for M >= N * RESULT( 19 ) = ZERO RESULT( 20 ) = ZERO @@ -862,8 +936,7 @@ & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & WORK, LWORK, IWORK, INFO ) * -* SGEJSV retuns V not VT, so we transpose to use the same -* test suite. +* SGEJSV returns V not VT * DO 140 J=1,N DO 130 I=1,N @@ -872,7 +945,7 @@ 140 END DO * IF( IINFO.NE.0 ) THEN - WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N, + WRITE( NOUT, FMT = 9995 )'GEJSV', IINFO, M, N, $ JTYPE, LSWORK, IOLDSD INFO = ABS( IINFO ) RETURN @@ -1086,7 +1159,7 @@ * * End of Loop -- Check for RESULT(j) > THRESH * - DO 210 J = 1, 35 + DO 210 J = 1, 39 IF( RESULT( J ).GE.THRESH ) THEN IF( NFAIL.EQ.0 ) THEN WRITE( NOUT, FMT = 9999 ) @@ -1097,7 +1170,7 @@ NFAIL = NFAIL + 1 END IF 210 CONTINUE - NTEST = NTEST + 35 + NTEST = NTEST + 39 220 CONTINUE 230 CONTINUE 240 CONTINUE @@ -1158,6 +1231,12 @@ $ ' SGESVDX(V,V,V) ', $ / '34 = | I - U**T U | / ( M ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ', + $ ' SGESVDQ(H,N,N,A,A', + $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ', + $ / '37 = | I - U**T U | / ( M ulp ) ', + $ / '38 = | I - VT VT**T | / ( N ulp ) ', + $ / '39 = 0 if S contains min(M,N) nonnegative values in', + $ ' decreasing order, else 1/ulp', $ / / ) 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) diff --git a/lapack-netlib/TESTING/EIG/serred.f b/lapack-netlib/TESTING/EIG/serred.f index f478fcdb1..7d3772e84 100644 --- a/lapack-netlib/TESTING/EIG/serred.f +++ b/lapack-netlib/TESTING/EIG/serred.f @@ -36,6 +36,8 @@ *> SGEJSV compute SVD of an M-by-N matrix A where M >= N *> SGESVDX compute SVD of an M-by-N matrix A(by bisection *> and inverse iteration) +*> SGESVDQ compute SVD of an M-by-N matrix A(with a +*> QR-Preconditioned ) *> \endverbatim * * Arguments: @@ -100,7 +102,7 @@ * .. * .. External Subroutines .. EXTERNAL CHKXER, SGEES, SGEESX, SGEEV, SGEEVX, SGEJSV, - $ SGESDD, SGESVD + $ SGESDD, SGESVD, SGESVDX, SGESVDQ * .. * .. External Functions .. LOGICAL SSLECT, LSAMEN @@ -486,6 +488,61 @@ ELSE WRITE( NOUT, FMT = 9998 ) END IF +* +* Test SGESVDQ +* + SRNAMT = 'SGESVDQ' + INFOT = 1 + CALL SGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL SGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL SGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL SGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 14 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 17 + CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO ) + CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK ) + NT = 11 + IF( OK ) THEN + WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), + $ NT + ELSE + WRITE( NOUT, FMT = 9998 ) + END IF END IF * * Print a summary line. diff --git a/lapack-netlib/TESTING/EIG/sget39.f b/lapack-netlib/TESTING/EIG/sget39.f index f02c6f856..f6c0f7e7c 100644 --- a/lapack-netlib/TESTING/EIG/sget39.f +++ b/lapack-netlib/TESTING/EIG/sget39.f @@ -194,7 +194,7 @@ VM5( 2 ) = EPS VM5( 3 ) = SQRT( SMLNUM ) * -* Initalization +* Initialization * KNT = 0 RMAX = ZERO diff --git a/lapack-netlib/TESTING/EIG/ssbt21.f b/lapack-netlib/TESTING/EIG/ssbt21.f index 50128ddbb..7ef5ad9b3 100644 --- a/lapack-netlib/TESTING/EIG/ssbt21.f +++ b/lapack-netlib/TESTING/EIG/ssbt21.f @@ -28,15 +28,16 @@ *> *> SSBT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric banded, U is +*> where **T means transpose, A is symmetric banded, U is *> orthogonal, and S is diagonal (if KS=0) or symmetric *> tridiagonal (if KS=1). *> *> Specifically: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> \endverbatim * * Arguments: @@ -214,7 +215,7 @@ * ANORM = MAX( SLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL ) * -* Compute error matrix: Error = A - U S U' +* Compute error matrix: Error = A - U S U**T * * Copy A from SB to SP storage format. * @@ -265,7 +266,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/EIG/sspt21.f b/lapack-netlib/TESTING/EIG/sspt21.f index 2384c87de..4ecb04c0e 100644 --- a/lapack-netlib/TESTING/EIG/sspt21.f +++ b/lapack-netlib/TESTING/EIG/sspt21.f @@ -28,9 +28,9 @@ *> *> SSPT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric (stored in packed format), U +*> where **T means transpose, A is symmetric (stored in packed format), U *> is orthogonal, and S is diagonal (if KBAND=0) or symmetric *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a *> dense matrix, otherwise the U is expressed as a product of @@ -41,15 +41,16 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> *> Packed storage means that, for example, if UPLO='U', then the columns *> of the upper triangle of A are stored one after another, so that @@ -70,7 +71,7 @@ *> *> If UPLO='U', then V = H(n-1)...H(1), where *> -*> H(j) = I - tau(j) v(j) v(j)' +*> H(j) = I - tau(j) v(j) v(j)**T *> *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), @@ -78,7 +79,7 @@ *> *> If UPLO='L', then V = H(1)...H(n-1), where *> -*> H(j) = I - tau(j) v(j) v(j)' +*> H(j) = I - tau(j) v(j) v(j)**T *> *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., @@ -93,14 +94,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> 3: U expressed both as a dense orthogonal matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -183,7 +185,7 @@ *> \verbatim *> TAU is REAL array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -303,7 +305,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U' +* ITYPE=1: error = A - U S U**T * CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SCOPY( LAP, AP, 1, WORK, 1 ) @@ -322,7 +324,7 @@ * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V' - A +* ITYPE=2: error = V S V**T - A * CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) * @@ -389,7 +391,7 @@ * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V' - I +* ITYPE=3: error = U V**T - I * IF( N.LT.2 ) $ RETURN @@ -420,7 +422,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * IF( ITYPE.EQ.1 ) THEN CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, diff --git a/lapack-netlib/TESTING/EIG/ssyt21.f b/lapack-netlib/TESTING/EIG/ssyt21.f index a7add3418..fc7ca6a2a 100644 --- a/lapack-netlib/TESTING/EIG/ssyt21.f +++ b/lapack-netlib/TESTING/EIG/ssyt21.f @@ -28,9 +28,9 @@ *> *> SSYT21 generally checks a decomposition of the form *> -*> A = U S U' +*> A = U S U**T *> -*> where ' means transpose, A is symmetric, U is orthogonal, and S is +*> where **T means transpose, A is symmetric, U is orthogonal, and S is *> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). *> *> If ITYPE=1, then U is represented as a dense matrix; otherwise U is @@ -41,18 +41,19 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> *> For ITYPE > 1, the transformation U is expressed as a product -*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)' and each +*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**T and each *> vector v(j) has its first j elements 0 and the remaining n-j elements *> stored in V(j+1:n,j). *> \endverbatim @@ -65,14 +66,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**T | / ( |A| n ulp ) *> *> 3: U expressed both as a dense orthogonal matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - VU' | / ( n ulp ) +*> RESULT(1) = | I - V U**T | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -170,7 +172,7 @@ *> \verbatim *> TAU is REAL array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -283,7 +285,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U' +* ITYPE=1: error = A - U S U**T * CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SLACPY( CUPLO, N, N, A, LDA, WORK, N ) @@ -302,7 +304,7 @@ * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V' - A +* ITYPE=2: error = V S V**T - A * CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) * @@ -359,7 +361,7 @@ * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V' - I +* ITYPE=3: error = U V**T - I * IF( N.LT.2 ) $ RETURN @@ -395,7 +397,7 @@ * * Do Test 2 * -* Compute UU' - I +* Compute U U**T - I * IF( ITYPE.EQ.1 ) THEN CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, diff --git a/lapack-netlib/TESTING/EIG/ssyt22.f b/lapack-netlib/TESTING/EIG/ssyt22.f index 3b748ec7f..38fc3e555 100644 --- a/lapack-netlib/TESTING/EIG/ssyt22.f +++ b/lapack-netlib/TESTING/EIG/ssyt22.f @@ -41,7 +41,8 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) +*> RESULT(1) = | U**T A U - S | / ( |A| m ulp ) and +*> RESULT(2) = | I - U**T U | / ( m ulp ) *> \endverbatim * * Arguments: @@ -51,7 +52,8 @@ *> ITYPE INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**T | / ( n ulp ) *> *> UPLO CHARACTER *> If UPLO='U', the upper triangle of A will be used and the @@ -122,7 +124,7 @@ *> *> TAU REAL array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**T in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> Not modified. @@ -207,7 +209,7 @@ * * Compute error matrix: * -* ITYPE=1: error = U' A U - S +* ITYPE=1: error = U**T A U - S * CALL SSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N ) NN = N*N @@ -240,7 +242,7 @@ * * Do Test 2 * -* Compute U'U - I +* Compute U**T U - I * IF( ITYPE.EQ.1 ) $ CALL SORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, diff --git a/lapack-netlib/TESTING/EIG/zbdt05.f b/lapack-netlib/TESTING/EIG/zbdt05.f index 7a493292a..bbf0208b7 100644 --- a/lapack-netlib/TESTING/EIG/zbdt05.f +++ b/lapack-netlib/TESTING/EIG/zbdt05.f @@ -52,6 +52,7 @@ *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) *> The m by n matrix A. +*> \endverbatim *> *> \param[in] LDA *> \verbatim diff --git a/lapack-netlib/TESTING/EIG/zchkst.f b/lapack-netlib/TESTING/EIG/zchkst.f index 4a8636ad9..cd45e98e1 100644 --- a/lapack-netlib/TESTING/EIG/zchkst.f +++ b/lapack-netlib/TESTING/EIG/zchkst.f @@ -167,7 +167,7 @@ *> ZSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because ZSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/zchkst2stg.f b/lapack-netlib/TESTING/EIG/zchkst2stg.f index cd952bc37..167e5f359 100644 --- a/lapack-netlib/TESTING/EIG/zchkst2stg.f +++ b/lapack-netlib/TESTING/EIG/zchkst2stg.f @@ -188,7 +188,7 @@ *> ZSTEMR('V', 'I') *> *> Tests 29 through 34 are disable at present because ZSTEMR -*> does not handle partial specturm requests. +*> does not handle partial spectrum requests. *> *> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I') *> diff --git a/lapack-netlib/TESTING/EIG/zdrgev3.f b/lapack-netlib/TESTING/EIG/zdrgev3.f index 62ddf2b56..11e8562d7 100644 --- a/lapack-netlib/TESTING/EIG/zdrgev3.f +++ b/lapack-netlib/TESTING/EIG/zdrgev3.f @@ -389,7 +389,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date Febuary 2015 +*> \date February 2015 * *> \ingroup complex16_eig * diff --git a/lapack-netlib/TESTING/EIG/zdrgsx.f b/lapack-netlib/TESTING/EIG/zdrgsx.f index 51a7d773f..f5821e520 100644 --- a/lapack-netlib/TESTING/EIG/zdrgsx.f +++ b/lapack-netlib/TESTING/EIG/zdrgsx.f @@ -738,7 +738,7 @@ CALL ZLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL ZLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) * -* Compute the Schur factorization while swaping the +* Compute the Schur factorization while swapping the * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, diff --git a/lapack-netlib/TESTING/EIG/zdrvbd.f b/lapack-netlib/TESTING/EIG/zdrvbd.f index 4bdbdfe2e..105e9dff7 100644 --- a/lapack-netlib/TESTING/EIG/zdrvbd.f +++ b/lapack-netlib/TESTING/EIG/zdrvbd.f @@ -33,8 +33,9 @@ *> *> \verbatim *> -*> ZDRVBD checks the singular value decomposition (SVD) driver ZGESVD -*> and ZGESDD. +*> ZDRVBD checks the singular value decomposition (SVD) driver ZGESVD, +*> ZGESDD, ZGESVJ, ZGEJSV, ZGESVDX, and ZGESVDQ. +*> *> ZGESVD and ZGESDD factors A = U diag(S) VT, where U and VT are *> unitary and diag(S) is diagonal with the entries of the array S on *> its diagonal. The entries of S are the singular values, nonnegative @@ -73,81 +74,92 @@ *> *> Test for ZGESDD: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (9) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (10) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (11) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> -*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially +*> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially *> computed U. *> -*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially +*> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially *> computed VT. *> -*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the +*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> +*> Test for ZGESVDQ: +*> +*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> +*> (37) | I - U'U | / ( M ulp ) +*> +*> (38) | I - VT VT' | / ( N ulp ) +*> +*> (39) S contains MNMIN nonnegative values in decreasing order. +*> (Return 0 if true, 1/ULP if false.) +*> *> Test for ZGESVJ: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (16) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (17) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (18) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> *> Test for ZGEJSV: *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (20) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (21) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (22) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> *> Test for ZGESVDX( 'V', 'V', 'A' )/ZGESVDX( 'N', 'N', 'A' ) *> -*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) +*> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> -*> (2) | I - U'U | / ( M ulp ) +*> (24) | I - U'U | / ( M ulp ) *> -*> (3) | I - VT VT' | / ( N ulp ) +*> (25) | I - VT VT' | / ( N ulp ) *> -*> (4) S contains MNMIN nonnegative values in decreasing order. +*> (26) S contains MNMIN nonnegative values in decreasing order. *> (Return 0 if true, 1/ULP if false.) *> -*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially +*> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially *> computed U. *> -*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially +*> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially *> computed VT. *> -*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the +*> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> vector of singular values from the partial SVD *> *> Test for ZGESVDX( 'V', 'V', 'I' ) *> -*> (8) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) +*> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> -*> (9) | I - U'U | / ( M ulp ) +*> (31) | I - U'U | / ( M ulp ) *> -*> (10) | I - VT VT' | / ( N ulp ) +*> (32) | I - VT VT' | / ( N ulp ) *> *> Test for ZGESVDX( 'V', 'V', 'V' ) *> -*> (11) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) +*> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> -*> (12) | I - U'U | / ( M ulp ) +*> (34) | I - U'U | / ( M ulp ) *> -*> (13) | I - VT VT' | / ( N ulp ) +*> (35) | I - VT VT' | / ( N ulp ) *> *> The "sizes" are specified by the arrays MM(1:NSIZES) and *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j)) @@ -393,6 +405,8 @@ * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * June 2016 +* + IMPLICIT NONE * * .. Scalar Arguments .. INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, @@ -411,7 +425,7 @@ * ===================================================================== * * .. Parameters .. - DOUBLE PRECISION ZERO, ONE, TWO, HALF + DOUBLE PRECISION ZERO, ONE, TWO, HALF PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, $ HALF = 0.5D0 ) COMPLEX*16 CZERO, CONE @@ -431,10 +445,13 @@ DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, $ UNFL, VL, VU * .. +* .. Local Scalars for ZGESVDQ .. + INTEGER LIWORK, NUMRANK +* .. * .. Local Arrays .. CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) INTEGER IOLDSD( 4 ), ISEED2( 4 ) - DOUBLE PRECISION RESULT( 35 ) + DOUBLE PRECISION RESULT( 39 ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DLARND @@ -442,8 +459,8 @@ * .. * .. External Subroutines .. EXTERNAL ALASVM, XERBLA, ZBDT01, ZBDT05, ZGESDD, - $ ZGESVD, ZGESVJ, ZGEJSV, ZGESVDX, ZLACPY, - $ ZLASET, ZLATMS, ZUNT01, ZUNT03 + $ ZGESVD, ZGESVDQ, ZGESVJ, ZGEJSV, ZGESVDX, + $ ZLACPY, ZLASET, ZLATMS, ZUNT01, ZUNT03 * .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, MAX, MIN @@ -836,10 +853,65 @@ 120 CONTINUE RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) 130 CONTINUE - * -* Test ZGESVJ: Factorize A -* Note: ZGESVJ does not work for M < N +* Test ZGESVDQ +* Note: ZGESVDQ only works for M >= N +* + RESULT( 36 ) = ZERO + RESULT( 37 ) = ZERO + RESULT( 38 ) = ZERO + RESULT( 39 ) = ZERO +* + IF( M.GE.N ) THEN + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK +* + CALL ZLACPY( 'F', M, N, ASAV, LDA, A, LDA ) + SRNAMT = 'ZGESVDQ' +* + LRWORK = MAX(2, M, 5*N) + LIWORK = MAX( N, 1 ) + CALL ZGESVDQ( 'H', 'N', 'N', 'A', 'A', + $ M, N, A, LDA, SSAV, USAV, LDU, + $ VTSAV, LDVT, NUMRANK, IWORK, LIWORK, + $ WORK, LWORK, RWORK, LRWORK, IINFO ) +* + IF( IINFO.NE.0 ) THEN + WRITE( NOUNIT, FMT = 9995 )'ZGESVDQ', IINFO, M, N, + $ JTYPE, LSWORK, IOLDSD + INFO = ABS( IINFO ) + RETURN + END IF +* +* Do tests 36--39 +* + CALL ZBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E, + $ VTSAV, LDVT, WORK, RWORK, RESULT( 36 ) ) + IF( M.NE.0 .AND. N.NE.0 ) THEN + CALL ZUNT01( 'Columns', M, M, USAV, LDU, WORK, + $ LWORK, RWORK, RESULT( 37 ) ) + CALL ZUNT01( 'Rows', N, N, VTSAV, LDVT, WORK, + $ LWORK, RWORK, RESULT( 38 ) ) + END IF + RESULT( 39 ) = ZERO + DO 199 I = 1, MNMIN - 1 + IF( SSAV( I ).LT.SSAV( I+1 ) ) + $ RESULT( 39 ) = ULPINV + IF( SSAV( I ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + 199 CONTINUE + IF( MNMIN.GE.1 ) THEN + IF( SSAV( MNMIN ).LT.ZERO ) + $ RESULT( 39 ) = ULPINV + END IF + END IF +* +* Test ZGESVJ +* Note: ZGESVJ only works for M >= N * RESULT( 15 ) = ZERO RESULT( 16 ) = ZERO @@ -847,13 +919,13 @@ RESULT( 18 ) = ZERO * IF( M.GE.N ) THEN - IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) - LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 - LSWORK = MIN( LSWORK, LWORK ) - LSWORK = MAX( LSWORK, 1 ) - LRWORK = MAX(6,N) - IF( IWSPC.EQ.4 ) - $ LSWORK = LWORK + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + LRWORK = MAX(6,N) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK * CALL ZLACPY( 'F', M, N, ASAV, LDA, USAV, LDA ) SRNAMT = 'ZGESVJ' @@ -861,8 +933,7 @@ & 0, A, LDVT, WORK, LWORK, RWORK, & LRWORK, IINFO ) * -* ZGESVJ retuns V not VT, so we transpose to use the same -* test suite. +* ZGESVJ returns V not VH * DO J=1,N DO I=1,N @@ -900,21 +971,21 @@ END IF END IF * -* Test ZGEJSV: Factorize A -* Note: ZGEJSV does not work for M < N +* Test ZGEJSV +* Note: ZGEJSV only works for M >= N * RESULT( 19 ) = ZERO RESULT( 20 ) = ZERO RESULT( 21 ) = ZERO RESULT( 22 ) = ZERO IF( M.GE.N ) THEN - IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) - LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 - LSWORK = MIN( LSWORK, LWORK ) - LSWORK = MAX( LSWORK, 1 ) - IF( IWSPC.EQ.4 ) - $ LSWORK = LWORK - LRWORK = MAX( 7, N + 2*M) + IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) + LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 + LSWORK = MIN( LSWORK, LWORK ) + LSWORK = MAX( LSWORK, 1 ) + IF( IWSPC.EQ.4 ) + $ LSWORK = LWORK + LRWORK = MAX( 7, N + 2*M) * CALL ZLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA ) SRNAMT = 'ZGEJSV' @@ -923,8 +994,7 @@ & WORK, LWORK, RWORK, & LRWORK, IWORK, IINFO ) * -* ZGEJSV retuns V not VT, so we transpose to use the same -* test suite. +* ZGEJSV returns V not VH * DO 133 J=1,N DO 132 I=1,N @@ -933,7 +1003,7 @@ 133 END DO * IF( IINFO.NE.0 ) THEN - WRITE( NOUNIT, FMT = 9995 )'GESVJ', IINFO, M, N, + WRITE( NOUNIT, FMT = 9995 )'GEJSV', IINFO, M, N, $ JTYPE, LSWORK, IOLDSD INFO = ABS( IINFO ) RETURN @@ -1160,7 +1230,7 @@ * NTEST = 0 NFAIL = 0 - DO 190 J = 1, 35 + DO 190 J = 1, 39 IF( RESULT( J ).GE.ZERO ) $ NTEST = NTEST + 1 IF( RESULT( J ).GE.THRESH ) @@ -1175,7 +1245,7 @@ NTESTF = 2 END IF * - DO 200 J = 1, 35 + DO 200 J = 1, 39 IF( RESULT( J ).GE.THRESH ) THEN WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC, $ IOLDSD, J, RESULT( J ) @@ -1251,6 +1321,12 @@ $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )', $ / '34 = | I - U**T U | / ( M ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ', + $ ' ZGESVDQ(H,N,N,A,A', + $ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ', + $ / '37 = | I - U**T U | / ( M ulp ) ', + $ / '38 = | I - VT VT**T | / ( N ulp ) ', + $ / '39 = 0 if S contains min(M,N) nonnegative values in', + $ ' decreasing order, else 1/ulp', $ / / ) 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) diff --git a/lapack-netlib/TESTING/EIG/zerred.f b/lapack-netlib/TESTING/EIG/zerred.f index 00bfbf261..013dc16c5 100644 --- a/lapack-netlib/TESTING/EIG/zerred.f +++ b/lapack-netlib/TESTING/EIG/zerred.f @@ -36,6 +36,8 @@ *> ZGEJSV compute SVD of an M-by-N matrix A where M >= N *> ZGESVDX compute SVD of an M-by-N matrix A(by bisection *> and inverse iteration) +*> ZGESVDQ compute SVD of an M-by-N matrix A(with a +*> QR-Preconditioned ) *> \endverbatim * * Arguments: @@ -101,7 +103,7 @@ * .. * .. External Subroutines .. EXTERNAL CHKXER, ZGEES, ZGEESX, ZGEEV, ZGEEVX, ZGESVJ, - $ ZGESDD, ZGESVD + $ ZGESDD, ZGESVD, ZGESVDX, ZGESVQ * .. * .. External Functions .. LOGICAL LSAMEN, ZSLECT @@ -495,6 +497,61 @@ ELSE WRITE( NOUT, FMT = 9998 ) END IF +* +* Test ZGESVDQ +* + SRNAMT = 'ZGESVDQ' + INFOT = 1 + CALL ZGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 4 + CALL ZGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 6 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 9 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U, + $ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 12 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ -1, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 14 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, -1, NS, IW, 1, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + INFOT = 17 + CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, + $ 1, VT, 1, NS, IW, -5, W, 1, RW, 1, INFO ) + CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK ) + NT = 11 + IF( OK ) THEN + WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), + $ NT + ELSE + WRITE( NOUT, FMT = 9998 ) + END IF END IF * * Print a summary line. diff --git a/lapack-netlib/TESTING/EIG/zget51.f b/lapack-netlib/TESTING/EIG/zget51.f index 96b1dfae4..e019127a3 100644 --- a/lapack-netlib/TESTING/EIG/zget51.f +++ b/lapack-netlib/TESTING/EIG/zget51.f @@ -29,12 +29,13 @@ *> *> ZGET51 generally checks a decomposition of the form *> -*> A = U B VC> -*> where * means conjugate transpose and U and V are unitary. +*> A = U B V**H +*> +*> where **H means conjugate transpose and U and V are unitary. *> *> Specifically, if ITYPE=1 *> -*> RESULT = | A - U B V* | / ( |A| n ulp ) +*> RESULT = | A - U B V**H | / ( |A| n ulp ) *> *> If ITYPE=2, then: *> @@ -42,7 +43,7 @@ *> *> If ITYPE=3, then: *> -*> RESULT = | I - UU* | / ( n ulp ) +*> RESULT = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -52,9 +53,9 @@ *> \verbatim *> ITYPE is INTEGER *> Specifies the type of tests to be performed. -*> =1: RESULT = | A - U B V* | / ( |A| n ulp ) +*> =1: RESULT = | A - U B V**H | / ( |A| n ulp ) *> =2: RESULT = | A - B | / ( |A| n ulp ) -*> =3: RESULT = | I - UU* | / ( n ulp ) +*> =3: RESULT = | I - U U**H | / ( n ulp ) *> \endverbatim *> *> \param[in] N @@ -218,7 +219,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: Compute W = A - UBV' +* ITYPE=1: Compute W = A - U B V**H * CALL ZLACPY( ' ', N, N, A, LDA, WORK, N ) CALL ZGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO, @@ -259,7 +260,7 @@ * * Tests not scaled by norm(A) * -* ITYPE=3: Compute UU' - I +* ITYPE=3: Compute U U**H - I * CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, $ WORK, N ) diff --git a/lapack-netlib/TESTING/EIG/zhbt21.f b/lapack-netlib/TESTING/EIG/zhbt21.f index 4cd8ed9f7..68125854c 100644 --- a/lapack-netlib/TESTING/EIG/zhbt21.f +++ b/lapack-netlib/TESTING/EIG/zhbt21.f @@ -28,14 +28,16 @@ *> *> ZHBT21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian banded, U is +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian banded, U is *> unitary, and S is diagonal (if KS=0) or symmetric *> tridiagonal (if KS=1). *> *> Specifically: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -220,7 +222,7 @@ * ANORM = MAX( ZLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL ) * -* Compute error matrix: Error = A - U S U* +* Compute error matrix: Error = A - U S U**H * * Copy A from SB to SP storage format. * @@ -271,7 +273,7 @@ * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/EIG/zhet21.f b/lapack-netlib/TESTING/EIG/zhet21.f index f6cb2d70a..cb854a850 100644 --- a/lapack-netlib/TESTING/EIG/zhet21.f +++ b/lapack-netlib/TESTING/EIG/zhet21.f @@ -29,8 +29,9 @@ *> *> ZHET21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian, U is unitary, and +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian, U is unitary, and *> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if *> KBAND=1). *> @@ -42,18 +43,19 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> *> For ITYPE > 1, the transformation U is expressed as a product -*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)C> and each +*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**H and each *> vector v(j) has its first j elements 0 and the remaining n-j elements *> stored in V(j+1:n,j). *> \endverbatim @@ -66,14 +68,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense unitary matrix: -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> 3: U expressed both as a dense unitary matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -171,7 +174,7 @@ *> \verbatim *> TAU is COMPLEX*16 array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)* in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -294,7 +297,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U* +* ITYPE=1: error = A - U S U**H * CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZLACPY( CUPLO, N, N, A, LDA, WORK, N ) @@ -304,7 +307,6 @@ 10 CONTINUE * IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN -CMK DO 20 J = 1, N - 1 DO 20 J = 2, N - 1 CALL ZHER2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1, $ U( 1, J-1 ), 1, WORK, N ) @@ -314,7 +316,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V* - A +* ITYPE=2: error = V S V**H - A * CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) * @@ -371,7 +373,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V* - I +* ITYPE=3: error = U V**H - I * IF( N.LT.2 ) $ RETURN @@ -407,7 +409,7 @@ CMK DO 20 J = 1, N - 1 * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * IF( ITYPE.EQ.1 ) THEN CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, diff --git a/lapack-netlib/TESTING/EIG/zhet22.f b/lapack-netlib/TESTING/EIG/zhet22.f index 7237f43f7..8ef73aef3 100644 --- a/lapack-netlib/TESTING/EIG/zhet22.f +++ b/lapack-netlib/TESTING/EIG/zhet22.f @@ -42,7 +42,8 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) +*> RESULT(1) = | U**H A U - S | / ( |A| m ulp ) and +*> RESULT(2) = | I - U**H U | / ( m ulp ) *> \endverbatim * * Arguments: @@ -52,7 +53,8 @@ *> ITYPE INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense orthogonal matrix: -*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) *and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> UPLO CHARACTER *> If UPLO='U', the upper triangle of A will be used and the @@ -122,7 +124,7 @@ *> *> TAU COMPLEX*16 array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)' in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> Not modified. @@ -215,7 +217,7 @@ * * Compute error matrix: * -* ITYPE=1: error = U' A U - S +* ITYPE=1: error = U**H A U - S * CALL ZHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK, $ N ) @@ -249,7 +251,7 @@ * * Do Test 2 * -* Compute U'U - I +* Compute U**H U - I * IF( ITYPE.EQ.1 ) $ CALL ZUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK, diff --git a/lapack-netlib/TESTING/EIG/zhpt21.f b/lapack-netlib/TESTING/EIG/zhpt21.f index ef9e4418d..825d387c7 100644 --- a/lapack-netlib/TESTING/EIG/zhpt21.f +++ b/lapack-netlib/TESTING/EIG/zhpt21.f @@ -29,8 +29,9 @@ *> *> ZHPT21 generally checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is hermitian, U is +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is hermitian, U is *> unitary, and S is diagonal (if KBAND=0) or (real) symmetric *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as *> a dense matrix, otherwise the U is expressed as a product of @@ -41,15 +42,16 @@ *> *> Specifically, if ITYPE=1, then: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> If ITYPE=2, then: *> -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> If ITYPE=3, then: *> -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> *> Packed storage means that, for example, if UPLO='U', then the columns *> of the upper triangle of A are stored one after another, so that @@ -70,14 +72,16 @@ *> *> If UPLO='U', then V = H(n-1)...H(1), where *> -*> H(j) = I - tau(j) v(j) v(j)C> +*> H(j) = I - tau(j) v(j) v(j)**H +*> *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> the j-th element is 1, and the last n-j elements are 0. *> *> If UPLO='L', then V = H(1)...H(n-1), where *> -*> H(j) = I - tau(j) v(j) v(j)C> +*> H(j) = I - tau(j) v(j) v(j)**H +*> *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .) @@ -91,14 +95,15 @@ *> ITYPE is INTEGER *> Specifies the type of tests to be performed. *> 1: U expressed as a dense unitary matrix: -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> *> 2: U expressed as a product V of Housholder transformations: -*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) +*> RESULT(1) = | A - V S V**H | / ( |A| n ulp ) *> *> 3: U expressed both as a dense unitary matrix and *> as a product of Housholder transformations: -*> RESULT(1) = | I - UV* | / ( n ulp ) +*> RESULT(1) = | I - U V**H | / ( n ulp ) *> \endverbatim *> *> \param[in] UPLO @@ -181,7 +186,7 @@ *> \verbatim *> TAU is COMPLEX*16 array, dimension (N) *> If ITYPE >= 2, then TAU(j) is the scalar factor of -*> v(j) v(j)* in the Householder transformation H(j) of +*> v(j) v(j)**H in the Householder transformation H(j) of *> the product U = H(1)...H(n-2) *> If ITYPE < 2, then TAU is not referenced. *> \endverbatim @@ -313,7 +318,7 @@ * IF( ITYPE.EQ.1 ) THEN * -* ITYPE=1: error = A - U S U* +* ITYPE=1: error = A - U S U**H * CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZCOPY( LAP, AP, 1, WORK, 1 ) @@ -323,7 +328,6 @@ 10 CONTINUE * IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN -CMK DO 20 J = 1, N - 1 DO 20 J = 2, N - 1 CALL ZHPR2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1, $ U( 1, J-1 ), 1, WORK ) @@ -333,7 +337,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.2 ) THEN * -* ITYPE=2: error = V S V* - A +* ITYPE=2: error = V S V**H - A * CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) * @@ -401,7 +405,7 @@ CMK DO 20 J = 1, N - 1 * ELSE IF( ITYPE.EQ.3 ) THEN * -* ITYPE=3: error = U V* - I +* ITYPE=3: error = U V**H - I * IF( N.LT.2 ) $ RETURN @@ -432,7 +436,7 @@ CMK DO 20 J = 1, N - 1 * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * IF( ITYPE.EQ.1 ) THEN CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, diff --git a/lapack-netlib/TESTING/EIG/zstt21.f b/lapack-netlib/TESTING/EIG/zstt21.f index ad1fe5529..f2e32a12e 100644 --- a/lapack-netlib/TESTING/EIG/zstt21.f +++ b/lapack-netlib/TESTING/EIG/zstt21.f @@ -28,14 +28,15 @@ *> *> ZSTT21 checks a decomposition of the form *> -*> A = U S UC> -*> where * means conjugate transpose, A is real symmetric tridiagonal, +*> A = U S U**H +*> +*> where **H means conjugate transpose, A is real symmetric tridiagonal, *> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric *> tridiagonal (if KBAND=1). Two tests are performed: *> -*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) +*> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) *> -*> RESULT(2) = | I - UU* | / ( n ulp ) +*> RESULT(2) = | I - U U**H | / ( n ulp ) *> \endverbatim * * Arguments: @@ -228,7 +229,7 @@ * * Do Test 2 * -* Compute UU* - I +* Compute U U**H - I * CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, $ N ) diff --git a/lapack-netlib/TESTING/LIN/CMakeLists.txt b/lapack-netlib/TESTING/LIN/CMakeLists.txt index 50ba8fc28..c941d3577 100644 --- a/lapack-netlib/TESTING/LIN/CMakeLists.txt +++ b/lapack-netlib/TESTING/LIN/CMakeLists.txt @@ -39,7 +39,8 @@ set(SLINTST schkaa.f strt02.f strt03.f strt05.f strt06.f sgennd.f sqrt04.f sqrt05.f schkqrt.f serrqrt.f schkqrtp.f serrqrtp.f schklqt.f schklqtp.f schktsqr.f - serrlqt.f serrlqtp.f serrtsqr.f stsqr01.f slqt04.f slqt05.f) + serrlqt.f serrlqtp.f serrtsqr.f stsqr01.f slqt04.f slqt05.f + schkorhr_col.f serrorhr_col.f sorhr_col01.f) if(USE_XBLAS) list(APPEND SLINTST sdrvgbx.f sdrvgex.f sdrvsyx.f sdrvpox.f @@ -94,7 +95,8 @@ set(CLINTST cchkaa.f sget06.f cgennd.f cqrt04.f cqrt05.f cchkqrt.f cerrqrt.f cchkqrtp.f cerrqrtp.f cchklqt.f cchklqtp.f cchktsqr.f - cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f) + cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f + cchkunhr_col.f cerrunhr_col.f cunhr_col01.f) if(USE_XBLAS) list(APPEND CLINTST cdrvgbx.f cdrvgex.f cdrvhex.f cdrvsyx.f cdrvpox.f @@ -139,7 +141,8 @@ set(DLINTST dchkaa.f dgennd.f dqrt04.f dqrt05.f dchkqrt.f derrqrt.f dchkqrtp.f derrqrtp.f dchklq.f dchklqt.f dchklqtp.f dchktsqr.f - derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f) + derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f + dchkorhr_col.f derrorhr_col.f dorhr_col01.f) if(USE_XBLAS) list(APPEND DLINTST ddrvgbx.f ddrvgex.f ddrvsyx.f ddrvpox.f @@ -194,7 +197,8 @@ set(ZLINTST zchkaa.f dget06.f zgennd.f zqrt04.f zqrt05.f zchkqrt.f zerrqrt.f zchkqrtp.f zerrqrtp.f zchklqt.f zchklqtp.f zchktsqr.f - zerrlqt.f zerrlqtp.f zerrtsqr.f ztsqr01.f zlqt04.f zlqt05.f) + zerrlqt.f zerrlqtp.f zerrtsqr.f ztsqr01.f zlqt04.f zlqt05.f + zchkunhr_col.f zerrunhr_col.f zunhr_col01.f) if(USE_XBLAS) list(APPEND ZLINTST zdrvgbx.f zdrvgex.f zdrvhex.f zdrvsyx.f zdrvpox.f diff --git a/lapack-netlib/TESTING/LIN/Makefile b/lapack-netlib/TESTING/LIN/Makefile index 1a332f70b..6e790aa93 100644 --- a/lapack-netlib/TESTING/LIN/Makefile +++ b/lapack-netlib/TESTING/LIN/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ####################################################################### # This makefile creates the test programs for the linear equation # routines in LAPACK. The test files are grouped as follows: @@ -33,10 +31,8 @@ include ../../make.inc # ####################################################################### -ifneq ($(strip $(VARLIB)),) - LAPACKLIB := $(VARLIB) ../../$(LAPACKLIB) -endif - +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc ALINTST = \ aladhd.o alaerh.o alaesm.o alahd.o alareq.o \ @@ -77,7 +73,8 @@ SLINTST = schkaa.o \ strt02.o strt03.o strt05.o strt06.o \ sgennd.o sqrt04.o sqrt05.o schkqrt.o serrqrt.o schkqrtp.o serrqrtp.o \ schklqt.o schklqtp.o schktsqr.o \ - serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o + serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o \ + schkorhr_col.o serrorhr_col.o sorhr_col01.o ifdef USEXBLAS SLINTST += sdrvgbx.o sdrvgex.o sdrvsyx.o sdrvpox.o \ @@ -125,7 +122,8 @@ CLINTST = cchkaa.o \ sget06.o cgennd.o \ cqrt04.o cqrt05.o cchkqrt.o cerrqrt.o cchkqrtp.o cerrqrtp.o \ cchklqt.o cchklqtp.o cchktsqr.o \ - cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o + cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o \ + cchkunhr_col.o cerrunhr_col.o cunhr_col01.o ifdef USEXBLAS CLINTST += cdrvgbx.o cdrvgex.o cdrvhex.o cdrvsyx.o cdrvpox.o \ @@ -168,7 +166,8 @@ DLINTST = dchkaa.o \ dgennd.o \ dqrt04.o dqrt05.o dchkqrt.o derrqrt.o dchkqrtp.o derrqrtp.o \ dchklq.o dchklqt.o dchklqtp.o dchktsqr.o \ - derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o + derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o \ + dchkorhr_col.o derrorhr_col.o dorhr_col01.o ifdef USEXBLAS DLINTST += ddrvgbx.o ddrvgex.o ddrvsyx.o ddrvpox.o \ @@ -215,7 +214,8 @@ ZLINTST = zchkaa.o \ dget06.o zgennd.o \ zqrt04.o zqrt05.o zchkqrt.o zerrqrt.o zchkqrtp.o zerrqrtp.o \ zchklqt.o zchklqtp.o zchktsqr.o \ - zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o + zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o \ + zchkunhr_col.o zerrunhr_col.o zunhr_col01.o ifdef USEXBLAS ZLINTST += zdrvgbx.o zdrvgex.o zdrvhex.o zdrvsyx.o zdrvpox.o \ @@ -254,47 +254,50 @@ ZLINTSTRFP = zchkrfp.o zdrvrfp.o zdrvrf1.o zdrvrf2.o zdrvrf3.o zdrvrf4.o zerrrfp zlatb4.o zlaipd.o zlarhs.o zsbmv.o zget04.o zpot01.o zpot03.o zpot02.o \ chkxer.o xerbla.o alaerh.o aladhd.o alahd.o alasvm.o +.PHONY: all all: single double complex complex16 proto-single proto-double proto-complex proto-complex16 +.PHONY: single double complex complex16 single: xlintsts double: xlintstd complex: xlintstc complex16: xlintstz +.PHONY: proto-single proto-double proto-complex proto-complex16 proto-single: xlintstrfs proto-double: xlintstds xlintstrfd proto-complex: xlintstrfc proto-complex16: xlintstzc xlintstrfz -xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstds: $(DSLINTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstds: $(DSLINTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstzc: $(ZCLINTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstzc: $(ZCLINTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstrfs: $(SLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstrfs: $(SLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstrfd: $(DLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstrfd: $(DLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstrfc: $(CLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstrfc: $(CLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ -xlintstrfz: $(ZLINTSTRFP) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) - $(LOADER) $(LOADOPTS) -o $@ $^ +xlintstrfz: $(ZLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB) + $(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^ $(ALINTST): $(FRC) $(SCLNTST): $(FRC) @@ -307,6 +310,7 @@ $(ZLINTST): $(FRC) FRC: @FRC=$(FRC) +.PHONY: clean cleanobj cleanexe clean: cleanobj cleanexe cleanobj: rm -f *.o @@ -314,15 +318,12 @@ cleanexe: rm -f xlintst* schkaa.o: schkaa.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< dchkaa.o: dchkaa.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< cchkaa.o: cchkaa.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< zchkaa.o: zchkaa.f - $(FORTRAN) $(DRVOPTS) -c -o $@ $< - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< + $(FC) $(FFLAGS_DRV) -c -o $@ $< .NOTPARALLEL: diff --git a/lapack-netlib/TESTING/LIN/cchkaa.f b/lapack-netlib/TESTING/LIN/cchkaa.f index d8d5060c3..d36770be7 100644 --- a/lapack-netlib/TESTING/LIN/cchkaa.f +++ b/lapack-netlib/TESTING/LIN/cchkaa.f @@ -74,6 +74,8 @@ *> CEQ *> CQT *> CQX +*> CTS +*> CHH *> \endverbatim * * Parameters: @@ -108,14 +110,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2017 +*> \date November 2019 * *> \ingroup complex_lin * * ===================================================================== PROGRAM CCHKAA * -* -- LAPACK test routine (version 3.8.0) -- +* -- LAPACK test routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2017 @@ -165,15 +167,16 @@ * .. * .. External Subroutines .. EXTERNAL ALAREQ, CCHKEQ, CCHKGB, CCHKGE, CCHKGT, CCHKHE, - $ CCHKHE_ROOK, CCHKHE_RK, CCHKHE_AA, CCHKLQ, - $ CCHKPB,CCHKPO, CCHKPS, CCHKPP, CCHKPT, CCHKQ3, - $ CCHKQL, CCHKQR, CCHKRQ, CCHKSP, CCHKSY, - $ CCHKSY_ROOK, CCHKSY_RK, CCHKSY_AA, CCHKTB, - $ CCHKTP, CCHKTR, CCHKTZ, CDRVGB, CDRVGE, CDRVGT, - $ CDRVHE, CDRVHE_ROOK, CDRVHE_RK, CDRVHE_AA, - $ CDRVHP, CDRVLS, CDRVPB, CDRVPO, CDRVPP, CDRVPT, - $ CDRVSP, CDRVSY, CDRVSY_ROOK, CDRVSY_RK, - $ CDRVSY_AA, ILAVER, CCHKQRT, CCHKQRTP + $ CCHKHE_ROOK, CCHKHE_RK, CCHKHE_AA, CCHKHP, + $ CCHKLQ, CCHKUNHR_COL, CCHKPB, CCHKPO, CCHKPS, + $ CCHKPP, CCHKPT, CCHKQ3, CCHKQL, CCHKQR, CCHKRQ, + $ CCHKSP, CCHKSY, CCHKSY_ROOK, CCHKSY_RK, + $ CCHKSY_AA, CCHKTB, CCHKTP, CCHKTR, CCHKTZ, + $ CDRVGB, CDRVGE, CDRVGT, CDRVHE, CDRVHE_ROOK, + $ CDRVHE_RK, CDRVHE_AA, CDRVHP, CDRVLS, CDRVPB, + $ CDRVPO, CDRVPP, CDRVPT, CDRVSP, CDRVSY, + $ CDRVSY_ROOK, CDRVSY_RK, CDRVSY_AA, ILAVER, + $ CCHKQRT, CCHKQRTP * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -678,7 +681,7 @@ * * HK: Hermitian indefinite matrices, * with bounded Bunch-Kaufman (rook) pivoting algorithm, -* differnet matrix storage format than HR path version. +* different matrix storage format than HR path version. * NTYPES = 10 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) @@ -838,7 +841,7 @@ * * SK: symmetric indefinite matrices, * with bounded Bunch-Kaufman (rook) pivoting algorithm, -* differnet matrix storage format than SR path version. +* different matrix storage format than SR path version. * NTYPES = 11 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) @@ -1165,6 +1168,17 @@ ELSE WRITE( NOUT, FMT = 9989 )PATH END IF +* + ELSE IF( LSAMEN( 2, C2, 'HH' ) ) THEN +* +* HH: Householder reconstruction for tall-skinny matrices +* + IF( TSTCHK ) THEN + CALL CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + ELSE + WRITE( NOUT, FMT = 9989 ) PATH + END IF * ELSE * diff --git a/lapack-netlib/TESTING/LIN/cchkunhr_col.f b/lapack-netlib/TESTING/LIN/cchkunhr_col.f new file mode 100644 index 000000000..00077ddd9 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/cchkunhr_col.f @@ -0,0 +1,239 @@ +*> \brief \b CCHKUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* NBVAL, NOUT ) +* +* .. Scalar Arguments .. +* LOGICAL TSTERR +* INTEGER NM, NN, NNB, NOUT +* REAL THRESH +* .. +* .. Array Arguments .. +* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CCHKUNHR_COL tests CUNHR_COL using CLATSQR and CGEMQRT. Therefore, CLATSQR +*> (used in CGEQR) and CGEMQRT (used in CGEMQR) have to be tested +*> before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] THRESH +*> \verbatim +*> THRESH is REAL +*> The threshold value for the test ratios. A result is +*> included in the output file if RESULT >= THRESH. To have +*> every test ratio printed, use THRESH = 0. +*> \endverbatim +*> +*> \param[in] TSTERR +*> \verbatim +*> TSTERR is LOGICAL +*> Flag that indicates whether error exits are to be tested. +*> \endverbatim +*> +*> \param[in] NM +*> \verbatim +*> NM is INTEGER +*> The number of values of M contained in the vector MVAL. +*> \endverbatim +*> +*> \param[in] MVAL +*> \verbatim +*> MVAL is INTEGER array, dimension (NM) +*> The values of the matrix row dimension M. +*> \endverbatim +*> +*> \param[in] NN +*> \verbatim +*> NN is INTEGER +*> The number of values of N contained in the vector NVAL. +*> \endverbatim +*> +*> \param[in] NVAL +*> \verbatim +*> NVAL is INTEGER array, dimension (NN) +*> The values of the matrix column dimension N. +*> \endverbatim +*> +*> \param[in] NNB +*> \verbatim +*> NNB is INTEGER +*> The number of values of NB contained in the vector NBVAL. +*> \endverbatim +*> +*> \param[in] NBVAL +*> \verbatim +*> NBVAL is INTEGER array, dimension (NBVAL) +*> The values of the blocksize NB. +*> \endverbatim +*> +*> \param[in] NOUT +*> \verbatim +*> NOUT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex_lin +* +* ===================================================================== + SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.7.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* December 2016 +* +* .. Scalar Arguments .. + LOGICAL TSTERR + INTEGER NM, NN, NNB, NOUT + REAL THRESH +* .. +* .. Array Arguments .. + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NTESTS + PARAMETER ( NTESTS = 6 ) +* .. +* .. Local Scalars .. + CHARACTER(LEN=3) PATH + INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1, + $ NB2, NFAIL, NERRS, NRUN +* +* .. Local Arrays .. + REAL RESULT( NTESTS ) +* .. +* .. External Subroutines .. + EXTERNAL ALAHD, ALASUM, CERRUNHR_COL, CUNHR_COL01 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NUNIT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NUNIT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Executable Statements .. +* +* Initialize constants +* + PATH( 1: 1 ) = 'C' + PATH( 2: 3 ) = 'HH' + NRUN = 0 + NFAIL = 0 + NERRS = 0 +* +* Test the error exits +* + IF( TSTERR ) CALL CERRUNHR_COL( PATH, NOUT ) + INFOT = 0 +* +* Do for each value of M in MVAL. +* + DO I = 1, NM + M = MVAL( I ) +* +* Do for each value of N in NVAL. +* + DO J = 1, NN + N = NVAL( J ) +* +* Only for M >= N +* + IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN +* +* Do for each possible value of MB1 +* + DO IMB1 = 1, NNB + MB1 = NBVAL( IMB1 ) +* +* Only for MB1 > N +* + IF ( MB1.GT.N ) THEN +* +* Do for each possible value of NB1 +* + DO INB1 = 1, NNB + NB1 = NBVAL( INB1 ) +* +* Do for each possible value of NB2 +* + DO INB2 = 1, NNB + NB2 = NBVAL( INB2 ) +* + IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN +* +* Test CUNHR_COL +* + CALL CUNHR_COL01( M, N, MB1, NB1, NB2, + $ RESULT ) +* +* Print information about the tests that did +* not pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) M, N, MB1, + $ NB1, NB2, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO + NRUN = NRUN + NTESTS + END IF + END DO + END DO + END IF + END DO + END IF + END DO + END DO +* +* Print a summary of the results. +* + CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) +* + 9999 FORMAT( 'M=', I5, ', N=', I5, ', MB1=', I5, + $ ', NB1=', I5, ', NB2=', I5,' test(', I2, ')=', G12.5 ) + RETURN +* +* End of CCHKUNHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/TESTING/LIN/cdrvls.f b/lapack-netlib/TESTING/LIN/cdrvls.f index 2c2d9abb8..d24e3885b 100644 --- a/lapack-netlib/TESTING/LIN/cdrvls.f +++ b/lapack-netlib/TESTING/LIN/cdrvls.f @@ -237,13 +237,13 @@ REAL EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ - REAL RESULT( NTESTS ), RWQ - COMPLEX WQ + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ( 1 ) + REAL RESULT( NTESTS ), RWQ( 1 ) + COMPLEX WQ( 1 ) * .. * .. Allocatable Arrays .. COMPLEX, ALLOCATABLE :: WORK (:) - REAL, ALLOCATABLE :: RWORK (:) + REAL, ALLOCATABLE :: RWORK (:), WORK2 (:) INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. @@ -363,32 +363,32 @@ * Compute workspace needed for CGELS CALL CGELS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_CGELS = INT( WQ ) + LWORK_CGELS = INT( WQ( 1 ) ) * Compute workspace needed for CGETSLS CALL CGETSLS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_CGETSLS = INT( WQ ) + LWORK_CGETSLS = INT( WQ( 1 ) ) ENDDO END IF * Compute workspace needed for CGELSY CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, $ IWQ, RCOND, CRANK, WQ, -1, RWORK, $ INFO ) - LWORK_CGELSY = INT( WQ ) + LWORK_CGELSY = INT( WQ( 1 ) ) LRWORK_CGELSY = 2*N * Compute workspace needed for CGELSS CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1, RWORK, INFO ) - LWORK_CGELSS = INT( WQ ) + LWORK_CGELSS = INT( WQ( 1 ) ) LRWORK_CGELSS = 5*MNMIN * Compute workspace needed for CGELSD CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1, RWQ, IWQ, $ INFO ) - LWORK_CGELSD = INT( WQ ) - LRWORK_CGELSD = INT( RWQ ) + LWORK_CGELSD = INT( WQ( 1 ) ) + LRWORK_CGELSD = INT( RWQ ( 1 ) ) * Compute LIWORK workspace needed for CGELSY and CGELSD - LIWORK = MAX( LIWORK, N, IWQ ) + LIWORK = MAX( LIWORK, N, IWQ ( 1 ) ) * Compute LRWORK workspace needed for CGELSY, CGELSS and CGELSD LRWORK = MAX( LRWORK, LRWORK_CGELSY, $ LRWORK_CGELSS, LRWORK_CGELSD ) @@ -408,6 +408,7 @@ ALLOCATE( WORK( LWORK ) ) ALLOCATE( IWORK( LIWORK ) ) ALLOCATE( RWORK( LRWORK ) ) + ALLOCATE( WORK2( 2 * LWORK ) ) * DO 140 IM = 1, NM M = MVAL( IM ) @@ -596,7 +597,7 @@ $ CALL CLACPY( 'Full', NROWS, NRHS, $ COPYB, LDB, C, LDB ) CALL CQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, WORK, + $ LDA, B, LDB, C, LDB, WORK2, $ RESULT( 15 ) ) * IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. diff --git a/lapack-netlib/TESTING/LIN/cdrvsy_rk.f b/lapack-netlib/TESTING/LIN/cdrvsy_rk.f index ae313c243..d3ed8c0a9 100644 --- a/lapack-netlib/TESTING/LIN/cdrvsy_rk.f +++ b/lapack-netlib/TESTING/LIN/cdrvsy_rk.f @@ -98,8 +98,9 @@ *> \param[out] E *> \verbatim *> E is COMPLEX array, dimension (NMAX) -*> \param[out] AINV +*> \endverbatim *> +*> \param[out] AINV *> \verbatim *> AINV is COMPLEX array, dimension (NMAX*NMAX) *> \endverbatim diff --git a/lapack-netlib/TESTING/LIN/cerrunhr_col.f b/lapack-netlib/TESTING/LIN/cerrunhr_col.f new file mode 100644 index 000000000..8fd58a683 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/cerrunhr_col.f @@ -0,0 +1,164 @@ +*> \brief \b CERRUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CERRUNHR_COL( PATH, NUNIT ) +* +* .. Scalar Arguments .. +* CHARACTER*3 PATH +* INTEGER NUNIT +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CERRUNHR_COL tests the error exits for CUNHR_COL that does +*> Householder reconstruction from the ouput of tall-skinny +*> factorization CLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] PATH +*> \verbatim +*> PATH is CHARACTER*3 +*> The LAPACK path name for the routines to be tested. +*> \endverbatim +*> +*> \param[in] NUNIT +*> \verbatim +*> NUNIT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex_lin +* +* ===================================================================== + SUBROUTINE CERRUNHR_COL( PATH, NUNIT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + CHARACTER(LEN=3) PATH + INTEGER NUNIT +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NMAX + PARAMETER ( NMAX = 2 ) +* .. +* .. Local Scalars .. + INTEGER I, INFO, J +* .. +* .. Local Arrays .. + COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX) +* .. +* .. External Subroutines .. + EXTERNAL ALAESM, CHKXER, CUNHR_COL +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NOUT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NOUT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Intrinsic Functions .. + INTRINSIC REAL, CMPLX +* .. +* .. Executable Statements .. +* + NOUT = NUNIT + WRITE( NOUT, FMT = * ) +* +* Set the variables to innocuous values. +* + DO J = 1, NMAX + DO I = 1, NMAX + A( I, J ) = CMPLX( 1.E+0 / REAL( I+J ) ) + T( I, J ) = CMPLX( 1.E+0 / REAL( I+J ) ) + END DO + D( J ) = ( 0.E+0, 0.E+0 ) + END DO + OK = .TRUE. +* +* Error exits for Householder reconstruction +* +* CUNHR_COL +* + SRNAMT = 'CUNHR_COL' +* + INFOT = 1 + CALL CUNHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 2 + CALL CUNHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) + CALL CUNHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 3 + CALL CUNHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL CUNHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 5 + CALL CUNHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL CUNHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL CUNHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 7 + CALL CUNHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL CUNHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL CUNHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO ) + CALL CHKXER( 'CUNHR_COL', INFOT, NOUT, LERR, OK ) +* +* Print a summary line. +* + CALL ALAESM( PATH, OK, NOUT ) +* + RETURN +* +* End of CERRUNHR_COL +* + END diff --git a/lapack-netlib/TESTING/LIN/cerrvx.f b/lapack-netlib/TESTING/LIN/cerrvx.f index d2d3d2a85..7f929f07f 100644 --- a/lapack-netlib/TESTING/LIN/cerrvx.f +++ b/lapack-netlib/TESTING/LIN/cerrvx.f @@ -739,7 +739,7 @@ $ W, 1, INFO ) CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL CHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1, + CALL CHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, $ W, 1, INFO ) CALL CHKXER( 'CHESV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 7 @@ -769,7 +769,7 @@ $ W, 1, INFO ) CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL CSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1, + CALL CSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, $ W, 1, INFO ) CALL CHKXER( 'CSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 7 diff --git a/lapack-netlib/TESTING/LIN/clahilb.f b/lapack-netlib/TESTING/LIN/clahilb.f index f88491a0d..c54884b9f 100644 --- a/lapack-netlib/TESTING/LIN/clahilb.f +++ b/lapack-netlib/TESTING/LIN/clahilb.f @@ -164,7 +164,7 @@ INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8) * -* d's are generated from random permuation of those eight elements. +* d's are generated from random permutation of those eight elements. COMPLEX D1(8), D2(8), INVD1(8), INVD2(8) DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/ DATA D2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/ diff --git a/lapack-netlib/TESTING/LIN/ctsqr01.f b/lapack-netlib/TESTING/LIN/ctsqr01.f index a3bd9ebc9..6d788ba41 100644 --- a/lapack-netlib/TESTING/LIN/ctsqr01.f +++ b/lapack-netlib/TESTING/LIN/ctsqr01.f @@ -114,7 +114,7 @@ * .. * .. Local Arrays .. INTEGER ISEED( 4 ) - COMPLEX TQUERY( 5 ), WORKQUERY + COMPLEX TQUERY( 5 ), WORKQUERY( 1 ) * .. * .. External Functions .. REAL SLAMCH, CLANGE, CLANSY @@ -173,22 +173,22 @@ * CALL CGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL CGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMQR( 'L', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMQR( 'R', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'CGEQR' @@ -316,22 +316,22 @@ ELSE CALL CGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, $ WORKQUERY, -1, INFO ) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'CGELQ' diff --git a/lapack-netlib/TESTING/LIN/cunhr_col01.f b/lapack-netlib/TESTING/LIN/cunhr_col01.f new file mode 100644 index 000000000..d760caba5 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/cunhr_col01.f @@ -0,0 +1,390 @@ +*> \brief \b CUNHR_COL01 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT ) +* +* .. Scalar Arguments .. +* INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. +* REAL RESULT(6) +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CUNHR_COL01 tests CUNHR_COL using CLATSQR, CGEMQRT and CUNGTSQR. +*> Therefore, CLATSQR (part of CGEQR), CGEMQRT (part CGEMQR), CUNGTSQR +*> have to be tested before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> Number of rows in test matrix. +*> \endverbatim +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> Number of columns in test matrix. +*> \endverbatim +*> \param[in] MB1 +*> \verbatim +*> MB1 is INTEGER +*> Number of row in row block in an input test matrix. +*> \endverbatim +*> +*> \param[in] NB1 +*> \verbatim +*> NB1 is INTEGER +*> Number of columns in column block an input test matrix. +*> \endverbatim +*> +*> \param[in] NB2 +*> \verbatim +*> NB2 is INTEGER +*> Number of columns in column block in an output test matrix. +*> \endverbatim +*> +*> \param[out] RESULT +*> \verbatim +*> RESULT is REAL array, dimension (6) +*> Results of each of the six tests below. +*> ( C is a M-by-N random matrix, D is a N-by-M random matrix ) +*> +*> RESULT(1) = | A - Q * R | / (eps * m * |A|) +*> RESULT(2) = | I - (Q**H) * Q | / (eps * m ) +*> RESULT(3) = | Q * C - Q * C | / (eps * m * |C|) +*> RESULT(4) = | (Q**H) * C - (Q**H) * C | / (eps * m * |C|) +*> RESULT(5) = | (D * Q) - D * Q | / (eps * m * |D|) +*> RESULT(6) = | D * (Q**H) - D * (Q**H) | / (eps * m * |D|) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16_lin +* +* ===================================================================== + SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. + REAL RESULT(6) +* +* ===================================================================== +* +* .. +* .. Local allocatable arrays + COMPLEX, ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:), + $ WORK( : ), T1(:,:), T2(:,:), DIAG(:), + $ C(:,:), CF(:,:), D(:,:), DF(:,:) + REAL, ALLOCATABLE :: RWORK(:) +* +* .. Parameters .. + REAL ZERO + PARAMETER ( ZERO = 0.0E+0 ) + COMPLEX CONE, CZERO + PARAMETER ( CONE = ( 1.0E+0, 0.0E+0 ), + $ CZERO = ( 0.0E+0, 0.0E+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL TESTZEROS + INTEGER INFO, I, J, K, L, LWORK, NB1_UB, NB2_UB, NRB + REAL ANORM, EPS, RESID, CNORM, DNORM +* .. +* .. Local Arrays .. + INTEGER ISEED( 4 ) + COMPLEX WORKQUERY( 1 ) +* .. +* .. External Functions .. + REAL SLAMCH, CLANGE, CLANSY + EXTERNAL SLAMCH, CLANGE, CLANSY +* .. +* .. External Subroutines .. + EXTERNAL CLACPY, CLARNV, CLASET, CLATSQR, CUNHR_COL, + $ CUNGTSQR, CSCAL, CGEMM, CGEMQRT, CHERK +* .. +* .. Intrinsic Functions .. + INTRINSIC CEILING, REAL, MAX, MIN +* .. +* .. Scalars in Common .. + CHARACTER(LEN=32) SRNAMT +* .. +* .. Common blocks .. + COMMON / SRMNAMC / SRNAMT +* .. +* .. Data statements .. + DATA ISEED / 1988, 1989, 1990, 1991 / +* +* TEST MATRICES WITH HALF OF MATRIX BEING ZEROS +* + TESTZEROS = .FALSE. +* + EPS = SLAMCH( 'Epsilon' ) + K = MIN( M, N ) + L = MAX( M, N, 1) +* +* Dynamically allocate local arrays +* + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ C(M,N), CF(M,N), + $ D(N,M), DF(N,M) ) +* +* Put random numbers into A and copy to AF +* + DO J = 1, N + CALL CLARNV( 2, ISEED, M, A( 1, J ) ) + END DO + IF( TESTZEROS ) THEN + IF( M.GE.4 ) THEN + DO J = 1, N + CALL CLARNV( 2, ISEED, M/2, A( M/4, J ) ) + END DO + END IF + END IF + CALL CLACPY( 'Full', M, N, A, M, AF, M ) +* +* Number of row blocks in CLATSQR +* + NRB = MAX( 1, CEILING( REAL( M - N ) / REAL( MB1 - N ) ) ) +* + ALLOCATE ( T1( NB1, N * NRB ) ) + ALLOCATE ( T2( NB2, N ) ) + ALLOCATE ( DIAG( N ) ) +* +* Begin determine LWORK for the array WORK and allocate memory. +* +* CLATSQR requires NB1 to be bounded by N. +* + NB1_UB = MIN( NB1, N) +* +* CGEMQRT requires NB2 to be bounded by N. +* + NB2_UB = MIN( NB2, N) +* + CALL CLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, + $ WORKQUERY, -1, INFO ) + LWORK = INT( WORKQUERY( 1 ) ) + CALL CUNGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORKQUERY, -1, + $ INFO ) + + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) +* +* In CGEMQRT, WORK is N*NB2_UB if SIDE = 'L', +* or M*NB2_UB if SIDE = 'R'. +* + LWORK = MAX( LWORK, NB2_UB * N, NB2_UB * M ) +* + ALLOCATE ( WORK( LWORK ) ) +* +* End allocate memory for WORK. +* +* +* Begin Householder reconstruction routines +* +* Factor the matrix A in the array AF. +* + SRNAMT = 'CLATSQR' + CALL CLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Copy the factor R into the array R. +* + SRNAMT = 'CLACPY' + CALL CLACPY( 'U', M, N, AF, M, R, M ) +* +* Reconstruct the orthogonal matrix Q. +* + SRNAMT = 'CUNGTSQR' + CALL CUNGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Perform the Householder reconstruction, the result is stored +* the arrays AF and T2. +* + SRNAMT = 'CUNHR_COL' + CALL CUNHR_COL( M, N, NB2, AF, M, T2, NB2, DIAG, INFO ) +* +* Compute the factor R_hr corresponding to the Householder +* reconstructed Q_hr and place it in the upper triangle of AF to +* match the Q storage format in CGEQRT. R_hr = R_tsqr * S, +* this means changing the sign of I-th row of the matrix R_tsqr +* according to sign of of I-th diagonal element DIAG(I) of the +* matrix S. +* + SRNAMT = 'CLACPY' + CALL CLACPY( 'U', M, N, R, M, AF, M ) +* + DO I = 1, N + IF( DIAG( I ).EQ.-CONE ) THEN + CALL CSCAL( N+1-I, -CONE, AF( I, I ), M ) + END IF + END DO +* +* End Householder reconstruction routines. +* +* +* Generate the m-by-m matrix Q +* + CALL CLASET( 'Full', M, M, CZERO, CONE, Q, M ) +* + SRNAMT = 'CGEMQRT' + CALL CGEMQRT( 'L', 'N', M, M, K, NB2_UB, AF, M, T2, NB2, Q, M, + $ WORK, INFO ) +* +* Copy R +* + CALL CLASET( 'Full', M, N, CZERO, CZERO, R, M ) +* + CALL CLACPY( 'Upper', M, N, AF, M, R, M ) +* +* TEST 1 +* Compute |R - (Q**H)*A| / ( eps * m * |A| ) and store in RESULT(1) +* + CALL CGEMM( 'C', 'N', M, N, M, -CONE, Q, M, A, M, CONE, R, M ) +* + ANORM = CLANGE( '1', M, N, A, M, RWORK ) + RESID = CLANGE( '1', M, N, R, M, RWORK ) + IF( ANORM.GT.ZERO ) THEN + RESULT( 1 ) = RESID / ( EPS * MAX( 1, M ) * ANORM ) + ELSE + RESULT( 1 ) = ZERO + END IF +* +* TEST 2 +* Compute |I - (Q**H)*Q| / ( eps * m ) and store in RESULT(2) +* + CALL CLASET( 'Full', M, M, CZERO, CONE, R, M ) + CALL CHERK( 'U', 'C', M, M, -CONE, Q, M, CONE, R, M ) + RESID = CLANSY( '1', 'Upper', M, R, M, RWORK ) + RESULT( 2 ) = RESID / ( EPS * MAX( 1, M ) ) +* +* Generate random m-by-n matrix C +* + DO J = 1, N + CALL CLARNV( 2, ISEED, M, C( 1, J ) ) + END DO + CNORM = CLANGE( '1', M, N, C, M, RWORK ) + CALL CLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as Q*C = CF +* + SRNAMT = 'CGEMQRT' + CALL CGEMQRT( 'L', 'N', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 3 +* Compute |CF - Q*C| / ( eps * m * |C| ) +* + CALL CGEMM( 'N', 'N', M, N, M, -CONE, Q, M, C, M, CONE, CF, M ) + RESID = CLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 3 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 3 ) = ZERO + END IF +* +* Copy C into CF again +* + CALL CLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as (Q**H)*C = CF +* + SRNAMT = 'CGEMQRT' + CALL CGEMQRT( 'L', 'C', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 4 +* Compute |CF - (Q**H)*C| / ( eps * m * |C|) +* + CALL CGEMM( 'C', 'N', M, N, M, -CONE, Q, M, C, M, CONE, CF, M ) + RESID = CLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 4 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 4 ) = ZERO + END IF +* +* Generate random n-by-m matrix D and a copy DF +* + DO J = 1, M + CALL CLARNV( 2, ISEED, N, D( 1, J ) ) + END DO + DNORM = CLANGE( '1', N, M, D, N, RWORK ) + CALL CLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*Q = DF +* + SRNAMT = 'CGEMQRT' + CALL CGEMQRT( 'R', 'N', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 5 +* Compute |DF - D*Q| / ( eps * m * |D| ) +* + CALL CGEMM( 'N', 'N', N, M, M, -CONE, D, N, Q, M, CONE, DF, N ) + RESID = CLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 5 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 5 ) = ZERO + END IF +* +* Copy D into DF again +* + CALL CLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*QT = DF +* + SRNAMT = 'CGEMQRT' + CALL CGEMQRT( 'R', 'C', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 6 +* Compute |DF - D*(Q**H)| / ( eps * m * |D| ) +* + CALL CGEMM( 'N', 'C', N, M, M, -CONE, D, N, Q, M, CONE, DF, N ) + RESID = CLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 6 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 6 ) = ZERO + END IF +* +* Deallocate all arrays +* + DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T1, T2, DIAG, + $ C, D, CF, DF ) +* + RETURN +* +* End of CUNHR_COL01 +* + END diff --git a/lapack-netlib/TESTING/LIN/dchkaa.f b/lapack-netlib/TESTING/LIN/dchkaa.f index c5fd7afda..03575c4d1 100644 --- a/lapack-netlib/TESTING/LIN/dchkaa.f +++ b/lapack-netlib/TESTING/LIN/dchkaa.f @@ -68,6 +68,10 @@ *> DEQ *> DQT *> DQX +*> DTQ +*> DXQ +*> DTS +*> DHH *> \endverbatim * * Parameters: @@ -102,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 +*> \date November 2019 * *> \ingroup double_lin * * ===================================================================== PROGRAM DCHKAA * -* -- LAPACK test routine (version 3.8.0) -- +* -- LAPACK test routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 +* Novemebr 2019 * * ===================================================================== * @@ -159,15 +163,14 @@ * .. * .. External Subroutines .. EXTERNAL ALAREQ, DCHKEQ, DCHKGB, DCHKGE, DCHKGT, DCHKLQ, - $ DCHKPB, DCHKPO, DCHKPS, DCHKPP, DCHKPT, DCHKQ3, - $ DCHKQL, DCHKQR, DCHKRQ, DCHKSP, DCHKSY, - $ DCHKSY_ROOK, DCHKSY_RK, DCHKSY_AA, DCHKTB, - $ DCHKTP, DCHKTR, DCHKTZ, DDRVGB, DDRVGE, - $ DDRVGT, DDRVLS, DDRVPB, DDRVPO, DDRVPP, - $ DDRVPT, DDRVSP, DDRVSY, DDRVSY_ROOK, DDRVSY_RK, - $ DDRVSY_AA, ILAVER, DCHKQRT, - $ DCHKQRTP, DCHKLQTP, DCHKTSQR, DCHKLQT - + $ DCHKORHR_COL, DCHKPB, DCHKPO, DCHKPS, DCHKPP, + $ DCHKPT, DCHKQ3, DCHKQL, DCHKQR, DCHKRQ, DCHKSP, + $ DCHKSY, DCHKSY_ROOK, DCHKSY_RK, DCHKSY_AA, + $ DCHKTB, DCHKTP, DCHKTR, DCHKTZ, DDRVGB, DDRVGE, + $ DDRVGT, DDRVLS, DDRVPB, DDRVPO, DDRVPP, DDRVPT, + $ DDRVSP, DDRVSY, DDRVSY_ROOK, DDRVSY_RK, + $ DDRVSY_AA, ILAVER, DCHKLQTP, DCHKQRT, DCHKQRTP, + $ DCHKLQT,DCHKTSQR * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -1007,8 +1010,20 @@ ELSE WRITE( NOUT, FMT = 9989 )PATH END IF +* + ELSE IF( LSAMEN( 2, C2, 'HH' ) ) THEN +* +* HH: Householder reconstruction for tall-skinny matrices +* + IF( TSTCHK ) THEN + CALL DCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + ELSE + WRITE( NOUT, FMT = 9989 ) PATH + END IF * ELSE + * WRITE( NOUT, FMT = 9990 )PATH END IF diff --git a/lapack-netlib/TESTING/LIN/dchkorhr_col.f b/lapack-netlib/TESTING/LIN/dchkorhr_col.f new file mode 100644 index 000000000..3b3e421eb --- /dev/null +++ b/lapack-netlib/TESTING/LIN/dchkorhr_col.f @@ -0,0 +1,239 @@ +*> \brief \b DCHKORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* NBVAL, NOUT ) +* +* .. Scalar Arguments .. +* LOGICAL TSTERR +* INTEGER NM, NN, NNB, NOUT +* DOUBLE PRECISION THRESH +* .. +* .. Array Arguments .. +* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DCHKORHR_COL tests DORHR_COL using DLATSQR and DGEMQRT. Therefore, DLATSQR +*> (used in DGEQR) and DGEMQRT (used in DGEMQR) have to be tested +*> before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] THRESH +*> \verbatim +*> THRESH is DOUBLE PRECISION +*> The threshold value for the test ratios. A result is +*> included in the output file if RESULT >= THRESH. To have +*> every test ratio printed, use THRESH = 0. +*> \endverbatim +*> +*> \param[in] TSTERR +*> \verbatim +*> TSTERR is LOGICAL +*> Flag that indicates whether error exits are to be tested. +*> \endverbatim +*> +*> \param[in] NM +*> \verbatim +*> NM is INTEGER +*> The number of values of M contained in the vector MVAL. +*> \endverbatim +*> +*> \param[in] MVAL +*> \verbatim +*> MVAL is INTEGER array, dimension (NM) +*> The values of the matrix row dimension M. +*> \endverbatim +*> +*> \param[in] NN +*> \verbatim +*> NN is INTEGER +*> The number of values of N contained in the vector NVAL. +*> \endverbatim +*> +*> \param[in] NVAL +*> \verbatim +*> NVAL is INTEGER array, dimension (NN) +*> The values of the matrix column dimension N. +*> \endverbatim +*> +*> \param[in] NNB +*> \verbatim +*> NNB is INTEGER +*> The number of values of NB contained in the vector NBVAL. +*> \endverbatim +*> +*> \param[in] NBVAL +*> \verbatim +*> NBVAL is INTEGER array, dimension (NBVAL) +*> The values of the blocksize NB. +*> \endverbatim +*> +*> \param[in] NOUT +*> \verbatim +*> NOUT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup double_lin +* +* ===================================================================== + SUBROUTINE DCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.7.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* December 2016 +* +* .. Scalar Arguments .. + LOGICAL TSTERR + INTEGER NM, NN, NNB, NOUT + DOUBLE PRECISION THRESH +* .. +* .. Array Arguments .. + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NTESTS + PARAMETER ( NTESTS = 6 ) +* .. +* .. Local Scalars .. + CHARACTER(LEN=3) PATH + INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1, + $ NB2, NFAIL, NERRS, NRUN +* +* .. Local Arrays .. + DOUBLE PRECISION RESULT( NTESTS ) +* .. +* .. External Subroutines .. + EXTERNAL ALAHD, ALASUM, DERRORHR_COL, DORHR_COL01 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NUNIT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NUNIT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Executable Statements .. +* +* Initialize constants +* + PATH( 1: 1 ) = 'D' + PATH( 2: 3 ) = 'HH' + NRUN = 0 + NFAIL = 0 + NERRS = 0 +* +* Test the error exits +* + IF( TSTERR ) CALL DERRORHR_COL( PATH, NOUT ) + INFOT = 0 +* +* Do for each value of M in MVAL. +* + DO I = 1, NM + M = MVAL( I ) +* +* Do for each value of N in NVAL. +* + DO J = 1, NN + N = NVAL( J ) +* +* Only for M >= N +* + IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN +* +* Do for each possible value of MB1 +* + DO IMB1 = 1, NNB + MB1 = NBVAL( IMB1 ) +* +* Only for MB1 > N +* + IF ( MB1.GT.N ) THEN +* +* Do for each possible value of NB1 +* + DO INB1 = 1, NNB + NB1 = NBVAL( INB1 ) +* +* Do for each possible value of NB2 +* + DO INB2 = 1, NNB + NB2 = NBVAL( INB2 ) +* + IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN +* +* Test DORHR_COL +* + CALL DORHR_COL01( M, N, MB1, NB1, NB2, + $ RESULT ) +* +* Print information about the tests that did +* not pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) M, N, MB1, + $ NB1, NB2, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO + NRUN = NRUN + NTESTS + END IF + END DO + END DO + END IF + END DO + END IF + END DO + END DO +* +* Print a summary of the results. +* + CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) +* + 9999 FORMAT( 'M=', I5, ', N=', I5, ', MB1=', I5, + $ ', NB1=', I5, ', NB2=', I5,' test(', I2, ')=', G12.5 ) + RETURN +* +* End of DCHKORHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/TESTING/LIN/ddrvls.f b/lapack-netlib/TESTING/LIN/ddrvls.f index 2f4975553..adfd71e09 100644 --- a/lapack-netlib/TESTING/LIN/ddrvls.f +++ b/lapack-netlib/TESTING/LIN/ddrvls.f @@ -233,8 +233,8 @@ DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ - DOUBLE PRECISION RESULT( NTESTS ), WQ + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ( 1 ) + DOUBLE PRECISION RESULT( NTESTS ), WQ( 1 ) * .. * .. Allocatable Arrays .. DOUBLE PRECISION, ALLOCATABLE :: WORK (:) @@ -359,27 +359,27 @@ * Compute workspace needed for DGELS CALL DGELS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_DGELS = INT ( WQ ) + LWORK_DGELS = INT ( WQ ( 1 ) ) * Compute workspace needed for DGETSLS CALL DGETSLS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_DGETSLS = INT( WQ ) + LWORK_DGETSLS = INT( WQ ( 1 ) ) ENDDO END IF * Compute workspace needed for DGELSY CALL DGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ, $ RCOND, CRANK, WQ, -1, INFO ) - LWORK_DGELSY = INT( WQ ) + LWORK_DGELSY = INT( WQ ( 1 ) ) * Compute workspace needed for DGELSS CALL DGELSS( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1 , INFO ) - LWORK_DGELSS = INT( WQ ) + LWORK_DGELSS = INT( WQ ( 1 ) ) * Compute workspace needed for DGELSD CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1, IWQ, INFO ) - LWORK_DGELSD = INT( WQ ) + LWORK_DGELSD = INT( WQ ( 1 ) ) * Compute LIWORK workspace needed for DGELSY and DGELSD - LIWORK = MAX( LIWORK, N, IWQ ) + LIWORK = MAX( LIWORK, N, IWQ( 1 ) ) * Compute LWORK workspace needed for all functions LWORK = MAX( LWORK, LWORK_DGELS, LWORK_DGETSLS, $ LWORK_DGELSY, LWORK_DGELSS, diff --git a/lapack-netlib/TESTING/LIN/derrorhr_col.f b/lapack-netlib/TESTING/LIN/derrorhr_col.f new file mode 100644 index 000000000..6d545bc91 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/derrorhr_col.f @@ -0,0 +1,164 @@ +*> \brief \b DERRORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DERRORHR_COL( PATH, NUNIT ) +* +* .. Scalar Arguments .. +* CHARACTER*3 PATH +* INTEGER NUNIT +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DERRORHR_COL tests the error exits for DORHR_COL that does +*> Householder reconstruction from the ouput of tall-skinny +*> factorization DLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] PATH +*> \verbatim +*> PATH is CHARACTER*3 +*> The LAPACK path name for the routines to be tested. +*> \endverbatim +*> +*> \param[in] NUNIT +*> \verbatim +*> NUNIT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup double_lin +* +* ===================================================================== + SUBROUTINE DERRORHR_COL( PATH, NUNIT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + CHARACTER(LEN=3) PATH + INTEGER NUNIT +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NMAX + PARAMETER ( NMAX = 2 ) +* .. +* .. Local Scalars .. + INTEGER I, INFO, J +* .. +* .. Local Arrays .. + DOUBLE PRECISION A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX) +* .. +* .. External Subroutines .. + EXTERNAL ALAESM, CHKXER, DORHR_COL +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NOUT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NOUT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE +* .. +* .. Executable Statements .. +* + NOUT = NUNIT + WRITE( NOUT, FMT = * ) +* +* Set the variables to innocuous values. +* + DO J = 1, NMAX + DO I = 1, NMAX + A( I, J ) = 1.D+0 / DBLE( I+J ) + T( I, J ) = 1.D+0 / DBLE( I+J ) + END DO + D( J ) = 0.D+0 + END DO + OK = .TRUE. +* +* Error exits for Householder reconstruction +* +* DORHR_COL +* + SRNAMT = 'DORHR_COL' +* + INFOT = 1 + CALL DORHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 2 + CALL DORHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) + CALL DORHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 3 + CALL DORHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL DORHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 5 + CALL DORHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL DORHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL DORHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 7 + CALL DORHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL DORHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL DORHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO ) + CALL CHKXER( 'DORHR_COL', INFOT, NOUT, LERR, OK ) +* +* Print a summary line. +* + CALL ALAESM( PATH, OK, NOUT ) +* + RETURN +* +* End of DERRORHR_COL +* + END diff --git a/lapack-netlib/TESTING/LIN/derrvx.f b/lapack-netlib/TESTING/LIN/derrvx.f index 3a4a6b7fc..fd1d038a6 100644 --- a/lapack-netlib/TESTING/LIN/derrvx.f +++ b/lapack-netlib/TESTING/LIN/derrvx.f @@ -740,7 +740,7 @@ $ W, 1, INFO ) CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL DSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1, + CALL DSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, $ W, 1, INFO ) CALL CHKXER( 'DSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 7 diff --git a/lapack-netlib/TESTING/LIN/dorhr_col01.f b/lapack-netlib/TESTING/LIN/dorhr_col01.f new file mode 100644 index 000000000..3e48de37f --- /dev/null +++ b/lapack-netlib/TESTING/LIN/dorhr_col01.f @@ -0,0 +1,386 @@ +*> \brief \b DORHR_COL01 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DORHR_COL01( M, N, MB1, NB1, NB2, RESULT ) +* +* .. Scalar Arguments .. +* INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. +* DOUBLE PRECISION RESULT(6) +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DORHR_COL01 tests DORHR_COL using DLATSQR, DGEMQRT and DORGTSQR. +*> Therefore, DLATSQR (part of DGEQR), DGEMQRT (part DGEMQR), DORGTSQR +*> have to be tested before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> Number of rows in test matrix. +*> \endverbatim +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> Number of columns in test matrix. +*> \endverbatim +*> \param[in] MB1 +*> \verbatim +*> MB1 is INTEGER +*> Number of row in row block in an input test matrix. +*> \endverbatim +*> +*> \param[in] NB1 +*> \verbatim +*> NB1 is INTEGER +*> Number of columns in column block an input test matrix. +*> \endverbatim +*> +*> \param[in] NB2 +*> \verbatim +*> NB2 is INTEGER +*> Number of columns in column block in an output test matrix. +*> \endverbatim +*> +*> \param[out] RESULT +*> \verbatim +*> RESULT is DOUBLE PRECISION array, dimension (6) +*> Results of each of the six tests below. +*> ( C is a M-by-N random matrix, D is a N-by-M random matrix ) +*> +*> RESULT(1) = | A - Q * R | / (eps * m * |A|) +*> RESULT(2) = | I - (Q**H) * Q | / (eps * m ) +*> RESULT(3) = | Q * C - Q * C | / (eps * m * |C|) +*> RESULT(4) = | (Q**H) * C - (Q**H) * C | / (eps * m * |C|) +*> RESULT(5) = | (D * Q) - D * Q | / (eps * m * |D|) +*> RESULT(6) = | D * (Q**H) - D * (Q**H) | / (eps * m * |D|) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup single_lin +* +* ===================================================================== + SUBROUTINE DORHR_COL01( M, N, MB1, NB1, NB2, RESULT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. + DOUBLE PRECISION RESULT(6) +* +* ===================================================================== +* +* .. +* .. Local allocatable arrays + DOUBLE PRECISION, ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:), + $ RWORK(:), WORK( : ), T1(:,:), T2(:,:), DIAG(:), + $ C(:,:), CF(:,:), D(:,:), DF(:,:) +* +* .. Parameters .. + DOUBLE PRECISION ONE, ZERO + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) +* .. +* .. Local Scalars .. + LOGICAL TESTZEROS + INTEGER INFO, I, J, K, L, LWORK, NB1_UB, NB2_UB, NRB + DOUBLE PRECISION ANORM, EPS, RESID, CNORM, DNORM +* .. +* .. Local Arrays .. + INTEGER ISEED( 4 ) + DOUBLE PRECISION WORKQUERY( 1 ) +* .. +* .. External Functions .. + DOUBLE PRECISION DLAMCH, DLANGE, DLANSY + EXTERNAL DLAMCH, DLANGE, DLANSY +* .. +* .. External Subroutines .. + EXTERNAL DLACPY, DLARNV, DLASET, DLATSQR, DORHR_COL, + $ DORGTSQR, DSCAL, DGEMM, DGEMQRT, DSYRK +* .. +* .. Intrinsic Functions .. + INTRINSIC CEILING, DBLE, MAX, MIN +* .. +* .. Scalars in Common .. + CHARACTER(LEN=32) SRNAMT +* .. +* .. Common blocks .. + COMMON / SRMNAMC / SRNAMT +* .. +* .. Data statements .. + DATA ISEED / 1988, 1989, 1990, 1991 / +* +* TEST MATRICES WITH HALF OF MATRIX BEING ZEROS +* + TESTZEROS = .FALSE. +* + EPS = DLAMCH( 'Epsilon' ) + K = MIN( M, N ) + L = MAX( M, N, 1) +* +* Dynamically allocate local arrays +* + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ C(M,N), CF(M,N), + $ D(N,M), DF(N,M) ) +* +* Put random numbers into A and copy to AF +* + DO J = 1, N + CALL DLARNV( 2, ISEED, M, A( 1, J ) ) + END DO + IF( TESTZEROS ) THEN + IF( M.GE.4 ) THEN + DO J = 1, N + CALL DLARNV( 2, ISEED, M/2, A( M/4, J ) ) + END DO + END IF + END IF + CALL DLACPY( 'Full', M, N, A, M, AF, M ) +* +* Number of row blocks in DLATSQR +* + NRB = MAX( 1, CEILING( DBLE( M - N ) / DBLE( MB1 - N ) ) ) +* + ALLOCATE ( T1( NB1, N * NRB ) ) + ALLOCATE ( T2( NB2, N ) ) + ALLOCATE ( DIAG( N ) ) +* +* Begin determine LWORK for the array WORK and allocate memory. +* +* DLATSQR requires NB1 to be bounded by N. +* + NB1_UB = MIN( NB1, N) +* +* DGEMQRT requires NB2 to be bounded by N. +* + NB2_UB = MIN( NB2, N) +* + CALL DLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, + $ WORKQUERY, -1, INFO ) + LWORK = INT( WORKQUERY( 1 ) ) + CALL DORGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORKQUERY, -1, + $ INFO ) + + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) +* +* In DGEMQRT, WORK is N*NB2_UB if SIDE = 'L', +* or M*NB2_UB if SIDE = 'R'. +* + LWORK = MAX( LWORK, NB2_UB * N, NB2_UB * M ) +* + ALLOCATE ( WORK( LWORK ) ) +* +* End allocate memory for WORK. +* +* +* Begin Householder reconstruction routines +* +* Factor the matrix A in the array AF. +* + SRNAMT = 'DLATSQR' + CALL DLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Copy the factor R into the array R. +* + SRNAMT = 'DLACPY' + CALL DLACPY( 'U', N, N, AF, M, R, M ) +* +* Reconstruct the orthogonal matrix Q. +* + SRNAMT = 'DORGTSQR' + CALL DORGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Perform the Householder reconstruction, the result is stored +* the arrays AF and T2. +* + SRNAMT = 'DORHR_COL' + CALL DORHR_COL( M, N, NB2, AF, M, T2, NB2, DIAG, INFO ) +* +* Compute the factor R_hr corresponding to the Householder +* reconstructed Q_hr and place it in the upper triangle of AF to +* match the Q storage format in DGEQRT. R_hr = R_tsqr * S, +* this means changing the sign of I-th row of the matrix R_tsqr +* according to sign of of I-th diagonal element DIAG(I) of the +* matrix S. +* + SRNAMT = 'DLACPY' + CALL DLACPY( 'U', N, N, R, M, AF, M ) +* + DO I = 1, N + IF( DIAG( I ).EQ.-ONE ) THEN + CALL DSCAL( N+1-I, -ONE, AF( I, I ), M ) + END IF + END DO +* +* End Householder reconstruction routines. +* +* +* Generate the m-by-m matrix Q +* + CALL DLASET( 'Full', M, M, ZERO, ONE, Q, M ) +* + SRNAMT = 'DGEMQRT' + CALL DGEMQRT( 'L', 'N', M, M, K, NB2_UB, AF, M, T2, NB2, Q, M, + $ WORK, INFO ) +* +* Copy R +* + CALL DLASET( 'Full', M, N, ZERO, ZERO, R, M ) +* + CALL DLACPY( 'Upper', M, N, AF, M, R, M ) +* +* TEST 1 +* Compute |R - (Q**T)*A| / ( eps * m * |A| ) and store in RESULT(1) +* + CALL DGEMM( 'T', 'N', M, N, M, -ONE, Q, M, A, M, ONE, R, M ) +* + ANORM = DLANGE( '1', M, N, A, M, RWORK ) + RESID = DLANGE( '1', M, N, R, M, RWORK ) + IF( ANORM.GT.ZERO ) THEN + RESULT( 1 ) = RESID / ( EPS * MAX( 1, M ) * ANORM ) + ELSE + RESULT( 1 ) = ZERO + END IF +* +* TEST 2 +* Compute |I - (Q**T)*Q| / ( eps * m ) and store in RESULT(2) +* + CALL DLASET( 'Full', M, M, ZERO, ONE, R, M ) + CALL DSYRK( 'U', 'T', M, M, -ONE, Q, M, ONE, R, M ) + RESID = DLANSY( '1', 'Upper', M, R, M, RWORK ) + RESULT( 2 ) = RESID / ( EPS * MAX( 1, M ) ) +* +* Generate random m-by-n matrix C +* + DO J = 1, N + CALL DLARNV( 2, ISEED, M, C( 1, J ) ) + END DO + CNORM = DLANGE( '1', M, N, C, M, RWORK ) + CALL DLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as Q*C = CF +* + SRNAMT = 'DGEMQRT' + CALL DGEMQRT( 'L', 'N', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 3 +* Compute |CF - Q*C| / ( eps * m * |C| ) +* + CALL DGEMM( 'N', 'N', M, N, M, -ONE, Q, M, C, M, ONE, CF, M ) + RESID = DLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 3 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 3 ) = ZERO + END IF +* +* Copy C into CF again +* + CALL DLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as (Q**T)*C = CF +* + SRNAMT = 'DGEMQRT' + CALL DGEMQRT( 'L', 'T', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 4 +* Compute |CF - (Q**T)*C| / ( eps * m * |C|) +* + CALL DGEMM( 'T', 'N', M, N, M, -ONE, Q, M, C, M, ONE, CF, M ) + RESID = DLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 4 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 4 ) = ZERO + END IF +* +* Generate random n-by-m matrix D and a copy DF +* + DO J = 1, M + CALL DLARNV( 2, ISEED, N, D( 1, J ) ) + END DO + DNORM = DLANGE( '1', N, M, D, N, RWORK ) + CALL DLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*Q = DF +* + SRNAMT = 'DGEMQRT' + CALL DGEMQRT( 'R', 'N', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 5 +* Compute |DF - D*Q| / ( eps * m * |D| ) +* + CALL DGEMM( 'N', 'N', N, M, M, -ONE, D, N, Q, M, ONE, DF, N ) + RESID = DLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 5 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 5 ) = ZERO + END IF +* +* Copy D into DF again +* + CALL DLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*QT = DF +* + SRNAMT = 'DGEMQRT' + CALL DGEMQRT( 'R', 'T', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 6 +* Compute |DF - D*(Q**T)| / ( eps * m * |D| ) +* + CALL DGEMM( 'N', 'T', N, M, M, -ONE, D, N, Q, M, ONE, DF, N ) + RESID = DLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 6 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 6 ) = ZERO + END IF +* +* Deallocate all arrays +* + DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T1, T2, DIAG, + $ C, D, CF, DF ) +* + RETURN +* +* End of DORHR_COL01 +* + END diff --git a/lapack-netlib/TESTING/LIN/dtsqr01.f b/lapack-netlib/TESTING/LIN/dtsqr01.f index 7a50009cc..25bf58a81 100644 --- a/lapack-netlib/TESTING/LIN/dtsqr01.f +++ b/lapack-netlib/TESTING/LIN/dtsqr01.f @@ -115,7 +115,7 @@ * .. * .. Local Arrays .. INTEGER ISEED( 4 ) - DOUBLE PRECISION TQUERY( 5 ), WORKQUERY + DOUBLE PRECISION TQUERY( 5 ), WORKQUERY( 1 ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DLANGE, DLANSY @@ -174,22 +174,22 @@ * CALL DGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL DGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMQR( 'L', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMQR( 'R', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'DGEQR' @@ -317,22 +317,22 @@ ELSE CALL DGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, $ WORKQUERY, -1, INFO ) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'DGELQ' diff --git a/lapack-netlib/TESTING/LIN/schkaa.f b/lapack-netlib/TESTING/LIN/schkaa.f index 33b109aa7..a9c13e442 100644 --- a/lapack-netlib/TESTING/LIN/schkaa.f +++ b/lapack-netlib/TESTING/LIN/schkaa.f @@ -68,6 +68,8 @@ *> SEQ *> SQT *> SQX +*> STS +*> SHH *> \endverbatim * * Parameters: @@ -102,17 +104,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date April 2012 +*> \date November 2019 * *> \ingroup single_lin * * ===================================================================== PROGRAM SCHKAA * -* -- LAPACK test routine (version 3.8.0) -- +* -- LAPACK test routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* April 2012 +* November 2019 * * ===================================================================== * @@ -159,13 +161,13 @@ * .. * .. External Subroutines .. EXTERNAL ALAREQ, SCHKEQ, SCHKGB, SCHKGE, SCHKGT, SCHKLQ, - $ SCHKPB, SCHKPO, SCHKPS, SCHKPP, SCHKPT, SCHKQ3, - $ SCHKQL, SCHKQR, SCHKRQ, SCHKSP, SCHKSY, - $ SCHKSY_ROOK, SCHKSY_RK, SCHKSY_AA, SCHKTB, - $ SCHKTP, SCHKTR, SCHKTZ, SDRVGB, SDRVGE, SDRVGT, - $ SDRVLS, SDRVPB, SDRVPO, SDRVPP, SDRVPT, SDRVSP, - $ SDRVSY, SDRVSY_ROOK, SDRVSY_RK, SDRVSY_AA, - $ ILAVER, SCHKLQTP, SCHKQRT, SCHKQRTP, + $ SCHKORHR_COL, SCHKPB, SCHKPO, SCHKPS, SCHKPP, + $ SCHKPT, SCHKQ3, SCHKQL, SCHKQR, SCHKRQ, SCHKSP, + $ SCHKSY, SCHKSY_ROOK, SCHKSY_RK, SCHKSY_AA, + $ SCHKTB, SCHKTP, SCHKTR, SCHKTZ, SDRVGB, SDRVGE, + $ SDRVGT, SDRVLS, SDRVPB, SDRVPO, SDRVPP, SDRVPT, + $ SDRVSP, SDRVSY, SDRVSY_ROOK, SDRVSY_RK, + $ SDRVSY_AA, ILAVER, SCHKLQTP, SCHKQRT, SCHKQRTP, $ SCHKLQT, SCHKTSQR * .. * .. Scalars in Common .. @@ -673,7 +675,7 @@ * * SK: symmetric indefinite matrices, * with bounded Bunch-Kaufman (rook) pivoting algorithm, -* differnet matrix storage format than SR path version. +* different matrix storage format than SR path version. * NTYPES = 10 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) @@ -1004,6 +1006,17 @@ ELSE WRITE( NOUT, FMT = 9989 )PATH END IF +* + ELSE IF( LSAMEN( 2, C2, 'HH' ) ) THEN +* +* HH: Householder reconstruction for tall-skinny matrices +* + IF( TSTCHK ) THEN + CALL SCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + ELSE + WRITE( NOUT, FMT = 9989 ) PATH + END IF * ELSE * diff --git a/lapack-netlib/TESTING/LIN/schkorhr_col.f b/lapack-netlib/TESTING/LIN/schkorhr_col.f new file mode 100644 index 000000000..cf6d2d323 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/schkorhr_col.f @@ -0,0 +1,239 @@ +*> \brief \b SCHKORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* NBVAL, NOUT ) +* +* .. Scalar Arguments .. +* LOGICAL TSTERR +* INTEGER NM, NN, NNB, NOUT +* REAL THRESH +* .. +* .. Array Arguments .. +* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SCHKORHR_COL tests SORHR_COL using SLATSQR, SGEMQRT and SORGTSQR. +*> Therefore, SLATSQR (part of SGEQR), SGEMQRT (part SGEMQR), SORGTSQR +*> have to be tested before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] THRESH +*> \verbatim +*> THRESH is REAL +*> The threshold value for the test ratios. A result is +*> included in the output file if RESULT >= THRESH. To have +*> every test ratio printed, use THRESH = 0. +*> \endverbatim +*> +*> \param[in] TSTERR +*> \verbatim +*> TSTERR is LOGICAL +*> Flag that indicates whether error exits are to be tested. +*> \endverbatim +*> +*> \param[in] NM +*> \verbatim +*> NM is INTEGER +*> The number of values of M contained in the vector MVAL. +*> \endverbatim +*> +*> \param[in] MVAL +*> \verbatim +*> MVAL is INTEGER array, dimension (NM) +*> The values of the matrix row dimension M. +*> \endverbatim +*> +*> \param[in] NN +*> \verbatim +*> NN is INTEGER +*> The number of values of N contained in the vector NVAL. +*> \endverbatim +*> +*> \param[in] NVAL +*> \verbatim +*> NVAL is INTEGER array, dimension (NN) +*> The values of the matrix column dimension N. +*> \endverbatim +*> +*> \param[in] NNB +*> \verbatim +*> NNB is INTEGER +*> The number of values of NB contained in the vector NBVAL. +*> \endverbatim +*> +*> \param[in] NBVAL +*> \verbatim +*> NBVAL is INTEGER array, dimension (NBVAL) +*> The values of the blocksize NB. +*> \endverbatim +*> +*> \param[in] NOUT +*> \verbatim +*> NOUT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup sigle_lin +* +* ===================================================================== + SUBROUTINE SCHKORHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* June 2019 +* +* .. Scalar Arguments .. + LOGICAL TSTERR + INTEGER NM, NN, NNB, NOUT + REAL THRESH +* .. +* .. Array Arguments .. + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NTESTS + PARAMETER ( NTESTS = 6 ) +* .. +* .. Local Scalars .. + CHARACTER(LEN=3) PATH + INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1, + $ NB2, NFAIL, NERRS, NRUN +* +* .. Local Arrays .. + REAL RESULT( NTESTS ) +* .. +* .. External Subroutines .. + EXTERNAL ALAHD, ALASUM, SERRORHR_COL, SORHR_COL01 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NUNIT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NUNIT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Executable Statements .. +* +* Initialize constants +* + PATH( 1: 1 ) = 'S' + PATH( 2: 3 ) = 'HH' + NRUN = 0 + NFAIL = 0 + NERRS = 0 +* +* Test the error exits +* + IF( TSTERR ) CALL SERRORHR_COL( PATH, NOUT ) + INFOT = 0 +* +* Do for each value of M in MVAL. +* + DO I = 1, NM + M = MVAL( I ) +* +* Do for each value of N in NVAL. +* + DO J = 1, NN + N = NVAL( J ) +* +* Only for M >= N +* + IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN +* +* Do for each possible value of MB1 +* + DO IMB1 = 1, NNB + MB1 = NBVAL( IMB1 ) +* +* Only for MB1 > N +* + IF ( MB1.GT.N ) THEN +* +* Do for each possible value of NB1 +* + DO INB1 = 1, NNB + NB1 = NBVAL( INB1 ) +* +* Do for each possible value of NB2 +* + DO INB2 = 1, NNB + NB2 = NBVAL( INB2 ) +* + IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN +* +* Test SORHR_COL +* + CALL SORHR_COL01( M, N, MB1, NB1, NB2, + $ RESULT ) +* +* Print information about the tests that did +* not pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) M, N, MB1, + $ NB1, NB2, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO + NRUN = NRUN + NTESTS + END IF + END DO + END DO + END IF + END DO + END IF + END DO + END DO +* +* Print a summary of the results. +* + CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) +* + 9999 FORMAT( 'M=', I5, ', N=', I5, ', MB1=', I5, + $ ', NB1=', I5, ', NB2=', I5,' test(', I2, ')=', G12.5 ) + RETURN +* +* End of SCHKORHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/TESTING/LIN/sdrvls.f b/lapack-netlib/TESTING/LIN/sdrvls.f index 2cf3439b5..649ca558c 100644 --- a/lapack-netlib/TESTING/LIN/sdrvls.f +++ b/lapack-netlib/TESTING/LIN/sdrvls.f @@ -233,8 +233,8 @@ REAL EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ - REAL RESULT( NTESTS ), WQ + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ( 1 ) + REAL RESULT( NTESTS ), WQ( 1 ) * .. * .. Allocatable Arrays .. REAL, ALLOCATABLE :: WORK (:) @@ -358,28 +358,28 @@ * * Compute workspace needed for SGELS CALL SGELS( TRANS, M, N, NRHS, A, LDA, - $ B, LDB, WQ, -1, INFO ) - LWORK_SGELS = INT ( WQ ) + $ B, LDB, WQ( 1 ), -1, INFO ) + LWORK_SGELS = INT ( WQ( 1 ) ) * Compute workspace needed for SGETSLS CALL SGETSLS( TRANS, M, N, NRHS, A, LDA, - $ B, LDB, WQ, -1, INFO ) - LWORK_SGETSLS = INT( WQ ) + $ B, LDB, WQ( 1 ), -1, INFO ) + LWORK_SGETSLS = INT( WQ( 1 ) ) ENDDO END IF * Compute workspace needed for SGELSY CALL SGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ, $ RCOND, CRANK, WQ, -1, INFO ) - LWORK_SGELSY = INT( WQ ) + LWORK_SGELSY = INT( WQ( 1 ) ) * Compute workspace needed for SGELSS CALL SGELSS( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1 , INFO ) - LWORK_SGELSS = INT( WQ ) + LWORK_SGELSS = INT( WQ( 1 ) ) * Compute workspace needed for SGELSD CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1, IWQ, INFO ) - LWORK_SGELSD = INT( WQ ) + LWORK_SGELSD = INT( WQ( 1 ) ) * Compute LIWORK workspace needed for SGELSY and SGELSD - LIWORK = MAX( LIWORK, N, IWQ ) + LIWORK = MAX( LIWORK, N, IWQ( 1 ) ) * Compute LWORK workspace needed for all functions LWORK = MAX( LWORK, LWORK_SGELS, LWORK_SGETSLS, $ LWORK_SGELSY, LWORK_SGELSS, diff --git a/lapack-netlib/TESTING/LIN/serrorhr_col.f b/lapack-netlib/TESTING/LIN/serrorhr_col.f new file mode 100644 index 000000000..e8d81a99c --- /dev/null +++ b/lapack-netlib/TESTING/LIN/serrorhr_col.f @@ -0,0 +1,164 @@ +*> \brief \b SERRORHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SERRORHR_COL( PATH, NUNIT ) +* +* .. Scalar Arguments .. +* CHARACTER*3 PATH +* INTEGER NUNIT +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SERRORHR_COL tests the error exits for SORHR_COL that does +*> Householder reconstruction from the ouput of tall-skinny +*> factorization SLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] PATH +*> \verbatim +*> PATH is CHARACTER*3 +*> The LAPACK path name for the routines to be tested. +*> \endverbatim +*> +*> \param[in] NUNIT +*> \verbatim +*> NUNIT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup singlr_lin +* +* ===================================================================== + SUBROUTINE SERRORHR_COL( PATH, NUNIT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + CHARACTER(LEN=3) PATH + INTEGER NUNIT +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NMAX + PARAMETER ( NMAX = 2 ) +* .. +* .. Local Scalars .. + INTEGER I, INFO, J +* .. +* .. Local Arrays .. + REAL A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX) +* .. +* .. External Subroutines .. + EXTERNAL ALAESM, CHKXER, SORHR_COL +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NOUT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NOUT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Intrinsic Functions .. + INTRINSIC REAL +* .. +* .. Executable Statements .. +* + NOUT = NUNIT + WRITE( NOUT, FMT = * ) +* +* Set the variables to innocuous values. +* + DO J = 1, NMAX + DO I = 1, NMAX + A( I, J ) = 1.E+0 / REAL( I+J ) + T( I, J ) = 1.E+0 / REAL( I+J ) + END DO + D( J ) = 0.E+0 + END DO + OK = .TRUE. +* +* Error exits for Householder reconstruction +* +* SORHR_COL +* + SRNAMT = 'SORHR_COL' +* + INFOT = 1 + CALL SORHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 2 + CALL SORHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) + CALL SORHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 3 + CALL SORHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL SORHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 5 + CALL SORHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL SORHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL SORHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 7 + CALL SORHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL SORHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL SORHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO ) + CALL CHKXER( 'SORHR_COL', INFOT, NOUT, LERR, OK ) +* +* Print a summary line. +* + CALL ALAESM( PATH, OK, NOUT ) +* + RETURN +* +* End of SERRORHR_COL +* + END diff --git a/lapack-netlib/TESTING/LIN/serrvx.f b/lapack-netlib/TESTING/LIN/serrvx.f index a63ed38d7..910bff1e5 100644 --- a/lapack-netlib/TESTING/LIN/serrvx.f +++ b/lapack-netlib/TESTING/LIN/serrvx.f @@ -735,7 +735,7 @@ $ W, 1, INFO ) CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL SSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1, + CALL SSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, $ W, 1, INFO ) CALL CHKXER( 'SSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 7 diff --git a/lapack-netlib/TESTING/LIN/sorhr_col01.f b/lapack-netlib/TESTING/LIN/sorhr_col01.f new file mode 100644 index 000000000..02429041b --- /dev/null +++ b/lapack-netlib/TESTING/LIN/sorhr_col01.f @@ -0,0 +1,386 @@ +*> \brief \b SORHR_COL01 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE SORHR_COL01( M, N, MB1, NB1, NB2, RESULT) +* +* .. Scalar Arguments .. +* INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. +* REAL RESULT(6) +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> SORHR_COL01 tests SORHR_COL using SLATSQR, SGEMQRT and SORGTSQR. +*> Therefore, SLATSQR (part of SGEQR), SGEMQRT (part SGEMQR), SORGTSQR +*> have to be tested before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> Number of rows in test matrix. +*> \endverbatim +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> Number of columns in test matrix. +*> \endverbatim +*> \param[in] MB1 +*> \verbatim +*> MB1 is INTEGER +*> Number of row in row block in an input test matrix. +*> \endverbatim +*> +*> \param[in] NB1 +*> \verbatim +*> NB1 is INTEGER +*> Number of columns in column block an input test matrix. +*> \endverbatim +*> +*> \param[in] NB2 +*> \verbatim +*> NB2 is INTEGER +*> Number of columns in column block in an output test matrix. +*> \endverbatim +*> +*> \param[out] RESULT +*> \verbatim +*> RESULT is REAL array, dimension (6) +*> Results of each of the six tests below. +*> ( C is a M-by-N random matrix, D is a N-by-M random matrix ) +*> +*> RESULT(1) = | A - Q * R | / (eps * m * |A|) +*> RESULT(2) = | I - (Q**H) * Q | / (eps * m ) +*> RESULT(3) = | Q * C - Q * C | / (eps * m * |C|) +*> RESULT(4) = | (Q**H) * C - (Q**H) * C | / (eps * m * |C|) +*> RESULT(5) = | (D * Q) - D * Q | / (eps * m * |D|) +*> RESULT(6) = | D * (Q**H) - D * (Q**H) | / (eps * m * |D|) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup single_lin +* +* ===================================================================== + SUBROUTINE SORHR_COL01( M, N, MB1, NB1, NB2, RESULT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. + REAL RESULT(6) +* +* ===================================================================== +* +* .. +* .. Local allocatable arrays + REAL, ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:), + $ RWORK(:), WORK( : ), T1(:,:), T2(:,:), DIAG(:), + $ C(:,:), CF(:,:), D(:,:), DF(:,:) +* +* .. Parameters .. + REAL ONE, ZERO + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) +* .. +* .. Local Scalars .. + LOGICAL TESTZEROS + INTEGER INFO, I, J, K, L, LWORK, NB1_UB, NB2_UB, NRB + REAL ANORM, EPS, RESID, CNORM, DNORM +* .. +* .. Local Arrays .. + INTEGER ISEED( 4 ) + REAL WORKQUERY( 1 ) +* .. +* .. External Functions .. + REAL SLAMCH, SLANGE, SLANSY + EXTERNAL SLAMCH, SLANGE, SLANSY +* .. +* .. External Subroutines .. + EXTERNAL SLACPY, SLARNV, SLASET, SLATSQR, SORHR_COL, + $ SORGTSQR, SSCAL, SGEMM, SGEMQRT, SSYRK +* .. +* .. Intrinsic Functions .. + INTRINSIC CEILING, MAX, MIN, REAL +* .. +* .. Scalars in Common .. + CHARACTER(LEN=32) SRNAMT +* .. +* .. Common blocks .. + COMMON / SRMNAMC / SRNAMT +* .. +* .. Data statements .. + DATA ISEED / 1988, 1989, 1990, 1991 / +* +* TEST MATRICES WITH HALF OF MATRIX BEING ZEROS +* + TESTZEROS = .FALSE. +* + EPS = SLAMCH( 'Epsilon' ) + K = MIN( M, N ) + L = MAX( M, N, 1) +* +* Dynamically allocate local arrays +* + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ C(M,N), CF(M,N), + $ D(N,M), DF(N,M) ) +* +* Put random numbers into A and copy to AF +* + DO J = 1, N + CALL SLARNV( 2, ISEED, M, A( 1, J ) ) + END DO + IF( TESTZEROS ) THEN + IF( M.GE.4 ) THEN + DO J = 1, N + CALL SLARNV( 2, ISEED, M/2, A( M/4, J ) ) + END DO + END IF + END IF + CALL SLACPY( 'Full', M, N, A, M, AF, M ) +* +* Number of row blocks in SLATSQR +* + NRB = MAX( 1, CEILING( REAL( M - N ) / REAL( MB1 - N ) ) ) +* + ALLOCATE ( T1( NB1, N * NRB ) ) + ALLOCATE ( T2( NB2, N ) ) + ALLOCATE ( DIAG( N ) ) +* +* Begin determine LWORK for the array WORK and allocate memory. +* +* SLATSQR requires NB1 to be bounded by N. +* + NB1_UB = MIN( NB1, N) +* +* SGEMQRT requires NB2 to be bounded by N. +* + NB2_UB = MIN( NB2, N) +* + CALL SLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, + $ WORKQUERY, -1, INFO ) + LWORK = INT( WORKQUERY( 1 ) ) + CALL SORGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORKQUERY, -1, + $ INFO ) + + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) +* +* In SGEMQRT, WORK is N*NB2_UB if SIDE = 'L', +* or M*NB2_UB if SIDE = 'R'. +* + LWORK = MAX( LWORK, NB2_UB * N, NB2_UB * M ) +* + ALLOCATE ( WORK( LWORK ) ) +* +* End allocate memory for WORK. +* +* +* Begin Householder reconstruction routines +* +* Factor the matrix A in the array AF. +* + SRNAMT = 'SLATSQR' + CALL SLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Copy the factor R into the array R. +* + SRNAMT = 'SLACPY' + CALL SLACPY( 'U', N, N, AF, M, R, M ) +* +* Reconstruct the orthogonal matrix Q. +* + SRNAMT = 'SORGTSQR' + CALL SORGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Perform the Householder reconstruction, the result is stored +* the arrays AF and T2. +* + SRNAMT = 'SORHR_COL' + CALL SORHR_COL( M, N, NB2, AF, M, T2, NB2, DIAG, INFO ) +* +* Compute the factor R_hr corresponding to the Householder +* reconstructed Q_hr and place it in the upper triangle of AF to +* match the Q storage format in DGEQRT. R_hr = R_tsqr * S, +* this means changing the sign of I-th row of the matrix R_tsqr +* according to sign of of I-th diagonal element DIAG(I) of the +* matrix S. +* + SRNAMT = 'SLACPY' + CALL SLACPY( 'U', N, N, R, M, AF, M ) +* + DO I = 1, N + IF( DIAG( I ).EQ.-ONE ) THEN + CALL SSCAL( N+1-I, -ONE, AF( I, I ), M ) + END IF + END DO +* +* End Householder reconstruction routines. +* +* +* Generate the m-by-m matrix Q +* + CALL SLASET( 'Full', M, M, ZERO, ONE, Q, M ) +* + SRNAMT = 'SGEMQRT' + CALL SGEMQRT( 'L', 'N', M, M, K, NB2_UB, AF, M, T2, NB2, Q, M, + $ WORK, INFO ) +* +* Copy R +* + CALL SLASET( 'Full', M, N, ZERO, ZERO, R, M ) +* + CALL SLACPY( 'Upper', M, N, AF, M, R, M ) +* +* TEST 1 +* Compute |R - (Q**T)*A| / ( eps * m * |A| ) and store in RESULT(1) +* + CALL SGEMM( 'T', 'N', M, N, M, -ONE, Q, M, A, M, ONE, R, M ) +* + ANORM = SLANGE( '1', M, N, A, M, RWORK ) + RESID = SLANGE( '1', M, N, R, M, RWORK ) + IF( ANORM.GT.ZERO ) THEN + RESULT( 1 ) = RESID / ( EPS * MAX( 1, M ) * ANORM ) + ELSE + RESULT( 1 ) = ZERO + END IF +* +* TEST 2 +* Compute |I - (Q**T)*Q| / ( eps * m ) and store in RESULT(2) +* + CALL SLASET( 'Full', M, M, ZERO, ONE, R, M ) + CALL SSYRK( 'U', 'T', M, M, -ONE, Q, M, ONE, R, M ) + RESID = SLANSY( '1', 'Upper', M, R, M, RWORK ) + RESULT( 2 ) = RESID / ( EPS * MAX( 1, M ) ) +* +* Generate random m-by-n matrix C +* + DO J = 1, N + CALL SLARNV( 2, ISEED, M, C( 1, J ) ) + END DO + CNORM = SLANGE( '1', M, N, C, M, RWORK ) + CALL SLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as Q*C = CF +* + SRNAMT = 'SGEMQRT' + CALL SGEMQRT( 'L', 'N', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 3 +* Compute |CF - Q*C| / ( eps * m * |C| ) +* + CALL SGEMM( 'N', 'N', M, N, M, -ONE, Q, M, C, M, ONE, CF, M ) + RESID = SLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 3 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 3 ) = ZERO + END IF +* +* Copy C into CF again +* + CALL SLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as (Q**T)*C = CF +* + SRNAMT = 'SGEMQRT' + CALL SGEMQRT( 'L', 'T', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 4 +* Compute |CF - (Q**T)*C| / ( eps * m * |C|) +* + CALL SGEMM( 'T', 'N', M, N, M, -ONE, Q, M, C, M, ONE, CF, M ) + RESID = SLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 4 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 4 ) = ZERO + END IF +* +* Generate random n-by-m matrix D and a copy DF +* + DO J = 1, M + CALL SLARNV( 2, ISEED, N, D( 1, J ) ) + END DO + DNORM = SLANGE( '1', N, M, D, N, RWORK ) + CALL SLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*Q = DF +* + SRNAMT = 'SGEMQRT' + CALL SGEMQRT( 'R', 'N', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 5 +* Compute |DF - D*Q| / ( eps * m * |D| ) +* + CALL SGEMM( 'N', 'N', N, M, M, -ONE, D, N, Q, M, ONE, DF, N ) + RESID = SLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 5 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 5 ) = ZERO + END IF +* +* Copy D into DF again +* + CALL SLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*QT = DF +* + SRNAMT = 'SGEMQRT' + CALL SGEMQRT( 'R', 'T', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 6 +* Compute |DF - D*(Q**T)| / ( eps * m * |D| ) +* + CALL SGEMM( 'N', 'T', N, M, M, -ONE, D, N, Q, M, ONE, DF, N ) + RESID = SLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 6 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 6 ) = ZERO + END IF +* +* Deallocate all arrays +* + DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T1, T2, DIAG, + $ C, D, CF, DF ) +* + RETURN +* +* End of SORHR_COL01 +* + END diff --git a/lapack-netlib/TESTING/LIN/stsqr01.f b/lapack-netlib/TESTING/LIN/stsqr01.f index b661d61f4..8eb69eae7 100644 --- a/lapack-netlib/TESTING/LIN/stsqr01.f +++ b/lapack-netlib/TESTING/LIN/stsqr01.f @@ -115,7 +115,7 @@ * .. * .. Local Arrays .. INTEGER ISEED( 4 ) - REAL TQUERY( 5 ), WORKQUERY + REAL TQUERY( 5 ), WORKQUERY( 1 ) * .. * .. External Functions .. REAL SLAMCH, SLANGE, SLANSY @@ -174,22 +174,22 @@ * CALL SGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL SGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMQR( 'L', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMQR( 'R', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'SGEQR' @@ -317,22 +317,22 @@ ELSE CALL SGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 )) CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, $ WORKQUERY, -1, INFO ) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'SGELQ' diff --git a/lapack-netlib/TESTING/LIN/zchkaa.f b/lapack-netlib/TESTING/LIN/zchkaa.f index d2be2525d..30d2a084a 100644 --- a/lapack-netlib/TESTING/LIN/zchkaa.f +++ b/lapack-netlib/TESTING/LIN/zchkaa.f @@ -74,6 +74,8 @@ *> ZEQ *> ZQT *> ZQX +*> ZTS +*> ZHH *> \endverbatim * * Parameters: @@ -108,17 +110,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2017 +*> \date November 2019 * *> \ingroup complex16_lin * * ===================================================================== PROGRAM ZCHKAA * -* -- LAPACK test routine (version 3.8.0) -- +* -- LAPACK test routine (version 3.9.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2017 +* November 2019 * * ===================================================================== * @@ -166,16 +168,16 @@ * .. External Subroutines .. EXTERNAL ALAREQ, ZCHKEQ, ZCHKGB, ZCHKGE, ZCHKGT, ZCHKHE, $ ZCHKHE_ROOK, ZCHKHE_RK, ZCHKHE_AA, ZCHKHP, - $ ZCHKLQ, ZCHKPB, ZCHKPO, ZCHKPS, ZCHKPP, ZCHKPT, - $ ZCHKQ3, ZCHKQL, ZCHKQR, ZCHKRQ, ZCHKSP, ZCHKSY, - $ ZCHKSY_ROOK, ZCHKSY_RK, ZCHKSY_AA, ZCHKTB, - $ ZCHKTP, ZCHKTR, ZCHKTZ, ZDRVGB, ZDRVGE, ZDRVGT, - $ ZDRVHE, ZDRVHE_ROOK, ZDRVHE_RK, ZDRVHE_AA, - $ ZDRVHE_AA_2STAGE, ZDRVHP, ZDRVLS, ZDRVPB, - $ ZDRVPO, ZDRVPP, ZDRVPT, ZDRVSP, ZDRVSY, - $ ZDRVSY_ROOK, ZDRVSY_RK, ZDRVSY_AA, - $ ZDRVSY_AA_2STAGE, ILAVER, ZCHKQRT, ZCHKQRTP, - $ ZCHKLQT, ZCHKLQTP, ZCHKTSQR + $ ZCHKLQ, ZCHKUNHR_COL, ZCHKPB, ZCHKPO, ZCHKPS, + $ ZCHKPP, ZCHKPT, ZCHKQ3, ZCHKQL, ZCHKQR, ZCHKRQ, + $ ZCHKSP, ZCHKSY, ZCHKSY_ROOK, ZCHKSY_RK, + $ ZCHKSY_AA, ZCHKTB, ZCHKTP, ZCHKTR, ZCHKTZ, + $ ZDRVGB, ZDRVGE, ZDRVGT, ZDRVHE, ZDRVHE_ROOK, + $ ZDRVHE_RK, ZDRVHE_AA, ZDRVHE_AA_2STAGE, ZDRVHP, + $ ZDRVLS, ZDRVPB, ZDRVPO, ZDRVPP, ZDRVPT, + $ ZDRVSP, ZDRVSY, ZDRVSY_ROOK, ZDRVSY_RK, + $ ZDRVSY_AA, ZDRVSY_AA_2STAGE, ILAVER, ZCHKQRT, + $ ZCHKQRTP, ZCHKLQT, ZCHKLQTP, ZCHKTSQR * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -679,7 +681,7 @@ * * HK: Hermitian indefinite matrices, * with bounded Bunch-Kaufman (rook) pivoting algorithm, -* differnet matrix storage format than HR path version. +* different matrix storage format than HR path version. * NTYPES = 10 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) @@ -839,7 +841,7 @@ * * SK: symmetric indefinite matrices, * with bounded Bunch-Kaufman (rook) pivoting algorithm, -* differnet matrix storage format than SR path version. +* different matrix storage format than SR path version. * NTYPES = 11 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) @@ -1201,6 +1203,17 @@ ELSE WRITE( NOUT, FMT = 9989 )PATH END IF +* + ELSE IF( LSAMEN( 2, C2, 'HH' ) ) THEN +* +* HH: Householder reconstruction for tall-skinny matrices +* + IF( TSTCHK ) THEN + CALL ZCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + ELSE + WRITE( NOUT, FMT = 9989 ) PATH + END IF * ELSE * diff --git a/lapack-netlib/TESTING/LIN/zchkunhr_col.f b/lapack-netlib/TESTING/LIN/zchkunhr_col.f new file mode 100644 index 000000000..ef8f8bcc4 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/zchkunhr_col.f @@ -0,0 +1,239 @@ +*> \brief \b ZCHKUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* NBVAL, NOUT ) +* +* .. Scalar Arguments .. +* LOGICAL TSTERR +* INTEGER NM, NN, NNB, NOUT +* DOUBLE PRECISION THRESH +* .. +* .. Array Arguments .. +* INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZCHKUNHR_COL tests ZUNHR_COL using ZLATSQR and ZGEMQRT. Therefore, ZLATSQR +*> (used in ZGEQR) and ZGEMQRT (used in ZGEMQR) have to be tested +*> before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] THRESH +*> \verbatim +*> THRESH is DOUBLE PRECISION +*> The threshold value for the test ratios. A result is +*> included in the output file if RESULT >= THRESH. To have +*> every test ratio printed, use THRESH = 0. +*> \endverbatim +*> +*> \param[in] TSTERR +*> \verbatim +*> TSTERR is LOGICAL +*> Flag that indicates whether error exits are to be tested. +*> \endverbatim +*> +*> \param[in] NM +*> \verbatim +*> NM is INTEGER +*> The number of values of M contained in the vector MVAL. +*> \endverbatim +*> +*> \param[in] MVAL +*> \verbatim +*> MVAL is INTEGER array, dimension (NM) +*> The values of the matrix row dimension M. +*> \endverbatim +*> +*> \param[in] NN +*> \verbatim +*> NN is INTEGER +*> The number of values of N contained in the vector NVAL. +*> \endverbatim +*> +*> \param[in] NVAL +*> \verbatim +*> NVAL is INTEGER array, dimension (NN) +*> The values of the matrix column dimension N. +*> \endverbatim +*> +*> \param[in] NNB +*> \verbatim +*> NNB is INTEGER +*> The number of values of NB contained in the vector NBVAL. +*> \endverbatim +*> +*> \param[in] NBVAL +*> \verbatim +*> NBVAL is INTEGER array, dimension (NBVAL) +*> The values of the blocksize NB. +*> \endverbatim +*> +*> \param[in] NOUT +*> \verbatim +*> NOUT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16_lin +* +* ===================================================================== + SUBROUTINE ZCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + $ NBVAL, NOUT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.7.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* December 2016 +* +* .. Scalar Arguments .. + LOGICAL TSTERR + INTEGER NM, NN, NNB, NOUT + DOUBLE PRECISION THRESH +* .. +* .. Array Arguments .. + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NTESTS + PARAMETER ( NTESTS = 6 ) +* .. +* .. Local Scalars .. + CHARACTER(LEN=3) PATH + INTEGER I, IMB1, INB1, INB2, J, T, M, N, MB1, NB1, + $ NB2, NFAIL, NERRS, NRUN +* +* .. Local Arrays .. + DOUBLE PRECISION RESULT( NTESTS ) +* .. +* .. External Subroutines .. + EXTERNAL ALAHD, ALASUM, ZERRUNHR_COL, ZUNHR_COL01 +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX, MIN +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NUNIT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NUNIT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Executable Statements .. +* +* Initialize constants +* + PATH( 1: 1 ) = 'Z' + PATH( 2: 3 ) = 'HH' + NRUN = 0 + NFAIL = 0 + NERRS = 0 +* +* Test the error exits +* + IF( TSTERR ) CALL ZERRUNHR_COL( PATH, NOUT ) + INFOT = 0 +* +* Do for each value of M in MVAL. +* + DO I = 1, NM + M = MVAL( I ) +* +* Do for each value of N in NVAL. +* + DO J = 1, NN + N = NVAL( J ) +* +* Only for M >= N +* + IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN +* +* Do for each possible value of MB1 +* + DO IMB1 = 1, NNB + MB1 = NBVAL( IMB1 ) +* +* Only for MB1 > N +* + IF ( MB1.GT.N ) THEN +* +* Do for each possible value of NB1 +* + DO INB1 = 1, NNB + NB1 = NBVAL( INB1 ) +* +* Do for each possible value of NB2 +* + DO INB2 = 1, NNB + NB2 = NBVAL( INB2 ) +* + IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN +* +* Test ZUNHR_COL +* + CALL ZUNHR_COL01( M, N, MB1, NB1, NB2, + $ RESULT ) +* +* Print information about the tests that did +* not pass the threshold. +* + DO T = 1, NTESTS + IF( RESULT( T ).GE.THRESH ) THEN + IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) + $ CALL ALAHD( NOUT, PATH ) + WRITE( NOUT, FMT = 9999 ) M, N, MB1, + $ NB1, NB2, T, RESULT( T ) + NFAIL = NFAIL + 1 + END IF + END DO + NRUN = NRUN + NTESTS + END IF + END DO + END DO + END IF + END DO + END IF + END DO + END DO +* +* Print a summary of the results. +* + CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS ) +* + 9999 FORMAT( 'M=', I5, ', N=', I5, ', MB1=', I5, + $ ', NB1=', I5, ', NB2=', I5,' test(', I2, ')=', G12.5 ) + RETURN +* +* End of ZCHKUNHR_COL +* + END \ No newline at end of file diff --git a/lapack-netlib/TESTING/LIN/zdrvhe_rk.f b/lapack-netlib/TESTING/LIN/zdrvhe_rk.f index 93c3fe61d..355260aad 100644 --- a/lapack-netlib/TESTING/LIN/zdrvhe_rk.f +++ b/lapack-netlib/TESTING/LIN/zdrvhe_rk.f @@ -98,6 +98,7 @@ *> \param[out] E *> \verbatim *> E is COMPLEX*16 array, dimension (NMAX) +*> \endverbatim *> *> \param[out] AINV *> \verbatim diff --git a/lapack-netlib/TESTING/LIN/zdrvls.f b/lapack-netlib/TESTING/LIN/zdrvls.f index 681852bc2..4587c5686 100644 --- a/lapack-netlib/TESTING/LIN/zdrvls.f +++ b/lapack-netlib/TESTING/LIN/zdrvls.f @@ -237,13 +237,13 @@ DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ - DOUBLE PRECISION RESULT( NTESTS ), RWQ - COMPLEX*16 WQ + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWQ( 1 ) + DOUBLE PRECISION RESULT( NTESTS ), RWQ( 1 ) + COMPLEX*16 WQ( 1 ) * .. * .. Allocatable Arrays .. COMPLEX*16, ALLOCATABLE :: WORK (:) - DOUBLE PRECISION, ALLOCATABLE :: RWORK (:) + DOUBLE PRECISION, ALLOCATABLE :: RWORK (:), WORK2 (:) INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. @@ -363,32 +363,32 @@ * Compute workspace needed for ZGELS CALL ZGELS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_ZGELS = INT ( WQ ) + LWORK_ZGELS = INT ( WQ( 1 ) ) * Compute workspace needed for ZGETSLS CALL ZGETSLS( TRANS, M, N, NRHS, A, LDA, $ B, LDB, WQ, -1, INFO ) - LWORK_ZGETSLS = INT( WQ ) + LWORK_ZGETSLS = INT( WQ( 1 ) ) ENDDO END IF * Compute workspace needed for ZGELSY CALL ZGELSY( M, N, NRHS, A, LDA, B, LDB, IWQ, $ RCOND, CRANK, WQ, -1, RWORK, INFO ) - LWORK_ZGELSY = INT( WQ ) + LWORK_ZGELSY = INT( WQ( 1 ) ) LRWORK_ZGELSY = 2*N * Compute workspace needed for ZGELSS CALL ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1 , RWORK, $ INFO ) - LWORK_ZGELSS = INT( WQ ) + LWORK_ZGELSS = INT( WQ( 1 ) ) LRWORK_ZGELSS = 5*MNMIN * Compute workspace needed for ZGELSD CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, $ RCOND, CRANK, WQ, -1, RWQ, IWQ, $ INFO ) - LWORK_ZGELSD = INT( WQ ) - LRWORK_ZGELSD = INT( RWQ ) + LWORK_ZGELSD = INT( WQ( 1 ) ) + LRWORK_ZGELSD = INT( RWQ ( 1 ) ) * Compute LIWORK workspace needed for ZGELSY and ZGELSD - LIWORK = MAX( LIWORK, N, IWQ ) + LIWORK = MAX( LIWORK, N, IWQ( 1 ) ) * Compute LRWORK workspace needed for ZGELSY, ZGELSS and ZGELSD LRWORK = MAX( LRWORK, LRWORK_ZGELSY, $ LRWORK_ZGELSS, LRWORK_ZGELSD ) @@ -406,6 +406,7 @@ LWLSY = LWORK * ALLOCATE( WORK( LWORK ) ) + ALLOCATE( WORK2( 2 * LWORK ) ) ALLOCATE( IWORK( LIWORK ) ) ALLOCATE( RWORK( LRWORK ) ) * @@ -596,7 +597,7 @@ $ CALL ZLACPY( 'Full', NROWS, NRHS, $ COPYB, LDB, C, LDB ) CALL ZQRT16( TRANS, M, N, NRHS, COPYA, - $ LDA, B, LDB, C, LDB, WORK, + $ LDA, B, LDB, C, LDB, WORK2, $ RESULT( 15 ) ) * IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR. diff --git a/lapack-netlib/TESTING/LIN/zerrunhr_col.f b/lapack-netlib/TESTING/LIN/zerrunhr_col.f new file mode 100644 index 000000000..4fb62734d --- /dev/null +++ b/lapack-netlib/TESTING/LIN/zerrunhr_col.f @@ -0,0 +1,164 @@ +*> \brief \b ZERRUNHR_COL +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZERRUNHR_COL( PATH, NUNIT ) +* +* .. Scalar Arguments .. +* CHARACTER*3 PATH +* INTEGER NUNIT +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZERRUNHR_COL tests the error exits for ZUNHR_COL that does +*> Householder reconstruction from the ouput of tall-skinny +*> factorization ZLATSQR. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] PATH +*> \verbatim +*> PATH is CHARACTER*3 +*> The LAPACK path name for the routines to be tested. +*> \endverbatim +*> +*> \param[in] NUNIT +*> \verbatim +*> NUNIT is INTEGER +*> The unit number for output. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16_lin +* +* ===================================================================== + SUBROUTINE ZERRUNHR_COL( PATH, NUNIT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + CHARACTER(LEN=3) PATH + INTEGER NUNIT +* .. +* +* ===================================================================== +* +* .. Parameters .. + INTEGER NMAX + PARAMETER ( NMAX = 2 ) +* .. +* .. Local Scalars .. + INTEGER I, INFO, J +* .. +* .. Local Arrays .. + COMPLEX*16 A( NMAX, NMAX ), T( NMAX, NMAX ), D(NMAX) +* .. +* .. External Subroutines .. + EXTERNAL ALAESM, CHKXER, ZUNHR_COL +* .. +* .. Scalars in Common .. + LOGICAL LERR, OK + CHARACTER(LEN=32) SRNAMT + INTEGER INFOT, NOUT +* .. +* .. Common blocks .. + COMMON / INFOC / INFOT, NOUT, OK, LERR + COMMON / SRNAMC / SRNAMT +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE, DCMPLX +* .. +* .. Executable Statements .. +* + NOUT = NUNIT + WRITE( NOUT, FMT = * ) +* +* Set the variables to innocuous values. +* + DO J = 1, NMAX + DO I = 1, NMAX + A( I, J ) = DCMPLX( 1.D+0 / DBLE( I+J ) ) + T( I, J ) = DCMPLX( 1.D+0 / DBLE( I+J ) ) + END DO + D( J ) = ( 0.D+0, 0.D+0 ) + END DO + OK = .TRUE. +* +* Error exits for Householder reconstruction +* +* ZUNHR_COL +* + SRNAMT = 'ZUNHR_COL' +* + INFOT = 1 + CALL ZUNHR_COL( -1, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 2 + CALL ZUNHR_COL( 0, -1, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) + CALL ZUNHR_COL( 1, 2, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 3 + CALL ZUNHR_COL( 0, 0, -1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL ZUNHR_COL( 0, 0, 0, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 5 + CALL ZUNHR_COL( 0, 0, 1, A, -1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL ZUNHR_COL( 0, 0, 1, A, 0, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL ZUNHR_COL( 2, 0, 1, A, 1, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + INFOT = 7 + CALL ZUNHR_COL( 0, 0, 1, A, 1, T, -1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL ZUNHR_COL( 0, 0, 1, A, 1, T, 0, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* + CALL ZUNHR_COL( 4, 3, 2, A, 4, T, 1, D, INFO ) + CALL CHKXER( 'ZUNHR_COL', INFOT, NOUT, LERR, OK ) +* +* Print a summary line. +* + CALL ALAESM( PATH, OK, NOUT ) +* + RETURN +* +* End of ZERRUNHR_COL +* + END diff --git a/lapack-netlib/TESTING/LIN/zerrvx.f b/lapack-netlib/TESTING/LIN/zerrvx.f index 29ba744ed..7759384e6 100644 --- a/lapack-netlib/TESTING/LIN/zerrvx.f +++ b/lapack-netlib/TESTING/LIN/zerrvx.f @@ -94,7 +94,7 @@ $ ZHPSV, ZHPSVX, ZPBSV, ZPBSVX, ZPOSV, ZPOSVX, $ ZPPSV, ZPPSVX, ZPTSV, ZPTSVX, ZSPSV, ZSPSVX, $ ZSYSV, ZSYSV_AA, ZSYSV_RK, ZSYSV_ROOK, - $ ZSYSVX, ZSYSV_AA_2STAGE + $ ZSYSVX, ZHESV_AA_2STAGE * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -721,7 +721,7 @@ * ELSE IF( LSAMEN( 2, C2, 'H2' ) ) THEN * -* CHESV_AASEN_2STAGE +* ZHESV_AASEN_2STAGE * SRNAMT = 'ZHESV_AA_2STAGE' INFOT = 1 @@ -741,7 +741,7 @@ $ W, 1, INFO ) CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL ZHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 2, IP, IP, B, 1, + CALL ZHESV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, $ W, 1, INFO ) CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK ) INFOT = 7 @@ -749,6 +749,36 @@ $ W, 1, INFO ) CALL CHKXER( 'ZHESV_AA_2STAGE', INFOT, NOUT, LERR, OK ) * + ELSE IF( LSAMEN( 2, C2, 'S2' ) ) THEN +* +* ZSYSV_AASEN_2STAGE +* + SRNAMT = 'ZSYSV_AA_2STAGE' + INFOT = 1 + CALL ZSYSV_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP, B, 1, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) + INFOT = 2 + CALL ZSYSV_AA_2STAGE( 'U', -1, 0, A, 1, A, 1, IP, IP, B, 1, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) + INFOT = 3 + CALL ZSYSV_AA_2STAGE( 'U', 0, -1, A, 1, A, 1, IP, IP, B, 1, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) + INFOT = 5 + CALL ZSYSV_AA_2STAGE( 'U', 2, 1, A, 1, A, 1, IP, IP, B, 1, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) + INFOT = 11 + CALL ZSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 8, IP, IP, B, 1, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) + INFOT = 7 + CALL ZSYSV_AA_2STAGE( 'U', 2, 1, A, 2, A, 1, IP, IP, B, 2, + $ W, 1, INFO ) + CALL CHKXER( 'ZSYSV_AA_2STAGE', INFOT, NOUT, LERR, OK ) +** ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN * * ZHPSV diff --git a/lapack-netlib/TESTING/LIN/zlahilb.f b/lapack-netlib/TESTING/LIN/zlahilb.f index a6dc79b20..ba83af825 100644 --- a/lapack-netlib/TESTING/LIN/zlahilb.f +++ b/lapack-netlib/TESTING/LIN/zlahilb.f @@ -164,7 +164,7 @@ INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8) * -* d's are generated from random permuation of those eight elements. +* d's are generated from random permutation of those eight elements. COMPLEX*16 d1(8), d2(8), invd1(8), invd2(8) DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/ DATA D2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/ diff --git a/lapack-netlib/TESTING/LIN/ztsqr01.f b/lapack-netlib/TESTING/LIN/ztsqr01.f index 094473888..81d7fdb44 100644 --- a/lapack-netlib/TESTING/LIN/ztsqr01.f +++ b/lapack-netlib/TESTING/LIN/ztsqr01.f @@ -114,7 +114,7 @@ * .. * .. Local Arrays .. INTEGER ISEED( 4 ) - COMPLEX*16 TQUERY( 5 ), WORKQUERY + COMPLEX*16 TQUERY( 5 ), WORKQUERY( 1 ) * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY @@ -173,22 +173,22 @@ * CALL ZGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'ZGEQR' @@ -316,22 +316,22 @@ ELSE CALL ZGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) TSIZE = INT( TQUERY( 1 ) ) - LWORK = INT( WORKQUERY ) + LWORK = INT( WORKQUERY( 1 ) ) CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, $ WORKQUERY, -1, INFO ) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, $ WORKQUERY, -1, INFO) - LWORK = MAX( LWORK, INT( WORKQUERY ) ) + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) ALLOCATE ( T( TSIZE ) ) ALLOCATE ( WORK( LWORK ) ) srnamt = 'ZGELQ' diff --git a/lapack-netlib/TESTING/LIN/zunhr_col01.f b/lapack-netlib/TESTING/LIN/zunhr_col01.f new file mode 100644 index 000000000..9fb3bf352 --- /dev/null +++ b/lapack-netlib/TESTING/LIN/zunhr_col01.f @@ -0,0 +1,390 @@ +*> \brief \b ZUNHR_COL01 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE ZUNHR_COL01( M, N, MB1, NB1, NB2, RESULT ) +* +* .. Scalar Arguments .. +* INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. +* DOUBLE PRECISION RESULT(6) +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZUNHR_COL01 tests ZUNHR_COL using ZLATSQR, ZGEMQRT and ZUNGTSQR. +*> Therefore, ZLATSQR (part of ZGEQR), ZGEMQRT (part ZGEMQR), ZUNGTSQR +*> have to be tested before this test. +*> +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] M +*> \verbatim +*> M is INTEGER +*> Number of rows in test matrix. +*> \endverbatim +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> Number of columns in test matrix. +*> \endverbatim +*> \param[in] MB1 +*> \verbatim +*> MB1 is INTEGER +*> Number of row in row block in an input test matrix. +*> \endverbatim +*> +*> \param[in] NB1 +*> \verbatim +*> NB1 is INTEGER +*> Number of columns in column block an input test matrix. +*> \endverbatim +*> +*> \param[in] NB2 +*> \verbatim +*> NB2 is INTEGER +*> Number of columns in column block in an output test matrix. +*> \endverbatim +*> +*> \param[out] RESULT +*> \verbatim +*> RESULT is DOUBLE PRECISION array, dimension (6) +*> Results of each of the six tests below. +*> ( C is a M-by-N random matrix, D is a N-by-M random matrix ) +*> +*> RESULT(1) = | A - Q * R | / (eps * m * |A|) +*> RESULT(2) = | I - (Q**H) * Q | / (eps * m ) +*> RESULT(3) = | Q * C - Q * C | / (eps * m * |C|) +*> RESULT(4) = | (Q**H) * C - (Q**H) * C | / (eps * m * |C|) +*> RESULT(5) = | (D * Q) - D * Q | / (eps * m * |D|) +*> RESULT(6) = | D * (Q**H) - D * (Q**H) | / (eps * m * |D|) +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date November 2019 +* +*> \ingroup complex16_lin +* +* ===================================================================== + SUBROUTINE ZUNHR_COL01( M, N, MB1, NB1, NB2, RESULT ) + IMPLICIT NONE +* +* -- LAPACK test routine (version 3.9.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2019 +* +* .. Scalar Arguments .. + INTEGER M, N, MB1, NB1, NB2 +* .. Return values .. + DOUBLE PRECISION RESULT(6) +* +* ===================================================================== +* +* .. +* .. Local allocatable arrays + COMPLEX*16, ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:), + $ WORK( : ), T1(:,:), T2(:,:), DIAG(:), + $ C(:,:), CF(:,:), D(:,:), DF(:,:) + DOUBLE PRECISION, ALLOCATABLE :: RWORK(:) +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D+0 ) + COMPLEX*16 CONE, CZERO + PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ), + $ CZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + LOGICAL TESTZEROS + INTEGER INFO, I, J, K, L, LWORK, NB1_UB, NB2_UB, NRB + DOUBLE PRECISION ANORM, EPS, RESID, CNORM, DNORM +* .. +* .. Local Arrays .. + INTEGER ISEED( 4 ) + COMPLEX*16 WORKQUERY( 1 ) +* .. +* .. External Functions .. + DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY + EXTERNAL DLAMCH, ZLANGE, ZLANSY +* .. +* .. External Subroutines .. + EXTERNAL ZLACPY, ZLARNV, ZLASET, ZLATSQR, ZUNHR_COL, + $ ZUNGTSQR, ZSCAL, ZGEMM, ZGEMQRT, ZHERK +* .. +* .. Intrinsic Functions .. + INTRINSIC CEILING, DBLE, MAX, MIN +* .. +* .. Scalars in Common .. + CHARACTER(LEN=32) SRNAMT +* .. +* .. Common blocks .. + COMMON / SRMNAMC / SRNAMT +* .. +* .. Data statements .. + DATA ISEED / 1988, 1989, 1990, 1991 / +* +* TEST MATRICES WITH HALF OF MATRIX BEING ZEROS +* + TESTZEROS = .FALSE. +* + EPS = DLAMCH( 'Epsilon' ) + K = MIN( M, N ) + L = MAX( M, N, 1) +* +* Dynamically allocate local arrays +* + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ C(M,N), CF(M,N), + $ D(N,M), DF(N,M) ) +* +* Put random numbers into A and copy to AF +* + DO J = 1, N + CALL ZLARNV( 2, ISEED, M, A( 1, J ) ) + END DO + IF( TESTZEROS ) THEN + IF( M.GE.4 ) THEN + DO J = 1, N + CALL ZLARNV( 2, ISEED, M/2, A( M/4, J ) ) + END DO + END IF + END IF + CALL ZLACPY( 'Full', M, N, A, M, AF, M ) +* +* Number of row blocks in ZLATSQR +* + NRB = MAX( 1, CEILING( DBLE( M - N ) / DBLE( MB1 - N ) ) ) +* + ALLOCATE ( T1( NB1, N * NRB ) ) + ALLOCATE ( T2( NB2, N ) ) + ALLOCATE ( DIAG( N ) ) +* +* Begin determine LWORK for the array WORK and allocate memory. +* +* ZLATSQR requires NB1 to be bounded by N. +* + NB1_UB = MIN( NB1, N) +* +* ZGEMQRT requires NB2 to be bounded by N. +* + NB2_UB = MIN( NB2, N) +* + CALL ZLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, + $ WORKQUERY, -1, INFO ) + LWORK = INT( WORKQUERY( 1 ) ) + CALL ZUNGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORKQUERY, -1, + $ INFO ) + + LWORK = MAX( LWORK, INT( WORKQUERY( 1 ) ) ) +* +* In ZGEMQRT, WORK is N*NB2_UB if SIDE = 'L', +* or M*NB2_UB if SIDE = 'R'. +* + LWORK = MAX( LWORK, NB2_UB * N, NB2_UB * M ) +* + ALLOCATE ( WORK( LWORK ) ) +* +* End allocate memory for WORK. +* +* +* Begin Householder reconstruction routines +* +* Factor the matrix A in the array AF. +* + SRNAMT = 'ZLATSQR' + CALL ZLATSQR( M, N, MB1, NB1_UB, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Copy the factor R into the array R. +* + SRNAMT = 'ZLACPY' + CALL ZLACPY( 'U', M, N, AF, M, R, M ) +* +* Reconstruct the orthogonal matrix Q. +* + SRNAMT = 'ZUNGTSQR' + CALL ZUNGTSQR( M, N, MB1, NB1, AF, M, T1, NB1, WORK, LWORK, + $ INFO ) +* +* Perform the Householder reconstruction, the result is stored +* the arrays AF and T2. +* + SRNAMT = 'ZUNHR_COL' + CALL ZUNHR_COL( M, N, NB2, AF, M, T2, NB2, DIAG, INFO ) +* +* Compute the factor R_hr corresponding to the Householder +* reconstructed Q_hr and place it in the upper triangle of AF to +* match the Q storage format in ZGEQRT. R_hr = R_tsqr * S, +* this means changing the sign of I-th row of the matrix R_tsqr +* according to sign of of I-th diagonal element DIAG(I) of the +* matrix S. +* + SRNAMT = 'ZLACPY' + CALL ZLACPY( 'U', M, N, R, M, AF, M ) +* + DO I = 1, N + IF( DIAG( I ).EQ.-CONE ) THEN + CALL ZSCAL( N+1-I, -CONE, AF( I, I ), M ) + END IF + END DO +* +* End Householder reconstruction routines. +* +* +* Generate the m-by-m matrix Q +* + CALL ZLASET( 'Full', M, M, CZERO, CONE, Q, M ) +* + SRNAMT = 'ZGEMQRT' + CALL ZGEMQRT( 'L', 'N', M, M, K, NB2_UB, AF, M, T2, NB2, Q, M, + $ WORK, INFO ) +* +* Copy R +* + CALL ZLASET( 'Full', M, N, CZERO, CZERO, R, M ) +* + CALL ZLACPY( 'Upper', M, N, AF, M, R, M ) +* +* TEST 1 +* Compute |R - (Q**H)*A| / ( eps * m * |A| ) and store in RESULT(1) +* + CALL ZGEMM( 'C', 'N', M, N, M, -CONE, Q, M, A, M, CONE, R, M ) +* + ANORM = ZLANGE( '1', M, N, A, M, RWORK ) + RESID = ZLANGE( '1', M, N, R, M, RWORK ) + IF( ANORM.GT.ZERO ) THEN + RESULT( 1 ) = RESID / ( EPS * MAX( 1, M ) * ANORM ) + ELSE + RESULT( 1 ) = ZERO + END IF +* +* TEST 2 +* Compute |I - (Q**H)*Q| / ( eps * m ) and store in RESULT(2) +* + CALL ZLASET( 'Full', M, M, CZERO, CONE, R, M ) + CALL ZHERK( 'U', 'C', M, M, -CONE, Q, M, CONE, R, M ) + RESID = ZLANSY( '1', 'Upper', M, R, M, RWORK ) + RESULT( 2 ) = RESID / ( EPS * MAX( 1, M ) ) +* +* Generate random m-by-n matrix C +* + DO J = 1, N + CALL ZLARNV( 2, ISEED, M, C( 1, J ) ) + END DO + CNORM = ZLANGE( '1', M, N, C, M, RWORK ) + CALL ZLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as Q*C = CF +* + SRNAMT = 'ZGEMQRT' + CALL ZGEMQRT( 'L', 'N', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 3 +* Compute |CF - Q*C| / ( eps * m * |C| ) +* + CALL ZGEMM( 'N', 'N', M, N, M, -CONE, Q, M, C, M, CONE, CF, M ) + RESID = ZLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 3 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 3 ) = ZERO + END IF +* +* Copy C into CF again +* + CALL ZLACPY( 'Full', M, N, C, M, CF, M ) +* +* Apply Q to C as (Q**H)*C = CF +* + SRNAMT = 'ZGEMQRT' + CALL ZGEMQRT( 'L', 'C', M, N, K, NB2_UB, AF, M, T2, NB2, CF, M, + $ WORK, INFO ) +* +* TEST 4 +* Compute |CF - (Q**H)*C| / ( eps * m * |C|) +* + CALL ZGEMM( 'C', 'N', M, N, M, -CONE, Q, M, C, M, CONE, CF, M ) + RESID = ZLANGE( '1', M, N, CF, M, RWORK ) + IF( CNORM.GT.ZERO ) THEN + RESULT( 4 ) = RESID / ( EPS * MAX( 1, M ) * CNORM ) + ELSE + RESULT( 4 ) = ZERO + END IF +* +* Generate random n-by-m matrix D and a copy DF +* + DO J = 1, M + CALL ZLARNV( 2, ISEED, N, D( 1, J ) ) + END DO + DNORM = ZLANGE( '1', N, M, D, N, RWORK ) + CALL ZLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*Q = DF +* + SRNAMT = 'ZGEMQRT' + CALL ZGEMQRT( 'R', 'N', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 5 +* Compute |DF - D*Q| / ( eps * m * |D| ) +* + CALL ZGEMM( 'N', 'N', N, M, M, -CONE, D, N, Q, M, CONE, DF, N ) + RESID = ZLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 5 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 5 ) = ZERO + END IF +* +* Copy D into DF again +* + CALL ZLACPY( 'Full', N, M, D, N, DF, N ) +* +* Apply Q to D as D*QT = DF +* + SRNAMT = 'ZGEMQRT' + CALL ZGEMQRT( 'R', 'C', N, M, K, NB2_UB, AF, M, T2, NB2, DF, N, + $ WORK, INFO ) +* +* TEST 6 +* Compute |DF - D*(Q**H)| / ( eps * m * |D| ) +* + CALL ZGEMM( 'N', 'C', N, M, M, -CONE, D, N, Q, M, CONE, DF, N ) + RESID = ZLANGE( '1', N, M, DF, N, RWORK ) + IF( DNORM.GT.ZERO ) THEN + RESULT( 6 ) = RESID / ( EPS * MAX( 1, M ) * DNORM ) + ELSE + RESULT( 6 ) = ZERO + END IF +* +* Deallocate all arrays +* + DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T1, T2, DIAG, + $ C, D, CF, DF ) +* + RETURN +* +* End of ZUNHR_COL01 +* + END diff --git a/lapack-netlib/TESTING/MATGEN/Makefile b/lapack-netlib/TESTING/MATGEN/Makefile index a1d784fa5..87432fd04 100644 --- a/lapack-netlib/TESTING/MATGEN/Makefile +++ b/lapack-netlib/TESTING/MATGEN/Makefile @@ -1,5 +1,3 @@ -include ../../make.inc - ####################################################################### # This is the makefile to create a library of the test matrix # generators used in LAPACK. The files are organized as follows: @@ -32,6 +30,9 @@ include ../../make.inc # ####################################################################### +TOPSRCDIR = ../.. +include $(TOPSRCDIR)/make.inc + SCATGEN = slatm1.o slatm7.o slaran.o slarnd.o SMATGEN = slatms.o slatme.o slatmr.o slatmt.o \ @@ -52,32 +53,32 @@ ZMATGEN = zlatms.o zlatme.o zlatmr.o zlatmt.o \ zlagge.o zlaghe.o zlagsy.o zlakf2.o zlarge.o zlaror.o zlarot.o \ zlatm1.o zlarnd.o zlatm2.o zlatm3.o zlatm5.o zlatm6.o zlahilb.o -all: ../../$(TMGLIB) +.PHONY: all +all: $(TMGLIB) ALLOBJ = $(SMATGEN) $(CMATGEN) $(SCATGEN) $(DMATGEN) $(ZMATGEN) \ $(DZATGEN) -.PHONY: ../../$(TMGLIB) - -../../$(TMGLIB): $(ALLOBJ) - $(ARCH) $(ARCHFLAGS) $@ $^ +$(TMGLIB): $(ALLOBJ) + $(AR) $(ARFLAGS) $@ $^ $(RANLIB) $@ +.PHONY: single complex double complex16 single: $(SMATGEN) $(SCATGEN) - $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^ - $(RANLIB) ../../$(TMGLIB) + $(AR) $(ARFLAGS) $(TMGLIB) $^ + $(RANLIB) $(TMGLIB) complex: $(CMATGEN) $(SCATGEN) - $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^ - $(RANLIB) ../../$(TMGLIB) + $(AR) $(ARFLAGS) $(TMGLIB) $^ + $(RANLIB) $(TMGLIB) double: $(DMATGEN) $(DZATGEN) - $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^ - $(RANLIB) ../../$(TMGLIB) + $(AR) $(ARFLAGS) $(TMGLIB) $^ + $(RANLIB) $(TMGLIB) complex16: $(ZMATGEN) $(DZATGEN) - $(ARCH) $(ARCHFLAGS) ../../$(TMGLIB) $^ - $(RANLIB) ../../$(TMGLIB) + $(AR) $(ARFLAGS) $(TMGLIB) $^ + $(RANLIB) $(TMGLIB) $(SCATGEN): $(FRC) $(SMATGEN): $(FRC) @@ -89,14 +90,12 @@ $(ZMATGEN): $(FRC) FRC: @FRC=$(FRC) -clean: cleanobj #cleanlib +.PHONY: clean cleanobj cleanlib +clean: cleanobj cleanlib cleanobj: rm -f *.o cleanlib: - rm -f ../../$(TMGLIB) - -.f.o: - $(FORTRAN) $(OPTS) -c -o $@ $< + rm -f $(TMGLIB) -slaran.o: slaran.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< -dlaran.o: dlaran.f ; $(FORTRAN) $(NOOPT) -c -o $@ $< +slaran.o: slaran.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< +dlaran.o: dlaran.f ; $(FC) $(FFLAGS_NOOPT) -c -o $@ $< diff --git a/lapack-netlib/TESTING/MATGEN/clahilb.f b/lapack-netlib/TESTING/MATGEN/clahilb.f index 13902872c..f4481fc78 100644 --- a/lapack-netlib/TESTING/MATGEN/clahilb.f +++ b/lapack-netlib/TESTING/MATGEN/clahilb.f @@ -164,7 +164,7 @@ INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8) * -* d's are generated from random permuation of those eight elements. +* d's are generated from random permutation of those eight elements. COMPLEX D1(8), D2(8), INVD1(8), INVD2(8) DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/ DATA D2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/ diff --git a/lapack-netlib/TESTING/MATGEN/clatm2.f b/lapack-netlib/TESTING/MATGEN/clatm2.f index 01221e0cc..5bd6b9dc8 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm2.f +++ b/lapack-netlib/TESTING/MATGEN/clatm2.f @@ -186,7 +186,7 @@ *> SPARSE is REAL *> Value between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/clatm3.f b/lapack-netlib/TESTING/MATGEN/clatm3.f index 3e07f3ec0..42b453553 100644 --- a/lapack-netlib/TESTING/MATGEN/clatm3.f +++ b/lapack-netlib/TESTING/MATGEN/clatm3.f @@ -202,7 +202,7 @@ *> \verbatim *> SPARSE is REAL between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/clatmr.f b/lapack-netlib/TESTING/MATGEN/clatmr.f index 11d29a3d0..e80c4a514 100644 --- a/lapack-netlib/TESTING/MATGEN/clatmr.f +++ b/lapack-netlib/TESTING/MATGEN/clatmr.f @@ -316,20 +316,6 @@ *> Not referenced if PIVTNG = 'N'. Not modified. *> \endverbatim *> -*> \param[in] SPARSE -*> \verbatim -*> SPARSE is REAL -*> On entry specifies the sparsity of the matrix if a sparse -*> matrix is to be generated. SPARSE should lie between -*> 0 and 1. To generate a sparse matrix, for each matrix entry -*> a uniform ( 0, 1 ) random number x is generated and -*> compared to SPARSE; if x is larger the matrix entry -*> is unchanged and if x is smaller the entry is set -*> to zero. Thus on the average a fraction SPARSE of the -*> entries will be set to zero. -*> Not modified. -*> \endverbatim -*> *> \param[in] KL *> \verbatim *> KL is INTEGER @@ -350,6 +336,20 @@ *> Not modified. *> \endverbatim *> +*> \param[in] SPARSE +*> \verbatim +*> SPARSE is REAL +*> On entry specifies the sparsity of the matrix if a sparse +*> matrix is to be generated. SPARSE should lie between +*> 0 and 1. To generate a sparse matrix, for each matrix entry +*> a uniform ( 0, 1 ) random number x is generated and +*> compared to SPARSE; if x is larger the matrix entry +*> is unchanged and if x is smaller the entry is set +*> to zero. Thus on the average a fraction SPARSE of the +*> entries will be set to zero. +*> Not modified. +*> \endverbatim +*> *> \param[in] ANORM *> \verbatim *> ANORM is REAL @@ -416,7 +416,7 @@ *> If PACK='C' or 'R', LDA must be at least 1. *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) *> If PACK='Z', LDA must be at least KUU+KLL+1, where -*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 ) +*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 ) *> Not modified. *> \endverbatim *> diff --git a/lapack-netlib/TESTING/MATGEN/dlatm2.f b/lapack-netlib/TESTING/MATGEN/dlatm2.f index 446f5a801..d7a6d19f3 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm2.f +++ b/lapack-netlib/TESTING/MATGEN/dlatm2.f @@ -182,7 +182,7 @@ *> \verbatim *> SPARSE is DOUBLE PRECISION between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/dlatm3.f b/lapack-netlib/TESTING/MATGEN/dlatm3.f index cf6da10f8..15f5ac080 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatm3.f +++ b/lapack-netlib/TESTING/MATGEN/dlatm3.f @@ -199,7 +199,7 @@ *> \verbatim *> SPARSE is DOUBLE PRECISION between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/dlatmr.f b/lapack-netlib/TESTING/MATGEN/dlatmr.f index e7ea41907..a914481f7 100644 --- a/lapack-netlib/TESTING/MATGEN/dlatmr.f +++ b/lapack-netlib/TESTING/MATGEN/dlatmr.f @@ -303,20 +303,6 @@ *> Not referenced if PIVTNG = 'N'. Not modified. *> \endverbatim *> -*> \param[in] SPARSE -*> \verbatim -*> SPARSE is DOUBLE PRECISION -*> On entry specifies the sparsity of the matrix if a sparse -*> matrix is to be generated. SPARSE should lie between -*> 0 and 1. To generate a sparse matrix, for each matrix entry -*> a uniform ( 0, 1 ) random number x is generated and -*> compared to SPARSE; if x is larger the matrix entry -*> is unchanged and if x is smaller the entry is set -*> to zero. Thus on the average a fraction SPARSE of the -*> entries will be set to zero. -*> Not modified. -*> \endverbatim -*> *> \param[in] KL *> \verbatim *> KL is INTEGER @@ -337,6 +323,20 @@ *> Not modified. *> \endverbatim *> +*> \param[in] SPARSE +*> \verbatim +*> SPARSE is DOUBLE PRECISION +*> On entry specifies the sparsity of the matrix if a sparse +*> matrix is to be generated. SPARSE should lie between +*> 0 and 1. To generate a sparse matrix, for each matrix entry +*> a uniform ( 0, 1 ) random number x is generated and +*> compared to SPARSE; if x is larger the matrix entry +*> is unchanged and if x is smaller the entry is set +*> to zero. Thus on the average a fraction SPARSE of the +*> entries will be set to zero. +*> Not modified. +*> \endverbatim +*> *> \param[in] ANORM *> \verbatim *> ANORM is DOUBLE PRECISION @@ -398,7 +398,7 @@ *> If PACK='C' or 'R', LDA must be at least 1. *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) *> If PACK='Z', LDA must be at least KUU+KLL+1, where -*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 ) +*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 ) *> Not modified. *> \endverbatim *> diff --git a/lapack-netlib/TESTING/MATGEN/slatm2.f b/lapack-netlib/TESTING/MATGEN/slatm2.f index fc7e78126..2473f1f44 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm2.f +++ b/lapack-netlib/TESTING/MATGEN/slatm2.f @@ -182,7 +182,7 @@ *> \verbatim *> SPARSE is REAL between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/slatm3.f b/lapack-netlib/TESTING/MATGEN/slatm3.f index e61c954bd..18c2c07d5 100644 --- a/lapack-netlib/TESTING/MATGEN/slatm3.f +++ b/lapack-netlib/TESTING/MATGEN/slatm3.f @@ -199,7 +199,7 @@ *> \verbatim *> SPARSE is REAL between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/slatmr.f b/lapack-netlib/TESTING/MATGEN/slatmr.f index e4705994a..c2cedd21c 100644 --- a/lapack-netlib/TESTING/MATGEN/slatmr.f +++ b/lapack-netlib/TESTING/MATGEN/slatmr.f @@ -303,20 +303,6 @@ *> Not referenced if PIVTNG = 'N'. Not modified. *> \endverbatim *> -*> \param[in] SPARSE -*> \verbatim -*> SPARSE is REAL -*> On entry specifies the sparsity of the matrix if a sparse -*> matrix is to be generated. SPARSE should lie between -*> 0 and 1. To generate a sparse matrix, for each matrix entry -*> a uniform ( 0, 1 ) random number x is generated and -*> compared to SPARSE; if x is larger the matrix entry -*> is unchanged and if x is smaller the entry is set -*> to zero. Thus on the average a fraction SPARSE of the -*> entries will be set to zero. -*> Not modified. -*> \endverbatim -*> *> \param[in] KL *> \verbatim *> KL is INTEGER @@ -337,6 +323,20 @@ *> Not modified. *> \endverbatim *> +*> \param[in] SPARSE +*> \verbatim +*> SPARSE is REAL +*> On entry specifies the sparsity of the matrix if a sparse +*> matrix is to be generated. SPARSE should lie between +*> 0 and 1. To generate a sparse matrix, for each matrix entry +*> a uniform ( 0, 1 ) random number x is generated and +*> compared to SPARSE; if x is larger the matrix entry +*> is unchanged and if x is smaller the entry is set +*> to zero. Thus on the average a fraction SPARSE of the +*> entries will be set to zero. +*> Not modified. +*> \endverbatim +*> *> \param[in] ANORM *> \verbatim *> ANORM is REAL @@ -398,7 +398,7 @@ *> If PACK='C' or 'R', LDA must be at least 1. *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) *> If PACK='Z', LDA must be at least KUU+KLL+1, where -*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 ) +*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 ) *> Not modified. *> \endverbatim *> diff --git a/lapack-netlib/TESTING/MATGEN/zlahilb.f b/lapack-netlib/TESTING/MATGEN/zlahilb.f index 43057931d..e5a317821 100644 --- a/lapack-netlib/TESTING/MATGEN/zlahilb.f +++ b/lapack-netlib/TESTING/MATGEN/zlahilb.f @@ -164,7 +164,7 @@ INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11, SIZE_D = 8) * -* d's are generated from random permuation of those eight elements. +* d's are generated from random permutation of those eight elements. COMPLEX*16 d1(8), d2(8), invd1(8), invd2(8) DATA D1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/ DATA D2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/ diff --git a/lapack-netlib/TESTING/MATGEN/zlatm2.f b/lapack-netlib/TESTING/MATGEN/zlatm2.f index 2de69eeca..ea93431e7 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm2.f +++ b/lapack-netlib/TESTING/MATGEN/zlatm2.f @@ -185,7 +185,7 @@ *> \verbatim *> SPARSE is DOUBLE PRECISION between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/zlatm3.f b/lapack-netlib/TESTING/MATGEN/zlatm3.f index 42d58c853..25d6233f3 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatm3.f +++ b/lapack-netlib/TESTING/MATGEN/zlatm3.f @@ -202,7 +202,7 @@ *> \verbatim *> SPARSE is DOUBLE PRECISION between 0. and 1. *> On entry specifies the sparsity of the matrix -*> if sparse matix is to be generated. +*> if sparse matrix is to be generated. *> SPARSE should lie between 0 and 1. *> A uniform ( 0, 1 ) random number x is generated and *> compared to SPARSE; if x is larger the matrix entry diff --git a/lapack-netlib/TESTING/MATGEN/zlatmr.f b/lapack-netlib/TESTING/MATGEN/zlatmr.f index 6685a3570..56285e1f4 100644 --- a/lapack-netlib/TESTING/MATGEN/zlatmr.f +++ b/lapack-netlib/TESTING/MATGEN/zlatmr.f @@ -316,20 +316,6 @@ *> Not referenced if PIVTNG = 'N'. Not modified. *> \endverbatim *> -*> \param[in] SPARSE -*> \verbatim -*> SPARSE is DOUBLE PRECISION -*> On entry specifies the sparsity of the matrix if a sparse -*> matrix is to be generated. SPARSE should lie between -*> 0 and 1. To generate a sparse matrix, for each matrix entry -*> a uniform ( 0, 1 ) random number x is generated and -*> compared to SPARSE; if x is larger the matrix entry -*> is unchanged and if x is smaller the entry is set -*> to zero. Thus on the average a fraction SPARSE of the -*> entries will be set to zero. -*> Not modified. -*> \endverbatim -*> *> \param[in] KL *> \verbatim *> KL is INTEGER @@ -350,6 +336,20 @@ *> Not modified. *> \endverbatim *> +*> \param[in] SPARSE +*> \verbatim +*> SPARSE is DOUBLE PRECISION +*> On entry specifies the sparsity of the matrix if a sparse +*> matrix is to be generated. SPARSE should lie between +*> 0 and 1. To generate a sparse matrix, for each matrix entry +*> a uniform ( 0, 1 ) random number x is generated and +*> compared to SPARSE; if x is larger the matrix entry +*> is unchanged and if x is smaller the entry is set +*> to zero. Thus on the average a fraction SPARSE of the +*> entries will be set to zero. +*> Not modified. +*> \endverbatim +*> *> \param[in] ANORM *> \verbatim *> ANORM is DOUBLE PRECISION @@ -416,7 +416,7 @@ *> If PACK='C' or 'R', LDA must be at least 1. *> If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) *> If PACK='Z', LDA must be at least KUU+KLL+1, where -*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 ) +*> KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, M-1 ) *> Not modified. *> \endverbatim *> diff --git a/lapack-netlib/TESTING/Makefile b/lapack-netlib/TESTING/Makefile index 8b883c0fa..bdea2bfaa 100644 --- a/lapack-netlib/TESTING/Makefile +++ b/lapack-netlib/TESTING/Makefile @@ -34,8 +34,10 @@ # ####################################################################### -include ../make.inc +TOPSRCDIR = .. +include $(TOPSRCDIR)/make.inc +.PHONY: all all: single complex double complex16 singleproto doubleproto complexproto complex16proto SEIGTST= snep.out \ @@ -139,10 +141,13 @@ ZLINTST= ztest.out ZLINTSTPROTO= zctest.out ztest_rfp.out +.PHONY: single complex double complex16 single: $(SLINTST) $(SEIGTST) complex: $(CLINTST) $(CEIGTST) double: $(DLINTST) $(DEIGTST) complex16: $(ZLINTST) $(ZEIGTST) + +.PHONY: singleproto complexproto doubleproto complex16proto singleproto: $(SLINTSTPROTO) complexproto: $(CLINTSTPROTO) doubleproto: $(DLINTSTPROTO) @@ -153,61 +158,61 @@ complex16proto: $(ZLINTSTPROTO) stest.out: stest.in LIN/xlintsts @echo Testing REAL LAPACK linear equation routines - ./LIN/xlintsts < $< > $@ 2>&1 + ./LIN/xlintsts < stest.in > $@ 2>&1 # # ======== COMPLEX LIN TESTS ========================== ctest.out: ctest.in LIN/xlintstc @echo Testing COMPLEX LAPACK linear equation routines - ./LIN/xlintstc < $< > $@ 2>&1 + ./LIN/xlintstc < ctest.in > $@ 2>&1 # # ======== DOUBLE LIN TESTS =========================== dtest.out: dtest.in LIN/xlintstd @echo Testing DOUBLE PRECISION LAPACK linear equation routines - ./LIN/xlintstd < $< > $@ 2>&1 + ./LIN/xlintstd < dtest.in > $@ 2>&1 # # ======== COMPLEX16 LIN TESTS ======================== ztest.out: ztest.in LIN/xlintstz @echo Testing COMPLEX16 LAPACK linear equation routines - ./LIN/xlintstz < $< > $@ 2>&1 + ./LIN/xlintstz < ztest.in > $@ 2>&1 # # ======== SINGLE-DOUBLE PROTO LIN TESTS ============== dstest.out: dstest.in LIN/xlintstds @echo Testing SINGLE-DOUBLE PRECISION LAPACK prototype linear equation routines - ./LIN/xlintstds < $< > $@ 2>&1 + ./LIN/xlintstds < dstest.in > $@ 2>&1 # # ======== COMPLEX-COMPLEX16 LIN TESTS ======================== zctest.out: zctest.in LIN/xlintstzc @echo Testing COMPLEX-COMPLEX16 LAPACK prototype linear equation routines - ./LIN/xlintstzc < $< > $@ 2>&1 + ./LIN/xlintstzc < zctest.in > $@ 2>&1 # # ======== SINGLE RFP LIN TESTS ======================== stest_rfp.out: stest_rfp.in LIN/xlintstrfs @echo Testing REAL LAPACK RFP prototype linear equation routines - ./LIN/xlintstrfs < $< > $@ 2>&1 + ./LIN/xlintstrfs < stest_rfp.in > $@ 2>&1 # # ======== COMPLEX16 RFP LIN TESTS ======================== dtest_rfp.out: dtest_rfp.in LIN/xlintstrfd @echo Testing DOUBLE PRECISION LAPACK RFP prototype linear equation routines - ./LIN/xlintstrfd < $< > $@ 2>&1 + ./LIN/xlintstrfd < dtest_rfp.in > $@ 2>&1 # # ======== COMPLEX16 RFP LIN TESTS ======================== ctest_rfp.out: ctest_rfp.in LIN/xlintstrfc @echo Testing COMPLEX LAPACK RFP prototype linear equation routines - ./LIN/xlintstrfc < $< > $@ 2>&1 + ./LIN/xlintstrfc < ctest_rfp.in > $@ 2>&1 # # ======== COMPLEX16 RFP LIN TESTS ======================== ztest_rfp.out: ztest_rfp.in LIN/xlintstrfz @echo Testing COMPLEX16 LAPACK RFP prototype linear equation routines - ./LIN/xlintstrfz < $< > $@ 2>&1 + ./LIN/xlintstrfz < ztest_rfp.in > $@ 2>&1 # # # ======== SINGLE EIG TESTS =========================== @@ -215,329 +220,329 @@ ztest_rfp.out: ztest_rfp.in LIN/xlintstrfz snep.out: nep.in EIG/xeigtsts @echo NEP: Testing Nonsymmetric Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < nep.in > $@ 2>&1 ssep.out: sep.in EIG/xeigtsts @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sep.in > $@ 2>&1 sse2.out: se2.in EIG/xeigtsts @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < se2.in > $@ 2>&1 ssvd.out: svd.in EIG/xeigtsts @echo SVD: Testing Singular Value Decomposition routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < svd.in > $@ 2>&1 sec.out: sec.in EIG/xeigtsts @echo SEC: Testing REAL Eigen Condition Routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sec.in > $@ 2>&1 sed.out: sed.in EIG/xeigtsts @echo SEV: Testing REAL Nonsymmetric Eigenvalue Driver - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sed.in > $@ 2>&1 sgg.out: sgg.in EIG/xeigtsts @echo SGG: Testing REAL Nonsymmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sgg.in > $@ 2>&1 sgd.out: sgd.in EIG/xeigtsts @echo SGD: Testing REAL Nonsymmetric Generalized Eigenvalue Problem driver routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sgd.in > $@ 2>&1 ssb.out: ssb.in EIG/xeigtsts @echo SSB: Testing REAL Symmetric Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < ssb.in > $@ 2>&1 ssg.out: ssg.in EIG/xeigtsts @echo SSG: Testing REAL Symmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < ssg.in > $@ 2>&1 sbal.out: sbal.in EIG/xeigtsts @echo SGEBAL: Testing the balancing of a REAL general matrix - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sbal.in > $@ 2>&1 sbak.out: sbak.in EIG/xeigtsts @echo SGEBAK: Testing the back transformation of a REAL balanced matrix - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sbak.in > $@ 2>&1 sgbal.out: sgbal.in EIG/xeigtsts @echo SGGBAL: Testing the balancing of a pair of REAL general matrices - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sgbal.in > $@ 2>&1 sgbak.out: sgbak.in EIG/xeigtsts @echo SGGBAK: Testing the back transformation of a pair of REAL balanced matrices - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sgbak.in > $@ 2>&1 sbb.out: sbb.in EIG/xeigtsts @echo SBB: Testing banded Singular Value Decomposition routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < sbb.in > $@ 2>&1 sglm.out: glm.in EIG/xeigtsts @echo GLM: Testing Generalized Linear Regression Model routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < glm.in > $@ 2>&1 sgqr.out: gqr.in EIG/xeigtsts @echo GQR: Testing Generalized QR and RQ factorization routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < gqr.in > $@ 2>&1 sgsv.out: gsv.in EIG/xeigtsts @echo GSV: Testing Generalized Singular Value Decomposition routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < gsv.in > $@ 2>&1 scsd.out: csd.in EIG/xeigtsts @echo CSD: Testing CS Decomposition routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < csd.in > $@ 2>&1 slse.out: lse.in EIG/xeigtsts @echo LSE: Testing Constrained Linear Least Squares routines - ./EIG/xeigtsts < $< > $@ 2>&1 + ./EIG/xeigtsts < lse.in > $@ 2>&1 # # ======== COMPLEX EIG TESTS =========================== cnep.out: nep.in EIG/xeigtstc @echo NEP: Testing Nonsymmetric Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < nep.in > $@ 2>&1 csep.out: sep.in EIG/xeigtstc @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < sep.in > $@ 2>&1 cse2.out: se2.in EIG/xeigtstc @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < se2.in > $@ 2>&1 csvd.out: svd.in EIG/xeigtstc @echo SVD: Testing Singular Value Decomposition routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < svd.in > $@ 2>&1 cec.out: cec.in EIG/xeigtstc @echo CEC: Testing COMPLEX Eigen Condition Routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cec.in > $@ 2>&1 ced.out: ced.in EIG/xeigtstc @echo CES: Testing COMPLEX Nonsymmetric Schur Form Driver - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < ced.in > $@ 2>&1 cgg.out: cgg.in EIG/xeigtstc @echo CGG: Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cgg.in > $@ 2>&1 cgd.out: cgd.in EIG/xeigtstc @echo CGD: Testing COMPLEX Nonsymmetric Generalized Eigenvalue Problem driver routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cgd.in > $@ 2>&1 csb.out: csb.in EIG/xeigtstc @echo CHB: Testing Hermitian Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < csb.in > $@ 2>&1 csg.out: csg.in EIG/xeigtstc @echo CSG: Testing Symmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < csg.in > $@ 2>&1 cbal.out: cbal.in EIG/xeigtstc @echo CGEBAL: Testing the balancing of a COMPLEX general matrix - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cbal.in > $@ 2>&1 cbak.out: cbak.in EIG/xeigtstc @echo CGEBAK: Testing the back transformation of a COMPLEX balanced matrix - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cbak.in > $@ 2>&1 cgbal.out: cgbal.in EIG/xeigtstc @echo CGGBAL: Testing the balancing of a pair of COMPLEX general matrices - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cgbal.in > $@ 2>&1 cgbak.out: cgbak.in EIG/xeigtstc @echo CGGBAK: Testing the back transformation of a pair of COMPLEX balanced matrices - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cgbak.in > $@ 2>&1 cbb.out: cbb.in EIG/xeigtstc @echo CBB: Testing banded Singular Value Decomposition routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < cbb.in > $@ 2>&1 cglm.out: glm.in EIG/xeigtstc @echo GLM: Testing Generalized Linear Regression Model routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < glm.in > $@ 2>&1 cgqr.out: gqr.in EIG/xeigtstc @echo GQR: Testing Generalized QR and RQ factorization routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < gqr.in > $@ 2>&1 cgsv.out: gsv.in EIG/xeigtstc @echo GSV: Testing Generalized Singular Value Decomposition routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < gsv.in > $@ 2>&1 ccsd.out: csd.in EIG/xeigtstc @echo CSD: Testing CS Decomposition routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < csd.in > $@ 2>&1 clse.out: lse.in EIG/xeigtstc @echo LSE: Testing Constrained Linear Least Squares routines - ./EIG/xeigtstc < $< > $@ 2>&1 + ./EIG/xeigtstc < lse.in > $@ 2>&1 # # ======== DOUBLE EIG TESTS =========================== dnep.out: nep.in EIG/xeigtstd @echo NEP: Testing Nonsymmetric Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < nep.in > $@ 2>&1 dsep.out: sep.in EIG/xeigtstd @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < sep.in > $@ 2>&1 dse2.out: se2.in EIG/xeigtstd @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < se2.in > $@ 2>&1 dsvd.out: svd.in EIG/xeigtstd @echo SVD: Testing Singular Value Decomposition routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < svd.in > $@ 2>&1 dec.out: dec.in EIG/xeigtstd @echo DEC: Testing DOUBLE PRECISION Eigen Condition Routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dec.in > $@ 2>&1 ded.out: ded.in EIG/xeigtstd @echo DEV: Testing DOUBLE PRECISION Nonsymmetric Eigenvalue Driver - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < ded.in > $@ 2>&1 dgg.out: dgg.in EIG/xeigtstd @echo DGG: Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dgg.in > $@ 2>&1 dgd.out: dgd.in EIG/xeigtstd @echo DGD: Testing DOUBLE PRECISION Nonsymmetric Generalized Eigenvalue Problem driver routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dgd.in > $@ 2>&1 dsb.out: dsb.in EIG/xeigtstd @echo DSB: Testing DOUBLE PRECISION Symmetric Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dsb.in > $@ 2>&1 dsg.out: dsg.in EIG/xeigtstd @echo DSG: Testing DOUBLE PRECISION Symmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dsg.in > $@ 2>&1 dbal.out: dbal.in EIG/xeigtstd @echo DGEBAL: Testing the balancing of a DOUBLE PRECISION general matrix - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dbal.in > $@ 2>&1 dbak.out: dbak.in EIG/xeigtstd @echo DGEBAK: Testing the back transformation of a DOUBLE PRECISION balanced matrix - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dbak.in > $@ 2>&1 dgbal.out: dgbal.in EIG/xeigtstd @echo DGGBAL: Testing the balancing of a pair of DOUBLE PRECISION general matrices - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dgbal.in > $@ 2>&1 dgbak.out: dgbak.in EIG/xeigtstd @echo DGGBAK: Testing the back transformation of a pair of DOUBLE PRECISION balanced matrices - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dgbak.in > $@ 2>&1 dbb.out: dbb.in EIG/xeigtstd @echo DBB: Testing banded Singular Value Decomposition routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < dbb.in > $@ 2>&1 dglm.out: glm.in EIG/xeigtstd @echo GLM: Testing Generalized Linear Regression Model routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < glm.in > $@ 2>&1 dgqr.out: gqr.in EIG/xeigtstd @echo GQR: Testing Generalized QR and RQ factorization routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < gqr.in > $@ 2>&1 dgsv.out: gsv.in EIG/xeigtstd @echo GSV: Testing Generalized Singular Value Decomposition routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < gsv.in > $@ 2>&1 dcsd.out: csd.in EIG/xeigtstd @echo CSD: Testing CS Decomposition routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < csd.in > $@ 2>&1 dlse.out: lse.in EIG/xeigtstd @echo LSE: Testing Constrained Linear Least Squares routines - ./EIG/xeigtstd < $< > $@ 2>&1 + ./EIG/xeigtstd < lse.in > $@ 2>&1 # # ======== COMPLEX16 EIG TESTS =========================== znep.out: nep.in EIG/xeigtstz @echo NEP: Testing Nonsymmetric Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < nep.in > $@ 2>&1 zsep.out: sep.in EIG/xeigtstz @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < sep.in > $@ 2>&1 zse2.out: se2.in EIG/xeigtstz @echo SEP: Testing Symmetric Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < se2.in > $@ 2>&1 zsvd.out: svd.in EIG/xeigtstz @echo SVD: Testing Singular Value Decomposition routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < svd.in > $@ 2>&1 zec.out: zec.in EIG/xeigtstz @echo ZEC: Testing COMPLEX16 Eigen Condition Routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zec.in > $@ 2>&1 zed.out: zed.in EIG/xeigtstz @echo ZES: Testing COMPLEX16 Nonsymmetric Schur Form Driver - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zed.in > $@ 2>&1 zgg.out: zgg.in EIG/xeigtstz @echo ZGG: Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zgg.in > $@ 2>&1 zgd.out: zgd.in EIG/xeigtstz @echo ZGD: Testing COMPLEX16 Nonsymmetric Generalized Eigenvalue Problem driver routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zgd.in > $@ 2>&1 zsb.out: zsb.in EIG/xeigtstz @echo ZHB: Testing Hermitian Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zsb.in > $@ 2>&1 zsg.out: zsg.in EIG/xeigtstz @echo ZSG: Testing Symmetric Generalized Eigenvalue Problem routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zsg.in > $@ 2>&1 zbal.out: zbal.in EIG/xeigtstz @echo ZGEBAL: Testing the balancing of a COMPLEX16 general matrix - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zbal.in > $@ 2>&1 zbak.out: zbak.in EIG/xeigtstz @echo ZGEBAK: Testing the back transformation of a COMPLEX16 balanced matrix - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zbak.in > $@ 2>&1 zgbal.out: zgbal.in EIG/xeigtstz @echo ZGGBAL: Testing the balancing of a pair of COMPLEX general matrices - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zgbal.in > $@ 2>&1 zgbak.out: zgbak.in EIG/xeigtstz @echo ZGGBAK: Testing the back transformation of a pair of COMPLEX16 balanced matrices - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zgbak.in > $@ 2>&1 zbb.out: zbb.in EIG/xeigtstz @echo ZBB: Testing banded Singular Value Decomposition routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < zbb.in > $@ 2>&1 zglm.out: glm.in EIG/xeigtstz @echo GLM: Testing Generalized Linear Regression Model routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < glm.in > $@ 2>&1 zgqr.out: gqr.in EIG/xeigtstz @echo GQR: Testing Generalized QR and RQ factorization routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < gqr.in > $@ 2>&1 zgsv.out: gsv.in EIG/xeigtstz @echo GSV: Testing Generalized Singular Value Decomposition routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < gsv.in > $@ 2>&1 zcsd.out: csd.in EIG/xeigtstz @echo CSD: Testing CS Decomposition routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < csd.in > $@ 2>&1 zlse.out: lse.in EIG/xeigtstz @echo LSE: Testing Constrained Linear Least Squares routines - ./EIG/xeigtstz < $< > $@ 2>&1 + ./EIG/xeigtstz < lse.in > $@ 2>&1 # ============================================================================== LIN/xlintsts: $(FRCLIN) $(FRC) @@ -582,6 +587,7 @@ EIG/xeigtstd: $(FRCEIG) $(FRC) EIG/xeigtstz: $(FRCEIG) $(FRC) $(MAKE) -C EIG xeigtstz +.PHONY: clean cleantest clean: cleantest cleantest: rm -f *.out core diff --git a/lapack-netlib/TESTING/ctest.in b/lapack-netlib/TESTING/ctest.in index 2f3853a03..a3588b4a1 100644 --- a/lapack-netlib/TESTING/ctest.in +++ b/lapack-netlib/TESTING/ctest.in @@ -50,3 +50,4 @@ CQX CXQ CTQ CTS +CHH diff --git a/lapack-netlib/TESTING/dtest.in b/lapack-netlib/TESTING/dtest.in index a7a16ee41..29bb8b92e 100644 --- a/lapack-netlib/TESTING/dtest.in +++ b/lapack-netlib/TESTING/dtest.in @@ -44,3 +44,4 @@ DQX DXQ DTQ DTS +DHH diff --git a/lapack-netlib/TESTING/stest.in b/lapack-netlib/TESTING/stest.in index d32047047..27ac30040 100644 --- a/lapack-netlib/TESTING/stest.in +++ b/lapack-netlib/TESTING/stest.in @@ -44,3 +44,4 @@ SQX SXQ STQ STS +SHH diff --git a/lapack-netlib/TESTING/ztest.in b/lapack-netlib/TESTING/ztest.in index 520253941..58da33d60 100644 --- a/lapack-netlib/TESTING/ztest.in +++ b/lapack-netlib/TESTING/ztest.in @@ -50,3 +50,4 @@ ZQX ZXQ ZTQ ZTS +ZHH diff --git a/lapack-netlib/appveyor.yml b/lapack-netlib/appveyor.yml deleted file mode 100644 index 7fc3fbdd7..000000000 --- a/lapack-netlib/appveyor.yml +++ /dev/null @@ -1,64 +0,0 @@ -# Windows testing. -# Syntax for this file: -# http://www.appveyor.com/docs/appveyor-yml - -shallow_clone: true - -platform: x64 - -cache: - - x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z - - i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z - -environment: - CTEST_OUTPUT_ON_FAILURE: 1 - matrix: - - MINGW_DIR: mingw64 - MINGW_URL: https://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win64/Personal%20Builds/mingw-builds/4.9.2/threads-win32/seh/x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z/download - MINGW_ARCHIVE: x86_64-4.9.2-release-win32-seh-rt_v4-rev4.7z - - MINGW_DIR: mingw32 - MINGW_URL: https://sourceforge.net/projects/mingw-w64/files/Toolchains%20targetting%20Win32/Personal%20Builds/mingw-builds/4.9.2/threads-win32/dwarf/i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z/download - MINGW_ARCHIVE: i686-4.9.2-release-win32-dwarf-rt_v4-rev4.7z - -install: - - if not exist "%MINGW_ARCHIVE%" appveyor DownloadFile "%MINGW_URL%" -FileName "%MINGW_ARCHIVE%" - - 7z x -y "%MINGW_ARCHIVE%" > nul - # CMake refuses to generate MinGW Makefiles if sh.exe is in the Path - - ps: Get-Command sh.exe -All | Remove-Item - -build_script: - - echo "NUMBER_OF_PROCESSORS=%NUMBER_OF_PROCESSORS%" - - set PATH=%CD%\%MINGW_DIR%\bin;%PATH% - - g++ --version - - mingw32-make --version - - cmake --version - - if "%APPVEYOR_REPO_TAG%"=="true" (set CMAKE_BUILD_TYPE=Release) else (set CMAKE_BUILD_TYPE=Debug) - - set SRC_DIR=%CD% - - echo %SRC_DIR% - - set BLD_DIR=%SRC_DIR%\..\lapack-appveyor-bld - - set INST_DIR=%SRC_DIR%\..\lapack-appveyor-install - - mkdir -p %BLD_DIR% - - cd %BLD_DIR% - # See issue #17 on github dashboard. Once resolved, use -DCBLAS=ON - # - cmake -DCMAKE_INSTALL_PREFIX=${INST_DIR} -DLAPACKE=ON ${SRC_DIR} - - cmake - -G "MinGW Makefiles" - -DBUILDNAME:STRING="appveyor-%MINGW_DIR%-%APPVEYOR_REPO_BRANCH%" - -DCMAKE_BUILD_TYPE=%CMAKE_BUILD_TYPE% - -DCMAKE_INSTALL_PREFIX=%INST_DIR% - -DCBLAS:BOOL=ON - -DLAPACKE:BOOL=ON - -DBUILD_TESTING=ON - -DLAPACKE_WITH_TMG:BOOL=ON - %SRC_DIR% - - mingw32-make -j%NUMBER_OF_PROCESSORS% - -test_script: - - ctest -D ExperimentalStart - - ctest -D ExperimentalConfigure - - ctest -D ExperimentalBuild -j%NUMBER_OF_PROCESSORS% - - ctest -D ExperimentalTest --schedule-random -j%NUMBER_OF_PROCESSORS% --output-on-failure --timeout 100 -E "CBLAS\-.*cblat1" - - ctest -D ExperimentalSubmit - -after_test: - - mingw32-make install -j%NUMBER_OF_PROCESSORS% diff --git a/lapack-netlib/lapack_build.cmake b/lapack-netlib/lapack_build.cmake index 68744cc4c..39878cb24 100644 --- a/lapack-netlib/lapack_build.cmake +++ b/lapack-netlib/lapack_build.cmake @@ -69,7 +69,8 @@ find_program(HOSTNAME NAMES hostname) find_program(UNAME NAMES uname) # Get the build name and hostname -exec_program(${HOSTNAME} ARGS OUTPUT_VARIABLE hostname) +execute_process(${HOSTNAME} + OUTPUT_VARIABLE hostname) string(REGEX REPLACE "[/\\\\+<> #]" "-" hostname "${hostname}") message("HOSTNAME: ${hostname}") @@ -83,7 +84,8 @@ find_package(Git REQUIRED) set(CTEST_GIT_COMMAND ${GIT_EXECUTABLE}) set(CTEST_UPDATE_COMMAND ${GIT_EXECUTABLE}) macro(getuname name flag) - exec_program("${UNAME}" ARGS "${flag}" OUTPUT_VARIABLE "${name}") + execute_process(COMMAND "${UNAME}" "${flag}" + OUTPUT_VARIABLE "${name}") string(REGEX REPLACE "[/\\\\+<> #]" "-" "${name}" "${${name}}") string(REGEX REPLACE "^(......|.....|....|...|..|.).*" "\\1" "${name}" "${${name}}") endmacro() @@ -167,7 +169,7 @@ endif() # dashboard then set this variable to the directory # the dashboard should be in make_directory("${CTEST_DASHBOARD_ROOT}") -# these are the the name of the source and binary directory on disk. +# these are the names of the source and binary directory on disk. # They will be appended to DASHBOARD_ROOT set(CTEST_SOURCE_DIRECTORY "${CTEST_DASHBOARD_ROOT}/${CTEST_DIR_NAME}") set(CTEST_BINARY_DIRECTORY "${CTEST_SOURCE_DIRECTORY}-${CTEST_BUILD_NAME}") diff --git a/lapack-netlib/lapack_testing.py b/lapack-netlib/lapack_testing.py index 5d07e1e87..5582744a0 100755 --- a/lapack-netlib/lapack_testing.py +++ b/lapack-netlib/lapack_testing.py @@ -12,8 +12,8 @@ import os, sys, math import getopt # Arguments try: - opts, args = getopt.getopt(sys.argv[1:], "hd:srep:t:n", - ["help", "dir", "short", "run", "error","prec=","test=","number"]) + opts, args = getopt.getopt(sys.argv[1:], "hd:b:srep:t:n", + ["help", "dir", "bin", "short", "run", "error","prec=","test=","number"]) except getopt.error as msg: print(msg) @@ -29,14 +29,13 @@ only_numbers=0 test_dir='TESTING' bin_dir='bin/Release' -abs_bin_dir=os.path.normpath(os.path.join(os.getcwd(),bin_dir)) - for o, a in opts: if o in ("-h", "--help"): print(sys.argv[0]+" [-h|--help] [-d dir |--dir dir] [-s |--short] [-r |--run] [-e |--error] [-p p |--prec p] [-t test |--test test] [-n | --number]") print(" - h is to print this message") print(" - r is to use to run the LAPACK tests then analyse the output (.out files). By default, the script will not run all the LAPACK tests") print(" - d [dir] is to indicate where is the LAPACK testing directory (.out files). By default, the script will use .") + print(" - b [bin] is to indicate where is the LAPACK binary files are located. By default, the script will use .") print(" LEVEL OF OUTPUT") print(" - x is to print a detailed summary") print(" - e is to print only the error summary") @@ -75,6 +74,8 @@ for o, a in opts: just_errors = 1 if o in ( '-p', '--prec' ): prec = a + if o in ( '-b', '--bin' ): + bin_dir = a if o in ( '-d', '--dir' ): test_dir = a if o in ( '-t', '--test' ): @@ -85,6 +86,8 @@ for o, a in opts: # process options +abs_bin_dir=os.path.normpath(os.path.join(os.getcwd(),bin_dir)) + os.chdir(test_dir) execution=1 @@ -114,10 +117,7 @@ def run_summary_test( f, cmdline, short_summary): pipe = open(cmdline,'r') r=0 else: - if os.name != 'nt': - cmdline='./' + cmdline - else : - cmdline=abs_bin_dir+os.path.sep+cmdline + cmdline = os.path.join(abs_bin_dir, cmdline) outfile=cmdline.split()[4] #pipe = open(outfile,'w') diff --git a/lapack-netlib/make.inc.example b/lapack-netlib/make.inc.example index d780c3a23..57fd51ebe 100644 --- a/lapack-netlib/make.inc.example +++ b/lapack-netlib/make.inc.example @@ -8,10 +8,10 @@ SHELL = /bin/sh # CC is the C compiler, normally invoked with options CFLAGS. # -CC = gcc +CC = gcc CFLAGS = -O3 -# Modify the FORTRAN and OPTS definitions to refer to the compiler +# Modify the FC and FFLAGS definitions to the desired compiler # and desired compiler options for your machine. NOOPT refers to # the compiler options desired when NO OPTIMIZATION is selected. # @@ -19,23 +19,21 @@ CFLAGS = -O3 # and handle these quantities appropriately. As a consequence, one # should not compile LAPACK with flags such as -ffpe-trap=overflow. # -FORTRAN = gfortran -OPTS = -O2 -frecursive -DRVOPTS = $(OPTS) -NOOPT = -O0 -frecursive +FC = gfortran +FFLAGS = -O2 -frecursive +FFLAGS_DRV = $(FFLAGS) +FFLAGS_NOOPT = -O0 -frecursive -# Define LOADER and LOADOPTS to refer to the loader and desired -# load options for your machine. +# Define LDFLAGS to the desired linker options for your machine. # -LOADER = gfortran -LOADOPTS = +LDFLAGS = # The archiver and the flag(s) to use when building an archive # (library). If your system has no ranlib, set RANLIB = echo. # -ARCH = ar -ARCHFLAGS = cr -RANLIB = ranlib +AR = ar +ARFLAGS = cr +RANLIB = ranlib # Timer for the SECOND and DSECND routines # @@ -78,8 +76,8 @@ TIMER = INT_ETIME # machine-specific, optimized BLAS library should be used whenever # possible.) # -BLASLIB = ../../librefblas.a -CBLASLIB = ../../libcblas.a -LAPACKLIB = liblapack.a -TMGLIB = libtmglib.a -LAPACKELIB = liblapacke.a +BLASLIB = $(TOPSRCDIR)/librefblas.a +CBLASLIB = $(TOPSRCDIR)/libcblas.a +LAPACKLIB = $(TOPSRCDIR)/liblapack.a +TMGLIB = $(TOPSRCDIR)/libtmglib.a +LAPACKELIB = $(TOPSRCDIR)/liblapacke.a diff --git a/lapack-netlib/meson.build b/lapack-netlib/meson.build new file mode 100644 index 000000000..b1e9c6bc1 --- /dev/null +++ b/lapack-netlib/meson.build @@ -0,0 +1,28 @@ +# cd build +# meson --buildtype release --prefix=$HOME/.local/lapack .. +# ninja +# ninja install + +project('LAPACK', 'fortran', + default_options : ['default_library=static', 'libdir=lib/'], + version : '3.8.0') + +subdir('BLAS/SRC') +subdir('SRC') + +prec = get_option('realkind') + + +if prec == 'd' + bsrc = DBLAS1 + DBLAS2 + DBLAS3 + lsrc = DZLAUX + DSLASRC +elif prec == 's' + bsrc = SBLAS1 + SBLAS2 + SBLAS3 + lsrc = SCLAUX + SLASRC +endif + +blas = library('blas', bsrc, + install : true) + +lapack = library('lapack', lsrc, ALLAUX, + install : true) diff --git a/lapack-netlib/meson_options.txt b/lapack-netlib/meson_options.txt new file mode 100644 index 000000000..b378e3329 --- /dev/null +++ b/lapack-netlib/meson_options.txt @@ -0,0 +1,3 @@ +option('realkind', type : 'string', value : 'd', + description : 's: real32 d: real64 c: complex32 z: complex64') +