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
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
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 xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
REAL function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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