348 SUBROUTINE dggsvd3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
349 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq,
350 $ work, lwork, iwork, info )
358 CHARACTER JOBQ, JOBU, JOBV
359 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P,
364 DOUBLE PRECISION A( lda, * ), ALPHA( * ), B( ldb, * ),
365 $ beta( * ), q( ldq, * ), u( ldu, * ),
366 $ v( ldv, * ), work( * )
372 LOGICAL WANTQ, WANTU, WANTV, LQUERY
373 INTEGER I, IBND, ISUB, J, NCYCLE, LWKOPT
374 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
378 DOUBLE PRECISION DLAMCH, DLANGE
379 EXTERNAL lsame, dlamch, dlange
391 wantu = lsame( jobu,
'U' )
392 wantv = lsame( jobv,
'V' )
393 wantq = lsame( jobq,
'Q' )
394 lquery = ( lwork.EQ.-1 )
400 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
402 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
404 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
406 ELSE IF( m.LT.0 )
THEN
408 ELSE IF( n.LT.0 )
THEN
410 ELSE IF( p.LT.0 )
THEN
412 ELSE IF( lda.LT.max( 1, m ) )
THEN
414 ELSE IF( ldb.LT.max( 1, p ) )
THEN
416 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
418 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
420 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
422 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
429 CALL dggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
430 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, work,
432 lwkopt = n + int( work( 1 ) )
433 lwkopt = max( 2*n, lwkopt )
434 lwkopt = max( 1, lwkopt )
435 work( 1 ) = dble( lwkopt )
439 CALL xerbla(
'DGGSVD3', -info )
448 anorm = dlange(
'1', m, n, a, lda, work )
449 bnorm = dlange(
'1', p, n, b, ldb, work )
454 ulp = dlamch(
'Precision' )
455 unfl = dlamch(
'Safe Minimum' )
456 tola = max( m, n )*max( anorm, unfl )*ulp
457 tolb = max( p, n )*max( bnorm, unfl )*ulp
461 CALL dggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
462 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, work,
463 $ work( n+1 ), lwork-n, info )
467 CALL dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
468 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
469 $ work, ncycle, info )
474 CALL dcopy( n, alpha, 1, work, 1 )
482 DO 10 j = i + 1, ibnd
484 IF( temp.GT.smax )
THEN
490 work( k+isub ) = work( k+i )
492 iwork( k+i ) = k + isub
498 work( 1 ) = dble( lwkopt )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dggsvp3(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, TAU, WORK, LWORK, INFO)
DGGSVP3
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtgsja(JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, NCYCLE, INFO)
DTGSJA
subroutine dggsvd3(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, LWORK, IWORK, INFO)
DGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices