350 SUBROUTINE zggsvd3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
351 $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ,
352 $ WORK, LWORK, RWORK, IWORK, INFO )
359 CHARACTER JOBQ, JOBU, JOBV
360 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P,
365 DOUBLE PRECISION ALPHA( * ), BETA( * ), RWORK( * )
366 COMPLEX*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
367 $ u( ldu, * ), v( ldv, * ), work( * )
373 LOGICAL WANTQ, WANTU, WANTV, LQUERY
374 INTEGER I, IBND, ISUB, J, NCYCLE, LWKOPT
375 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
379 DOUBLE PRECISION DLAMCH, ZLANGE
380 EXTERNAL lsame, dlamch, zlange
392 wantu = lsame( jobu,
'U' )
393 wantv = lsame( jobv,
'V' )
394 wantq = lsame( jobq,
'Q' )
395 lquery = ( lwork.EQ.-1 )
401 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
403 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
405 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
407 ELSE IF( m.LT.0 )
THEN
409 ELSE IF( n.LT.0 )
THEN
411 ELSE IF( p.LT.0 )
THEN
413 ELSE IF( lda.LT.max( 1, m ) )
THEN
415 ELSE IF( ldb.LT.max( 1, p ) )
THEN
417 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
419 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
421 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
423 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
430 CALL zggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
431 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
432 $ work, work, -1, info )
433 lwkopt = n + int( work( 1 ) )
434 lwkopt = max( 2*n, lwkopt )
435 lwkopt = max( 1, lwkopt )
436 work( 1 ) = dcmplx( lwkopt )
440 CALL xerbla(
'ZGGSVD3', -info )
449 anorm = zlange(
'1', m, n, a, lda, rwork )
450 bnorm = zlange(
'1', p, n, b, ldb, rwork )
455 ulp = dlamch(
'Precision' )
456 unfl = dlamch(
'Safe Minimum' )
457 tola = max( m, n )*max( anorm, unfl )*ulp
458 tolb = max( p, n )*max( bnorm, unfl )*ulp
460 CALL zggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
461 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
462 $ work, work( n+1 ), lwork-n, info )
466 CALL ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
467 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
468 $ work, ncycle, info )
473 CALL dcopy( n, alpha, 1, rwork, 1 )
481 DO 10 j = i + 1, ibnd
483 IF( temp.GT.smax )
THEN
489 rwork( k+isub ) = rwork( k+i )
491 iwork( k+i ) = k + isub
497 work( 1 ) = dcmplx( lwkopt )
subroutine xerbla(srname, info)
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 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
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