335 SUBROUTINE cggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
336 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
337 $ rwork, iwork, info )
345 CHARACTER jobq, jobu, jobv
346 INTEGER info, k, l, lda, ldb, ldq, ldu, ldv, m, n, p
350 REAL alpha( * ), beta( * ), rwork( * )
351 COMPLEX a( lda, * ), b( ldb, * ), q( ldq, * ),
352 $ u( ldu, * ), v( ldv, * ), work( * )
358 LOGICAL wantq, wantu, wantv
359 INTEGER i, ibnd, isub, j, ncycle
360 REAL anorm, bnorm, smax, temp, tola, tolb, ulp, unfl
377 wantu =
lsame( jobu,
'U' )
378 wantv =
lsame( jobv,
'V' )
379 wantq =
lsame( jobq,
'Q' )
382 IF( .NOT.( wantu .OR.
lsame( jobu,
'N' ) ) )
THEN
384 ELSE IF( .NOT.( wantv .OR.
lsame( jobv,
'N' ) ) )
THEN
386 ELSE IF( .NOT.( wantq .OR.
lsame( jobq,
'N' ) ) )
THEN
388 ELSE IF( m.LT.0 )
THEN
390 ELSE IF( n.LT.0 )
THEN
392 ELSE IF( p.LT.0 )
THEN
394 ELSE IF( lda.LT.max( 1, m ) )
THEN
396 ELSE IF( ldb.LT.max( 1, p ) )
THEN
398 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
400 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
402 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
406 CALL
xerbla(
'CGGSVD', -info )
412 anorm =
clange(
'1', m, n, a, lda, rwork )
413 bnorm =
clange(
'1', p, n, b, ldb, rwork )
418 ulp =
slamch(
'Precision' )
419 unfl =
slamch(
'Safe Minimum' )
420 tola = max( m, n )*max( anorm, unfl )*ulp
421 tolb = max( p, n )*max( bnorm, unfl )*ulp
423 CALL
cggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
424 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
425 $ work, work( n+1 ), info )
429 CALL
ctgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
430 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
431 $ work, ncycle, info )
436 CALL
scopy( n, alpha, 1, rwork, 1 )
444 DO 10 j = i + 1, ibnd
446 IF( temp.GT.smax )
THEN
452 rwork( k+isub ) = rwork( k+i )
454 iwork( k+i ) = k + isub