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
LOGICAL function lsame(CA, CB)
LSAME
subroutine dtgsja(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)
DTGSJA
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, IWORK, INFO)
DGGSVD computes the singular value decomposition (SVD) for OTHER matrices
DOUBLE PRECISION function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine dggsvp(JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ, IWORK, TAU, WORK, INFO)
DGGSVP
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH