331 SUBROUTINE dggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
332 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
341 CHARACTER jobq, jobu, jobv
342 INTEGER info, k, l, lda, ldb, ldq, ldu, ldv, m, n, p
346 DOUBLE PRECISION a( lda, * ), alpha( * ), b( ldb, * ),
347 $ beta( * ), q( ldq, * ), u( ldu, * ),
348 $ v( ldv, * ), work( * )
354 LOGICAL wantq, wantu, wantv
355 INTEGER i, ibnd, isub, j, ncycle
356 DOUBLE PRECISION anorm, bnorm, smax, temp, tola, tolb, ulp, unfl
373 wantu =
lsame( jobu,
'U' )
374 wantv =
lsame( jobv,
'V' )
375 wantq =
lsame( jobq,
'Q' )
378 IF( .NOT.( wantu .OR.
lsame( jobu,
'N' ) ) )
THEN
380 ELSE IF( .NOT.( wantv .OR.
lsame( jobv,
'N' ) ) )
THEN
382 ELSE IF( .NOT.( wantq .OR.
lsame( jobq,
'N' ) ) )
THEN
384 ELSE IF( m.LT.0 )
THEN
386 ELSE IF( n.LT.0 )
THEN
388 ELSE IF( p.LT.0 )
THEN
390 ELSE IF( lda.LT.max( 1, m ) )
THEN
392 ELSE IF( ldb.LT.max( 1, p ) )
THEN
394 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
396 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
398 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
402 CALL
xerbla(
'DGGSVD', -info )
408 anorm =
dlange(
'1', m, n, a, lda, work )
409 bnorm =
dlange(
'1', p, n, b, ldb, work )
414 ulp =
dlamch(
'Precision' )
415 unfl =
dlamch(
'Safe Minimum' )
416 tola = max( m, n )*max( anorm, unfl )*ulp
417 tolb = max( p, n )*max( bnorm, unfl )*ulp
421 CALL
dggsvp( jobu, jobv, jobq, m, p, n, a, lda, b, ldb, tola,
422 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, work,
423 $ work( n+1 ), info )
427 CALL
dtgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda, b, ldb,
428 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
429 $ work, ncycle, info )
434 CALL
dcopy( n, alpha, 1, work, 1 )
442 DO 10 j = i + 1, ibnd
444 IF( temp.GT.smax )
THEN
450 work( k+isub ) = work( k+i )
452 iwork( k+i ) = k + isub