348 SUBROUTINE sggsvd3( 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 REAL 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 REAL ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
379 EXTERNAL lsame, slamch, slange
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 sggsvp3( 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 ) =
REAL( lwkopt )
439 CALL xerbla(
'SGGSVD3', -info )
448 anorm = slange(
'1', m, n, a, lda, work )
449 bnorm = slange(
'1', p, n, b, ldb, work )
454 ulp = slamch(
'Precision' )
455 unfl = slamch(
'Safe Minimum' )
456 tola = max( m, n )*max( anorm, unfl )*ulp
457 tolb = max( p, n )*max( bnorm, unfl )*ulp
461 CALL sggsvp3( 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 stgsja( 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 scopy( 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 ) =
REAL( lwkopt )
subroutine sggsvd3(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, LWORK, IWORK, INFO)
SGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices
subroutine sggsvp3(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)
SGGSVP3
subroutine stgsja(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)
STGSJA
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY