311 SUBROUTINE dlasd6( ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA,
312 $ idxq, perm, givptr, givcol, ldgcol, givnum,
313 $ ldgnum, poles, difl, difr, z, k, c, s, work,
322 INTEGER GIVPTR, ICOMPQ, INFO, K, LDGCOL, LDGNUM, NL,
324 DOUBLE PRECISION ALPHA, BETA, C, S
327 INTEGER GIVCOL( ldgcol, * ), IDXQ( * ), IWORK( * ),
329 DOUBLE PRECISION D( * ), DIFL( * ), DIFR( * ),
330 $ givnum( ldgnum, * ), poles( ldgnum, * ),
331 $ vf( * ), vl( * ), work( * ), z( * )
337 DOUBLE PRECISION ONE, ZERO
338 parameter ( one = 1.0d+0, zero = 0.0d+0 )
341 INTEGER I, IDX, IDXC, IDXP, ISIGMA, IVFW, IVLW, IW, M,
343 DOUBLE PRECISION ORGNRM
359 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
361 ELSE IF( nl.LT.1 )
THEN
363 ELSE IF( nr.LT.1 )
THEN
365 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) )
THEN
367 ELSE IF( ldgcol.LT.n )
THEN
369 ELSE IF( ldgnum.LT.n )
THEN
373 CALL xerbla(
'DLASD6', -info )
392 orgnrm = max( abs( alpha ), abs( beta ) )
395 IF( abs( d( i ) ).GT.orgnrm )
THEN
396 orgnrm = abs( d( i ) )
399 CALL dlascl(
'G', 0, 0, orgnrm, one, n, 1, d, n, info )
400 alpha = alpha / orgnrm
405 CALL dlasd7( icompq, nl, nr, sqre, k, d, z, work( iw ), vf,
406 $ work( ivfw ), vl, work( ivlw ), alpha, beta,
407 $ work( isigma ), iwork( idx ), iwork( idxp ), idxq,
408 $ perm, givptr, givcol, ldgcol, givnum, ldgnum, c, s,
413 CALL dlasd8( icompq, k, d, z, vf, vl, difl, difr, ldgnum,
414 $ work( isigma ), work( iw ), info )
424 IF( icompq.EQ.1 )
THEN
425 CALL dcopy( k, d, 1, poles( 1, 1 ), 1 )
426 CALL dcopy( k, work( isigma ), 1, poles( 1, 2 ), 1 )
431 CALL dlascl(
'G', 0, 0, one, orgnrm, n, 1, d, n, info )
437 CALL dlamrg( n1, n2, d, 1, -1, idxq )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 dlasd8(ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, DSIGMA, WORK, INFO)
DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D...
subroutine dlasd6(ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, IWORK, INFO)
DLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by...
subroutine xerbla(SRNAME, INFO)
XERBLA
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 dlasd7(ICOMPQ, NL, NR, SQRE, K, D, Z, ZW, VF, VFW, VL, VLW, ALPHA, BETA, DSIGMA, IDX, IDXP, IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, C, S, INFO)
DLASD7 merges the two sets of singular values together into a single sorted set. Then it tries to def...