334 SUBROUTINE zggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
335 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
336 $ rwork, iwork, info )
344 CHARACTER JOBQ, JOBU, JOBV
345 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
349 DOUBLE PRECISION ALPHA( * ), BETA( * ), RWORK( * )
350 COMPLEX*16 A( lda, * ), B( ldb, * ), Q( ldq, * ),
351 $ u( ldu, * ), v( ldv, * ), work( * )
357 LOGICAL WANTQ, WANTU, WANTV
358 INTEGER I, IBND, ISUB, J, NCYCLE
359 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
363 DOUBLE PRECISION DLAMCH, ZLANGE
364 EXTERNAL lsame, dlamch, zlange
376 wantu = lsame( jobu,
'U' )
377 wantv = lsame( jobv,
'V' )
378 wantq = lsame( jobq,
'Q' )
381 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
383 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
385 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
387 ELSE IF( m.LT.0 )
THEN
389 ELSE IF( n.LT.0 )
THEN
391 ELSE IF( p.LT.0 )
THEN
393 ELSE IF( lda.LT.max( 1, m ) )
THEN
395 ELSE IF( ldb.LT.max( 1, p ) )
THEN
397 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
399 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
401 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
405 CALL xerbla(
'ZGGSVD', -info )
411 anorm = zlange(
'1', m, n, a, lda, rwork )
412 bnorm = zlange(
'1', p, n, b, ldb, rwork )
417 ulp = dlamch(
'Precision' )
418 unfl = dlamch(
'Safe Minimum' )
419 tola = max( m, n )*max( anorm, unfl )*ulp
420 tolb = max( p, n )*max( bnorm, unfl )*ulp
422 CALL zggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
423 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
424 $ work, work( n+1 ), info )
428 CALL ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
429 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
430 $ work, ncycle, info )
435 CALL dcopy( n, alpha, 1, rwork, 1 )
443 DO 10 j = i + 1, ibnd
445 IF( temp.GT.smax )
THEN
451 rwork( k+isub ) = rwork( k+i )
453 iwork( k+i ) = k + isub
subroutine zggsvp(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, RWORK, TAU, WORK, INFO)
ZGGSVP
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, RWORK, IWORK, INFO)
ZGGSVD computes the singular value decomposition (SVD) for OTHER matrices
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