337 SUBROUTINE cggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
338 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
339 $ rwork, iwork, info )
347 CHARACTER JOBQ, JOBU, JOBV
348 INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
352 REAL ALPHA( * ), BETA( * ), RWORK( * )
353 COMPLEX A( lda, * ), B( ldb, * ), Q( ldq, * ),
354 $ u( ldu, * ), v( ldv, * ), work( * )
360 LOGICAL WANTQ, WANTU, WANTV
361 INTEGER I, IBND, ISUB, J, NCYCLE
362 REAL ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL
367 EXTERNAL lsame, clange, slamch
379 wantu = lsame( jobu,
'U' )
380 wantv = lsame( jobv,
'V' )
381 wantq = lsame( jobq,
'Q' )
384 IF( .NOT.( wantu .OR. lsame( jobu,
'N' ) ) )
THEN
386 ELSE IF( .NOT.( wantv .OR. lsame( jobv,
'N' ) ) )
THEN
388 ELSE IF( .NOT.( wantq .OR. lsame( jobq,
'N' ) ) )
THEN
390 ELSE IF( m.LT.0 )
THEN
392 ELSE IF( n.LT.0 )
THEN
394 ELSE IF( p.LT.0 )
THEN
396 ELSE IF( lda.LT.max( 1, m ) )
THEN
398 ELSE IF( ldb.LT.max( 1, p ) )
THEN
400 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
402 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
404 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
408 CALL xerbla(
'CGGSVD', -info )
414 anorm = clange(
'1', m, n, a, lda, rwork )
415 bnorm = clange(
'1', p, n, b, ldb, rwork )
420 ulp = slamch(
'Precision' )
421 unfl = slamch(
'Safe Minimum' )
422 tola = max( m, n )*max( anorm, unfl )*ulp
423 tolb = max( p, n )*max( bnorm, unfl )*ulp
425 CALL cggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
426 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
427 $ work, work( n+1 ), info )
431 CALL ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
432 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
433 $ work, ncycle, info )
438 CALL scopy( n, alpha, 1, rwork, 1 )
446 DO 10 j = i + 1, ibnd
448 IF( temp.GT.smax )
THEN
454 rwork( k+isub ) = rwork( k+i )
456 iwork( k+i ) = k + isub
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, RWORK, IWORK, INFO)
CGGSVD computes the singular value decomposition (SVD) for OTHER matrices
subroutine cggsvp(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)
CGGSVP
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