diff --git a/lapack-netlib/SRC/CMakeLists.txt b/lapack-netlib/SRC/CMakeLists.txt
index 03441b942..4857f4747 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 22799769a..bb2d9562c 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 2d619cde1..a2d1a1339 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 0e2875fe8..f93413be4 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 fc7349691..31caebe61 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 81157717a..4d3c459a7 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 0f48322a8..7d19c0228 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 539a7b95f..7ad229e72 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 4b3e90565..bee18fdf8 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 2d0905358..6cb4026a4 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 a5b55c1d3..9bcb82d71 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 7f16b63b6..986619c6c 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 3c1f825db..d147dee53 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 235426ad4..1e32637c6 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 69d77048b..28f3eb305 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 99eb69d92..021ec6724 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 9e985d0e2..d761806eb 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 9103ccf1c..876a26df9 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 decdae509..f34b8f2c4 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 112b41a17..a9468a24b 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 36fe9913b..feee3644f 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 79ffde623..66074bdb1 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 f4b1fc156..ca71a4eae 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 d9a22e350..47dd8069e 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 e57bd9375..64dd1f6de 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 5e28cc88f..43ae794d5 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 18dfe4313..9b8ffb4e3 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 12f69ccc9..f41479bd1 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 33a4e5f4a..52fb983d2 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 98c8dbd26..0217150d1 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 024354e66..15aaaa44d 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 e7bd2c4f4..e6bf245e0 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 ee100984c..cc4b296bc 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 b74156dbc..074ca90a3 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 dc05aedc9..9326299c7 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 94db81439..4ac5abec8 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 8e2b98371..01e07a148 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 607752ada..d60cfe622 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 c1441393c..a42ee6817 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 53e0e3c42..f3ee410ba 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 fc412c4da..22e55def5 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 30a920437..63038ec2d 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 ecedfa4d2..31f374cb8 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 ada9535c3..77876771f 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 a5ab897ba..776d6cd32 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 f45f85e18..01fbe6980 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 11f0dfd9b..ff56cdeb8 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 6ab06a637..dfd06fa9e 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 4214dd11d..68f650e02 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 379ca4956..c545b8fec 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 6e1eae055..aaecf36dd 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 29734964b..90f050ad7 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 fab048162..139569f9b 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 d2ba8de8a..3de430bf1 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 000000000..00d3b9464
--- /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 b1086b6fe..95a24ea68 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 fea26b21a..7d36547da 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 cec00f93c..6571befde 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 5451ef003..05eab91be 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 bc948a30f..ce3a86605 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 ca3922da4..09c9b305a 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 1b2b0fb2a..54b774b88 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 2c54d1c5d..962071cf7 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 2c572f12c..a5af1b0fa 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 7ceb9392c..89a8aab41 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 c96c62338..e50ef67b2 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 2a3e963fd..67e084877 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 328eaa39c..eb043d95a 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 81f30f936..3067f346d 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 4b26a1d68..fc91ab51d 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 c5f57a29f..42453dbf1 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 54e2652e4..02beb3be5 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 898570b66..0c40673a4 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 cfa2ff05d..accf2594e 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 3cd7eeb2b..3f6be168d 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 b1871b5dd..30aa42d68 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 812df3f23..034e94389 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 b32ba0fe6..a0620d65f 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 bf6e414d7..e5b02fc7f 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 c37c1d210..b4e018364 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 658ece9a0..babd57be3 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 a941b940b..1e3366c9b 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 7126053e8..8e9d37bd1 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 aac01a49f..103cd366f 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 37ce6f6b0..b28df32aa 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 f093563e9..9a6f7f795 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 65cdbe96e..00add6f9d 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 e7eea10c6..d8e9c8459 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 f054caa8c..afec65c99 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 828661f2c..0628d49ed 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 81f5aa813..acd577833 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 9b9b33c0c..13c176ce3 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 8cd9dd72c..f9b3b8a15 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 7b66d90b2..cf7ae9089 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 a5238b919..d562cc53e 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 6beef32ac..94cc1141d 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 4506e19f2..3ae35ad11 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 97d9bdeba..45361b2cb 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 f5d0e6cd1..fca457efc 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 a4b103053..0af00d39d 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 be70313bb..5eba2843b 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 b5675f71d..8d616bc1b 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 3cf82cf40..554cc2ff6 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 03be504fa..003c4402d 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 8c7236054..a8fe7435d 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 19dedbe8d..dd0cd351c 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 39517fb93..fc8836f79 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 fe8d62873..a259ad78e 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 fc06677da..2db4ac346 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 64e2c1686..99eb122c8 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 35a96b2b8..4f9e8d46f 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 9eb91f7a1..e87ad5fce 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 bb72199ba..f7573dd3c 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 01bea27c3..25d271206 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 298e1c766..a56f90631 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 8967c18fc..60884672f 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 941ec97f3..dd40cf99c 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 cda9de16c..0cdfe9992 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 08f363613..c78fb156d 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 cb990e50d..52c847779 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 0ed770637..13ab094db 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 81264872a..a7f405378 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 09a87fe3d..9d1205b77 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 82b17626f..14719e4fd 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 000000000..ba5abb5f5
--- /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 89a4468ff..b963ad738 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 c882d03f5..0da02707e 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 46b87c7ee..d2cd707fb 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 261aa1c21..b31cc0bf0 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 752640700..6b5c3c419 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 d1effd9e3..d94b88516 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 a154c3d6e..234ea170e 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 fe98b450e..1deb4d5f7 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 667de0afe..9f21d1fc5 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 821c080cd..db20e8bee 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 55bb59e12..7d80d4ec0 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 86a43f67d..a0e1c2c18 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 1bc7e8a4e..cae699394 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 263548b07..4e37528ba 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 aae8b0764..8a2fc9b0c 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 598446519..ce6a5b392 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 068710b77..02b6c3454 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 3c58aea78..758f4b5c7 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 f54962462..595afab13 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 254e65fcf..6d55c5563 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 74eeb6330..c6f52d0fd 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 3d3d62928..f6615e039 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 ad04333a0..da18f6b23 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 6229abd6a..7f171cbe9 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 150febd43..b80b27af5 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 6a2997417..d9ed7922d 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 7812ca553..ec9c252c2 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 7d17210c3..5ac428e2a 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 a5b9f2fd6..bf56986c0 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 058e5027c..f686018d1 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 73847f394..b098c3d11 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 df7ede2c8..3f51d722d 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 bacf86ed4..d67ea0f09 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 a44a3c8fd..bb2f960b8 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 ae076a0f5..63d878be5 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 f79a06d03..9f31e6ccf 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 289ed855c..7b72fb98f 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 4187a943e..879fdfbbd 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 bdd24f32c..1ad5a9118 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 e93c0d6db..d3aa12921 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 5684a119f..ed34a823e 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 51773d4e5..dc5e2b749 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 b1f5f4628..a8c2e96bd 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 582540e34..c9919a174 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 ea52f4db3..8ce74d407 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 9ed16a714..1efe146b1 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 b2401af19..3354d091c 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 0fa1ac45f..a03c4a415 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 b0d48ae93..fac2baadc 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 b35a7b323..2b27f023f 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 565aedf31..c2bbaf717 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 c95139a62..8f8ed9a8f 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 c5263651a..1e231ec89 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 d98c451fe..4c8350e6b 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 2e995802e..5ffe96d43 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 e8b52a221..2dec8695d 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 58f86f2e3..427ad742b 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 bfe4258c7..7e274b4e6 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 cbc8b1d0e..611f4f243 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 bbe922201..8c909946d 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 6467be457..3281fbe7f 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 90e1d9451..13997be31 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 000000000..95ac0f6d0
--- /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 0d6e218bb..18c4db0d0 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 d7d0a9d28..493cc4164 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 dfa114d96..4cf9f61e0 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 3dce529cd..3c53046bf 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 2b81d403b..14972ebb1 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 4cf4ef319..7868245e7 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 a518b4cd9..1fb35a175 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 402eec799..752d0328e 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 62274f3a2..ad47a4079 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 56e58ddfe..b99535a64 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 8926b9980..6995a289c 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 ea08dbc6d..4f3201756 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 966e02273..5f66bcb1e 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 6f7d5ba04..27428732c 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 930a35309..e4b6969f7 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 7d28b5812..9b2e956c8 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 7298da397..7771c4c16 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 1a7dbccc7..08557b134 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 78337fd07..2e88adedc 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 9d6e36285..94ae93b98 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 d478d2922..da479793d 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 b397651cc..88566f750 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 a9e663d4b..e547eebb2 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 54410cc0f..65b383b78 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 f060029ec..09322be40 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 f60d6b017..333e4377f 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 e8596e451..4d42b503e 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 86e05b065..1ea82200f 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 376d4c1b9..fe4422f6c 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 932e070e2..2aaa33590 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 64e59aab5..afbad21c3 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 15b460b44..7f72c18fe 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 98d1fb06d..fb2df81ef 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 e80435567..a7a6abc4d 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 5495c0034..ef7e11977 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 aae5e6667..096ab3733 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 e1fb5c4dc..8d9e2a23f 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 161eed970..212c3582f 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 682a670a9..1cf63cdba 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 ae6e9a36a..26a0534f6 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 398801471..b09c3ef7c 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 e33a30d65..66f550fce 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 e72c1061b..90af72ef7 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 b9ac93976..7e1013f2f 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 3992f14d5..c29dda1bc 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 b54f02c98..2b47d6ba2 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 51a4f0f61..1618fdbaa 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 eebdebb4d..78b94b3d5 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 e90bfede0..8551ca4f1 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 a75f563ae..a47cd17a7 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 179bcac00..de07310a6 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 8d6aa3912..4940b3e00 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 3be100a23..434dbceda 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 16a4e789c..b68a4c447 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 cc815666a..0de085271 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 f5d3e51bf..9ba446abc 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 6321197f9..890c07a97 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 4c991ec40..87e0f99ac 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 000000000..22654856a
--- /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 4125450c7..02375224e 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 89104f650..65508ec1e 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 37a5c89f4..c1336c48c 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 91ed9d052..17f529ee8 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 432471fe2..d4ab1eef5 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