204 SUBROUTINE dlasd1( NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT,
205 $ idxq, iwork, work, info )
213 INTEGER INFO, LDU, LDVT, NL, NR, SQRE
214 DOUBLE PRECISION ALPHA, BETA
217 INTEGER IDXQ( * ), IWORK( * )
218 DOUBLE PRECISION D( * ), U( ldu, * ), VT( ldvt, * ), WORK( * )
225 DOUBLE PRECISION ONE, ZERO
226 parameter ( one = 1.0d+0, zero = 0.0d+0 )
229 INTEGER COLTYP, I, IDX, IDXC, IDXP, IQ, ISIGMA, IU2,
230 $ ivt2, iz, k, ldq, ldu2, ldvt2, m, n, n1, n2
231 DOUBLE PRECISION ORGNRM
247 ELSE IF( nr.LT.1 )
THEN
249 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) )
THEN
253 CALL xerbla(
'DLASD1', -info )
280 orgnrm = max( abs( alpha ), abs( beta ) )
283 IF( abs( d( i ) ).GT.orgnrm )
THEN
284 orgnrm = abs( d( i ) )
287 CALL dlascl(
'G', 0, 0, orgnrm, one, n, 1, d, n, info )
288 alpha = alpha / orgnrm
293 CALL dlasd2( nl, nr, sqre, k, d, work( iz ), alpha, beta, u, ldu,
294 $ vt, ldvt, work( isigma ), work( iu2 ), ldu2,
295 $ work( ivt2 ), ldvt2, iwork( idxp ), iwork( idx ),
296 $ iwork( idxc ), idxq, iwork( coltyp ), info )
301 CALL dlasd3( nl, nr, sqre, k, d, work( iq ), ldq, work( isigma ),
302 $ u, ldu, work( iu2 ), ldu2, vt, ldvt, work( ivt2 ),
303 $ ldvt2, iwork( idxc ), iwork( coltyp ), work( iz ),
314 CALL dlascl(
'G', 0, 0, one, orgnrm, n, 1, d, n, info )
320 CALL dlamrg( n1, n2, d, 1, -1, idxq )
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dlamrg(N1, N2, A, DTRD1, DTRD2, INDEX)
DLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlasd3(NL, NR, SQRE, K, D, Q, LDQ, DSIGMA, U, LDU, U2, LDU2, VT, LDVT, VT2, LDVT2, IDXC, CTOT, Z, INFO)
DLASD3 finds all square roots of the roots of the secular equation, as defined by the values in D and...
subroutine dlasd1(NL, NR, SQRE, D, ALPHA, BETA, U, LDU, VT, LDVT, IDXQ, IWORK, WORK, INFO)
DLASD1 computes the SVD of an upper bidiagonal matrix B of the specified size. Used by sbdsdc...
subroutine dlasd2(NL, NR, SQRE, K, D, Z, ALPHA, BETA, U, LDU, VT, LDVT, DSIGMA, U2, LDU2, VT2, LDVT2, IDXP, IDX, IDXC, IDXQ, COLTYP, INFO)
DLASD2 merges the two sets of singular values together into a single sorted set. Used by sbdsdc...