333 SUBROUTINE dggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
334 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
343 CHARACTER JOBQ, JOBU, JOBV
344 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
348 DOUBLE PRECISION A( lda, * ), ALPHA( * ), B( ldb, * ),
349 $ beta( * ), q( ldq, * ), u( ldu, * ),
350 $ v( ldv, * ), work( * )
356 LOGICAL WANTQ, WANTU, WANTV
357 INTEGER I, IBND, ISUB, J, NCYCLE
358 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
362 DOUBLE PRECISION DLAMCH, DLANGE
363 EXTERNAL lsame, dlamch, dlange
375 wantu = lsame( jobu,
'U' )
376 wantv = lsame( jobv,
'V' )
377 wantq = lsame( jobq,
'Q' )
380 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
382 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
384 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
386 ELSE IF( m.LT.0 )
THEN
388 ELSE IF( n.LT.0 )
THEN
390 ELSE IF( p.LT.0 )
THEN
392 ELSE IF( lda.LT.max( 1, m ) )
THEN
394 ELSE IF( ldb.LT.max( 1, p ) )
THEN
396 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
398 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
400 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
404 CALL xerbla(
'DGGSVD', -info )
410 anorm = dlange(
'1', m, n, a, lda, work )
411 bnorm = dlange(
'1', p, n, b, ldb, work )
416 ulp = dlamch(
'Precision' )
417 unfl = dlamch(
'Safe Minimum' )
418 tola = max( m, n )*max( anorm, unfl )*ulp
419 tolb = max( p, n )*max( bnorm, unfl )*ulp
423 CALL dggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
424 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, work,
425 $ work( n+1 ), info )
429 CALL dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
430 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
431 $ work, ncycle, info )
436 CALL dcopy( n, alpha, 1, work, 1 )
444 DO 10 j = i + 1, ibnd
446 IF( temp.GT.smax )
THEN
452 work( k+isub ) = work( k+i )
454 iwork( k+i ) = k + isub
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dggsvp(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, TAU, WORK, INFO)
DGGSVP
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 dggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, IWORK, INFO)
DGGSVD computes the singular value decomposition (SVD) for OTHER matrices