version 1.3, 2010/08/13 21:03:44
|
version 1.4, 2010/12/21 13:48:05
|
Line 2
|
Line 2
|
& M, N, A, LDA, SVA, U, LDU, V, LDV, |
& M, N, A, LDA, SVA, U, LDU, V, LDV, |
& WORK, LWORK, IWORK, INFO ) |
& WORK, LWORK, IWORK, INFO ) |
* |
* |
* -- LAPACK routine (version 3.2.2) -- |
* -- LAPACK routine (version 3.3.0) -- |
* |
* |
* -- Contributed by Zlatko Drmac of the University of Zagreb and -- |
* -- Contributed by Zlatko Drmac of the University of Zagreb and -- |
* -- Kresimir Veselic of the Fernuniversitaet Hagen -- |
* -- Kresimir Veselic of the Fernuniversitaet Hagen -- |
* -- June 2010 -- |
* November 2010 |
* |
* |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
Line 489
|
Line 489
|
GOSCAL = .TRUE. |
GOSCAL = .TRUE. |
DO 1874 p = 1, N |
DO 1874 p = 1, N |
AAPP = ZERO |
AAPP = ZERO |
AAQQ = ZERO |
AAQQ = ONE |
CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ ) |
CALL DLASSQ( M, A(1,p), 1, AAPP, AAQQ ) |
IF ( AAPP .GT. BIG ) THEN |
IF ( AAPP .GT. BIG ) THEN |
INFO = - 9 |
INFO = - 9 |
Line 612
|
Line 612
|
IF ( L2TRAN ) THEN |
IF ( L2TRAN ) THEN |
DO 1950 p = 1, M |
DO 1950 p = 1, M |
XSC = ZERO |
XSC = ZERO |
TEMP1 = ZERO |
TEMP1 = ONE |
CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 ) |
CALL DLASSQ( N, A(p,1), LDA, XSC, TEMP1 ) |
* DLASSQ gets both the ell_2 and the ell_infinity norm |
* DLASSQ gets both the ell_2 and the ell_infinity norm |
* in one pass through the vector |
* in one pass through the vector |
Line 643
|
Line 643
|
IF ( L2TRAN ) THEN |
IF ( L2TRAN ) THEN |
* |
* |
XSC = ZERO |
XSC = ZERO |
TEMP1 = ZERO |
TEMP1 = ONE |
CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) |
CALL DLASSQ( N, SVA, 1, XSC, TEMP1 ) |
TEMP1 = ONE / TEMP1 |
TEMP1 = ONE / TEMP1 |
* |
* |
Line 697
|
Line 697
|
KILL = LSVEC |
KILL = LSVEC |
LSVEC = RSVEC |
LSVEC = RSVEC |
RSVEC = KILL |
RSVEC = KILL |
|
IF ( LSVEC ) N1 = N |
* |
* |
ROWPIV = .TRUE. |
ROWPIV = .TRUE. |
END IF |
END IF |
Line 1475
|
Line 1476
|
* Assemble the left singular vector matrix U (M x N). |
* Assemble the left singular vector matrix U (M x N). |
* |
* |
IF ( N .LT. M ) THEN |
IF ( N .LT. M ) THEN |
CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(NR+1,1), LDU ) |
CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(N+1,1), LDU ) |
IF ( N .LT. N1 ) THEN |
IF ( N .LT. N1 ) THEN |
CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) |
CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) |
CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(NR+1,N+1),LDU ) |
CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(N+1,N+1),LDU ) |
END IF |
END IF |
END IF |
END IF |
CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, |
CALL DORMQR( 'Left', 'No Tr', M, N1, N, A, LDA, WORK, U, |
Line 1582
|
Line 1583
|
* At this moment, V contains the right singular vectors of A. |
* At this moment, V contains the right singular vectors of A. |
* Next, assemble the left singular vector matrix U (M x N). |
* Next, assemble the left singular vector matrix U (M x N). |
* |
* |
IF ( N .LT. M ) THEN |
IF ( NR .LT. M ) THEN |
CALL DLASET( 'A', M-N, N, ZERO, ZERO, U(NR+1,1), LDU ) |
CALL DLASET( 'A', M-NR, NR, ZERO, ZERO, U(NR+1,1), LDU ) |
IF ( N .LT. N1 ) THEN |
IF ( NR .LT. N1 ) THEN |
CALL DLASET( 'A',N, N1-N, ZERO, ZERO, U(1,N+1),LDU ) |
CALL DLASET( 'A',NR, N1-NR, ZERO, ZERO, U(1,NR+1),LDU ) |
CALL DLASET( 'A',M-N,N1-N, ZERO, ONE,U(NR+1,N+1),LDU ) |
CALL DLASET( 'A',M-NR,N1-NR, ZERO, ONE,U(NR+1,NR+1),LDU ) |
END IF |
END IF |
END IF |
END IF |
* |
* |