version 1.7, 2017/06/17 11:06:29
|
version 1.10, 2023/08/07 08:39:01
|
Line 36
|
Line 36
|
* |
* |
* |
* |
*> \par Purpose: |
*> \par Purpose: |
*> ============= |
* ============= |
*> |
*> |
*>\verbatim |
*>\verbatim |
*> |
*> |
Line 224
|
Line 224
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date July 2012 |
|
* |
|
*> \ingroup doubleOTHERcomputational |
*> \ingroup doubleOTHERcomputational |
* |
* |
* ===================================================================== |
* ===================================================================== |
Line 236
|
Line 234
|
* -- LAPACK computational routine (3.5.0) -- |
* -- LAPACK computational routine (3.5.0) -- |
* -- 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..-- |
* July 2012 |
|
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
CHARACTER JOBU1, JOBU2, JOBV1T |
CHARACTER JOBU1, JOBU2, JOBV1T |
Line 583
|
Line 580
|
* Simultaneously diagonalize X11 and X21. |
* Simultaneously diagonalize X11 and X21. |
* |
* |
CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, |
CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, |
$ WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2, |
$ WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2, |
$ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), |
$ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), |
$ WORK(IB12E), WORK(IB21D), WORK(IB21E), |
$ WORK(IB12E), WORK(IB21D), WORK(IB21E), |
$ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, |
$ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, |
Line 638
|
Line 635
|
* Simultaneously diagonalize X11 and X21. |
* Simultaneously diagonalize X11 and X21. |
* |
* |
CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, |
CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, |
$ THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2, |
$ THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2, |
$ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), |
$ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), |
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), |
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), |
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), |
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), |
Line 674
|
Line 671
|
* |
* |
* Accumulate Householder reflectors |
* Accumulate Householder reflectors |
* |
* |
|
IF( WANTU2 .AND. M-P .GT. 0 ) THEN |
|
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) |
|
END IF |
IF( WANTU1 .AND. P .GT. 0 ) THEN |
IF( WANTU1 .AND. P .GT. 0 ) THEN |
CALL DCOPY( P, WORK(IORBDB), 1, U1, 1 ) |
CALL DCOPY( P, WORK(IORBDB), 1, U1, 1 ) |
DO J = 2, P |
DO J = 2, P |
Line 685
|
Line 685
|
$ WORK(IORGQR), LORGQR, CHILDINFO ) |
$ WORK(IORGQR), LORGQR, CHILDINFO ) |
END IF |
END IF |
IF( WANTU2 .AND. M-P .GT. 0 ) THEN |
IF( WANTU2 .AND. M-P .GT. 0 ) THEN |
CALL DCOPY( M-P, WORK(IORBDB+P), 1, U2, 1 ) |
|
DO J = 2, M-P |
DO J = 2, M-P |
U2(1,J) = ZERO |
U2(1,J) = ZERO |
END DO |
END DO |
Line 707
|
Line 706
|
* Simultaneously diagonalize X11 and X21. |
* Simultaneously diagonalize X11 and X21. |
* |
* |
CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, |
CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, |
$ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2, |
$ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1, |
$ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), |
$ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), |
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), |
$ WORK(IB12D), WORK(IB12E), WORK(IB21D), |
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), |
$ WORK(IB21E), WORK(IB22D), WORK(IB22E), |