353 SUBROUTINE cggsvd3( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
354 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq,
355 $ work, lwork, rwork, iwork, info )
363 CHARACTER JOBQ, JOBU, JOBV
364 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P,
369 REAL ALPHA( * ), BETA( * ), RWORK( * )
370 COMPLEX A( lda, * ), B( ldb, * ), Q( ldq, * ),
371 $ u( ldu, * ), v( ldv, * ), work( * )
377 LOGICAL WANTQ, WANTU, WANTV, LQUERY
378 INTEGER I, IBND, ISUB, J, NCYCLE, LWKOPT
379 REAL ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
384 EXTERNAL lsame, clange, slamch
396 wantu = lsame( jobu,
'U' )
397 wantv = lsame( jobv,
'V' )
398 wantq = lsame( jobq,
'Q' )
399 lquery = ( lwork.EQ.-1 )
405 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
407 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
409 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
411 ELSE IF( m.LT.0 )
THEN
413 ELSE IF( n.LT.0 )
THEN
415 ELSE IF( p.LT.0 )
THEN
417 ELSE IF( lda.LT.max( 1, m ) )
THEN
419 ELSE IF( ldb.LT.max( 1, p ) )
THEN
421 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
423 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
425 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
427 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
434 CALL cggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
435 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
436 $ work, work, -1, info )
437 lwkopt = n + int( work( 1 ) )
438 lwkopt = max( 2*n, lwkopt )
439 lwkopt = max( 1, lwkopt )
440 work( 1 ) = cmplx( lwkopt )
444 CALL xerbla(
'CGGSVD3', -info )
453 anorm = clange(
'1', m, n, a, lda, rwork )
454 bnorm = clange(
'1', p, n, b, ldb, rwork )
459 ulp = slamch(
'Precision' )
460 unfl = slamch(
'Safe Minimum' )
461 tola = max( m, n )*max( anorm, unfl )*ulp
462 tolb = max( p, n )*max( bnorm, unfl )*ulp
464 CALL cggsvp3( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
465 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
466 $ work, work( n+1 ), lwork-n, info )
470 CALL ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
471 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
472 $ work, ncycle, info )
477 CALL scopy( n, alpha, 1, rwork, 1 )
485 DO 10 j = i + 1, ibnd
487 IF( temp.GT.smax )
THEN
493 rwork( k+isub ) = rwork( k+i )
495 iwork( k+i ) = k + isub
501 work( 1 ) = cmplx( lwkopt )
subroutine cggsvp3(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)
CGGSVP3
subroutine cggsvd3(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)
CGGSVD3 computes the singular value decomposition (SVD) for OTHER matrices
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctgsja(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)
CTGSJA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY