336 SUBROUTINE zggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
337 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
338 $ rwork, iwork, info )
346 CHARACTER JOBQ, JOBU, JOBV
347 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
351 DOUBLE PRECISION ALPHA( * ), BETA( * ), RWORK( * )
352 COMPLEX*16 A( lda, * ), B( ldb, * ), Q( ldq, * ),
353 $ u( ldu, * ), v( ldv, * ), work( * )
359 LOGICAL WANTQ, WANTU, WANTV
360 INTEGER I, IBND, ISUB, J, NCYCLE
361 DOUBLE PRECISION ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
365 DOUBLE PRECISION DLAMCH, ZLANGE
366 EXTERNAL lsame, dlamch, zlange
378 wantu = lsame( jobu,
'U' )
379 wantv = lsame( jobv,
'V' )
380 wantq = lsame( jobq,
'Q' )
383 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
385 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
387 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
389 ELSE IF( m.LT.0 )
THEN
391 ELSE IF( n.LT.0 )
THEN
393 ELSE IF( p.LT.0 )
THEN
395 ELSE IF( lda.LT.max( 1, m ) )
THEN
397 ELSE IF( ldb.LT.max( 1, p ) )
THEN
399 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
401 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
403 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
407 CALL xerbla(
'ZGGSVD', -info )
413 anorm = zlange(
'1', m, n, a, lda, rwork )
414 bnorm = zlange(
'1', p, n, b, ldb, rwork )
419 ulp = dlamch(
'Precision' )
420 unfl = dlamch(
'Safe Minimum' )
421 tola = max( m, n )*max( anorm, unfl )*ulp
422 tolb = max( p, n )*max( bnorm, unfl )*ulp
424 CALL zggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
425 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
426 $ work, work( n+1 ), info )
430 CALL ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
431 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
432 $ work, ncycle, info )
437 CALL dcopy( n, alpha, 1, rwork, 1 )
445 DO 10 j = i + 1, ibnd
447 IF( temp.GT.smax )
THEN
453 rwork( k+isub ) = rwork( k+i )
455 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 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 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