334 SUBROUTINE zggsvd( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
335 $ ldb, alpha, beta, u, ldu, v, ldv, q, ldq, work,
336 $ rwork, iwork, info )
344 CHARACTER jobq, jobu, jobv
345 INTEGER info, k, l, lda, ldb, ldq, ldu, ldv, m, n, p
349 DOUBLE PRECISION alpha( * ), beta( * ), rwork( * )
350 COMPLEX*16 a( lda, * ),
b( ldb, * ), q( ldq, * ),
351 $ u( ldu, * ), v( ldv, * ), work( * )
357 LOGICAL wantq, wantu, wantv
358 INTEGER i, ibnd, isub,
j, ncycle
359 DOUBLE PRECISION anorm, bnorm, smax, temp, tola, tolb, ulp, unfl
376 wantu =
lsame( jobu,
'U' )
377 wantv =
lsame( jobv,
'V' )
378 wantq =
lsame( jobq,
'Q' )
381 IF( .NOT.( wantu .OR.
lsame( jobu,
'N' ) ) )
THEN
383 ELSE IF( .NOT.( wantv .OR.
lsame( jobv,
'N' ) ) )
THEN
385 ELSE IF( .NOT.( wantq .OR.
lsame( jobq,
'N' ) ) )
THEN
387 ELSE IF( m.LT.0 )
THEN
389 ELSE IF( n.LT.0 )
THEN
391 ELSE IF( p.LT.0 )
THEN
393 ELSE IF( lda.LT.max( 1, m ) )
THEN
395 ELSE IF( ldb.LT.max( 1, p ) )
THEN
397 ELSE IF( ldu.LT.1 .OR. ( wantu .AND. ldu.LT.m ) )
THEN
399 ELSE IF( ldv.LT.1 .OR. ( wantv .AND. ldv.LT.p ) )
THEN
401 ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.n ) )
THEN
405 CALL
xerbla(
'ZGGSVD', -info )
411 anorm =
zlange(
'1', m, n, a, lda, rwork )
412 bnorm =
zlange(
'1', p, n,
b, ldb, rwork )
417 ulp =
dlamch(
'Precision' )
418 unfl =
dlamch(
'Safe Minimum' )
419 tola = max( m, n )*max( anorm, unfl )*ulp
420 tolb = max( p, n )*max( bnorm, unfl )*ulp
422 CALL
zggsvp( jobu, jobv, jobq, m, p, n, a, lda,
b, ldb, tola,
423 $ tolb, k, l, u, ldu, v, ldv, q, ldq, iwork, rwork,
424 $ work, work( n+1 ), info )
428 CALL
ztgsja( jobu, jobv, jobq, m, p, n, k, l, a, lda,
b, ldb,
429 $ tola, tolb, alpha, beta, u, ldu, v, ldv, q, ldq,
430 $ work, ncycle, info )
435 CALL
dcopy( n, alpha, 1, rwork, 1 )
443 DO 10
j = i + 1, ibnd
445 IF( temp.GT.smax )
THEN
451 rwork( k+isub ) = rwork( k+i )
453 iwork( k+i ) = k + isub
LOGICAL function lsame(CA, CB)
LSAME
subroutine zggsvp(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)
ZGGSVP
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zggsvd(JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B, LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK, RWORK, IWORK, INFO)
ZGGSVD computes the singular value decomposition (SVD) for OTHER matrices
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ztgsja(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)
ZTGSJA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH