From 92a858e69e469dea7ba9ac439659c53345f48222 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Martin=20K=C3=B6hler?= Date: Wed, 26 Oct 2016 15:12:09 +0200 Subject: [PATCH] Import LAPACK: SRC directory --- lapack-netlib/SRC/CMakeLists.txt | 8 +- lapack-netlib/SRC/Makefile | 8 +- lapack-netlib/SRC/cbbcsd.f | 22 +- lapack-netlib/SRC/cgbequb.f | 8 +- lapack-netlib/SRC/cgbrfsx.f | 4 +- lapack-netlib/SRC/cgeesx.f | 8 +- lapack-netlib/SRC/cgeev.f | 65 +- lapack-netlib/SRC/cgeevx.f | 72 +- lapack-netlib/SRC/cgejsv.f | 63 +- lapack-netlib/SRC/cgelss.f | 18 +- lapack-netlib/SRC/cgeqrt3.f | 8 +- lapack-netlib/SRC/cgesdd.f | 1054 +++++++++++++---------- lapack-netlib/SRC/cgesvd.f | 72 +- lapack-netlib/SRC/cgesvdx.f | 107 ++- lapack-netlib/SRC/cgesvj.f | 16 +- lapack-netlib/SRC/cgetc2.f | 6 +- lapack-netlib/SRC/cgetrf2.f | 8 +- lapack-netlib/SRC/cgges3.f | 4 +- lapack-netlib/SRC/cggev3.f | 2 +- lapack-netlib/SRC/cgghd3.f | 4 +- lapack-netlib/SRC/cggsvp3.f | 3 +- lapack-netlib/SRC/cgsvj0.f | 8 +- lapack-netlib/SRC/cgsvj1.f | 14 +- lapack-netlib/SRC/chbevx.f | 19 +- lapack-netlib/SRC/chbgvd.f | 8 +- lapack-netlib/SRC/chbgvx.f | 21 +- lapack-netlib/SRC/cheevr.f | 19 +- lapack-netlib/SRC/cheevx.f | 19 +- lapack-netlib/SRC/chegvx.f | 21 +- lapack-netlib/SRC/chetrf_rook.f | 10 +- lapack-netlib/SRC/chgeqz.f | 10 +- lapack-netlib/SRC/chpevx.f | 19 +- lapack-netlib/SRC/chpgvx.f | 21 +- lapack-netlib/SRC/cla_gbamv.f | 10 +- lapack-netlib/SRC/cla_herpvgrw.f | 8 +- lapack-netlib/SRC/cla_lin_berr.f | 10 +- lapack-netlib/SRC/cla_porcond_c.f | 8 +- lapack-netlib/SRC/cla_porpvgrw.f | 8 +- lapack-netlib/SRC/claed7.f | 8 +- lapack-netlib/SRC/claqr3.f | 8 +- lapack-netlib/SRC/claqr5.f | 10 +- lapack-netlib/SRC/clarcm.f | 8 +- lapack-netlib/SRC/clarrv.f | 15 +- lapack-netlib/SRC/clarscl2.f | 8 +- lapack-netlib/SRC/clascl.f | 12 +- lapack-netlib/SRC/clascl2.f | 8 +- lapack-netlib/SRC/clatdf.f | 12 +- lapack-netlib/SRC/cpotrf2.f | 8 +- lapack-netlib/SRC/cpttrs.f | 8 +- lapack-netlib/SRC/cptts2.f | 8 +- lapack-netlib/SRC/cstegr.f | 23 +- lapack-netlib/SRC/cstemr.f | 21 +- lapack-netlib/SRC/csytrf_rook.f | 10 +- lapack-netlib/SRC/ctgsen.f | 8 +- lapack-netlib/SRC/ctrevc3.f | 630 ++++++++++++++ lapack-netlib/SRC/ctrttf.f | 8 +- lapack-netlib/SRC/cunbdb1.f | 7 +- lapack-netlib/SRC/cunbdb2.f | 6 +- lapack-netlib/SRC/cunbdb3.f | 6 +- lapack-netlib/SRC/cunbdb4.f | 7 +- lapack-netlib/SRC/cuncsd.f | 12 +- lapack-netlib/SRC/cuncsd2by1.f | 188 +++-- lapack-netlib/SRC/dbbcsd.f | 22 +- lapack-netlib/SRC/dbdsdc.f | 27 +- lapack-netlib/SRC/dbdsvdx.f | 44 +- lapack-netlib/SRC/dgbrfsx.f | 4 +- lapack-netlib/SRC/dgeesx.f | 8 +- lapack-netlib/SRC/dgeev.f | 41 +- lapack-netlib/SRC/dgeevx.f | 41 +- lapack-netlib/SRC/dgejsv.f | 24 +- lapack-netlib/SRC/dgeqrt3.f | 8 +- lapack-netlib/SRC/dgesdd.f | 727 +++++++++------- lapack-netlib/SRC/dgesvd.f | 639 +++++++------- lapack-netlib/SRC/dgesvdx.f | 94 ++- lapack-netlib/SRC/dgetc2.f | 6 +- lapack-netlib/SRC/dgetrf2.f | 8 +- lapack-netlib/SRC/dgghd3.f | 4 +- lapack-netlib/SRC/dgsvj1.f | 8 +- lapack-netlib/SRC/dhgeqz.f | 14 +- lapack-netlib/SRC/dlaed1.f | 8 +- lapack-netlib/SRC/dlaed7.f | 8 +- lapack-netlib/SRC/dlag2.f | 14 +- lapack-netlib/SRC/dlamrg.f | 8 +- lapack-netlib/SRC/dlaqr3.f | 8 +- lapack-netlib/SRC/dlaqr5.f | 10 +- lapack-netlib/SRC/dlarrc.f | 9 +- lapack-netlib/SRC/dlarrd.f | 20 +- lapack-netlib/SRC/dlarre.f | 22 +- lapack-netlib/SRC/dlarrf.f | 8 +- lapack-netlib/SRC/dlarrv.f | 15 +- lapack-netlib/SRC/dlarscl2.f | 8 +- lapack-netlib/SRC/dlascl.f | 12 +- lapack-netlib/SRC/dlascl2.f | 8 +- lapack-netlib/SRC/dlasd1.f | 10 +- lapack-netlib/SRC/dlasd6.f | 21 +- lapack-netlib/SRC/dlasdq.f | 8 +- lapack-netlib/SRC/dlasq3.f | 8 +- lapack-netlib/SRC/dlasq4.f | 10 +- lapack-netlib/SRC/dlasrt.f | 8 +- lapack-netlib/SRC/dlasy2.f | 12 +- lapack-netlib/SRC/dlatdf.f | 8 +- lapack-netlib/SRC/dorbdb1.f | 7 +- lapack-netlib/SRC/dorbdb2.f | 6 +- lapack-netlib/SRC/dorbdb3.f | 6 +- lapack-netlib/SRC/dorbdb4.f | 7 +- lapack-netlib/SRC/dorcsd2by1.f | 205 +++-- lapack-netlib/SRC/dsbevx.f | 19 +- lapack-netlib/SRC/dsbgvd.f | 8 +- lapack-netlib/SRC/dsbgvx.f | 21 +- lapack-netlib/SRC/dsgesv.f | 8 +- lapack-netlib/SRC/dspevx.f | 19 +- lapack-netlib/SRC/dspgvx.f | 21 +- lapack-netlib/SRC/dsposv.f | 8 +- lapack-netlib/SRC/dstebz.f | 22 +- lapack-netlib/SRC/dstegr.f | 23 +- lapack-netlib/SRC/dstemr.f | 21 +- lapack-netlib/SRC/dstevr.f | 19 +- lapack-netlib/SRC/dstevx.f | 19 +- lapack-netlib/SRC/dsyevr.f | 19 +- lapack-netlib/SRC/dsyevx.f | 19 +- lapack-netlib/SRC/dsygvx.f | 19 +- lapack-netlib/SRC/dsytrf_rook.f | 4 +- lapack-netlib/SRC/dsytrs2.f | 8 +- lapack-netlib/SRC/dtgsen.f | 8 +- lapack-netlib/SRC/dtrevc3.f | 1303 +++++++++++++++++++++++++++++ lapack-netlib/SRC/ilaenv.f | 12 +- lapack-netlib/SRC/ilaver.f | 14 +- lapack-netlib/SRC/sbbcsd.f | 22 +- lapack-netlib/SRC/sbdsdc.f | 13 +- lapack-netlib/SRC/sbdsvdx.f | 44 +- lapack-netlib/SRC/sgbequb.f | 8 +- lapack-netlib/SRC/sgbrfsx.f | 8 +- lapack-netlib/SRC/sgeesx.f | 8 +- lapack-netlib/SRC/sgeev.f | 57 +- lapack-netlib/SRC/sgeevx.f | 64 +- lapack-netlib/SRC/sgejsv.f | 20 +- lapack-netlib/SRC/sgeqrt3.f | 8 +- lapack-netlib/SRC/sgesdd.f | 736 +++++++++------- lapack-netlib/SRC/sgesvd.f | 67 +- lapack-netlib/SRC/sgesvdx.f | 94 ++- lapack-netlib/SRC/sgetc2.f | 6 +- lapack-netlib/SRC/sgetrf2.f | 8 +- lapack-netlib/SRC/sgghd3.f | 4 +- lapack-netlib/SRC/sggsvp3.f | 4 +- lapack-netlib/SRC/shgeqz.f | 14 +- lapack-netlib/SRC/slaed1.f | 8 +- lapack-netlib/SRC/slaed7.f | 8 +- lapack-netlib/SRC/slag2.f | 14 +- lapack-netlib/SRC/slamrg.f | 8 +- lapack-netlib/SRC/slaqr3.f | 8 +- lapack-netlib/SRC/slaqr5.f | 10 +- lapack-netlib/SRC/slarrc.f | 17 +- lapack-netlib/SRC/slarrd.f | 20 +- lapack-netlib/SRC/slarre.f | 22 +- lapack-netlib/SRC/slarrf.f | 8 +- lapack-netlib/SRC/slarrv.f | 15 +- lapack-netlib/SRC/slarscl2.f | 8 +- lapack-netlib/SRC/slascl.f | 12 +- lapack-netlib/SRC/slascl2.f | 8 +- lapack-netlib/SRC/slasd1.f | 10 +- lapack-netlib/SRC/slasd6.f | 21 +- lapack-netlib/SRC/slasdq.f | 8 +- lapack-netlib/SRC/slasq3.f | 8 +- lapack-netlib/SRC/slasq4.f | 8 +- lapack-netlib/SRC/slasrt.f | 8 +- lapack-netlib/SRC/slasy2.f | 12 +- lapack-netlib/SRC/slatdf.f | 8 +- lapack-netlib/SRC/sorbdb1.f | 7 +- lapack-netlib/SRC/sorbdb2.f | 6 +- lapack-netlib/SRC/sorbdb3.f | 6 +- lapack-netlib/SRC/sorbdb4.f | 7 +- lapack-netlib/SRC/sorcsd2by1.f | 189 +++-- lapack-netlib/SRC/ssbevx.f | 19 +- lapack-netlib/SRC/ssbgvd.f | 8 +- lapack-netlib/SRC/ssbgvx.f | 21 +- lapack-netlib/SRC/sspevx.f | 19 +- lapack-netlib/SRC/sspgvx.f | 21 +- lapack-netlib/SRC/sstebz.f | 22 +- lapack-netlib/SRC/sstegr.f | 23 +- lapack-netlib/SRC/sstemr.f | 21 +- lapack-netlib/SRC/sstevr.f | 19 +- lapack-netlib/SRC/sstevx.f | 19 +- lapack-netlib/SRC/ssyevr.f | 19 +- lapack-netlib/SRC/ssyevx.f | 19 +- lapack-netlib/SRC/ssygvx.f | 19 +- lapack-netlib/SRC/ssytrf_rook.f | 10 +- lapack-netlib/SRC/stgsen.f | 8 +- lapack-netlib/SRC/strevc3.f | 1303 +++++++++++++++++++++++++++++ lapack-netlib/SRC/zbbcsd.f | 22 +- lapack-netlib/SRC/zcgesv.f | 8 +- lapack-netlib/SRC/zcposv.f | 8 +- lapack-netlib/SRC/zgbequb.f | 8 +- lapack-netlib/SRC/zgbrfsx.f | 8 +- lapack-netlib/SRC/zgeesx.f | 8 +- lapack-netlib/SRC/zgeev.f | 48 +- lapack-netlib/SRC/zgeevx.f | 48 +- lapack-netlib/SRC/zgejsv.f | 176 ++-- lapack-netlib/SRC/zgelss.f | 18 +- lapack-netlib/SRC/zgeqrt3.f | 8 +- lapack-netlib/SRC/zgesdd.f | 1051 +++++++++++++---------- lapack-netlib/SRC/zgesvd.f | 72 +- lapack-netlib/SRC/zgesvdx.f | 154 ++-- lapack-netlib/SRC/zgesvj.f | 44 +- lapack-netlib/SRC/zgetc2.f | 6 +- lapack-netlib/SRC/zgetrf2.f | 8 +- lapack-netlib/SRC/zggbal.f | 8 +- lapack-netlib/SRC/zgges3.f | 6 +- lapack-netlib/SRC/zggev3.f | 2 +- lapack-netlib/SRC/zgghd3.f | 4 +- lapack-netlib/SRC/zggsvd3.f | 4 +- lapack-netlib/SRC/zggsvp3.f | 3 +- lapack-netlib/SRC/zgsvj0.f | 14 +- lapack-netlib/SRC/zgsvj1.f | 24 +- lapack-netlib/SRC/zhbevx.f | 19 +- lapack-netlib/SRC/zhbgvd.f | 8 +- lapack-netlib/SRC/zhbgvx.f | 21 +- lapack-netlib/SRC/zheevr.f | 19 +- lapack-netlib/SRC/zheevx.f | 19 +- lapack-netlib/SRC/zhegvx.f | 21 +- lapack-netlib/SRC/zhetrf_rook.f | 10 +- lapack-netlib/SRC/zhetrs2.f | 8 +- lapack-netlib/SRC/zhgeqz.f | 10 +- lapack-netlib/SRC/zhpevx.f | 19 +- lapack-netlib/SRC/zhpgvx.f | 21 +- lapack-netlib/SRC/zla_gerpvgrw.f | 10 +- lapack-netlib/SRC/zla_herpvgrw.f | 8 +- lapack-netlib/SRC/zla_lin_berr.f | 10 +- lapack-netlib/SRC/zla_porpvgrw.f | 8 +- lapack-netlib/SRC/zlaed7.f | 8 +- lapack-netlib/SRC/zlaqr3.f | 8 +- lapack-netlib/SRC/zlaqr5.f | 10 +- lapack-netlib/SRC/zlarcm.f | 8 +- lapack-netlib/SRC/zlarft.f | 8 +- lapack-netlib/SRC/zlarrv.f | 15 +- lapack-netlib/SRC/zlarscl2.f | 8 +- lapack-netlib/SRC/zlascl.f | 12 +- lapack-netlib/SRC/zlascl2.f | 8 +- lapack-netlib/SRC/zlatdf.f | 12 +- lapack-netlib/SRC/zpbrfs.f | 8 +- lapack-netlib/SRC/zpftrf.f | 8 +- lapack-netlib/SRC/zpttrs.f | 8 +- lapack-netlib/SRC/zptts2.f | 8 +- lapack-netlib/SRC/zstegr.f | 23 +- lapack-netlib/SRC/zstemr.f | 21 +- lapack-netlib/SRC/zsytrf_rook.f | 10 +- lapack-netlib/SRC/zsytrs2.f | 8 +- lapack-netlib/SRC/ztgsen.f | 8 +- lapack-netlib/SRC/ztrevc3.f | 630 ++++++++++++++ lapack-netlib/SRC/zunbdb1.f | 7 +- lapack-netlib/SRC/zunbdb2.f | 6 +- lapack-netlib/SRC/zunbdb3.f | 6 +- lapack-netlib/SRC/zunbdb4.f | 7 +- lapack-netlib/SRC/zuncsd2by1.f | 183 ++-- 253 files changed, 9073 insertions(+), 3794 deletions(-) create mode 100644 lapack-netlib/SRC/ctrevc3.f create mode 100644 lapack-netlib/SRC/dtrevc3.f create mode 100644 lapack-netlib/SRC/strevc3.f create mode 100644 lapack-netlib/SRC/ztrevc3.f diff --git a/lapack-netlib/SRC/CMakeLists.txt b/lapack-netlib/SRC/CMakeLists.txt index 03441b94..4857f474 100644 --- a/lapack-netlib/SRC/CMakeLists.txt +++ b/lapack-netlib/SRC/CMakeLists.txt @@ -141,7 +141,7 @@ set(SLASRC 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 strexc.f strrfs.f strsen.f strsna.f strsyl.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 @@ -221,7 +221,7 @@ set(CLASRC ctbcon.f ctbrfs.f ctbtrs.f ctgevc.f ctgex2.f ctgexc.f ctgsen.f ctgsja.f ctgsna.f ctgsy2.f ctgsyl.f ctpcon.f ctprfs.f ctptri.f - ctptrs.f ctrcon.f ctrevc.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f + 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 @@ -302,7 +302,7 @@ set(DLASRC dtbrfs.f dtbtrs.f dtgevc.f dtgex2.f dtgexc.f dtgsen.f dtgsja.f dtgsna.f dtgsy2.f dtgsyl.f dtpcon.f dtprfs.f dtptri.f dtptrs.f - dtrcon.f dtrevc.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f + dtrcon.f dtrevc.f dtrevc3.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f dtrti2.f dtrtri.f dtrtrs.f dtzrzf.f dstemr.f dsgesv.f dsposv.f dlag2s.f slag2d.f dlat2s.f dlansf.f dpftrf.f dpftri.f dpftrs.f dsfrk.f dtfsm.f dtftri.f dtfttp.f @@ -383,7 +383,7 @@ set(ZLASRC ztbcon.f ztbrfs.f ztbtrs.f ztgevc.f ztgex2.f ztgexc.f ztgsen.f ztgsja.f ztgsna.f ztgsy2.f ztgsyl.f ztpcon.f ztprfs.f ztptri.f - ztptrs.f ztrcon.f ztrevc.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f + 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 diff --git a/lapack-netlib/SRC/Makefile b/lapack-netlib/SRC/Makefile index 22799769..bb2d9562 100644 --- a/lapack-netlib/SRC/Makefile +++ b/lapack-netlib/SRC/Makefile @@ -150,7 +150,7 @@ SLASRC = \ stbrfs.o stbtrs.o stgevc.o stgex2.o stgexc.o stgsen.o \ stgsja.o stgsna.o stgsy2.o stgsyl.o stpcon.o stprfs.o stptri.o \ stptrs.o \ - strcon.o strevc.o strexc.o strrfs.o strsen.o strsna.o strsyl.o \ + strcon.o strevc.o strevc3.o strexc.o strrfs.o strsen.o strsna.o strsyl.o \ strtrs.o stzrzf.o sstemr.o \ slansf.o spftrf.o spftri.o spftrs.o ssfrk.o stfsm.o stftri.o stfttp.o \ stfttr.o stpttf.o stpttr.o strttf.o strttp.o \ @@ -231,7 +231,7 @@ CLASRC = \ ctbcon.o ctbrfs.o ctbtrs.o ctgevc.o ctgex2.o \ ctgexc.o ctgsen.o ctgsja.o ctgsna.o ctgsy2.o ctgsyl.o ctpcon.o \ ctprfs.o ctptri.o \ - ctptrs.o ctrcon.o ctrevc.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o \ + ctptrs.o ctrcon.o ctrevc.o ctrevc3.o ctrexc.o ctrrfs.o ctrsen.o ctrsna.o \ ctrsyl.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 \ @@ -316,7 +316,7 @@ DLASRC = \ dtbcon.o dtbrfs.o dtbtrs.o dtgevc.o dtgex2.o dtgexc.o dtgsen.o \ dtgsja.o dtgsna.o dtgsy2.o dtgsyl.o dtpcon.o dtprfs.o dtptri.o \ dtptrs.o \ - dtrcon.o dtrevc.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o \ + dtrcon.o dtrevc.o dtrevc3.o dtrexc.o dtrrfs.o dtrsen.o dtrsna.o dtrsyl.o \ dtrtrs.o dtzrzf.o dstemr.o \ dsgesv.o dsposv.o dlag2s.o slag2d.o dlat2s.o \ dlansf.o dpftrf.o dpftri.o dpftrs.o dsfrk.o dtfsm.o dtftri.o dtfttp.o \ @@ -400,7 +400,7 @@ ZLASRC = \ ztbcon.o ztbrfs.o ztbtrs.o ztgevc.o ztgex2.o \ ztgexc.o ztgsen.o ztgsja.o ztgsna.o ztgsy2.o ztgsyl.o ztpcon.o \ ztprfs.o ztptri.o \ - ztptrs.o ztrcon.o ztrevc.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o \ + ztptrs.o ztrcon.o ztrevc.o ztrevc3.o ztrexc.o ztrrfs.o ztrsen.o ztrsna.o \ ztrsyl.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 \ diff --git a/lapack-netlib/SRC/cbbcsd.f b/lapack-netlib/SRC/cbbcsd.f index 2d619cde..a2d1a133 100644 --- a/lapack-netlib/SRC/cbbcsd.f +++ b/lapack-netlib/SRC/cbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is COMPLEX array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is COMPLEX array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is COMPLEX array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the conjugate transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is COMPLEX array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the conjugate transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/cgbequb.f b/lapack-netlib/SRC/cgbequb.f index 0e2875fe..f93413be 100644 --- a/lapack-netlib/SRC/cgbequb.f +++ b/lapack-netlib/SRC/cgbequb.f @@ -84,7 +84,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -153,7 +153,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGBcomputational * @@ -161,10 +161,10 @@ SUBROUTINE CGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/cgbrfsx.f b/lapack-netlib/SRC/cgbrfsx.f index fc734969..31caebe6 100644 --- a/lapack-netlib/SRC/cgbrfsx.f +++ b/lapack-netlib/SRC/cgbrfsx.f @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -642,7 +642,7 @@ * * Perform refinement on each right-hand side * - IF ( REF_TYPE .NE. 0 ) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'D' ) diff --git a/lapack-netlib/SRC/cgeesx.f b/lapack-netlib/SRC/cgeesx.f index 81157717..4d3c459a 100644 --- a/lapack-netlib/SRC/cgeesx.f +++ b/lapack-netlib/SRC/cgeesx.f @@ -83,7 +83,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of one COMPLEX argument +*> SELECT is a LOGICAL FUNCTION of one COMPLEX argument *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to order *> to the top left of the Schur form. @@ -230,7 +230,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGEeigen * @@ -239,10 +239,10 @@ $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/cgeev.f b/lapack-netlib/SRC/cgeev.f index 0f48322a..7d19c022 100644 --- a/lapack-netlib/SRC/cgeev.f +++ b/lapack-netlib/SRC/cgeev.f @@ -26,8 +26,8 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL RWORK( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL RWORK( * ) +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -169,59 +169,62 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @generated from zgeev.f, fortran z -> c, Tue Apr 19 01:47:44 2016 * *> \ingroup complexGEeigen * * ===================================================================== SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, $ WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL RWORK( * ) + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, - $ IWRK, K, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC, CUNGHR, SLABAD, XERBLA + EXTERNAL SLABAD, XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, + $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -244,7 +247,6 @@ ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN INFO = -10 END IF - * * Compute workspace * (Note: Comments in the code beginning "Workspace:" describe the @@ -267,18 +269,28 @@ IF( WANTVL ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL CTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'CUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL CTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE CALL CHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, HSWORK, MINWRK ) END IF WORK( 1 ) = MAXWRK @@ -413,12 +425,13 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL CTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR ) + CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK( IRWORK ), N, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/cgeevx.f b/lapack-netlib/SRC/cgeevx.f index 539a7b95..7ad229e7 100644 --- a/lapack-netlib/SRC/cgeevx.f +++ b/lapack-netlib/SRC/cgeevx.f @@ -25,12 +25,12 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. -* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), +* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), * $ SCALE( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -134,7 +134,7 @@ *> A is COMPLEX array, dimension (LDA,N) *> On entry, the N-by-N matrix A. *> On exit, A has been overwritten. If JOBVL = 'V' or -*> JOBVR = 'V', A contains the Schur form of the balanced +*> JOBVR = 'V', A contains the Schur form of the balanced *> version of the matrix A. *> \endverbatim *> @@ -276,7 +276,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @generated from zgeevx.f, fortran z -> c, Tue Apr 19 01:47:44 2016 * *> \ingroup complexGEeigen * @@ -284,56 +286,57 @@ SUBROUTINE CGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, $ RCONDV, WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. - REAL RCONDE( * ), RCONDV( * ), RWORK( * ), + REAL RCONDE( * ), RCONDV( * ), RWORK( * ), $ SCALE( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC, CTRSNA, CUNGHR, SLABAD, - $ SLASCL, XERBLA + EXTERNAL SLABAD, SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, + $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, + $ CTRSNA, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -387,9 +390,19 @@ MAXWRK = N + N*ILAENV( 1, 'CGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL CTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL CTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL CHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -401,7 +414,7 @@ $ WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -559,19 +572,20 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from CHSEQR, then quit +* If INFO .NE. 0 from CHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL CTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK, IERR ) + CALL CTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK, N, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/cgejsv.f b/lapack-netlib/SRC/cgejsv.f index 4b3e9056..bee18fdf 100644 --- a/lapack-netlib/SRC/cgejsv.f +++ b/lapack-netlib/SRC/cgejsv.f @@ -39,18 +39,19 @@ *> *> \verbatim *> -*> CGEJSV computes the singular value decomposition (SVD) of a real M-by-N +*> CGEJSV computes the singular value decomposition (SVD) of a complex M-by-N *> matrix [A], where M >= N. The SVD of [A] is written as *> *> [A] = [U] * [SIGMA] * [V]^*, *> *> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -*> diagonal elements, [U] is an M-by-N (or M-by-M) orthonormal matrix, and -*> [V] is an N-by-N orthogonal matrix. The diagonal elements of [SIGMA] are +*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary 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. The matrices [U] and [V] *> are computed and stored in the arrays U and V, respectively. The diagonal *> of [SIGMA] is computed and stored in the array SVA. +*> \endverbatim *> *> Arguments: *> ========== @@ -221,7 +222,7 @@ *> *> \param[out] U *> \verbatim -*> U is COMPLEX array, dimension ( LDU, N ) +*> U is COMPLEX array, dimension ( LDU, N ) or ( LDU, M ) *> If JOBU = 'U', then U contains on exit the M-by-N matrix of *> the left singular vectors. *> If JOBU = 'F', then U contains on exit the M-by-M matrix of @@ -234,7 +235,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -256,7 +257,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -278,7 +279,7 @@ *> LWORK depends on the job: *> *> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBE.EQ.'N'): +*> 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 *> is LWORK >= N + (N+1)*NB. Here NB is the optimal @@ -298,7 +299,7 @@ *> (JOBU.EQ.'N') *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, LWORK >= max(N+(N+1)*NB, 3*N,2*N+N*NB), -*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQ, +*> where NB is the optimal block size for CGEQP3, CGEQRF, CGELQF, *> CUNMLQ. In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(CGEQP3), N+LWORK(CPOCON), N+LWORK(CGESVJ), *> N+LWORK(CGELQF), 2*N+LWORK(CGEQRF), N+LWORK(CUNMLQ)). @@ -317,8 +318,8 @@ *> the minimal requirement is LWORK >= 5*N+2*N*N. *> 4.2. if JOBV.EQ.'J' the minimal requirement is *> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accomodate blocked runs -*> of CGEQP3, CGEQRF, CGELQF, SUNMQR, CUNMLQ. +*> In both cases, the allocated CWORK can accommodate blocked runs +*> of CGEQP3, CGEQRF, CGELQF, CUNMQR, CUNMLQ. *> \endverbatim *> *> \param[out] RWORK @@ -432,7 +433,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -498,7 +499,7 @@ *> LAPACK Working note 170. *> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR *> factorization software - a case study. -*> ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. *> LAPACK Working note 176. *> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, *> QSVD, (H,K)-SVD computations. @@ -516,10 +517,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -556,13 +557,13 @@ * .. * .. External Functions .. REAL SLAMCH, SCNRM2 - INTEGER ISAMAX + INTEGER ISAMAX, ICAMAX LOGICAL LSAME - EXTERNAL ISAMAX, LSAME, SLAMCH, SCNRM2 + EXTERNAL ISAMAX, ICAMAX, LSAME, SLAMCH, SCNRM2 * .. * .. External Subroutines .. EXTERNAL CCOPY, CGELQF, CGEQP3, CGEQRF, CLACPY, CLASCL, - $ CLASET, CLASSQ, CLASWP, CUNGQR, CUNMLQ, + $ SLASCL, CLASET, CLASSQ, SLASSQ, CLASWP, CUNGQR, CUNMLQ, $ CUNMQR, CPOCON, SSCAL, CSSCAL, CSWAP, CTRSM, XERBLA * EXTERNAL CGESVJ @@ -636,7 +637,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + RWORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -803,7 +808,7 @@ 1950 CONTINUE ELSE DO 1904 p = 1, M - RWORK(M+N+p) = SCALEM*ABS( A(p,ISAMAX(N,A(p,1),LDA)) ) + RWORK(M+N+p) = SCALEM*ABS( A(p,ICAMAX(N,A(p,1),LDA)) ) AATMAX = AMAX1( AATMAX, RWORK(M+N+p) ) AATMIN = AMIN1( AATMIN, RWORK(M+N+p) ) 1904 CONTINUE @@ -824,7 +829,7 @@ * XSC = ZERO TEMP1 = ONE - CALL CLASSQ( N, SVA, 1, XSC, TEMP1 ) + CALL SLASSQ( N, SVA, 1, XSC, TEMP1 ) TEMP1 = ONE / TEMP1 * ENTRA = ZERO @@ -903,7 +908,7 @@ BIG1 = SQRT( BIG ) TEMP1 = SQRT( BIG / FLOAT(N) ) * - CALL CLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) + CALL SLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN AAQQ = ( AAQQ / AAPP ) * TEMP1 ELSE @@ -1221,7 +1226,7 @@ CALL CCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) CALL CLACGV( NR-p+1, V(p,p), 1 ) 8998 CONTINUE - CALL CLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL CLASET('Upper', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) * CALL CGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) @@ -1517,9 +1522,9 @@ CALL CTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), $ N,V,LDV) IF ( NR .LT. N ) THEN - CALL CLASET('A',N-NR,NR,ZERO,CZERO,V(NR+1,1),LDV) - CALL CLASET('A',NR,N-NR,ZERO,CZERO,V(1,NR+1),LDV) - CALL CLASET('A',N-NR,N-NR,ZERO,CONE,V(NR+1,NR+1),LDV) + 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) END IF CALL CUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1775,9 +1780,9 @@ NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - CALL CLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL CLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL CLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + 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 ) END IF CALL CUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), @@ -1832,7 +1837,7 @@ * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL CLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) + CALL SLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) USCAL1 = ONE USCAL2 = ONE END IF diff --git a/lapack-netlib/SRC/cgelss.f b/lapack-netlib/SRC/cgelss.f index 2d090535..6cb4026a 100644 --- a/lapack-netlib/SRC/cgelss.f +++ b/lapack-netlib/SRC/cgelss.f @@ -170,7 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexGEsolve * @@ -178,10 +178,10 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK @@ -285,8 +285,8 @@ * Path 1 - overdetermined or exactly determined * * Compute space needed for CGEBRD - CALL CGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + $ -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), @@ -315,8 +315,8 @@ $ -1, INFO ) LWORK_CGELQF=DUM(1) * Compute space needed for CGEBRD - CALL CGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, @@ -346,8 +346,8 @@ * Path 2 - underdetermined * * Compute space needed for CGEBRD - CALL CGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL CGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_CGEBRD=DUM(1) * Compute space needed for CUNMBR CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA, diff --git a/lapack-netlib/SRC/cgeqrt3.f b/lapack-netlib/SRC/cgeqrt3.f index a5b55c1d..9bcb82d7 100644 --- a/lapack-netlib/SRC/cgeqrt3.f +++ b/lapack-netlib/SRC/cgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE CGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL CLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL CLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/cgesdd.f b/lapack-netlib/SRC/cgesdd.f index 7f16b63b..986619c6 100644 --- a/lapack-netlib/SRC/cgesdd.f +++ b/lapack-netlib/SRC/cgesdd.f @@ -135,8 +135,8 @@ *> \param[in] LDU *> \verbatim *> LDU is INTEGER -*> The leading dimension of the array U. LDU >= 1; if -*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. +*> The leading dimension of the array U. LDU >= 1; +*> if JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. *> \endverbatim *> *> \param[out] VT @@ -152,8 +152,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -167,24 +167,28 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> if JOBZ = 'N', LWORK >= 2*min(M,N)+max(M,N). -*> if JOBZ = 'O', -*> LWORK >= 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> if JOBZ = 'S' or 'A', -*> LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> For good performance, LWORK should generally be larger. -*> *> If LWORK = -1, a workspace query is assumed. The optimal *> size for the WORK array is calculated and stored in WORK(1), *> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 2*mn + mx. +*> If JOBZ = 'O', LWORK >= 2*mn*mn + 2*mn + mx. +*> If JOBZ = 'S', LWORK >= mn*mn + 3*mn. +*> If JOBZ = 'A', LWORK >= mn*mn + 2*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is REAL array, dimension (MAX(1,LRWORK)) -*> If JOBZ = 'N', LRWORK >= 7*min(M,N). -*> Otherwise, -*> LRWORK >= min(M,N)*max(5*min(M,N)+7,2*max(M,N)+2*min(M,N)+1) +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LRWORK >= 5*mn (LAPACK <= 3.6 needs 7*mn); +*> else if mx >> mn, LRWORK >= 5*mn*mn + 5*mn; +*> else LRWORK >= max( 5*mn*mn + 5*mn, +*> 2*mx*mn + 2*mn*mn + mn ). *> \endverbatim *> *> \param[out] IWORK @@ -208,7 +212,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -221,11 +225,12 @@ * ===================================================================== SUBROUTINE CGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, RWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -241,8 +246,6 @@ * ===================================================================== * * .. Parameters .. - INTEGER LQUERV - PARAMETER ( LQUERV = -1 ) COMPLEX CZERO, CONE PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), $ CONE = ( 1.0E+0, 0.0E+0 ) ) @@ -250,16 +253,27 @@ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) * .. * .. Local Scalars .. - LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS + LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT, $ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR1, MNTHR2, NRWORK, NWORK, WRKBL - REAL ANRM, BIGNUM, EPS, SMLNUM + INTEGER LWORK_CGEBRD_MN, LWORK_CGEBRD_MM, + $ LWORK_CGEBRD_NN, LWORK_CGELQF_MN, + $ LWORK_CGEQRF_MN, + $ LWORK_CUNGBR_P_MN, LWORK_CUNGBR_P_NN, + $ LWORK_CUNGBR_Q_MN, LWORK_CUNGBR_Q_MM, + $ LWORK_CUNGLQ_MN, LWORK_CUNGLQ_NN, + $ LWORK_CUNGQR_MM, LWORK_CUNGQR_MN, + $ LWORK_CUNMBR_PRC_MM, LWORK_CUNMBR_QLN_MM, + $ LWORK_CUNMBR_PRC_MN, LWORK_CUNMBR_QLN_MN, + $ LWORK_CUNMBR_PRC_NN, LWORK_CUNMBR_QLN_NN + REAL ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) REAL DUM( 1 ) + COMPLEX CDUM( 1 ) * .. * .. External Subroutines .. EXTERNAL CGEBRD, CGELQF, CGEMM, CGEQRF, CLACP2, CLACPY, @@ -268,9 +282,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV - REAL CLANGE, SLAMCH - EXTERNAL CLANGE, SLAMCH, ILAENV, LSAME + REAL SLAMCH, CLANGE + EXTERNAL LSAME, SLAMCH, CLANGE * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -279,15 +292,16 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - MNTHR1 = INT( MINMN*17.0 / 9.0 ) - MNTHR2 = INT( MINMN*5.0 / 3.0 ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + MNTHR1 = INT( MINMN*17.0E0 / 9.0E0 ) + MNTHR2 = INT( MINMN*5.0E0 / 3.0E0 ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) MINWRK = 1 MAXWRK = 1 * @@ -309,8 +323,8 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * CWorkspace refers to complex workspace, and RWorkspace to * real workspace. NB refers to the optimal block size for the @@ -320,233 +334,283 @@ IF( M.GE.N ) THEN * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*N*N + 7*N -* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (sbdsdc) is +* BDSPAC = 3*N*N + 4*N for singular values and vectors; +* BDSPAC = 4*N for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL CGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MN = INT( CDUM(1) ) +* + CALL CGEBRD( N, N, CDUM(1), N, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_NN = INT( CDUM(1) ) +* + CALL CGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEQRF_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', N, N, N, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_NN = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MN = INT( CDUM(1) ) +* + CALL CUNGQR( M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGQR_MM = INT( CDUM(1) ) +* + CALL CUNGQR( M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGQR_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, M, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MM = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, N, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_NN = INT( CDUM(1) ) * IF( M.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - MAXWRK = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) + MAXWRK = N + LWORK_CGEQRF_MN + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CGEBRD_NN ) MINWRK = 3*N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') -* - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'CUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 2 (M >> N, JOBZ='O') +* + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = M*N + N*N + WRKBL MINWRK = 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') -* - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'CUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 3 (M >> N, JOBZ='S') +* + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL MINWRK = N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') -* - WRKBL = N + N*ILAENV( 1, 'CGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'CUNGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'CGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 4 (M >> N, JOBZ='A') +* + WRKBL = N + LWORK_CGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_CUNGQR_MM ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_CUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL - MINWRK = N*N + 2*N + M + MINWRK = N*N + MAX( 3*N, N + M ) END IF ELSE IF( M.GE.MNTHR2 ) THEN * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_CGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5o (M >> N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5s (M >> N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5a (M >> N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNGBR_Q_MM ) END IF ELSE * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_CGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6o (M >= N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6s (M >= N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'CUNGBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6a (M >= N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR_PRC_NN ) END IF END IF ELSE * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*M*M + 7*M -* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (sbdsdc) is +* BDSPAC = 3*M*M + 4*M for singular values and vectors; +* BDSPAC = 4*M for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL CGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MN = INT( CDUM(1) ) +* + CALL CGEBRD( M, M, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGEBRD_MM = INT( CDUM(1) ) +* + CALL CGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_CGELQF_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_MN = INT( CDUM(1) ) +* + CALL CUNGBR( 'P', N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_P_NN = INT( CDUM(1) ) +* + CALL CUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL CUNGLQ( M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGLQ_MN = INT( CDUM(1) ) +* + CALL CUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_CUNGLQ_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_MM = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', M, N, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_MN = INT( CDUM(1) ) +* + CALL CUNMBR( 'P', 'R', 'C', N, N, M, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_CUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL CUNMBR( 'Q', 'L', 'N', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_CUNMBR_QLN_MM = INT( CDUM(1) ) * IF( N.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - MAXWRK = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) + MAXWRK = M + LWORK_CGELQF_MN + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CGEBRD_MM ) MINWRK = 3*M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') -* - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'CUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 2t (N >> M, JOBZ='O') +* + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*N + M*M + WRKBL MINWRK = 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'CUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 3t (N >> M, JOBZ='S') +* + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL MINWRK = M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') -* - WRKBL = M + M*ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'CUNGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 4t (N >> M, JOBZ='A') +* + WRKBL = M + LWORK_CGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_CUNGLQ_NN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_CUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL - MINWRK = M*M + 2*M + N + MINWRK = M*M + MAX( 3*M, M + N ) END IF ELSE IF( N.GE.MNTHR2 ) THEN * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_CGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5to (N >> M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ts (N >> M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'CUNGBR', 'P', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ta (N >> M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR_P_NN ) END IF ELSE * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'CGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_CGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNMBR', 'QLN', M, M, N, -1 ) ) +* Path 6to (N > M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ts (N > M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'CUNGBR', 'PRC', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'CUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ta (N > M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR_PRC_NN ) END IF END IF END IF @@ -554,18 +618,20 @@ END IF IF( INFO.EQ.0 ) THEN WORK( 1 ) = MAXWRK - IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV ) - $ INFO = -13 + IF( LWORK.LT.MINWRK .AND. .NOT. LQUERY ) THEN + INFO = -12 + END IF END IF -* -* Quick returns * IF( INFO.NE.0 ) THEN CALL XERBLA( 'CGESDD', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF - IF( LWORK.EQ.LQUERV ) - $ RETURN +* +* Quick return if possible +* IF( M.EQ.0 .OR. N.EQ.0 ) THEN RETURN END IF @@ -598,15 +664,16 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: need 0) +* CWorkspace: need N [tau] + N [work] +* CWorkspace: prefer N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -621,8 +688,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -630,15 +698,15 @@ NRWORK = IE + N * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -648,20 +716,21 @@ * LDWRKU = N IR = IU + LDWRKU*N - IF( LWORK.GE.M*N+N*N+3*N ) THEN + IF( LWORK .GE. M*N + N*N + 3*N ) THEN * * WORK(IR) is M by N * LDWRKR = M ELSE - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer M*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -673,8 +742,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -684,8 +754,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -694,8 +765,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of R in WORK(IRU) and computing right singular vectors * of R in WORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -706,8 +777,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of R -* (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -717,8 +789,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by the right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -727,8 +800,9 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (CWorkspace: need 2*N*N, prefer N*N+M*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] +* CWorkspace: prefer N*N [U] + M*N [R] +* RWorkspace: need 0 * DO 10 I = 1, M, LDWRKR CHUNK = MIN( M-I+1, LDWRKR ) @@ -741,7 +815,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -754,8 +828,9 @@ NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -767,8 +842,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -778,8 +854,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -788,8 +865,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -800,8 +877,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, @@ -810,8 +888,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -820,8 +899,8 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] +* RWorkspace: need 0 * CALL CLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL CGEMM( 'N', 'N', M, N, N, CONE, A, LDA, WORK( IR ), @@ -829,7 +908,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -842,16 +921,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (CWorkspace: need N+M, prefer N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + M [work] +* CWorkspace: prefer N*N [U] + N [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -866,8 +947,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -879,8 +961,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -888,8 +970,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -899,8 +982,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -909,8 +993,8 @@ * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] +* RWorkspace: need 0 * CALL CGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), $ LDWRKU, CZERO, A, LDA ) @@ -925,7 +1009,7 @@ * * MNTHR2 <= M < MNTHR1 * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * CUNGBR and matrix multiplication to compute singular vectors * @@ -936,19 +1020,21 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >> N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK @@ -956,22 +1042,25 @@ IRVT = IRU + N*N NRWORK = IRVT + N*N * +* Path 5o (M >> N, JOBZ='O') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -980,15 +1069,15 @@ * * WORK(IU) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -996,8 +1085,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in WORK(IU), copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, $ WORK( IU ), LDWRKU, RWORK( NRWORK ) ) @@ -1005,8 +1094,10 @@ * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 20 I = 1, M, LDWRKU @@ -1019,17 +1110,20 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >> N, JOBZ='S') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, N, N, U, LDU, WORK( ITAUQ ), @@ -1038,8 +1132,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1050,8 +1144,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1059,8 +1153,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need N*N+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL CLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1068,17 +1162,20 @@ CALL CLACPY( 'F', M, N, A, LDA, U, LDU ) ELSE * +* Path 5a (M >> N, JOBZ='A') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, N, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -1087,8 +1184,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1099,8 +1196,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL CLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1108,8 +1205,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL CLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1121,7 +1218,7 @@ * * M .LT. MNTHR2 * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * Use CUNMBR to compute singular vectors * @@ -1132,26 +1229,28 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6n (M >= N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -1160,15 +1259,16 @@ * * WORK( IU ) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * +* Path 6o (M >= N, JOBZ='O') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -1176,21 +1276,24 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * -* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) -* Overwrite WORK(IU) by left singular vectors of A, copying -* to A -* (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) -* (Rworkspace: need 0) +* Path 6o-fast +* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) +* Overwrite WORK(IU) by left singular vectors of A, copying +* to A +* CWorkspace: need 2*N [tauq, taup] + M*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] * CALL CLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) @@ -1202,17 +1305,21 @@ CALL CLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 6o-slow * Generate Q in A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 30 I = 1, M, LDWRKU @@ -1227,11 +1334,12 @@ * ELSE IF( WNTQS ) THEN * +* Path 6s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1242,8 +1350,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLASET( 'F', M, N, CZERO, CZERO, U, LDU ) CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) @@ -1253,8 +1362,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1262,11 +1372,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1285,8 +1396,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1295,8 +1407,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL CLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1316,15 +1429,16 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M [tau] + M [work] +* CWorkspace: prefer M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1339,8 +1453,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1348,15 +1463,15 @@ NRWORK = IE + M * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * @@ -1366,7 +1481,7 @@ * WORK(IVT) is M by M * IL = IVT + LDWKVT*M - IF( LWORK.GE.M*N+M*M+3*M ) THEN + IF( LWORK .GE. M*N + M*M + 3*M ) THEN * * WORK(IL) M by N * @@ -1377,14 +1492,15 @@ * WORK(IL) is M by CHUNK * LDWRKL = M - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF ITAU = IL + LDWRKL*CHUNK NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1396,8 +1512,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1407,8 +1524,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1417,8 +1535,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1429,8 +1547,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1439,8 +1558,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by the right singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1450,8 +1570,9 @@ * * Multiply right singular vectors of L in WORK(IL) by Q * in A, storing result in WORK(IL) and copying to A -* (CWorkspace: need 2*M*M, prefer M*M+M*N)) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] +* CWorkspace: prefer M*M [VT] + M*N [L] +* RWorkspace: need 0 * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -1464,9 +1585,9 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* M right singular vectors to be computed in VT and -* M left singular vectors to be computed in U +* Path 3t (N >> M, JOBZ='S') +* M right singular vectors to be computed in VT and +* M left singular vectors to be computed in U * IL = 1 * @@ -1477,8 +1598,9 @@ NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1490,8 +1612,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1501,8 +1624,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1511,8 +1635,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1523,8 +1647,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1533,8 +1658,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, @@ -1543,8 +1669,8 @@ * * Copy VT to WORK(IL), multiply right singular vectors of L * in WORK(IL) by Q in A, storing result in VT -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] +* RWorkspace: need 0 * CALL CLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, @@ -1552,7 +1678,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 9t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1565,16 +1691,18 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL CGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (CWorkspace: need M+N, prefer M+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + N [work] +* CWorkspace: prefer M*M [VT] + M [tau] + N*NB [work] +* RWorkspace: need 0 * CALL CUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1589,8 +1717,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1599,8 +1728,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1611,8 +1740,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, M, A, LDA, @@ -1621,8 +1751,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by right singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1632,11 +1763,11 @@ * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] +* RWorkspace: need 0 * - CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), - $ LDWKVT, VT, LDVT, CZERO, A, LDA ) + CALL CGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, + $ VT, LDVT, CZERO, A, LDA ) * * Copy right singular vectors of A from A to VT * @@ -1648,10 +1779,9 @@ * * MNTHR2 <= N < MNTHR1 * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * CUNGBR and matrix multiplication to compute singular vectors -* * IE = 1 NRWORK = IE + M @@ -1660,8 +1790,9 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1669,11 +1800,12 @@ * IF( WNTQN ) THEN * +* Path 5tn (N >> M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IRVT = NRWORK @@ -1681,23 +1813,26 @@ NRWORK = IRU + M*M IVT = NWORK * +* Path 5to (N >> M, JOBZ='O') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * LDWKVT = M - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1707,15 +1842,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * CALL SBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, @@ -1723,8 +1858,8 @@ * * Multiply Q in U by real matrix RWORK(IRVT) * storing the result in WORK(IVT), copying to U -* (Cworkspace: need 0) -* (Rworkspace: need 2*M*M) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) @@ -1732,8 +1867,10 @@ * * Multiply RWORK(IRVT) by P**H in A, storing the * result in WORK(IVT), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 2*M*M, prefer 2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 50 I = 1, N, CHUNK @@ -1745,17 +1882,20 @@ 50 CONTINUE ELSE IF( WNTQS ) THEN * +* Path 5ts (N >> M, JOBZ='S') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', M, N, M, VT, LDVT, WORK( ITAUP ), @@ -1764,8 +1904,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1776,8 +1916,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1785,8 +1925,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU CALL CLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, @@ -1794,17 +1934,20 @@ CALL CLACPY( 'F', M, N, A, LDA, VT, LDVT ) ELSE * +* Path 5ta (N >> M, JOBZ='A') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'L', M, M, A, LDA, U, LDU ) CALL CUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL CLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL CUNGBR( 'P', N, N, M, VT, LDVT, WORK( ITAUP ), @@ -1813,8 +1956,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1825,8 +1968,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL CLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1834,9 +1977,10 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * + NRWORK = IRU CALL CLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) CALL CLACPY( 'F', M, N, A, LDA, VT, LDVT ) @@ -1846,7 +1990,7 @@ * * N .LT. MNTHR2 * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * Use CUNMBR to compute singular vectors * @@ -1857,24 +2001,27 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL CGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6tn (N > M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL SBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 6to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1885,15 +2032,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1904,21 +2051,24 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * -* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) -* Overwrite WORK(IVT) by right singular vectors of A, -* copying to A -* (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) -* (Rworkspace: need 0) +* Path 6to-fast +* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) +* Overwrite WORK(IVT) by right singular vectors of A, +* copying to A +* CWorkspace: need 2*M [tauq, taup] + M*N [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1928,17 +2078,21 @@ CALL CLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 6to-slow * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need 0 * CALL CUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 3*M*M, prefer M*M+2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 60 I = 1, N, CHUNK @@ -1952,11 +2106,12 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 6ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1967,8 +2122,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1977,8 +2133,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLASET( 'F', M, N, CZERO, CZERO, VT, LDVT ) CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) @@ -1987,11 +2144,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -2003,8 +2161,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL CLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL CUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -2017,8 +2176,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL CLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL CUNMBR( 'P', 'R', 'C', N, N, M, A, LDA, diff --git a/lapack-netlib/SRC/cgesvd.f b/lapack-netlib/SRC/cgesvd.f index 3c1f825d..d147dee5 100644 --- a/lapack-netlib/SRC/cgesvd.f +++ b/lapack-netlib/SRC/cgesvd.f @@ -214,7 +214,7 @@ SUBROUTINE CGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -322,23 +322,23 @@ MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for CGEQRF CALL CGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEQRF=CDUM(1) + LWORK_CGEQRF = INT( CDUM(1) ) * Compute space needed for CUNGQR CALL CUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGQR_N=CDUM(1) + LWORK_CUNGQR_N = INT( CDUM(1) ) CALL CUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGQR_M=CDUM(1) + LWORK_CUNGQR_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) * Compute space needed for CUNGBR CALL CUNGBR( 'P', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) CALL CUNGBR( 'Q', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) * MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) IF( M.GE.MNTHR ) THEN @@ -446,24 +446,24 @@ * CALL CGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) MAXWRK = 2*N + LWORK_CGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL CUNGBR( 'Q', M, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_Q ) END IF IF( WNTUA ) THEN CALL CUNGBR( 'Q', M, M, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_Q ) END IF IF( .NOT.WNTVN ) THEN MAXWRK = MAX( MAXWRK, 2*N+LWORK_CUNGBR_P ) - MINWRK = 2*N + M END IF + MINWRK = 2*N + M END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -472,25 +472,25 @@ MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for CGELQF CALL CGELQF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGELQF=CDUM(1) + LWORK_CGELQF = INT( CDUM(1) ) * Compute space needed for CUNGLQ CALL CUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) - LWORK_CUNGLQ_N=CDUM(1) + LWORK_CUNGLQ_N = INT( CDUM(1) ) CALL CUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_CUNGLQ_M=CDUM(1) + LWORK_CUNGLQ_M = INT( CDUM(1) ) * Compute space needed for CGEBRD CALL CGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) * Compute space needed for CUNGBR P CALL CUNGBR( 'P', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) * Compute space needed for CUNGBR Q CALL CUNGBR( 'Q', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_Q=CDUM(1) + LWORK_CUNGBR_Q = INT( CDUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -596,25 +596,25 @@ * CALL CGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_CGEBRD=CDUM(1) + LWORK_CGEBRD = INT( CDUM(1) ) MAXWRK = 2*M + LWORK_CGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for CUNGBR P CALL CUNGBR( 'P', M, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_P ) END IF IF( WNTVA ) THEN CALL CUNGBR( 'P', N, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_CUNGBR_P=CDUM(1) + LWORK_CUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_P ) END IF IF( .NOT.WNTUN ) THEN MAXWRK = MAX( MAXWRK, 2*M+LWORK_CUNGBR_Q ) - MINWRK = 2*M + N END IF + MINWRK = 2*M + N END IF END IF MAXWRK = MAX( MINWRK, MAXWRK ) @@ -681,8 +681,10 @@ * * Zero out below R * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = 1 ITAUP = ITAUQ + N @@ -1145,8 +1147,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1322,8 +1326,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1650,8 +1656,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1831,8 +1839,10 @@ * * Zero out below R in A * - CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL CLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) diff --git a/lapack-netlib/SRC/cgesvdx.f b/lapack-netlib/SRC/cgesvdx.f index 235426ad..1e32637c 100644 --- a/lapack-netlib/SRC/cgesvdx.f +++ b/lapack-netlib/SRC/cgesvdx.f @@ -124,13 +124,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -138,13 +140,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -170,7 +176,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -255,7 +261,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEsing * @@ -264,10 +270,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -294,8 +300,8 @@ CHARACTER JOBZ, RNGTGK LOGICAL ALLS, INDS, LQUERY, VALS, WANTU, WANTVT INTEGER I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL, - $ ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK, - $ J, K, MAXWRK, MINMN, MINWRK, MNTHR + $ ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, + $ IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR REAL ABSTOL, ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -367,8 +373,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -390,18 +402,24 @@ * * Path 1 (M much larger than N) * - MAXWRK = N + N* - $ ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*N + N + 2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N+4) + MINWRK = N*(N+5) + MAXWRK = N + N*ILAENV(1,'CGEQRF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+2*N*ILAENV(1,'CGEBRD',' ',N,N,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1)) + END IF ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = 2*N + ( M+N )* - $ ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*N + M + MINWRK = 3*N + M + MAXWRK = 2*N + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*N+N*ILAENV(1,'CUNMQR','LN',N,N,N,-1)) + END IF END IF ELSE MNTHR = ILAENV( 6, 'CGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -409,18 +427,25 @@ * * Path 1t (N much larger than M) * - MAXWRK = M + M* - $ ILAENV( 1, 'CGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*M + M + 2*M* - $ ILAENV( 1, 'CGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M+4) + MINWRK = M*(M+5) + MAXWRK = M + M*ILAENV(1,'CGELQF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+2*M*ILAENV(1,'CGEBRD',' ',M,M,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1)) + END IF ELSE * * Path 2t (N greater than M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* - $ ILAENV( 1, 'CGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*M + N +* + MINWRK = 3*M + N + MAXWRK = 2*M + (M+N)*ILAENV(1,'CGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*M+M*ILAENV(1,'CUNMQR','LN',M,M,M,-1)) + END IF END IF END IF END IF @@ -447,8 +472,6 @@ * * Set singular values indices accord to RANGE='A'. * - ALLS = LSAME( RANGE, 'A' ) - INDS = LSAME( RANGE, 'I' ) IF( ALLS ) THEN RNGTGK = 'I' ILTGK = 1 @@ -518,14 +541,14 @@ CALL CGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -539,7 +562,7 @@ END DO K = K + N END DO - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call CUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -594,14 +617,14 @@ CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -615,7 +638,7 @@ END DO K = K + N END DO - CALL CLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL CLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call CUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -681,14 +704,14 @@ CALL CGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL SBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -722,7 +745,7 @@ END DO K = K + M END DO - CALL CLASET( 'A', M, N-M, CZERO, CZERO, + CALL CLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call CUNMBR to compute (VB**T)*(PB**T) @@ -758,14 +781,14 @@ CALL CGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL SBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -799,7 +822,7 @@ END DO K = K + M END DO - CALL CLASET( 'A', M, N-M, CZERO, CZERO, + CALL CLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call CUNMBR to compute VB**T * PB**T diff --git a/lapack-netlib/SRC/cgesvj.f b/lapack-netlib/SRC/cgesvj.f index 69d77048..28f3eb30 100644 --- a/lapack-netlib/SRC/cgesvj.f +++ b/lapack-netlib/SRC/cgesvj.f @@ -205,6 +205,7 @@ *> \endverbatim *> *> \param[in,out] CWORK +*> \verbatim *> CWORK is COMPLEX array, dimension M+N. *> Used as work space. *> \endverbatim @@ -213,8 +214,10 @@ *> \verbatim *> LWORK is INTEGER *> Length of CWORK, LWORK >= M+N. +*> \endverbatim *> *> \param[in,out] RWORK +*> \verbatim *> RWORK is REAL array, dimension max(6,M+N). *> On entry, *> If JOBU .EQ. 'C' : @@ -244,6 +247,7 @@ *> \endverbatim *> *> \param[in] LRWORK +*> \verbatim *> LRWORK is INTEGER *> Length of RWORK, LRWORK >= MAX(6,N). *> \endverbatim @@ -266,7 +270,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEcomputational * @@ -326,10 +330,10 @@ SUBROUTINE CGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -387,7 +391,7 @@ * from BLAS EXTERNAL CCOPY, CROT, CSSCAL, CSWAP * from LAPACK - EXTERNAL CLASCL, CLASET, CLASSQ, XERBLA + EXTERNAL CLASCL, CLASET, CLASSQ, SLASCL, XERBLA EXTERNAL CGSVJ0, CGSVJ1 * .. * .. Executable Statements .. @@ -889,7 +893,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * CONJG( CWORK(p) ) * CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 ) @@ -909,6 +912,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1 @@ -1110,7 +1114,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * CONJG(CWORK(p))*CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 ) @@ -1125,6 +1128,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1 diff --git a/lapack-netlib/SRC/cgetc2.f b/lapack-netlib/SRC/cgetc2.f index 99eb69d9..021ec672 100644 --- a/lapack-netlib/SRC/cgetc2.f +++ b/lapack-netlib/SRC/cgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE CGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/cgetrf2.f b/lapack-netlib/SRC/cgetrf2.f index 9e985d0e..d761806e 100644 --- a/lapack-netlib/SRC/cgetrf2.f +++ b/lapack-netlib/SRC/cgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE CGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/cgges3.f b/lapack-netlib/SRC/cgges3.f index 9103ccf1..876a26df 100644 --- a/lapack-netlib/SRC/cgges3.f +++ b/lapack-netlib/SRC/cgges3.f @@ -269,7 +269,7 @@ $ LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, $ WORK, LWORK, RWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -394,7 +394,7 @@ LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) CALL CHGEQZ( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, - $ WORK, IERR ) + $ RWORK, IERR ) LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) IF( WANTST ) THEN CALL CTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, diff --git a/lapack-netlib/SRC/cggev3.f b/lapack-netlib/SRC/cggev3.f index decdae50..f34b8f2c 100644 --- a/lapack-netlib/SRC/cggev3.f +++ b/lapack-netlib/SRC/cggev3.f @@ -216,7 +216,7 @@ SUBROUTINE CGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 diff --git a/lapack-netlib/SRC/cgghd3.f b/lapack-netlib/SRC/cgghd3.f index 112b41a1..a9468a24 100644 --- a/lapack-netlib/SRC/cgghd3.f +++ b/lapack-netlib/SRC/cgghd3.f @@ -231,7 +231,7 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -282,7 +282,7 @@ * INFO = 0 NB = ILAENV( 1, 'CGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = CMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/cggsvp3.f b/lapack-netlib/SRC/cggsvp3.f index 36fe9913..feee3644 100644 --- a/lapack-netlib/SRC/cggsvp3.f +++ b/lapack-netlib/SRC/cggsvp3.f @@ -278,7 +278,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, RWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -308,7 +308,6 @@ * .. Local Scalars .. LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY INTEGER I, J, LWKOPT - COMPLEX T * .. * .. External Functions .. LOGICAL LSAME diff --git a/lapack-netlib/SRC/cgsvj0.f b/lapack-netlib/SRC/cgsvj0.f index 79ffde62..66074bdb 100644 --- a/lapack-netlib/SRC/cgsvj0.f +++ b/lapack-netlib/SRC/cgsvj0.f @@ -1,4 +1,4 @@ -*> \brief \b CGSVJ0 pre-processor for the routine sgesvj. +*> \brief \b CGSVJ0 pre-processor for the routine cgesvj. * * =========== DOCUMENTATION =========== * @@ -193,7 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -218,10 +218,10 @@ SUBROUTINE CGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. diff --git a/lapack-netlib/SRC/cgsvj1.f b/lapack-netlib/SRC/cgsvj1.f index f4b1fc15..ca71a4ea 100644 --- a/lapack-netlib/SRC/cgsvj1.f +++ b/lapack-netlib/SRC/cgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b CGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b CGSVJ1 pre-processor for the routine cgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -105,7 +105,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is REAL array, dimension (LDA,N) +*> A is COMPLEX array, dimension (LDA,N) *> On entry, M-by-N matrix A, such that A*diag(D) represents *> the input matrix. *> On exit, @@ -124,7 +124,7 @@ *> *> \param[in,out] D *> \verbatim -*> D is REAL array, dimension (N) +*> D is COMPLEX array, dimension (N) *> The array D accumulates the scaling factors from the fast scaled *> Jacobi rotations. *> On entry, A*diag(D) represents the input matrix. @@ -154,7 +154,7 @@ *> *> \param[in,out] V *> \verbatim -*> V is REAL array, dimension (LDV,N) +*> V is COMPLEX 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 @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE CGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. REAL EPS, SFMIN, TOL diff --git a/lapack-netlib/SRC/chbevx.f b/lapack-netlib/SRC/chbevx.f index d9a22e35..47dd8069 100644 --- a/lapack-netlib/SRC/chbevx.f +++ b/lapack-netlib/SRC/chbevx.f @@ -123,12 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -136,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -251,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -260,10 +267,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chbgvd.f b/lapack-netlib/SRC/chbgvd.f index e57bd937..64dd1f6d 100644 --- a/lapack-netlib/SRC/chbgvd.f +++ b/lapack-netlib/SRC/chbgvd.f @@ -238,7 +238,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -252,10 +252,10 @@ $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -372,7 +372,7 @@ LLWK2 = LWORK - INDWK2 + 2 LLRWK = LRWORK - INDWRK + 2 CALL CHBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK, RWORK( INDWRK ), IINFO ) + $ WORK, RWORK, IINFO ) * * Reduce Hermitian band matrix to tridiagonal form. * diff --git a/lapack-netlib/SRC/chbgvx.f b/lapack-netlib/SRC/chbgvx.f index 5e28cc88..43ae794d 100644 --- a/lapack-netlib/SRC/chbgvx.f +++ b/lapack-netlib/SRC/chbgvx.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -277,7 +286,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -291,10 +300,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cheevr.f b/lapack-netlib/SRC/cheevr.f index 18dfe431..9b8ffb4e 100644 --- a/lapack-netlib/SRC/cheevr.f +++ b/lapack-netlib/SRC/cheevr.f @@ -155,12 +155,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -168,13 +171,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -329,7 +336,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -348,10 +355,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cheevx.f b/lapack-netlib/SRC/cheevx.f index 12f69ccc..f41479bd 100644 --- a/lapack-netlib/SRC/cheevx.f +++ b/lapack-netlib/SRC/cheevx.f @@ -99,12 +99,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -112,13 +115,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -243,7 +250,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -252,10 +259,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chegvx.f b/lapack-netlib/SRC/chegvx.f index 33a4e5f4..52fb983d 100644 --- a/lapack-netlib/SRC/chegvx.f +++ b/lapack-netlib/SRC/chegvx.f @@ -132,13 +132,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -146,14 +150,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -284,7 +293,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexHEeigen * @@ -298,10 +307,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chetrf_rook.f b/lapack-netlib/SRC/chetrf_rook.f index 98c8dbd2..0217150d 100644 --- a/lapack-netlib/SRC/chetrf_rook.f +++ b/lapack-netlib/SRC/chetrf_rook.f @@ -150,7 +150,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexHEcomputational * @@ -199,7 +199,7 @@ *> *> \verbatim *> -*> November 2013, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -212,10 +212,10 @@ * ===================================================================== SUBROUTINE CHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -265,7 +265,7 @@ * Determine the block size * NB = ILAENV( 1, 'CHETRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/chgeqz.f b/lapack-netlib/SRC/chgeqz.f index 024354e6..15aaaa44 100644 --- a/lapack-netlib/SRC/chgeqz.f +++ b/lapack-netlib/SRC/chgeqz.f @@ -190,12 +190,12 @@ *> \param[in,out] Q *> \verbatim *> Q is COMPLEX array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the unitary matrix Q1 used in the +*> On entry, if COMPQ = 'V', the unitary matrix Q1 used in the *> reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the unitary matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the unitary matrix of +*> On exit, if COMPQ = 'I', the unitary matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the unitary matrix of *> left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -284,7 +284,7 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 diff --git a/lapack-netlib/SRC/chpevx.f b/lapack-netlib/SRC/chpevx.f index e7bd2c4f..e6bf245e 100644 --- a/lapack-netlib/SRC/chpevx.f +++ b/lapack-netlib/SRC/chpevx.f @@ -97,12 +97,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -110,13 +113,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -224,7 +231,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -233,10 +240,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/chpgvx.f b/lapack-netlib/SRC/chpgvx.f index ee100984..cc4b296b 100644 --- a/lapack-netlib/SRC/chpgvx.f +++ b/lapack-netlib/SRC/chpgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +263,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHEReigen * @@ -268,10 +277,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/cla_gbamv.f b/lapack-netlib/SRC/cla_gbamv.f index b74156db..074ca90a 100644 --- a/lapack-netlib/SRC/cla_gbamv.f +++ b/lapack-netlib/SRC/cla_gbamv.f @@ -107,7 +107,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is REAL array, dimension (LDAB,n) +*> AB is COMPLEX array, dimension (LDAB,n) *> Before entry, the leading m by n part of the array AB must *> contain the matrix of coefficients. *> Unchanged on exit. @@ -124,7 +124,7 @@ *> *> \param[in] X *> \verbatim -*> X is REAL array, dimension +*> X is COMPLEX array, dimension *> ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' *> and at least *> ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. @@ -178,7 +178,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexGBcomputational * @@ -186,10 +186,10 @@ SUBROUTINE CLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X, $ INCX, BETA, Y, INCY ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. REAL ALPHA, BETA diff --git a/lapack-netlib/SRC/cla_herpvgrw.f b/lapack-netlib/SRC/cla_herpvgrw.f index dc05aedc..9326299c 100644 --- a/lapack-netlib/SRC/cla_herpvgrw.f +++ b/lapack-netlib/SRC/cla_herpvgrw.f @@ -104,7 +104,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (2*N) +*> WORK is REAL array, dimension (2*N) *> \endverbatim * * Authors: @@ -115,7 +115,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexHEcomputational * @@ -123,10 +123,10 @@ REAL FUNCTION CLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, LDAF, IPIV, $ WORK ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/cla_lin_berr.f b/lapack-netlib/SRC/cla_lin_berr.f index 94db8143..4ac5abec 100644 --- a/lapack-netlib/SRC/cla_lin_berr.f +++ b/lapack-netlib/SRC/cla_lin_berr.f @@ -67,7 +67,7 @@ *> *> \param[in] RES *> \verbatim -*> RES is REAL array, dimension (N,NRHS) +*> RES is COMPLEX array, dimension (N,NRHS) *> The residual matrix, i.e., the matrix R in the relative backward *> error formula above. *> \endverbatim @@ -82,7 +82,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX array, dimension (NRHS) +*> BERR is REAL array, dimension (NRHS) *> The componentwise relative backward error from the formula above. *> \endverbatim * @@ -94,17 +94,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NZ, NRHS diff --git a/lapack-netlib/SRC/cla_porcond_c.f b/lapack-netlib/SRC/cla_porcond_c.f index 8e2b9837..01e07a14 100644 --- a/lapack-netlib/SRC/cla_porcond_c.f +++ b/lapack-netlib/SRC/cla_porcond_c.f @@ -38,7 +38,7 @@ *> \verbatim *> *> CLA_PORCOND_C Computes the infinity norm condition number of -*> op(A) * inv(diag(C)) where C is a DOUBLE PRECISION vector +*> op(A) * inv(diag(C)) where C is a REAL vector *> \endverbatim * * Arguments: @@ -122,7 +122,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPOcomputational * @@ -130,10 +130,10 @@ REAL FUNCTION CLA_PORCOND_C( UPLO, N, A, LDA, AF, LDAF, C, CAPPLY, $ INFO, WORK, RWORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cla_porpvgrw.f b/lapack-netlib/SRC/cla_porpvgrw.f index 607752ad..d60cfe62 100644 --- a/lapack-netlib/SRC/cla_porpvgrw.f +++ b/lapack-netlib/SRC/cla_porpvgrw.f @@ -87,7 +87,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX array, dimension (2*N) +*> WORK is REAL array, dimension (2*N) *> \endverbatim * * Authors: @@ -98,17 +98,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPOcomputational * * ===================================================================== REAL FUNCTION CLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, LDAF, WORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/claed7.f b/lapack-netlib/SRC/claed7.f index c1441393..a42ee681 100644 --- a/lapack-netlib/SRC/claed7.f +++ b/lapack-netlib/SRC/claed7.f @@ -57,7 +57,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED2. *> @@ -239,7 +239,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -249,10 +249,10 @@ $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, diff --git a/lapack-netlib/SRC/claqr3.f b/lapack-netlib/SRC/claqr3.f index 53e0e3c4..f3ee410b 100644 --- a/lapack-netlib/SRC/claqr3.f +++ b/lapack-netlib/SRC/claqr3.f @@ -137,7 +137,7 @@ *> Z is COMPLEX array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the unitary *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -251,7 +251,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -266,10 +266,10 @@ $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/claqr5.f b/lapack-netlib/SRC/claqr5.f index fc412c4d..22e55def 100644 --- a/lapack-netlib/SRC/claqr5.f +++ b/lapack-netlib/SRC/claqr5.f @@ -142,10 +142,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is COMPLEX array of size (LDZ,IHI) +*> Z is COMPLEX array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep unitary *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -228,7 +228,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -251,10 +251,10 @@ $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/clarcm.f b/lapack-netlib/SRC/clarcm.f index 30a92043..63038ec2 100644 --- a/lapack-netlib/SRC/clarcm.f +++ b/lapack-netlib/SRC/clarcm.f @@ -72,7 +72,7 @@ *> *> \param[in] B *> \verbatim -*> B is REAL array, dimension (LDB, N) +*> B is COMPLEX array, dimension (LDB, N) *> B contains the M by N matrix B. *> \endverbatim *> @@ -107,17 +107,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * * ===================================================================== SUBROUTINE CLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, M, N diff --git a/lapack-netlib/SRC/clarrv.f b/lapack-netlib/SRC/clarrv.f index ecedfa4d..31f374cb 100644 --- a/lapack-netlib/SRC/clarrv.f +++ b/lapack-netlib/SRC/clarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is REAL array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by SLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in CLARRV. +*> > 0: A problem occurred in CLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/clarscl2.f b/lapack-netlib/SRC/clarscl2.f index ada9535c..77876771 100644 --- a/lapack-netlib/SRC/clarscl2.f +++ b/lapack-netlib/SRC/clarscl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/clascl.f b/lapack-netlib/SRC/clascl.f index a5ab897b..776d6cd3 100644 --- a/lapack-netlib/SRC/clascl.f +++ b/lapack-netlib/SRC/clascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * * ===================================================================== SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/clascl2.f b/lapack-netlib/SRC/clascl2.f index f45f85e1..01fbe698 100644 --- a/lapack-netlib/SRC/clascl2.f +++ b/lapack-netlib/SRC/clascl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * * ===================================================================== SUBROUTINE CLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/clatdf.f b/lapack-netlib/SRC/clatdf.f index 11f0dfd9..ff56cdeb 100644 --- a/lapack-netlib/SRC/clatdf.f +++ b/lapack-netlib/SRC/clatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value of *> 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where -*> all entries of the r.h.s. b is choosen as either +1 or +*> all entries of the r.h.s. b is chosen as either +1 or *> -1. Default. *> \endverbatim *> @@ -70,7 +70,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is REAL array, dimension (LDZ, N) +*> Z is COMPLEX array, dimension (LDZ, N) *> On entry, the LU part of the factorization of the n-by-n *> matrix Z computed by CGETC2: Z = P * L * U * Q *> \endverbatim @@ -83,7 +83,7 @@ *> *> \param[in,out] RHS *> \verbatim -*> RHS is REAL array, dimension (N). +*> RHS is COMPLEX array, dimension (N). *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with *> entries according to the value of IJOB (see above). @@ -134,7 +134,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERauxiliary * @@ -169,10 +169,10 @@ SUBROUTINE CLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/cpotrf2.f b/lapack-netlib/SRC/cpotrf2.f index 6ab06a63..dfd06fa9 100644 --- a/lapack-netlib/SRC/cpotrf2.f +++ b/lapack-netlib/SRC/cpotrf2.f @@ -62,7 +62,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE PRECISION 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 @@ -99,17 +99,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexPOcomputational * * ===================================================================== RECURSIVE SUBROUTINE CPOTRF2( UPLO, N, A, LDA, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cpttrs.f b/lapack-netlib/SRC/cpttrs.f index 4214dd11..68f650e0 100644 --- a/lapack-netlib/SRC/cpttrs.f +++ b/lapack-netlib/SRC/cpttrs.f @@ -87,7 +87,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 vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -114,17 +114,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPTcomputational * * ===================================================================== SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/cptts2.f b/lapack-netlib/SRC/cptts2.f index 379ca495..c545b8fe 100644 --- a/lapack-netlib/SRC/cptts2.f +++ b/lapack-netlib/SRC/cptts2.f @@ -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 vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexPTcomputational * * ===================================================================== SUBROUTINE CPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IUPLO, LDB, N, NRHS diff --git a/lapack-netlib/SRC/cstegr.f b/lapack-netlib/SRC/cstegr.f index 6e1eae05..aaecf36d 100644 --- a/lapack-netlib/SRC/cstegr.f +++ b/lapack-netlib/SRC/cstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> CSTEGR is a compatability wrapper around the improved CSTEMR routine. +*> CSTEGR is a compatibility wrapper around the improved CSTEMR routine. *> See SSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/cstemr.f b/lapack-netlib/SRC/cstemr.f index 29734964..90f050ad 100644 --- a/lapack-netlib/SRC/cstemr.f +++ b/lapack-netlib/SRC/cstemr.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +320,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -329,10 +338,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/csytrf_rook.f b/lapack-netlib/SRC/csytrf_rook.f index fab04816..139569f9 100644 --- a/lapack-netlib/SRC/csytrf_rook.f +++ b/lapack-netlib/SRC/csytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complexSYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'CSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/ctgsen.f b/lapack-netlib/SRC/ctgsen.f index d2ba8de8..3de430bf 100644 --- a/lapack-netlib/SRC/ctgsen.f +++ b/lapack-netlib/SRC/ctgsen.f @@ -290,7 +290,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -433,10 +433,10 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -515,6 +515,7 @@ * subspaces. * M = 0 + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N ALPHA( K ) = A( K, K ) BETA( K ) = B( K, K ) @@ -526,6 +527,7 @@ $ M = M + 1 END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 2*M*(N-M) ) diff --git a/lapack-netlib/SRC/ctrevc3.f b/lapack-netlib/SRC/ctrevc3.f new file mode 100644 index 00000000..00d3b946 --- /dev/null +++ b/lapack-netlib/SRC/ctrevc3.f @@ -0,0 +1,630 @@ +*> \brief \b CTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download CTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, RWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* REAL RWORK( * ) +* COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> CTREVC3 computes some or all of the right and/or left eigenvectors of +*> a complex upper triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a complex general matrix: A = Q*T*Q**H, as computed by CHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**H)*T = w*(y**H) +*> +*> where y**H denotes the conjugate transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the unitary factor that reduces a matrix A to +*> Schur form T, then Q*X and Q*Y are the matrices of right and left +*> eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed using the matrices supplied in +*> VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> The eigenvector corresponding to the j-th eigenvalue is +*> computed if SELECT(j) = .TRUE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in,out] T +*> \verbatim +*> T is COMPLEX array, dimension (LDT,N) +*> The upper triangular matrix T. T is modified, but restored +*> on exit. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is COMPLEX array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by CHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is COMPLEX array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by CHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected eigenvector occupies one column. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,2*N). +*> For optimum performance, LWORK >= N + 2*N*NB, where NB is +*> the optimal blocksize. +*> +*> 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] RWORK +*> \verbatim +*> RWORK is REAL array, dimension (LRWORK) +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of array RWORK. LRWORK >= max(1,N). +*> +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the RWORK array, returns +*> this value as the first entry of the RWORK array, and no error +*> message related to LRWORK 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 2011 +* +* @generated from ztrevc3.f, fortran z -> c, Tue Apr 19 01:47:44 2016 +* +*> \ingroup complexOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE CTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + REAL RWORK( * ) + COMPLEX T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) + COMPLEX CZERO, CONE + PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), + $ CONE = ( 1.0E+0, 0.0E+0 ) ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV + INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB + REAL OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL + COMPLEX CDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV, ICAMAX + REAL SLAMCH, SCASUM + EXTERNAL LSAME, ILAENV, ICAMAX, SLAMCH, SCASUM +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, CCOPY, CSSCAL, CGEMV, CLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, REAL, CMPLX, CONJG, AIMAG, MAX +* .. +* .. Statement Functions .. + REAL CABS1 +* .. +* .. Statement Function definitions .. + CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* +* Set M to the number of columns required to store the selected +* eigenvectors. +* + IF( SOMEV ) THEN + M = 0 + DO 10 J = 1, N + IF( SELECT( J ) ) + $ M = M + 1 + 10 CONTINUE + ELSE + M = N + END IF +* + INFO = 0 + NB = ILAENV( 1, 'CTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + RWORK(1) = N + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( MM.LT.M ) THEN + INFO = -11 + ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE IF ( LRWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + INFO = -16 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'CTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL CLASET( 'F', N, 1+2*NB, CZERO, CZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) +* +* Store the diagonal elements of T in working array WORK. +* + DO 20 I = 1, N + WORK( I ) = T( I, I ) + 20 CONTINUE +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + RWORK( 1 ) = ZERO + DO 30 J = 2, N + RWORK( J ) = SCASUM( J-1, T( 1, J ), 1 ) + 30 CONTINUE +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=NB=1; +* blocked version starts with IV=NB, goes down to 1. +* (Note the "0-th" column is used to store the original diagonal.) + IV = NB + IS = M + DO 80 KI = N, 1, -1 + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 80 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex right eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 40 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 40 CONTINUE +* +* Solve upper triangular system: +* [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK. +* + DO 50 K = 1, KI - 1 + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 50 CONTINUE +* + IF( KI.GT.1 ) THEN + CALL CLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y', + $ KI-1, T, LDT, WORK( 1 + IV*N ), SCALE, + $ RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL CCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = ICAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / CABS1( VR( II, IS ) ) + CALL CSSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 60 K = KI + 1, N + VR( K, IS ) = CZERO + 60 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL CGEMV( 'N', N, KI-1, CONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, CMPLX( SCALE ), + $ VR( 1, KI ), 1 ) +* + II = ICAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / CABS1( VR( II, KI ) ) + CALL CSSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = CZERO + END DO +* +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.1) .OR. (KI.EQ.1) ) THEN + CALL CGEMM( 'N', 'N', N, NB-IV+1, KI+NB-IV, CONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + II = ICAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL CSSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL CLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 70 K = 1, KI - 1 + T( K, K ) = WORK( K ) + 70 CONTINUE +* + IS = IS - 1 + 80 CONTINUE + END IF +* + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB. +* (Note the "0-th" column is used to store the original diagonal.) + IV = 1 + IS = 1 + DO 130 KI = 1, N +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 130 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex left eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 90 K = KI + 1, N + WORK( K + IV*N ) = -CONJG( T( KI, K ) ) + 90 CONTINUE +* +* Solve conjugate-transposed triangular system: +* [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK. +* + DO 100 K = KI + 1, N + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 100 CONTINUE +* + IF( KI.LT.N ) THEN + CALL CLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, + $ WORK( KI+1 + IV*N ), SCALE, RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL CCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS), 1 ) +* + II = ICAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / CABS1( VL( II, IS ) ) + CALL CSSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 110 K = 1, KI - 1 + VL( K, IS ) = CZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL CGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, CMPLX( SCALE ), + $ VL( 1, KI ), 1 ) +* + II = ICAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / CABS1( VL( II, KI ) ) + CALL CSSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = CZERO + END DO +* +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.NB) .OR. (KI.EQ.N) ) THEN + CALL CGEMM( 'N', 'N', N, IV, N-KI+IV, ONE, + $ VL( 1, KI-IV+1 ), LDVL, + $ WORK( KI-IV+1 + (1)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + II = ICAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL CSSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL CLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 120 K = KI + 1, N + T( K, K ) = WORK( K ) + 120 CONTINUE +* + IS = IS + 1 + 130 CONTINUE + END IF +* + RETURN +* +* End of CTREVC3 +* + END diff --git a/lapack-netlib/SRC/ctrttf.f b/lapack-netlib/SRC/ctrttf.f index b1086b6f..95a24ea6 100644 --- a/lapack-netlib/SRC/ctrttf.f +++ b/lapack-netlib/SRC/ctrttf.f @@ -81,7 +81,7 @@ *> *> \param[out] ARF *> \verbatim -*> ARF is COMPLEX*16 array, dimension ( N*(N+1)/2 ), +*> ARF is COMPLEX array, dimension ( N*(N+1)/2 ), *> On exit, the upper or lower triangular matrix A stored in *> RFP format. For a further discussion see Notes below. *> \endverbatim @@ -101,7 +101,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -216,10 +216,10 @@ * ===================================================================== SUBROUTINE CTRTTF( TRANSR, UPLO, N, A, LDA, ARF, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TRANSR, UPLO diff --git a/lapack-netlib/SRC/cunbdb1.f b/lapack-netlib/SRC/cunbdb1.f index fea26b21..7d36547d 100644 --- a/lapack-netlib/SRC/cunbdb1.f +++ b/lapack-netlib/SRC/cunbdb1.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -307,9 +307,8 @@ CALL CLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I, X21(I,I+1), LDX21 ) - C = SQRT( SCNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( SCNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL CUNBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/cunbdb2.f b/lapack-netlib/SRC/cunbdb2.f index cec00f93..6571befd 100644 --- a/lapack-netlib/SRC/cunbdb2.f +++ b/lapack-netlib/SRC/cunbdb2.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -296,8 +296,8 @@ CALL CLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X11(I,I), LDX11 ) - S = SQRT( SCNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SCNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SCNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL CUNBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/cunbdb3.f b/lapack-netlib/SRC/cunbdb3.f index 5451ef00..05eab91b 100644 --- a/lapack-netlib/SRC/cunbdb3.f +++ b/lapack-netlib/SRC/cunbdb3.f @@ -202,7 +202,7 @@ SUBROUTINE CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -296,8 +296,8 @@ CALL CLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) - C = SQRT( SCNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( SCNRM2( P-I+1, X11(I,I), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL CUNBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/cunbdb4.f b/lapack-netlib/SRC/cunbdb4.f index bc948a30..ce3a8660 100644 --- a/lapack-netlib/SRC/cunbdb4.f +++ b/lapack-netlib/SRC/cunbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -344,9 +344,8 @@ $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL CLACGV( Q-I+1, X21(I,I), LDX21 ) IF( I .LT. M-Q ) THEN - S = SQRT( SCNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SCNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( SCNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SCNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/cuncsd.f b/lapack-netlib/SRC/cuncsd.f index ca3922da..09c9b305 100644 --- a/lapack-netlib/SRC/cuncsd.f +++ b/lapack-netlib/SRC/cuncsd.f @@ -308,7 +308,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -320,10 +320,10 @@ $ LDV2T, WORK, LWORK, RWORK, LRWORK, $ IWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, SIGNS, TRANS @@ -371,7 +371,7 @@ EXTERNAL LSAME * .. * .. Intrinsic Functions - INTRINSIC COS, INT, MAX, MIN, SIN + INTRINSIC INT, MAX, MIN * .. * .. Executable Statements .. * @@ -488,12 +488,12 @@ ITAUQ1 = ITAUP2 + MAX( 1, M - P ) ITAUQ2 = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ2 + MAX( 1, M - Q ) - CALL CUNGQR( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), U1, WORK, -1, + CALL CUNGQR( M-Q, M-Q, M-Q, U1, MAX(1,M-Q), U1, WORK, -1, $ CHILDINFO ) LORGQRWORKOPT = INT( WORK(1) ) LORGQRWORKMIN = MAX( 1, M - Q ) IORGLQ = ITAUQ2 + MAX( 1, M - Q ) - CALL CUNGLQ( M-Q, M-Q, M-Q, 0, MAX(1,M-Q), U1, WORK, -1, + CALL CUNGLQ( M-Q, M-Q, M-Q, U1, MAX(1,M-Q), U1, WORK, -1, $ CHILDINFO ) LORGLQWORKOPT = INT( WORK(1) ) LORGLQWORKMIN = MAX( 1, M - Q ) diff --git a/lapack-netlib/SRC/cuncsd2by1.f b/lapack-netlib/SRC/cuncsd2by1.f index 1b2b0fb2..54b774b8 100644 --- a/lapack-netlib/SRC/cuncsd2by1.f +++ b/lapack-netlib/SRC/cuncsd2by1.f @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date July 2012 +*> \date June 2016 * *> \ingroup complexOTHERcomputational * @@ -254,10 +254,10 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* July 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T @@ -288,6 +288,10 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + REAL DUM( 1 ) + COMPLEX CDUM( 1, 1 ) +* .. * .. External Subroutines .. EXTERNAL CBBCSD, CCOPY, CLACPY, CLAPMR, CLAPMT, CUNBDB1, $ CUNBDB2, CUNBDB3, CUNBDB4, CUNGLQ, CUNGQR, @@ -320,11 +324,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -380,99 +384,119 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL CUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM, CDUM, CDUM, CDUM, WORK, -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL CUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ CDUM, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM(1), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, V1T, LDV1T, CDUM, 1, U1, LDU1, U2, LDU2, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL CUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, CDUM, $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, CDUM, 1, V1T, LDV1T, U2, LDU2, U1, + $ LDU1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL CUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO + $ ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL CUNGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL CUNGQR( P, P, M-Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL CUNGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL CUNGQR( M-P, M-P, M-Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL CUNGLQ( Q, Q, Q, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL CUNGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL CBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, U2, LDU2, U1, LDU1, CDUM, 1, V1T, + $ LDV1T, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) END IF LRWORKMIN = IBBCSD+LBBCSD-1 @@ -538,8 +562,8 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -592,8 +616,8 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ RWORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), V1T, LDV1T, CDUM, 1, U1, LDU1, U2, + $ LDU2, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -647,7 +671,7 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, RWORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, + $ THETA, RWORK(IPHI), CDUM, 1, V1T, LDV1T, U2, LDU2, $ U1, LDU1, RWORK(IB11D), RWORK(IB11E), $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), @@ -716,11 +740,11 @@ * Simultaneously diagonalize X11 and X21. * CALL CBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), - $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), - $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, CDUM, 1, + $ V1T, LDV1T, RWORK(IB11D), RWORK(IB11E), + $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), + $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), + $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions diff --git a/lapack-netlib/SRC/dbbcsd.f b/lapack-netlib/SRC/dbbcsd.f index 2c54d1c5..962071cf 100644 --- a/lapack-netlib/SRC/dbbcsd.f +++ b/lapack-netlib/SRC/dbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is DOUBLE PRECISION array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is DOUBLE PRECISION array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is DOUBLE PRECISION array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is DOUBLE PRECISION array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/dbdsdc.f b/lapack-netlib/SRC/dbdsdc.f index 2c572f12..a5af1b0f 100644 --- a/lapack-netlib/SRC/dbdsdc.f +++ b/lapack-netlib/SRC/dbdsdc.f @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -205,10 +205,10 @@ SUBROUTINE DBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, UPLO @@ -311,7 +311,7 @@ WSTART = 1 QSTART = 3 IF( ICOMPQ.EQ.1 ) THEN - CALL DCOPY( N, D, 1, Q( 1 ), 1 ) + CALL DCOPY( N, D, 1, Q( 1 ), 1 ) CALL DCOPY( N-1, E, 1, Q( N+1 ), 1 ) END IF IF( IUPLO.EQ.2 ) THEN @@ -335,8 +335,11 @@ * If ICOMPQ = 0, use DLASDQ to compute the singular values. * IF( ICOMPQ.EQ.0 ) THEN +* Ignore WSTART, instead using WORK( 1 ), since the two vectors +* for CS and -SN above are added only if ICOMPQ == 2, +* and adding them exceeds documented WORK size of 4*n. CALL DLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U, - $ LDU, WORK( WSTART ), INFO ) + $ LDU, WORK( 1 ), INFO ) GO TO 40 END IF * @@ -412,24 +415,24 @@ DO 30 I = 1, NM1 IF( ( ABS( E( I ) ).LT.EPS ) .OR. ( I.EQ.NM1 ) ) THEN * -* Subproblem found. First determine its size and then -* apply divide and conquer on it. +* Subproblem found. First determine its size and then +* apply divide and conquer on it. * IF( I.LT.NM1 ) THEN * -* A subproblem with E(I) small for I < NM1. +* A subproblem with E(I) small for I < NM1. * NSIZE = I - START + 1 ELSE IF( ABS( E( I ) ).GE.EPS ) THEN * -* A subproblem with E(NM1) not too small but I = NM1. +* A subproblem with E(NM1) not too small but I = NM1. * NSIZE = N - START + 1 ELSE * -* A subproblem with E(NM1) small. This implies an -* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem -* first. +* A subproblem with E(NM1) small. This implies an +* 1-by-1 subproblem at D(N). Solve this 1-by-1 problem +* first. * NSIZE = I - START + 1 IF( ICOMPQ.EQ.2 ) THEN diff --git a/lapack-netlib/SRC/dbdsvdx.f b/lapack-netlib/SRC/dbdsvdx.f index 7ceb9392..89a8aab4 100644 --- a/lapack-netlib/SRC/dbdsvdx.f +++ b/lapack-netlib/SRC/dbdsvdx.f @@ -80,7 +80,7 @@ *> = 'L': B is lower bidiagonal. *> \endverbatim *> -*> \param[in] JOBXZ +*> \param[in] JOBZ *> \verbatim *> JOBZ is CHARACTER*1 *> = 'N': Compute singular values only; @@ -117,14 +117,16 @@ *> *> \param[in] VL *> \verbatim -*> VL is DOUBLE PRECISION -*> VL >=0. +*> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,13 +134,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -190,7 +196,10 @@ *> If JOBZ = 'V', then if INFO = 0, the first NS elements of *> IWORK are zero. If INFO > 0, then IWORK contains the indices *> of the eigenvectors that failed to converge in DSTEVX. +*> \endverbatim *> +*> \param[out] INFO +*> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value @@ -209,7 +218,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -217,7 +226,7 @@ SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ NS, S, Z, LDZ, WORK, IWORK, INFO) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -371,7 +380,6 @@ IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO END DO IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO - E( N ) = ZERO * * Pointers for arrays used by DSTEVX. * @@ -398,7 +406,7 @@ * of the active submatrix. * RNGVX = 'I' - CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) ELSE IF( VALSV ) THEN * * Find singular values in a half-open interval. We aim @@ -418,7 +426,7 @@ IF( NS.EQ.0 ) THEN RETURN ELSE - CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) END IF ELSE IF( INDSV ) THEN * @@ -455,7 +463,7 @@ * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ) END IF * * Initialize variables and pointers for S, Z, and WORK. @@ -709,9 +717,11 @@ NRU = 0 NRV = 0 END IF !** NTGK.GT.0 **! - IF( IROWZ.LT.N*2 ) Z( 1:IROWZ-1, ICOLZ ) = ZERO + IF( IROWZ.LT.N*2 .AND. WANTZ ) THEN + Z( 1:IROWZ-1, ICOLZ ) = ZERO + END IF END DO !** IDPTR loop **! - IF( SPLIT ) THEN + IF( SPLIT .AND. WANTZ ) THEN * * Bring back eigenvector corresponding * to eigenvalue equal to zero. @@ -744,7 +754,7 @@ IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) + IF( WANTZ ) CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) END IF END DO * @@ -754,7 +764,7 @@ K = IU - IL + 1 IF( K.LT.NS ) THEN S( K+1:NS ) = ZERO - Z( 1:N*2,K+1:NS ) = ZERO + IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO NS = K END IF END IF @@ -762,6 +772,7 @@ * Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). * If B is a lower diagonal, swap U and V. * + IF( WANTZ ) THEN DO I = 1, NS CALL DCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) IF( LOWER ) THEN @@ -772,6 +783,7 @@ CALL DCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) END IF END DO + END IF * RETURN * diff --git a/lapack-netlib/SRC/dgbrfsx.f b/lapack-netlib/SRC/dgbrfsx.f index c96c6233..e50ef67b 100644 --- a/lapack-netlib/SRC/dgbrfsx.f +++ b/lapack-netlib/SRC/dgbrfsx.f @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -646,7 +646,7 @@ * * Perform refinement on each right-hand side * - IF (REF_TYPE .NE. 0) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'E' ) diff --git a/lapack-netlib/SRC/dgeesx.f b/lapack-netlib/SRC/dgeesx.f index 2a3e963f..67e08487 100644 --- a/lapack-netlib/SRC/dgeesx.f +++ b/lapack-netlib/SRC/dgeesx.f @@ -90,7 +90,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of two DOUBLE PRECISION arguments +*> SELECT is a LOGICAL FUNCTION of two DOUBLE PRECISION arguments *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to sort *> to the top left of the Schur form. @@ -272,7 +272,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleGEeigen * @@ -281,10 +281,10 @@ $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, $ IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/dgeev.f b/lapack-netlib/SRC/dgeev.f index 328eaa39..eb043d95 100644 --- a/lapack-netlib/SRC/dgeev.f +++ b/lapack-netlib/SRC/dgeev.f @@ -181,18 +181,21 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @precisions fortran d -> s * *> \ingroup doubleGEeigen * * ===================================================================== SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, $ LDVR, WORK, LWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR @@ -213,7 +216,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, - $ MAXWRK, MINWRK, NOUT + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. @@ -223,7 +226,7 @@ * .. * .. External Subroutines .. EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, + $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, $ XERBLA * .. * .. External Functions .. @@ -279,24 +282,34 @@ MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL DTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE IF( WANTVR ) THEN MINWRK = 4*N MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL DTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -426,10 +439,10 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 4*N) +* (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/dgeevx.f b/lapack-netlib/SRC/dgeevx.f index 81f30f93..3067f346 100644 --- a/lapack-netlib/SRC/dgeevx.f +++ b/lapack-netlib/SRC/dgeevx.f @@ -294,7 +294,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @precisions fortran d -> s * *> \ingroup doubleGEeigen * @@ -302,11 +304,12 @@ SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE @@ -330,8 +333,8 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. @@ -341,7 +344,7 @@ * .. * .. External Subroutines .. EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, + $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, $ DTRSNA, XERBLA * .. * .. External Functions .. @@ -366,8 +369,8 @@ WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, - $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) + IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) + $ .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) $ THEN INFO = -1 ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN @@ -406,9 +409,19 @@ MAXWRK = N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL DTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL DTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -420,7 +433,7 @@ $ LDVR, WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -572,18 +585,18 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from DHSEQR, then quit +* If INFO .NE. 0 from DHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 3*N) +* (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/dgejsv.f b/lapack-netlib/SRC/dgejsv.f index 4b26a1d6..fc91ab51 100644 --- a/lapack-netlib/SRC/dgejsv.f +++ b/lapack-netlib/SRC/dgejsv.f @@ -52,7 +52,8 @@ *> are computed and stored in the arrays U and V, respectively. The diagonal *> of [SIGMA] is computed and stored in the array SVA. *> DGEJSV can sometimes compute tiny singular values and their singular vectors much -*> more accurately than other SVD routines, see below under Further Details.*> \endverbatim +*> more accurately than other SVD routines, see below under Further Details. +*> \endverbatim * * Arguments: * ========== @@ -236,7 +237,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -258,7 +259,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -332,10 +333,10 @@ *> If SIGMA and the right singular vectors are needed (JOBV.EQ.'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, +*> where NB is the optimal block size for DGEQP3, DGEQRF, DGELQF, *> DORMLQ. In general, the optimal length LWORK is computed as *> LWORK >= max(2*M+N,N+LWORK(DGEQP3), N+LWORK(DPOCON), -*> N+LWORK(DGELQ), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)). +*> N+LWORK(DGELQF), 2*N+LWORK(DGEQRF), N+LWORK(DORMLQ)). *> *> If SIGMA and the left singular vectors are needed *> -> the minimal requirement is LWORK >= max(2*M+N,4*N+1,7). @@ -390,7 +391,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -475,10 +476,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -589,7 +590,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + WORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -715,6 +720,7 @@ IWORK(1) = 0 IWORK(2) = 0 END IF + IWORK(3) = 0 IF ( ERREST ) WORK(3) = ONE IF ( LSVEC .AND. RSVEC ) THEN WORK(4) = ONE diff --git a/lapack-netlib/SRC/dgeqrt3.f b/lapack-netlib/SRC/dgeqrt3.f index c5f57a29..42453dbf 100644 --- a/lapack-netlib/SRC/dgeqrt3.f +++ b/lapack-netlib/SRC/dgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE DGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL DLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL DLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/dgesdd.f b/lapack-netlib/SRC/dgesdd.f index 54e2652e..02beb3be 100644 --- a/lapack-netlib/SRC/dgesdd.f +++ b/lapack-netlib/SRC/dgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, IWORK, INFO ) +* SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -154,8 +154,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -169,16 +169,18 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> If JOBZ = 'N', -*> LWORK >= 3*min(M,N) + max(max(M,N),7*min(M,N)). -*> If JOBZ = 'O', -*> LWORK >= 3*min(M,N) + -*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). -*> If JOBZ = 'S' or 'A' -*> LWORK >= min(M,N)*(7+4*min(M,N)) -*> For good performance, LWORK should generally be larger. -*> If LWORK = -1 but other input arguments are legal, WORK(1) -*> returns the optimal LWORK. +*> If LWORK = -1, a workspace query is assumed. The optimal +*> size for the WORK array is calculated and stored in WORK(1), +*> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 3*mn + max( mx, 7*mn ). +*> If JOBZ = 'O', LWORK >= 3*mn + max( mx, 5*mn*mn + 4*mn ). +*> If JOBZ = 'S', LWORK >= 4*mn*mn + 7*mn. +*> If JOBZ = 'A', LWORK >= 4*mn*mn + 6*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] IWORK @@ -202,7 +204,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -212,14 +214,16 @@ *> Ming Gu and Huan Ren, Computer Science Division, University of *> California at Berkeley, USA *> +*> @precisions fortran d -> s * ===================================================================== - SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, IWORK, INFO ) + SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -243,6 +247,15 @@ $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR, NWORK, WRKBL + INTEGER LWORK_DGEBRD_MN, LWORK_DGEBRD_MM, + $ LWORK_DGEBRD_NN, LWORK_DGELQF_MN, + $ LWORK_DGEQRF_MN, + $ LWORK_DORGBR_P_MM, LWORK_DORGBR_Q_NN, + $ LWORK_DORGLQ_MN, LWORK_DORGLQ_NN, + $ LWORK_DORGQR_MM, LWORK_DORGQR_MN, + $ LWORK_DORMBR_PRT_MM, LWORK_DORMBR_QLN_MM, + $ LWORK_DORMBR_PRT_MN, LWORK_DORMBR_QLN_MN, + $ LWORK_DORMBR_PRT_NN, LWORK_DORMBR_QLN_NN DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -256,9 +269,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL DLAMCH, DLANGE, ILAENV, LSAME + EXTERNAL DLAMCH, DLANGE, LSAME * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -267,13 +279,13 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) LQUERY = ( LWORK.EQ.-1 ) * IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN @@ -294,115 +306,140 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * NB refers to the optimal block size for the immediately -* following subroutine, as returned by ILAENV.) +* following subroutine, as returned by ILAENV. * IF( INFO.EQ.0 ) THEN MINWRK = 1 MAXWRK = 1 + BDSPAC = 0 + MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( M.GE.N .AND. MINMN.GT.0 ) THEN * * Compute space needed for DBDSDC * - MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( WNTQN ) THEN +* dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N END IF +* +* Compute space preferred for each routine + CALL DGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MN = INT( DUM(1) ) +* + CALL DGEBRD( N, N, DUM(1), N, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_NN = INT( DUM(1) ) +* + CALL DGEQRF( M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DGEQRF_MN = INT( DUM(1) ) +* + CALL DORGBR( 'Q', N, N, N, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) + LWORK_DORGBR_Q_NN = INT( DUM(1) ) +* + CALL DORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGQR_MM = INT( DUM(1) ) +* + CALL DORGQR( M, N, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGQR_MN = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, N, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, M, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MM = INT( DUM(1) ) +* IF( M.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+N ) + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + MAXWRK = MAX( WRKBL, BDSPAC + N ) MINWRK = BDSPAC + N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') -* - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 2 (M >> N, JOBZ='O') +* + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + 2*N*N MINWRK = BDSPAC + 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') -* - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'DORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 3 (M >> N, JOBZ='S') +* + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N MINWRK = BDSPAC + N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') -* - WRKBL = N + N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'DORGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 4 (M >> N, JOBZ='A') +* + WRKBL = N + LWORK_DGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N - MINWRK = BDSPAC + N*N + 2*N + M + MINWRK = N*N + MAX( 3*N + BDSPAC, N + M ) END IF ELSE * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * - WRKBL = 3*N + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*N + LWORK_DGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5n (M >= N, jobz='N') + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 5o (M >= N, jobz='O') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*N + MAX( M, N*N+BDSPAC ) + MINWRK = 3*N + MAX( M, N*N + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5s (M >= N, jobz='S') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*N+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, BDSPAC+3*N ) +* Path 5a (M >= N, jobz='A') + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) END IF END IF @@ -410,106 +447,129 @@ * * Compute space needed for DBDSDC * - MNTHR = INT( MINMN*11.0D0 / 6.0D0 ) IF( WNTQN ) THEN +* dbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M END IF +* +* Compute space preferred for each routine + CALL DGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MN = INT( DUM(1) ) +* + CALL DGEBRD( M, M, A, M, S, DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_DGEBRD_MM = INT( DUM(1) ) +* + CALL DGELQF( M, N, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_DGELQF_MN = INT( DUM(1) ) +* + CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGLQ_NN = INT( DUM(1) ) +* + CALL DORGLQ( M, N, M, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGLQ_MN = INT( DUM(1) ) +* + CALL DORGBR( 'P', M, M, M, A, N, DUM(1), DUM(1), -1, IERR ) + LWORK_DORGBR_P_MM = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_MM = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', M, N, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_MN = INT( DUM(1) ) +* + CALL DORMBR( 'P', 'R', 'T', N, N, M, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_DORMBR_PRT_NN = INT( DUM(1) ) +* + CALL DORMBR( 'Q', 'L', 'N', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_DORMBR_QLN_MM = INT( DUM(1) ) +* IF( N.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+M ) + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + MAXWRK = MAX( WRKBL, BDSPAC + M ) MINWRK = BDSPAC + M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') -* - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 2t (N >> M, JOBZ='O') +* + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + 2*M*M MINWRK = BDSPAC + 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'DORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 3t (N >> M, JOBZ='S') +* + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M MINWRK = BDSPAC + M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') -* - WRKBL = M + M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'DORGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 4t (N >> M, JOBZ='A') +* + WRKBL = M + LWORK_DGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_NN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M - MINWRK = BDSPAC + M*M + 3*M + MINWRK = M*M + MAX( 3*M + BDSPAC, M + N ) END IF ELSE * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * - WRKBL = 3*M + ( M+N )*ILAENV( 1, 'DGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*M + LWORK_DGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5tn (N > M, jobz='N') + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 5to (N > M, jobz='O') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MN ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*M + MAX( N, M*M+BDSPAC ) + MINWRK = 3*M + MAX( N, M*M + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', M, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ts (N > M, jobz='S') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_MN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'DORMBR', 'PRT', N, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ta (N > M, jobz='A') + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) END IF END IF END IF + MAXWRK = MAX( MAXWRK, MINWRK ) WORK( 1 ) = MAXWRK * @@ -559,17 +619,18 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* Workspace: need N [tau] + N [work] +* Workspace: prefer N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out below R * @@ -580,7 +641,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -588,14 +650,14 @@ NWORK = IE + N * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need N+BDSPAC) +* Workspace: need N [e] + BDSPAC * CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ = 'O') +* Path 2 (M >> N, JOBZ = 'O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -603,42 +665,45 @@ * * WORK(IR) is LDWRKR by N * - IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. LDA*N + N*N + 3*N + BDSPAC ) THEN LDWRKR = LDA ELSE - LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N + LDWRKR = ( LWORK - N*N - 3*N - BDSPAC ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL DLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * -* Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Bidiagonalize R in WORK(IR) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * WORK(IU) is N by N * @@ -648,7 +713,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -656,21 +721,23 @@ * * Overwrite WORK(IU) by left singular vectors of R * and VT by right singular vectors of R -* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] +* Workspace: prefer M*N [R] + 3*N [e, tauq, taup] + N*N [U] * DO 10 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), N, ZERO, WORK( IR ), $ LDWRKR ) @@ -680,7 +747,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -693,38 +760,41 @@ NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL DLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL DLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagoal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -732,19 +802,20 @@ * * Overwrite U by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * CALL DORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (Workspace: need N*N) +* Workspace: need N*N [R] * CALL DLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL DGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ), @@ -752,7 +823,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -765,16 +836,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + N [work] +* Workspace: prefer N*N [U] + N [tau] + N*NB [work] * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + M [work] +* Workspace: prefer N*N [U] + N [tau] + M*NB [work] CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce R in A, zeroing out other entries * @@ -785,7 +858,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -794,7 +868,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -802,18 +876,19 @@ * * Overwrite WORK(IU) by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', N, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (Workspace: need N*N) +* Workspace: need N*N [U] * CALL DGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), $ LDWRKU, ZERO, A, LDA ) @@ -828,7 +903,7 @@ * * M .LT. MNTHR * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * IE = 1 @@ -837,21 +912,24 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + (M+N)*NB [work] * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >= N, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5o (M >= N, JOBZ='O') IU = NWORK - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * * WORK( IU ) is M by N * @@ -859,6 +937,8 @@ NWORK = IU + LDWRKU*N CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IU ), $ LDWRKU ) +* IR is unused; silence compile warnings + IR = -1 ELSE * * WORK( IU ) is N by N @@ -869,53 +949,59 @@ * WORK(IR) is LDWRKR by N * IR = NWORK - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ), $ IWORK, INFO ) * * Overwrite VT by right singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * +* Path 5o-fast * Overwrite WORK(IU) by left singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + M*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*N [U] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy left singular vectors of A from WORK(IU) to A * CALL DLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 5o-slow * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of * bidiagonal matrix in WORK(IU), storing result in * WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + NB*N [R] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + M*N [R] * DO 20 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL DGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) @@ -926,10 +1012,11 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, N, ZERO, ZERO, U, LDU ) CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -938,20 +1025,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*N, prefer 2*N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, M, ZERO, ZERO, U, LDU ) CALL DBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -961,20 +1050,21 @@ * Set the right corner of U to identity matrix * IF( M.GT.N ) THEN - CALL DLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ), + CALL DLASET( 'F', M - N, M - N, ZERO, ONE, U(N+1,N+1), $ LDU ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF @@ -989,17 +1079,18 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* Workspace: need M [tau] + M [work] +* Workspace: prefer M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out above L * @@ -1010,7 +1101,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1018,68 +1110,69 @@ NWORK = IE + M * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need M+BDSPAC) +* Workspace: need M [e] + BDSPAC * CALL DBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * IVT = 1 * -* IVT is M by M +* WORK(IVT) is M by M +* WORK(IL) is M by M; it is later resized to M by chunk for gemm * IL = IVT + M*M - IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN -* -* WORK(IL) is M by N -* + IF( LWORK .GE. M*N + M*M + 3*M + BDSPAC ) THEN LDWRKL = M CHUNK = N ELSE LDWRKL = M - CHUNK = ( LWORK-M*M ) / M + CHUNK = ( LWORK - M*M ) / M END IF ITAU = IL + LDWRKL*M NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it * CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL DLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U, and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ), @@ -1087,21 +1180,24 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by Q * in A, storing result in WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need M*M [VT] + M*M [L] +* Workspace: prefer M*M [VT] + M*N [L] +* At this point, L is resized as M by chunk. * DO 30 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL ) CALL DLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1110,7 +1206,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * M right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1123,38 +1219,41 @@ NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it * CALL DLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL DLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL DLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * -* Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Bidiagonalize L in WORK(IU). +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -1162,18 +1261,19 @@ * * Overwrite U by left singular vectors of L and VT * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IL) by * Q in A, storing result in VT -* (Workspace: need M*M) +* Workspace: need M*M [L] * CALL DLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL, @@ -1181,7 +1281,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1194,17 +1294,19 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M [tau] + M*NB [work] * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + N [work] +* Workspace: prefer M*M [VT] + M [tau] + N*NB [work] * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce L in A, zeroing out other entries * @@ -1215,7 +1317,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1224,7 +1327,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, @@ -1232,18 +1335,19 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup]+ M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup]+ M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, M, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, M, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (Workspace: need M*M) +* Workspace: need M*M [VT] * CALL DGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, $ VT, LDVT, ZERO, A, LDA ) @@ -1258,7 +1362,7 @@ * * N .LT. MNTHR * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * IE = 1 @@ -1267,28 +1371,33 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + (M+N)*NB [work] * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5tn (N > M, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * * WORK( IVT ) is M by N * CALL DLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ), $ LDWKVT ) NWORK = IVT + LDWKVT*N +* IL is unused; silence compile warnings + IL = -1 ELSE * * WORK( IVT ) is M by M @@ -1298,52 +1407,58 @@ * * WORK(IL) is M by CHUNK * - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M*M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + BDSPAC * CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, $ WORK( NWORK ), IWORK, INFO ) * * Overwrite U by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * +* Path 5to-fast * Overwrite WORK(IVT) by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*N [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*N [VT] + M*NB [work] * CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy right singular vectors of A from WORK(IVT) to A * CALL DLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 5to-slow * Generate P**T in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by right singular vectors of * bidiagonal matrix in WORK(IVT), storing result in * WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M*NB [L] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*N [L] * DO 40 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL DGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) @@ -1353,10 +1468,11 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 5ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', M, N, ZERO, ZERO, VT, LDVT ) CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1365,20 +1481,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*M, prefer 2*M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL DLASET( 'F', N, N, ZERO, ZERO, VT, LDVT ) CALL DBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1388,20 +1506,21 @@ * Set the right corner of VT to identity matrix * IF( N.GT.M ) THEN - CALL DLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ), + CALL DLASET( 'F', N-M, N-M, ZERO, ONE, VT(M+1,M+1), $ LDVT ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 2*M+N, prefer 2*M+N*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + N*NB [work] * CALL DORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL DORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF diff --git a/lapack-netlib/SRC/dgesvd.f b/lapack-netlib/SRC/dgesvd.f index 898570b6..0c40673a 100644 --- a/lapack-netlib/SRC/dgesvd.f +++ b/lapack-netlib/SRC/dgesvd.f @@ -175,7 +175,7 @@ *> LWORK >= MAX(1,5*MIN(M,N)) for the paths (see comments inside code): *> - PATH 1 (M much larger than N, JOBU='N') *> - PATH 1t (N much larger than M, JOBVT='N') -*> LWORK >= MAX(1,3*MIN(M,N)+MAX(M,N),5*MIN(M,N)) for the other paths +*> LWORK >= MAX(1,3*MIN(M,N) + MAX(M,N),5*MIN(M,N)) for the other paths *> For good performance, LWORK should generally be larger. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -211,7 +211,7 @@ SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.1) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -314,24 +314,24 @@ BDSPAC = 5*N * Compute space needed for DGEQRF CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DGEQRF=DUM(1) + LWORK_DGEQRF = INT( DUM(1) ) * Compute space needed for DORGQR CALL DORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGQR_N=DUM(1) + LWORK_DORGQR_N = INT( DUM(1) ) CALL DORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGQR_M=DUM(1) + LWORK_DORGQR_M = INT( DUM(1) ) * Compute space needed for DGEBRD CALL DGEBRD( N, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORGBR P CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) + LWORK_DORGBR_P = INT( DUM(1) ) * Compute space needed for DORGBR Q CALL DORGBR( 'Q', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) + LWORK_DORGBR_Q = INT( DUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -339,9 +339,9 @@ * Path 1 (M much larger than N, JOBU='N') * MAXWRK = N + LWORK_DGEQRF - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DGEBRD ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD ) IF( WNTVO .OR. WNTVAS ) - $ MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P ) + $ MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_P ) MAXWRK = MAX( MAXWRK, BDSPAC ) MINWRK = MAX( 4*N, BDSPAC ) ELSE IF( WNTUO .AND. WNTVN ) THEN @@ -349,97 +349,97 @@ * Path 2 (M much larger than N, JOBU='O', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MAXWRK = MAX( N*N + WRKBL, N*N + M*N + N ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUO .AND. WNTVAS ) THEN * * Path 3 (M much larger than N, JOBU='O', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( N*N+WRKBL, N*N+M*N+N ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MAXWRK = MAX( N*N + WRKBL, N*N + M*N + N ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVN ) THEN * * Path 4 (M much larger than N, JOBU='S', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVO ) THEN * * Path 5 (M much larger than N, JOBU='S', JOBVT='O') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUS .AND. WNTVAS ) THEN * * Path 6 (M much larger than N, JOBU='S', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_N ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_N ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVN ) THEN * * Path 7 (M much larger than N, JOBU='A', JOBVT='N') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVO ) THEN * * Path 8 (M much larger than N, JOBU='A', JOBVT='O') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) ELSE IF( WNTUA .AND. WNTVAS ) THEN * * Path 9 (M much larger than N, JOBU='A', JOBVT='S' or * 'A') * WRKBL = N + LWORK_DGEQRF - WRKBL = MAX( WRKBL, N+LWORK_DORGQR_M ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_Q ) - WRKBL = MAX( WRKBL, 3*N+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, N + LWORK_DORGQR_M ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, 3*N + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = N*N + WRKBL - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) END IF ELSE * @@ -447,25 +447,25 @@ * CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) MAXWRK = 3*N + LWORK_DGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL DORGBR( 'Q', M, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q ) + LWORK_DORGBR_Q = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q ) END IF IF( WNTUA ) THEN CALL DORGBR( 'Q', M, M, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_Q ) + LWORK_DORGBR_Q = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_Q ) END IF IF( .NOT.WNTVN ) THEN - MAXWRK = MAX( MAXWRK, 3*N+LWORK_DORGBR_P ) + MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORGBR_P ) END IF MAXWRK = MAX( MAXWRK, BDSPAC ) - MINWRK = MAX( 3*N+M, BDSPAC ) + MINWRK = MAX( 3*N + M, BDSPAC ) END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -475,33 +475,33 @@ BDSPAC = 5*M * Compute space needed for DGELQF CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DGELQF=DUM(1) + LWORK_DGELQF = INT( DUM(1) ) * Compute space needed for DORGLQ CALL DORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGLQ_N=DUM(1) + LWORK_DORGLQ_N = INT( DUM(1) ) CALL DORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_DORGLQ_M=DUM(1) + LWORK_DORGLQ_M = INT( DUM(1) ) * Compute space needed for DGEBRD CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORGBR P CALL DORGBR( 'P', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) + LWORK_DORGBR_P = INT( DUM(1) ) * Compute space needed for DORGBR Q CALL DORGBR( 'Q', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_Q=DUM(1) + LWORK_DORGBR_Q = INT( DUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * * Path 1t(N much larger than M, JOBVT='N') * MAXWRK = M + LWORK_DGELQF - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DGEBRD ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DGEBRD ) IF( WNTUO .OR. WNTUAS ) - $ MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q ) + $ MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_Q ) MAXWRK = MAX( MAXWRK, BDSPAC ) MINWRK = MAX( 4*M, BDSPAC ) ELSE IF( WNTVO .AND. WNTUN ) THEN @@ -509,97 +509,97 @@ * Path 2t(N much larger than M, JOBU='N', JOBVT='O') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MAXWRK = MAX( M*M + WRKBL, M*M + M*N + M ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVO .AND. WNTUAS ) THEN * * Path 3t(N much larger than M, JOBU='S' or 'A', * JOBVT='O') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) - MAXWRK = MAX( M*M+WRKBL, M*M+M*N+M ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MAXWRK = MAX( M*M + WRKBL, M*M + M*N + M ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUN ) THEN * * Path 4t(N much larger than M, JOBU='N', JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUO ) THEN * * Path 5t(N much larger than M, JOBU='O', JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVS .AND. WNTUAS ) THEN * * Path 6t(N much larger than M, JOBU='S' or 'A', * JOBVT='S') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_M ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_M ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUN ) THEN * * Path 7t(N much larger than M, JOBU='N', JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUO ) THEN * * Path 8t(N much larger than M, JOBU='O', JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = 2*M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) ELSE IF( WNTVA .AND. WNTUAS ) THEN * * Path 9t(N much larger than M, JOBU='S' or 'A', * JOBVT='A') * WRKBL = M + LWORK_DGELQF - WRKBL = MAX( WRKBL, M+LWORK_DORGLQ_N ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DGEBRD ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_P ) - WRKBL = MAX( WRKBL, 3*M+LWORK_DORGBR_Q ) + WRKBL = MAX( WRKBL, M + LWORK_DORGLQ_N ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DGEBRD ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_P ) + WRKBL = MAX( WRKBL, 3*M + LWORK_DORGBR_Q ) WRKBL = MAX( WRKBL, BDSPAC ) MAXWRK = M*M + WRKBL - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) END IF ELSE * @@ -607,26 +607,26 @@ * CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) MAXWRK = 3*M + LWORK_DGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for DORGBR P CALL DORGBR( 'P', M, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P ) + LWORK_DORGBR_P = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P ) END IF IF( WNTVA ) THEN CALL DORGBR( 'P', N, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_DORGBR_P=DUM(1) - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_P ) + LWORK_DORGBR_P = INT( DUM(1) ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_P ) END IF IF( .NOT.WNTUN ) THEN - MAXWRK = MAX( MAXWRK, 3*M+LWORK_DORGBR_Q ) + MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR_Q ) END IF MAXWRK = MAX( MAXWRK, BDSPAC ) - MINWRK = MAX( 3*M+N, BDSPAC ) + MINWRK = MAX( 3*M + N, BDSPAC ) END IF END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -685,21 +685,24 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Zero out below R * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N IWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -708,7 +711,7 @@ IF( WNTVO .OR. WNTVAS ) THEN * * If right singular vectors desired, generate P'. -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -739,13 +742,13 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + LDA*N ) THEN * * WORK(IU) is LDA by N, WORK(IR) is LDA by N * LDWRKU = LDA LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + N*N ) THEN * * WORK(IU) is LDA by N, WORK(IR) is N by N * @@ -762,7 +765,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -774,7 +777,7 @@ $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -784,14 +787,14 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing R -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -800,7 +803,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, 1, $ WORK( IR ), LDWRKR, DUM, 1, @@ -809,7 +812,7 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in WORK(IU) and copying to A -* (Workspace: need N*N+2*N, prefer N*N+M*N+N) +* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) * DO 10 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) @@ -830,14 +833,14 @@ IWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing A -* (Workspace: need 4*N, prefer 3*N+N*NB) +* (Workspace: need 4*N, prefer 3*N + N*NB) * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -863,13 +866,13 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+LDA*N ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + LDA*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by N * LDWRKU = LDA LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+N )+N*N ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + N ) + N*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -886,7 +889,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -899,7 +902,7 @@ $ VT( 2, 1 ), LDVT ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -909,7 +912,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -917,14 +920,14 @@ CALL DLACPY( 'L', N, N, VT, LDVT, WORK( IR ), LDWRKR ) * * Generate left vectors bidiagonalizing R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in VT -* (Workspace: need N*N+4*N-1, prefer N*N+3*N+(N-1)*NB) +* (Workspace: need N*N + 4*N-1, prefer N*N + 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -933,7 +936,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) and computing right * singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, LDVT, $ WORK( IR ), LDWRKR, DUM, 1, @@ -942,7 +945,7 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in WORK(IU) and copying to A -* (Workspace: need N*N+2*N, prefer N*N+M*N+N) +* (Workspace: need N*N + 2*N, prefer N*N + M*N + N) * DO 20 I = 1, M, LDWRKU CHUNK = MIN( M-I+1, LDWRKU ) @@ -961,7 +964,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -974,7 +977,7 @@ $ VT( 2, 1 ), LDVT ) * * Generate Q in A -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -984,21 +987,21 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in A by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), A, LDA, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1042,7 +1045,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1055,7 +1058,7 @@ $ WORK( IR+1 ), LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1065,7 +1068,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1073,7 +1076,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -1082,7 +1085,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, @@ -1103,14 +1106,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1121,18 +1124,20 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in U by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), @@ -1167,7 +1172,7 @@ LDWRKU = LDA IR = IU + LDWRKU*N LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + N )*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -1186,7 +1191,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1199,7 +1204,7 @@ $ WORK( IU+1 ), LDWRKU ) * * Generate Q in A -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1210,7 +1215,7 @@ * * Bidiagonalize R in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*N*N+4*N, +* (Workspace: need 2*N*N + 4*N, * prefer 2*N*N+3*N+2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, @@ -1221,14 +1226,14 @@ $ WORK( IR ), LDWRKR ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) +* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*N*N+4*N-1, +* (Workspace: need 2*N*N + 4*N-1, * prefer 2*N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR, @@ -1239,7 +1244,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in WORK(IR) -* (Workspace: need 2*N*N+BDSPAC) +* (Workspace: need 2*N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, WORK( IU ), @@ -1266,14 +1271,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1284,25 +1289,27 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply Q in U by left vectors bidiagonalizing R -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing R in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1346,7 +1353,7 @@ IWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1359,7 +1366,7 @@ $ WORK( IU+1 ), LDWRKU ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DORGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1369,7 +1376,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IU), copying result to VT -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1379,14 +1386,14 @@ $ LDVT ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need N*N+4*N-1, +* (Workspace: need N*N + 4*N-1, * prefer N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -1396,7 +1403,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, $ LDVT, WORK( IU ), LDWRKU, DUM, 1, @@ -1417,14 +1424,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DORGQR( M, N, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1441,7 +1448,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1449,14 +1456,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in VT -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1503,7 +1510,7 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1517,7 +1524,7 @@ $ WORK( IR+1 ), LDWRKR ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1527,7 +1534,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1535,7 +1542,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -1544,7 +1551,7 @@ * * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IR) -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, 0, N, 0, S, WORK( IE ), DUM, $ 1, WORK( IR ), LDWRKR, DUM, 1, @@ -1569,14 +1576,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1587,11 +1594,13 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1599,7 +1608,7 @@ * * Multiply Q in U by left bidiagonalizing vectors * in A -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), @@ -1634,7 +1643,7 @@ LDWRKU = LDA IR = IU + LDWRKU*N LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+N )*N ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + N )*N ) THEN * * WORK(IU) is LDA by N and WORK(IR) is N by N * @@ -1653,14 +1662,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N*N+2*N, prefer 2*N*N+N+N*NB) +* (Workspace: need 2*N*N + 2*N, prefer 2*N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need 2*N*N+N+M, prefer 2*N*N+N+M*NB) +* (Workspace: need 2*N*N + N + M, prefer 2*N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1678,7 +1687,7 @@ * * Bidiagonalize R in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*N*N+4*N, +* (Workspace: need 2*N*N + 4*N, * prefer 2*N*N+3*N+2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, @@ -1689,14 +1698,14 @@ $ WORK( IR ), LDWRKR ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*N*N+4*N, prefer 2*N*N+3*N+N*NB) +* (Workspace: need 2*N*N + 4*N, prefer 2*N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*N*N+4*N-1, +* (Workspace: need 2*N*N + 4*N-1, * prefer 2*N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, WORK( IR ), LDWRKR, @@ -1707,7 +1716,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in WORK(IR) -* (Workspace: need 2*N*N+BDSPAC) +* (Workspace: need 2*N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, WORK( IU ), @@ -1737,14 +1746,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1755,11 +1764,13 @@ * * Zero out below R in A * - CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL DLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1767,14 +1778,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in A -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1818,14 +1829,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* (Workspace: need N*N + 2*N, prefer N*N + N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* (Workspace: need N*N + N + M, prefer N*N + N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1842,7 +1853,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in WORK(IU), copying result to VT -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + 2*N*NB) * CALL DGEBRD( N, N, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -1852,14 +1863,14 @@ $ LDVT ) * * Generate left bidiagonalizing vectors in WORK(IU) -* (Workspace: need N*N+4*N, prefer N*N+3*N+N*NB) +* (Workspace: need N*N + 4*N, prefer N*N + 3*N + N*NB) * CALL DORGBR( 'Q', N, N, N, WORK( IU ), LDWRKU, $ WORK( ITAUQ ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need N*N+4*N-1, +* (Workspace: need N*N + 4*N-1, * prefer N*N+3*N+(N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -1869,7 +1880,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of R in WORK(IU) and computing * right singular vectors of R in VT -* (Workspace: need N*N+BDSPAC) +* (Workspace: need N*N + BDSPAC) * CALL DBDSQR( 'U', N, N, N, 0, S, WORK( IE ), VT, $ LDVT, WORK( IU ), LDWRKU, DUM, 1, @@ -1894,14 +1905,14 @@ IWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need 2*N, prefer N+N*NB) +* (Workspace: need 2*N, prefer N + N*NB) * CALL DGEQRF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N+M, prefer N+M*NB) +* (Workspace: need N + M, prefer N + M*NB) * CALL DORGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1918,7 +1929,7 @@ IWORK = ITAUP + N * * Bidiagonalize R in VT -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* (Workspace: need 4*N, prefer 3*N + 2*N*NB) * CALL DGEBRD( N, N, VT, LDVT, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -1926,14 +1937,14 @@ * * Multiply Q in U by left bidiagonalizing vectors * in VT -* (Workspace: need 3*N+M, prefer 3*N+M*NB) +* (Workspace: need 3*N + M, prefer 3*N + M*NB) * CALL DORMBR( 'Q', 'R', 'N', M, N, N, VT, LDVT, $ WORK( ITAUQ ), U, LDU, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -1967,7 +1978,7 @@ IWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* (Workspace: need 3*N + M, prefer 3*N + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -1976,7 +1987,7 @@ * * If left singular vectors desired in U, copy result to U * and generate left bidiagonalizing vectors in U -* (Workspace: need 3*N+NCU, prefer 3*N+NCU*NB) +* (Workspace: need 3*N + NCU, prefer 3*N + NCU*NB) * CALL DLACPY( 'L', M, N, A, LDA, U, LDU ) IF( WNTUS ) @@ -1990,7 +2001,7 @@ * * If right singular vectors desired in VT, copy result to * VT and generate right bidiagonalizing vectors in VT -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL DORGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), @@ -2000,7 +2011,7 @@ * * If left singular vectors desired in A, generate left * bidiagonalizing vectors in A -* (Workspace: need 4*N, prefer 3*N+N*NB) +* (Workspace: need 4*N, prefer 3*N + N*NB) * CALL DORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2009,7 +2020,7 @@ * * If right singular vectors desired in A, generate right * bidiagonalizing vectors in A -* (Workspace: need 4*N-1, prefer 3*N+(N-1)*NB) +* (Workspace: need 4*N-1, prefer 3*N + (N-1)*NB) * CALL DORGBR( 'P', N, N, N, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2071,7 +2082,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) @@ -2085,7 +2096,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -2093,7 +2104,7 @@ IF( WNTUO .OR. WNTUAS ) THEN * * If left singular vectors desired, generate Q -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2126,14 +2137,14 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + LDA*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by M * LDWRKU = LDA CHUNK = N LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + M*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is M by M * @@ -2152,7 +2163,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2164,7 +2175,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2174,14 +2185,14 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing L -* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), @@ -2190,7 +2201,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2199,7 +2210,7 @@ * * Multiply right singular vectors of L in WORK(IR) by Q * in A, storing result in WORK(IU) and copying to A -* (Workspace: need M*M+2*M, prefer M*M+M*N+M) +* (Workspace: need M*M + 2*M, prefer M*M + M*N + M) * DO 30 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -2220,14 +2231,14 @@ IWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate right vectors bidiagonalizing A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2253,14 +2264,14 @@ * Sufficient workspace for a fast algorithm * IR = 1 - IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+LDA*M ) THEN + IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + LDA*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is LDA by M * LDWRKU = LDA CHUNK = N LDWRKR = LDA - ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N+M )+M*M ) THEN + ELSE IF( LWORK.GE.MAX( WRKBL, LDA*N + M ) + M*M ) THEN * * WORK(IU) is LDA by N and WORK(IR) is M by M * @@ -2279,7 +2290,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2291,7 +2302,7 @@ $ LDU ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2301,7 +2312,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U, copying result to WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2309,14 +2320,14 @@ CALL DLACPY( 'U', M, M, U, LDU, WORK( IR ), LDWRKR ) * * Generate right vectors bidiagonalizing L in WORK(IR) -* (Workspace: need M*M+4*M-1, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M-1, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing L in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2325,7 +2336,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U, and computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, U, LDU, DUM, 1, @@ -2334,7 +2345,7 @@ * * Multiply right singular vectors of L in WORK(IR) by Q * in A, storing result in WORK(IU) and copying to A -* (Workspace: need M*M+2*M, prefer M*M+M*N+M)) +* (Workspace: need M*M + 2*M, prefer M*M + M*N + M)) * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -2353,7 +2364,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2365,7 +2376,7 @@ $ LDU ) * * Generate Q in A -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2375,21 +2386,21 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in A -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), A, LDA, WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left vectors bidiagonalizing L in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2433,7 +2444,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2446,7 +2457,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2456,7 +2467,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2465,7 +2476,7 @@ * * Generate right vectors bidiagonalizing L in * WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUP ), WORK( IWORK ), @@ -2474,7 +2485,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2495,7 +2506,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2505,7 +2516,7 @@ CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2520,14 +2531,14 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, @@ -2562,7 +2573,7 @@ LDWRKU = LDA IR = IU + LDWRKU*M LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + M )*M ) THEN * * WORK(IU) is LDA by M and WORK(IR) is M by M * @@ -2581,7 +2592,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2594,7 +2605,7 @@ $ WORK( IU+LDWRKU ), LDWRKU ) * * Generate Q in A -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2605,7 +2616,7 @@ * * Bidiagonalize L in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*M*M+4*M, +* (Workspace: need 2*M*M + 4*M, * prefer 2*M*M+3*M+2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, @@ -2616,7 +2627,7 @@ $ WORK( IR ), LDWRKR ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*M*M+4*M-1, +* (Workspace: need 2*M*M + 4*M-1, * prefer 2*M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -2624,7 +2635,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) +* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -2634,7 +2645,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in WORK(IR) and computing * right singular vectors of L in WORK(IU) -* (Workspace: need 2*M*M+BDSPAC) +* (Workspace: need 2*M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, WORK( IR ), @@ -2661,14 +2672,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2683,21 +2694,21 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Multiply right vectors bidiagonalizing L by Q in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors of L in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2741,7 +2752,7 @@ IWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2754,7 +2765,7 @@ $ WORK( IU+LDWRKU ), LDWRKU ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DORGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2764,7 +2775,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2774,7 +2785,7 @@ $ LDU ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need M*M+4*M-1, +* (Workspace: need M*M + 4*M-1, * prefer M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -2782,7 +2793,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2791,7 +2802,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U and computing right * singular vectors of L in WORK(IU) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, U, LDU, DUM, 1, @@ -2812,14 +2823,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DORGLQ( M, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2835,7 +2846,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2843,14 +2854,14 @@ * * Multiply right bidiagonalizing vectors in U by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2877,7 +2888,7 @@ * N right singular vectors to be computed in VT and * no left singular vectors to be computed * - IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -2897,7 +2908,7 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2911,7 +2922,7 @@ $ WORK( IR+LDWRKR ), LDWRKR ) * * Generate Q in VT -* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) +* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2921,7 +2932,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IR) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IR ), LDWRKR, S, $ WORK( IE ), WORK( ITAUQ ), @@ -2929,7 +2940,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate right bidiagonalizing vectors in WORK(IR) -* (Workspace: need M*M+4*M-1, +* (Workspace: need M*M + 4*M-1, * prefer M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IR ), LDWRKR, @@ -2939,7 +2950,7 @@ * * Perform bidiagonal QR iteration, computing right * singular vectors of L in WORK(IR) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, 0, 0, S, WORK( IE ), $ WORK( IR ), LDWRKR, DUM, 1, DUM, 1, @@ -2964,14 +2975,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -2986,7 +2997,7 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -2994,7 +3005,7 @@ * * Multiply right bidiagonalizing vectors in A by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, @@ -3017,7 +3028,7 @@ * N right singular vectors to be computed in VT and * M left singular vectors to be overwritten on A * - IF( LWORK.GE.2*M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.2*M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -3029,7 +3040,7 @@ LDWRKU = LDA IR = IU + LDWRKU*M LDWRKR = LDA - ELSE IF( LWORK.GE.WRKBL+( LDA+M )*M ) THEN + ELSE IF( LWORK.GE.WRKBL+( LDA + M )*M ) THEN * * WORK(IU) is LDA by M and WORK(IR) is M by M * @@ -3048,14 +3059,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M*M+2*M, prefer 2*M*M+M+M*NB) +* (Workspace: need 2*M*M + 2*M, prefer 2*M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need 2*M*M+M+N, prefer 2*M*M+M+N*NB) +* (Workspace: need 2*M*M + M + N, prefer 2*M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3073,7 +3084,7 @@ * * Bidiagonalize L in WORK(IU), copying result to * WORK(IR) -* (Workspace: need 2*M*M+4*M, +* (Workspace: need 2*M*M + 4*M, * prefer 2*M*M+3*M+2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, @@ -3084,7 +3095,7 @@ $ WORK( IR ), LDWRKR ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need 2*M*M+4*M-1, +* (Workspace: need 2*M*M + 4*M-1, * prefer 2*M*M+3*M+(M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, @@ -3092,7 +3103,7 @@ $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in WORK(IR) -* (Workspace: need 2*M*M+4*M, prefer 2*M*M+3*M+M*NB) +* (Workspace: need 2*M*M + 4*M, prefer 2*M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IWORK ), @@ -3102,7 +3113,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in WORK(IR) and computing * right singular vectors of L in WORK(IU) -* (Workspace: need 2*M*M+BDSPAC) +* (Workspace: need 2*M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, WORK( IR ), @@ -3132,14 +3143,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3154,7 +3165,7 @@ $ LDA ) * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, A, LDA, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -3162,14 +3173,14 @@ * * Multiply right bidiagonalizing vectors in A by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3193,7 +3204,7 @@ * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * - IF( LWORK.GE.M*M+MAX( N+M, 4*M, BDSPAC ) ) THEN + IF( LWORK.GE.M*M+MAX( N + M, 4*M, BDSPAC ) ) THEN * * Sufficient workspace for a fast algorithm * @@ -3213,14 +3224,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* (Workspace: need M*M + 2*M, prefer M*M + M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+M+N, prefer M*M+M+N*NB) +* (Workspace: need M*M + M + N, prefer M*M + M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3237,7 +3248,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + 2*M*NB) * CALL DGEBRD( M, M, WORK( IU ), LDWRKU, S, $ WORK( IE ), WORK( ITAUQ ), @@ -3247,14 +3258,14 @@ $ LDU ) * * Generate right bidiagonalizing vectors in WORK(IU) -* (Workspace: need M*M+4*M, prefer M*M+3*M+(M-1)*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + (M-1)*NB) * CALL DORGBR( 'P', M, M, M, WORK( IU ), LDWRKU, $ WORK( ITAUP ), WORK( IWORK ), $ LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need M*M+4*M, prefer M*M+3*M+M*NB) +* (Workspace: need M*M + 4*M, prefer M*M + 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3263,7 +3274,7 @@ * Perform bidiagonal QR iteration, computing left * singular vectors of L in U and computing right * singular vectors of L in WORK(IU) -* (Workspace: need M*M+BDSPAC) +* (Workspace: need M*M + BDSPAC) * CALL DBDSQR( 'U', M, M, M, 0, S, WORK( IE ), $ WORK( IU ), LDWRKU, U, LDU, DUM, 1, @@ -3288,14 +3299,14 @@ IWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need 2*M, prefer M+M*NB) +* (Workspace: need 2*M, prefer M + M*NB) * CALL DGELQF( M, N, A, LDA, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M+N, prefer M+N*NB) +* (Workspace: need M + N, prefer M + N*NB) * CALL DORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3311,7 +3322,7 @@ IWORK = ITAUP + M * * Bidiagonalize L in U -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* (Workspace: need 4*M, prefer 3*M + 2*M*NB) * CALL DGEBRD( M, M, U, LDU, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), @@ -3319,14 +3330,14 @@ * * Multiply right bidiagonalizing vectors in U by Q * in VT -* (Workspace: need 3*M+N, prefer 3*M+N*NB) +* (Workspace: need 3*M + N, prefer 3*M + N*NB) * CALL DORMBR( 'P', 'L', 'T', M, N, M, U, LDU, $ WORK( ITAUP ), VT, LDVT, $ WORK( IWORK ), LWORK-IWORK+1, IERR ) * * Generate left bidiagonalizing vectors in U -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'Q', M, M, M, U, LDU, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3360,7 +3371,7 @@ IWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* (Workspace: need 3*M + N, prefer 3*M + (M + N)*NB) * CALL DGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( IWORK ), LWORK-IWORK+1, @@ -3369,7 +3380,7 @@ * * If left singular vectors desired in U, copy result to U * and generate left bidiagonalizing vectors in U -* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) +* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) * CALL DLACPY( 'L', M, M, A, LDA, U, LDU ) CALL DORGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -3379,7 +3390,7 @@ * * If right singular vectors desired in VT, copy result to * VT and generate right bidiagonalizing vectors in VT -* (Workspace: need 3*M+NRVT, prefer 3*M+NRVT*NB) +* (Workspace: need 3*M + NRVT, prefer 3*M + NRVT*NB) * CALL DLACPY( 'U', M, N, A, LDA, VT, LDVT ) IF( WNTVA ) @@ -3393,7 +3404,7 @@ * * If left singular vectors desired in A, generate left * bidiagonalizing vectors in A -* (Workspace: need 4*M-1, prefer 3*M+(M-1)*NB) +* (Workspace: need 4*M-1, prefer 3*M + (M-1)*NB) * CALL DORGBR( 'Q', M, M, N, A, LDA, WORK( ITAUQ ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) @@ -3402,7 +3413,7 @@ * * If right singular vectors desired in A, generate right * bidiagonalizing vectors in A -* (Workspace: need 4*M, prefer 3*M+M*NB) +* (Workspace: need 4*M, prefer 3*M + M*NB) * CALL DORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( IWORK ), LWORK-IWORK+1, IERR ) diff --git a/lapack-netlib/SRC/dgesvdx.f b/lapack-netlib/SRC/dgesvdx.f index cfa2ff05..accf2594 100644 --- a/lapack-netlib/SRC/dgesvdx.f +++ b/lapack-netlib/SRC/dgesvdx.f @@ -123,13 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -137,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -169,7 +175,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -248,7 +254,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEsing * @@ -257,10 +263,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -357,8 +363,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -380,18 +392,34 @@ * * Path 1 (M much larger than N) * - MAXWRK = N*(N*2+16) + + MAXWRK = N + $ N*ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N* + MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N* $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = N*(N*3+20) ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = N*(N*2+19) + ( M+N )* + MAXWRK = 4*N + ( M+N )* $ ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) - MINWRK = N*(N*2+20) + M + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'DORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'DORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE MNTHR = ILAENV( 6, 'DGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -399,18 +427,34 @@ * * Path 1t (N much larger than M) * - MAXWRK = M*(M*2+16) + + MAXWRK = M + $ M*ILAENV( 1, 'DGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M* + MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M* $ ILAENV( 1, 'DGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = M*(M*3+20) ELSE * -* Path 2t (N greater than M, but not much larger) +* Path 2t (N at least M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* + MAXWRK = 4*M + ( M+N )* $ ILAENV( 1, 'DGEBRD', ' ', M, N, -1, -1 ) - MINWRK = M*(M*2+20) + N + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'DORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'DORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = MAX(M*(M*2+19),4*M+N) END IF END IF END IF @@ -522,7 +566,7 @@ CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call DORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,7 +635,7 @@ CALL DCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL DLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL DLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call DORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -687,7 +731,7 @@ CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call DORMBR to compute (VB**T)*(PB**T) * (Workspace in WORK( ITEMP ): need M, prefer M*NB) @@ -756,7 +800,7 @@ CALL DCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL DLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL DLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call DORMBR to compute VB**T * PB**T * (Workspace in WORK( ITEMP ): need M, prefer M*NB) diff --git a/lapack-netlib/SRC/dgetc2.f b/lapack-netlib/SRC/dgetc2.f index 3cd7eeb2..3f6be168 100644 --- a/lapack-netlib/SRC/dgetc2.f +++ b/lapack-netlib/SRC/dgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE DGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/dgetrf2.f b/lapack-netlib/SRC/dgetrf2.f index b1871b5d..30aa42d6 100644 --- a/lapack-netlib/SRC/dgetrf2.f +++ b/lapack-netlib/SRC/dgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE DGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/dgghd3.f b/lapack-netlib/SRC/dgghd3.f index 812df3f2..034e9438 100644 --- a/lapack-netlib/SRC/dgghd3.f +++ b/lapack-netlib/SRC/dgghd3.f @@ -230,7 +230,7 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'DGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = DBLE( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/dgsvj1.f b/lapack-netlib/SRC/dgsvj1.f index b32ba0fe..a0620d65 100644 --- a/lapack-netlib/SRC/dgsvj1.f +++ b/lapack-netlib/SRC/dgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b DGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b DGSVJ1 pre-processor for the routine dgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE DGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. DOUBLE PRECISION EPS, SFMIN, TOL diff --git a/lapack-netlib/SRC/dhgeqz.f b/lapack-netlib/SRC/dhgeqz.f index bf6e414d..e5b02fc7 100644 --- a/lapack-netlib/SRC/dhgeqz.f +++ b/lapack-netlib/SRC/dhgeqz.f @@ -211,12 +211,12 @@ *> \param[in,out] Q *> \verbatim *> Q is DOUBLE PRECISION array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in +*> On entry, if COMPQ = 'V', the orthogonal matrix Q1 used in *> the reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix +*> On exit, if COMPQ = 'I', the orthogonal matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the orthogonal matrix *> of left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -282,7 +282,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -304,10 +304,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, COMPZ, JOB diff --git a/lapack-netlib/SRC/dlaed1.f b/lapack-netlib/SRC/dlaed1.f index c37c1d21..b4e01836 100644 --- a/lapack-netlib/SRC/dlaed1.f +++ b/lapack-netlib/SRC/dlaed1.f @@ -54,7 +54,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED2. *> @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -163,10 +163,10 @@ SUBROUTINE DLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, INFO, LDQ, N diff --git a/lapack-netlib/SRC/dlaed7.f b/lapack-netlib/SRC/dlaed7.f index 658ece9a..babd57be 100644 --- a/lapack-netlib/SRC/dlaed7.f +++ b/lapack-netlib/SRC/dlaed7.f @@ -59,7 +59,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED8. *> @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -260,10 +260,10 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lapack-netlib/SRC/dlag2.f b/lapack-netlib/SRC/dlag2.f index a941b940..1e3366c9 100644 --- a/lapack-netlib/SRC/dlag2.f +++ b/lapack-netlib/SRC/dlag2.f @@ -99,7 +99,7 @@ *> will always be positive. If the eigenvalues are real, then *> the first (real) eigenvalue is WR1 / SCALE1 , but this may *> overflow or underflow, and in fact, SCALE1 may be zero or -*> less than the underflow threshhold if the exact eigenvalue +*> less than the underflow threshold if the exact eigenvalue *> is sufficiently large. *> \endverbatim *> @@ -112,7 +112,7 @@ *> eigenvalues are real, then the second (real) eigenvalue is *> WR2 / SCALE2 , but this may overflow or underflow, and in *> fact, SCALE2 may be zero or less than the underflow -*> threshhold if the exact eigenvalue is sufficiently large. +*> threshold if the exact eigenvalue is sufficiently large. *> \endverbatim *> *> \param[out] WR1 @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -156,10 +156,10 @@ SUBROUTINE DLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, $ WR2, WI ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB @@ -266,8 +266,8 @@ * Note: the test of R in the following IF is to cover the case when * DISCR is small and negative and is flushed to zero during * the calculation of R. On machines which have a consistent -* flush-to-zero threshhold and handle numbers above that -* threshhold correctly, it would not be necessary. +* flush-to-zero threshold and handle numbers above that +* threshold correctly, it would not be necessary. * IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN SUM = PP + SIGN( R, PP ) diff --git a/lapack-netlib/SRC/dlamrg.f b/lapack-netlib/SRC/dlamrg.f index 7126053e..8e9d37bd 100644 --- a/lapack-netlib/SRC/dlamrg.f +++ b/lapack-netlib/SRC/dlamrg.f @@ -50,7 +50,7 @@ *> \param[in] N2 *> \verbatim *> N2 is INTEGER -*> These arguements contain the respective lengths of the two +*> These arguments contain the respective lengths of the two *> sorted lists to be merged. *> \endverbatim *> @@ -92,17 +92,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER DTRD1, DTRD2, N1, N2 diff --git a/lapack-netlib/SRC/dlaqr3.f b/lapack-netlib/SRC/dlaqr3.f index aac01a49..103cd366 100644 --- a/lapack-netlib/SRC/dlaqr3.f +++ b/lapack-netlib/SRC/dlaqr3.f @@ -138,7 +138,7 @@ *> Z is DOUBLE PRECISION array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the orthogonal *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -260,7 +260,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -275,10 +275,10 @@ $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/dlaqr5.f b/lapack-netlib/SRC/dlaqr5.f index 37ce6f6b..b28df32a 100644 --- a/lapack-netlib/SRC/dlaqr5.f +++ b/lapack-netlib/SRC/dlaqr5.f @@ -150,10 +150,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is DOUBLE PRECISION array of size (LDZ,IHI) +*> Z is DOUBLE PRECISION array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep orthogonal *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -236,7 +236,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -259,10 +259,10 @@ $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, $ LDU, NV, WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/dlarrc.f b/lapack-netlib/SRC/dlarrc.f index f093563e..9a6f7f79 100644 --- a/lapack-netlib/SRC/dlarrc.f +++ b/lapack-netlib/SRC/dlarrc.f @@ -60,12 +60,13 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> The lower bound for the eigenvalues. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> The lower and upper bounds for the eigenvalues. +*> The upper bound for the eigenvalues. *> \endverbatim *> *> \param[in] D @@ -119,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -136,10 +137,10 @@ SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, $ EIGCNT, LCNT, RCNT, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBT diff --git a/lapack-netlib/SRC/dlarrd.f b/lapack-netlib/SRC/dlarrd.f index 65cdbe96..00add6f9 100644 --- a/lapack-netlib/SRC/dlarrd.f +++ b/lapack-netlib/SRC/dlarrd.f @@ -92,12 +92,16 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -106,13 +110,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +319,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -321,10 +329,10 @@ $ M, W, WERR, WL, WU, IBLOCK, INDEXW, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/dlarre.f b/lapack-netlib/SRC/dlarre.f index e7eea10c..d8e9c845 100644 --- a/lapack-netlib/SRC/dlarre.f +++ b/lapack-netlib/SRC/dlarre.f @@ -78,12 +78,17 @@ *> \param[in,out] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound for the eigenvalues. +*> Eigenvalues less than or equal to VL, or greater than VU, +*> will not be returned. VL < VU. +*> If RANGE='I' or ='A', DLARRE computes bounds on the desired +*> part of the spectrum. *> \endverbatim *> *> \param[in,out] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds for the eigenvalues. +*> If RANGE='V', the upper bound for the eigenvalues. *> Eigenvalues less than or equal to VL, or greater than VU, *> will not be returned. VL < VU. *> If RANGE='I' or ='A', DLARRE computes bounds on the desired @@ -93,13 +98,16 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N. *> \endverbatim *> @@ -244,7 +252,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: A problem occured in DLARRE. +*> > 0: A problem occurred in DLARRE. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -268,7 +276,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -297,10 +305,10 @@ $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER RANGE diff --git a/lapack-netlib/SRC/dlarrf.f b/lapack-netlib/SRC/dlarrf.f index f054caa8..afec65c9 100644 --- a/lapack-netlib/SRC/dlarrf.f +++ b/lapack-netlib/SRC/dlarrf.f @@ -51,7 +51,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix (subblock, if the matrix splitted). +*> The order of the matrix (subblock, if the matrix split). *> \endverbatim *> *> \param[in] D @@ -174,7 +174,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -193,10 +193,10 @@ $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, $ DPLUS, LPLUS, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CLSTRT, CLEND, INFO, N diff --git a/lapack-netlib/SRC/dlarrv.f b/lapack-netlib/SRC/dlarrv.f index 828661f2..0628d49e 100644 --- a/lapack-netlib/SRC/dlarrv.f +++ b/lapack-netlib/SRC/dlarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is DOUBLE PRECISION array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by DLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in DLARRV. +*> > 0: A problem occurred in DLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/dlarscl2.f b/lapack-netlib/SRC/dlarscl2.f index 81f5aa81..acd57783 100644 --- a/lapack-netlib/SRC/dlarscl2.f +++ b/lapack-netlib/SRC/dlarscl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/dlascl.f b/lapack-netlib/SRC/dlascl.f index 9b9b33c0..13c176ce 100644 --- a/lapack-netlib/SRC/dlascl.f +++ b/lapack-netlib/SRC/dlascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/dlascl2.f b/lapack-netlib/SRC/dlascl2.f index 8cd9dd72..f9b3b8a1 100644 --- a/lapack-netlib/SRC/dlascl2.f +++ b/lapack-netlib/SRC/dlascl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * * ===================================================================== SUBROUTINE DLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/dlasd1.f b/lapack-netlib/SRC/dlasd1.f index 7b66d90b..cf7ae908 100644 --- a/lapack-netlib/SRC/dlasd1.f +++ b/lapack-netlib/SRC/dlasd1.f @@ -60,7 +60,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or when there are zeros in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLASD2. *> @@ -156,7 +156,7 @@ *> The leading dimension of the array VT. LDVT >= max( 1, M ). *> \endverbatim *> -*> \param[out] IDXQ +*> \param[in,out] IDXQ *> \verbatim *> IDXQ is INTEGER array, dimension(N) *> This contains the permutation which will reintegrate the @@ -190,7 +190,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -204,10 +204,10 @@ SUBROUTINE DLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, $ IDXQ, IWORK, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDU, LDVT, NL, NR, SQRE diff --git a/lapack-netlib/SRC/dlasd6.f b/lapack-netlib/SRC/dlasd6.f index a5238b91..d562cc53 100644 --- a/lapack-netlib/SRC/dlasd6.f +++ b/lapack-netlib/SRC/dlasd6.f @@ -74,7 +74,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or if there is a zero -*> in the Z vector. For each such occurence the dimension of the +*> in the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLASD7. *> @@ -232,14 +232,13 @@ *> \param[out] DIFR *> \verbatim *> DIFR is DOUBLE PRECISION array, -*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and -*> dimension ( N ) if ICOMPQ = 0. -*> On exit, DIFR(I, 1) is the distance between I-th updated -*> (undeflated) singular value and the I+1-th (undeflated) old -*> singular value. +*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and +*> dimension ( K ) if ICOMPQ = 0. +*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not +*> defined and will not be referenced. *> -*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the -*> normalizing factors for the right singular vector matrix. +*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the +*> normalizing factors for the right singular vector matrix. *> *> See DLASD8 for details on DIFL and DIFR. *> \endverbatim @@ -298,7 +297,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -314,10 +313,10 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lapack-netlib/SRC/dlasdq.f b/lapack-netlib/SRC/dlasdq.f index 6beef32a..94cc1141 100644 --- a/lapack-netlib/SRC/dlasdq.f +++ b/lapack-netlib/SRC/dlasdq.f @@ -59,7 +59,7 @@ *> \verbatim *> UPLO is CHARACTER*1 *> On entry, UPLO specifies whether the input bidiagonal matrix -*> is upper or lower bidiagonal, and wether it is square are +*> is upper or lower bidiagonal, and whether it is square are *> not. *> UPLO = 'U' or 'u' B is upper bidiagonal. *> UPLO = 'L' or 'l' B is lower bidiagonal. @@ -197,7 +197,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -211,10 +211,10 @@ SUBROUTINE DLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dlasq3.f b/lapack-netlib/SRC/dlasq3.f index 4506e19f..3ae35ad1 100644 --- a/lapack-netlib/SRC/dlasq3.f +++ b/lapack-netlib/SRC/dlasq3.f @@ -60,7 +60,7 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension ( 4*N ) +*> Z is DOUBLE PRECISION array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -173,7 +173,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -182,10 +182,10 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lapack-netlib/SRC/dlasq4.f b/lapack-netlib/SRC/dlasq4.f index 97d9bdeb..45361b2c 100644 --- a/lapack-netlib/SRC/dlasq4.f +++ b/lapack-netlib/SRC/dlasq4.f @@ -56,7 +56,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension ( 4*N ) +*> Z is DOUBLE PRECISION array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -122,7 +122,7 @@ *> *> \param[in,out] G *> \verbatim -*> G is REAL +*> G is DOUBLE PRECISION *> G is passed as an argument in order to save its value between *> calls to DLASQ4. *> \endverbatim @@ -135,7 +135,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -151,10 +151,10 @@ SUBROUTINE DLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER I0, N0, N0IN, PP, TTYPE diff --git a/lapack-netlib/SRC/dlasrt.f b/lapack-netlib/SRC/dlasrt.f index f5d0e6cd..fca457ef 100644 --- a/lapack-netlib/SRC/dlasrt.f +++ b/lapack-netlib/SRC/dlasrt.f @@ -81,17 +81,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE DLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ID @@ -123,7 +123,7 @@ * .. * .. Executable Statements .. * -* Test the input paramters. +* Test the input parameters. * INFO = 0 DIR = -1 diff --git a/lapack-netlib/SRC/dlasy2.f b/lapack-netlib/SRC/dlasy2.f index a4b10305..0af00d39 100644 --- a/lapack-netlib/SRC/dlasy2.f +++ b/lapack-netlib/SRC/dlasy2.f @@ -166,7 +166,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleSYauxiliary * @@ -174,10 +174,10 @@ SUBROUTINE DLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. LOGICAL LTRANL, LTRANR @@ -438,8 +438,10 @@ 80 CONTINUE 90 CONTINUE 100 CONTINUE - IF( ABS( T16( 4, 4 ) ).LT.SMIN ) - $ T16( 4, 4 ) = SMIN + IF( ABS( T16( 4, 4 ) ).LT.SMIN ) THEN + INFO = 1 + T16( 4, 4 ) = SMIN + END IF SCALE = ONE IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR. $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR. diff --git a/lapack-netlib/SRC/dlatdf.f b/lapack-netlib/SRC/dlatdf.f index be70313b..5eba2843 100644 --- a/lapack-netlib/SRC/dlatdf.f +++ b/lapack-netlib/SRC/dlatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value *> of 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where all entries of -*> the r.h.s. b is choosen as either +1 or -1 (Default). +*> the r.h.s. b is chosen as either +1 or -1 (Default). *> \endverbatim *> *> \param[in] N @@ -133,7 +133,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleOTHERauxiliary * @@ -171,10 +171,10 @@ SUBROUTINE DLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/dorbdb1.f b/lapack-netlib/SRC/dorbdb1.f index b5675f71..8d616bc1 100644 --- a/lapack-netlib/SRC/dorbdb1.f +++ b/lapack-netlib/SRC/dorbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -304,9 +304,8 @@ $ X11(I+1,I+1), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) - C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( DNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL DORBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/dorbdb2.f b/lapack-netlib/SRC/dorbdb2.f index 3cf82cf4..554cc2ff 100644 --- a/lapack-netlib/SRC/dorbdb2.f +++ b/lapack-netlib/SRC/dorbdb2.f @@ -202,7 +202,7 @@ SUBROUTINE DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -292,8 +292,8 @@ $ X11(I+1,I), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) - S = SQRT( DNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL DORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/dorbdb3.f b/lapack-netlib/SRC/dorbdb3.f index 03be504f..003c4402 100644 --- a/lapack-netlib/SRC/dorbdb3.f +++ b/lapack-netlib/SRC/dorbdb3.f @@ -201,7 +201,7 @@ SUBROUTINE DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -292,8 +292,8 @@ $ X11(I,I), LDX11, WORK(ILARF) ) CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) - C = SQRT( DNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( DNRM2( P-I+1, X11(I,I), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL DORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/dorbdb4.f b/lapack-netlib/SRC/dorbdb4.f index 8c723605..a8fe7435 100644 --- a/lapack-netlib/SRC/dorbdb4.f +++ b/lapack-netlib/SRC/dorbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -341,9 +341,8 @@ CALL DLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) IF( I .LT. M-Q ) THEN - S = SQRT( DNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( DNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/dorcsd2by1.f b/lapack-netlib/SRC/dorcsd2by1.f index 19dedbe8..dd0cd351 100644 --- a/lapack-netlib/SRC/dorcsd2by1.f +++ b/lapack-netlib/SRC/dorcsd2by1.f @@ -266,6 +266,9 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + DOUBLE PRECISION DUM1(1), DUM2(1,1) +* .. * .. External Subroutines .. EXTERNAL DBBCSD, DCOPY, DLACPY, DLAPMR, DLAPMT, DORBDB1, $ DORBDB2, DORBDB3, DORBDB4, DORGLQ, DORGQR, @@ -298,11 +301,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -344,99 +347,125 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK, + $ -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, - $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, + $ U2, LDU2, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, - $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE - CALL DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL DORGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL DORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL DORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL DORGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, + $ 1, V1T, LDV1T, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF LWORKMIN = MAX( IORBDB+LORBDB-1, @@ -501,11 +530,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place zero submatrices in * preferred positions @@ -555,8 +584,8 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2, + $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -610,11 +639,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, U1, - $ LDU1, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions @@ -679,11 +708,11 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2, + $ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions diff --git a/lapack-netlib/SRC/dsbevx.f b/lapack-netlib/SRC/dsbevx.f index 39517fb9..fc8836f7 100644 --- a/lapack-netlib/SRC/dsbevx.f +++ b/lapack-netlib/SRC/dsbevx.f @@ -126,12 +126,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -139,13 +142,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +256,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -258,10 +265,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsbgvd.f b/lapack-netlib/SRC/dsbgvd.f index fe8d6287..a259ad78 100644 --- a/lapack-netlib/SRC/dsbgvd.f +++ b/lapack-netlib/SRC/dsbgvd.f @@ -214,7 +214,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -227,10 +227,10 @@ SUBROUTINE DSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -338,7 +338,7 @@ INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 CALL DSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK( INDWRK ), IINFO ) + $ WORK, IINFO ) * * Reduce to tridiagonal form. * diff --git a/lapack-netlib/SRC/dsbgvx.f b/lapack-netlib/SRC/dsbgvx.f index fc06677d..2db4ac34 100644 --- a/lapack-netlib/SRC/dsbgvx.f +++ b/lapack-netlib/SRC/dsbgvx.f @@ -152,13 +152,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,14 +170,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -271,7 +280,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -285,10 +294,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsgesv.f b/lapack-netlib/SRC/dsgesv.f index 64e2c168..99eb122c 100644 --- a/lapack-netlib/SRC/dsgesv.f +++ b/lapack-netlib/SRC/dsgesv.f @@ -164,7 +164,7 @@ *> -3 : failure of SGETRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -187,7 +187,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleGEsolve * @@ -195,10 +195,10 @@ SUBROUTINE DSGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, $ SWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS diff --git a/lapack-netlib/SRC/dspevx.f b/lapack-netlib/SRC/dspevx.f index 35a96b2b..4f9e8d46 100644 --- a/lapack-netlib/SRC/dspevx.f +++ b/lapack-netlib/SRC/dspevx.f @@ -96,12 +96,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -109,13 +112,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -218,7 +225,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -227,10 +234,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, $ INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dspgvx.f b/lapack-netlib/SRC/dspgvx.f index 9eb91f7a..e87ad5fc 100644 --- a/lapack-netlib/SRC/dspgvx.f +++ b/lapack-netlib/SRC/dspgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -263,10 +272,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsposv.f b/lapack-netlib/SRC/dsposv.f index bb72199b..f7573dd3 100644 --- a/lapack-netlib/SRC/dsposv.f +++ b/lapack-netlib/SRC/dsposv.f @@ -168,7 +168,7 @@ *> -3 : failure of SPOTRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doublePOsolve * @@ -199,10 +199,10 @@ SUBROUTINE DSPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, $ SWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dstebz.f b/lapack-netlib/SRC/dstebz.f index 01bea27c..25d27120 100644 --- a/lapack-netlib/SRC/dstebz.f +++ b/lapack-netlib/SRC/dstebz.f @@ -87,13 +87,18 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -102,14 +107,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +264,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -263,10 +273,10 @@ $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/dstegr.f b/lapack-netlib/SRC/dstegr.f index 298e1c76..a56f9063 100644 --- a/lapack-netlib/SRC/dstegr.f +++ b/lapack-netlib/SRC/dstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> DSTEGR is a compatability wrapper around the improved DSTEMR routine. +*> DSTEGR is a compatibility wrapper around the improved DSTEMR routine. *> See DSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstemr.f b/lapack-netlib/SRC/dstemr.f index 8967c18f..60884672 100644 --- a/lapack-netlib/SRC/dstemr.f +++ b/lapack-netlib/SRC/dstemr.f @@ -136,13 +136,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -150,14 +154,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -294,7 +303,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -312,10 +321,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstevr.f b/lapack-netlib/SRC/dstevr.f index 941ec97f..dd40cf99 100644 --- a/lapack-netlib/SRC/dstevr.f +++ b/lapack-netlib/SRC/dstevr.f @@ -128,12 +128,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -141,13 +144,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -280,7 +287,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -297,10 +304,10 @@ $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dstevx.f b/lapack-netlib/SRC/dstevx.f index cda9de16..0cdfe999 100644 --- a/lapack-netlib/SRC/dstevx.f +++ b/lapack-netlib/SRC/dstevx.f @@ -89,12 +89,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -102,13 +105,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -212,7 +219,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHEReigen * @@ -220,10 +227,10 @@ SUBROUTINE DSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/dsyevr.f b/lapack-netlib/SRC/dsyevr.f index 08f36361..c78fb156 100644 --- a/lapack-netlib/SRC/dsyevr.f +++ b/lapack-netlib/SRC/dsyevr.f @@ -153,12 +153,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,13 +169,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -306,7 +313,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -325,10 +332,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsyevx.f b/lapack-netlib/SRC/dsyevx.f index cb990e50..52c84777 100644 --- a/lapack-netlib/SRC/dsyevx.f +++ b/lapack-netlib/SRC/dsyevx.f @@ -98,12 +98,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -111,13 +114,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -237,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -246,10 +253,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsygvx.f b/lapack-netlib/SRC/dsygvx.f index 0ed77063..13ab094d 100644 --- a/lapack-netlib/SRC/dsygvx.f +++ b/lapack-netlib/SRC/dsygvx.f @@ -131,12 +131,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -144,13 +147,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -276,7 +283,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleSYeigen * @@ -290,10 +297,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/dsytrf_rook.f b/lapack-netlib/SRC/dsytrf_rook.f index 81264872..a7f40537 100644 --- a/lapack-netlib/SRC/dsytrf_rook.f +++ b/lapack-netlib/SRC/dsytrf_rook.f @@ -208,7 +208,7 @@ * ===================================================================== SUBROUTINE DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'DSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/dsytrs2.f b/lapack-netlib/SRC/dsytrs2.f index 09a87fe3..9d1205b7 100644 --- a/lapack-netlib/SRC/dsytrs2.f +++ b/lapack-netlib/SRC/dsytrs2.f @@ -106,7 +106,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is DOUBLE PRECISION array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -124,7 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleSYcomputational * @@ -132,10 +132,10 @@ SUBROUTINE DSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/dtgsen.f b/lapack-netlib/SRC/dtgsen.f index 82b17626..14719e4f 100644 --- a/lapack-netlib/SRC/dtgsen.f +++ b/lapack-netlib/SRC/dtgsen.f @@ -305,7 +305,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup doubleOTHERcomputational * @@ -452,10 +452,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -542,6 +542,7 @@ * M = 0 PAIR = .FALSE. + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N IF( PAIR ) THEN PAIR = .FALSE. @@ -561,6 +562,7 @@ END IF END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) ) diff --git a/lapack-netlib/SRC/dtrevc3.f b/lapack-netlib/SRC/dtrevc3.f new file mode 100644 index 00000000..ba5abb5f --- /dev/null +++ b/lapack-netlib/SRC/dtrevc3.f @@ -0,0 +1,1303 @@ +*> \brief \b DTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download DTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DTREVC3 computes some or all of the right and/or left eigenvectors of +*> a real upper quasi-triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a real general matrix: A = Q*T*Q**T, as computed by DHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**T)*T = w*(y**T) +*> +*> where y**T denotes the transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal blocks of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the orthogonal factor that reduces a matrix +*> A to Schur form T, then Q*X and Q*Y are the matrices of right and +*> left eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed by the matrices in VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in,out] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> If w(j) is a real eigenvalue, the corresponding real +*> eigenvector is computed if SELECT(j) is .TRUE.. +*> If w(j) and w(j+1) are the real and imaginary parts of a +*> complex eigenvalue, the corresponding complex eigenvector is +*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and +*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to +*> .FALSE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is DOUBLE PRECISION array, dimension (LDT,N) +*> The upper quasi-triangular matrix T in Schur canonical form. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is DOUBLE PRECISION array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by DHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part, and the second the imaginary part. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is DOUBLE PRECISION array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by DHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part and the second the imaginary part. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected real eigenvector occupies one column and each +*> selected complex eigenvector occupies two columns. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,3*N). +*> For optimum performance, LWORK >= N + 2*N*NB, where NB is +*> the optimal blocksize. +*> +*> 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 2011 +* +* @precisions fortran d -> s +* +*> \ingroup doubleOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE DTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, LDVR, MM, M, WORK, LWORK, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, PAIR, + $ RIGHTV, SOMEV + INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, + $ IV, MAXWRK, NB, KI2 + DOUBLE PRECISION BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE, + $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR, + $ XNORM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER IDAMAX, ILAENV + DOUBLE PRECISION DDOT, DLAMCH + EXTERNAL LSAME, IDAMAX, ILAENV, DDOT, DLAMCH +* .. +* .. External Subroutines .. + EXTERNAL DAXPY, DCOPY, DGEMV, DLALN2, DSCAL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. +* .. Local Arrays .. + DOUBLE PRECISION X( 2, 2 ) + INTEGER ISCOMPLEX( NBMAX ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* + INFO = 0 + NB = ILAENV( 1, 'DTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + LQUERY = ( LWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE +* +* Set M to the number of columns required to store the selected +* eigenvectors, standardize the array SELECT if necessary, and +* test MM. +* + IF( SOMEV ) THEN + M = 0 + PAIR = .FALSE. + DO 10 J = 1, N + IF( PAIR ) THEN + PAIR = .FALSE. + SELECT( J ) = .FALSE. + ELSE + IF( J.LT.N ) THEN + IF( T( J+1, J ).EQ.ZERO ) THEN + IF( SELECT( J ) ) + $ M = M + 1 + ELSE + PAIR = .TRUE. + IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN + SELECT( J ) = .TRUE. + M = M + 2 + END IF + END IF + ELSE + IF( SELECT( N ) ) + $ M = M + 1 + END IF + END IF + 10 CONTINUE + ELSE + M = N + END IF +* + IF( MM.LT.M ) THEN + INFO = -11 + END IF + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'DTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL DLASET( 'F', N, 1+2*NB, ZERO, ZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = DLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL DLABAD( UNFL, OVFL ) + ULP = DLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) + BIGNUM = ( ONE-ULP ) / SMLNUM +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + WORK( 1 ) = ZERO + DO 30 J = 2, N + WORK( J ) = ZERO + DO 20 I = 1, J - 1 + WORK( J ) = WORK( J ) + ABS( T( I, J ) ) + 20 CONTINUE + 30 CONTINUE +* +* Index IP is used to specify the real or complex eigenvalue: +* IP = 0, real eigenvalue, +* 1, first of conjugate complex pair: (wr,wi) +* -1, second of conjugate complex pair: (wr,wi) +* ISCOMPLEX array stores IP for each column in current block. +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* For complex right vector, uses IV-1 for real part and IV for complex part. +* Non-blocked version always uses IV=2; +* blocked version starts with IV=NB, goes down to 1 or 2. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 2 + IF( NB.GT.2 ) THEN + IV = NB + END IF + + IP = 0 + IS = M + DO 140 KI = N, 1, -1 + IF( IP.EQ.-1 ) THEN +* previous iteration (ki+1) was second of conjugate pair, +* so this ki is first of conjugate pair; skip to end of loop + IP = 1 + GO TO 140 + ELSE IF( KI.EQ.1 ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI, KI-1 ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is second of conjugate pair + IP = -1 + END IF + + IF( SOMEV ) THEN + IF( IP.EQ.0 ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 140 + ELSE + IF( .NOT.SELECT( KI-1 ) ) + $ GO TO 140 + END IF + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI-1 ) ) )* + $ SQRT( ABS( T( KI-1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real right eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 50 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 50 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-1,1:KI-1) - WR ]*X = SCALE*WORK. +* + JNXT = KI - 1 + DO 60 J = KI - 1, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 60 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) +* +* Update right-hand side +* + CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL DLALN2( .FALSE., 2, 1, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+IV*N ), N, WR, ZERO, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(2,1) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 2, 1 ) = X( 2, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J-1+IV*N ) = X( 1, 1 ) + WORK( J +IV*N ) = X( 2, 1 ) +* +* Update right-hand side +* + CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+IV*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) + END IF + 60 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL DCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = IDAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / ABS( VR( II, IS ) ) + CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 70 K = KI + 1, N + VR( K, IS ) = ZERO + 70 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL DGEMV( 'N', N, KI-1, ONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, WORK( KI + IV*N ), + $ VR( 1, KI ), 1 ) +* + II = IDAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / ABS( VR( II, KI ) ) + CALL DSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex right eigenvector. +* +* Initial solve +* [ ( T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I*WI) ]*X = 0. +* [ ( T(KI, KI-1) T(KI, KI) ) ] +* + IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN + WORK( KI-1 + (IV-1)*N ) = ONE + WORK( KI + (IV )*N ) = WI / T( KI-1, KI ) + ELSE + WORK( KI-1 + (IV-1)*N ) = -WI / T( KI, KI-1 ) + WORK( KI + (IV )*N ) = ONE + END IF + WORK( KI + (IV-1)*N ) = ZERO + WORK( KI-1 + (IV )*N ) = ZERO +* +* Form right-hand side. +* + DO 80 K = 1, KI - 2 + WORK( K+(IV-1)*N ) = -WORK( KI-1+(IV-1)*N )*T(K,KI-1) + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(K,KI ) + 80 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-2,1:KI-2) - (WR+i*WI) ]*X = SCALE*(WORK+i*WORK2) +* + JNXT = KI - 2 + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 90 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+(IV-1)*N ), N, + $ WR, WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(1,2) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 1, 2 ) = X( 1, 2 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL DSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J+(IV-1)*N ) = X( 1, 1 ) + WORK( J+(IV )*N ) = X( 1, 2 ) +* +* Update the right-hand side +* + CALL DAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL DLALN2( .FALSE., 2, 2, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+(IV-1)*N ), N, WR, WI, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + REC = ONE / XNORM + X( 1, 1 ) = X( 1, 1 )*REC + X( 1, 2 ) = X( 1, 2 )*REC + X( 2, 1 ) = X( 2, 1 )*REC + X( 2, 2 ) = X( 2, 2 )*REC + SCALE = SCALE*REC + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL DSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J-1+(IV-1)*N ) = X( 1, 1 ) + WORK( J +(IV-1)*N ) = X( 2, 1 ) + WORK( J-1+(IV )*N ) = X( 1, 2 ) + WORK( J +(IV )*N ) = X( 2, 2 ) +* +* Update the right-hand side +* + CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL DAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV )*N ), 1 ) + CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) + END IF + 90 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL DCOPY( KI, WORK( 1+(IV-1)*N ), 1, VR(1,IS-1), 1 ) + CALL DCOPY( KI, WORK( 1+(IV )*N ), 1, VR(1,IS ), 1 ) +* + EMAX = ZERO + DO 100 K = 1, KI + EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+ + $ ABS( VR( K, IS ) ) ) + 100 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( KI, REMAX, VR( 1, IS-1 ), 1 ) + CALL DSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 110 K = KI + 1, N + VR( K, IS-1 ) = ZERO + VR( K, IS ) = ZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.2 ) THEN + CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV-1)*N ), 1, + $ WORK( KI-1 + (IV-1)*N ), VR(1,KI-1), 1) + CALL DGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), VR( 1, KI ), 1 ) + ELSE + CALL DSCAL( N, WORK(KI-1+(IV-1)*N), VR(1,KI-1), 1) + CALL DSCAL( N, WORK(KI +(IV )*N), VR(1,KI ), 1) + END IF +* + EMAX = ZERO + DO 120 K = 1, N + EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+ + $ ABS( VR( K, KI ) ) ) + 120 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N, REMAX, VR( 1, KI-1 ), 1 ) + CALL DSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + (IV-1)*N ) = ZERO + WORK( K + (IV )*N ) = ZERO + END DO + ISCOMPLEX( IV-1 ) = -IP + ISCOMPLEX( IV ) = IP + IV = IV - 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI-1 and KI) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI - 1 + END IF + +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.LE.2) .OR. (KI2.EQ.1) ) THEN + CALL DGEMM( 'N', 'N', N, NB-IV+1, KI2+NB-IV, ONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + IF( ISCOMPLEX(K).EQ.0 ) THEN +* real eigenvector + II = IDAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1 ) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL DSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL DLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI2 ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF ! blocked back-transform +* + IS = IS - 1 + IF( IP.NE.0 ) + $ IS = IS - 1 + 140 CONTINUE + END IF + + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* For complex left vector, uses IV for real part and IV+1 for complex part. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB-1 or NB. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 1 + IP = 0 + IS = 1 + DO 260 KI = 1, N + IF( IP.EQ.1 ) THEN +* previous iteration (ki-1) was first of conjugate pair, +* so this ki is second of conjugate pair; skip to end of loop + IP = -1 + GO TO 260 + ELSE IF( KI.EQ.N ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI+1, KI ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is first of conjugate pair + IP = 1 + END IF +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 260 + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI+1 ) ) )* + $ SQRT( ABS( T( KI+1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real left eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 160 K = KI + 1, N + WORK( K + IV*N ) = -T( KI, K ) + 160 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+1:N,KI+1:N) - WR ]**T * X = SCALE*WORK +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 1 + DO 170 J = KI + 1, N + IF( J.LT.JNXT ) + $ GO TO 170 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve [ T(J,J) - WR ]**T * X = WORK +* + CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) + VMAX = MAX( ABS( WORK( J+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* + WORK( J+1+IV*N ) = WORK( J+1+IV*N ) - + $ DDOT( J-KI-1, T( KI+1, J+1 ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve +* [ T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 ) +* [ T(J+1,J) T(J+1,J+1)-WR ] ( WORK2 ) +* + CALL DLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL DSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J +IV*N ) = X( 1, 1 ) + WORK( J+1+IV*N ) = X( 2, 1 ) +* + VMAX = MAX( ABS( WORK( J +IV*N ) ), + $ ABS( WORK( J+1+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 170 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL DCOPY( N-KI+1, WORK( KI + IV*N ), 1, + $ VL( KI, IS ), 1 ) +* + II = IDAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / ABS( VL( II, IS ) ) + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 180 K = 1, KI - 1 + VL( K, IS ) = ZERO + 180 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL DGEMV( 'N', N, N-KI, ONE, + $ VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, + $ WORK( KI + IV*N ), VL( 1, KI ), 1 ) +* + II = IDAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / ABS( VL( II, KI ) ) + CALL DSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex left eigenvector. +* +* Initial solve: +* [ ( T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI) ]*X = 0. +* [ ( T(KI+1,KI) T(KI+1,KI+1) ) ] +* + IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN + WORK( KI + (IV )*N ) = WI / T( KI, KI+1 ) + WORK( KI+1 + (IV+1)*N ) = ONE + ELSE + WORK( KI + (IV )*N ) = ONE + WORK( KI+1 + (IV+1)*N ) = -WI / T( KI+1, KI ) + END IF + WORK( KI+1 + (IV )*N ) = ZERO + WORK( KI + (IV+1)*N ) = ZERO +* +* Form right-hand side. +* + DO 190 K = KI + 2, N + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(KI, K) + WORK( K+(IV+1)*N ) = -WORK( KI+1+(IV+1)*N )*T(KI+1,K) + 190 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+2:N,KI+2:N)**T - (WR-i*WI) ]*X = WORK1+i*WORK2 +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 2 + DO 200 J = KI + 2, N + IF( J.LT.JNXT ) + $ GO TO 200 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when +* forming the right-hand side elements. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+(IV )*N ) = WORK( J+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) + WORK( J+(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve [ T(J,J)-(WR-i*WI) ]*(X11+i*X12)= WK+I*WK2 +* + CALL DLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J+(IV )*N ) = X( 1, 1 ) + WORK( J+(IV+1)*N ) = X( 1, 2 ) + VMAX = MAX( ABS( WORK( J+(IV )*N ) ), + $ ABS( WORK( J+(IV+1)*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side elements. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL DSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J +(IV )*N ) = WORK( J+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J +(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* + WORK( J+1+(IV )*N ) = WORK( J+1+(IV)*N ) - + $ DDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J+1+(IV+1)*N ) = WORK( J+1+(IV+1)*N ) - + $ DDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve 2-by-2 complex linear equation +* [ (T(j,j) T(j,j+1) )**T - (wr-i*wi)*I ]*X = SCALE*B +* [ (T(j+1,j) T(j+1,j+1)) ] +* + CALL DLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL DSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J +(IV )*N ) = X( 1, 1 ) + WORK( J +(IV+1)*N ) = X( 1, 2 ) + WORK( J+1+(IV )*N ) = X( 2, 1 ) + WORK( J+1+(IV+1)*N ) = X( 2, 2 ) + VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ), + $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), + $ VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 200 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL DCOPY( N-KI+1, WORK( KI + (IV )*N ), 1, + $ VL( KI, IS ), 1 ) + CALL DCOPY( N-KI+1, WORK( KI + (IV+1)*N ), 1, + $ VL( KI, IS+1 ), 1 ) +* + EMAX = ZERO + DO 220 K = KI, N + EMAX = MAX( EMAX, ABS( VL( K, IS ) )+ + $ ABS( VL( K, IS+1 ) ) ) + 220 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) + CALL DSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 ) +* + DO 230 K = 1, KI - 1 + VL( K, IS ) = ZERO + VL( K, IS+1 ) = ZERO + 230 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N-1 ) THEN + CALL DGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), + $ VL( 1, KI ), 1 ) + CALL DGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV+1)*N ), 1, + $ WORK( KI+1 + (IV+1)*N ), + $ VL( 1, KI+1 ), 1 ) + ELSE + CALL DSCAL( N, WORK(KI+ (IV )*N), VL(1, KI ), 1) + CALL DSCAL( N, WORK(KI+1+(IV+1)*N), VL(1, KI+1), 1) + END IF +* + EMAX = ZERO + DO 240 K = 1, N + EMAX = MAX( EMAX, ABS( VL( K, KI ) )+ + $ ABS( VL( K, KI+1 ) ) ) + 240 CONTINUE + REMAX = ONE / EMAX + CALL DSCAL( N, REMAX, VL( 1, KI ), 1 ) + CALL DSCAL( N, REMAX, VL( 1, KI+1 ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + (IV )*N ) = ZERO + WORK( K + (IV+1)*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP + ISCOMPLEX( IV+1 ) = -IP + IV = IV + 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI and KI+1) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI + 1 + END IF + +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.GE.NB-1) .OR. (KI2.EQ.N) ) THEN + CALL DGEMM( 'N', 'N', N, IV, N-KI2+IV, ONE, + $ VL( 1, KI2-IV+1 ), LDVL, + $ WORK( KI2-IV+1 + (1)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + IF( ISCOMPLEX(K).EQ.0) THEN +* real eigenvector + II = IDAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL DSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL DLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI2-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF ! blocked back-transform +* + IS = IS + 1 + IF( IP.NE.0 ) + $ IS = IS + 1 + 260 CONTINUE + END IF +* + RETURN +* +* End of DTREVC3 +* + END diff --git a/lapack-netlib/SRC/ilaenv.f b/lapack-netlib/SRC/ilaenv.f index 89a4468f..b963ad73 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 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -162,10 +162,10 @@ * ===================================================================== INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER*( * ) NAME, OPTS @@ -397,6 +397,12 @@ ELSE NB = 64 END IF + ELSE IF ( C3.EQ.'EVC' ) THEN + IF( SNAME ) THEN + NB = 64 + ELSE + NB = 64 + END IF END IF ELSE IF( C2.EQ.'LA' ) THEN IF( C3.EQ.'UUM' ) THEN diff --git a/lapack-netlib/SRC/ilaver.f b/lapack-netlib/SRC/ilaver.f index c882d03f..0da02707 100644 --- a/lapack-netlib/SRC/ilaver.f +++ b/lapack-netlib/SRC/ilaver.f @@ -25,13 +25,19 @@ * ========== * *> \param[out] VERS_MAJOR +*> \verbatim *> return the lapack major version +*> \endverbatim *> *> \param[out] VERS_MINOR +*> \verbatim *> return the lapack minor version from the major version +*> \endverbatim *> *> \param[out] VERS_PATCH +*> \verbatim *> return the lapack patch version from the minor version +*> \endverbatim * * Authors: * ======== @@ -41,17 +47,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * ===================================================================== * @@ -59,7 +65,7 @@ * ===================================================================== VERS_MAJOR = 3 VERS_MINOR = 6 - VERS_PATCH = 0 + VERS_PATCH = 1 * ===================================================================== * RETURN diff --git a/lapack-netlib/SRC/sbbcsd.f b/lapack-netlib/SRC/sbbcsd.f index 46b87c7e..d2cd707f 100644 --- a/lapack-netlib/SRC/sbbcsd.f +++ b/lapack-netlib/SRC/sbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is REAL array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is REAL array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is REAL array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is REAL array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/sbdsdc.f b/lapack-netlib/SRC/sbdsdc.f index 261aa1c2..b31cc0bf 100644 --- a/lapack-netlib/SRC/sbdsdc.f +++ b/lapack-netlib/SRC/sbdsdc.f @@ -191,7 +191,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -205,10 +205,10 @@ SUBROUTINE SBDSDC( UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, $ WORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, UPLO @@ -311,7 +311,7 @@ WSTART = 1 QSTART = 3 IF( ICOMPQ.EQ.1 ) THEN - CALL SCOPY( N, D, 1, Q( 1 ), 1 ) + CALL SCOPY( N, D, 1, Q( 1 ), 1 ) CALL SCOPY( N-1, E, 1, Q( N+1 ), 1 ) END IF IF( IUPLO.EQ.2 ) THEN @@ -335,8 +335,11 @@ * If ICOMPQ = 0, use SLASDQ to compute the singular values. * IF( ICOMPQ.EQ.0 ) THEN +* Ignore WSTART, instead using WORK( 1 ), since the two vectors +* for CS and -SN above are added only if ICOMPQ == 2, +* and adding them exceeds documented WORK size of 4*n. CALL SLASDQ( 'U', 0, N, 0, 0, 0, D, E, VT, LDVT, U, LDU, U, - $ LDU, WORK( WSTART ), INFO ) + $ LDU, WORK( 1 ), INFO ) GO TO 40 END IF * diff --git a/lapack-netlib/SRC/sbdsvdx.f b/lapack-netlib/SRC/sbdsvdx.f index 75264070..6b5c3c41 100644 --- a/lapack-netlib/SRC/sbdsvdx.f +++ b/lapack-netlib/SRC/sbdsvdx.f @@ -80,7 +80,7 @@ *> = 'L': B is lower bidiagonal. *> \endverbatim *> -*> \param[in] JOBXZ +*> \param[in] JOBZ *> \verbatim *> JOBZ is CHARACTER*1 *> = 'N': Compute singular values only; @@ -117,14 +117,16 @@ *> *> \param[in] VL *> \verbatim -*> VL is REAL -*> VL >=0. +*> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,13 +134,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -190,7 +196,10 @@ *> If JOBZ = 'V', then if INFO = 0, the first NS elements of *> IWORK are zero. If INFO > 0, then IWORK contains the indices *> of the eigenvectors that failed to converge in DSTEVX. +*> \endverbatim *> +*> \param[out] INFO +*> \verbatim *> INFO is INTEGER *> = 0: successful exit *> < 0: if INFO = -i, the i-th argument had an illegal value @@ -209,7 +218,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -217,7 +226,7 @@ SUBROUTINE SBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, $ NS, S, Z, LDZ, WORK, IWORK, INFO) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -371,7 +380,6 @@ IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO END DO IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO - E( N ) = ZERO * * Pointers for arrays used by SSTEVX. * @@ -398,7 +406,7 @@ * of the active submatrix. * RNGVX = 'I' - CALL SLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) ELSE IF( VALSV ) THEN * * Find singular values in a half-open interval. We aim @@ -418,7 +426,7 @@ IF( NS.EQ.0 ) THEN RETURN ELSE - CALL SLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) END IF ELSE IF( INDSV ) THEN * @@ -455,7 +463,7 @@ * IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL * - CALL SLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ ) + IF( WANTZ ) CALL SLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ) END IF * * Initialize variables and pointers for S, Z, and WORK. @@ -709,9 +717,11 @@ NRU = 0 NRV = 0 END IF !** NTGK.GT.0 **! - IF( IROWZ.LT.N*2 ) Z( 1:IROWZ-1, ICOLZ ) = ZERO + IF( IROWZ.LT.N*2 .AND. WANTZ ) THEN + Z( 1:IROWZ-1, ICOLZ ) = ZERO + END IF END DO !** IDPTR loop **! - IF( SPLIT ) THEN + IF( SPLIT .AND. WANTZ ) THEN * * Bring back eigenvector corresponding * to eigenvalue equal to zero. @@ -744,7 +754,7 @@ IF( K.NE.NS+1-I ) THEN S( K ) = S( NS+1-I ) S( NS+1-I ) = SMIN - CALL SSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) + IF( WANTZ ) CALL SSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) END IF END DO * @@ -754,7 +764,7 @@ K = IU - IL + 1 IF( K.LT.NS ) THEN S( K+1:NS ) = ZERO - Z( 1:N*2,K+1:NS ) = ZERO + IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO NS = K END IF END IF @@ -762,6 +772,7 @@ * Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). * If B is a lower diagonal, swap U and V. * + IF( WANTZ ) THEN DO I = 1, NS CALL SCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) IF( LOWER ) THEN @@ -772,6 +783,7 @@ CALL SCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) END IF END DO + END IF * RETURN * diff --git a/lapack-netlib/SRC/sgbequb.f b/lapack-netlib/SRC/sgbequb.f index d1effd9e..d94b8851 100644 --- a/lapack-netlib/SRC/sgbequb.f +++ b/lapack-netlib/SRC/sgbequb.f @@ -83,7 +83,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is REAL array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -152,7 +152,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realGBcomputational * @@ -160,10 +160,10 @@ SUBROUTINE SGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/sgbrfsx.f b/lapack-netlib/SRC/sgbrfsx.f index a154c3d6..234ea170 100644 --- a/lapack-netlib/SRC/sgbrfsx.f +++ b/lapack-netlib/SRC/sgbrfsx.f @@ -121,7 +121,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is REAL array, dimension (LDAB,N) *> The original band matrix A, stored in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -136,7 +136,7 @@ *> *> \param[in] AFB *> \verbatim -*> AFB is DOUBLE PRECISION array, dimension (LDAFB,N) +*> AFB is REAL array, dimension (LDAFB,N) *> Details of the LU factorization of the band matrix A, as *> computed by DGBTRF. U is stored as an upper triangular band *> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -646,7 +646,7 @@ * * Perform refinement on each right-hand side * - IF (REF_TYPE .NE. 0) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'D' ) diff --git a/lapack-netlib/SRC/sgeesx.f b/lapack-netlib/SRC/sgeesx.f index fe98b450..1deb4d5f 100644 --- a/lapack-netlib/SRC/sgeesx.f +++ b/lapack-netlib/SRC/sgeesx.f @@ -90,7 +90,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of two REAL arguments +*> SELECT is a LOGICAL FUNCTION of two REAL arguments *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to sort *> to the top left of the Schur form. @@ -272,7 +272,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realGEeigen * @@ -281,10 +281,10 @@ $ WR, WI, VS, LDVS, RCONDE, RCONDV, WORK, LWORK, $ IWORK, LIWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/sgeev.f b/lapack-netlib/SRC/sgeev.f index 667de0af..9f21d1fc 100644 --- a/lapack-netlib/SRC/sgeev.f +++ b/lapack-netlib/SRC/sgeev.f @@ -26,7 +26,7 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. * @@ -181,56 +181,59 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @generated from dgeev.f, fortran d -> s, Tue Apr 19 01:47:44 2016 * *> \ingroup realGEeigen * * ===================================================================== SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, $ LDVR, WORK, LWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, - $ MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, - $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC, + $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ XERBLA * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. @@ -279,24 +282,34 @@ MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'SORGHR', ' ', N, 1, N, -1 ) ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL STREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE IF( WANTVR ) THEN MINWRK = 4*N MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'SORGHR', ' ', N, 1, N, -1 ) ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + CALL STREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, N, NOUT, + $ WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N CALL SHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -426,10 +439,10 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 4*N) +* (Workspace: need 4*N, prefer N + N + 2*N*NB) * - CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * IF( WANTVL ) THEN diff --git a/lapack-netlib/SRC/sgeevx.f b/lapack-netlib/SRC/sgeevx.f index 821c080c..db20e8be 100644 --- a/lapack-netlib/SRC/sgeevx.f +++ b/lapack-netlib/SRC/sgeevx.f @@ -25,11 +25,11 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. * INTEGER IWORK( * ) -* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), +* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), * $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. @@ -210,7 +210,7 @@ *> \verbatim *> IHI is INTEGER *> ILO and IHI are integer values determined when A was -*> balanced. The balanced A(i,j) = 0 if I > J and +*> balanced. The balanced A(i,j) = 0 if I > J and *> J = 1,...,ILO-1 or I = IHI+1,...,N. *> \endverbatim *> @@ -294,7 +294,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 +* +* @generated from dgeevx.f, fortran d -> s, Tue Apr 19 01:47:44 2016 * *> \ingroup realGEeigen * @@ -302,20 +304,21 @@ SUBROUTINE SGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI, $ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, $ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. INTEGER IWORK( * ) - REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), + REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. @@ -323,32 +326,32 @@ * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, - $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC, + $ SLARTG, SLASCL, SORGHR, SROT, SSCAL, STREVC3, $ STRSNA, XERBLA * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. @@ -366,8 +369,9 @@ WNTSNE = LSAME( SENSE, 'E' ) WNTSNV = LSAME( SENSE, 'V' ) WNTSNB = LSAME( SENSE, 'B' ) - IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) .OR. - $ LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) THEN + IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' ) + $ .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) ) + $ THEN INFO = -1 ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN INFO = -2 @@ -405,9 +409,19 @@ MAXWRK = N + N*ILAENV( 1, 'SGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL STREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL STREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL SHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -419,7 +433,7 @@ $ LDVR, WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -571,18 +585,18 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from SHSEQR, then quit +* If INFO .NE. 0 from SHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 3*N) +* (Workspace: need 3*N, prefer N + 2*N*NB) * - CALL STREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), IERR ) + CALL STREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR ) END IF * * Compute condition numbers if desired diff --git a/lapack-netlib/SRC/sgejsv.f b/lapack-netlib/SRC/sgejsv.f index 55bb59e1..7d80d4ec 100644 --- a/lapack-netlib/SRC/sgejsv.f +++ b/lapack-netlib/SRC/sgejsv.f @@ -53,7 +53,6 @@ *> of [SIGMA] is computed and stored in the array SVA. *> SGEJSV can sometimes compute tiny singular values and their singular vectors much *> more accurately than other SVD routines, see below under Further Details. - *> \endverbatim * * Arguments: @@ -238,7 +237,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -260,7 +259,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -392,7 +391,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -459,7 +458,7 @@ *> LAPACK Working note 170. *> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR *> factorization software - a case study. -*> ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. *> LAPACK Working note 176. *> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, *> QSVD, (H,K)-SVD computations. @@ -477,10 +476,10 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE @@ -591,7 +590,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + WORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -717,6 +720,7 @@ IWORK(1) = 0 IWORK(2) = 0 END IF + IWORK(3) = 0 IF ( ERREST ) WORK(3) = ONE IF ( LSVEC .AND. RSVEC ) THEN WORK(4) = ONE diff --git a/lapack-netlib/SRC/sgeqrt3.f b/lapack-netlib/SRC/sgeqrt3.f index 86a43f67..a0e1c2c1 100644 --- a/lapack-netlib/SRC/sgeqrt3.f +++ b/lapack-netlib/SRC/sgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realGEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE SGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL SLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL SLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/sgesdd.f b/lapack-netlib/SRC/sgesdd.f index 1bc7e8a4..cae69939 100644 --- a/lapack-netlib/SRC/sgesdd.f +++ b/lapack-netlib/SRC/sgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, IWORK, INFO ) +* SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -27,7 +27,7 @@ * .. * .. Array Arguments .. * INTEGER IWORK( * ) -* REAL A( LDA, * ), S( * ), U( LDU, * ), +* REAL A( LDA, * ), S( * ), U( LDU, * ), * $ VT( LDVT, * ), WORK( * ) * .. * @@ -154,8 +154,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -169,16 +169,18 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> If JOBZ = 'N', -*> LWORK >= 3*min(M,N) + max(max(M,N),6*min(M,N)). -*> If JOBZ = 'O', -*> LWORK >= 3*min(M,N) + -*> max(max(M,N),5*min(M,N)*min(M,N)+4*min(M,N)). -*> If JOBZ = 'S' or 'A' -*> LWORK >= min(M,N)*(7+4*min(M,N)) -*> For good performance, LWORK should generally be larger. -*> If LWORK = -1 but other input arguments are legal, WORK(1) -*> returns the optimal LWORK. +*> If LWORK = -1, a workspace query is assumed. The optimal +*> size for the WORK array is calculated and stored in WORK(1), +*> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 3*mn + max( mx, 7*mn ). +*> If JOBZ = 'O', LWORK >= 3*mn + max( mx, 5*mn*mn + 4*mn ). +*> If JOBZ = 'S', LWORK >= 4*mn*mn + 7*mn. +*> If JOBZ = 'A', LWORK >= 4*mn*mn + 6*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] IWORK @@ -202,7 +204,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -213,13 +215,14 @@ *> California at Berkeley, USA *> * ===================================================================== - SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, IWORK, INFO ) + SUBROUTINE SGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -227,14 +230,14 @@ * .. * .. Array Arguments .. INTEGER IWORK( * ) - REAL A( LDA, * ), S( * ), U( LDU, * ), + REAL A( LDA, * ), S( * ), U( LDU, * ), $ VT( LDVT, * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -243,7 +246,16 @@ $ IR, ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR, NWORK, WRKBL - REAL ANRM, BIGNUM, EPS, SMLNUM + INTEGER LWORK_SGEBRD_MN, LWORK_SGEBRD_MM, + $ LWORK_SGEBRD_NN, LWORK_SGELQF_MN, + $ LWORK_SGEQRF_MN, + $ LWORK_SORGBR_P_MM, LWORK_SORGBR_Q_NN, + $ LWORK_SORGLQ_MN, LWORK_SORGLQ_NN, + $ LWORK_SORGQR_MM, LWORK_SORGQR_MN, + $ LWORK_SORMBR_PRT_MM, LWORK_SORMBR_QLN_MM, + $ LWORK_SORMBR_PRT_MN, LWORK_SORMBR_QLN_MN, + $ LWORK_SORMBR_PRT_NN, LWORK_SORMBR_QLN_NN + REAL ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) @@ -256,9 +268,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV REAL SLAMCH, SLANGE - EXTERNAL ILAENV, LSAME, SLAMCH, SLANGE + EXTERNAL SLAMCH, SLANGE, LSAME * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -267,13 +278,13 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + INFO = 0 + MINMN = MIN( M, N ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) LQUERY = ( LWORK.EQ.-1 ) * IF( .NOT.( WNTQA .OR. WNTQS .OR. WNTQO .OR. WNTQN ) ) THEN @@ -294,222 +305,270 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * NB refers to the optimal block size for the immediately -* following subroutine, as returned by ILAENV.) +* following subroutine, as returned by ILAENV. * IF( INFO.EQ.0 ) THEN MINWRK = 1 MAXWRK = 1 + BDSPAC = 0 + MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( M.GE.N .AND. MINMN.GT.0 ) THEN * * Compute space needed for SBDSDC * - MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( WNTQN ) THEN +* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*N ELSE BDSPAC = 3*N*N + 4*N END IF +* +* Compute space preferred for each routine + CALL SGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MN = INT( DUM(1) ) +* + CALL SGEBRD( N, N, DUM(1), N, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_NN = INT( DUM(1) ) +* + CALL SGEQRF( M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SGEQRF_MN = INT( DUM(1) ) +* + CALL SORGBR( 'Q', N, N, N, DUM(1), N, DUM(1), DUM(1), -1, + $ IERR ) + LWORK_SORGBR_Q_NN = INT( DUM(1) ) +* + CALL SORGQR( M, M, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGQR_MM = INT( DUM(1) ) +* + CALL SORGQR( M, N, N, DUM(1), M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGQR_MN = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', N, N, N, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, N, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, M, N, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MM = INT( DUM(1) ) +* IF( M.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+N ) + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + MAXWRK = MAX( WRKBL, BDSPAC + N ) MINWRK = BDSPAC + N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') -* - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 2 (M >> N, JOBZ='O') +* + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + 2*N*N MINWRK = BDSPAC + 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') -* - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'SORGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 3 (M >> N, JOBZ='S') +* + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N MINWRK = BDSPAC + N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') -* - WRKBL = N + N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'SORGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+2*N* - $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 4 (M >> N, JOBZ='A') +* + WRKBL = N + LWORK_SGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_SORGQR_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SGEBRD_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + N*N - MINWRK = BDSPAC + N*N + 2*N + M + MINWRK = N*N + MAX( 3*N + BDSPAC, N + M ) END IF ELSE * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * - WRKBL = 3*N + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*N + LWORK_SGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5n (M >= N, jobz='N') + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*N ) +* Path 5o (M >= N, jobz='O') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*N + MAX( M, N*N+BDSPAC ) + MINWRK = 3*N + MAX( M, N*N + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'QLN', M, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*N ) +* Path 5s (M >= N, jobz='S') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MN ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*N+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*N+N* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, BDSPAC+3*N ) +* Path 5a (M >= N, jobz='A') + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*N + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*N + BDSPAC ) MINWRK = 3*N + MAX( M, BDSPAC ) END IF END IF - ELSE IF ( MINMN.GT.0 ) THEN + ELSE IF( MINMN.GT.0 ) THEN * * Compute space needed for SBDSDC * - MNTHR = INT( MINMN*11.0E0 / 6.0E0 ) IF( WNTQN ) THEN +* sbdsdc needs only 4*N (or 6*N for uplo=L for LAPACK <= 3.6) +* keep 7*N for backwards compatability. BDSPAC = 7*M ELSE BDSPAC = 3*M*M + 4*M END IF +* +* Compute space preferred for each routine + CALL SGEBRD( M, N, DUM(1), M, DUM(1), DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MN = INT( DUM(1) ) +* + CALL SGEBRD( M, M, A, M, S, DUM(1), DUM(1), + $ DUM(1), DUM(1), -1, IERR ) + LWORK_SGEBRD_MM = INT( DUM(1) ) +* + CALL SGELQF( M, N, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_SGELQF_MN = INT( DUM(1) ) +* + CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGLQ_NN = INT( DUM(1) ) +* + CALL SORGLQ( M, N, M, A, M, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGLQ_MN = INT( DUM(1) ) +* + CALL SORGBR( 'P', M, M, M, A, N, DUM(1), DUM(1), -1, IERR ) + LWORK_SORGBR_P_MM = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_MM = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', M, N, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_MN = INT( DUM(1) ) +* + CALL SORMBR( 'P', 'R', 'T', N, N, M, DUM(1), N, + $ DUM(1), DUM(1), N, DUM(1), -1, IERR ) + LWORK_SORMBR_PRT_NN = INT( DUM(1) ) +* + CALL SORMBR( 'Q', 'L', 'N', M, M, M, DUM(1), M, + $ DUM(1), DUM(1), M, DUM(1), -1, IERR ) + LWORK_SORMBR_QLN_MM = INT( DUM(1) ) +* IF( N.GE.MNTHR ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, - $ -1 ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+M ) + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + MAXWRK = MAX( WRKBL, BDSPAC + M ) MINWRK = BDSPAC + M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') -* - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 2t (N >> M, JOBZ='O') +* + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + 2*M*M MINWRK = BDSPAC + 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'SORGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 3t (N >> M, JOBZ='S') +* + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_MN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M MINWRK = BDSPAC + M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') -* - WRKBL = M + M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'SORGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+2*M* - $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 4t (N >> M, JOBZ='A') +* + WRKBL = M + LWORK_SGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_SORGLQ_NN ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SGEBRD_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MM ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*M - MINWRK = BDSPAC + M*M + 3*M + MINWRK = M*M + MAX( 3*M + BDSPAC, M + N ) END IF ELSE * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * - WRKBL = 3*M + ( M+N )*ILAENV( 1, 'SGEBRD', ' ', M, N, -1, - $ -1 ) + WRKBL = 3*M + LWORK_SGEBRD_MN IF( WNTQN ) THEN - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5tn (N > M, jobz='N') + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQO ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) ) - WRKBL = MAX( WRKBL, BDSPAC+3*M ) +* Path 5to (N > M, jobz='O') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MN ) + WRKBL = MAX( WRKBL, 3*M + BDSPAC ) MAXWRK = WRKBL + M*N - MINWRK = 3*M + MAX( N, M*M+BDSPAC ) + MINWRK = 3*M + MAX( N, M*M + BDSPAC ) ELSE IF( WNTQS ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', M, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ts (N > M, jobz='S') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_MN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) ELSE IF( WNTQA ) THEN - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'QLN', M, M, N, -1 ) ) - WRKBL = MAX( WRKBL, 3*M+M* - $ ILAENV( 1, 'SORMBR', 'PRT', N, N, M, -1 ) ) - MAXWRK = MAX( WRKBL, BDSPAC+3*M ) +* Path 5ta (N > M, jobz='A') + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 3*M + LWORK_SORMBR_PRT_NN ) + MAXWRK = MAX( WRKBL, 3*M + BDSPAC ) MINWRK = 3*M + MAX( N, BDSPAC ) END IF END IF END IF + MAXWRK = MAX( MAXWRK, MINWRK ) WORK( 1 ) = MAXWRK * @@ -559,17 +618,18 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need 2*N, prefer N+N*NB) +* Workspace: need N [tau] + N [work] +* Workspace: prefer N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out below R * @@ -580,7 +640,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need 4*N, prefer 3*N+2*N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -588,14 +649,14 @@ NWORK = IE + N * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need N+BDSPAC) +* Workspace: need N [e] + BDSPAC * CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ = 'O') +* Path 2 (M >> N, JOBZ = 'O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -603,42 +664,45 @@ * * WORK(IR) is LDWRKR by N * - IF( LWORK.GE.LDA*N+N*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. LDA*N + N*N + 3*N + BDSPAC ) THEN LDWRKR = LDA ELSE - LDWRKR = ( LWORK-N*N-3*N-BDSPAC ) / N + LDWRKR = ( LWORK - N*N - 3*N - BDSPAC ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL SLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * -* Bidiagonalize R in VT, copying result to WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Bidiagonalize R in WORK(IR) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * WORK(IU) is N by N * @@ -648,7 +712,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -656,21 +720,23 @@ * * Overwrite WORK(IU) by left singular vectors of R * and VT by right singular vectors of R -* (Workspace: need 2*N*N+3*N, prefer 2*N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), WORK( IU ), N, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N*N [U] +* Workspace: prefer M*N [R] + 3*N [e, tauq, taup] + N*N [U] * DO 10 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), N, ZERO, WORK( IR ), $ LDWRKR ) @@ -680,7 +746,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -693,38 +759,41 @@ NWORK = ITAU + N * * Compute A=Q*R -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy R to WORK(IR), zeroing out below it * CALL SLACPY( 'U', N, N, A, LDA, WORK( IR ), LDWRKR ) - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, WORK( IR+1 ), + CALL SLASET( 'L', N - 1, N - 1, ZERO, ZERO, WORK(IR+1), $ LDWRKR ) * * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need N*N [R] + N [tau] + N [work] +* Workspace: prefer N*N [R] + N [tau] + N*NB [work] * CALL SORGQR( M, N, N, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + N ITAUP = ITAUQ + N NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, WORK( IR ), LDWRKR, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagoal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -732,19 +801,20 @@ * * Overwrite U by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [R] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [R] + 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * CALL SORMBR( 'P', 'R', 'T', N, N, N, WORK( IR ), LDWRKR, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (Workspace: need N*N) +* Workspace: need N*N [R] * CALL SLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL SGEMM( 'N', 'N', M, N, N, ONE, A, LDA, WORK( IR ), @@ -752,7 +822,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -765,16 +835,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + N [work] +* Workspace: prefer N*N [U] + N [tau] + N*NB [work] * CALL SGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (Workspace: need N*N+N+M, prefer N*N+N+M*NB) +* Workspace: need N*N [U] + N [tau] + M [work] +* Workspace: prefer N*N [U] + N [tau] + M*NB [work] CALL SORGQR( M, M, N, U, LDU, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce R in A, zeroing out other entries * @@ -785,7 +857,8 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (Workspace: need N*N+4*N, prefer N*N+3*N+2*N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + 2*N*NB [work] * CALL SGEBRD( N, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -794,7 +867,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), N, $ VT, LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -802,18 +875,19 @@ * * Overwrite WORK(IU) by left singular vectors of R and VT * by right singular vectors of R -* (Workspace: need N*N+3*N, prefer N*N+2*N+N*NB) +* Workspace: need N*N [U] + 3*N [e, tauq, taup] + N [work] +* Workspace: prefer N*N [U] + 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', N, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (Workspace: need N*N) +* Workspace: need N*N [U] * CALL SGEMM( 'N', 'N', M, N, N, ONE, U, LDU, WORK( IU ), $ LDWRKU, ZERO, A, LDA ) @@ -828,7 +902,7 @@ * * M .LT. MNTHR * -* Path 5 (M at least N, but not much larger) +* Path 5 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * IE = 1 @@ -837,21 +911,24 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (Workspace: need 3*N+M, prefer 3*N+(M+N)*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + (M+N)*NB [work] * CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >= N, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'N', N, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5o (M >= N, JOBZ='O') IU = NWORK - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * * WORK( IU ) is M by N * @@ -859,6 +936,8 @@ NWORK = IU + LDWRKU*N CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IU ), $ LDWRKU ) +* IR is unused; silence compile warnings + IR = -1 ELSE * * WORK( IU ) is N by N @@ -869,53 +948,59 @@ * WORK(IR) is LDWRKR by N * IR = NWORK - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in WORK(IU) and computing right * singular vectors of bidiagonal matrix in VT -* (Workspace: need N+N*N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + BDSPAC * CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), WORK( IU ), $ LDWRKU, VT, LDVT, DUM, IDUM, WORK( NWORK ), $ IWORK, INFO ) * * Overwrite VT by right singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*N+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*N + BDSPAC ) THEN * +* Path 5o-fast * Overwrite WORK(IU) by left singular vectors of A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + M*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*N [U] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), WORK( IU ), LDWRKU, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy left singular vectors of A from WORK(IU) to A * CALL SLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 5o-slow * Generate Q in A -* (Workspace: need N*N+2*N, prefer N*N+N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + N*NB [work] * CALL SORGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by left singular vectors of * bidiagonal matrix in WORK(IU), storing result in * WORK(IR) and copying to A -* (Workspace: need 2*N*N, prefer N*N+M*N) +* Workspace: need 3*N [e, tauq, taup] + N*N [U] + NB*N [R] +* Workspace: prefer 3*N [e, tauq, taup] + N*N [U] + M*N [R] * DO 20 I = 1, M, LDWRKR - CHUNK = MIN( M-I+1, LDWRKR ) + CHUNK = MIN( M - I + 1, LDWRKR ) CALL SGEMM( 'N', 'N', CHUNK, N, N, ONE, A( I, 1 ), $ LDA, WORK( IU ), LDWRKU, ZERO, $ WORK( IR ), LDWRKR ) @@ -926,10 +1011,11 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, N, ZERO, ZERO, U, LDU ) CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -938,20 +1024,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*N, prefer 2*N+N*NB) +* Workspace: need 3*N [e, tauq, taup] + N [work] +* Workspace: prefer 3*N [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, N, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need N+BDSPAC) +* Workspace: need 3*N [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, M, ZERO, ZERO, U, LDU ) CALL SBDSDC( 'U', 'I', N, S, WORK( IE ), U, LDU, VT, @@ -961,20 +1049,21 @@ * Set the right corner of U to identity matrix * IF( M.GT.N ) THEN - CALL SLASET( 'F', M-N, M-N, ZERO, ONE, U( N+1, N+1 ), + CALL SLASET( 'F', M - N, M - N, ZERO, ONE, U(N+1,N+1), $ LDU ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need N*N+2*N+M, prefer N*N+2*N+M*NB) +* Workspace: need 3*N [e, tauq, taup] + M [work] +* Workspace: prefer 3*N [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF @@ -989,17 +1078,18 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need 2*M, prefer M+M*NB) +* Workspace: need M [tau] + M [work] +* Workspace: prefer M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Zero out above L * @@ -1010,7 +1100,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need 4*M, prefer 3*M+2*M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1018,68 +1109,69 @@ NWORK = IE + M * * Perform bidiagonal SVD, computing singular values only -* (Workspace: need M+BDSPAC) +* Workspace: need M [e] + BDSPAC * CALL SBDSDC( 'U', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * IVT = 1 * -* IVT is M by M +* WORK(IVT) is M by M +* WORK(IL) is M by M; it is later resized to M by chunk for gemm * IL = IVT + M*M - IF( LWORK.GE.M*N+M*M+3*M+BDSPAC ) THEN -* -* WORK(IL) is M by N -* + IF( LWORK .GE. M*N + M*M + 3*M + BDSPAC ) THEN LDWRKL = M CHUNK = N ELSE LDWRKL = M - CHUNK = ( LWORK-M*M ) / M + CHUNK = ( LWORK - M*M ) / M END IF ITAU = IL + LDWRKL*M NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing about above it * CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL SLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] * CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U, and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), M, DUM, IDUM, WORK( NWORK ), @@ -1087,21 +1179,24 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need 2*M*M+3*M, prefer 2*M*M+2*M+M*NB) +* Workspace: need M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), WORK( IVT ), M, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by Q * in A, storing result in WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need M*M [VT] + M*M [L] +* Workspace: prefer M*M [VT] + M*N [L] +* At this point, L is resized as M by chunk. * DO 30 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), M, $ A( 1, I ), LDA, ZERO, WORK( IL ), LDWRKL ) CALL SLACPY( 'F', M, BLK, WORK( IL ), LDWRKL, @@ -1110,7 +1205,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') +* Path 3t (N >> M, JOBZ='S') * M right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1123,38 +1218,41 @@ NWORK = ITAU + M * * Compute A=L*Q -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Copy L to WORK(IL), zeroing out above it * CALL SLACPY( 'L', M, M, A, LDA, WORK( IL ), LDWRKL ) - CALL SLASET( 'U', M-1, M-1, ZERO, ZERO, - $ WORK( IL+LDWRKL ), LDWRKL ) + CALL SLASET( 'U', M - 1, M - 1, ZERO, ZERO, + $ WORK( IL + LDWRKL ), LDWRKL ) * * Generate Q in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [L] + M [tau] + M [work] +* Workspace: prefer M*M [L] + M [tau] + M*NB [work] * CALL SORGLQ( M, N, M, A, LDA, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) IE = ITAU ITAUQ = IE + M ITAUP = ITAUQ + M NWORK = ITAUP + M * -* Bidiagonalize L in WORK(IU), copying result to U -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Bidiagonalize L in WORK(IU). +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, WORK( IL ), LDWRKL, S, WORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, VT, $ LDVT, DUM, IDUM, WORK( NWORK ), IWORK, @@ -1162,18 +1260,19 @@ * * Overwrite U by left singular vectors of L and VT * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [L] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [L] + 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, WORK( IL ), LDWRKL, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IL) by * Q in A, storing result in VT -* (Workspace: need M*M) +* Workspace: need M*M [L] * CALL SLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IL ), LDWRKL, @@ -1181,7 +1280,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1194,17 +1293,19 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + M [work] +* Workspace: prefer M*M [VT] + M [tau] + M*NB [work] * CALL SGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need M*M [VT] + M [tau] + N [work] +* Workspace: prefer M*M [VT] + M [tau] + N*NB [work] * CALL SORGLQ( N, N, M, VT, LDVT, WORK( ITAU ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Produce L in A, zeroing out other entries * @@ -1215,7 +1316,8 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (Workspace: need M*M+4*M, prefer M*M+3*M+2*M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup] + 2*M*NB [work] * CALL SGEBRD( M, M, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1224,7 +1326,7 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M+M*M+BDSPAC) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'U', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, @@ -1232,18 +1334,19 @@ * * Overwrite U by left singular vectors of L and WORK(IVT) * by right singular vectors of L -* (Workspace: need M*M+3*M, prefer M*M+2*M+M*NB) +* Workspace: need M*M [VT] + 3*M [e, tauq, taup]+ M [work] +* Workspace: prefer M*M [VT] + 3*M [e, tauq, taup]+ M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, M, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, M, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (Workspace: need M*M) +* Workspace: need M*M [VT] * CALL SGEMM( 'N', 'N', M, N, M, ONE, WORK( IVT ), LDWKVT, $ VT, LDVT, ZERO, A, LDA ) @@ -1258,7 +1361,7 @@ * * N .LT. MNTHR * -* Path 5t (N greater than M, but not much larger) +* Path 5t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * IE = 1 @@ -1267,28 +1370,33 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (Workspace: need 3*M+N, prefer 3*M+(M+N)*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + (M+N)*NB [work] * CALL SGEBRD( M, N, A, LDA, S, WORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5tn (N > M, JOBZ='N') * Perform bidiagonal SVD, only computing singular values -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SBDSDC( 'L', 'N', M, S, WORK( IE ), DUM, 1, DUM, 1, $ DUM, IDUM, WORK( NWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 5to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * * WORK( IVT ) is M by N * CALL SLASET( 'F', M, N, ZERO, ZERO, WORK( IVT ), $ LDWKVT ) NWORK = IVT + LDWKVT*N +* IL is unused; silence compile warnings + IL = -1 ELSE * * WORK( IVT ) is M by M @@ -1298,52 +1406,58 @@ * * WORK(IL) is M by CHUNK * - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in WORK(IVT) -* (Workspace: need M*M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + BDSPAC * CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, $ WORK( IVT ), LDWKVT, DUM, IDUM, $ WORK( NWORK ), IWORK, INFO ) * * Overwrite U by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) * - IF( LWORK.GE.M*N+3*M+BDSPAC ) THEN + IF( LWORK .GE. M*N + 3*M + BDSPAC ) THEN * +* Path 5to-fast * Overwrite WORK(IVT) by left singular vectors of A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*N [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*N [VT] + M*NB [work] * CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), WORK( IVT ), LDWKVT, - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Copy right singular vectors of A from WORK(IVT) to A * CALL SLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 5to-slow * Generate P**T in A -* (Workspace: need M*M+2*M, prefer M*M+M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*NB [work] * CALL SORGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), - $ WORK( NWORK ), LWORK-NWORK+1, IERR ) + $ WORK( NWORK ), LWORK - NWORK + 1, IERR ) * * Multiply Q in A by right singular vectors of * bidiagonal matrix in WORK(IVT), storing result in * WORK(IL) and copying to A -* (Workspace: need 2*M*M, prefer M*M+M*N) +* Workspace: need 3*M [e, tauq, taup] + M*M [VT] + M*NB [L] +* Workspace: prefer 3*M [e, tauq, taup] + M*M [VT] + M*N [L] * DO 40 I = 1, N, CHUNK - BLK = MIN( N-I+1, CHUNK ) + BLK = MIN( N - I + 1, CHUNK ) CALL SGEMM( 'N', 'N', M, BLK, M, ONE, WORK( IVT ), $ LDWKVT, A( 1, I ), LDA, ZERO, $ WORK( IL ), M ) @@ -1353,10 +1467,11 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 5ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', M, N, ZERO, ZERO, VT, LDVT ) CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1365,20 +1480,22 @@ * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 3*M, prefer 2*M+M*NB) +* Workspace: need 3*M [e, tauq, taup] + M [work] +* Workspace: prefer 3*M [e, tauq, taup] + M*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', M, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) ELSE IF( WNTQA ) THEN * +* Path 5ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in U and computing right singular * vectors of bidiagonal matrix in VT -* (Workspace: need M+BDSPAC) +* Workspace: need 3*M [e, tauq, taup] + BDSPAC * CALL SLASET( 'F', N, N, ZERO, ZERO, VT, LDVT ) CALL SBDSDC( 'L', 'I', M, S, WORK( IE ), U, LDU, VT, @@ -1388,20 +1505,21 @@ * Set the right corner of VT to identity matrix * IF( N.GT.M ) THEN - CALL SLASET( 'F', N-M, N-M, ZERO, ONE, VT( M+1, M+1 ), + CALL SLASET( 'F', N-M, N-M, ZERO, ONE, VT(M+1,M+1), $ LDVT ) END IF * * Overwrite U by left singular vectors of A and VT * by right singular vectors of A -* (Workspace: need 2*M+N, prefer 2*M+N*NB) +* Workspace: need 3*M [e, tauq, taup] + N [work] +* Workspace: prefer 3*M [e, tauq, taup] + N*NB [work] * CALL SORMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) CALL SORMBR( 'P', 'R', 'T', N, N, M, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), - $ LWORK-NWORK+1, IERR ) + $ LWORK - NWORK + 1, IERR ) END IF * END IF diff --git a/lapack-netlib/SRC/sgesvd.f b/lapack-netlib/SRC/sgesvd.f index 263548b0..4e37528b 100644 --- a/lapack-netlib/SRC/sgesvd.f +++ b/lapack-netlib/SRC/sgesvd.f @@ -211,7 +211,7 @@ SUBROUTINE SGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, $ WORK, LWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.1) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -314,24 +314,24 @@ BDSPAC = 5*N * Compute space needed for SGEQRF CALL SGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SGEQRF=DUM(1) + LWORK_SGEQRF = INT( DUM(1) ) * Compute space needed for SORGQR CALL SORGQR( M, N, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGQR_N=DUM(1) + LWORK_SORGQR_N = INT( DUM(1) ) CALL SORGQR( M, M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGQR_M=DUM(1) + LWORK_SORGQR_M = INT( DUM(1) ) * Compute space needed for SGEBRD CALL SGEBRD( N, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) * Compute space needed for SORGBR P CALL SORGBR( 'P', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) * Compute space needed for SORGBR Q CALL SORGBR( 'Q', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -447,18 +447,18 @@ * CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) MAXWRK = 3*N + LWORK_SGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL SORGBR( 'Q', M, N, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q ) END IF IF( WNTUA ) THEN CALL SORGBR( 'Q', M, M, N, A, LDA, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*N+LWORK_SORGBR_Q ) END IF IF( .NOT.WNTVN ) THEN @@ -475,24 +475,24 @@ BDSPAC = 5*M * Compute space needed for SGELQF CALL SGELQF( M, N, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SGELQF=DUM(1) + LWORK_SGELQF = INT( DUM(1) ) * Compute space needed for SORGLQ CALL SORGLQ( N, N, M, DUM(1), N, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGLQ_N=DUM(1) + LWORK_SORGLQ_N = INT( DUM(1) ) CALL SORGLQ( M, N, M, A, LDA, DUM(1), DUM(1), -1, IERR ) - LWORK_SORGLQ_M=DUM(1) + LWORK_SORGLQ_M = INT( DUM(1) ) * Compute space needed for SGEBRD CALL SGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) * Compute space needed for SORGBR P CALL SORGBR( 'P', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) * Compute space needed for SORGBR Q CALL SORGBR( 'Q', M, M, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_Q=DUM(1) + LWORK_SORGBR_Q = INT( DUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -608,19 +608,19 @@ * CALL SGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, IERR ) - LWORK_SGEBRD=DUM(1) + LWORK_SGEBRD = INT( DUM(1) ) MAXWRK = 3*M + LWORK_SGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for SORGBR P CALL SORGBR( 'P', M, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P ) END IF IF( WNTVA ) THEN CALL SORGBR( 'P', N, N, M, A, N, DUM(1), $ DUM(1), -1, IERR ) - LWORK_SORGBR_P=DUM(1) + LWORK_SORGBR_P = INT( DUM(1) ) MAXWRK = MAX( MAXWRK, 3*M+LWORK_SORGBR_P ) END IF IF( .NOT.WNTUN ) THEN @@ -693,7 +693,10 @@ * * Zero out below R * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = IE + N ITAUP = ITAUQ + N @@ -1122,8 +1125,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1285,8 +1290,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1588,8 +1595,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) @@ -1756,8 +1765,10 @@ * * Zero out below R in A * - CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL SLASET( 'L', N-1, N-1, ZERO, ZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (Workspace: need 4*N, prefer 3*N+2*N*NB) diff --git a/lapack-netlib/SRC/sgesvdx.f b/lapack-netlib/SRC/sgesvdx.f index aae8b076..8a2fc9b0 100644 --- a/lapack-netlib/SRC/sgesvdx.f +++ b/lapack-netlib/SRC/sgesvdx.f @@ -123,13 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -137,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -169,7 +175,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -248,7 +254,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEsing * @@ -257,10 +263,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -357,8 +363,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -380,18 +392,34 @@ * * Path 1 (M much larger than N) * - MAXWRK = N*(N*2+16) + + MAXWRK = N + $ N*ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*(N*2+20) + 2*N* + MAXWRK = MAX( MAXWRK, N*(N+5) + 2*N* $ ILAENV( 1, 'SGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*3+6)+N* + $ ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = N*(N*3+20) ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = N*(N*2+19) + ( M+N )* + MAXWRK = 4*N + ( M+N )* $ ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) - MINWRK = N*(N*2+20) + M + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'SORMQR', ' ', N, N, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,N*(N*2+5)+N* + $ ILAENV( 1, 'SORMLQ', ' ', N, N, -1, -1 ) ) + END IF + MINWRK = MAX(N*(N*2+19),4*N+M) END IF ELSE MNTHR = ILAENV( 6, 'SGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -399,18 +427,34 @@ * * Path 1t (N much larger than M) * - MAXWRK = M*(M*2+16) + + MAXWRK = M + $ M*ILAENV( 1, 'SGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*(M*2+20) + 2*M* + MAXWRK = MAX( MAXWRK, M*(M+5) + 2*M* $ ILAENV( 1, 'SGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M*2+21) + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*3+6)+M* + $ ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = M*(M*3+20) ELSE * -* Path 2t (N greater than M, but not much larger) +* Path 2t (N at least M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* + MAXWRK = 4*M + ( M+N )* $ ILAENV( 1, 'SGEBRD', ' ', M, N, -1, -1 ) - MINWRK = M*(M*2+20) + N + IF (WANTU) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'SORMQR', ' ', M, M, -1, -1 ) ) + END IF + IF (WANTVT) THEN + MAXWRK = MAX(MAXWRK,M*(M*2+5)+M* + $ ILAENV( 1, 'SORMLQ', ' ', M, M, -1, -1 ) ) + END IF + MINWRK = MAX(M*(M*2+19),4*M+N) END IF END IF END IF @@ -522,7 +566,7 @@ CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call SORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,7 +635,7 @@ CALL SCOPY( N, WORK( J ), 1, U( 1,I ), 1 ) J = J + N*2 END DO - CALL SLASET( 'A', M-N, N, ZERO, ZERO, U( N+1,1 ), LDU ) + CALL SLASET( 'A', M-N, NS, ZERO, ZERO, U( N+1,1 ), LDU ) * * Call SORMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -687,7 +731,7 @@ CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call SORMBR to compute (VB**T)*(PB**T) * (Workspace in WORK( ITEMP ): need M, prefer M*NB) @@ -756,7 +800,7 @@ CALL SCOPY( M, WORK( J ), 1, VT( I,1 ), LDVT ) J = J + M*2 END DO - CALL SLASET( 'A', M, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT ) + CALL SLASET( 'A', NS, N-M, ZERO, ZERO, VT( 1,M+1 ), LDVT) * * Call SORMBR to compute VB**T * PB**T * (Workspace in WORK( ITEMP ): need M, prefer M*NB) diff --git a/lapack-netlib/SRC/sgetc2.f b/lapack-netlib/SRC/sgetc2.f index 59844651..ce6a5b39 100644 --- a/lapack-netlib/SRC/sgetc2.f +++ b/lapack-netlib/SRC/sgetc2.f @@ -98,7 +98,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realGEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE SGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/sgetrf2.f b/lapack-netlib/SRC/sgetrf2.f index 068710b7..02b6c345 100644 --- a/lapack-netlib/SRC/sgetrf2.f +++ b/lapack-netlib/SRC/sgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 * [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realGEcomputational * * ===================================================================== RECURSIVE SUBROUTINE SGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/sgghd3.f b/lapack-netlib/SRC/sgghd3.f index 3c58aea7..758f4b5c 100644 --- a/lapack-netlib/SRC/sgghd3.f +++ b/lapack-netlib/SRC/sgghd3.f @@ -230,7 +230,7 @@ SUBROUTINE SGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'SGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = REAL( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/sggsvp3.f b/lapack-netlib/SRC/sggsvp3.f index f5496246..595afab1 100644 --- a/lapack-netlib/SRC/sggsvp3.f +++ b/lapack-netlib/SRC/sggsvp3.f @@ -220,7 +220,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> WORK is REAL array, dimension (MAX(1,LWORK)) *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK. *> \endverbatim *> @@ -272,7 +272,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 diff --git a/lapack-netlib/SRC/shgeqz.f b/lapack-netlib/SRC/shgeqz.f index 254e65fc..6d55c556 100644 --- a/lapack-netlib/SRC/shgeqz.f +++ b/lapack-netlib/SRC/shgeqz.f @@ -211,12 +211,12 @@ *> \param[in,out] Q *> \verbatim *> Q is REAL array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the orthogonal matrix Q1 used in +*> On entry, if COMPQ = 'V', the orthogonal matrix Q1 used in *> the reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the orthogonal matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the orthogonal matrix +*> On exit, if COMPQ = 'I', the orthogonal matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the orthogonal matrix *> of left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -282,7 +282,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realGEcomputational * @@ -304,10 +304,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, WORK, $ LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER COMPQ, COMPZ, JOB diff --git a/lapack-netlib/SRC/slaed1.f b/lapack-netlib/SRC/slaed1.f index 74eeb633..c6f52d0f 100644 --- a/lapack-netlib/SRC/slaed1.f +++ b/lapack-netlib/SRC/slaed1.f @@ -54,7 +54,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED2. *> @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -163,10 +163,10 @@ SUBROUTINE SLAED1( N, D, Q, LDQ, INDXQ, RHO, CUTPNT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CUTPNT, INFO, LDQ, N diff --git a/lapack-netlib/SRC/slaed7.f b/lapack-netlib/SRC/slaed7.f index 3d3d6292..f6615e03 100644 --- a/lapack-netlib/SRC/slaed7.f +++ b/lapack-netlib/SRC/slaed7.f @@ -59,7 +59,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLAED8. *> @@ -244,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -260,10 +260,10 @@ $ PERM, GIVPTR, GIVCOL, GIVNUM, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, ICOMPQ, INFO, LDQ, N, diff --git a/lapack-netlib/SRC/slag2.f b/lapack-netlib/SRC/slag2.f index ad04333a..da18f6b2 100644 --- a/lapack-netlib/SRC/slag2.f +++ b/lapack-netlib/SRC/slag2.f @@ -99,7 +99,7 @@ *> will always be positive. If the eigenvalues are real, then *> the first (real) eigenvalue is WR1 / SCALE1 , but this may *> overflow or underflow, and in fact, SCALE1 may be zero or -*> less than the underflow threshhold if the exact eigenvalue +*> less than the underflow threshold if the exact eigenvalue *> is sufficiently large. *> \endverbatim *> @@ -112,7 +112,7 @@ *> eigenvalues are real, then the second (real) eigenvalue is *> WR2 / SCALE2 , but this may overflow or underflow, and in *> fact, SCALE2 may be zero or less than the underflow -*> threshhold if the exact eigenvalue is sufficiently large. +*> threshold if the exact eigenvalue is sufficiently large. *> \endverbatim *> *> \param[out] WR1 @@ -148,7 +148,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -156,10 +156,10 @@ SUBROUTINE SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, $ WR2, WI ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB @@ -266,8 +266,8 @@ * Note: the test of R in the following IF is to cover the case when * DISCR is small and negative and is flushed to zero during * the calculation of R. On machines which have a consistent -* flush-to-zero threshhold and handle numbers above that -* threshhold correctly, it would not be necessary. +* flush-to-zero threshold and handle numbers above that +* threshold correctly, it would not be necessary. * IF( DISCR.GE.ZERO .OR. R.EQ.ZERO ) THEN SUM = PP + SIGN( R, PP ) diff --git a/lapack-netlib/SRC/slamrg.f b/lapack-netlib/SRC/slamrg.f index 6229abd6..7f171cbe 100644 --- a/lapack-netlib/SRC/slamrg.f +++ b/lapack-netlib/SRC/slamrg.f @@ -50,7 +50,7 @@ *> \param[in] N2 *> \verbatim *> N2 is INTEGER -*> These arguements contain the respective lengths of the two +*> These arguments contain the respective lengths of the two *> sorted lists to be merged. *> \endverbatim *> @@ -92,17 +92,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N1, N2, STRD1, STRD2 diff --git a/lapack-netlib/SRC/slaqr3.f b/lapack-netlib/SRC/slaqr3.f index 150febd4..b80b27af 100644 --- a/lapack-netlib/SRC/slaqr3.f +++ b/lapack-netlib/SRC/slaqr3.f @@ -138,7 +138,7 @@ *> Z is REAL array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the orthogonal *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -260,7 +260,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -275,10 +275,10 @@ $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T, $ LDT, NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/slaqr5.f b/lapack-netlib/SRC/slaqr5.f index 6a299741..d9ed7922 100644 --- a/lapack-netlib/SRC/slaqr5.f +++ b/lapack-netlib/SRC/slaqr5.f @@ -150,10 +150,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is REAL array of size (LDZ,IHI) +*> Z is REAL array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep orthogonal *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -236,7 +236,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -259,10 +259,10 @@ $ SR, SI, H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, $ LDU, NV, WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/slarrc.f b/lapack-netlib/SRC/slarrc.f index 7812ca55..ec9c252c 100644 --- a/lapack-netlib/SRC/slarrc.f +++ b/lapack-netlib/SRC/slarrc.f @@ -59,25 +59,26 @@ *> *> \param[in] VL *> \verbatim -*> VL is DOUBLE PRECISION +*> VL is REAL +*> The lower bound for the eigenvalues. *> \endverbatim *> *> \param[in] VU *> \verbatim -*> VU is DOUBLE PRECISION -*> The lower and upper bounds for the eigenvalues. +*> VU is REAL +*> The upper bound for the eigenvalues. *> \endverbatim *> *> \param[in] D *> \verbatim -*> D is DOUBLE PRECISION array, dimension (N) +*> D is REAL array, dimension (N) *> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. *> JOBT = 'L': The N diagonal elements of the diagonal matrix D. *> \endverbatim *> *> \param[in] E *> \verbatim -*> E is DOUBLE PRECISION array, dimension (N) +*> E is REAL array, dimension (N) *> JOBT = 'T': The N-1 offdiagonal elements of the matrix T. *> JOBT = 'L': The N-1 offdiagonal elements of the matrix L. *> \endverbatim @@ -119,7 +120,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -136,10 +137,10 @@ SUBROUTINE SLARRC( JOBT, N, VL, VU, D, E, PIVMIN, $ EIGCNT, LCNT, RCNT, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBT diff --git a/lapack-netlib/SRC/slarrd.f b/lapack-netlib/SRC/slarrd.f index 7d17210c..5ac428e2 100644 --- a/lapack-netlib/SRC/slarrd.f +++ b/lapack-netlib/SRC/slarrd.f @@ -92,12 +92,16 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -106,13 +110,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +319,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -321,10 +329,10 @@ $ M, W, WERR, WL, WU, IBLOCK, INDEXW, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/slarre.f b/lapack-netlib/SRC/slarre.f index a5b9f2fd..bf56986c 100644 --- a/lapack-netlib/SRC/slarre.f +++ b/lapack-netlib/SRC/slarre.f @@ -78,12 +78,17 @@ *> \param[in,out] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound for the eigenvalues. +*> Eigenvalues less than or equal to VL, or greater than VU, +*> will not be returned. VL < VU. +*> If RANGE='I' or ='A', SLARRE computes bounds on the desired +*> part of the spectrum. *> \endverbatim *> *> \param[in,out] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds for the eigenvalues. +*> If RANGE='V', the upper bound for the eigenvalues. *> Eigenvalues less than or equal to VL, or greater than VU, *> will not be returned. VL < VU. *> If RANGE='I' or ='A', SLARRE computes bounds on the desired @@ -93,13 +98,16 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N. *> \endverbatim *> @@ -244,7 +252,7 @@ *> \verbatim *> INFO is INTEGER *> = 0: successful exit -*> > 0: A problem occured in SLARRE. +*> > 0: A problem occurred in SLARRE. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -268,7 +276,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -297,10 +305,10 @@ $ W, WERR, WGAP, IBLOCK, INDEXW, GERS, PIVMIN, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER RANGE diff --git a/lapack-netlib/SRC/slarrf.f b/lapack-netlib/SRC/slarrf.f index 058e5027..f686018d 100644 --- a/lapack-netlib/SRC/slarrf.f +++ b/lapack-netlib/SRC/slarrf.f @@ -51,7 +51,7 @@ *> \param[in] N *> \verbatim *> N is INTEGER -*> The order of the matrix (subblock, if the matrix splitted). +*> The order of the matrix (subblock, if the matrix split). *> \endverbatim *> *> \param[in] D @@ -174,7 +174,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -193,10 +193,10 @@ $ SPDIAM, CLGAPL, CLGAPR, PIVMIN, SIGMA, $ DPLUS, LPLUS, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER CLSTRT, CLEND, INFO, N diff --git a/lapack-netlib/SRC/slarrv.f b/lapack-netlib/SRC/slarrv.f index 73847f39..b098c3d1 100644 --- a/lapack-netlib/SRC/slarrv.f +++ b/lapack-netlib/SRC/slarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is REAL array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by SLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in SLARRV. +*> > 0: A problem occurred in SLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/slarscl2.f b/lapack-netlib/SRC/slarscl2.f index df7ede2c..3f51d722 100644 --- a/lapack-netlib/SRC/slarscl2.f +++ b/lapack-netlib/SRC/slarscl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * * ===================================================================== SUBROUTINE SLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/slascl.f b/lapack-netlib/SRC/slascl.f index bacf86ed..d67ea0f0 100644 --- a/lapack-netlib/SRC/slascl.f +++ b/lapack-netlib/SRC/slascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * * ===================================================================== SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/slascl2.f b/lapack-netlib/SRC/slascl2.f index a44a3c8f..bb2f960b 100644 --- a/lapack-netlib/SRC/slascl2.f +++ b/lapack-netlib/SRC/slascl2.f @@ -72,7 +72,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -83,17 +83,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHERcomputational * * ===================================================================== SUBROUTINE SLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/slasd1.f b/lapack-netlib/SRC/slasd1.f index ae076a0f..63d878be 100644 --- a/lapack-netlib/SRC/slasd1.f +++ b/lapack-netlib/SRC/slasd1.f @@ -60,7 +60,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or when there are zeros in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLASD2. *> @@ -156,7 +156,7 @@ *> The leading dimension of the array VT. LDVT >= max( 1, M ). *> \endverbatim *> -*> \param[out] IDXQ +*> \param[in,out] IDXQ *> \verbatim *> IDXQ is INTEGER array, dimension (N) *> This contains the permutation which will reintegrate the @@ -190,7 +190,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -204,10 +204,10 @@ SUBROUTINE SLASD1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, $ IDXQ, IWORK, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDU, LDVT, NL, NR, SQRE diff --git a/lapack-netlib/SRC/slasd6.f b/lapack-netlib/SRC/slasd6.f index f79a06d0..9f31e6cc 100644 --- a/lapack-netlib/SRC/slasd6.f +++ b/lapack-netlib/SRC/slasd6.f @@ -74,7 +74,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple singular values or if there is a zero -*> in the Z vector. For each such occurence the dimension of the +*> in the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine SLASD7. *> @@ -232,14 +232,13 @@ *> \param[out] DIFR *> \verbatim *> DIFR is REAL array, -*> dimension ( LDGNUM, 2 ) if ICOMPQ = 1 and -*> dimension ( N ) if ICOMPQ = 0. -*> On exit, DIFR(I, 1) is the distance between I-th updated -*> (undeflated) singular value and the I+1-th (undeflated) old -*> singular value. +*> dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and +*> dimension ( K ) if ICOMPQ = 0. +*> On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not +*> defined and will not be referenced. *> -*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the -*> normalizing factors for the right singular vector matrix. +*> If ICOMPQ = 1, DIFR(1:K,2) is an array containing the +*> normalizing factors for the right singular vector matrix. *> *> See SLASD8 for details on DIFL and DIFR. *> \endverbatim @@ -298,7 +297,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -314,10 +313,10 @@ $ LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, $ IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL, diff --git a/lapack-netlib/SRC/slasdq.f b/lapack-netlib/SRC/slasdq.f index 289ed855..7b72fb98 100644 --- a/lapack-netlib/SRC/slasdq.f +++ b/lapack-netlib/SRC/slasdq.f @@ -59,7 +59,7 @@ *> \verbatim *> UPLO is CHARACTER*1 *> On entry, UPLO specifies whether the input bidiagonal matrix -*> is upper or lower bidiagonal, and wether it is square are +*> is upper or lower bidiagonal, and whether it is square are *> not. *> UPLO = 'U' or 'u' B is upper bidiagonal. *> UPLO = 'L' or 'l' B is lower bidiagonal. @@ -197,7 +197,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERauxiliary * @@ -211,10 +211,10 @@ SUBROUTINE SLASDQ( UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, $ U, LDU, C, LDC, WORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/slasq3.f b/lapack-netlib/SRC/slasq3.f index 4187a943..879fdfbb 100644 --- a/lapack-netlib/SRC/slasq3.f +++ b/lapack-netlib/SRC/slasq3.f @@ -60,7 +60,7 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is REAL array, dimension ( 4*N ) +*> Z is REAL array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -173,7 +173,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -182,10 +182,10 @@ $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, $ DN2, G, TAU ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. LOGICAL IEEE diff --git a/lapack-netlib/SRC/slasq4.f b/lapack-netlib/SRC/slasq4.f index bdd24f32..1ad5a911 100644 --- a/lapack-netlib/SRC/slasq4.f +++ b/lapack-netlib/SRC/slasq4.f @@ -56,7 +56,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is REAL array, dimension ( 4*N ) +*> Z is REAL array, dimension ( 4*N0 ) *> Z holds the qd array. *> \endverbatim *> @@ -135,7 +135,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -151,10 +151,10 @@ SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, $ DN1, DN2, TAU, TTYPE, G ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER I0, N0, N0IN, PP, TTYPE diff --git a/lapack-netlib/SRC/slasrt.f b/lapack-netlib/SRC/slasrt.f index e93c0d6d..d3aa1292 100644 --- a/lapack-netlib/SRC/slasrt.f +++ b/lapack-netlib/SRC/slasrt.f @@ -81,17 +81,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE SLASRT( ID, N, D, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER ID @@ -123,7 +123,7 @@ * .. * .. Executable Statements .. * -* Test the input paramters. +* Test the input parameters. * INFO = 0 DIR = -1 diff --git a/lapack-netlib/SRC/slasy2.f b/lapack-netlib/SRC/slasy2.f index 5684a119..ed34a823 100644 --- a/lapack-netlib/SRC/slasy2.f +++ b/lapack-netlib/SRC/slasy2.f @@ -166,7 +166,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realSYauxiliary * @@ -174,10 +174,10 @@ SUBROUTINE SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, $ LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. LOGICAL LTRANL, LTRANR @@ -438,8 +438,10 @@ 80 CONTINUE 90 CONTINUE 100 CONTINUE - IF( ABS( T16( 4, 4 ) ).LT.SMIN ) - $ T16( 4, 4 ) = SMIN + IF( ABS( T16( 4, 4 ) ).LT.SMIN ) THEN + INFO = 1 + T16( 4, 4 ) = SMIN + END IF SCALE = ONE IF( ( EIGHT*SMLNUM )*ABS( BTMP( 1 ) ).GT.ABS( T16( 1, 1 ) ) .OR. $ ( EIGHT*SMLNUM )*ABS( BTMP( 2 ) ).GT.ABS( T16( 2, 2 ) ) .OR. diff --git a/lapack-netlib/SRC/slatdf.f b/lapack-netlib/SRC/slatdf.f index 51773d4e..dc5e2b74 100644 --- a/lapack-netlib/SRC/slatdf.f +++ b/lapack-netlib/SRC/slatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value *> of 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where all entries of -*> the r.h.s. b is choosen as either +1 or -1 (Default). +*> the r.h.s. b is chosen as either +1 or -1 (Default). *> \endverbatim *> *> \param[in] N @@ -133,7 +133,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realOTHERauxiliary * @@ -171,10 +171,10 @@ SUBROUTINE SLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/sorbdb1.f b/lapack-netlib/SRC/sorbdb1.f index b1f5f462..a8c2e96b 100644 --- a/lapack-netlib/SRC/sorbdb1.f +++ b/lapack-netlib/SRC/sorbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -304,9 +304,8 @@ $ X11(I+1,I+1), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) - C = SQRT( SNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( SNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL SORBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/sorbdb2.f b/lapack-netlib/SRC/sorbdb2.f index 582540e3..c9919a17 100644 --- a/lapack-netlib/SRC/sorbdb2.f +++ b/lapack-netlib/SRC/sorbdb2.f @@ -201,7 +201,7 @@ SUBROUTINE SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -291,8 +291,8 @@ $ X11(I+1,I), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) - S = SQRT( SNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL SORBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/sorbdb3.f b/lapack-netlib/SRC/sorbdb3.f index ea52f4db..8ce74d40 100644 --- a/lapack-netlib/SRC/sorbdb3.f +++ b/lapack-netlib/SRC/sorbdb3.f @@ -202,7 +202,7 @@ SUBROUTINE SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -293,8 +293,8 @@ $ X11(I,I), LDX11, WORK(ILARF) ) CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) - C = SQRT( SNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( SNRM2( P-I+1, X11(I,I), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL SORBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/sorbdb4.f b/lapack-netlib/SRC/sorbdb4.f index 9ed16a71..1efe146b 100644 --- a/lapack-netlib/SRC/sorbdb4.f +++ b/lapack-netlib/SRC/sorbdb4.f @@ -214,7 +214,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -342,9 +342,8 @@ CALL SLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) IF( I .LT. M-Q ) THEN - S = SQRT( SNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + SNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( SNRM2( P-I, X11(I+1,I), 1 )**2 + $ + SNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/sorcsd2by1.f b/lapack-netlib/SRC/sorcsd2by1.f index b2401af1..3354d091 100644 --- a/lapack-netlib/SRC/sorcsd2by1.f +++ b/lapack-netlib/SRC/sorcsd2by1.f @@ -232,7 +232,7 @@ $ X21, LDX21, THETA, U1, LDU1, U2, LDU2, V1T, $ LDV1T, WORK, LWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -264,6 +264,9 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + REAL DUM1(1), DUM2(1,1) +* .. * .. External Subroutines .. EXTERNAL SBBCSD, SCOPY, SLACPY, SLAPMR, SLAPMT, SORBDB1, $ SORBDB2, SORBDB3, SORBDB4, SORGLQ, SORGQR, @@ -296,11 +299,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -342,98 +345,124 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK, -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ DUM1, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, DUM2, + $ 1, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO + $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), - $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, + $ WORK(1), -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, WORK(1), -1, CHILDINFO ) + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, U2, + $ LDU2, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO + $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, + $ CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, DUM1, $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, LDU2, + $ U1, LDU1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE - CALL SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, + $ DUM1, DUM1, DUM1, DUM1, DUM1, + $ WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL SORGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL SORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), + $ -1, CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL SORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL SORGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, WORK(1), -1, + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, 1, + $ V1T, LDV1T, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF @@ -499,8 +528,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -553,8 +582,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2, + $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -608,11 +637,11 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, U1, - $ LDU1, WORK(IB11D), WORK(IB11E), WORK(IB12D), - $ WORK(IB12E), WORK(IB21D), WORK(IB21E), - $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), + $ WORK(IB12D), WORK(IB12E), WORK(IB21D), + $ WORK(IB21E), WORK(IB22D), WORK(IB22E), + $ WORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions @@ -677,8 +706,8 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1, 1, + $ V1T, LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) diff --git a/lapack-netlib/SRC/ssbevx.f b/lapack-netlib/SRC/ssbevx.f index 0fa1ac45..a03c4a41 100644 --- a/lapack-netlib/SRC/ssbevx.f +++ b/lapack-netlib/SRC/ssbevx.f @@ -126,12 +126,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -139,13 +142,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +256,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -258,10 +265,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssbgvd.f b/lapack-netlib/SRC/ssbgvd.f index b0d48ae9..fac2baad 100644 --- a/lapack-netlib/SRC/ssbgvd.f +++ b/lapack-netlib/SRC/ssbgvd.f @@ -214,7 +214,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -227,10 +227,10 @@ SUBROUTINE SSBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, $ Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -338,7 +338,7 @@ INDWK2 = INDWRK + N*N LLWRK2 = LWORK - INDWK2 + 1 CALL SSBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK( INDWRK ), IINFO ) + $ WORK, IINFO ) * * Reduce to tridiagonal form. * diff --git a/lapack-netlib/SRC/ssbgvx.f b/lapack-netlib/SRC/ssbgvx.f index b35a7b32..2b27f023 100644 --- a/lapack-netlib/SRC/ssbgvx.f +++ b/lapack-netlib/SRC/ssbgvx.f @@ -152,13 +152,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,14 +170,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -271,7 +280,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -285,10 +294,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sspevx.f b/lapack-netlib/SRC/sspevx.f index 565aedf3..c2bbaf71 100644 --- a/lapack-netlib/SRC/sspevx.f +++ b/lapack-netlib/SRC/sspevx.f @@ -96,12 +96,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -109,13 +112,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -218,7 +225,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -227,10 +234,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, $ INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sspgvx.f b/lapack-netlib/SRC/sspgvx.f index c95139a6..8f8ed9a8 100644 --- a/lapack-netlib/SRC/sspgvx.f +++ b/lapack-netlib/SRC/sspgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -249,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -263,10 +272,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/sstebz.f b/lapack-netlib/SRC/sstebz.f index c5263651..1e231ec8 100644 --- a/lapack-netlib/SRC/sstebz.f +++ b/lapack-netlib/SRC/sstebz.f @@ -87,13 +87,18 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. Eigenvalues less than or equal +*> to VL, or greater than VU, will not be returned. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. Eigenvalues less than or equal *> to VL, or greater than VU, will not be returned. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. @@ -102,14 +107,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +264,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup auxOTHERcomputational * @@ -263,10 +273,10 @@ $ M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER ORDER, RANGE diff --git a/lapack-netlib/SRC/sstegr.f b/lapack-netlib/SRC/sstegr.f index d98c451f..4c8350e6 100644 --- a/lapack-netlib/SRC/sstegr.f +++ b/lapack-netlib/SRC/sstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> SSTEGR is a compatability wrapper around the improved SSTEMR routine. +*> SSTEGR is a compatibility wrapper around the improved SSTEMR routine. *> See SSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstemr.f b/lapack-netlib/SRC/sstemr.f index 2e995802..5ffe96d4 100644 --- a/lapack-netlib/SRC/sstemr.f +++ b/lapack-netlib/SRC/sstemr.f @@ -136,13 +136,17 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -150,14 +154,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -294,7 +303,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -312,10 +321,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstevr.f b/lapack-netlib/SRC/sstevr.f index e8b52a22..2dec8695 100644 --- a/lapack-netlib/SRC/sstevr.f +++ b/lapack-netlib/SRC/sstevr.f @@ -128,12 +128,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -141,13 +144,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -280,7 +287,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -299,10 +306,10 @@ $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/sstevx.f b/lapack-netlib/SRC/sstevx.f index 58f86f2e..427ad742 100644 --- a/lapack-netlib/SRC/sstevx.f +++ b/lapack-netlib/SRC/sstevx.f @@ -89,12 +89,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -102,13 +105,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -212,7 +219,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHEReigen * @@ -220,10 +227,10 @@ SUBROUTINE SSTEVX( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/ssyevr.f b/lapack-netlib/SRC/ssyevr.f index bfe4258c..7e274b4e 100644 --- a/lapack-netlib/SRC/ssyevr.f +++ b/lapack-netlib/SRC/ssyevr.f @@ -153,12 +153,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -166,13 +169,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -308,7 +315,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -327,10 +334,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssyevx.f b/lapack-netlib/SRC/ssyevx.f index cbc8b1d0..611f4f24 100644 --- a/lapack-netlib/SRC/ssyevx.f +++ b/lapack-netlib/SRC/ssyevx.f @@ -98,12 +98,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -111,13 +114,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -237,7 +244,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -246,10 +253,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssygvx.f b/lapack-netlib/SRC/ssygvx.f index bbe92220..8c909946 100644 --- a/lapack-netlib/SRC/ssygvx.f +++ b/lapack-netlib/SRC/ssygvx.f @@ -131,12 +131,15 @@ *> \param[in] VL *> \verbatim *> VL is REAL +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is REAL -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -144,13 +147,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -276,7 +283,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realSYeigen * @@ -290,10 +297,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/ssytrf_rook.f b/lapack-netlib/SRC/ssytrf_rook.f index 6467be45..3281fbe7 100644 --- a/lapack-netlib/SRC/ssytrf_rook.f +++ b/lapack-netlib/SRC/ssytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup realSYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'SSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/stgsen.f b/lapack-netlib/SRC/stgsen.f index 90e1d945..13997be3 100644 --- a/lapack-netlib/SRC/stgsen.f +++ b/lapack-netlib/SRC/stgsen.f @@ -304,7 +304,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup realOTHERcomputational * @@ -451,10 +451,10 @@ $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -541,6 +541,7 @@ * M = 0 PAIR = .FALSE. + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N IF( PAIR ) THEN PAIR = .FALSE. @@ -560,6 +561,7 @@ END IF END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 4*N+16, 2*M*(N-M) ) diff --git a/lapack-netlib/SRC/strevc3.f b/lapack-netlib/SRC/strevc3.f new file mode 100644 index 00000000..95ac0f6d --- /dev/null +++ b/lapack-netlib/SRC/strevc3.f @@ -0,0 +1,1303 @@ +*> \brief \b STREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download STREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> STREVC3 computes some or all of the right and/or left eigenvectors of +*> a real upper quasi-triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a real general matrix: A = Q*T*Q**T, as computed by SHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**T)*T = w*(y**T) +*> +*> where y**T denotes the transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal blocks of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the orthogonal factor that reduces a matrix +*> A to Schur form T, then Q*X and Q*Y are the matrices of right and +*> left eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed by the matrices in VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in,out] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> If w(j) is a real eigenvalue, the corresponding real +*> eigenvector is computed if SELECT(j) is .TRUE.. +*> If w(j) and w(j+1) are the real and imaginary parts of a +*> complex eigenvalue, the corresponding complex eigenvector is +*> computed if either SELECT(j) or SELECT(j+1) is .TRUE., and +*> on exit SELECT(j) is set to .TRUE. and SELECT(j+1) is set to +*> .FALSE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in] T +*> \verbatim +*> T is REAL array, dimension (LDT,N) +*> The upper quasi-triangular matrix T in Schur canonical form. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is REAL array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by SHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part, and the second the imaginary part. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is REAL array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the orthogonal matrix Q +*> of Schur vectors returned by SHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> A complex eigenvector corresponding to a complex eigenvalue +*> is stored in two consecutive columns, the first holding the +*> real part and the second the imaginary part. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected real eigenvector occupies one column and each +*> selected complex eigenvector occupies two columns. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is REAL array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,3*N). +*> For optimum performance, LWORK >= N + 2*N*NB, where NB is +*> the optimal blocksize. +*> +*> 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 2011 +* +* @generated from dtrevc3.f, fortran d -> s, Tue Apr 19 01:47:44 2016 +* +*> \ingroup realOTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE STREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, + $ VR, LDVR, MM, M, WORK, LWORK, INFO ) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + REAL T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + REAL ZERO, ONE + PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, PAIR, + $ RIGHTV, SOMEV + INTEGER I, IERR, II, IP, IS, J, J1, J2, JNXT, K, KI, + $ IV, MAXWRK, NB, KI2 + REAL BETA, BIGNUM, EMAX, OVFL, REC, REMAX, SCALE, + $ SMIN, SMLNUM, ULP, UNFL, VCRIT, VMAX, WI, WR, + $ XNORM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ISAMAX, ILAENV + REAL SDOT, SLAMCH + EXTERNAL LSAME, ISAMAX, ILAENV, SDOT, SLAMCH +* .. +* .. External Subroutines .. + EXTERNAL SAXPY, SCOPY, SGEMV, SLALN2, SSCAL, XERBLA +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, MAX, SQRT +* .. +* .. Local Arrays .. + REAL X( 2, 2 ) + INTEGER ISCOMPLEX( NBMAX ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* + INFO = 0 + NB = ILAENV( 1, 'STREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + LQUERY = ( LWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( LWORK.LT.MAX( 1, 3*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE +* +* Set M to the number of columns required to store the selected +* eigenvectors, standardize the array SELECT if necessary, and +* test MM. +* + IF( SOMEV ) THEN + M = 0 + PAIR = .FALSE. + DO 10 J = 1, N + IF( PAIR ) THEN + PAIR = .FALSE. + SELECT( J ) = .FALSE. + ELSE + IF( J.LT.N ) THEN + IF( T( J+1, J ).EQ.ZERO ) THEN + IF( SELECT( J ) ) + $ M = M + 1 + ELSE + PAIR = .TRUE. + IF( SELECT( J ) .OR. SELECT( J+1 ) ) THEN + SELECT( J ) = .TRUE. + M = M + 2 + END IF + END IF + ELSE + IF( SELECT( N ) ) + $ M = M + 1 + END IF + END IF + 10 CONTINUE + ELSE + M = N + END IF +* + IF( MM.LT.M ) THEN + INFO = -11 + END IF + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'STREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL SLASET( 'F', N, 1+2*NB, ZERO, ZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = SLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL SLABAD( UNFL, OVFL ) + ULP = SLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) + BIGNUM = ( ONE-ULP ) / SMLNUM +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + WORK( 1 ) = ZERO + DO 30 J = 2, N + WORK( J ) = ZERO + DO 20 I = 1, J - 1 + WORK( J ) = WORK( J ) + ABS( T( I, J ) ) + 20 CONTINUE + 30 CONTINUE +* +* Index IP is used to specify the real or complex eigenvalue: +* IP = 0, real eigenvalue, +* 1, first of conjugate complex pair: (wr,wi) +* -1, second of conjugate complex pair: (wr,wi) +* ISCOMPLEX array stores IP for each column in current block. +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* For complex right vector, uses IV-1 for real part and IV for complex part. +* Non-blocked version always uses IV=2; +* blocked version starts with IV=NB, goes down to 1 or 2. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 2 + IF( NB.GT.2 ) THEN + IV = NB + END IF + + IP = 0 + IS = M + DO 140 KI = N, 1, -1 + IF( IP.EQ.-1 ) THEN +* previous iteration (ki+1) was second of conjugate pair, +* so this ki is first of conjugate pair; skip to end of loop + IP = 1 + GO TO 140 + ELSE IF( KI.EQ.1 ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI, KI-1 ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is second of conjugate pair + IP = -1 + END IF + + IF( SOMEV ) THEN + IF( IP.EQ.0 ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 140 + ELSE + IF( .NOT.SELECT( KI-1 ) ) + $ GO TO 140 + END IF + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI-1 ) ) )* + $ SQRT( ABS( T( KI-1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real right eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 50 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 50 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-1,1:KI-1) - WR ]*X = SCALE*WORK. +* + JNXT = KI - 1 + DO 60 J = KI - 1, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 60 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) +* +* Update right-hand side +* + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+IV*N ), N, WR, ZERO, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(2,1) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 2, 1 ) = X( 2, 1 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( KI, SCALE, WORK( 1+IV*N ), 1 ) + WORK( J-1+IV*N ) = X( 1, 1 ) + WORK( J +IV*N ) = X( 2, 1 ) +* +* Update right-hand side +* + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+IV*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+IV*N ), 1 ) + END IF + 60 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL SCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = ISAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / ABS( VR( II, IS ) ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 70 K = KI + 1, N + VR( K, IS ) = ZERO + 70 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL SGEMV( 'N', N, KI-1, ONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, WORK( KI + IV*N ), + $ VR( 1, KI ), 1 ) +* + II = ISAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / ABS( VR( II, KI ) ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex right eigenvector. +* +* Initial solve +* [ ( T(KI-1,KI-1) T(KI-1,KI) ) - (WR + I*WI) ]*X = 0. +* [ ( T(KI, KI-1) T(KI, KI) ) ] +* + IF( ABS( T( KI-1, KI ) ).GE.ABS( T( KI, KI-1 ) ) ) THEN + WORK( KI-1 + (IV-1)*N ) = ONE + WORK( KI + (IV )*N ) = WI / T( KI-1, KI ) + ELSE + WORK( KI-1 + (IV-1)*N ) = -WI / T( KI, KI-1 ) + WORK( KI + (IV )*N ) = ONE + END IF + WORK( KI + (IV-1)*N ) = ZERO + WORK( KI-1 + (IV )*N ) = ZERO +* +* Form right-hand side. +* + DO 80 K = 1, KI - 2 + WORK( K+(IV-1)*N ) = -WORK( KI-1+(IV-1)*N )*T(K,KI-1) + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(K,KI ) + 80 CONTINUE +* +* Solve upper quasi-triangular system: +* [ T(1:KI-2,1:KI-2) - (WR+i*WI) ]*X = SCALE*(WORK+i*WORK2) +* + JNXT = KI - 2 + DO 90 J = KI - 2, 1, -1 + IF( J.GT.JNXT ) + $ GO TO 90 + J1 = J + J2 = J + JNXT = J - 1 + IF( J.GT.1 ) THEN + IF( T( J, J-1 ).NE.ZERO ) THEN + J1 = J - 1 + JNXT = J - 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+(IV-1)*N ), N, + $ WR, WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale X(1,1) and X(1,2) to avoid overflow when +* updating the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + IF( WORK( J ).GT.BIGNUM / XNORM ) THEN + X( 1, 1 ) = X( 1, 1 ) / XNORM + X( 1, 2 ) = X( 1, 2 ) / XNORM + SCALE = SCALE / XNORM + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J+(IV-1)*N ) = X( 1, 1 ) + WORK( J+(IV )*N ) = X( 1, 2 ) +* +* Update the right-hand side +* + CALL SAXPY( J-1, -X( 1, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-1, -X( 1, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) +* + ELSE +* +* 2-by-2 diagonal block +* + CALL SLALN2( .FALSE., 2, 2, SMIN, ONE, + $ T( J-1, J-1 ), LDT, ONE, ONE, + $ WORK( J-1+(IV-1)*N ), N, WR, WI, X, 2, + $ SCALE, XNORM, IERR ) +* +* Scale X to avoid overflow when updating +* the right-hand side. +* + IF( XNORM.GT.ONE ) THEN + BETA = MAX( WORK( J-1 ), WORK( J ) ) + IF( BETA.GT.BIGNUM / XNORM ) THEN + REC = ONE / XNORM + X( 1, 1 ) = X( 1, 1 )*REC + X( 1, 2 ) = X( 1, 2 )*REC + X( 2, 1 ) = X( 2, 1 )*REC + X( 2, 2 ) = X( 2, 2 )*REC + SCALE = SCALE*REC + END IF + END IF +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( KI, SCALE, WORK( 1+(IV-1)*N ), 1 ) + CALL SSCAL( KI, SCALE, WORK( 1+(IV )*N ), 1 ) + END IF + WORK( J-1+(IV-1)*N ) = X( 1, 1 ) + WORK( J +(IV-1)*N ) = X( 2, 1 ) + WORK( J-1+(IV )*N ) = X( 1, 2 ) + WORK( J +(IV )*N ) = X( 2, 2 ) +* +* Update the right-hand side +* + CALL SAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 1 ), T( 1, J ), 1, + $ WORK( 1+(IV-1)*N ), 1 ) + CALL SAXPY( J-2, -X( 1, 2 ), T( 1, J-1 ), 1, + $ WORK( 1+(IV )*N ), 1 ) + CALL SAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1, + $ WORK( 1+(IV )*N ), 1 ) + END IF + 90 CONTINUE +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL SCOPY( KI, WORK( 1+(IV-1)*N ), 1, VR(1,IS-1), 1 ) + CALL SCOPY( KI, WORK( 1+(IV )*N ), 1, VR(1,IS ), 1 ) +* + EMAX = ZERO + DO 100 K = 1, KI + EMAX = MAX( EMAX, ABS( VR( K, IS-1 ) )+ + $ ABS( VR( K, IS ) ) ) + 100 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( KI, REMAX, VR( 1, IS-1 ), 1 ) + CALL SSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 110 K = KI + 1, N + VR( K, IS-1 ) = ZERO + VR( K, IS ) = ZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.2 ) THEN + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV-1)*N ), 1, + $ WORK( KI-1 + (IV-1)*N ), VR(1,KI-1), 1) + CALL SGEMV( 'N', N, KI-2, ONE, VR, LDVR, + $ WORK( 1 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), VR( 1, KI ), 1 ) + ELSE + CALL SSCAL( N, WORK(KI-1+(IV-1)*N), VR(1,KI-1), 1) + CALL SSCAL( N, WORK(KI +(IV )*N), VR(1,KI ), 1) + END IF +* + EMAX = ZERO + DO 120 K = 1, N + EMAX = MAX( EMAX, ABS( VR( K, KI-1 ) )+ + $ ABS( VR( K, KI ) ) ) + 120 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VR( 1, KI-1 ), 1 ) + CALL SSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + (IV-1)*N ) = ZERO + WORK( K + (IV )*N ) = ZERO + END DO + ISCOMPLEX( IV-1 ) = -IP + ISCOMPLEX( IV ) = IP + IV = IV - 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI-1 and KI) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI - 1 + END IF + +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.LE.2) .OR. (KI2.EQ.1) ) THEN + CALL SGEMM( 'N', 'N', N, NB-IV+1, KI2+NB-IV, ONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + IF( ISCOMPLEX(K).EQ.0 ) THEN +* real eigenvector + II = ISAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1 ) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL SSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL SLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI2 ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF ! blocked back-transform +* + IS = IS - 1 + IF( IP.NE.0 ) + $ IS = IS - 1 + 140 CONTINUE + END IF + + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* For complex left vector, uses IV for real part and IV+1 for complex part. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB-1 or NB. +* (Note the "0-th" column is used for 1-norms computed above.) + IV = 1 + IP = 0 + IS = 1 + DO 260 KI = 1, N + IF( IP.EQ.1 ) THEN +* previous iteration (ki-1) was first of conjugate pair, +* so this ki is second of conjugate pair; skip to end of loop + IP = -1 + GO TO 260 + ELSE IF( KI.EQ.N ) THEN +* last column, so this ki must be real eigenvalue + IP = 0 + ELSE IF( T( KI+1, KI ).EQ.ZERO ) THEN +* zero on sub-diagonal, so this ki is real eigenvalue + IP = 0 + ELSE +* non-zero on sub-diagonal, so this ki is first of conjugate pair + IP = 1 + END IF +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 260 + END IF +* +* Compute the KI-th eigenvalue (WR,WI). +* + WR = T( KI, KI ) + WI = ZERO + IF( IP.NE.0 ) + $ WI = SQRT( ABS( T( KI, KI+1 ) ) )* + $ SQRT( ABS( T( KI+1, KI ) ) ) + SMIN = MAX( ULP*( ABS( WR )+ABS( WI ) ), SMLNUM ) +* + IF( IP.EQ.0 ) THEN +* +* -------------------------------------------------------- +* Real left eigenvector +* + WORK( KI + IV*N ) = ONE +* +* Form right-hand side. +* + DO 160 K = KI + 1, N + WORK( K + IV*N ) = -T( KI, K ) + 160 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+1:N,KI+1:N) - WR ]**T * X = SCALE*WORK +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 1 + DO 170 J = KI + 1, N + IF( J.LT.JNXT ) + $ GO TO 170 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve [ T(J,J) - WR ]**T * X = WORK +* + CALL SLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J+IV*N ) = X( 1, 1 ) + VMAX = MAX( ABS( WORK( J+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK( KI+IV*N ), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+IV*N ) = WORK( J+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* + WORK( J+1+IV*N ) = WORK( J+1+IV*N ) - + $ SDOT( J-KI-1, T( KI+1, J+1 ), 1, + $ WORK( KI+1+IV*N ), 1 ) +* +* Solve +* [ T(J,J)-WR T(J,J+1) ]**T * X = SCALE*( WORK1 ) +* [ T(J+1,J) T(J+1,J+1)-WR ] ( WORK2 ) +* + CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ ZERO, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) + $ CALL SSCAL( N-KI+1, SCALE, WORK( KI+IV*N ), 1 ) + WORK( J +IV*N ) = X( 1, 1 ) + WORK( J+1+IV*N ) = X( 2, 1 ) +* + VMAX = MAX( ABS( WORK( J +IV*N ) ), + $ ABS( WORK( J+1+IV*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 170 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL SCOPY( N-KI+1, WORK( KI + IV*N ), 1, + $ VL( KI, IS ), 1 ) +* + II = ISAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / ABS( VL( II, IS ) ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 180 K = 1, KI - 1 + VL( K, IS ) = ZERO + 180 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL SGEMV( 'N', N, N-KI, ONE, + $ VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, + $ WORK( KI + IV*N ), VL( 1, KI ), 1 ) +* + II = ISAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / ABS( VL( II, KI ) ) + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP +* back-transform and normalization is done below + END IF + ELSE +* +* -------------------------------------------------------- +* Complex left eigenvector. +* +* Initial solve: +* [ ( T(KI,KI) T(KI,KI+1) )**T - (WR - I* WI) ]*X = 0. +* [ ( T(KI+1,KI) T(KI+1,KI+1) ) ] +* + IF( ABS( T( KI, KI+1 ) ).GE.ABS( T( KI+1, KI ) ) ) THEN + WORK( KI + (IV )*N ) = WI / T( KI, KI+1 ) + WORK( KI+1 + (IV+1)*N ) = ONE + ELSE + WORK( KI + (IV )*N ) = ONE + WORK( KI+1 + (IV+1)*N ) = -WI / T( KI+1, KI ) + END IF + WORK( KI+1 + (IV )*N ) = ZERO + WORK( KI + (IV+1)*N ) = ZERO +* +* Form right-hand side. +* + DO 190 K = KI + 2, N + WORK( K+(IV )*N ) = -WORK( KI +(IV )*N )*T(KI, K) + WORK( K+(IV+1)*N ) = -WORK( KI+1+(IV+1)*N )*T(KI+1,K) + 190 CONTINUE +* +* Solve transposed quasi-triangular system: +* [ T(KI+2:N,KI+2:N)**T - (WR-i*WI) ]*X = WORK1+i*WORK2 +* + VMAX = ONE + VCRIT = BIGNUM +* + JNXT = KI + 2 + DO 200 J = KI + 2, N + IF( J.LT.JNXT ) + $ GO TO 200 + J1 = J + J2 = J + JNXT = J + 1 + IF( J.LT.N ) THEN + IF( T( J+1, J ).NE.ZERO ) THEN + J2 = J + 1 + JNXT = J + 2 + END IF + END IF +* + IF( J1.EQ.J2 ) THEN +* +* 1-by-1 diagonal block +* +* Scale if necessary to avoid overflow when +* forming the right-hand side elements. +* + IF( WORK( J ).GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J+(IV )*N ) = WORK( J+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) + WORK( J+(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve [ T(J,J)-(WR-i*WI) ]*(X11+i*X12)= WK+I*WK2 +* + CALL SLALN2( .FALSE., 1, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J+(IV )*N ) = X( 1, 1 ) + WORK( J+(IV+1)*N ) = X( 1, 2 ) + VMAX = MAX( ABS( WORK( J+(IV )*N ) ), + $ ABS( WORK( J+(IV+1)*N ) ), VMAX ) + VCRIT = BIGNUM / VMAX +* + ELSE +* +* 2-by-2 diagonal block +* +* Scale if necessary to avoid overflow when forming +* the right-hand side elements. +* + BETA = MAX( WORK( J ), WORK( J+1 ) ) + IF( BETA.GT.VCRIT ) THEN + REC = ONE / VMAX + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV )*N), 1 ) + CALL SSCAL( N-KI+1, REC, WORK(KI+(IV+1)*N), 1 ) + VMAX = ONE + VCRIT = BIGNUM + END IF +* + WORK( J +(IV )*N ) = WORK( J+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J +(IV+1)*N ) = WORK( J+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* + WORK( J+1+(IV )*N ) = WORK( J+1+(IV)*N ) - + $ SDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV)*N ), 1 ) +* + WORK( J+1+(IV+1)*N ) = WORK( J+1+(IV+1)*N ) - + $ SDOT( J-KI-2, T( KI+2, J+1 ), 1, + $ WORK( KI+2+(IV+1)*N ), 1 ) +* +* Solve 2-by-2 complex linear equation +* [ (T(j,j) T(j,j+1) )**T - (wr-i*wi)*I ]*X = SCALE*B +* [ (T(j+1,j) T(j+1,j+1)) ] +* + CALL SLALN2( .TRUE., 2, 2, SMIN, ONE, T( J, J ), + $ LDT, ONE, ONE, WORK( J+IV*N ), N, WR, + $ -WI, X, 2, SCALE, XNORM, IERR ) +* +* Scale if necessary +* + IF( SCALE.NE.ONE ) THEN + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV )*N), 1) + CALL SSCAL( N-KI+1, SCALE, WORK(KI+(IV+1)*N), 1) + END IF + WORK( J +(IV )*N ) = X( 1, 1 ) + WORK( J +(IV+1)*N ) = X( 1, 2 ) + WORK( J+1+(IV )*N ) = X( 2, 1 ) + WORK( J+1+(IV+1)*N ) = X( 2, 2 ) + VMAX = MAX( ABS( X( 1, 1 ) ), ABS( X( 1, 2 ) ), + $ ABS( X( 2, 1 ) ), ABS( X( 2, 2 ) ), + $ VMAX ) + VCRIT = BIGNUM / VMAX +* + END IF + 200 CONTINUE +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL SCOPY( N-KI+1, WORK( KI + (IV )*N ), 1, + $ VL( KI, IS ), 1 ) + CALL SCOPY( N-KI+1, WORK( KI + (IV+1)*N ), 1, + $ VL( KI, IS+1 ), 1 ) +* + EMAX = ZERO + DO 220 K = KI, N + EMAX = MAX( EMAX, ABS( VL( K, IS ) )+ + $ ABS( VL( K, IS+1 ) ) ) + 220 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) + CALL SSCAL( N-KI+1, REMAX, VL( KI, IS+1 ), 1 ) +* + DO 230 K = 1, KI - 1 + VL( K, IS ) = ZERO + VL( K, IS+1 ) = ZERO + 230 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N-1 ) THEN + CALL SGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV)*N ), 1, + $ WORK( KI + (IV)*N ), + $ VL( 1, KI ), 1 ) + CALL SGEMV( 'N', N, N-KI-1, ONE, + $ VL( 1, KI+2 ), LDVL, + $ WORK( KI+2 + (IV+1)*N ), 1, + $ WORK( KI+1 + (IV+1)*N ), + $ VL( 1, KI+1 ), 1 ) + ELSE + CALL SSCAL( N, WORK(KI+ (IV )*N), VL(1, KI ), 1) + CALL SSCAL( N, WORK(KI+1+(IV+1)*N), VL(1, KI+1), 1) + END IF +* + EMAX = ZERO + DO 240 K = 1, N + EMAX = MAX( EMAX, ABS( VL( K, KI ) )+ + $ ABS( VL( K, KI+1 ) ) ) + 240 CONTINUE + REMAX = ONE / EMAX + CALL SSCAL( N, REMAX, VL( 1, KI ), 1 ) + CALL SSCAL( N, REMAX, VL( 1, KI+1 ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + (IV )*N ) = ZERO + WORK( K + (IV+1)*N ) = ZERO + END DO + ISCOMPLEX( IV ) = IP + ISCOMPLEX( IV+1 ) = -IP + IV = IV + 1 +* back-transform and normalization is done below + END IF + END IF + + IF( NB.GT.1 ) THEN +* -------------------------------------------------------- +* Blocked version of back-transform +* For complex case, KI2 includes both vectors (KI and KI+1) + IF( IP.EQ.0 ) THEN + KI2 = KI + ELSE + KI2 = KI + 1 + END IF + +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB-1 or NB, +* or if this was last vector, do the GEMM + IF( (IV.GE.NB-1) .OR. (KI2.EQ.N) ) THEN + CALL SGEMM( 'N', 'N', N, IV, N-KI2+IV, ONE, + $ VL( 1, KI2-IV+1 ), LDVL, + $ WORK( KI2-IV+1 + (1)*N ), N, + $ ZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + IF( ISCOMPLEX(K).EQ.0) THEN +* real eigenvector + II = ISAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / ABS( WORK( II + (NB+K)*N ) ) + ELSE IF( ISCOMPLEX(K).EQ.1) THEN +* first eigenvector of conjugate pair + EMAX = ZERO + DO II = 1, N + EMAX = MAX( EMAX, + $ ABS( WORK( II + (NB+K )*N ) )+ + $ ABS( WORK( II + (NB+K+1)*N ) ) ) + END DO + REMAX = ONE / EMAX +* else if ISCOMPLEX(K).EQ.-1 +* second eigenvector of conjugate pair +* reuse same REMAX as previous K + END IF + CALL SSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL SLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI2-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF ! blocked back-transform +* + IS = IS + 1 + IF( IP.NE.0 ) + $ IS = IS + 1 + 260 CONTINUE + END IF +* + RETURN +* +* End of STREVC3 +* + END diff --git a/lapack-netlib/SRC/zbbcsd.f b/lapack-netlib/SRC/zbbcsd.f index 0d6e218b..18c4db0d 100644 --- a/lapack-netlib/SRC/zbbcsd.f +++ b/lapack-netlib/SRC/zbbcsd.f @@ -149,7 +149,7 @@ *> \param[in,out] U1 *> \verbatim *> U1 is COMPLEX*16 array, dimension (LDU1,P) -*> On entry, an LDU1-by-P matrix. On exit, U1 is postmultiplied +*> On entry, a P-by-P matrix. On exit, U1 is postmultiplied *> by the left singular vector matrix common to [ B11 ; 0 ] and *> [ B12 0 0 ; 0 -I 0 0 ]. *> \endverbatim @@ -157,13 +157,13 @@ *> \param[in] LDU1 *> \verbatim *> LDU1 is INTEGER -*> The leading dimension of the array U1. +*> The leading dimension of the array U1, LDU1 >= MAX(1,P). *> \endverbatim *> *> \param[in,out] U2 *> \verbatim *> U2 is COMPLEX*16 array, dimension (LDU2,M-P) -*> On entry, an LDU2-by-(M-P) matrix. On exit, U2 is +*> On entry, an (M-P)-by-(M-P) matrix. On exit, U2 is *> postmultiplied by the left singular vector matrix common to *> [ B21 ; 0 ] and [ B22 0 0 ; 0 0 I ]. *> \endverbatim @@ -171,13 +171,13 @@ *> \param[in] LDU2 *> \verbatim *> LDU2 is INTEGER -*> The leading dimension of the array U2. +*> The leading dimension of the array U2, LDU2 >= MAX(1,M-P). *> \endverbatim *> *> \param[in,out] V1T *> \verbatim *> V1T is COMPLEX*16 array, dimension (LDV1T,Q) -*> On entry, a LDV1T-by-Q matrix. On exit, V1T is premultiplied +*> On entry, a Q-by-Q matrix. On exit, V1T is premultiplied *> by the conjugate transpose of the right singular vector *> matrix common to [ B11 ; 0 ] and [ B21 ; 0 ]. *> \endverbatim @@ -185,13 +185,13 @@ *> \param[in] LDV1T *> \verbatim *> LDV1T is INTEGER -*> The leading dimension of the array V1T. +*> The leading dimension of the array V1T, LDV1T >= MAX(1,Q). *> \endverbatim *> *> \param[in,out] V2T *> \verbatim *> V2T is COMPLEX*16 array, dimenison (LDV2T,M-Q) -*> On entry, a LDV2T-by-(M-Q) matrix. On exit, V2T is +*> On entry, an (M-Q)-by-(M-Q) matrix. On exit, V2T is *> premultiplied by the conjugate transpose of the right *> singular vector matrix common to [ B12 0 0 ; 0 -I 0 ] and *> [ B22 0 0 ; 0 0 I ]. @@ -200,7 +200,7 @@ *> \param[in] LDV2T *> \verbatim *> LDV2T is INTEGER -*> The leading dimension of the array V2T. +*> The leading dimension of the array V2T, LDV2T >= MAX(1,M-Q). *> \endverbatim *> *> \param[out] B11D @@ -322,7 +322,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -332,10 +332,10 @@ $ V2T, LDV2T, B11D, B11E, B12D, B12E, B21D, B21E, $ B22D, B22E, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU1, JOBU2, JOBV1T, JOBV2T, TRANS diff --git a/lapack-netlib/SRC/zcgesv.f b/lapack-netlib/SRC/zcgesv.f index d7d0a9d2..493cc416 100644 --- a/lapack-netlib/SRC/zcgesv.f +++ b/lapack-netlib/SRC/zcgesv.f @@ -170,7 +170,7 @@ *> -3 : failure of CGETRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -193,7 +193,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEsolve * @@ -201,10 +201,10 @@ SUBROUTINE ZCGESV( N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, $ SWORK, RWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, ITER, LDA, LDB, LDX, N, NRHS diff --git a/lapack-netlib/SRC/zcposv.f b/lapack-netlib/SRC/zcposv.f index dfa114d9..4cf9f61e 100644 --- a/lapack-netlib/SRC/zcposv.f +++ b/lapack-netlib/SRC/zcposv.f @@ -178,7 +178,7 @@ *> -3 : failure of CPOTRF *> -31: stop the iterative refinement after the 30th *> iterations -*> > 0: iterative refinement has been sucessfully used. +*> > 0: iterative refinement has been successfully used. *> Returns the number of iterations *> \endverbatim *> @@ -201,7 +201,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16POsolve * @@ -209,10 +209,10 @@ SUBROUTINE ZCPOSV( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, WORK, $ SWORK, RWORK, ITER, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zgbequb.f b/lapack-netlib/SRC/zgbequb.f index 3dce529c..3c53046b 100644 --- a/lapack-netlib/SRC/zgbequb.f +++ b/lapack-netlib/SRC/zgbequb.f @@ -84,7 +84,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX*16 array, dimension (LDAB,N) *> On entry, the matrix A in band storage, in rows 1 to KL+KU+1. *> The j-th column of A is stored in the j-th column of the *> array AB as follows: @@ -153,7 +153,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GBcomputational * @@ -161,10 +161,10 @@ SUBROUTINE ZGBEQUB( M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, $ AMAX, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, KL, KU, LDAB, M, N diff --git a/lapack-netlib/SRC/zgbrfsx.f b/lapack-netlib/SRC/zgbrfsx.f index 2b81d403..14972ebb 100644 --- a/lapack-netlib/SRC/zgbrfsx.f +++ b/lapack-netlib/SRC/zgbrfsx.f @@ -195,7 +195,7 @@ *> *> \param[in] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> The right hand side matrix B. *> \endverbatim *> @@ -232,7 +232,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX*16 array, dimension (NRHS) +*> BERR is DOUBLE PRECISION array, dimension (NRHS) *> Componentwise relative backward error. This is the *> componentwise relative backward error of each solution vector X(j) *> (i.e., the smallest relative change in any element of A or B that @@ -440,7 +440,7 @@ $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.1) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -642,7 +642,7 @@ * * Perform refinement on each right-hand side * - IF ( REF_TYPE .NE. 0 ) THEN + IF ( REF_TYPE .NE. 0 .AND. INFO .EQ. 0 ) THEN PREC_TYPE = ILAPREC( 'E' ) diff --git a/lapack-netlib/SRC/zgeesx.f b/lapack-netlib/SRC/zgeesx.f index 4cf4ef31..7868245e 100644 --- a/lapack-netlib/SRC/zgeesx.f +++ b/lapack-netlib/SRC/zgeesx.f @@ -83,7 +83,7 @@ *> *> \param[in] SELECT *> \verbatim -*> SELECT is procedure) LOGICAL FUNCTION of one COMPLEX*16 argument +*> SELECT is a LOGICAL FUNCTION of one COMPLEX*16 argument *> SELECT must be declared EXTERNAL in the calling subroutine. *> If SORT = 'S', SELECT is used to select eigenvalues to order *> to the top left of the Schur form. @@ -230,7 +230,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEeigen * @@ -239,10 +239,10 @@ $ VS, LDVS, RCONDE, RCONDV, WORK, LWORK, RWORK, $ BWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVS, SENSE, SORT diff --git a/lapack-netlib/SRC/zgeev.f b/lapack-netlib/SRC/zgeev.f index a518b4cd..1fb35a17 100644 --- a/lapack-netlib/SRC/zgeev.f +++ b/lapack-netlib/SRC/zgeev.f @@ -169,18 +169,21 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @precisions fortran z -> c * *> \ingroup complex16GEeigen * * ===================================================================== SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, $ WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBVL, JOBVR @@ -202,7 +205,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, - $ IWRK, K, MAXWRK, MINWRK, NOUT + $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP * .. @@ -212,7 +215,7 @@ * .. * .. External Subroutines .. EXTERNAL DLABAD, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, ZGEHRD, - $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, ZUNGHR + $ ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR * .. * .. External Functions .. LOGICAL LSAME @@ -221,7 +224,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -266,18 +269,28 @@ IF( WANTVL ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN MAXWRK = MAX( MAXWRK, N + ( N - 1 )*ILAENV( 1, 'ZUNGHR', $ ' ', N, 1, N, -1 ) ) + CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, N + LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) ELSE CALL ZHSEQR( 'E', 'N', N, 1, N, A, LDA, W, VR, LDVR, - $ WORK, -1, INFO ) + $ WORK, -1, INFO ) END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, HSWORK, MINWRK ) END IF WORK( 1 ) = MAXWRK @@ -412,12 +425,13 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need 2*N) * IRWORK = IBAL + N - CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK( IRWORK ), IERR ) + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK( IRWORK ), N, IERR ) END IF * IF( WANTVL ) THEN @@ -436,10 +450,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -461,10 +475,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/lapack-netlib/SRC/zgeevx.f b/lapack-netlib/SRC/zgeevx.f index 402eec79..752d0328 100644 --- a/lapack-netlib/SRC/zgeevx.f +++ b/lapack-netlib/SRC/zgeevx.f @@ -276,7 +276,9 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 +* +* @precisions fortran z -> c * *> \ingroup complex16GEeigen * @@ -284,11 +286,12 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, $ RCONDV, WORK, LWORK, RWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE @@ -312,8 +315,8 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK, - $ MINWRK, NOUT + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP * .. @@ -323,7 +326,7 @@ * .. * .. External Subroutines .. EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, - $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, + $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, $ ZTRSNA, ZUNGHR * .. * .. External Functions .. @@ -333,7 +336,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -387,9 +390,19 @@ MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -401,7 +414,7 @@ $ WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -559,19 +572,20 @@ $ WORK( IWRK ), LWORK-IWRK+1, INFO ) END IF * -* If INFO > 0 from ZHSEQR, then quit +* If INFO .NE. 0 from ZHSEQR, then quit * - IF( INFO.GT.0 ) + IF( INFO.NE.0 ) $ GO TO 50 * IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK, IERR ) + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK, N, IERR ) END IF * * Compute condition numbers if desired @@ -598,10 +612,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( K ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -621,10 +635,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( K ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/lapack-netlib/SRC/zgejsv.f b/lapack-netlib/SRC/zgejsv.f index 62274f3a..ad47a407 100644 --- a/lapack-netlib/SRC/zgejsv.f +++ b/lapack-netlib/SRC/zgejsv.f @@ -27,7 +27,7 @@ * INTEGER INFO, LDA, LDU, LDV, LWORK, M, N * .. * .. Array Arguments .. -* DOUBLE COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) +* COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), CWORK( LWORK ) * DOUBLE PRECISION SVA( N ), RWORK( LRWORK ) * INTEGER IWORK( * ) * CHARACTER*1 JOBA, JOBP, JOBR, JOBT, JOBU, JOBV @@ -39,21 +39,22 @@ *> *> \verbatim *> -* ZGEJSV computes the singular value decomposition (SVD) of a real M-by-N -* matrix [A], where M >= N. The SVD of [A] is written as -* -* [A] = [U] * [SIGMA] * [V]^*, -* -* where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N -* diagonal elements, [U] is an M-by-N (or M-by-M) 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. The matrices [U] and [V] -* are computed and stored in the arrays U and V, respectively. The diagonal -* of [SIGMA] is computed and stored in the array SVA. -* -* Arguments: -* ========== +*> ZGEJSV computes the singular value decomposition (SVD) of a complex M-by-N +*> matrix [A], where M >= N. The SVD of [A] is written as +*> +*> [A] = [U] * [SIGMA] * [V]^*, +*> +*> where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N +*> diagonal elements, [U] is an M-by-N (or M-by-M) unitary 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. The matrices [U] and [V] +*> are computed and stored in the arrays U and V, respectively. The diagonal +*> of [SIGMA] is computed and stored in the array SVA. +*> \endverbatim +*> +*> Arguments: +*> ========== *> *> \param[in] JOBA *> \verbatim @@ -193,7 +194,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE COMPLEX array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> \endverbatim *> @@ -221,7 +222,7 @@ *> *> \param[out] U *> \verbatim -*> U is DOUBLE COMPLEX array, dimension ( LDU, N ) +*> U is COMPLEX*16 array, dimension ( LDU, N ) *> If JOBU = 'U', then U contains on exit the M-by-N matrix of *> the left singular vectors. *> If JOBU = 'F', then U contains on exit the M-by-M matrix of @@ -234,7 +235,7 @@ *> copied back to the V array. This 'W' option is just *> a reminder to the caller that in this case U is *> reserved as workspace of length N*N. -*> If JOBU = 'N' U is not referenced. +*> If JOBU = 'N' U is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDU @@ -246,7 +247,7 @@ *> *> \param[out] V *> \verbatim -*> V is DOUBLE COMPLEX array, dimension ( LDV, N ) +*> 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), @@ -256,7 +257,7 @@ *> copied back to the U array. This 'W' option is just *> a reminder to the caller that in this case V is *> reserved as workspace of length N*N. -*> If JOBV = 'N' V is not referenced. +*> If JOBV = 'N' V is not referenced, unless JOBT='T'. *> \endverbatim *> *> \param[in] LDV @@ -268,8 +269,7 @@ *> *> \param[out] CWORK *> \verbatim -*> CWORK (workspace) -*> CWORK is DOUBLE COMPLEX array, dimension at least LWORK. +*> CWORK is COMPLEX*16 array, dimension at least LWORK. *> \endverbatim *> *> \param[in] LWORK @@ -279,7 +279,7 @@ *> LWORK depends on the job: *> *> 1. If only SIGMA is needed ( JOBU.EQ.'N', JOBV.EQ.'N' ) and -*> 1.1 .. no scaled condition estimate required (JOBE.EQ.'N'): +*> 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 *> is LWORK >= N + (N+1)*NB. Here NB is the optimal @@ -293,33 +293,33 @@ *> is LWORK >= max(N+(N+1)*NB, N*N+3*N). *> In general, the optimal length LWORK is computed as *> LWORK >= max(N+LWORK(ZGEQP3),N+LWORK(ZGEQRF), -*> N+N*N+LWORK(CPOCON)). +*> N+N*N+LWORK(ZPOCON)). *> *> 2. If SIGMA and the right singular vectors are needed (JOBV.EQ.'V'), *> (JOBU.EQ.'N') *> -> the minimal requirement is LWORK >= 3*N. *> -> For optimal performance, LWORK >= max(N+(N+1)*NB, 3*N,2*N+N*NB), -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQ, -*> CUNMLQ. In general, the optimal length LWORK is computed as -*> LWORK >= max(N+LWORK(ZGEQP3), N+LWORK(CPOCON), N+LWORK(ZGESVJ), -*> N+LWORK(ZGELQF), 2*N+LWORK(ZGEQRF), N+LWORK(CUNMLQ)). +*> where NB is the optimal block size for ZGEQP3, ZGEQRF, ZGELQF, +*> ZUNMLQ. In general, the optimal length LWORK is computed as +*> LWORK >= max(N+LWORK(ZGEQP3), N+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 *> -> 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), -*> where NB is the optimal block size for ZGEQP3, ZGEQRF, CUNMQR. +*> 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(CPOCON), -*> 2*N+LWORK(ZGEQRF), N+LWORK(CUNMQR)). +*> 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' *> the minimal requirement is LWORK >= 5*N+2*N*N. *> 4.2. if JOBV.EQ.'J' the minimal requirement is *> LWORK >= 4*N+N*N. -*> In both cases, the allocated CWORK can accomodate blocked runs -*> of ZGEQP3, ZGEQRF, ZGELQF, SUNMQR, CUNMLQ. +*> In both cases, the allocated CWORK can accommodate blocked runs +*> of ZGEQP3, ZGEQRF, ZGELQF, ZUNMQR, ZUNMLQ. *> \endverbatim *> *> \param[out] RWORK @@ -433,7 +433,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -491,19 +491,19 @@ *> *> \verbatim *> -* [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. -* SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. -* LAPACK Working note 169. -* [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. -* SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. -* LAPACK Working note 170. -* [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR -* factorization software - a case study. -* ACM Trans. math. Softw. Vol. 35, No 2 (2008), pp. 1-28. -* LAPACK Working note 176. -* [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, -* QSVD, (H,K)-SVD computations. -* Department of Mathematics, University of Zagreb, 2008. +*> [1] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm I. +*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1322-1342. +*> LAPACK Working note 169. +*> [2] Z. Drmac and K. Veselic: New fast and accurate Jacobi SVD algorithm II. +*> SIAM J. Matrix Anal. Appl. Vol. 35, No. 2 (2008), pp. 1343-1362. +*> LAPACK Working note 170. +*> [3] Z. Drmac and Z. Bujanovic: On the failure of rank-revealing QR +*> factorization software - a case study. +*> ACM Trans. Math. Softw. Vol. 35, No 2 (2008), pp. 1-28. +*> LAPACK Working note 176. +*> [4] Z. Drmac: SIGMA - mathematical software library for accurate SVD, PSV, +*> QSVD, (H,K)-SVD computations. +*> Department of Mathematics, University of Zagreb, 2008. *> \endverbatim * *> \par Bugs, examples and comments: @@ -517,17 +517,17 @@ $ M, N, A, LDA, SVA, U, LDU, V, LDV, $ CWORK, LWORK, RWORK, LRWORK, IWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. IMPLICIT NONE INTEGER INFO, LDA, LDU, LDV, LWORK, LRWORK, M, N * .. * .. Array Arguments .. - DOUBLE COMPLEX A( LDA, * ), U( LDU, * ), V( LDV, * ), + COMPLEX*16 A( LDA, * ), U( LDU, * ), V( LDV, * ), $ CWORK( LWORK ) DOUBLE PRECISION SVA( N ), RWORK( * ) INTEGER IWORK( * ) @@ -539,11 +539,11 @@ * .. Local Parameters .. DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) - DOUBLE COMPLEX CZERO, CONE + COMPLEX*16 CZERO, CONE PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ), CONE = ( 1.0D0, 0.0D0 ) ) * .. * .. Local Scalars .. - DOUBLE COMPLEX CTEMP + COMPLEX*16 CTEMP DOUBLE PRECISION AAPP, AAQQ, AATMAX, AATMIN, BIG, BIG1, $ COND_OK, CONDR1, CONDR2, ENTRA, ENTRAT, EPSLN, $ MAXPRJ, SCALEM, SCONDA, SFMIN, SMALL, TEMP1, @@ -554,18 +554,18 @@ $ NOSCAL, ROWPIV, RSVEC, TRANSP * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DCMPLX, DCONJG, DLOG, DMAX1, DMIN1, DFLOAT, + INTRINSIC ABS, DCMPLX, DCONJG, DLOG, DMAX1, DMIN1, DBLE, $ MAX0, MIN0, NINT, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DZNRM2 - INTEGER IDAMAX + INTEGER IDAMAX, IZAMAX LOGICAL LSAME - EXTERNAL IDAMAX, LSAME, DLAMCH, DZNRM2 + EXTERNAL IDAMAX, IZAMAX, LSAME, DLAMCH, DZNRM2 * .. * .. External Subroutines .. - EXTERNAL ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLASCL, - $ ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, + EXTERNAL DLASSQ, ZCOPY, ZGELQF, ZGEQP3, ZGEQRF, ZLACPY, ZLASCL, + $ DLASCL, ZLASET, ZLASSQ, ZLASWP, ZUNGQR, ZUNMLQ, $ ZUNMQR, ZPOCON, DSCAL, ZDSCAL, ZSWAP, ZTRSM, XERBLA * EXTERNAL ZGESVJ @@ -640,7 +640,11 @@ * * Quick return for void matrix (Y3K safe) * #:) - IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) RETURN + IF ( ( M .EQ. 0 ) .OR. ( N .EQ. 0 ) ) THEN + IWORK(1:3) = 0 + RWORK(1:7) = 0 + RETURN + ENDIF * * Determine whether the matrix U should be M x N or M x M * @@ -665,7 +669,7 @@ * overflow. It is possible that this scaling pushes the smallest * column norm left from the underflow threshold (extreme case). * - SCALEM = ONE / DSQRT(DFLOAT(M)*DFLOAT(N)) + SCALEM = ONE / DSQRT(DBLE(M)*DBLE(N)) NOSCAL = .TRUE. GOSCAL = .TRUE. DO 1874 p = 1, N @@ -807,7 +811,7 @@ 1950 CONTINUE ELSE DO 1904 p = 1, M - RWORK(M+N+p) = SCALEM*ABS( A(p,IDAMAX(N,A(p,1),LDA)) ) + RWORK(M+N+p) = SCALEM*ABS( A(p,IZAMAX(N,A(p,1),LDA)) ) AATMAX = DMAX1( AATMAX, RWORK(M+N+p) ) AATMIN = DMIN1( AATMIN, RWORK(M+N+p) ) 1904 CONTINUE @@ -828,7 +832,7 @@ * XSC = ZERO TEMP1 = ONE - CALL ZLASSQ( N, SVA, 1, XSC, TEMP1 ) + CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) TEMP1 = ONE / TEMP1 * ENTRA = ZERO @@ -836,7 +840,7 @@ BIG1 = ( ( SVA(p) / XSC )**2 ) * TEMP1 IF ( BIG1 .NE. ZERO ) ENTRA = ENTRA + BIG1 * DLOG(BIG1) 1113 CONTINUE - ENTRA = - ENTRA / DLOG(DFLOAT(N)) + ENTRA = - ENTRA / DLOG(DBLE(N)) * * Now, SVA().^2/Trace(A^* * A) is a point in the probability simplex. * It is derived from the diagonal of A^* * A. Do the same with the @@ -849,7 +853,7 @@ BIG1 = ( ( RWORK(p) / XSC )**2 ) * TEMP1 IF ( BIG1 .NE. ZERO ) ENTRAT = ENTRAT + BIG1 * DLOG(BIG1) 1114 CONTINUE - ENTRAT = - ENTRAT / DLOG(DFLOAT(M)) + ENTRAT = - ENTRAT / DLOG(DBLE(M)) * * Analyze the entropies and decide A or A^*. Smaller entropy * usually means better input for the algorithm. @@ -905,9 +909,9 @@ * one should use ZGESVJ instead of ZGEJSV. * BIG1 = DSQRT( BIG ) - TEMP1 = DSQRT( BIG / DFLOAT(N) ) + TEMP1 = DSQRT( BIG / DBLE(N) ) * - CALL ZLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, AAPP, TEMP1, N, 1, SVA, N, IERR ) IF ( AAQQ .GT. (AAPP * SFMIN) ) THEN AAQQ = ( AAQQ / AAPP ) * TEMP1 ELSE @@ -1009,7 +1013,7 @@ * sigma_i < N*EPSLN*||A|| are flushed to zero. This is an * agressive enforcement of lower numerical rank by introducing a * backward error of the order of N*EPSLN*||A||. - TEMP1 = DSQRT(DFLOAT(N))*EPSLN + TEMP1 = DSQRT(DBLE(N))*EPSLN DO 3001 p = 2, N IF ( ABS(A(p,p)) .GE. (TEMP1*ABS(A(1,1))) ) THEN NR = NR + 1 @@ -1056,7 +1060,7 @@ TEMP1 = ABS(A(p,p)) / SVA(IWORK(p)) MAXPRJ = DMIN1( MAXPRJ, TEMP1 ) 3051 CONTINUE - IF ( MAXPRJ**2 .GE. ONE - DFLOAT(N)*EPSLN ) ALMORT = .TRUE. + IF ( MAXPRJ**2 .GE. ONE - DBLE(N)*EPSLN ) ALMORT = .TRUE. END IF * * @@ -1136,7 +1140,7 @@ * IF ( L2PERT ) THEN * XSC = SQRT(SMALL) - XSC = EPSLN / DFLOAT(N) + XSC = EPSLN / DBLE(N) DO 4947 q = 1, NR CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) DO 4949 p = 1, N @@ -1168,7 +1172,7 @@ * to drown denormals IF ( L2PERT ) THEN * XSC = SQRT(SMALL) - XSC = EPSLN / DFLOAT(N) + XSC = EPSLN / DBLE(N) DO 1947 q = 1, NR CTEMP = DCMPLX(XSC*ABS(A(q,q)),ZERO) DO 1949 p = 1, NR @@ -1226,7 +1230,7 @@ CALL ZCOPY( NR-p+1, V(p,p), LDV, V(p,p), 1 ) CALL ZLACGV( NR-p+1, V(p,p), 1 ) 8998 CONTINUE - CALL ZLASET( 'Upper', NR-1, NR-1, ZERO, ZERO, V(1,2), LDV ) + CALL ZLASET('Upper', NR-1, NR-1, CZERO, CZERO, V(1,2), LDV) * CALL ZGESVJ( 'Lower', 'U','N', NR, NR, V,LDV, SVA, NR, U, $ LDU, CWORK(N+1), LWORK-N, RWORK, LRWORK, INFO ) @@ -1363,10 +1367,10 @@ CONDR1 = ONE / DSQRT(TEMP1) * .. here need a second oppinion on the condition number * .. then assume worst case scenario -* R1 is OK for inverse <=> CONDR1 .LT. DFLOAT(N) -* more conservative <=> CONDR1 .LT. SQRT(DFLOAT(N)) +* R1 is OK for inverse <=> CONDR1 .LT. DBLE(N) +* more conservative <=> CONDR1 .LT. SQRT(DBLE(N)) * - COND_OK = DSQRT(DSQRT(DFLOAT(NR))) + COND_OK = DSQRT(DSQRT(DBLE(NR))) *[TP] COND_OK is a tuning parameter. * IF ( CONDR1 .LT. COND_OK ) THEN @@ -1521,9 +1525,9 @@ CALL ZTRSM('L','U','C','N',NR,NR,CONE,CWORK(2*N+1), $ N,V,LDV) IF ( NR .LT. N ) THEN - CALL ZLASET('A',N-NR,NR,ZERO,CZERO,V(NR+1,1),LDV) - CALL ZLASET('A',NR,N-NR,ZERO,CZERO,V(1,NR+1),LDV) - CALL ZLASET('A',N-NR,N-NR,ZERO,CONE,V(NR+1,NR+1),LDV) + 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) END IF CALL ZUNMQR('L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), $ V,LDV,CWORK(2*N+N*NR+NR+1),LWORK-2*N-N*NR-NR,IERR) @@ -1605,7 +1609,7 @@ * first QRF. Also, scale the columns to make them unit in * Euclidean norm. This applies to all cases. * - TEMP1 = DSQRT(DFLOAT(N)) * EPSLN + TEMP1 = DSQRT(DBLE(N)) * EPSLN DO 1972 q = 1, N DO 972 p = 1, N CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) @@ -1635,7 +1639,7 @@ $ LDU, CWORK(N+1), LWORK-N, IERR ) * The columns of U are normalized. The cost is O(M*N) flops. - TEMP1 = DSQRT(DFLOAT(M)) * EPSLN + TEMP1 = DSQRT(DBLE(M)) * EPSLN DO 1973 p = 1, NR XSC = ONE / DZNRM2( M, U(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1684,7 +1688,7 @@ DO 6972 p = 1, N CALL ZCOPY( N, CWORK(N+p), N, V(IWORK(p),1), LDV ) 6972 CONTINUE - TEMP1 = DSQRT(DFLOAT(N))*EPSLN + TEMP1 = DSQRT(DBLE(N))*EPSLN DO 6971 p = 1, N XSC = ONE / DZNRM2( N, V(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1702,7 +1706,7 @@ END IF CALL ZUNMQR( 'Left', 'No Tr', M, N1, N, A, LDA, CWORK, U, $ LDU, CWORK(N+1), LWORK-N, IERR ) - TEMP1 = DSQRT(DFLOAT(M))*EPSLN + TEMP1 = DSQRT(DBLE(M))*EPSLN DO 6973 p = 1, N1 XSC = ONE / DZNRM2( M, U(1,p), 1 ) IF ( (XSC .LT. (ONE-TEMP1)) .OR. (XSC .GT. (ONE+TEMP1)) ) @@ -1779,9 +1783,9 @@ NUMRANK = NINT(RWORK(2)) IF ( NR .LT. N ) THEN - CALL ZLASET( 'A',N-NR,NR,ZERO,ZERO,V(NR+1,1),LDV ) - CALL ZLASET( 'A',NR,N-NR,ZERO,ZERO,V(1,NR+1),LDV ) - CALL ZLASET( 'A',N-NR,N-NR,ZERO,ONE,V(NR+1,NR+1),LDV ) + 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 ) END IF CALL ZUNMQR( 'L','N',N,N,NR,CWORK(2*N+1),N,CWORK(N+1), @@ -1791,7 +1795,7 @@ * first QRF. Also, scale the columns to make them unit in * Euclidean norm. This applies to all cases. * - TEMP1 = DSQRT(DFLOAT(N)) * EPSLN + TEMP1 = DSQRT(DBLE(N)) * EPSLN DO 7972 q = 1, N DO 8972 p = 1, N CWORK(2*N+N*NR+NR+IWORK(p)) = V(p,q) @@ -1836,7 +1840,7 @@ * Undo scaling, if necessary (and possible) * IF ( USCAL2 .LE. (BIG/SVA(1))*USCAL1 ) THEN - CALL ZLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, USCAL1, USCAL2, NR, 1, SVA, N, IERR ) USCAL1 = ONE USCAL2 = ONE END IF diff --git a/lapack-netlib/SRC/zgelss.f b/lapack-netlib/SRC/zgelss.f index 56e58ddf..b99535a6 100644 --- a/lapack-netlib/SRC/zgelss.f +++ b/lapack-netlib/SRC/zgelss.f @@ -170,7 +170,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16GEsolve * @@ -178,10 +178,10 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK, $ WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK @@ -285,8 +285,8 @@ * Path 1 - overdetermined or exactly determined * * Compute space needed for ZGEBRD - CALL ZGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1), + $ -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1), @@ -315,8 +315,8 @@ $ -1, INFO ) LWORK_ZGELQF=DUM(1) * Compute space needed for ZGEBRD - CALL ZGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA, @@ -346,8 +346,8 @@ * Path 2 - underdetermined * * Compute space needed for ZGEBRD - CALL ZGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), - $ DUM(1), DUM(1), -1, INFO ) + CALL ZGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1), + $ DUM(1), -1, INFO ) LWORK_ZGEBRD=DUM(1) * Compute space needed for ZUNMBR CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA, diff --git a/lapack-netlib/SRC/zgeqrt3.f b/lapack-netlib/SRC/zgeqrt3.f index 8926b998..6995a289 100644 --- a/lapack-netlib/SRC/zgeqrt3.f +++ b/lapack-netlib/SRC/zgeqrt3.f @@ -100,7 +100,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16GEcomputational * @@ -132,10 +132,10 @@ * ===================================================================== RECURSIVE SUBROUTINE ZGEQRT3( M, N, A, LDA, T, LDT, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N, LDT @@ -177,7 +177,7 @@ * * Compute Householder transform when N=1 * - CALL ZLARFG( M, A, A( MIN( 2, M ), 1 ), 1, T ) + CALL ZLARFG( M, A(1,1), A( MIN( 2, M ), 1 ), 1, T(1,1) ) * ELSE * diff --git a/lapack-netlib/SRC/zgesdd.f b/lapack-netlib/SRC/zgesdd.f index ea08dbc6..4f320175 100644 --- a/lapack-netlib/SRC/zgesdd.f +++ b/lapack-netlib/SRC/zgesdd.f @@ -18,8 +18,8 @@ * Definition: * =========== * -* SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, -* LWORK, RWORK, IWORK, INFO ) +* SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, +* WORK, LWORK, RWORK, IWORK, INFO ) * * .. Scalar Arguments .. * CHARACTER JOBZ @@ -135,8 +135,8 @@ *> \param[in] LDU *> \verbatim *> LDU is INTEGER -*> The leading dimension of the array U. LDU >= 1; if -*> JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. +*> The leading dimension of the array U. LDU >= 1; +*> if JOBZ = 'S' or 'A' or JOBZ = 'O' and M < N, LDU >= M. *> \endverbatim *> *> \param[out] VT @@ -152,8 +152,8 @@ *> \param[in] LDVT *> \verbatim *> LDVT is INTEGER -*> The leading dimension of the array VT. LDVT >= 1; if -*> JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; +*> The leading dimension of the array VT. LDVT >= 1; +*> if JOBZ = 'A' or JOBZ = 'O' and M >= N, LDVT >= N; *> if JOBZ = 'S', LDVT >= min(M,N). *> \endverbatim *> @@ -167,24 +167,28 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1. -*> if JOBZ = 'N', LWORK >= 2*min(M,N)+max(M,N). -*> if JOBZ = 'O', -*> LWORK >= 2*min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> if JOBZ = 'S' or 'A', -*> LWORK >= min(M,N)*min(M,N)+2*min(M,N)+max(M,N). -*> For good performance, LWORK should generally be larger. -*> *> If LWORK = -1, a workspace query is assumed. The optimal *> size for the WORK array is calculated and stored in WORK(1), *> and no other work except argument checking is performed. +*> +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LWORK >= 2*mn + mx. +*> If JOBZ = 'O', LWORK >= 2*mn*mn + 2*mn + mx. +*> If JOBZ = 'S', LWORK >= mn*mn + 3*mn. +*> If JOBZ = 'A', LWORK >= mn*mn + 2*mn + mx. +*> These are not tight minimums in all cases; see comments inside code. +*> For good performance, LWORK should generally be larger; +*> a query is recommended. *> \endverbatim *> *> \param[out] RWORK *> \verbatim *> RWORK is DOUBLE PRECISION array, dimension (MAX(1,LRWORK)) -*> If JOBZ = 'N', LRWORK >= 7*min(M,N). -*> Otherwise, -*> LRWORK >= min(M,N)*max(5*min(M,N)+7,2*max(M,N)+2*min(M,N)+1) +*> Let mx = max(M,N) and mn = min(M,N). +*> If JOBZ = 'N', LRWORK >= 5*mn (LAPACK <= 3.6 needs 7*mn); +*> else if mx >> mn, LRWORK >= 5*mn*mn + 5*mn; +*> else LRWORK >= max( 5*mn*mn + 5*mn, +*> 2*mx*mn + 2*mn*mn + mn ). *> \endverbatim *> *> \param[out] IWORK @@ -208,7 +212,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -218,14 +222,16 @@ *> Ming Gu and Huan Ren, Computer Science Division, University of *> California at Berkeley, USA *> +*> @precisions fortran z -> c * ===================================================================== - SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, - $ LWORK, RWORK, IWORK, INFO ) + SUBROUTINE ZGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, + $ WORK, LWORK, RWORK, IWORK, INFO ) + implicit none * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ @@ -241,8 +247,6 @@ * ===================================================================== * * .. Parameters .. - INTEGER LQUERV - PARAMETER ( LQUERV = -1 ) COMPLEX*16 CZERO, CONE PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), $ CONE = ( 1.0D+0, 0.0D+0 ) ) @@ -250,16 +254,27 @@ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) * .. * .. Local Scalars .. - LOGICAL WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS + LOGICAL LQUERY, WNTQA, WNTQAS, WNTQN, WNTQO, WNTQS INTEGER BLK, CHUNK, I, IE, IERR, IL, IR, IRU, IRVT, $ ISCL, ITAU, ITAUP, ITAUQ, IU, IVT, LDWKVT, $ LDWRKL, LDWRKR, LDWRKU, MAXWRK, MINMN, MINWRK, $ MNTHR1, MNTHR2, NRWORK, NWORK, WRKBL + INTEGER LWORK_ZGEBRD_MN, LWORK_ZGEBRD_MM, + $ LWORK_ZGEBRD_NN, LWORK_ZGELQF_MN, + $ LWORK_ZGEQRF_MN, + $ LWORK_ZUNGBR_P_MN, LWORK_ZUNGBR_P_NN, + $ LWORK_ZUNGBR_Q_MN, LWORK_ZUNGBR_Q_MM, + $ LWORK_ZUNGLQ_MN, LWORK_ZUNGLQ_NN, + $ LWORK_ZUNGQR_MM, LWORK_ZUNGQR_MN, + $ LWORK_ZUNMBR_PRC_MM, LWORK_ZUNMBR_QLN_MM, + $ LWORK_ZUNMBR_PRC_MN, LWORK_ZUNMBR_QLN_MN, + $ LWORK_ZUNMBR_PRC_NN, LWORK_ZUNMBR_QLN_NN DOUBLE PRECISION ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. INTEGER IDUM( 1 ) DOUBLE PRECISION DUM( 1 ) + COMPLEX*16 CDUM( 1 ) * .. * .. External Subroutines .. EXTERNAL DBDSDC, DLASCL, XERBLA, ZGEBRD, ZGELQF, ZGEMM, @@ -268,9 +283,8 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, ILAENV, DLAMCH, ZLANGE + EXTERNAL LSAME, DLAMCH, ZLANGE * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -279,15 +293,16 @@ * * Test the input arguments * - INFO = 0 - MINMN = MIN( M, N ) + INFO = 0 + MINMN = MIN( M, N ) MNTHR1 = INT( MINMN*17.0D0 / 9.0D0 ) MNTHR2 = INT( MINMN*5.0D0 / 3.0D0 ) - WNTQA = LSAME( JOBZ, 'A' ) - WNTQS = LSAME( JOBZ, 'S' ) + WNTQA = LSAME( JOBZ, 'A' ) + WNTQS = LSAME( JOBZ, 'S' ) WNTQAS = WNTQA .OR. WNTQS - WNTQO = LSAME( JOBZ, 'O' ) - WNTQN = LSAME( JOBZ, 'N' ) + WNTQO = LSAME( JOBZ, 'O' ) + WNTQN = LSAME( JOBZ, 'N' ) + LQUERY = ( LWORK.EQ.-1 ) MINWRK = 1 MAXWRK = 1 * @@ -309,8 +324,8 @@ END IF * * Compute workspace -* (Note: Comments in the code beginning "Workspace:" describe the -* minimal amount of workspace needed at that point in the code, +* Note: Comments in the code beginning "Workspace:" describe the +* minimal amount of workspace allocated at that point in the code, * as well as the preferred amount for good performance. * CWorkspace refers to complex workspace, and RWorkspace to * real workspace. NB refers to the optimal block size for the @@ -320,233 +335,283 @@ IF( M.GE.N ) THEN * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*N*N + 7*N -* BDSPAN = MAX(7*N+4, 3*N+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (dbdsdc) is +* BDSPAC = 3*N*N + 4*N for singular values and vectors; +* BDSPAC = 4*N for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL ZGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MN = INT( CDUM(1) ) +* + CALL ZGEBRD( N, N, CDUM(1), N, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_NN = INT( CDUM(1) ) +* + CALL ZGEQRF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEQRF_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', N, N, N, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_NN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MN = INT( CDUM(1) ) +* + CALL ZUNGQR( M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGQR_MM = INT( CDUM(1) ) +* + CALL ZUNGQR( M, N, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGQR_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MM = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, N, N, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_NN = INT( CDUM(1) ) * IF( M.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * - MAXWRK = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) + MAXWRK = N + LWORK_ZGEQRF_MN + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZGEBRD_NN ) MINWRK = 3*N ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') -* - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 2 (M >> N, JOBZ='O') +* + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = M*N + N*N + WRKBL MINWRK = 2*N*N + 3*N ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') -* - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+N*ILAENV( 1, 'ZUNGQR', ' ', M, - $ N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 3 (M >> N, JOBZ='S') +* + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL MINWRK = N*N + 3*N ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') -* - WRKBL = N + N*ILAENV( 1, 'ZGEQRF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, N+M*ILAENV( 1, 'ZUNGQR', ' ', M, - $ M, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+2*N* - $ ILAENV( 1, 'ZGEBRD', ' ', N, N, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', N, N, N, -1 ) ) - WRKBL = MAX( WRKBL, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) +* Path 4 (M >> N, JOBZ='A') +* + WRKBL = N + LWORK_ZGEQRF_MN + WRKBL = MAX( WRKBL, N + LWORK_ZUNGQR_MM ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZGEBRD_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_QLN_NN ) + WRKBL = MAX( WRKBL, 2*N + LWORK_ZUNMBR_PRC_NN ) MAXWRK = N*N + WRKBL - MINWRK = N*N + 2*N + M + MINWRK = N*N + MAX( 3*N, N + M ) END IF ELSE IF( M.GE.MNTHR2 ) THEN * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_ZGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5o (M >> N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, N, N, -1 ) ) +* Path 5s (M >> N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5a (M >> N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_P_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNGBR_Q_MM ) END IF ELSE * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * - MAXWRK = 2*N + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*N + LWORK_ZGEBRD_MN MINWRK = 2*N + M IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6o (M >= N, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + N*N ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, N, N, -1 ) ) +* Path 6s (M >= N, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MN ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*N+N* - $ ILAENV( 1, 'ZUNGBR', 'PRC', N, N, N, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*N+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6a (M >= N, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR_PRC_NN ) END IF END IF ELSE * * There is no complex work space needed for bidiagonal SVD -* The real work space needed for bidiagonal SVD is BDSPAC -* for computing singular values and singular vectors; BDSPAN -* for computing singular values only. -* BDSPAC = 5*M*M + 7*M -* BDSPAN = MAX(7*M+4, 3*M+2+SMLSIZ*(SMLSIZ+8)) +* The real work space needed for bidiagonal SVD (dbdsdc) is +* BDSPAC = 3*M*M + 4*M for singular values and vectors; +* BDSPAC = 4*M for singular values only; +* not including e, RU, and RVT matrices. +* +* Compute space preferred for each routine + CALL ZGEBRD( M, N, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MN = INT( CDUM(1) ) +* + CALL ZGEBRD( M, M, CDUM(1), M, DUM(1), DUM(1), CDUM(1), + $ CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGEBRD_MM = INT( CDUM(1) ) +* + CALL ZGELQF( M, N, CDUM(1), M, CDUM(1), CDUM(1), -1, IERR ) + LWORK_ZGELQF_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_MN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'P', N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_P_NN = INT( CDUM(1) ) +* + CALL ZUNGBR( 'Q', M, M, N, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGBR_Q_MM = INT( CDUM(1) ) +* + CALL ZUNGLQ( M, N, M, CDUM(1), M, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGLQ_MN = INT( CDUM(1) ) +* + CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), + $ -1, IERR ) + LWORK_ZUNGLQ_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_MM = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', M, N, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_MN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'P', 'R', 'C', N, N, M, CDUM(1), N, CDUM(1), + $ CDUM(1), N, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_PRC_NN = INT( CDUM(1) ) +* + CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, CDUM(1), M, CDUM(1), + $ CDUM(1), M, CDUM(1), -1, IERR ) + LWORK_ZUNMBR_QLN_MM = INT( CDUM(1) ) * IF( N.GE.MNTHR1 ) THEN IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * - MAXWRK = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, - $ -1 ) - MAXWRK = MAX( MAXWRK, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) + MAXWRK = M + LWORK_ZGELQF_MN + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZGEBRD_MM ) MINWRK = 3*M ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') -* - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 2t (N >> M, JOBZ='O') +* + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*N + M*M + WRKBL MINWRK = 2*M*M + 3*M ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+M*ILAENV( 1, 'ZUNGLQ', ' ', M, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 3t (N >> M, JOBZ='S') +* + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_MN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL MINWRK = M*M + 3*M ELSE IF( WNTQA ) THEN * -* Path 4t (N much larger than M, JOBZ='A') -* - WRKBL = M + M*ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - WRKBL = MAX( WRKBL, M+N*ILAENV( 1, 'ZUNGLQ', ' ', N, - $ N, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, M, M, -1 ) ) - WRKBL = MAX( WRKBL, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, M, -1 ) ) +* Path 4t (N >> M, JOBZ='A') +* + WRKBL = M + LWORK_ZGELQF_MN + WRKBL = MAX( WRKBL, M + LWORK_ZUNGLQ_NN ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZGEBRD_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_QLN_MM ) + WRKBL = MAX( WRKBL, 2*M + LWORK_ZUNMBR_PRC_MM ) MAXWRK = M*M + WRKBL - MINWRK = M*M + 2*M + N + MINWRK = M*M + MAX( 3*M, M + N ) END IF ELSE IF( N.GE.MNTHR2 ) THEN * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_ZGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5to (N >> M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'P', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ts (N >> M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'ZUNGBR', 'P', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'Q', M, M, N, -1 ) ) +* Path 5ta (N >> M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_Q_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR_P_NN ) END IF ELSE * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * - MAXWRK = 2*M + ( M+N )*ILAENV( 1, 'ZGEBRD', ' ', M, N, - $ -1, -1 ) + MAXWRK = 2*M + LWORK_ZGEBRD_MN MINWRK = 2*M + N IF( WNTQO ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNMBR', 'QLN', M, M, N, -1 ) ) +* Path 6to (N > M, JOBZ='O') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_MN ) MAXWRK = MAXWRK + M*N MINWRK = MINWRK + M*M ELSE IF( WNTQS ) THEN - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'PRC', M, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ts (N > M, JOBZ='S') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_MN ) ELSE IF( WNTQA ) THEN - MAXWRK = MAX( MAXWRK, 2*M+N* - $ ILAENV( 1, 'ZUNGBR', 'PRC', N, N, M, -1 ) ) - MAXWRK = MAX( MAXWRK, 2*M+M* - $ ILAENV( 1, 'ZUNGBR', 'QLN', M, M, N, -1 ) ) +* Path 6ta (N > M, JOBZ='A') + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_QLN_MM ) + MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR_PRC_NN ) END IF END IF END IF @@ -554,18 +619,20 @@ END IF IF( INFO.EQ.0 ) THEN WORK( 1 ) = MAXWRK - IF( LWORK.LT.MINWRK .AND. LWORK.NE.LQUERV ) - $ INFO = -13 + IF( LWORK.LT.MINWRK .AND. .NOT. LQUERY ) THEN + INFO = -12 + END IF END IF -* -* Quick returns * IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZGESDD', -INFO ) RETURN + ELSE IF( LQUERY ) THEN + RETURN END IF - IF( LWORK.EQ.LQUERV ) - $ RETURN +* +* Quick return if possible +* IF( M.EQ.0 .OR. N.EQ.0 ) THEN RETURN END IF @@ -598,15 +665,16 @@ * IF( WNTQN ) THEN * -* Path 1 (M much larger than N, JOBZ='N') +* Path 1 (M >> N, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: need 0) +* CWorkspace: need N [tau] + N [work] +* CWorkspace: prefer N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -621,8 +689,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -630,15 +699,15 @@ NRWORK = IE + N * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2 (M much larger than N, JOBZ='O') +* Path 2 (M >> N, JOBZ='O') * N left singular vectors to be overwritten on A and * N right singular vectors to be computed in VT * @@ -648,20 +717,21 @@ * LDWRKU = N IR = IU + LDWRKU*N - IF( LWORK.GE.M*N+N*N+3*N ) THEN + IF( LWORK .GE. M*N + N*N + 3*N ) THEN * * WORK(IR) is M by N * LDWRKR = M ELSE - LDWRKR = ( LWORK-N*N-3*N ) / N + LDWRKR = ( LWORK - N*N - 3*N ) / N END IF ITAU = IR + LDWRKR*N NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer M*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -673,8 +743,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -684,8 +755,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -694,8 +766,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of R in WORK(IRU) and computing right singular vectors * of R in WORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -706,8 +778,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of R -* (CWorkspace: need 2*N*N+3*N, prefer M*N+N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -717,8 +790,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by the right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -727,8 +801,9 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IU), storing result in WORK(IR) and copying to A -* (CWorkspace: need 2*N*N, prefer N*N+M*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N*N [R] +* CWorkspace: prefer N*N [U] + M*N [R] +* RWorkspace: need 0 * DO 10 I = 1, M, LDWRKR CHUNK = MIN( M-I+1, LDWRKR ) @@ -741,7 +816,7 @@ * ELSE IF( WNTQS ) THEN * -* Path 3 (M much larger than N, JOBZ='S') +* Path 3 (M >> N, JOBZ='S') * N left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -754,8 +829,9 @@ NWORK = ITAU + N * * Compute A=Q*R -* (CWorkspace: need N*N+2*N, prefer N*N+N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -767,8 +843,9 @@ $ LDWRKR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + N [tau] + N [work] +* CWorkspace: prefer N*N [R] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, N, N, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -778,8 +855,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in WORK(IR) -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, WORK( IR ), LDWRKR, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -788,8 +866,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = IE + N IRVT = IRU + N*N @@ -800,8 +878,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', N, N, N, WORK( IR ), LDWRKR, @@ -810,8 +889,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [R] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, WORK( IR ), LDWRKR, @@ -820,8 +900,8 @@ * * Multiply Q in A by left singular vectors of R in * WORK(IR), storing result in U -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [R] +* RWorkspace: need 0 * CALL ZLACPY( 'F', N, N, U, LDU, WORK( IR ), LDWRKR ) CALL ZGEMM( 'N', 'N', M, N, N, CONE, A, LDA, WORK( IR ), @@ -829,7 +909,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 4 (M much larger than N, JOBZ='A') +* Path 4 (M >> N, JOBZ='A') * M left singular vectors to be computed in U and * N right singular vectors to be computed in VT * @@ -842,16 +922,18 @@ NWORK = ITAU + N * * Compute A=Q*R, copying result to U -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + N [work] +* CWorkspace: prefer N*N [U] + N [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZGEQRF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) * * Generate Q in U -* (CWorkspace: need N+M, prefer N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + N [tau] + M [work] +* CWorkspace: prefer N*N [U] + N [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGQR( M, M, N, U, LDU, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -866,8 +948,9 @@ NWORK = ITAUP + N * * Bidiagonalize R in A -* (CWorkspace: need 3*N, prefer 2*N+2*N*NB) -* (RWorkspace: need N) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + 2*N*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( N, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -879,8 +962,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -888,8 +971,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by left singular vectors of R -* (CWorkspace: need N*N+3*N, prefer N*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, WORK( IU ), $ LDWRKU ) @@ -899,8 +983,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of R -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] + 2*N [tauq, taup] + N [work] +* CWorkspace: prefer N*N [U] + 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -909,8 +994,8 @@ * * Multiply Q in U by left singular vectors of R in * WORK(IU), storing result in A -* (CWorkspace: need N*N) -* (RWorkspace: 0) +* CWorkspace: need N*N [U] +* RWorkspace: need 0 * CALL ZGEMM( 'N', 'N', M, N, N, CONE, U, LDU, WORK( IU ), $ LDWRKU, CZERO, A, LDA ) @@ -925,7 +1010,7 @@ * * MNTHR2 <= M < MNTHR1 * -* Path 5 (M much larger than N, but not as much as MNTHR1) +* Path 5 (M >> N, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * ZUNGBR and matrix multiplication to compute singular vectors * @@ -936,19 +1021,21 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 5n (M >> N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK @@ -956,22 +1043,25 @@ IRVT = IRU + N*N NRWORK = IRVT + N*N * +* Path 5o (M >> N, JOBZ='O') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate Q in A -* (CWorkspace: need 2*N, prefer N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -980,15 +1070,15 @@ * * WORK(IU) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -996,8 +1086,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in WORK(IU), copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, $ WORK( IU ), LDWRKU, RWORK( NRWORK ) ) @@ -1005,8 +1095,10 @@ * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 20 I = 1, M, LDWRKU @@ -1019,17 +1111,20 @@ * ELSE IF( WNTQS ) THEN * +* Path 5s (M >> N, JOBZ='S') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, N, N, U, LDU, WORK( ITAUQ ), @@ -1038,8 +1133,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1050,8 +1145,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1059,8 +1154,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need N*N+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL ZLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1068,17 +1163,20 @@ CALL ZLACPY( 'F', M, N, A, LDA, U, LDU ) ELSE * +* Path 5a (M >> N, JOBZ='A') * Copy A to VT, generate P**H -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', N, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, N, VT, LDVT, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to U, generate Q -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, N, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), @@ -1087,8 +1185,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1099,8 +1197,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + 2*N*N [rwork] * CALL ZLARCM( N, N, RWORK( IRVT ), N, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) @@ -1108,8 +1206,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: 0) -* (Rworkspace: need 3*N*N) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT CALL ZLACRM( M, N, U, LDU, RWORK( IRU ), N, A, LDA, @@ -1121,7 +1219,7 @@ * * M .LT. MNTHR2 * -* Path 6 (M at least N, but not much larger) +* Path 6 (M >= N, but not much larger) * Reduce to bidiagonal form without QR decomposition * Use ZUNMBR to compute singular vectors * @@ -1132,26 +1230,28 @@ NWORK = ITAUP + N * * Bidiagonalize A -* (CWorkspace: need 2*N+M, prefer 2*N+(M+N)*NB) -* (RWorkspace: need N) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need N [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6n (M >= N, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need N [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', N, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IU = NWORK IRU = NRWORK IRVT = IRU + N*N NRWORK = IRVT + N*N - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * * WORK( IU ) is M by N * @@ -1160,15 +1260,16 @@ * * WORK( IU ) is LDWRKU by N * - LDWRKU = ( LWORK-3*N ) / N + LDWRKU = ( LWORK - 3*N ) / N END IF NWORK = IU + LDWRKU*N * +* Path 6o (M >= N, JOBZ='O') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * CALL DBDSDC( 'U', 'I', N, S, RWORK( IE ), RWORK( IRU ), $ N, RWORK( IRVT ), N, DUM, IDUM, @@ -1176,21 +1277,24 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, $ WORK( ITAUP ), VT, LDVT, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*N ) THEN + IF( LWORK .GE. M*N + 3*N ) THEN * -* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) -* Overwrite WORK(IU) by left singular vectors of A, copying -* to A -* (Cworkspace: need M*N+2*N, prefer M*N+N+N*NB) -* (Rworkspace: need 0) +* Path 6o-fast +* Copy real matrix RWORK(IRU) to complex matrix WORK(IU) +* Overwrite WORK(IU) by left singular vectors of A, copying +* to A +* CWorkspace: need 2*N [tauq, taup] + M*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] * CALL ZLASET( 'F', M, N, CZERO, CZERO, WORK( IU ), $ LDWRKU ) @@ -1202,17 +1306,21 @@ CALL ZLACPY( 'F', M, N, WORK( IU ), LDWRKU, A, LDA ) ELSE * +* Path 6o-slow * Generate Q in A -* (Cworkspace: need 2*N, prefer N+N*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*N [U] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'Q', M, N, N, A, LDA, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need N*N, prefer M*N) -* (Rworkspace: need 3*N*N, prefer N*N+2*M*N) +* CWorkspace: need 2*N [tauq, taup] + N*N [U] +* CWorkspace: prefer 2*N [tauq, taup] + M*N [U] +* RWorkspace: need N [e] + N*N [RU] + 2*N*N [rwork] +* RWorkspace: prefer N [e] + N*N [RU] + 2*M*N [rwork] < N + 5*N*N since M < 2*N here * NRWORK = IRVT DO 30 I = 1, M, LDWRKU @@ -1227,11 +1335,12 @@ * ELSE IF( WNTQS ) THEN * +* Path 6s (M >= N, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1242,8 +1351,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLASET( 'F', M, N, CZERO, CZERO, U, LDU ) CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) @@ -1253,8 +1363,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1262,11 +1373,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6a (M >= N, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] + BDSPAC * IRU = NRWORK IRVT = IRU + N*N @@ -1285,8 +1397,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 2*N+M, prefer 2*N+M*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + M [work] +* CWorkspace: prefer 2*N [tauq, taup] + M*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRU ), N, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1295,8 +1408,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*N, prefer 2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need 2*N [tauq, taup] + N [work] +* CWorkspace: prefer 2*N [tauq, taup] + N*NB [work] +* RWorkspace: need N [e] + N*N [RU] + N*N [RVT] * CALL ZLACP2( 'F', N, N, RWORK( IRVT ), N, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, N, A, LDA, @@ -1316,15 +1430,16 @@ * IF( WNTQN ) THEN * -* Path 1t (N much larger than M, JOBZ='N') +* Path 1t (N >> M, JOBZ='N') * No singular vectors to be computed * ITAU = 1 NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M [tau] + M [work] +* CWorkspace: prefer M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1339,8 +1454,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need 3*M, prefer 2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1348,15 +1464,15 @@ NRWORK = IE + M * * Perform bidiagonal SVD, compute singular values only -* (CWorkspace: 0) -* (RWorkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'U', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) * ELSE IF( WNTQO ) THEN * -* Path 2t (N much larger than M, JOBZ='O') +* Path 2t (N >> M, JOBZ='O') * M right singular vectors to be overwritten on A and * M left singular vectors to be computed in U * @@ -1366,7 +1482,7 @@ * WORK(IVT) is M by M * IL = IVT + LDWKVT*M - IF( LWORK.GE.M*N+M*M+3*M ) THEN + IF( LWORK .GE. M*N + M*M + 3*M ) THEN * * WORK(IL) M by N * @@ -1377,14 +1493,15 @@ * WORK(IL) is M by CHUNK * LDWRKL = M - CHUNK = ( LWORK-M*M-3*M ) / M + CHUNK = ( LWORK - M*M - 3*M ) / M END IF ITAU = IL + LDWRKL*CHUNK NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1396,8 +1513,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1407,8 +1525,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1417,8 +1536,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1429,8 +1548,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix WORK(IU) * Overwrite WORK(IU) by the left singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1439,8 +1559,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by the right singular vectors of L -* (CWorkspace: need N*N+3*N, prefer M*N+2*N+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1450,8 +1571,9 @@ * * Multiply right singular vectors of L in WORK(IL) by Q * in A, storing result in WORK(IL) and copying to A -* (CWorkspace: need 2*M*M, prefer M*M+M*N)) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M*M [L] +* CWorkspace: prefer M*M [VT] + M*N [L] +* RWorkspace: need 0 * DO 40 I = 1, N, CHUNK BLK = MIN( N-I+1, CHUNK ) @@ -1464,9 +1586,9 @@ * ELSE IF( WNTQS ) THEN * -* Path 3t (N much larger than M, JOBZ='S') -* M right singular vectors to be computed in VT and -* M left singular vectors to be computed in U +* Path 3t (N >> M, JOBZ='S') +* M right singular vectors to be computed in VT and +* M left singular vectors to be computed in U * IL = 1 * @@ -1477,8 +1599,9 @@ NWORK = ITAU + M * * Compute A=L*Q -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) @@ -1490,8 +1613,9 @@ $ WORK( IL+LDWRKL ), LDWRKL ) * * Generate Q in A -* (CWorkspace: need M*M+2*M, prefer M*M+M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + M [tau] + M [work] +* CWorkspace: prefer M*M [L] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( M, N, M, A, LDA, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1501,8 +1625,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in WORK(IL) -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, WORK( IL ), LDWRKL, S, RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( NWORK ), @@ -1511,8 +1636,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1523,8 +1648,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, WORK( IL ), LDWRKL, @@ -1533,8 +1659,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by left singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [L] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', M, M, M, WORK( IL ), LDWRKL, @@ -1543,8 +1670,8 @@ * * Copy VT to WORK(IL), multiply right singular vectors of L * in WORK(IL) by Q in A, storing result in VT -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [L] +* RWorkspace: need 0 * CALL ZLACPY( 'F', M, M, VT, LDVT, WORK( IL ), LDWRKL ) CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IL ), LDWRKL, @@ -1552,7 +1679,7 @@ * ELSE IF( WNTQA ) THEN * -* Path 9t (N much larger than M, JOBZ='A') +* Path 4t (N >> M, JOBZ='A') * N right singular vectors to be computed in VT and * M left singular vectors to be computed in U * @@ -1565,16 +1692,18 @@ NWORK = ITAU + M * * Compute A=L*Q, copying result to VT -* (CWorkspace: need 2*M, prefer M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + M [work] +* CWorkspace: prefer M*M [VT] + M [tau] + M*NB [work] +* RWorkspace: need 0 * CALL ZGELQF( M, N, A, LDA, WORK( ITAU ), WORK( NWORK ), $ LWORK-NWORK+1, IERR ) CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) * * Generate Q in VT -* (CWorkspace: need M+N, prefer M+N*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + M [tau] + N [work] +* CWorkspace: prefer M*M [VT] + M [tau] + N*NB [work] +* RWorkspace: need 0 * CALL ZUNGLQ( N, N, M, VT, LDVT, WORK( ITAU ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) @@ -1589,8 +1718,9 @@ NWORK = ITAUP + M * * Bidiagonalize L in A -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+2*M*NB) -* (RWorkspace: need M) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + 2*M*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, M, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1599,8 +1729,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RU] + M*M [RVT] + BDSPAC * IRU = IE + M IRVT = IRU + M*M @@ -1611,8 +1741,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of L -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, M, A, LDA, @@ -1621,8 +1752,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) * Overwrite WORK(IVT) by right singular vectors of L -* (CWorkspace: need M*M+3*M, prefer M*M+2*M+M*NB) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] + 2*M [tauq, taup] + M [work] +* CWorkspace: prefer M*M [VT] + 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1632,8 +1764,8 @@ * * Multiply right singular vectors of L in WORK(IVT) by * Q in VT, storing result in A -* (CWorkspace: need M*M) -* (RWorkspace: 0) +* CWorkspace: need M*M [VT] +* RWorkspace: need 0 * CALL ZGEMM( 'N', 'N', M, N, M, CONE, WORK( IVT ), LDWKVT, $ VT, LDVT, CZERO, A, LDA ) @@ -1648,10 +1780,9 @@ * * MNTHR2 <= N < MNTHR1 * -* Path 5t (N much larger than M, but not as much as MNTHR1) +* Path 5t (N >> M, but not as much as MNTHR1) * Reduce to bidiagonal form without QR decomposition, use * ZUNGBR and matrix multiplication to compute singular vectors -* * IE = 1 NRWORK = IE + M @@ -1660,8 +1791,9 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, @@ -1669,11 +1801,12 @@ * IF( WNTQN ) THEN * +* Path 5tn (N >> M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN IRVT = NRWORK @@ -1681,23 +1814,26 @@ NRWORK = IRU + M*M IVT = NWORK * +* Path 5to (N >> M, JOBZ='O') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * LDWKVT = M - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1707,15 +1843,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * CALL DBDSDC( 'L', 'I', M, S, RWORK( IE ), RWORK( IRU ), $ M, RWORK( IRVT ), M, DUM, IDUM, @@ -1723,8 +1859,8 @@ * * Multiply Q in U by real matrix RWORK(IRVT) * storing the result in WORK(IVT), copying to U -* (Cworkspace: need 0) -* (Rworkspace: need 2*M*M) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, WORK( IVT ), $ LDWKVT, RWORK( NRWORK ) ) @@ -1732,8 +1868,10 @@ * * Multiply RWORK(IRVT) by P**H in A, storing the * result in WORK(IVT), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 2*M*M, prefer 2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 50 I = 1, N, CHUNK @@ -1745,17 +1883,20 @@ 50 CONTINUE ELSE IF( WNTQS ) THEN * +* Path 5ts (N >> M, JOBZ='S') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', M, N, M, VT, LDVT, WORK( ITAUP ), @@ -1764,8 +1905,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1776,8 +1917,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1785,8 +1926,8 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU CALL ZLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, @@ -1794,17 +1935,20 @@ CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT ) ELSE * +* Path 5ta (N >> M, JOBZ='A') * Copy A to U, generate Q -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'L', M, M, A, LDA, U, LDU ) CALL ZUNGBR( 'Q', M, M, N, U, LDU, WORK( ITAUQ ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Copy A to VT, generate P**H -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: 0) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need 0 * CALL ZLACPY( 'U', M, N, A, LDA, VT, LDVT ) CALL ZUNGBR( 'P', N, N, M, VT, LDVT, WORK( ITAUP ), @@ -1813,8 +1957,8 @@ * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1825,8 +1969,8 @@ * * Multiply Q in U by real matrix RWORK(IRU), storing the * result in A, copying to U -* (CWorkspace: need 0) -* (Rworkspace: need 3*M*M) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + 2*M*M [rwork] * CALL ZLACRM( M, M, U, LDU, RWORK( IRU ), M, A, LDA, $ RWORK( NRWORK ) ) @@ -1834,9 +1978,10 @@ * * Multiply real matrix RWORK(IRVT) by P**H in VT, * storing the result in A, copying to VT -* (Cworkspace: need 0) -* (Rworkspace: need M*M+2*M*N) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * + NRWORK = IRU CALL ZLARCM( M, N, RWORK( IRVT ), M, VT, LDVT, A, LDA, $ RWORK( NRWORK ) ) CALL ZLACPY( 'F', M, N, A, LDA, VT, LDVT ) @@ -1846,7 +1991,7 @@ * * N .LT. MNTHR2 * -* Path 6t (N greater than M, but not much larger) +* Path 6t (N > M, but not much larger) * Reduce to bidiagonal form without LQ decomposition * Use ZUNMBR to compute singular vectors * @@ -1857,24 +2002,27 @@ NWORK = ITAUP + M * * Bidiagonalize A -* (CWorkspace: need 2*M+N, prefer 2*M+(M+N)*NB) -* (RWorkspace: M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + (M+N)*NB [work] +* RWorkspace: need M [e] * CALL ZGEBRD( M, N, A, LDA, S, RWORK( IE ), WORK( ITAUQ ), $ WORK( ITAUP ), WORK( NWORK ), LWORK-NWORK+1, $ IERR ) IF( WNTQN ) THEN * +* Path 6tn (N > M, JOBZ='N') * Compute singular values only -* (Cworkspace: 0) -* (Rworkspace: need BDSPAN) +* CWorkspace: need 0 +* RWorkspace: need M [e] + BDSPAC * - CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM, 1, DUM, 1, + CALL DBDSDC( 'L', 'N', M, S, RWORK( IE ), DUM,1,DUM,1, $ DUM, IDUM, RWORK( NRWORK ), IWORK, INFO ) ELSE IF( WNTQO ) THEN +* Path 6to (N > M, JOBZ='O') LDWKVT = M IVT = NWORK - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * * WORK( IVT ) is M by N * @@ -1885,15 +2033,15 @@ * * WORK( IVT ) is M by CHUNK * - CHUNK = ( LWORK-3*M ) / M + CHUNK = ( LWORK - 3*M ) / M NWORK = IVT + LDWKVT*CHUNK END IF * * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1904,21 +2052,24 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, $ WORK( ITAUQ ), U, LDU, WORK( NWORK ), $ LWORK-NWORK+1, IERR ) * - IF( LWORK.GE.M*N+3*M ) THEN + IF( LWORK .GE. M*N + 3*M ) THEN * -* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) -* Overwrite WORK(IVT) by right singular vectors of A, -* copying to A -* (Cworkspace: need M*N+2*M, prefer M*N+M+M*NB) -* (Rworkspace: need 0) +* Path 6to-fast +* Copy real matrix RWORK(IRVT) to complex matrix WORK(IVT) +* Overwrite WORK(IVT) by right singular vectors of A, +* copying to A +* CWorkspace: need 2*M [tauq, taup] + M*N [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, WORK( IVT ), $ LDWKVT ) @@ -1928,17 +2079,21 @@ CALL ZLACPY( 'F', M, N, WORK( IVT ), LDWKVT, A, LDA ) ELSE * +* Path 6to-slow * Generate P**H in A -* (Cworkspace: need 2*M, prefer M+M*NB) -* (Rworkspace: need 0) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*M [VT] + M*NB [work] +* RWorkspace: need 0 * CALL ZUNGBR( 'P', M, N, M, A, LDA, WORK( ITAUP ), $ WORK( NWORK ), LWORK-NWORK+1, IERR ) * * Multiply Q in A by real matrix RWORK(IRU), storing the * result in WORK(IU), copying to A -* (CWorkspace: need M*M, prefer M*N) -* (Rworkspace: need 3*M*M, prefer M*M+2*M*N) +* CWorkspace: need 2*M [tauq, taup] + M*M [VT] +* CWorkspace: prefer 2*M [tauq, taup] + M*N [VT] +* RWorkspace: need M [e] + M*M [RVT] + 2*M*M [rwork] +* RWorkspace: prefer M [e] + M*M [RVT] + 2*M*N [rwork] < M + 5*M*M since N < 2*M here * NRWORK = IRU DO 60 I = 1, N, CHUNK @@ -1952,11 +2107,12 @@ END IF ELSE IF( WNTQS ) THEN * +* Path 6ts (N > M, JOBZ='S') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -1967,8 +2123,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -1977,8 +2134,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLASET( 'F', M, N, CZERO, CZERO, VT, LDVT ) CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) @@ -1987,11 +2145,12 @@ $ LWORK-NWORK+1, IERR ) ELSE * +* Path 6ta (N > M, JOBZ='A') * Perform bidiagonal SVD, computing left singular vectors * of bidiagonal matrix in RWORK(IRU) and computing right * singular vectors of bidiagonal matrix in RWORK(IRVT) -* (CWorkspace: need 0) -* (RWorkspace: need BDSPAC) +* CWorkspace: need 0 +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] + BDSPAC * IRVT = NRWORK IRU = IRVT + M*M @@ -2003,8 +2162,9 @@ * * Copy real matrix RWORK(IRU) to complex matrix U * Overwrite U by left singular vectors of A -* (CWorkspace: need 3*M, prefer 2*M+M*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + M [work] +* CWorkspace: prefer 2*M [tauq, taup] + M*NB [work] +* RWorkspace: need M [e] + M*M [RVT] + M*M [RU] * CALL ZLACP2( 'F', M, M, RWORK( IRU ), M, U, LDU ) CALL ZUNMBR( 'Q', 'L', 'N', M, M, N, A, LDA, @@ -2017,8 +2177,9 @@ * * Copy real matrix RWORK(IRVT) to complex matrix VT * Overwrite VT by right singular vectors of A -* (CWorkspace: need 2*M+N, prefer 2*M+N*NB) -* (RWorkspace: M*M) +* CWorkspace: need 2*M [tauq, taup] + N [work] +* CWorkspace: prefer 2*M [tauq, taup] + N*NB [work] +* RWorkspace: need M [e] + M*M [RVT] * CALL ZLACP2( 'F', M, M, RWORK( IRVT ), M, VT, LDVT ) CALL ZUNMBR( 'P', 'R', 'C', N, N, M, A, LDA, diff --git a/lapack-netlib/SRC/zgesvd.f b/lapack-netlib/SRC/zgesvd.f index 966e0227..5f66bcb1 100644 --- a/lapack-netlib/SRC/zgesvd.f +++ b/lapack-netlib/SRC/zgesvd.f @@ -214,7 +214,7 @@ SUBROUTINE ZGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, $ VT, LDVT, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 @@ -322,23 +322,23 @@ MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for ZGEQRF CALL ZGEQRF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEQRF=CDUM(1) + LWORK_ZGEQRF = INT( CDUM(1) ) * Compute space needed for ZUNGQR CALL ZUNGQR( M, N, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGQR_N=CDUM(1) + LWORK_ZUNGQR_N = INT( CDUM(1) ) CALL ZUNGQR( M, M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGQR_M=CDUM(1) + LWORK_ZUNGQR_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( N, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) * Compute space needed for ZUNGBR CALL ZUNGBR( 'P', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) CALL ZUNGBR( 'Q', N, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) * IF( M.GE.MNTHR ) THEN IF( WNTUN ) THEN @@ -445,24 +445,24 @@ * CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) MAXWRK = 2*N + LWORK_ZGEBRD IF( WNTUS .OR. WNTUO ) THEN CALL ZUNGBR( 'Q', M, N, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q ) END IF IF( WNTUA ) THEN CALL ZUNGBR( 'Q', M, M, N, A, LDA, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_Q ) END IF IF( .NOT.WNTVN ) THEN MAXWRK = MAX( MAXWRK, 2*N+LWORK_ZUNGBR_P ) - MINWRK = 2*N + M END IF + MINWRK = 2*N + M END IF ELSE IF( MINMN.GT.0 ) THEN * @@ -471,25 +471,25 @@ MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) * Compute space needed for ZGELQF CALL ZGELQF( M, N, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGELQF=CDUM(1) + LWORK_ZGELQF = INT( CDUM(1) ) * Compute space needed for ZUNGLQ CALL ZUNGLQ( N, N, M, CDUM(1), N, CDUM(1), CDUM(1), -1, $ IERR ) - LWORK_ZUNGLQ_N=CDUM(1) + LWORK_ZUNGLQ_N = INT( CDUM(1) ) CALL ZUNGLQ( M, N, M, A, LDA, CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZUNGLQ_M=CDUM(1) + LWORK_ZUNGLQ_M = INT( CDUM(1) ) * Compute space needed for ZGEBRD CALL ZGEBRD( M, M, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) * Compute space needed for ZUNGBR P CALL ZUNGBR( 'P', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) * Compute space needed for ZUNGBR Q CALL ZUNGBR( 'Q', M, M, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_Q=CDUM(1) + LWORK_ZUNGBR_Q = INT( CDUM(1) ) IF( N.GE.MNTHR ) THEN IF( WNTVN ) THEN * @@ -595,25 +595,25 @@ * CALL ZGEBRD( M, N, A, LDA, S, DUM(1), CDUM(1), $ CDUM(1), CDUM(1), -1, IERR ) - LWORK_ZGEBRD=CDUM(1) + LWORK_ZGEBRD = INT( CDUM(1) ) MAXWRK = 2*M + LWORK_ZGEBRD IF( WNTVS .OR. WNTVO ) THEN * Compute space needed for ZUNGBR P CALL ZUNGBR( 'P', M, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P ) END IF IF( WNTVA ) THEN CALL ZUNGBR( 'P', N, N, M, A, N, CDUM(1), $ CDUM(1), -1, IERR ) - LWORK_ZUNGBR_P=CDUM(1) + LWORK_ZUNGBR_P = INT( CDUM(1) ) MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_P ) END IF IF( .NOT.WNTUN ) THEN MAXWRK = MAX( MAXWRK, 2*M+LWORK_ZUNGBR_Q ) - MINWRK = 2*M + N END IF + MINWRK = 2*M + N END IF END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -680,8 +680,10 @@ * * Zero out below R * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), - $ LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, A( 2, 1 ), + $ LDA ) + END IF IE = 1 ITAUQ = 1 ITAUP = ITAUQ + N @@ -1144,8 +1146,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1321,8 +1325,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1649,8 +1655,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) @@ -1830,8 +1838,10 @@ * * Zero out below R in A * - CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, - $ A( 2, 1 ), LDA ) + IF( N .GT. 1 ) THEN + CALL ZLASET( 'L', N-1, N-1, CZERO, CZERO, + $ A( 2, 1 ), LDA ) + END IF * * Bidiagonalize R in A * (CWorkspace: need 3*N, prefer 2*N+2*N*NB) diff --git a/lapack-netlib/SRC/zgesvdx.f b/lapack-netlib/SRC/zgesvdx.f index 6f7d5ba0..27428732 100644 --- a/lapack-netlib/SRC/zgesvdx.f +++ b/lapack-netlib/SRC/zgesvdx.f @@ -36,27 +36,30 @@ * .. * * -* Purpose -* ======= -* -* ZGESVDX computes the singular value decomposition (SVD) of a complex -* M-by-N matrix A, optionally computing the left and/or right singular -* vectors. The SVD is written -* -* A = U * SIGMA * transpose(V) -* -* where SIGMA is an M-by-N matrix which is zero except for its -* min(m,n) diagonal elements, U is an M-by-M unitary matrix, and -* V is an N-by-N unitary matrix. The diagonal elements of SIGMA -* are the singular values of A; they are real and non-negative, and -* are returned in descending order. The first min(m,n) columns of -* U and V are the left and right singular vectors of A. -* -* ZGESVDX uses an eigenvalue problem for obtaining the SVD, which -* allows for the computation of a subset of singular values and -* vectors. See DBDSVDX for details. -* -* Note that the routine returns V**T, not V. +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZGESVDX computes the singular value decomposition (SVD) of a complex +*> M-by-N matrix A, optionally computing the left and/or right singular +*> vectors. The SVD is written +*> +*> A = U * SIGMA * transpose(V) +*> +*> where SIGMA is an M-by-N matrix which is zero except for its +*> min(m,n) diagonal elements, U is an M-by-M unitary matrix, and +*> V is an N-by-N unitary matrix. The diagonal elements of SIGMA +*> are the singular values of A; they are real and non-negative, and +*> are returned in descending order. The first min(m,n) columns of +*> U and V are the left and right singular vectors of A. +*> +*> ZGESVDX uses an eigenvalue problem for obtaining the SVD, which +*> allows for the computation of a subset of singular values and +*> vectors. See DBDSVDX for details. +*> +*> Note that the routine returns V**T, not V. +*> \endverbatim * * Arguments: * ========== @@ -107,7 +110,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is COMPLEX array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the contents of A are destroyed. *> \endverbatim @@ -121,13 +124,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION -*> VL >=0. +*> If RANGE='V', the lower bound of the interval to +*> be searched for singular values. VU > VL. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for singular values. VU > VL. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -135,13 +140,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest singular value to be returned. +*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest singular values to be returned. +*> If RANGE='I', the index of the +*> largest singular value to be returned. *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -167,7 +176,7 @@ *> vectors, stored columnwise) as specified by RANGE; if *> JOBU = 'N', U is not referenced. *> Note: The user must ensure that UCOL >= NS; if RANGE = 'V', -*> the exact value of NS is not known ILQFin advance and an upper +*> the exact value of NS is not known in advance and an upper *> bound must be used. *> \endverbatim *> @@ -252,7 +261,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEsing * @@ -261,10 +270,10 @@ $ IL, IU, NS, S, U, LDU, VT, LDVT, WORK, $ LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBU, JOBVT, RANGE @@ -291,8 +300,8 @@ CHARACTER JOBZ, RNGTGK LOGICAL ALLS, INDS, LQUERY, VALS, WANTU, WANTVT INTEGER I, ID, IE, IERR, ILQF, ILTGK, IQRF, ISCL, - $ ITAU, ITAUP, ITAUQ, ITEMP, ITGKZ, IUTGK, - $ J, K, MAXWRK, MINMN, MINWRK, MNTHR + $ ITAU, ITAUP, ITAUQ, ITEMP, ITEMPR, ITGKZ, + $ IUTGK, J, K, MAXWRK, MINMN, MINWRK, MNTHR DOUBLE PRECISION ABSTOL, ANRM, BIGNUM, EPS, SMLNUM * .. * .. Local Arrays .. @@ -364,8 +373,14 @@ IF( INFO.EQ.0 ) THEN IF( WANTU .AND. LDU.LT.M ) THEN INFO = -15 - ELSE IF( WANTVT .AND. LDVT.LT.MINMN ) THEN - INFO = -16 + ELSE IF( WANTVT ) THEN + IF( INDS ) THEN + IF( LDVT.LT.IU-IL+1 ) THEN + INFO = -17 + END IF + ELSE IF( LDVT.LT.MINMN ) THEN + INFO = -17 + END IF END IF END IF END IF @@ -387,18 +402,24 @@ * * Path 1 (M much larger than N) * - MAXWRK = N + N* - $ ILAENV( 1, 'DGEQRF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, N*N + N + 2*N* - $ ILAENV( 1, 'DGEBRD', ' ', N, N, -1, -1 ) ) - MINWRK = N*(N+4) + MINWRK = N*(N+5) + MAXWRK = N + N*ILAENV(1,'ZGEQRF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+2*N*ILAENV(1,'ZGEBRD',' ',N,N,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ N*N+2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1)) + END IF ELSE * * Path 2 (M at least N, but not much larger) * - MAXWRK = 2*N + ( M+N )* - $ ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*N + M + MINWRK = 3*N + M + MAXWRK = 2*N + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*N+N*ILAENV(1,'ZUNMQR','LN',N,N,N,-1)) + END IF END IF ELSE MNTHR = ILAENV( 6, 'ZGESVD', JOBU // JOBVT, M, N, 0, 0 ) @@ -406,18 +427,25 @@ * * Path 1t (N much larger than M) * - MAXWRK = M + M* - $ ILAENV( 1, 'ZGELQF', ' ', M, N, -1, -1 ) - MAXWRK = MAX( MAXWRK, M*M + M + 2*M* - $ ILAENV( 1, 'ZGEBRD', ' ', M, M, -1, -1 ) ) - MINWRK = M*(M+4) + MINWRK = M*(M+5) + MAXWRK = M + M*ILAENV(1,'ZGELQF',' ',M,N,-1,-1) + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+2*M*ILAENV(1,'ZGEBRD',' ',M,M,-1,-1)) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ M*M+2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1)) + END IF ELSE * * Path 2t (N greater than M, but not much larger) * - MAXWRK = M*(M*2+19) + ( M+N )* - $ ILAENV( 1, 'ZGEBRD', ' ', M, N, -1, -1 ) - MINWRK = 2*M + N +* + MINWRK = 3*M + N + MAXWRK = 2*M + (M+N)*ILAENV(1,'ZGEBRD',' ',M,N,-1,-1) + IF (WANTU .OR. WANTVT) THEN + MAXWRK = MAX(MAXWRK, + $ 2*M+M*ILAENV(1,'ZUNMQR','LN',M,M,M,-1)) + END IF END IF END IF END IF @@ -444,8 +472,6 @@ * * Set singular values indices accord to RANGE='A'. * - ALLS = LSAME( RANGE, 'A' ) - INDS = LSAME( RANGE, 'I' ) IF( ALLS ) THEN RNGTGK = 'I' ILTGK = 1 @@ -515,14 +541,14 @@ CALL ZGEBRD( N, N, WORK( IQRF ), N, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -536,7 +562,7 @@ END DO K = K + N END DO - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call ZUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -591,14 +617,14 @@ CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + N*(N*2+1) + ITEMPR = ITGKZ + N*(N*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*N*N+14*N) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, N, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), N*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), N*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -612,7 +638,7 @@ END DO K = K + N END DO - CALL ZLASET( 'A', M-N, N, CZERO, CZERO, U( N+1,1 ), LDU ) + CALL ZLASET( 'A', M-N, NS, CZERO, CZERO, U( N+1,1 ), LDU) * * Call ZUNMBR to compute QB*UB. * (Workspace in WORK( ITEMP ): need N, prefer N*NB) @@ -678,14 +704,14 @@ CALL ZGEBRD( M, M, WORK( ILQF ), M, RWORK( ID ), $ RWORK( IE ), WORK( ITAUQ ), WORK( ITAUP ), $ WORK( ITEMP ), LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL DBDSVDX( 'U', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -719,7 +745,7 @@ END DO K = K + M END DO - CALL ZLASET( 'A', M, N-M, CZERO, CZERO, + CALL ZLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call ZUNMBR to compute (VB**T)*(PB**T) @@ -755,14 +781,14 @@ CALL ZGEBRD( M, N, A, LDA, RWORK( ID ), RWORK( IE ), $ WORK( ITAUQ ), WORK( ITAUP ), WORK( ITEMP ), $ LWORK-ITEMP+1, INFO ) - ITEMP = ITGKZ + M*(M*2+1) + ITEMPR = ITGKZ + M*(M*2+1) * * Solve eigenvalue problem TGK*Z=Z*S. * (Workspace: need 2*M*M+14*M) * CALL DBDSVDX( 'L', JOBZ, RNGTGK, M, RWORK( ID ), $ RWORK( IE ), VL, VU, ILTGK, IUTGK, NS, S, - $ RWORK( ITGKZ ), M*2, RWORK( ITEMP ), + $ RWORK( ITGKZ ), M*2, RWORK( ITEMPR ), $ IWORK, INFO) * * If needed, compute left singular vectors. @@ -796,7 +822,7 @@ END DO K = K + M END DO - CALL ZLASET( 'A', M, N-M, CZERO, CZERO, + CALL ZLASET( 'A', NS, N-M, CZERO, CZERO, $ VT( 1,M+1 ), LDVT ) * * Call ZUNMBR to compute VB**T * PB**T diff --git a/lapack-netlib/SRC/zgesvj.f b/lapack-netlib/SRC/zgesvj.f index 930a3530..e4b6969f 100644 --- a/lapack-netlib/SRC/zgesvj.f +++ b/lapack-netlib/SRC/zgesvj.f @@ -270,7 +270,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup doubleGEcomputational * @@ -342,10 +342,10 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, $ LDV, CWORK, LWORK, RWORK, LRWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -381,7 +381,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DFLOAT, MIN0, MAX0, + INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DBLE, MIN0, MAX0, $ DSIGN, DSQRT * .. * .. External Functions .. @@ -403,7 +403,7 @@ * from BLAS EXTERNAL ZCOPY, ZROT, ZDSCAL, ZSWAP * from LAPACK - EXTERNAL ZLASCL, ZLASET, ZLASSQ, XERBLA + EXTERNAL DLASCL, ZLASCL, ZLASET, ZLASSQ, XERBLA EXTERNAL ZGSVJ0, ZGSVJ1 * .. * .. Executable Statements .. @@ -467,9 +467,9 @@ ELSE * ... default IF( LSVEC .OR. RSVEC .OR. APPLV ) THEN - CTOL = DSQRT( DFLOAT( M ) ) + CTOL = DSQRT( DBLE( M ) ) ELSE - CTOL = DFLOAT( M ) + CTOL = DBLE( M ) END IF END IF * ... and the machine dependent parameters are @@ -483,13 +483,13 @@ BIG = DLAMCH( 'Overflow' ) * BIG = ONE / SFMIN ROOTBIG = ONE / ROOTSFMIN - LARGE = BIG / DSQRT( DFLOAT( M*N ) ) + LARGE = BIG / DSQRT( DBLE( M*N ) ) BIGTHETA = ONE / ROOTEPS * TOL = CTOL*EPSLN ROOTTOL = DSQRT( TOL ) * - IF( DFLOAT( M )*EPSLN.GE.ONE ) THEN + IF( DBLE( M )*EPSLN.GE.ONE ) THEN INFO = -4 CALL XERBLA( 'ZGESVJ', -INFO ) RETURN @@ -514,7 +514,7 @@ * SQRT(N)*max_i SVA(i) does not overflow. If INFinite entries * in A are detected, the procedure returns with INFO=-6. * - SKL = ONE / DSQRT( DFLOAT( M )*DFLOAT( N ) ) + SKL = ONE / DSQRT( DBLE( M )*DBLE( N ) ) NOSCALE = .TRUE. GOSCALE = .TRUE. * @@ -643,14 +643,14 @@ * avoid underflows/overflows in computing Jacobi rotations. * SN = DSQRT( SFMIN / EPSLN ) - TEMP1 = DSQRT( BIG / DFLOAT( N ) ) + TEMP1 = DSQRT( BIG / DBLE( N ) ) IF( ( AAPP.LE.SN ) .OR. ( AAQQ.GE.TEMP1 ) .OR. $ ( ( SN.LE.AAQQ ) .AND. ( AAPP.LE.TEMP1 ) ) ) THEN TEMP1 = DMIN1( BIG, TEMP1 / AAPP ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.LE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DFLOAT(N)) ) ) + TEMP1 = DMIN1( SN / AAQQ, BIG / (AAPP*DSQRT( DBLE(N)) ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.GE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN @@ -658,7 +658,7 @@ * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE IF( ( AAQQ.LE.SN ) .AND. ( AAPP.GE.TEMP1 ) ) THEN - TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DFLOAT( N ) )*AAPP ) ) + TEMP1 = DMIN1( SN / AAQQ, BIG / ( DSQRT( DBLE( N ) )*AAPP ) ) * AAQQ = AAQQ*TEMP1 * AAPP = AAPP*TEMP1 ELSE @@ -668,7 +668,7 @@ * Scale, if necessary * IF( TEMP1.NE.ONE ) THEN - CALL ZLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR ) + CALL DLASCL( 'G', 0, 0, ONE, TEMP1, N, 1, SVA, N, IERR ) END IF SKL = TEMP1*SKL IF( SKL.NE.ONE ) THEN @@ -905,7 +905,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 ) @@ -925,7 +924,8 @@ * IF( ROTOK ) THEN * - AQOAP = AAQQ / AAPP + OMPQ = AAPQ / ABS(AAPQ) + AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1 * @@ -1126,7 +1126,6 @@ END IF END IF * - OMPQ = AAPQ / ABS(AAPQ) * AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q) AAPQ1 = -ABS(AAPQ) MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 ) @@ -1141,6 +1140,7 @@ * IF( ROTOK ) THEN * + OMPQ = AAPQ / ABS(AAPQ) AQOAP = AAQQ / AAPP APOAQ = AAPP / AAQQ THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1 @@ -1322,8 +1322,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * @@ -1400,15 +1400,15 @@ * then some of the singular values may overflow or underflow and * the spectrum is given in this factored representation. * - RWORK( 2 ) = DFLOAT( N4 ) + RWORK( 2 ) = DBLE( N4 ) * N4 is the number of computed nonzero singular values of A. * - RWORK( 3 ) = DFLOAT( N2 ) + RWORK( 3 ) = DBLE( N2 ) * N2 is the number of singular values of A greater than SFMIN. * If N2 \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complex16GEauxiliary * @@ -111,10 +111,10 @@ * ===================================================================== SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, N diff --git a/lapack-netlib/SRC/zgetrf2.f b/lapack-netlib/SRC/zgetrf2.f index 7d28b581..9b2e956c 100644 --- a/lapack-netlib/SRC/zgetrf2.f +++ b/lapack-netlib/SRC/zgetrf2.f @@ -37,7 +37,7 @@ *> the matrix into four submatrices: *> *> [ A11 | A12 ] where A11 is n1 by n1 and A22 is n2 by n2 -*> A = [ -----|----- ] with n1 = min(m,n) +*> A = [ -----|----- ] with n1 = min(m,n)/2 *> [ A21 | A22 ] n2 = n-n1 *> *> [ A11 ] @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GEcomputational * * ===================================================================== RECURSIVE SUBROUTINE ZGETRF2( M, N, A, LDA, IPIV, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER INFO, LDA, M, N diff --git a/lapack-netlib/SRC/zggbal.f b/lapack-netlib/SRC/zggbal.f index 7298da39..7771c4c1 100644 --- a/lapack-netlib/SRC/zggbal.f +++ b/lapack-netlib/SRC/zggbal.f @@ -140,7 +140,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (lwork) +*> WORK is DOUBLE PRECISION array, dimension (lwork) *> lwork must be at least max(1,6*N) when JOB = 'S' or 'B', and *> at least 1 when JOB = 'N' or 'P'. *> \endverbatim @@ -160,7 +160,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16GBcomputational * @@ -177,10 +177,10 @@ SUBROUTINE ZGGBAL( JOB, N, A, LDA, B, LDB, ILO, IHI, LSCALE, $ RSCALE, WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOB diff --git a/lapack-netlib/SRC/zgges3.f b/lapack-netlib/SRC/zgges3.f index 1a7dbccc..08557b13 100644 --- a/lapack-netlib/SRC/zgges3.f +++ b/lapack-netlib/SRC/zgges3.f @@ -269,7 +269,7 @@ $ LDB, SDIM, ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, $ WORK, LWORK, RWORK, BWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -392,8 +392,8 @@ $ LDVSL, VSR, LDVSR, WORK, -1, IERR ) LWKOPT = MAX( LWKOPT, N + INT ( WORK( 1 ) ) ) CALL ZHGEQZ( 'S', JOBVSL, JOBVSR, N, 1, N, A, LDA, B, LDB, - $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, - $ -1, RWORK, IERR ) + $ ALPHA, BETA, VSL, LDVSL, VSR, LDVSR, WORK, -1, + $ RWORK, IERR ) LWKOPT = MAX( LWKOPT, INT ( WORK( 1 ) ) ) IF( WANTST ) THEN CALL ZTGSEN( 0, ILVSL, ILVSR, BWORK, N, A, LDA, B, LDB, diff --git a/lapack-netlib/SRC/zggev3.f b/lapack-netlib/SRC/zggev3.f index 78337fd0..2e88aded 100644 --- a/lapack-netlib/SRC/zggev3.f +++ b/lapack-netlib/SRC/zggev3.f @@ -216,7 +216,7 @@ SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA, $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 diff --git a/lapack-netlib/SRC/zgghd3.f b/lapack-netlib/SRC/zgghd3.f index 9d6e3628..94ae93b9 100644 --- a/lapack-netlib/SRC/zgghd3.f +++ b/lapack-netlib/SRC/zgghd3.f @@ -227,7 +227,7 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q, $ LDQ, Z, LDZ, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2015 @@ -277,7 +277,7 @@ * INFO = 0 NB = ILAENV( 1, 'ZGGHD3', ' ', N, ILO, IHI, -1 ) - LWKOPT = 6*N*NB + LWKOPT = MAX( 6*N*NB, 1 ) WORK( 1 ) = DCMPLX( LWKOPT ) INITQ = LSAME( COMPQ, 'I' ) WANTQ = INITQ .OR. LSAME( COMPQ, 'V' ) diff --git a/lapack-netlib/SRC/zggsvd3.f b/lapack-netlib/SRC/zggsvd3.f index d478d292..da479793 100644 --- a/lapack-netlib/SRC/zggsvd3.f +++ b/lapack-netlib/SRC/zggsvd3.f @@ -353,7 +353,7 @@ $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, $ WORK, LWORK, RWORK, IWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -383,7 +383,7 @@ EXTERNAL LSAME, DLAMCH, ZLANGE * .. * .. External Subroutines .. - EXTERNAL DCOPY, XERBLA, ZGGSVP, ZTGSJA + EXTERNAL DCOPY, XERBLA, ZGGSVP3, ZTGSJA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN diff --git a/lapack-netlib/SRC/zggsvp3.f b/lapack-netlib/SRC/zggsvp3.f index b397651c..88566f75 100644 --- a/lapack-netlib/SRC/zggsvp3.f +++ b/lapack-netlib/SRC/zggsvp3.f @@ -278,7 +278,7 @@ $ TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, $ IWORK, RWORK, TAU, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * August 2015 @@ -308,7 +308,6 @@ * .. Local Scalars .. LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY INTEGER I, J, LWKOPT - COMPLEX*16 T * .. * .. External Functions .. LOGICAL LSAME diff --git a/lapack-netlib/SRC/zgsvj0.f b/lapack-netlib/SRC/zgsvj0.f index a9e663d4..e547eebb 100644 --- a/lapack-netlib/SRC/zgsvj0.f +++ b/lapack-netlib/SRC/zgsvj0.f @@ -1,4 +1,4 @@ -*> \brief \b ZGSVJ0 pre-processor for the routine dgesvj. +*> \brief \b ZGSVJ0 pre-processor for the routine zgesvj. * * =========== DOCUMENTATION =========== * @@ -192,7 +192,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational *> @@ -217,10 +217,10 @@ SUBROUTINE ZGSVJ0( JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, $ SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -254,7 +254,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DMAX1, DCONJG, DFLOAT, MIN0, DSIGN, DSQRT + INTRINSIC ABS, DMAX1, DCONJG, DBLE, MIN0, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DZNRM2 @@ -889,8 +889,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * diff --git a/lapack-netlib/SRC/zgsvj1.f b/lapack-netlib/SRC/zgsvj1.f index 54410cc0..65b383b7 100644 --- a/lapack-netlib/SRC/zgsvj1.f +++ b/lapack-netlib/SRC/zgsvj1.f @@ -1,4 +1,4 @@ -*> \brief \b ZGSVJ1 pre-processor for the routine sgesvj, applies Jacobi rotations targeting only particular pivots. +*> \brief \b ZGSVJ1 pre-processor for the routine zgesvj, applies Jacobi rotations targeting only particular pivots. * * =========== DOCUMENTATION =========== * @@ -105,7 +105,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, M-by-N matrix A, such that A*diag(D) represents *> the input matrix. *> On exit, @@ -124,7 +124,7 @@ *> *> \param[in,out] D *> \verbatim -*> D is DOUBLE PRECISION array, dimension (N) +*> D is COMPLEX*16 array, dimension (N) *> The array D accumulates the scaling factors from the fast scaled *> Jacobi rotations. *> On entry, A*diag(D) represents the input matrix. @@ -154,7 +154,7 @@ *> *> \param[in,out] V *> \verbatim -*> V is DOUBLE PRECISION array, dimension (LDV,N) +*> V is COMPLEX*16 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 @@ -199,7 +199,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is DOUBLE PRECISION array, dimension (LWORK) +*> WORK is COMPLEX*16 array, dimension (LWORK) *> \endverbatim *> *> \param[in] LWORK @@ -223,7 +223,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -236,10 +236,10 @@ SUBROUTINE ZGSVJ1( JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, $ EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * IMPLICIT NONE * .. Scalar Arguments .. @@ -271,7 +271,7 @@ * .. * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DCONJG, DMAX1, DFLOAT, MIN0, DSIGN, DSQRT + INTRINSIC ABS, DCONJG, DMAX1, DBLE, MIN0, DSIGN, DSQRT * .. * .. External Functions .. DOUBLE PRECISION DZNRM2 @@ -335,7 +335,7 @@ SMALL = SFMIN / EPS BIG = ONE / SFMIN ROOTBIG = ONE / ROOTSFMIN - LARGE = BIG / DSQRT( DFLOAT( M*N ) ) + LARGE = BIG / DSQRT( DBLE( M*N ) ) BIGTHETA = ONE / ROOTEPS ROOTTOL = DSQRT( TOL ) * @@ -660,8 +660,8 @@ IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR. $ ( ISWROT.LE.N ) ) )SWBAND = i * - IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )* - $ TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN + IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DBLE( N ) )* + $ TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN GO TO 1994 END IF * diff --git a/lapack-netlib/SRC/zhbevx.f b/lapack-netlib/SRC/zhbevx.f index f060029e..09322be4 100644 --- a/lapack-netlib/SRC/zhbevx.f +++ b/lapack-netlib/SRC/zhbevx.f @@ -123,12 +123,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -136,13 +139,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -251,7 +258,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -260,10 +267,10 @@ $ VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhbgvd.f b/lapack-netlib/SRC/zhbgvd.f index f60d6b01..333e4377 100644 --- a/lapack-netlib/SRC/zhbgvd.f +++ b/lapack-netlib/SRC/zhbgvd.f @@ -238,7 +238,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -252,10 +252,10 @@ $ Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, UPLO @@ -372,7 +372,7 @@ LLWK2 = LWORK - INDWK2 + 2 LLRWK = LRWORK - INDWRK + 2 CALL ZHBGST( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ, - $ WORK, RWORK( INDWRK ), IINFO ) + $ WORK, RWORK, IINFO ) * * Reduce Hermitian band matrix to tridiagonal form. * diff --git a/lapack-netlib/SRC/zhbgvx.f b/lapack-netlib/SRC/zhbgvx.f index e8596e45..4d42b503 100644 --- a/lapack-netlib/SRC/zhbgvx.f +++ b/lapack-netlib/SRC/zhbgvx.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -277,7 +286,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -291,10 +300,10 @@ $ LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, $ LDZ, WORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zheevr.f b/lapack-netlib/SRC/zheevr.f index 86e05b06..1ea82200 100644 --- a/lapack-netlib/SRC/zheevr.f +++ b/lapack-netlib/SRC/zheevr.f @@ -155,12 +155,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -168,13 +171,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -329,7 +336,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -348,10 +355,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, $ RWORK, LRWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK driver routine (version 3.4.2) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zheevx.f b/lapack-netlib/SRC/zheevx.f index 376d4c1b..fe4422f6 100644 --- a/lapack-netlib/SRC/zheevx.f +++ b/lapack-netlib/SRC/zheevx.f @@ -99,12 +99,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -112,13 +115,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -243,7 +250,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -252,10 +259,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhegvx.f b/lapack-netlib/SRC/zhegvx.f index 932e070e..2aaa3359 100644 --- a/lapack-netlib/SRC/zhegvx.f +++ b/lapack-netlib/SRC/zhegvx.f @@ -132,13 +132,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -146,14 +150,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -284,7 +293,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16HEeigen * @@ -298,10 +307,10 @@ $ VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, $ LWORK, RWORK, IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhetrf_rook.f b/lapack-netlib/SRC/zhetrf_rook.f index 64e59aab..afbad21c 100644 --- a/lapack-netlib/SRC/zhetrf_rook.f +++ b/lapack-netlib/SRC/zhetrf_rook.f @@ -150,7 +150,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2013 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -199,7 +199,7 @@ *> *> \verbatim *> -*> November 2013, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -212,10 +212,10 @@ * ===================================================================== SUBROUTINE ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -265,7 +265,7 @@ * Determine the block size * NB = ILAENV( 1, 'ZHETRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/zhetrs2.f b/lapack-netlib/SRC/zhetrs2.f index 15b460b4..7f72c18f 100644 --- a/lapack-netlib/SRC/zhetrs2.f +++ b/lapack-netlib/SRC/zhetrs2.f @@ -101,7 +101,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is COMPLEX*16 array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -119,7 +119,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -127,10 +127,10 @@ SUBROUTINE ZHETRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zhgeqz.f b/lapack-netlib/SRC/zhgeqz.f index 98d1fb06..fb2df81e 100644 --- a/lapack-netlib/SRC/zhgeqz.f +++ b/lapack-netlib/SRC/zhgeqz.f @@ -190,12 +190,12 @@ *> \param[in,out] Q *> \verbatim *> Q is COMPLEX*16 array, dimension (LDQ, N) -*> On entry, if COMPZ = 'V', the unitary matrix Q1 used in the +*> On entry, if COMPQ = 'V', the unitary matrix Q1 used in the *> reduction of (A,B) to generalized Hessenberg form. -*> On exit, if COMPZ = 'I', the unitary matrix of left Schur -*> vectors of (H,T), and if COMPZ = 'V', the unitary matrix of +*> On exit, if COMPQ = 'I', the unitary matrix of left Schur +*> vectors of (H,T), and if COMPQ = 'V', the unitary matrix of *> left Schur vectors of (A,B). -*> Not referenced if COMPZ = 'N'. +*> Not referenced if COMPQ = 'N'. *> \endverbatim *> *> \param[in] LDQ @@ -284,7 +284,7 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, WORK, LWORK, $ RWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * April 2012 diff --git a/lapack-netlib/SRC/zhpevx.f b/lapack-netlib/SRC/zhpevx.f index e8043556..a7a6abc4 100644 --- a/lapack-netlib/SRC/zhpevx.f +++ b/lapack-netlib/SRC/zhpevx.f @@ -97,12 +97,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -110,13 +113,17 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -224,7 +231,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -233,10 +240,10 @@ $ ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, $ IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.4.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zhpgvx.f b/lapack-netlib/SRC/zhpgvx.f index 5495c003..ef7e1197 100644 --- a/lapack-netlib/SRC/zhpgvx.f +++ b/lapack-netlib/SRC/zhpgvx.f @@ -118,13 +118,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -132,14 +136,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0; IL = 1 and IU = 0 if N = 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -254,7 +263,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHEReigen * @@ -268,10 +277,10 @@ $ IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, $ IWORK, IFAIL, INFO ) * -* -- LAPACK driver routine (version 3.6.0) -- +* -- LAPACK driver routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE, UPLO diff --git a/lapack-netlib/SRC/zla_gerpvgrw.f b/lapack-netlib/SRC/zla_gerpvgrw.f index aae5e666..096ab373 100644 --- a/lapack-netlib/SRC/zla_gerpvgrw.f +++ b/lapack-netlib/SRC/zla_gerpvgrw.f @@ -61,7 +61,7 @@ *> *> \param[in] A *> \verbatim -*> A is DOUBLE PRECISION array, dimension (LDA,N) +*> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the N-by-N matrix A. *> \endverbatim *> @@ -73,7 +73,7 @@ *> *> \param[in] AF *> \verbatim -*> AF is DOUBLE PRECISION array, dimension (LDAF,N) +*> AF is COMPLEX*16 array, dimension (LDAF,N) *> The factors L and U from the factorization *> A = P*L*U as computed by ZGETRF. *> \endverbatim @@ -92,7 +92,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16GEcomputational * @@ -100,10 +100,10 @@ DOUBLE PRECISION FUNCTION ZLA_GERPVGRW( N, NCOLS, A, LDA, AF, $ LDAF ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NCOLS, LDA, LDAF diff --git a/lapack-netlib/SRC/zla_herpvgrw.f b/lapack-netlib/SRC/zla_herpvgrw.f index e1fb5c4d..8d9e2a23 100644 --- a/lapack-netlib/SRC/zla_herpvgrw.f +++ b/lapack-netlib/SRC/zla_herpvgrw.f @@ -104,7 +104,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) +*> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim * * Authors: @@ -115,7 +115,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16HEcomputational * @@ -123,10 +123,10 @@ DOUBLE PRECISION FUNCTION ZLA_HERPVGRW( UPLO, N, INFO, A, LDA, AF, $ LDAF, IPIV, WORK ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/zla_lin_berr.f b/lapack-netlib/SRC/zla_lin_berr.f index 161eed97..212c3582 100644 --- a/lapack-netlib/SRC/zla_lin_berr.f +++ b/lapack-netlib/SRC/zla_lin_berr.f @@ -67,7 +67,7 @@ *> *> \param[in] RES *> \verbatim -*> RES is DOUBLE PRECISION array, dimension (N,NRHS) +*> RES is COMPLEX*16 array, dimension (N,NRHS) *> The residual matrix, i.e., the matrix R in the relative backward *> error formula above. *> \endverbatim @@ -82,7 +82,7 @@ *> *> \param[out] BERR *> \verbatim -*> BERR is COMPLEX*16 array, dimension (NRHS) +*> BERR is DOUBLE PRECISION array, dimension (NRHS) *> The componentwise relative backward error from the formula above. *> \endverbatim * @@ -94,17 +94,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLA_LIN_BERR ( N, NZ, NRHS, RES, AYB, BERR ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER N, NZ, NRHS diff --git a/lapack-netlib/SRC/zla_porpvgrw.f b/lapack-netlib/SRC/zla_porpvgrw.f index 682a670a..1cf63cdb 100644 --- a/lapack-netlib/SRC/zla_porpvgrw.f +++ b/lapack-netlib/SRC/zla_porpvgrw.f @@ -88,7 +88,7 @@ *> *> \param[in] WORK *> \verbatim -*> WORK is COMPLEX*16 array, dimension (2*N) +*> WORK is DOUBLE PRECISION array, dimension (2*N) *> \endverbatim * * Authors: @@ -99,7 +99,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16POcomputational * @@ -107,10 +107,10 @@ DOUBLE PRECISION FUNCTION ZLA_PORPVGRW( UPLO, NCOLS, A, LDA, AF, $ LDAF, WORK ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER*1 UPLO diff --git a/lapack-netlib/SRC/zlaed7.f b/lapack-netlib/SRC/zlaed7.f index ae6e9a36..26a0534f 100644 --- a/lapack-netlib/SRC/zlaed7.f +++ b/lapack-netlib/SRC/zlaed7.f @@ -57,7 +57,7 @@ *> *> The first stage consists of deflating the size of the problem *> when there are multiple eigenvalues or if there is a zero in -*> the Z vector. For each such occurence the dimension of the +*> the Z vector. For each such occurrence the dimension of the *> secular equation problem is reduced by one. This stage is *> performed by the routine DLAED2. *> @@ -239,7 +239,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -249,10 +249,10 @@ $ GIVPTR, GIVCOL, GIVNUM, WORK, RWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER CURLVL, CURPBM, CUTPNT, INFO, LDQ, N, QSIZ, diff --git a/lapack-netlib/SRC/zlaqr3.f b/lapack-netlib/SRC/zlaqr3.f index 39880147..b09c3ef7 100644 --- a/lapack-netlib/SRC/zlaqr3.f +++ b/lapack-netlib/SRC/zlaqr3.f @@ -138,7 +138,7 @@ *> Z is COMPLEX*16 array, dimension (LDZ,N) *> IF WANTZ is .TRUE., then on output, the unitary *> similarity transformation mentioned above has been -*> accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ is .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -252,7 +252,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -267,10 +267,10 @@ $ IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT, $ NV, WV, LDWV, WORK, LWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV, diff --git a/lapack-netlib/SRC/zlaqr5.f b/lapack-netlib/SRC/zlaqr5.f index e33a30d6..66f550fc 100644 --- a/lapack-netlib/SRC/zlaqr5.f +++ b/lapack-netlib/SRC/zlaqr5.f @@ -142,10 +142,10 @@ *> *> \param[in,out] Z *> \verbatim -*> Z is COMPLEX*16 array of size (LDZ,IHI) +*> Z is COMPLEX*16 array of size (LDZ,IHIZ) *> If WANTZ = .TRUE., then the QR Sweep unitary *> similarity transformation is accumulated into -*> Z(ILOZ:IHIZ,ILO:IHI) from the right. +*> Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right. *> If WANTZ = .FALSE., then Z is unreferenced. *> \endverbatim *> @@ -228,7 +228,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -251,10 +251,10 @@ $ H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV, $ WV, LDWV, NH, WH, LDWH ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, diff --git a/lapack-netlib/SRC/zlarcm.f b/lapack-netlib/SRC/zlarcm.f index e72c1061..90af72ef 100644 --- a/lapack-netlib/SRC/zlarcm.f +++ b/lapack-netlib/SRC/zlarcm.f @@ -72,7 +72,7 @@ *> *> \param[in] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB, N) +*> B is COMPLEX*16 array, dimension (LDB, N) *> B contains the M by N matrix B. *> \endverbatim *> @@ -107,17 +107,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER LDA, LDB, LDC, M, N diff --git a/lapack-netlib/SRC/zlarft.f b/lapack-netlib/SRC/zlarft.f index b9ac9397..7e1013f2 100644 --- a/lapack-netlib/SRC/zlarft.f +++ b/lapack-netlib/SRC/zlarft.f @@ -130,7 +130,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -163,10 +163,10 @@ * ===================================================================== SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER DIRECT, STOREV @@ -303,7 +303,7 @@ * CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ), $ V( I+1, J ), LDV, V( I, J ), LDV, - $ ONE, T( I+1, I ), LDT ) + $ ONE, T( I+1, I ), LDT ) END IF * * T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) diff --git a/lapack-netlib/SRC/zlarrv.f b/lapack-netlib/SRC/zlarrv.f index 3992f14d..c29dda1b 100644 --- a/lapack-netlib/SRC/zlarrv.f +++ b/lapack-netlib/SRC/zlarrv.f @@ -59,12 +59,15 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> Lower bound of the interval that contains the desired +*> eigenvalues. VL < VU. Needed to compute gaps on the left or right +*> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION -*> Lower and upper bounds of the interval that contains the desired +*> Upper bound of the interval that contains the desired *> eigenvalues. VL < VU. Needed to compute gaps on the left or right *> end of the extremal eigenvalues in the desired RANGE. *> \endverbatim @@ -81,7 +84,7 @@ *> L is DOUBLE PRECISION array, dimension (N) *> On entry, the (N-1) subdiagonal elements of the unit *> bidiagonal matrix L are in elements 1 to N-1 of L -*> (if the matrix is not splitted.) At the end of each block +*> (if the matrix is not split.) At the end of each block *> is stored the corresponding shift as given by DLARRE. *> On exit, L is overwritten. *> \endverbatim @@ -236,7 +239,7 @@ *> INFO is INTEGER *> = 0: successful exit *> -*> > 0: A problem occured in ZLARRV. +*> > 0: A problem occurred in ZLARRV. *> < 0: One of the called subroutines signaled an internal problem. *> Needs inspection of the corresponding parameter IINFO *> for further information. @@ -263,7 +266,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -283,10 +286,10 @@ $ IBLOCK, INDEXW, GERS, Z, LDZ, ISUPPZ, $ WORK, IWORK, INFO ) * -* -- LAPACK auxiliary routine (version 3.6.0) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER DOL, DOU, INFO, LDZ, M, N diff --git a/lapack-netlib/SRC/zlarscl2.f b/lapack-netlib/SRC/zlarscl2.f index b54f02c9..2b47d6ba 100644 --- a/lapack-netlib/SRC/zlarscl2.f +++ b/lapack-netlib/SRC/zlarscl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLARSCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/zlascl.f b/lapack-netlib/SRC/zlascl.f index 51a4f0f6..1618fdba 100644 --- a/lapack-netlib/SRC/zlascl.f +++ b/lapack-netlib/SRC/zlascl.f @@ -114,7 +114,11 @@ *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. LDA >= max(1,M). +*> The leading dimension of the array A. +*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); +*> TYPE = 'B', LDA >= KL+1; +*> TYPE = 'Q', LDA >= KU+1; +*> TYPE = 'Z', LDA >= 2*KL+KU+1. *> \endverbatim *> *> \param[out] INFO @@ -132,17 +136,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER TYPE diff --git a/lapack-netlib/SRC/zlascl2.f b/lapack-netlib/SRC/zlascl2.f index eebdebb4..78b94b3d 100644 --- a/lapack-netlib/SRC/zlascl2.f +++ b/lapack-netlib/SRC/zlascl2.f @@ -73,7 +73,7 @@ *> \param[in] LDX *> \verbatim *> LDX is INTEGER -*> The leading dimension of the vector X. LDX >= 0. +*> The leading dimension of the vector X. LDX >= M. *> \endverbatim * * Authors: @@ -84,17 +84,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZLASCL2 ( M, N, D, X, LDX ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. INTEGER M, N, LDX diff --git a/lapack-netlib/SRC/zlatdf.f b/lapack-netlib/SRC/zlatdf.f index e90bfede..8551ca4f 100644 --- a/lapack-netlib/SRC/zlatdf.f +++ b/lapack-netlib/SRC/zlatdf.f @@ -58,7 +58,7 @@ *> Zx = +-e - f with the sign giving the greater value of *> 2-norm(x). About 5 times as expensive as Default. *> IJOB .ne. 2: Local look ahead strategy where -*> all entries of the r.h.s. b is choosen as either +1 or +*> all entries of the r.h.s. b is chosen as either +1 or *> -1. Default. *> \endverbatim *> @@ -70,7 +70,7 @@ *> *> \param[in] Z *> \verbatim -*> Z is DOUBLE PRECISION array, dimension (LDZ, N) +*> Z is COMPLEX*16 array, dimension (LDZ, N) *> On entry, the LU part of the factorization of the n-by-n *> matrix Z computed by ZGETC2: Z = P * L * U * Q *> \endverbatim @@ -83,7 +83,7 @@ *> *> \param[in,out] RHS *> \verbatim -*> RHS is DOUBLE PRECISION array, dimension (N). +*> RHS is COMPLEX*16 array, dimension (N). *> On entry, RHS contains contributions from other subsystems. *> On exit, RHS contains the solution of the subsystem with *> entries according to the value of IJOB (see above). @@ -134,7 +134,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16OTHERauxiliary * @@ -169,10 +169,10 @@ SUBROUTINE ZLATDF( IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, $ JPIV ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IJOB, LDZ, N diff --git a/lapack-netlib/SRC/zpbrfs.f b/lapack-netlib/SRC/zpbrfs.f index a75f563a..a47cd17a 100644 --- a/lapack-netlib/SRC/zpbrfs.f +++ b/lapack-netlib/SRC/zpbrfs.f @@ -75,7 +75,7 @@ *> *> \param[in] AB *> \verbatim -*> AB is DOUBLE PRECISION array, dimension (LDAB,N) +*> AB is COMPLEX*16 array, dimension (LDAB,N) *> The upper or lower triangle of the Hermitian band matrix A, *> stored in the first KD+1 rows of the array. The j-th column *> of A is stored in the j-th column of the array AB as follows: @@ -181,7 +181,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -189,10 +189,10 @@ SUBROUTINE ZPBRFS( UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, $ LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zpftrf.f b/lapack-netlib/SRC/zpftrf.f index 179bcac0..de07310a 100644 --- a/lapack-netlib/SRC/zpftrf.f +++ b/lapack-netlib/SRC/zpftrf.f @@ -69,7 +69,7 @@ *> *> \param[in,out] A *> \verbatim -*> A is COMPLEX array, dimension ( N*(N+1)/2 ); +*> A is COMPLEX*16 array, dimension ( N*(N+1)/2 ); *> On entry, the Hermitian matrix A in RFP format. RFP format is *> described by TRANSR, UPLO, and N as follows: If TRANSR = 'N' *> then RFP A is (0:N,0:k-1) when N is even; k=N/2. RFP A is @@ -204,17 +204,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * * ===================================================================== SUBROUTINE ZPFTRF( TRANSR, UPLO, N, A, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER TRANSR, UPLO diff --git a/lapack-netlib/SRC/zpttrs.f b/lapack-netlib/SRC/zpttrs.f index 8d6aa391..4940b3e0 100644 --- a/lapack-netlib/SRC/zpttrs.f +++ b/lapack-netlib/SRC/zpttrs.f @@ -87,7 +87,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -114,17 +114,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16PTcomputational * * ===================================================================== SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/zptts2.f b/lapack-netlib/SRC/zptts2.f index 3be100a2..434dbced 100644 --- a/lapack-netlib/SRC/zptts2.f +++ b/lapack-netlib/SRC/zptts2.f @@ -86,7 +86,7 @@ *> *> \param[in,out] B *> \verbatim -*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) +*> B is COMPLEX*16 array, dimension (LDB,NRHS) *> On entry, the right hand side vectors B for the system of *> linear equations. *> On exit, the solution vectors, X. @@ -106,17 +106,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2016 * *> \ingroup complex16PTcomputational * * ===================================================================== SUBROUTINE ZPTTS2( IUPLO, N, NRHS, D, E, B, LDB ) * -* -- LAPACK computational routine (version 3.4.2) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2016 * * .. Scalar Arguments .. INTEGER IUPLO, LDB, N, NRHS diff --git a/lapack-netlib/SRC/zstegr.f b/lapack-netlib/SRC/zstegr.f index 16a4e789..b68a4c44 100644 --- a/lapack-netlib/SRC/zstegr.f +++ b/lapack-netlib/SRC/zstegr.f @@ -48,7 +48,7 @@ *> either an interval (VL,VU] or a range of indices IL:IU for the desired *> eigenvalues. *> -*> ZSTEGR is a compatability wrapper around the improved ZSTEMR routine. +*> ZSTEGR is a compatibility wrapper around the improved ZSTEMR routine. *> See DSTEMR for further details. *> *> One important change is that the ABSTOL parameter no longer provides any @@ -105,13 +105,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -119,14 +123,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -240,7 +249,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -256,10 +265,10 @@ $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/zstemr.f b/lapack-netlib/SRC/zstemr.f index cc815666..0de08527 100644 --- a/lapack-netlib/SRC/zstemr.f +++ b/lapack-netlib/SRC/zstemr.f @@ -153,13 +153,17 @@ *> \param[in] VL *> \verbatim *> VL is DOUBLE PRECISION +*> +*> If RANGE='V', the lower bound of the interval to +*> be searched for eigenvalues. VL < VU. +*> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim *> *> \param[in] VU *> \verbatim *> VU is DOUBLE PRECISION *> -*> If RANGE='V', the lower and upper bounds of the interval to +*> If RANGE='V', the upper bound of the interval to *> be searched for eigenvalues. VL < VU. *> Not referenced if RANGE = 'A' or 'I'. *> \endverbatim @@ -167,14 +171,19 @@ *> \param[in] IL *> \verbatim *> IL is INTEGER +*> +*> If RANGE='I', the index of the +*> smallest eigenvalue to be returned. +*> 1 <= IL <= IU <= N, if N > 0. +*> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim *> *> \param[in] IU *> \verbatim *> IU is INTEGER *> -*> If RANGE='I', the indices (in ascending order) of the -*> smallest and largest eigenvalues to be returned. +*> If RANGE='I', the index of the +*> largest eigenvalue to be returned. *> 1 <= IL <= IU <= N, if N > 0. *> Not referenced if RANGE = 'A' or 'V'. *> \endverbatim @@ -311,7 +320,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -329,10 +338,10 @@ $ M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, $ IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER JOBZ, RANGE diff --git a/lapack-netlib/SRC/zsytrf_rook.f b/lapack-netlib/SRC/zsytrf_rook.f index f5d3e51b..9ba446ab 100644 --- a/lapack-netlib/SRC/zsytrf_rook.f +++ b/lapack-netlib/SRC/zsytrf_rook.f @@ -146,7 +146,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16SYcomputational * @@ -195,7 +195,7 @@ *> *> \verbatim *> -*> November 2015, Igor Kozachenko, +*> June 2016, Igor Kozachenko, *> Computer Science Division, *> University of California, Berkeley *> @@ -208,10 +208,10 @@ * ===================================================================== SUBROUTINE ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO @@ -261,7 +261,7 @@ * Determine the block size * NB = ILAENV( 1, 'ZSYTRF_ROOK', UPLO, N, -1, -1, -1 ) - LWKOPT = N*NB + LWKOPT = MAX( 1, N*NB ) WORK( 1 ) = LWKOPT END IF * diff --git a/lapack-netlib/SRC/zsytrs2.f b/lapack-netlib/SRC/zsytrs2.f index 6321197f..890c07a9 100644 --- a/lapack-netlib/SRC/zsytrs2.f +++ b/lapack-netlib/SRC/zsytrs2.f @@ -106,7 +106,7 @@ *> *> \param[out] WORK *> \verbatim -*> WORK is REAL array, dimension (N) +*> WORK is COMPLEX*16 array, dimension (N) *> \endverbatim *> *> \param[out] INFO @@ -124,7 +124,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2015 +*> \date June 2016 * *> \ingroup complex16SYcomputational * @@ -132,10 +132,10 @@ SUBROUTINE ZSYTRS2( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, $ WORK, INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2015 +* June 2016 * * .. Scalar Arguments .. CHARACTER UPLO diff --git a/lapack-netlib/SRC/ztgsen.f b/lapack-netlib/SRC/ztgsen.f index 4c991ec4..87e0f99a 100644 --- a/lapack-netlib/SRC/ztgsen.f +++ b/lapack-netlib/SRC/ztgsen.f @@ -290,7 +290,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date June 2016 * *> \ingroup complex16OTHERcomputational * @@ -433,10 +433,10 @@ $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* June 2016 * * .. Scalar Arguments .. LOGICAL WANTQ, WANTZ @@ -518,6 +518,7 @@ * subspaces. * M = 0 + IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN DO 10 K = 1, N ALPHA( K ) = A( K, K ) BETA( K ) = B( K, K ) @@ -529,6 +530,7 @@ $ M = M + 1 END IF 10 CONTINUE + END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN LWMIN = MAX( 1, 2*M*( N-M ) ) diff --git a/lapack-netlib/SRC/ztrevc3.f b/lapack-netlib/SRC/ztrevc3.f new file mode 100644 index 00000000..22654856 --- /dev/null +++ b/lapack-netlib/SRC/ztrevc3.f @@ -0,0 +1,630 @@ +*> \brief \b ZTREVC3 +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +*> \htmlonly +*> Download ZTREVC3 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> +*> [TXT] +*> \endhtmlonly +* +* Definition: +* =========== +* +* SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, +* VR, LDVR, MM, M, WORK, LWORK, RWORK, INFO ) +* +* .. Scalar Arguments .. +* CHARACTER HOWMNY, SIDE +* INTEGER INFO, LDT, LDVL, LDVR, LWORK, M, MM, N +* .. +* .. Array Arguments .. +* LOGICAL SELECT( * ) +* DOUBLE PRECISION RWORK( * ) +* COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), +* $ WORK( * ) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> ZTREVC3 computes some or all of the right and/or left eigenvectors of +*> a complex upper triangular matrix T. +*> Matrices of this type are produced by the Schur factorization of +*> a complex general matrix: A = Q*T*Q**H, as computed by ZHSEQR. +*> +*> The right eigenvector x and the left eigenvector y of T corresponding +*> to an eigenvalue w are defined by: +*> +*> T*x = w*x, (y**H)*T = w*(y**H) +*> +*> where y**H denotes the conjugate transpose of the vector y. +*> The eigenvalues are not input to this routine, but are read directly +*> from the diagonal of T. +*> +*> This routine returns the matrices X and/or Y of right and left +*> eigenvectors of T, or the products Q*X and/or Q*Y, where Q is an +*> input matrix. If Q is the unitary factor that reduces a matrix A to +*> Schur form T, then Q*X and Q*Y are the matrices of right and left +*> eigenvectors of A. +*> +*> This uses a Level 3 BLAS version of the back transformation. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] SIDE +*> \verbatim +*> SIDE is CHARACTER*1 +*> = 'R': compute right eigenvectors only; +*> = 'L': compute left eigenvectors only; +*> = 'B': compute both right and left eigenvectors. +*> \endverbatim +*> +*> \param[in] HOWMNY +*> \verbatim +*> HOWMNY is CHARACTER*1 +*> = 'A': compute all right and/or left eigenvectors; +*> = 'B': compute all right and/or left eigenvectors, +*> backtransformed using the matrices supplied in +*> VR and/or VL; +*> = 'S': compute selected right and/or left eigenvectors, +*> as indicated by the logical array SELECT. +*> \endverbatim +*> +*> \param[in] SELECT +*> \verbatim +*> SELECT is LOGICAL array, dimension (N) +*> If HOWMNY = 'S', SELECT specifies the eigenvectors to be +*> computed. +*> The eigenvector corresponding to the j-th eigenvalue is +*> computed if SELECT(j) = .TRUE.. +*> Not referenced if HOWMNY = 'A' or 'B'. +*> \endverbatim +*> +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> The order of the matrix T. N >= 0. +*> \endverbatim +*> +*> \param[in,out] T +*> \verbatim +*> T is COMPLEX*16 array, dimension (LDT,N) +*> The upper triangular matrix T. T is modified, but restored +*> on exit. +*> \endverbatim +*> +*> \param[in] LDT +*> \verbatim +*> LDT is INTEGER +*> The leading dimension of the array T. LDT >= max(1,N). +*> \endverbatim +*> +*> \param[in,out] VL +*> \verbatim +*> VL is COMPLEX*16 array, dimension (LDVL,MM) +*> On entry, if SIDE = 'L' or 'B' and HOWMNY = 'B', VL must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by ZHSEQR). +*> On exit, if SIDE = 'L' or 'B', VL contains: +*> if HOWMNY = 'A', the matrix Y of left eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*Y; +*> if HOWMNY = 'S', the left eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VL, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'R'. +*> \endverbatim +*> +*> \param[in] LDVL +*> \verbatim +*> LDVL is INTEGER +*> The leading dimension of the array VL. +*> LDVL >= 1, and if SIDE = 'L' or 'B', LDVL >= N. +*> \endverbatim +*> +*> \param[in,out] VR +*> \verbatim +*> VR is COMPLEX*16 array, dimension (LDVR,MM) +*> On entry, if SIDE = 'R' or 'B' and HOWMNY = 'B', VR must +*> contain an N-by-N matrix Q (usually the unitary matrix Q of +*> Schur vectors returned by ZHSEQR). +*> On exit, if SIDE = 'R' or 'B', VR contains: +*> if HOWMNY = 'A', the matrix X of right eigenvectors of T; +*> if HOWMNY = 'B', the matrix Q*X; +*> if HOWMNY = 'S', the right eigenvectors of T specified by +*> SELECT, stored consecutively in the columns +*> of VR, in the same order as their +*> eigenvalues. +*> Not referenced if SIDE = 'L'. +*> \endverbatim +*> +*> \param[in] LDVR +*> \verbatim +*> LDVR is INTEGER +*> The leading dimension of the array VR. +*> LDVR >= 1, and if SIDE = 'R' or 'B', LDVR >= N. +*> \endverbatim +*> +*> \param[in] MM +*> \verbatim +*> MM is INTEGER +*> The number of columns in the arrays VL and/or VR. MM >= M. +*> \endverbatim +*> +*> \param[out] M +*> \verbatim +*> M is INTEGER +*> The number of columns in the arrays VL and/or VR actually +*> used to store the eigenvectors. +*> If HOWMNY = 'A' or 'B', M is set to N. +*> Each selected eigenvector occupies one column. +*> \endverbatim +*> +*> \param[out] WORK +*> \verbatim +*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> \endverbatim +*> +*> \param[in] LWORK +*> \verbatim +*> LWORK is INTEGER +*> The dimension of array WORK. LWORK >= max(1,2*N). +*> For optimum performance, LWORK >= N + 2*N*NB, where NB is +*> the optimal blocksize. +*> +*> 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] RWORK +*> \verbatim +*> RWORK is DOUBLE PRECISION array, dimension (LRWORK) +*> \endverbatim +*> +*> \param[in] LRWORK +*> \verbatim +*> LRWORK is INTEGER +*> The dimension of array RWORK. LRWORK >= max(1,N). +*> +*> If LRWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of the RWORK array, returns +*> this value as the first entry of the RWORK array, and no error +*> message related to LRWORK 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 2011 +* +* @precisions fortran z -> c +* +*> \ingroup complex16OTHERcomputational +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> The algorithm used in this program is basically backward (forward) +*> substitution, with scaling to make the the code robust against +*> possible overflow. +*> +*> Each eigenvector is normalized so that the element of largest +*> magnitude has magnitude 1; here the magnitude of a complex number +*> (x,y) is taken to be |x| + |y|. +*> \endverbatim +*> +* ===================================================================== + SUBROUTINE ZTREVC3( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, + $ LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO) + IMPLICIT NONE +* +* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* November 2011 +* +* .. Scalar Arguments .. + CHARACTER HOWMNY, SIDE + INTEGER INFO, LDT, LDVL, LDVR, LWORK, LRWORK, M, MM, N +* .. +* .. Array Arguments .. + LOGICAL SELECT( * ) + DOUBLE PRECISION RWORK( * ) + COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ), + $ WORK( * ) +* .. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO, ONE + PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) + COMPLEX*16 CZERO, CONE + PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), + $ CONE = ( 1.0D+0, 0.0D+0 ) ) + INTEGER NBMIN, NBMAX + PARAMETER ( NBMIN = 8, NBMAX = 128 ) +* .. +* .. Local Scalars .. + LOGICAL ALLV, BOTHV, LEFTV, LQUERY, OVER, RIGHTV, SOMEV + INTEGER I, II, IS, J, K, KI, IV, MAXWRK, NB + DOUBLE PRECISION OVFL, REMAX, SCALE, SMIN, SMLNUM, ULP, UNFL + COMPLEX*16 CDUM +* .. +* .. External Functions .. + LOGICAL LSAME + INTEGER ILAENV, IZAMAX + DOUBLE PRECISION DLAMCH, DZASUM + EXTERNAL LSAME, ILAENV, IZAMAX, DLAMCH, DZASUM +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZLATRS +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS, DBLE, DCMPLX, CONJG, AIMAG, MAX +* .. +* .. Statement Functions .. + DOUBLE PRECISION CABS1 +* .. +* .. Statement Function definitions .. + CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( AIMAG( CDUM ) ) +* .. +* .. Executable Statements .. +* +* Decode and test the input parameters +* + BOTHV = LSAME( SIDE, 'B' ) + RIGHTV = LSAME( SIDE, 'R' ) .OR. BOTHV + LEFTV = LSAME( SIDE, 'L' ) .OR. BOTHV +* + ALLV = LSAME( HOWMNY, 'A' ) + OVER = LSAME( HOWMNY, 'B' ) + SOMEV = LSAME( HOWMNY, 'S' ) +* +* Set M to the number of columns required to store the selected +* eigenvectors. +* + IF( SOMEV ) THEN + M = 0 + DO 10 J = 1, N + IF( SELECT( J ) ) + $ M = M + 1 + 10 CONTINUE + ELSE + M = N + END IF +* + INFO = 0 + NB = ILAENV( 1, 'ZTREVC', SIDE // HOWMNY, N, -1, -1, -1 ) + MAXWRK = N + 2*N*NB + WORK(1) = MAXWRK + RWORK(1) = N + LQUERY = ( LWORK.EQ.-1 .OR. LRWORK.EQ.-1 ) + IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN + INFO = -1 + ELSE IF( .NOT.ALLV .AND. .NOT.OVER .AND. .NOT.SOMEV ) THEN + INFO = -2 + ELSE IF( N.LT.0 ) THEN + INFO = -4 + ELSE IF( LDT.LT.MAX( 1, N ) ) THEN + INFO = -6 + ELSE IF( LDVL.LT.1 .OR. ( LEFTV .AND. LDVL.LT.N ) ) THEN + INFO = -8 + ELSE IF( LDVR.LT.1 .OR. ( RIGHTV .AND. LDVR.LT.N ) ) THEN + INFO = -10 + ELSE IF( MM.LT.M ) THEN + INFO = -11 + ELSE IF( LWORK.LT.MAX( 1, 2*N ) .AND. .NOT.LQUERY ) THEN + INFO = -14 + ELSE IF ( LRWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN + INFO = -16 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZTREVC3', -INFO ) + RETURN + ELSE IF( LQUERY ) THEN + RETURN + END IF +* +* Quick return if possible. +* + IF( N.EQ.0 ) + $ RETURN +* +* Use blocked version of back-transformation if sufficient workspace. +* Zero-out the workspace to avoid potential NaN propagation. +* + IF( OVER .AND. LWORK .GE. N + 2*N*NBMIN ) THEN + NB = (LWORK - N) / (2*N) + NB = MIN( NB, NBMAX ) + CALL ZLASET( 'F', N, 1+2*NB, CZERO, CZERO, WORK, N ) + ELSE + NB = 1 + END IF +* +* Set the constants to control overflow. +* + UNFL = DLAMCH( 'Safe minimum' ) + OVFL = ONE / UNFL + CALL DLABAD( UNFL, OVFL ) + ULP = DLAMCH( 'Precision' ) + SMLNUM = UNFL*( N / ULP ) +* +* Store the diagonal elements of T in working array WORK. +* + DO 20 I = 1, N + WORK( I ) = T( I, I ) + 20 CONTINUE +* +* Compute 1-norm of each column of strictly upper triangular +* part of T to control overflow in triangular solver. +* + RWORK( 1 ) = ZERO + DO 30 J = 2, N + RWORK( J ) = DZASUM( J-1, T( 1, J ), 1 ) + 30 CONTINUE +* + IF( RIGHTV ) THEN +* +* ============================================================ +* Compute right eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=NB=1; +* blocked version starts with IV=NB, goes down to 1. +* (Note the "0-th" column is used to store the original diagonal.) + IV = NB + IS = M + DO 80 KI = N, 1, -1 + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 80 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex right eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 40 K = 1, KI - 1 + WORK( K + IV*N ) = -T( K, KI ) + 40 CONTINUE +* +* Solve upper triangular system: +* [ T(1:KI-1,1:KI-1) - T(KI,KI) ]*X = SCALE*WORK. +* + DO 50 K = 1, KI - 1 + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 50 CONTINUE +* + IF( KI.GT.1 ) THEN + CALL ZLATRS( 'Upper', 'No transpose', 'Non-unit', 'Y', + $ KI-1, T, LDT, WORK( 1 + IV*N ), SCALE, + $ RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VR and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VR and normalize. + CALL ZCOPY( KI, WORK( 1 + IV*N ), 1, VR( 1, IS ), 1 ) +* + II = IZAMAX( KI, VR( 1, IS ), 1 ) + REMAX = ONE / CABS1( VR( II, IS ) ) + CALL ZDSCAL( KI, REMAX, VR( 1, IS ), 1 ) +* + DO 60 K = KI + 1, N + VR( K, IS ) = CZERO + 60 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.GT.1 ) + $ CALL ZGEMV( 'N', N, KI-1, CONE, VR, LDVR, + $ WORK( 1 + IV*N ), 1, DCMPLX( SCALE ), + $ VR( 1, KI ), 1 ) +* + II = IZAMAX( N, VR( 1, KI ), 1 ) + REMAX = ONE / CABS1( VR( II, KI ) ) + CALL ZDSCAL( N, REMAX, VR( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out below vector + DO K = KI + 1, N + WORK( K + IV*N ) = CZERO + END DO +* +* Columns IV:NB of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.1) .OR. (KI.EQ.1) ) THEN + CALL ZGEMM( 'N', 'N', N, NB-IV+1, KI+NB-IV, CONE, + $ VR, LDVR, + $ WORK( 1 + (IV)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+IV)*N ), N ) +* normalize vectors + DO K = IV, NB + II = IZAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL ZDSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL ZLACPY( 'F', N, NB-IV+1, + $ WORK( 1 + (NB+IV)*N ), N, + $ VR( 1, KI ), LDVR ) + IV = NB + ELSE + IV = IV - 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 70 K = 1, KI - 1 + T( K, K ) = WORK( K ) + 70 CONTINUE +* + IS = IS - 1 + 80 CONTINUE + END IF +* + IF( LEFTV ) THEN +* +* ============================================================ +* Compute left eigenvectors. +* +* IV is index of column in current block. +* Non-blocked version always uses IV=1; +* blocked version starts with IV=1, goes up to NB. +* (Note the "0-th" column is used to store the original diagonal.) + IV = 1 + IS = 1 + DO 130 KI = 1, N +* + IF( SOMEV ) THEN + IF( .NOT.SELECT( KI ) ) + $ GO TO 130 + END IF + SMIN = MAX( ULP*( CABS1( T( KI, KI ) ) ), SMLNUM ) +* +* -------------------------------------------------------- +* Complex left eigenvector +* + WORK( KI + IV*N ) = CONE +* +* Form right-hand side. +* + DO 90 K = KI + 1, N + WORK( K + IV*N ) = -CONJG( T( KI, K ) ) + 90 CONTINUE +* +* Solve conjugate-transposed triangular system: +* [ T(KI+1:N,KI+1:N) - T(KI,KI) ]**H * X = SCALE*WORK. +* + DO 100 K = KI + 1, N + T( K, K ) = T( K, K ) - T( KI, KI ) + IF( CABS1( T( K, K ) ).LT.SMIN ) + $ T( K, K ) = SMIN + 100 CONTINUE +* + IF( KI.LT.N ) THEN + CALL ZLATRS( 'Upper', 'Conjugate transpose', 'Non-unit', + $ 'Y', N-KI, T( KI+1, KI+1 ), LDT, + $ WORK( KI+1 + IV*N ), SCALE, RWORK, INFO ) + WORK( KI + IV*N ) = SCALE + END IF +* +* Copy the vector x or Q*x to VL and normalize. +* + IF( .NOT.OVER ) THEN +* ------------------------------ +* no back-transform: copy x to VL and normalize. + CALL ZCOPY( N-KI+1, WORK( KI + IV*N ), 1, VL(KI,IS), 1 ) +* + II = IZAMAX( N-KI+1, VL( KI, IS ), 1 ) + KI - 1 + REMAX = ONE / CABS1( VL( II, IS ) ) + CALL ZDSCAL( N-KI+1, REMAX, VL( KI, IS ), 1 ) +* + DO 110 K = 1, KI - 1 + VL( K, IS ) = CZERO + 110 CONTINUE +* + ELSE IF( NB.EQ.1 ) THEN +* ------------------------------ +* version 1: back-transform each vector with GEMV, Q*x. + IF( KI.LT.N ) + $ CALL ZGEMV( 'N', N, N-KI, CONE, VL( 1, KI+1 ), LDVL, + $ WORK( KI+1 + IV*N ), 1, DCMPLX( SCALE ), + $ VL( 1, KI ), 1 ) +* + II = IZAMAX( N, VL( 1, KI ), 1 ) + REMAX = ONE / CABS1( VL( II, KI ) ) + CALL ZDSCAL( N, REMAX, VL( 1, KI ), 1 ) +* + ELSE +* ------------------------------ +* version 2: back-transform block of vectors with GEMM +* zero out above vector +* could go from KI-NV+1 to KI-1 + DO K = 1, KI - 1 + WORK( K + IV*N ) = CZERO + END DO +* +* Columns 1:IV of work are valid vectors. +* When the number of vectors stored reaches NB, +* or if this was last vector, do the GEMM + IF( (IV.EQ.NB) .OR. (KI.EQ.N) ) THEN + CALL ZGEMM( 'N', 'N', N, IV, N-KI+IV, ONE, + $ VL( 1, KI-IV+1 ), LDVL, + $ WORK( KI-IV+1 + (1)*N ), N, + $ CZERO, + $ WORK( 1 + (NB+1)*N ), N ) +* normalize vectors + DO K = 1, IV + II = IZAMAX( N, WORK( 1 + (NB+K)*N ), 1 ) + REMAX = ONE / CABS1( WORK( II + (NB+K)*N ) ) + CALL ZDSCAL( N, REMAX, WORK( 1 + (NB+K)*N ), 1 ) + END DO + CALL ZLACPY( 'F', N, IV, + $ WORK( 1 + (NB+1)*N ), N, + $ VL( 1, KI-IV+1 ), LDVL ) + IV = 1 + ELSE + IV = IV + 1 + END IF + END IF +* +* Restore the original diagonal elements of T. +* + DO 120 K = KI + 1, N + T( K, K ) = WORK( K ) + 120 CONTINUE +* + IS = IS + 1 + 130 CONTINUE + END IF +* + RETURN +* +* End of ZTREVC3 +* + END diff --git a/lapack-netlib/SRC/zunbdb1.f b/lapack-netlib/SRC/zunbdb1.f index 4125450c..02375224 100644 --- a/lapack-netlib/SRC/zunbdb1.f +++ b/lapack-netlib/SRC/zunbdb1.f @@ -203,7 +203,7 @@ SUBROUTINE ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -308,9 +308,8 @@ CALL ZLARF( 'R', M-P-I, Q-I, X21(I,I+1), LDX21, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I, X21(I,I+1), LDX21 ) - C = SQRT( DZNRM2( P-I, X11(I+1,I+1), 1, X11(I+1,I+1), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I+1), 1, X21(I+1,I+1), - $ 1 )**2 ) + C = SQRT( DZNRM2( P-I, X11(I+1,I+1), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I+1), 1 )**2 ) PHI(I) = ATAN2( S, C ) CALL ZUNBDB5( P-I, M-P-I, Q-I-1, X11(I+1,I+1), 1, $ X21(I+1,I+1), 1, X11(I+1,I+2), LDX11, diff --git a/lapack-netlib/SRC/zunbdb2.f b/lapack-netlib/SRC/zunbdb2.f index 89104f65..65508ec1 100644 --- a/lapack-netlib/SRC/zunbdb2.f +++ b/lapack-netlib/SRC/zunbdb2.f @@ -201,7 +201,7 @@ SUBROUTINE ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -295,8 +295,8 @@ CALL ZLARF( 'R', M-P-I+1, Q-I+1, X11(I,I), LDX11, TAUQ1(I), $ X21(I,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X11(I,I), LDX11 ) - S = SQRT( DZNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DZNRM2( M-P-I+1, X21(I,I), 1, X21(I,I), 1 )**2 ) + S = SQRT( DZNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DZNRM2( M-P-I+1, X21(I,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL ZUNBDB5( P-I, M-P-I+1, Q-I, X11(I+1,I), 1, X21(I,I), 1, diff --git a/lapack-netlib/SRC/zunbdb3.f b/lapack-netlib/SRC/zunbdb3.f index 37a5c89f..c1336c48 100644 --- a/lapack-netlib/SRC/zunbdb3.f +++ b/lapack-netlib/SRC/zunbdb3.f @@ -201,7 +201,7 @@ SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, $ TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -295,8 +295,8 @@ CALL ZLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I), $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) - C = SQRT( DZNRM2( P-I+1, X11(I,I), 1, X11(I,I), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 ) + C = SQRT( DZNRM2( P-I+1, X11(I,I), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I), 1 )**2 ) THETA(I) = ATAN2( S, C ) * CALL ZUNBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1, diff --git a/lapack-netlib/SRC/zunbdb4.f b/lapack-netlib/SRC/zunbdb4.f index 91ed9d05..17f529ee 100644 --- a/lapack-netlib/SRC/zunbdb4.f +++ b/lapack-netlib/SRC/zunbdb4.f @@ -213,7 +213,7 @@ $ TAUP1, TAUP2, TAUQ1, PHANTOM, WORK, LWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.5.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -344,9 +344,8 @@ $ X21(I+1,I), LDX21, WORK(ILARF) ) CALL ZLACGV( Q-I+1, X21(I,I), LDX21 ) IF( I .LT. M-Q ) THEN - S = SQRT( DZNRM2( P-I, X11(I+1,I), 1, X11(I+1,I), - $ 1 )**2 + DZNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), - $ 1 )**2 ) + S = SQRT( DZNRM2( P-I, X11(I+1,I), 1 )**2 + $ + DZNRM2( M-P-I, X21(I+1,I), 1 )**2 ) PHI(I) = ATAN2( S, C ) END IF * diff --git a/lapack-netlib/SRC/zuncsd2by1.f b/lapack-netlib/SRC/zuncsd2by1.f index 432471fe..d4ab1eef 100644 --- a/lapack-netlib/SRC/zuncsd2by1.f +++ b/lapack-netlib/SRC/zuncsd2by1.f @@ -253,7 +253,7 @@ $ LDV1T, WORK, LWORK, RWORK, LRWORK, IWORK, $ INFO ) * -* -- LAPACK computational routine (version 3.6.0) -- +* -- LAPACK computational routine (version 3.6.1) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * July 2012 @@ -287,6 +287,10 @@ $ LWORKMIN, LWORKOPT, R LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. +* .. Local Arrays .. + DOUBLE PRECISION DUM( 1 ) + COMPLEX*16 CDUM( 1, 1 ) +* .. * .. External Subroutines .. EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, ZUNBDB1, $ ZUNBDB2, ZUNBDB3, ZUNBDB4, ZUNGLQ, ZUNGQR, @@ -319,11 +323,11 @@ INFO = -8 ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN INFO = -10 - ELSE IF( WANTU1 .AND. LDU1 .LT. P ) THEN + ELSE IF( WANTU1 .AND. LDU1 .LT. MAX( 1, P ) ) THEN INFO = -13 - ELSE IF( WANTU2 .AND. LDU2 .LT. M - P ) THEN + ELSE IF( WANTU2 .AND. LDU2 .LT. MAX( 1, M - P ) ) THEN INFO = -15 - ELSE IF( WANTV1T .AND. LDV1T .LT. Q ) THEN + ELSE IF( WANTV1T .AND. LDV1T .LT. MAX( 1, Q ) ) THEN INFO = -17 END IF * @@ -379,99 +383,118 @@ IORBDB = ITAUQ1 + MAX( 1, Q ) IORGQR = ITAUQ1 + MAX( 1, Q ) IORGLQ = ITAUQ1 + MAX( 1, Q ) + LORGQRMIN = 1 + LORGQROPT = 1 + LORGLQMIN = 1 + LORGLQOPT = 1 IF( R .EQ. Q ) THEN - CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK, -1, CHILDINFO ) + CALL ZUNBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK, -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + ENDIF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, + $ CDUM, WORK(1), -1, CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q-1 ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( MAX(0,Q-1), MAX(0,Q-1), MAX(0,Q-1), V1T, LDV1T, - $ 0, WORK(1), -1, CHILDINFO ) - LORGLQMIN = MAX( 1, Q-1 ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ 0, U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, 1, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. P ) THEN - CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P-1 .GE. M-P ) THEN - CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, 0, WORK(1), + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P-1, P-1, P-1, U1(2,2), LDU1, CDUM, WORK(1), $ -1, CHILDINFO ) - LORGQRMIN = MAX( 1, P-1 ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, Q, U2, LDU2, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ 0, V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, 0, 0, - $ 0, 0, 0, 0, 0, 0, RWORK(1), -1, CHILDINFO ) + $ DUM, V1T, LDV1T, CDUM, 1, U1, LDU1, U2, LDU2, + $ DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE IF( R .EQ. M-P ) THEN - CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) - IF( P .GE. M-P-1 ) THEN - CALL ZUNGQR( P, P, Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, 0, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, CDUM, $ WORK(1), -1, CHILDINFO ) - LORGQRMIN = MAX( 1, M-P-1 ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, R, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, 0, 0, 1, V1T, LDV1T, U2, LDU2, U1, LDU1, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, CDUM, 1, V1T, LDV1T, U2, LDU2, U1, + $ LDU1, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) ELSE - CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, 0, 0, - $ 0, 0, 0, WORK(1), -1, CHILDINFO ) + CALL ZUNBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, DUM, + $ CDUM, CDUM, CDUM, CDUM, WORK(1), -1, CHILDINFO + $ ) LORBDB = M + INT( WORK(1) ) - IF( P .GE. M-P ) THEN - CALL ZUNGQR( P, P, M-Q, U1, LDU1, 0, WORK(1), -1, + IF( WANTU1 .AND. P .GT. 0 ) THEN + CALL ZUNGQR( P, P, M-Q, U1, LDU1, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, P ) - LORGQROPT = INT( WORK(1) ) - ELSE - CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, 0, WORK(1), -1, + LORGQRMIN = MAX( LORGQRMIN, P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTU2 .AND. M-P .GT. 0 ) THEN + CALL ZUNGQR( M-P, M-P, M-Q, U2, LDU2, CDUM, WORK(1), -1, $ CHILDINFO ) - LORGQRMIN = MAX( 1, M-P ) - LORGQROPT = INT( WORK(1) ) + LORGQRMIN = MAX( LORGQRMIN, M-P ) + LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) + END IF + IF( WANTV1T .AND. Q .GT. 0 ) THEN + CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, CDUM, WORK(1), -1, + $ CHILDINFO ) + LORGLQMIN = MAX( LORGLQMIN, Q ) + LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF - CALL ZUNGLQ( Q, Q, Q, V1T, LDV1T, 0, WORK(1), -1, - $ CHILDINFO ) - LORGLQMIN = MAX( 1, Q ) - LORGLQOPT = INT( WORK(1) ) CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, 0, U2, LDU2, U1, LDU1, 0, 1, V1T, LDV1T, - $ 0, 0, 0, 0, 0, 0, 0, 0, RWORK(1), -1, - $ CHILDINFO ) + $ THETA, DUM, U2, LDU2, U1, LDU1, CDUM, 1, V1T, + $ LDV1T, DUM, DUM, DUM, DUM, DUM, DUM, DUM, DUM, + $ RWORK(1), -1, CHILDINFO ) LBBCSD = INT( RWORK(1) ) END IF LRWORKMIN = IBBCSD+LBBCSD-1 @@ -537,8 +560,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, 0, 1, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, CDUM, + $ 1, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -591,8 +614,8 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ RWORK(IPHI), V1T, LDV1T, 0, 1, U1, LDU1, U2, LDU2, - $ RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), + $ RWORK(IPHI), V1T, LDV1T, CDUM, 1, U1, LDU1, U2, + $ LDU2, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -646,7 +669,7 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, RWORK(IPHI), 0, 1, V1T, LDV1T, U2, LDU2, + $ THETA, RWORK(IPHI), CDUM, 1, V1T, LDV1T, U2, LDU2, $ U1, LDU1, RWORK(IB11D), RWORK(IB11E), $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), @@ -715,11 +738,11 @@ * Simultaneously diagonalize X11 and X21. * CALL ZBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, 0, 1, V1T, - $ LDV1T, RWORK(IB11D), RWORK(IB11E), RWORK(IB12D), - $ RWORK(IB12E), RWORK(IB21D), RWORK(IB21E), - $ RWORK(IB22D), RWORK(IB22E), RWORK(IBBCSD), LBBCSD, - $ CHILDINFO ) + $ THETA, RWORK(IPHI), U2, LDU2, U1, LDU1, CDUM, 1, + $ V1T, LDV1T, RWORK(IB11D), RWORK(IB11E), + $ RWORK(IB12D), RWORK(IB12E), RWORK(IB21D), + $ RWORK(IB21E), RWORK(IB22D), RWORK(IB22E), + $ RWORK(IBBCSD), LBBCSD, CHILDINFO ) * * Permute rows and columns to place identity submatrices in * preferred positions -- 2.34.1