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
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
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
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
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 \
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 \
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 \
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 \
*> \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
*> \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
*> \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
*> \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 ].
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
*>
*> \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:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexGBcomputational
*
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
$ 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
*
* 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' )
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexGEeigen
*
$ 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
* 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( * )
* ..
*
*> \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 ..
*
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
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
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
* .. 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( * )
* ..
*
*> 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
*>
*> \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
*
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 ..
*
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
$ WORK, -1, INFO )
END IF
END IF
- HSWORK = WORK( 1 )
+ HSWORK = INT( WORK(1) )
*
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = 2*N
$ 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
*>
*> \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:
*> ==========
*>
*> \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
*> 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
*> 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
*> 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
*> (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)).
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexGEsing
*
*> 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.
$ 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
* ..
* .. 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
*
* 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
*
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
*
XSC = ZERO
TEMP1 = ONE
- CALL CLASSQ( N, SVA, 1, XSC, TEMP1 )
+ CALL SLASSQ( N, SVA, 1, XSC, TEMP1 )
TEMP1 = ONE / TEMP1
*
ENTRA = ZERO
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
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 )
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)
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),
* 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexGEsolve
*
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
* 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),
$ -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,
* 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,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexGEcomputational
*
* =====================================================================
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
*
* 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
*
*> \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
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexGEsing
*
* =====================================================================
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
* =====================================================================
*
* .. Parameters ..
- INTEGER LQUERV
- PARAMETER ( LQUERV = -1 )
COMPLEX CZERO, CONE
PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
$ CONE = ( 1.0E+0, 0.0E+0 ) )
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,
* ..
* .. 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
*
* 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
*
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
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
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
*
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 )
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,
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
*
*
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 )
$ 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 )
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 ),
* 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
*
* 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 )
*
* 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,
*
* 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 )
*
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
*
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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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,
*
* 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 ),
*
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
*
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 )
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,
* 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,
*
* 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 )
*
* 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,
*
* 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 )
*
* 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
*
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
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
*
*
* 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,
*
* 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 ) )
*
* 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
*
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 ),
* 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
*
* 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 ) )
*
* 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,
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 ),
* 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
*
* 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 ) )
*
* 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,
*
* 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
*
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
*
*
* 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,
*
* 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 )
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
*
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
*
* 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 )
*
* 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,
$ 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
*
* 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,
*
* 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,
*
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 )
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,
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
*
* 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
*
* 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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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 )
*
* 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 )
*
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
*
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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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,
*
* 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,
*
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
*
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 )
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,
* 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
*
* 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,
*
* 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 )
*
* 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
*
*
* 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
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,
*
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
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
*
*
* 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,
*
* 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 ) )
*
* 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
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 ),
* 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
*
* 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 ) )
*
* 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,
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 ),
* 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
*
* 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 ) )
*
* 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 )
*
* 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
*
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
*
*
* 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
*
* 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 )
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
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
*
* 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,
*
* 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 )
$ 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
*
* 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,
*
* 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,
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
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
*
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
*
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
*
*
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 )
*
* 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
*
* 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)
*
* 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)
*
* 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)
*
* 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)
*> \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
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexGEsing
*
$ 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
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 ..
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
*
* 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 )
*
* 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
*
* Set singular values indices accord to RANGE='A'.
*
- ALLS = LSAME( RANGE, 'A' )
- INDS = LSAME( RANGE, 'I' )
IF( ALLS ) THEN
RNGTGK = 'I'
ILTGK = 1
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.
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)
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.
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)
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.
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)
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.
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
*> \endverbatim
*>
*> \param[in,out] CWORK
+*> \verbatim
*> CWORK is COMPLEX array, dimension M+N.
*> Used as work space.
*> \endverbatim
*> \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' :
*> \endverbatim
*>
*> \param[in] LRWORK
+*> \verbatim
*> LRWORK is INTEGER
*> Length of RWORK, LRWORK >= MAX(6,N).
*> \endverbatim
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexGEcomputational
*
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 ..
* 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 ..
END IF
END IF
*
- OMPQ = AAPQ / ABS(AAPQ)
* AAPQ = AAPQ * CONJG( CWORK(p) ) * CWORK(q)
AAPQ1 = -ABS(AAPQ)
MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 )
*
IF( ROTOK ) THEN
*
+ OMPQ = AAPQ / ABS(AAPQ)
AQOAP = AAQQ / AAPP
APOAQ = AAPP / AAQQ
THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1
END IF
END IF
*
- OMPQ = AAPQ / ABS(AAPQ)
* AAPQ = AAPQ * CONJG(CWORK(p))*CWORK(q)
AAPQ1 = -ABS(AAPQ)
MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 )
*
IF( ROTOK ) THEN
*
+ OMPQ = AAPQ / ABS(AAPQ)
AQOAP = AAQQ / AAPP
APOAQ = AAPP / AAQQ
THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complexGEauxiliary
*
* =====================================================================
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
*> 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 ]
*> \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
$ 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
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,
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
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
*
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' )
$ 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
* .. Local Scalars ..
LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY
INTEGER I, J, LWKOPT
- COMPLEX T
* ..
* .. External Functions ..
LOGICAL LSAME
-*> \brief \b CGSVJ0 pre-processor for the routine sgesvj.
+*> \brief \b CGSVJ0 pre-processor for the routine cgesvj.
*
* =========== DOCUMENTATION ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
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 ..
-*> \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 ===========
*
*>
*> \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,
*>
*> \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.
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexOTHEReigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHEReigen
*
$ 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
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.
*
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexHEeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexHEeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexHEeigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complexHEcomputational
*
*>
*> \verbatim
*>
-*> November 2013, Igor Kozachenko,
+*> June 2016, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
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
* 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
*
*> \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
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHEReigen
*
$ 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
*>
*> \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.
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexGBcomputational
*
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
*>
*> \param[in] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension (2*N)
+*> WORK is REAL array, dimension (2*N)
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexHEcomputational
*
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
*>
*> \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
*>
*> \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
*
*> \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
*> \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:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexPOcomputational
*
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
*>
*> \param[in] WORK
*> \verbatim
-*> WORK is COMPLEX array, dimension (2*N)
+*> WORK is REAL array, dimension (2*N)
*> \endverbatim
*
* Authors:
*> \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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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,
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexOTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexOTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \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
*> \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
*> 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
*> 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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHERauxiliary
*
$ 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
*> \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:
*> \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
*> \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
*> \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
*> \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:
*> \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
*> 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
*>
*>
*> \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
*>
*> \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).
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexOTHERauxiliary
*
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
*>
*> \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
*> \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
*>
*> \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.
*> \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
*>
*> \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.
*> \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
*> 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complexSYcomputational
*
*>
*> \verbatim
*>
-*> November 2015, Igor Kozachenko,
+*> June 2016, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
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
* 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
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
* 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 )
$ 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) )
--- /dev/null
+*> \brief \b CTREVC3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CTREVC3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrevc3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrevc3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrevc3.f">
+*> [TXT]</a>
+*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
* =====================================================================
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
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
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,
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
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,
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
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,
$ 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
$ 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
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
EXTERNAL LSAME
* ..
* .. Intrinsic Functions
- INTRINSIC COS, INT, MAX, MIN, SIN
+ INTRINSIC INT, MAX, MIN
* ..
* .. Executable Statements ..
*
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 )
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date July 2012
+*> \date June 2016
*
*> \ingroup complexOTHERcomputational
*
$ 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
$ 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,
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
*
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
* 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 )
* 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 )
* 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),
* 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
*> \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
*> \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
*> \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
*> \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 ].
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHERcomputational
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
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
* 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
*
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
*> = 'L': B is lower bidiagonal.
*> \endverbatim
*>
-*> \param[in] JOBXZ
+*> \param[in] JOBZ
*> \verbatim
*> JOBZ is CHARACTER*1
*> = 'N': Compute singular values only;
*>
*> \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
*> \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
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
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
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.
*
* 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
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
*
*
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.
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.
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
*
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
* 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
CALL DCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 )
END IF
END DO
+ END IF
*
RETURN
*
$ 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
*
* 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' )
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleGEeigen
*
$ 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
*> \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
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
* ..
* ..
* .. External Subroutines ..
EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
- $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
+ $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3,
$ XERBLA
* ..
* .. External Functions ..
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 )
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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
+*
+* @precisions fortran d -> s
*
*> \ingroup doubleGEeigen
*
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
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
* ..
* ..
* .. 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 ..
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
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
$ 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
$ 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
*> 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:
* ==========
*> 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
*> 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
*> 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).
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleGEsing
*
$ 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
*
* 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
*
IWORK(1) = 0
IWORK(2) = 0
END IF
+ IWORK(3) = 0
IF ( ERREST ) WORK(3) = ONE
IF ( LSVEC .AND. RSVEC ) THEN
WORK(4) = ONE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleGEcomputational
*
* =====================================================================
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
*
* 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
*
* 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
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleGEsing
*
*> 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
$ 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 ..
* ..
* .. 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
*
* 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
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
*
* 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
*
*
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
*
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,
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
*
*
* 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
*
* 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,
*
* 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 )
*
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
*
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,
*
* 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 ),
*
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
*
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
*
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,
* 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,
*
* 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 )
*
* 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
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
*
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
* 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 )
*
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,
*
* 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,
* 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
*
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
*
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,
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 ),
*
* 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,
*
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
*
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,
*
* 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,
*
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
*
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
*
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,
* 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,
*
* 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 )
*
* 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
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
*
* 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 )
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,
*
* 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,
* 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
*> 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
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
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
* 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
* 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
*
*
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
*
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
* 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
*
*
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 )
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,
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 )
* 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
*
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 )
$ 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 )
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 ),
*
* 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,
*
* 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 )
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 )
* 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
*
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 )
$ 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 )
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 ),
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 )
* 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,
*
* 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 )
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 )
$ 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 )
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 )
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 )
$ 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 )
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 ),
$ 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 ),
*
* 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,
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 )
*
* 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 ),
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
*
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 )
$ 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 )
*
* 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,
$ 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,
* 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 ),
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 )
*
* 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 )
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 )
$ 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 )
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 ),
$ 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 ),
* 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,
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 )
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 ),
*
* 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 )
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 )
$ 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 )
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 ),
$ 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 ),
*
* 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,
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 )
*
* 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 ),
*
* 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 ),
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
*
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 )
*
* 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,
$ 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,
* 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 ),
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 )
*
* 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 ),
*
* 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 )
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 )
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 ),
$ 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 ),
* 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,
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 )
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 ),
*
* 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 )
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,
*
* 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 )
*
* 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 ),
*
* 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 )
*
* 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 )
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 )
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,
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 )
* 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
*
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 )
$ 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 )
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 ),
*
* 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,
*
* 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 )
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 )
* 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
*
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 )
$ 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 )
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 ),
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 )
* 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,
*
* 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 )
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 )
$ 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 )
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 )
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 )
$ 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 )
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 ),
*
* 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 ),
*
* 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,
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 )
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 )
$ 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,
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
*
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 )
$ 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 )
*
* 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,
$ 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,
$ 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 ),
* 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 ),
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 )
$ 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 )
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 )
$ 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 )
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 ),
$ 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,
$ 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 )
* 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,
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 )
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 ),
*
* 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 )
* 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
*
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 )
$ 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 )
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 ),
$ 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,
*
* 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,
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 )
$ 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 ),
*
* 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,
* 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
*
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
*
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 )
*
* 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,
$ 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,
$ 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 ),
* 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 ),
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 )
$ 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 ),
*
* 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 )
* 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
*
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 )
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 ),
$ 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 )
* 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,
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 )
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 ),
*
* 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 )
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,
*
* 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 ),
*
* 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 )
*
* 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 )
*
* 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 )
*> \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
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleGEsing
*
$ 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
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
*
* 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 )
*
* 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
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)
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)
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)
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)
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup doubleGEauxiliary
*
* =====================================================================
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
*> 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 ]
*> \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
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
*
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' )
-*> \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 ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHERcomputational
*
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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup doubleGEcomputational
*
$ 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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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,
*> 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
*>
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleOTHERauxiliary
*
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
* 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 )
*> \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
*>
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleOTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleOTHERauxiliary
*
$ 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,
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*> \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'.
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> \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
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> 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
*> 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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHERauxiliary
*
$ 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
*> \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:
*> \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
*> \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
*> \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
*> \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:
*> \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
*>
*> 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.
*>
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*>
*> 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.
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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,
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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
*>
*> \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
*>
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
*> \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
* ..
* .. Executable Statements ..
*
-* Test the input paramters.
+* Test the input parameters.
*
INFO = 0
DIR = -1
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleSYauxiliary
*
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
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.
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleOTHERauxiliary
*
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
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
$ 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,
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
$ 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,
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
$ 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,
$ 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
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
*
$ 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,
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
*
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,
* 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
* 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 )
* 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
* 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
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
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.
*
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
$ 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
*> -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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleGEsolve
*
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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
$ 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
*> -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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doublePOsolve
*
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
*> \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'.
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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
*> 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup doubleOTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHEReigen
*
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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup doubleSYeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleSYeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleSYeigen
*
$ 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
* =====================================================================
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
* 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
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (N)
+*> WORK is DOUBLE PRECISION array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleSYcomputational
*
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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup doubleOTHERcomputational
*
$ 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
*
M = 0
PAIR = .FALSE.
+ IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN
DO 10 K = 1, N
IF( PAIR ) THEN
PAIR = .FALSE.
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 ) )
--- /dev/null
+*> \brief \b DTREVC3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DTREVC3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrevc3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrevc3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrevc3.f">
+*> [TXT]</a>
+*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
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
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
* ==========
*
*> \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:
* ========
*> \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
*
* =====================================================================
*
* =====================================================================
VERS_MAJOR = 3
VERS_MINOR = 6
- VERS_PATCH = 0
+ VERS_PATCH = 1
* =====================================================================
*
RETURN
*> \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
*> \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
*> \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
*> \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 ].
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHERcomputational
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
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
* 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
*
*> = 'L': B is lower bidiagonal.
*> \endverbatim
*>
-*> \param[in] JOBXZ
+*> \param[in] JOBZ
*> \verbatim
*> JOBZ is CHARACTER*1
*> = 'N': Compute singular values only;
*>
*> \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
*> \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
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
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
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.
*
* 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
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
*
*
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.
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.
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
*
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
* 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
CALL SCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 )
END IF
END DO
+ END IF
*
RETURN
*
*>
*> \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:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realGBcomputational
*
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
*>
*> \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:
*>
*> \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
$ 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
*
* 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' )
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realGEeigen
*
$ 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
* 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( * )
* ..
*
*> \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 ..
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 )
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
* .. 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( * )
* ..
*> \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
*>
*> \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
*
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( * )
* ..
* =====================================================================
*
* .. 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 ..
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
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
$ 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
$ 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
*> 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:
*> 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
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realGEsing
*
*> 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.
$ 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
*
* 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
*
IWORK(1) = 0
IWORK(2) = 0
END IF
+ IWORK(3) = 0
IF ( ERREST ) WORK(3) = ONE
IF ( LSVEC .AND. RSVEC ) THEN
WORK(4) = ONE
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realGEcomputational
*
* =====================================================================
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
*
* 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
*
* 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
* ..
* .. Array Arguments ..
* INTEGER IWORK( * )
-* REAL A( LDA, * ), S( * ), U( LDU, * ),
+* REAL A( LDA, * ), S( * ), U( LDU, * ),
* $ VT( LDVT, * ), WORK( * )
* ..
*
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realGEsing
*
*> 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
* ..
* .. 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 ..
$ 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 )
* ..
* .. 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
*
* 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
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
*
*
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
*
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,
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
*
*
* 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
*
* 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,
*
* 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 )
*
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
*
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,
*
* 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 ),
*
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
*
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
*
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,
* 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,
*
* 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 )
*
* 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
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
*
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
* 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 )
*
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,
*
* 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,
* 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
*
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
*
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,
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 ),
*
* 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,
*
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
*
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,
*
* 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,
*
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
*
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
*
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,
* 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,
*
* 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 )
*
* 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
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
*
* 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 )
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,
*
* 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,
* 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
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
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
*
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
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
*
*
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
*
* 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
*
* 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)
*
* 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)
*
* 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)
*
* 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)
*> \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
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realGEsing
*
$ 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
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
*
* 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 )
*
* 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
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)
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)
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)
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)
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup realGEauxiliary
*
* =====================================================================
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
*> 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 ]
*> \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
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
*
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' )
*>
*> \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
*>
$ 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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup realGEcomputational
*
$ 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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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,
*> 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
*>
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realOTHERauxiliary
*
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
* 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 )
*> \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
*>
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realOTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realOTHERauxiliary
*
$ 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,
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*> \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'.
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> \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
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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
*> \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
*> 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
*> 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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHERauxiliary
*
$ 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
*> \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:
*> \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
*> \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
*> \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
*> \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:
*> \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
*>
*> 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.
*>
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*>
*> 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.
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
$ 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,
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERauxiliary
*
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
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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
*>
*> \param[in] Z
*> \verbatim
-*> Z is REAL array, dimension ( 4*N )
+*> Z is REAL array, dimension ( 4*N0 )
*> Z holds the qd array.
*> \endverbatim
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
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
*> \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
* ..
* .. Executable Statements ..
*
-* Test the input paramters.
+* Test the input parameters.
*
INFO = 0
DIR = -1
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realSYauxiliary
*
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
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.
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realOTHERauxiliary
*
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
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
$ 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,
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
$ 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,
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
$ 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,
$ 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
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
*
$ 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
$ 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,
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
*
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
* 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 )
* 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 )
* 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
* 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 )
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
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
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.
*
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
$ 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
*> \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'.
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup auxOTHERcomputational
*
$ 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
*> 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup realOTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHEReigen
*
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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup realSYeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realSYeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realSYeigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup realSYcomputational
*
*>
*> \verbatim
*>
-*> November 2015, Igor Kozachenko,
+*> June 2016, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
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
* 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
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup realOTHERcomputational
*
$ 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
*
M = 0
PAIR = .FALSE.
+ IF( .NOT.LQUERY .OR. IJOB.NE.0 ) THEN
DO 10 K = 1, N
IF( PAIR ) THEN
PAIR = .FALSE.
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) )
--- /dev/null
+*> \brief \b STREVC3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download STREVC3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strevc3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strevc3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strevc3.f">
+*> [TXT]</a>
+*> \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
*> \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
*> \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
*> \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
*> \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 ].
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
$ 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
*> -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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16GEsolve
*
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
*> -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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16POsolve
*
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
*>
*> \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:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16GBcomputational
*
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
*>
*> \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
*>
*>
*> \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
$ 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
*
* 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' )
*>
*> \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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16GEeigen
*
$ 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
*> \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
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
* ..
* ..
* .. 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
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 ..
*
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
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
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
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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
+*
+* @precisions fortran z -> c
*
*> \ingroup complex16GEeigen
*
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
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
* ..
* ..
* .. 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 ..
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 ..
*
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
$ WORK, -1, INFO )
END IF
END IF
- HSWORK = WORK( 1 )
+ HSWORK = INT( WORK(1) )
*
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = 2*N
$ 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
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
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
* 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
*>
*> \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
*>
*> \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
*>
*>
*> \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
*> 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
*>
*> \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),
*> 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
*>
*> \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
*> 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
*> 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16GEsing
*
*>
*> \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:
$ 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( * )
* .. 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,
$ 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
*
* 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
*
* 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
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
*
XSC = ZERO
TEMP1 = ONE
- CALL ZLASSQ( N, SVA, 1, XSC, TEMP1 )
+ CALL DLASSQ( N, SVA, 1, XSC, TEMP1 )
TEMP1 = ONE / TEMP1
*
ENTRA = ZERO
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
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.
* 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
* 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
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
*
*
*
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
* 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
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 )
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
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)
* 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)
$ 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)) )
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)) )
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)) )
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),
* 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)
* 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16GEsolve
*
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
* 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),
$ -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,
* 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,
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16GEcomputational
*
* =====================================================================
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
*
* 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
*
* 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
*> \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
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16GEsing
*
*> 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
* =====================================================================
*
* .. 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 ) )
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,
* ..
* .. 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
*
* 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
*
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
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
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
*
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 )
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,
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
*
*
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 )
$ 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 )
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 ),
* 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
*
* 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 )
*
* 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,
*
* 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 )
*
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
*
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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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,
*
* 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 ),
*
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
*
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 )
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,
* 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,
*
* 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 )
*
* 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,
*
* 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 )
*
* 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
*
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
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
*
*
* 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,
*
* 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 ) )
*
* 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
*
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 ),
* 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
*
* 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 ) )
*
* 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,
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 ),
* 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
*
* 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 ) )
*
* 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,
*
* 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
*
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
*
*
* 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,
*
* 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 )
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
*
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
*
* 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 )
*
* 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,
$ 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
*
* 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,
*
* 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,
*
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 )
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,
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
*
* 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
*
* 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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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 )
*
* 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 )
*
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
*
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 )
$ 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 )
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 ),
* 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
*
* 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,
*
* 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,
*
* 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,
*
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
*
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 )
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,
* 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
*
* 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,
*
* 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 )
*
* 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 )
*
* 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
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,
*
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
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
*
*
* 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,
*
* 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 ) )
*
* 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
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 ),
* 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
*
* 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 ) )
*
* 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,
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 ),
* 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
*
* 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 ) )
*
* 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 )
*
* 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
*
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
*
*
* 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
*
* 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 )
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
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
*
* 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,
*
* 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 )
$ 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
*
* 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,
*
* 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,
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
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
*
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
*
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
*
*
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 )
*
* 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
*
* 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)
*
* 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)
*
* 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)
*
* 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)
* ..
*
*
-* 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:
* ==========
*>
*> \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
*> \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
*> \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
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16GEsing
*
$ 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
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 ..
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
*
* 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 )
*
* 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
*
* Set singular values indices accord to RANGE='A'.
*
- ALLS = LSAME( RANGE, 'A' )
- INDS = LSAME( RANGE, 'I' )
IF( ALLS ) THEN
RNGTGK = 'I'
ILTGK = 1
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.
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)
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.
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)
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.
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)
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.
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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup doubleGEcomputational
*
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 ..
* ..
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DFLOAT, MIN0, MAX0,
+ INTRINSIC ABS, DMAX1, DMIN1, DCONJG, DBLE, MIN0, MAX0,
$ DSIGN, DSQRT
* ..
* .. External Functions ..
* 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 ..
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
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
* 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.
*
* 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
* 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
* 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
END IF
END IF
*
- OMPQ = AAPQ / ABS(AAPQ)
* AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q)
AAPQ1 = -ABS(AAPQ)
MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
*
IF( ROTOK ) THEN
*
- AQOAP = AAQQ / AAPP
+ OMPQ = AAPQ / ABS(AAPQ)
+ AQOAP = AAQQ / AAPP
APOAQ = AAPP / AAQQ
THETA = -HALF*ABS( AQOAP-APOAQ )/AAPQ1
*
END IF
END IF
*
- OMPQ = AAPQ / ABS(AAPQ)
* AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q)
AAPQ1 = -ABS(AAPQ)
MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
*
IF( ROTOK ) THEN
*
+ OMPQ = AAPQ / ABS(AAPQ)
AQOAP = AAQQ / AAPP
APOAQ = AAPP / AAQQ
THETA = -HALF*ABS( AQOAP-APOAQ )/ AAPQ1
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
*
* 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<N, SVA(N2:N) contains ZEROS and/or denormalized numbers
* that may carry some information.
*
- RWORK( 4 ) = DFLOAT( i )
+ RWORK( 4 ) = DBLE( i )
* i is the index of the last sweep before declaring convergence.
*
RWORK( 5 ) = MXAAPQ
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complex16GEauxiliary
*
* =====================================================================
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
*> 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 ]
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16GBcomputational
*
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
$ 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
$ 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,
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
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
*
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' )
$ 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
EXTERNAL LSAME, DLAMCH, ZLANGE
* ..
* .. External Subroutines ..
- EXTERNAL DCOPY, XERBLA, ZGGSVP, ZTGSJA
+ EXTERNAL DCOPY, XERBLA, ZGGSVP3, ZTGSJA
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN
$ 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
* .. Local Scalars ..
LOGICAL FORWRD, WANTQ, WANTU, WANTV, LQUERY
INTEGER I, J, LWKOPT
- COMPLEX*16 T
* ..
* .. External Functions ..
LOGICAL LSAME
-*> \brief \b ZGSVJ0 pre-processor for the routine dgesvj.
+*> \brief \b ZGSVJ0 pre-processor for the routine zgesvj.
*
* =========== DOCUMENTATION ===========
*
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*>
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 ..
* ..
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, DMAX1, DCONJG, DFLOAT, MIN0, DSIGN, DSQRT
+ INTRINSIC ABS, DMAX1, DCONJG, DBLE, MIN0, DSIGN, DSQRT
* ..
* .. External Functions ..
DOUBLE PRECISION DZNRM2
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
*
-*> \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 ===========
*
*>
*> \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,
*>
*> \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.
*>
*> \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
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is DOUBLE PRECISION array, dimension (LWORK)
+*> WORK is COMPLEX*16 array, dimension (LWORK)
*> \endverbatim
*>
*> \param[in] LWORK
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
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 ..
* ..
* ..
* .. Intrinsic Functions ..
- INTRINSIC ABS, DCONJG, DMAX1, DFLOAT, MIN0, DSIGN, DSQRT
+ INTRINSIC ABS, DCONJG, DMAX1, DBLE, MIN0, DSIGN, DSQRT
* ..
* .. External Functions ..
DOUBLE PRECISION DZNRM2
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 )
*
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
*
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16OTHEReigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHEReigen
*
$ 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
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.
*
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16HEeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16HEeigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16HEeigen
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2013
+*> \date June 2016
*
*> \ingroup complex16HEcomputational
*
*>
*> \verbatim
*>
-*> November 2013, Igor Kozachenko,
+*> June 2016, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
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
* 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
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (N)
+*> WORK is COMPLEX*16 array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16HEcomputational
*
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
*> \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
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16OTHEReigen
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHEReigen
*
$ 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
*>
*> \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
*>
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16GEcomputational
*
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
*>
*> \param[in] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (2*N)
+*> WORK is DOUBLE PRECISION array, dimension (2*N)
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16HEcomputational
*
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
*>
*> \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
*>
*> \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
*
*> \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
*>
*> \param[in] WORK
*> \verbatim
-*> WORK is COMPLEX*16 array, dimension (2*N)
+*> WORK is DOUBLE PRECISION array, dimension (2*N)
*> \endverbatim
*
* Authors:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16POcomputational
*
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
*>
*> 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.
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
$ 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,
*> 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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16OTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16OTHERauxiliary
*
$ 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,
*>
*> \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
*>
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
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
*
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)
*> \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
*> 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
*> 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.
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERauxiliary
*
$ 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
*> \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:
*> \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
*> \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
*> \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
*> \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:
*> \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
*> 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
*>
*>
*> \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
*>
*> \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).
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date September 2012
+*> \date June 2016
*
*> \ingroup complex16OTHERauxiliary
*
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
*>
*> \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:
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
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
*>
*> \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
*> \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
*>
*> \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.
*> \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
*>
*> \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.
*> \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
*> 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
$ 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
*> \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
*> \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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
$ 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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16SYcomputational
*
*>
*> \verbatim
*>
-*> November 2015, Igor Kozachenko,
+*> June 2016, Igor Kozachenko,
*> Computer Science Division,
*> University of California, Berkeley
*>
* =====================================================================
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
* 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
*
*>
*> \param[out] WORK
*> \verbatim
-*> WORK is REAL array, dimension (N)
+*> WORK is COMPLEX*16 array, dimension (N)
*> \endverbatim
*>
*> \param[out] INFO
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2015
+*> \date June 2016
*
*> \ingroup complex16SYcomputational
*
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
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \date November 2011
+*> \date June 2016
*
*> \ingroup complex16OTHERcomputational
*
$ 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
* 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 )
$ 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 ) )
--- /dev/null
+*> \brief \b ZTREVC3
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZTREVC3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrevc3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrevc3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrevc3.f">
+*> [TXT]</a>
+*> \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
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
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,
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
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,
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
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,
$ 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
$ 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
*
$ 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
$ 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,
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
*
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
* 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 )
* 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 )
* 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),
* 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
projects / platform / upstream / openblas.git / commitdiff