352 SUBROUTINE zggsvd3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
353 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq,
354 $ work, lwork, rwork, iwork, info )
362 CHARACTER JOBQ, JOBU, JOBV
363 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P,
368 DOUBLE PRECISION ALPHA( * ), BETA( * ), RWORK( * )
369 COMPLEX*16 A( lda, * ), B( ldb, * ), Q( ldq, * ),
370 $ u( ldu, * ), v( ldv, * ), work( * )
376 LOGICAL WANTQ, WANTU, WANTV, LQUERY
377 INTEGER I, IBND, ISUB, J, NCYCLE, LWKOPT
378 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
382 DOUBLE PRECISION DLAMCH, ZLANGE
383 EXTERNAL lsame, dlamch, zlange
395 wantu = lsame( jobu,
'U' )
396 wantv = lsame( jobv,
'V' )
397 wantq = lsame( jobq,
'Q' )
398 lquery = ( lwork.EQ.-1 )
404 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
406 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
408 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
410 ELSE IF( m.LT.0 )
THEN
412 ELSE IF( n.LT.0 )
THEN
414 ELSE IF( p.LT.0 )
THEN
416 ELSE IF( lda.LT.max( 1, m ) )
THEN
418 ELSE IF( ldb.LT.max( 1, p ) )
THEN
420 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
422 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
424 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
426 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
433 CALL zggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
434 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
435 $ work, work, -1, info )
436 lwkopt = n + int( work( 1 ) )
437 lwkopt = max( 2*n, lwkopt )
438 lwkopt = max( 1, lwkopt )
439 work( 1 ) = dcmplx( lwkopt )
443 CALL xerbla(
'ZGGSVD3', -info )
452 anorm = zlange(
'1', m, n, a, lda, rwork )
453 bnorm = zlange(
'1', p, n, b, ldb, rwork )
458 ulp = dlamch(
'Precision' )
459 unfl = dlamch(
'Safe Minimum' )
460 tola = max( m, n )*max( anorm, unfl )*ulp
461 tolb = max( p, n )*max( bnorm, unfl )*ulp
463 CALL zggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
464 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
465 $ work, work( n+1 ), lwork-n, info )
469 CALL ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
470 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
471 $ work, ncycle, info )
476 CALL dcopy( n, alpha, 1, rwork, 1 )
484 DO 10 j = i + 1, ibnd
486 IF( temp.GT.smax )
THEN
492 rwork( k+isub ) = rwork( k+i )
494 iwork( k+i ) = k + isub
500 work( 1 ) = dcmplx( lwkopt )
subroutine ztgsja(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)
ZTGSJA
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zggsvd3(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, LWORK, RWORK, IWORK, INFO)
ZGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zggsvp3(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, TAU, WORK, LWORK, INFO)
ZGGSVP3