Add tests for ?GELST (Reference-LAPACK PR739)
This commit is contained in:
Martin Kroeker
GitHub
parent
d0afbd8d29
commit
1497336b20
|
|
@ -608,17 +608,18 @@
|
|||
ELSE IF( LSAMEN( 2, P2, 'LS' ) ) THEN
|
||||
*
|
||||
* LS: Least Squares driver routines for
|
||||
* LS, LSD, LSS, LSX and LSY.
|
||||
* LS, LST, TSLS, LSD, LSS, LSX and LSY.
|
||||
*
|
||||
WRITE( IOUNIT, FMT = 9984 )PATH
|
||||
WRITE( IOUNIT, FMT = 9967 )
|
||||
WRITE( IOUNIT, FMT = 9921 )C1, C1, C1, C1
|
||||
WRITE( IOUNIT, FMT = 9921 )C1, C1, C1, C1, C1, C1
|
||||
WRITE( IOUNIT, FMT = 9935 )1
|
||||
WRITE( IOUNIT, FMT = 9931 )2
|
||||
WRITE( IOUNIT, FMT = 9933 )3
|
||||
WRITE( IOUNIT, FMT = 9935 )4
|
||||
WRITE( IOUNIT, FMT = 9934 )5
|
||||
WRITE( IOUNIT, FMT = 9932 )6
|
||||
WRITE( IOUNIT, FMT = 9919 )
|
||||
WRITE( IOUNIT, FMT = 9933 )7
|
||||
WRITE( IOUNIT, FMT = 9935 )8
|
||||
WRITE( IOUNIT, FMT = 9934 )9
|
||||
WRITE( IOUNIT, FMT = 9932 )10
|
||||
WRITE( IOUNIT, FMT = 9920 )
|
||||
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
|
||||
*
|
||||
|
|
@ -1048,10 +1049,11 @@
|
|||
$ 'check if X is in the row space of A or A'' ',
|
||||
$ '(overdetermined case)' )
|
||||
9929 FORMAT( ' Test ratios (1-3: ', A1, 'TZRZF):' )
|
||||
9920 FORMAT( 3X, ' 7-10: same as 3-6', 3X, ' 11-14: same as 3-6' )
|
||||
9921 FORMAT( ' Test ratios:', / ' (1-2: ', A1, 'GELS, 3-6: ', A1,
|
||||
$ 'GELSY, 7-10: ', A1, 'GELSS, 11-14: ', A1, 'GELSD, 15-16: ',
|
||||
$ A1, 'GETSLS)')
|
||||
9919 FORMAT( 3X, ' 3-4: same as 1-2', 3X, ' 5-6: same as 1-2' )
|
||||
9920 FORMAT( 3X, ' 11-14: same as 7-10', 3X, ' 15-18: same as 7-10' )
|
||||
9921 FORMAT( ' Test ratios:', / ' (1-2: ', A1, 'GELS, 3-4: ', A1,
|
||||
$ 'GELST, 5-6: ', A1, 'GETSLS, 7-10: ', A1, 'GELSY, 11-14: ',
|
||||
$ A1, 'GETSS, 15-18: ', A1, 'GELSD)' )
|
||||
9928 FORMAT( 7X, 'where ALPHA = ( 1 + SQRT( 17 ) ) / 8' )
|
||||
9927 FORMAT( 3X, I2, ': ABS( Largest element in L )', / 12X,
|
||||
$ ' - ( 1 / ( 1 - ALPHA ) ) + THRESH' )
|
||||
|
|
|
|||
|
|
@ -31,7 +31,8 @@
|
|||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> CDRVLS tests the least squares driver routines CGELS, CGETSLS, CGELSS, CGELSY
|
||||
*> CDRVLS tests the least squares driver routines CGELS, CGELST,
|
||||
*> CGETSLS, CGELSS, CGELSY
|
||||
*> and CGELSD.
|
||||
*> \endverbatim
|
||||
*
|
||||
|
|
@ -211,7 +212,7 @@
|
|||
*
|
||||
* .. Parameters ..
|
||||
INTEGER NTESTS
|
||||
PARAMETER ( NTESTS = 16 )
|
||||
PARAMETER ( NTESTS = 18 )
|
||||
INTEGER SMLSIZ
|
||||
PARAMETER ( SMLSIZ = 25 )
|
||||
REAL ONE, ZERO
|
||||
|
|
@ -228,8 +229,8 @@
|
|||
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
|
||||
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB,
|
||||
$ MMAX, NMAX, NSMAX, LIWORK, LRWORK,
|
||||
$ LWORK_CGELS, LWORK_CGETSLS, LWORK_CGELSS,
|
||||
$ LWORK_CGELSY, LWORK_CGELSD,
|
||||
$ LWORK_CGELS, LWORK_CGELST, LWORK_CGETSLS,
|
||||
$ LWORK_CGELSS, LWORK_CGELSY, LWORK_CGELSD,
|
||||
$ LRWORK_CGELSY, LRWORK_CGELSS, LRWORK_CGELSD
|
||||
REAL EPS, NORMA, NORMB, RCOND
|
||||
* ..
|
||||
|
|
@ -249,7 +250,7 @@
|
|||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAERH, ALAHD, ALASVM, CERRLS, CGELS, CGELSD,
|
||||
$ CGELSS, CGELSY, CGEMM, CGETSLS, CLACPY,
|
||||
$ CGELSS, CGELST, CGELSY, CGEMM, CGETSLS, CLACPY,
|
||||
$ CLARNV, CQRT13, CQRT15, CQRT16, CSSCAL,
|
||||
$ SAXPY, XLAENV
|
||||
* ..
|
||||
|
|
@ -334,7 +335,8 @@
|
|||
LIWORK = 1
|
||||
*
|
||||
* Iterate through all test cases and compute necessary workspace
|
||||
* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
|
||||
* sizes for ?GELS, ?GELST, ?GETSLS, ?GELSY, ?GELSS and ?GELSD
|
||||
* routines.
|
||||
*
|
||||
DO IM = 1, NM
|
||||
M = MVAL( IM )
|
||||
|
|
@ -361,6 +363,10 @@
|
|||
CALL CGELS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_CGELS = INT( WQ( 1 ) )
|
||||
* Compute workspace needed for CGELST
|
||||
CALL CGELST( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_CGELST = INT ( WQ ( 1 ) )
|
||||
* Compute workspace needed for CGETSLS
|
||||
CALL CGETSLS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
|
|
@ -425,21 +431,26 @@
|
|||
ITYPE = ( IRANK-1 )*3 + ISCALE
|
||||
IF( .NOT.DOTYPE( ITYPE ) )
|
||||
$ GO TO 100
|
||||
*
|
||||
* =====================================================
|
||||
* Begin test CGELS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Test CGELS
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL CQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 40 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
DO 30 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -484,15 +495,20 @@
|
|||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 1: Check correctness of results
|
||||
* for CGELS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL CQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, RWORK,
|
||||
$ RESULT( 1 ) )
|
||||
*
|
||||
* Test 2: Check correctness of results
|
||||
* for CGELS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
|
|
@ -515,7 +531,7 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 20 K = 1, 2
|
||||
DO K = 1, 2
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
@ -524,26 +540,157 @@
|
|||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
20 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
*
|
||||
*
|
||||
* Test CGETSLS
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test CGELS
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test CGELST
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL CQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 65 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
NCOLS = N
|
||||
ELSE
|
||||
TRANS = 'C'
|
||||
NROWS = N
|
||||
NCOLS = M
|
||||
END IF
|
||||
LDWORK = MAX( 1, NCOLS )
|
||||
*
|
||||
* Set up a consistent rhs
|
||||
*
|
||||
IF( NCOLS.GT.0 ) THEN
|
||||
CALL CLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL CSSCAL( NCOLS*NRHS,
|
||||
$ ONE / REAL( NCOLS ), WORK,
|
||||
$ 1 )
|
||||
END IF
|
||||
CALL CGEMM( TRANS, 'No transpose', NROWS,
|
||||
$ NRHS, NCOLS, CONE, COPYA, LDA,
|
||||
$ WORK, LDWORK, CZERO, B, LDB )
|
||||
CALL CLACPY( 'Full', NROWS, NRHS, B, LDB,
|
||||
$ COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL CLACPY( 'Full', M, N, COPYA, LDA,
|
||||
$ A, LDA )
|
||||
CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'CGELST'
|
||||
CALL CGELST( TRANS, M, N, NRHS, A, LDA, B,
|
||||
$ LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'CGELST', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Test 3: Check correctness of results
|
||||
* for CGELST, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL CQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, RWORK,
|
||||
$ RESULT( 3 ) )
|
||||
*
|
||||
* Test 4: Check correctness of results
|
||||
* for CGELST.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
*
|
||||
RESULT( 4 ) = CQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 4 ) = CQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO K = 3, 4
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9999 )TRANS, M,
|
||||
$ N, NRHS, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test CGELST
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test CGELSTSLS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL CQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
*
|
||||
* Loop for testing different block sizes MB.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
MB = NBVAL( INB )
|
||||
CALL XLAENV( 1, MB )
|
||||
DO 62 IMB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes NB.
|
||||
*
|
||||
DO IMB = 1, NNB
|
||||
NB = NBVAL( IMB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
DO 60 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed
|
||||
* and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -561,78 +708,91 @@
|
|||
CALL CLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL CSCAL( NCOLS*NRHS,
|
||||
$ CONE / REAL( NCOLS ), WORK,
|
||||
$ 1 )
|
||||
$ CONE / REAL( NCOLS ),
|
||||
$ WORK, 1 )
|
||||
END IF
|
||||
CALL CGEMM( TRANS, 'No transpose', NROWS,
|
||||
$ NRHS, NCOLS, CONE, COPYA, LDA,
|
||||
$ WORK, LDWORK, CZERO, B, LDB )
|
||||
CALL CLACPY( 'Full', NROWS, NRHS, B, LDB,
|
||||
$ COPYB, LDB )
|
||||
CALL CGEMM( TRANS, 'No transpose',
|
||||
$ NROWS, NRHS, NCOLS, CONE,
|
||||
$ COPYA, LDA, WORK, LDWORK,
|
||||
$ CZERO, B, LDB )
|
||||
CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ B, LDB, COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL CLACPY( 'Full', M, N, COPYA, LDA,
|
||||
$ A, LDA )
|
||||
CALL CLACPY( 'Full', M, N,
|
||||
$ COPYA, LDA, A, LDA )
|
||||
CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'CGETSLS '
|
||||
CALL CGETSLS( TRANS, M, N, NRHS, A,
|
||||
$ LDA, B, LDB, WORK, LWORK, INFO )
|
||||
$ LDA, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'CGETSLS ', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
$ CALL ALAERH( PATH, 'CGETSLS ', INFO,
|
||||
$ 0, TRANS, M, N, NRHS,
|
||||
$ -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 5: Check correctness of results
|
||||
* for CGETSLS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL CLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL CQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK2,
|
||||
$ RESULT( 15 ) )
|
||||
CALL CQRT16( TRANS, M, N, NRHS,
|
||||
$ COPYA, LDA, B, LDB,
|
||||
$ C, LDB, WORK2,
|
||||
$ RESULT( 5 ) )
|
||||
*
|
||||
* Test 6: Check correctness of results
|
||||
* for CGETSLS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 16 ) = CQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
RESULT( 6 ) = CQRT17( TRANS, 1, M,
|
||||
$ N, NRHS, COPYA, LDA,
|
||||
$ B, LDB, COPYB, LDB,
|
||||
$ C, WORK, LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 16 ) = CQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
RESULT( 6 ) = CQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B,
|
||||
$ LDB, WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 50 K = 15, 16
|
||||
DO K = 5, 6
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 )TRANS, M,
|
||||
$ N, NRHS, MB, NB, ITYPE, K,
|
||||
WRITE( NOUT, FMT = 9997 )TRANS,
|
||||
$ M, N, NRHS, MB, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
50 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
60 CONTINUE
|
||||
62 CONTINUE
|
||||
65 CONTINUE
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test CGELSTSLS
|
||||
* ====================================================
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE and rank
|
||||
* type IRANK.
|
||||
|
|
@ -680,37 +840,37 @@
|
|||
*
|
||||
* workspace used: 2*MNMIN+NB*NB+NB*MAX(N,NRHS)
|
||||
*
|
||||
* Test 3: Compute relative error in svd
|
||||
* Test 7: Compute relative error in svd
|
||||
* workspace: M*N + 4*MIN(M,N) + MAX(M,N)
|
||||
*
|
||||
RESULT( 3 ) = CQRT12( CRANK, CRANK, A, LDA,
|
||||
RESULT( 7 ) = CQRT12( CRANK, CRANK, A, LDA,
|
||||
$ COPYS, WORK, LWORK, RWORK )
|
||||
*
|
||||
* Test 4: Compute error in solution
|
||||
* Test 8: Compute error in solution
|
||||
* workspace: M*NRHS + M
|
||||
*
|
||||
CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 4 ) )
|
||||
$ RESULT( 8 ) )
|
||||
*
|
||||
* Test 5: Check norm of r'*A
|
||||
* Test 9: Check norm of r'*A
|
||||
* workspace: NRHS*(M+N)
|
||||
*
|
||||
RESULT( 5 ) = ZERO
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 5 ) = CQRT17( 'No transpose', 1, M,
|
||||
$ RESULT( 9 ) = CQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 6: Check if x is in the rowspace of A
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
* workspace: (M+NRHS)*(N+2)
|
||||
*
|
||||
RESULT( 6 ) = ZERO
|
||||
RESULT( 10 ) = ZERO
|
||||
*
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 6 ) = CQRT14( 'No transpose', M, N,
|
||||
$ RESULT( 10 ) = CQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
|
|
@ -736,62 +896,6 @@
|
|||
* workspace used: 3*min(m,n) +
|
||||
* max(2*min(m,n),nrhs,max(m,n))
|
||||
*
|
||||
* Test 7: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 7 ) = SASUM( MNMIN, S, 1 ) /
|
||||
$ SASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*REAL( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 7 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 8: Compute error in solution
|
||||
*
|
||||
CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 8 ) )
|
||||
*
|
||||
* Test 9: Check norm of r'*A
|
||||
*
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 9 ) = CQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 10 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 10 ) = CQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test CGELSD
|
||||
*
|
||||
* CGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
CALL XLAENV( 9, 25 )
|
||||
*
|
||||
CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'CGELSD'
|
||||
CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, RWORK,
|
||||
$ IWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'CGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 11: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
|
|
@ -827,10 +931,66 @@
|
|||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test CGELSD
|
||||
*
|
||||
* CGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
CALL XLAENV( 9, 25 )
|
||||
*
|
||||
CALL CLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'CGELSD'
|
||||
CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, RWORK,
|
||||
$ IWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'CGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 15: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 15 ) = SASUM( MNMIN, S, 1 ) /
|
||||
$ SASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*REAL( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 15 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 16: Compute error in solution
|
||||
*
|
||||
CALL CLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL CQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 16 ) )
|
||||
*
|
||||
* Test 17: Check norm of r'*A
|
||||
*
|
||||
RESULT( 17 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 17 ) = CQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 18: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 18 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 18 ) = CQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Print information about the tests that did not
|
||||
* pass the threshold.
|
||||
*
|
||||
DO 80 K = 3, 14
|
||||
DO 80 K = 7, 18
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
*> \verbatim
|
||||
*>
|
||||
*> CERRLS tests the error exits for the COMPLEX least squares
|
||||
*> driver routines (CGELS, CGELSS, CGELSY, CGELSD).
|
||||
*> driver routines (CGELS, CGELST, CGETSLS, CGELSS, CGELSY, CGELSD).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -83,7 +83,8 @@
|
|||
EXTERNAL LSAMEN
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAESM, CGELS, CGELSD, CGELSS, CGELSY, CHKXER
|
||||
EXTERNAL ALAESM, CHKXER, CGELS, CGELSD, CGELSS, CGELST,
|
||||
$ CGELSY, CGETSLS
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -130,10 +131,66 @@
|
|||
INFOT = 8
|
||||
CALL CGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGELS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGELS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL CGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* CGELST
|
||||
*
|
||||
SRNAMT = 'CGELST'
|
||||
INFOT = 1
|
||||
CALL CGELST( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGELST( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL CGELST( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGELST( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL CGELST( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGELST( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGELST( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL CGELST( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGELST', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* CGETSLS
|
||||
*
|
||||
SRNAMT = 'CGETSLS'
|
||||
INFOT = 1
|
||||
CALL CGETSLS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL CGETSLS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL CGETSLS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL CGETSLS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL CGETSLS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGETSLS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL CGETSLS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'CGETSLS', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* CGELSS
|
||||
*
|
||||
SRNAMT = 'CGELSS'
|
||||
|
|
|
|||
|
|
@ -31,8 +31,8 @@
|
|||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> DDRVLS tests the least squares driver routines DGELS, DGETSLS, DGELSS, DGELSY,
|
||||
*> and DGELSD.
|
||||
*> DDRVLS tests the least squares driver routines DGELS, DGELST,
|
||||
*> DGETSLS, DGELSS, DGELSY, and DGELSD.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -211,7 +211,7 @@
|
|||
*
|
||||
* .. Parameters ..
|
||||
INTEGER NTESTS
|
||||
PARAMETER ( NTESTS = 16 )
|
||||
PARAMETER ( NTESTS = 18 )
|
||||
INTEGER SMLSIZ
|
||||
PARAMETER ( SMLSIZ = 25 )
|
||||
DOUBLE PRECISION ONE, TWO, ZERO
|
||||
|
|
@ -225,8 +225,8 @@
|
|||
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
|
||||
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB,
|
||||
$ MMAX, NMAX, NSMAX, LIWORK,
|
||||
$ LWORK_DGELS, LWORK_DGETSLS, LWORK_DGELSS,
|
||||
$ LWORK_DGELSY, LWORK_DGELSD
|
||||
$ LWORK_DGELS, LWORK_DGELST, LWORK_DGETSLS,
|
||||
$ LWORK_DGELSS, LWORK_DGELSY, LWORK_DGELSD
|
||||
DOUBLE PRECISION EPS, NORMA, NORMB, RCOND
|
||||
* ..
|
||||
* .. Local Arrays ..
|
||||
|
|
@ -243,12 +243,12 @@
|
|||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAERH, ALAHD, ALASVM, DAXPY, DERRLS, DGELS,
|
||||
$ DGELSD, DGELSS, DGELSY, DGEMM, DLACPY,
|
||||
$ DLARNV, DLASRT, DQRT13, DQRT15, DQRT16, DSCAL,
|
||||
$ XLAENV
|
||||
$ DGELSD, DGELSS, DGELST, DGELSY, DGEMM,
|
||||
$ DGETSLS, DLACPY, DLARNV, DQRT13, DQRT15,
|
||||
$ DQRT16, DSCAL, XLAENV
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC DBLE, INT, LOG, MAX, MIN, SQRT
|
||||
INTRINSIC DBLE, INT, MAX, MIN, SQRT
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -330,7 +330,8 @@
|
|||
LIWORK = 1
|
||||
*
|
||||
* Iterate through all test cases and compute necessary workspace
|
||||
* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
|
||||
* sizes for ?GELS, ?GELST, ?GETSLS, ?GELSY, ?GELSS and ?GELSD
|
||||
* routines.
|
||||
*
|
||||
DO IM = 1, NM
|
||||
M = MVAL( IM )
|
||||
|
|
@ -357,6 +358,10 @@
|
|||
CALL DGELS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_DGELS = INT ( WQ ( 1 ) )
|
||||
* Compute workspace needed for DGELST
|
||||
CALL DGELST( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_DGELST = INT ( WQ ( 1 ) )
|
||||
* Compute workspace needed for DGETSLS
|
||||
CALL DGETSLS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
|
|
@ -378,9 +383,9 @@
|
|||
* Compute LIWORK workspace needed for DGELSY and DGELSD
|
||||
LIWORK = MAX( LIWORK, N, IWQ( 1 ) )
|
||||
* Compute LWORK workspace needed for all functions
|
||||
LWORK = MAX( LWORK, LWORK_DGELS, LWORK_DGETSLS,
|
||||
$ LWORK_DGELSY, LWORK_DGELSS,
|
||||
$ LWORK_DGELSD )
|
||||
LWORK = MAX( LWORK, LWORK_DGELS, LWORK_DGELST,
|
||||
$ LWORK_DGETSLS, LWORK_DGELSY,
|
||||
$ LWORK_DGELSS, LWORK_DGELSD )
|
||||
END IF
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
|
@ -411,21 +416,26 @@
|
|||
ITYPE = ( IRANK-1 )*3 + ISCALE
|
||||
IF( .NOT.DOTYPE( ITYPE ) )
|
||||
$ GO TO 110
|
||||
*
|
||||
* =====================================================
|
||||
* Begin test DGELS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Test DGELS
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL DQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 40 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
DO 30 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -469,20 +479,27 @@
|
|||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 1: Check correctness of results
|
||||
* for DGELS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL DQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK,
|
||||
$ RESULT( 1 ) )
|
||||
*
|
||||
* Test 2: Check correctness of results
|
||||
* for DGELS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 2 ) = DQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
|
|
@ -500,35 +517,42 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 20 K = 1, 2
|
||||
DO K = 1, 2
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9999 )TRANS, M,
|
||||
WRITE( NOUT, FMT = 9999 ) TRANS, M,
|
||||
$ N, NRHS, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
20 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
*
|
||||
*
|
||||
* Test DGETSLS
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test DGELS
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test DGELST
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL DQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 65 INB = 1, NNB
|
||||
MB = NBVAL( INB )
|
||||
CALL XLAENV( 1, MB )
|
||||
DO 62 IMB = 1, NNB
|
||||
NB = NBVAL( IMB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
DO 60 ITRAN = 1, 2
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
*
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -563,31 +587,38 @@
|
|||
CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'DGETSLS '
|
||||
CALL DGETSLS( TRANS, M, N, NRHS, A,
|
||||
$ LDA, B, LDB, WORK, LWORK, INFO )
|
||||
SRNAMT = 'DGELST'
|
||||
CALL DGELST( TRANS, M, N, NRHS, A, LDA, B,
|
||||
$ LDB, WORK, LWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'DGETSLS ', INFO, 0,
|
||||
$ CALL ALAERH( PATH, 'DGELST', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 3: Check correctness of results
|
||||
* for DGELST, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL DQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK,
|
||||
$ RESULT( 15 ) )
|
||||
$ RESULT( 3 ) )
|
||||
*
|
||||
* Test 4: Check correctness of results
|
||||
* for DGELST.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 16 ) = DQRT17( TRANS, 1, M, N,
|
||||
RESULT( 4 ) = DQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
|
|
@ -595,7 +626,7 @@
|
|||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 16 ) = DQRT14( TRANS, M, N,
|
||||
RESULT( 4 ) = DQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
END IF
|
||||
|
|
@ -603,21 +634,151 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 50 K = 15, 16
|
||||
DO K = 3, 4
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 )TRANS, M,
|
||||
$ N, NRHS, MB, NB, ITYPE, K,
|
||||
WRITE( NOUT, FMT = 9999 ) TRANS, M,
|
||||
$ N, NRHS, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
50 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
60 CONTINUE
|
||||
62 CONTINUE
|
||||
65 CONTINUE
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test DGELST
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test DGETSLS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL DQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
*
|
||||
* Loop for testing different block sizes MB.
|
||||
*
|
||||
DO IMB = 1, NNB
|
||||
MB = NBVAL( IMB )
|
||||
CALL XLAENV( 1, MB )
|
||||
*
|
||||
* Loop for testing different block sizes NB.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
* Loop for testing non-transposed
|
||||
* and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
NCOLS = N
|
||||
ELSE
|
||||
TRANS = 'T'
|
||||
NROWS = N
|
||||
NCOLS = M
|
||||
END IF
|
||||
LDWORK = MAX( 1, NCOLS )
|
||||
*
|
||||
* Set up a consistent rhs
|
||||
*
|
||||
IF( NCOLS.GT.0 ) THEN
|
||||
CALL DLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL DSCAL( NCOLS*NRHS,
|
||||
$ ONE / DBLE( NCOLS ),
|
||||
$ WORK, 1 )
|
||||
END IF
|
||||
CALL DGEMM( TRANS, 'No transpose',
|
||||
$ NROWS, NRHS, NCOLS, ONE,
|
||||
$ COPYA, LDA, WORK, LDWORK,
|
||||
$ ZERO, B, LDB )
|
||||
CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ B, LDB, COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL DLACPY( 'Full', M, N,
|
||||
$ COPYA, LDA, A, LDA )
|
||||
CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'DGETSLS'
|
||||
CALL DGETSLS( TRANS, M, N, NRHS,
|
||||
$ A, LDA, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'DGETSLS', INFO,
|
||||
$ 0, TRANS, M, N, NRHS,
|
||||
$ -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 5: Check correctness of results
|
||||
* for DGETSLS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL DLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL DQRT16( TRANS, M, N, NRHS,
|
||||
$ COPYA, LDA, B, LDB,
|
||||
$ C, LDB, WORK,
|
||||
$ RESULT( 5 ) )
|
||||
*
|
||||
* Test 6: Check correctness of results
|
||||
* for DGETSLS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 6 ) = DQRT17( TRANS, 1, M,
|
||||
$ N, NRHS, COPYA, LDA,
|
||||
$ B, LDB, COPYB, LDB,
|
||||
$ C, WORK, LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 6 ) = DQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA,
|
||||
$ B, LDB, WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO K = 5, 6
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 ) TRANS,
|
||||
$ M, N, NRHS, MB, NB, ITYPE,
|
||||
$ K, RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test DGETSLS
|
||||
* =====================================================
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE and rank
|
||||
* type IRANK.
|
||||
|
|
@ -662,37 +823,37 @@
|
|||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 3: Compute relative error in svd
|
||||
* Test 7: Compute relative error in svd
|
||||
* workspace: M*N + 4*MIN(M,N) + MAX(M,N)
|
||||
*
|
||||
RESULT( 3 ) = DQRT12( CRANK, CRANK, A, LDA,
|
||||
RESULT( 7 ) = DQRT12( CRANK, CRANK, A, LDA,
|
||||
$ COPYS, WORK, LWORK )
|
||||
*
|
||||
* Test 4: Compute error in solution
|
||||
* Test 8: Compute error in solution
|
||||
* workspace: M*NRHS + M
|
||||
*
|
||||
CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL DQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 4 ) )
|
||||
$ WORK( M*NRHS+1 ), RESULT( 8 ) )
|
||||
*
|
||||
* Test 5: Check norm of r'*A
|
||||
* Test 9: Check norm of r'*A
|
||||
* workspace: NRHS*(M+N)
|
||||
*
|
||||
RESULT( 5 ) = ZERO
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 5 ) = DQRT17( 'No transpose', 1, M,
|
||||
$ RESULT( 9 ) = DQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 6: Check if x is in the rowspace of A
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
* workspace: (M+NRHS)*(N+2)
|
||||
*
|
||||
RESULT( 6 ) = ZERO
|
||||
RESULT( 10 ) = ZERO
|
||||
*
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 6 ) = DQRT14( 'No transpose', M, N,
|
||||
$ RESULT( 10 ) = DQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
|
|
@ -716,66 +877,6 @@
|
|||
* workspace used: 3*min(m,n) +
|
||||
* max(2*min(m,n),nrhs,max(m,n))
|
||||
*
|
||||
* Test 7: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL DAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 7 ) = DASUM( MNMIN, S, 1 ) /
|
||||
$ DASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*DBLE( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 7 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 8: Compute error in solution
|
||||
*
|
||||
CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL DQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 8 ) )
|
||||
*
|
||||
* Test 9: Check norm of r'*A
|
||||
*
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 9 ) = DQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 10 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 10 ) = DQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test DGELSD
|
||||
*
|
||||
* DGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
* Initialize vector IWORK.
|
||||
*
|
||||
DO 80 J = 1, N
|
||||
IWORK( J ) = 0
|
||||
80 CONTINUE
|
||||
*
|
||||
CALL DLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'DGELSD'
|
||||
CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, IWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'DGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 11: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
|
|
@ -811,10 +912,70 @@
|
|||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test DGELSD
|
||||
*
|
||||
* DGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
* Initialize vector IWORK.
|
||||
*
|
||||
DO 80 J = 1, N
|
||||
IWORK( J ) = 0
|
||||
80 CONTINUE
|
||||
*
|
||||
CALL DLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'DGELSD'
|
||||
CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, IWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'DGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 15: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL DAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 15 ) = DASUM( MNMIN, S, 1 ) /
|
||||
$ DASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*DBLE( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 15 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 16: Compute error in solution
|
||||
*
|
||||
CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL DQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 16 ) )
|
||||
*
|
||||
* Test 17: Check norm of r'*A
|
||||
*
|
||||
RESULT( 17 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 17 ) = DQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 18: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 18 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 18 ) = DQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Print information about the tests that did not
|
||||
* pass the threshold.
|
||||
*
|
||||
DO 90 K = 3, 14
|
||||
DO 90 K = 7, 18
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
@ -826,6 +987,12 @@
|
|||
NRUN = NRUN + 12
|
||||
*
|
||||
100 CONTINUE
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
110 CONTINUE
|
||||
120 CONTINUE
|
||||
130 CONTINUE
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
*> \verbatim
|
||||
*>
|
||||
*> DERRLS tests the error exits for the DOUBLE PRECISION least squares
|
||||
*> driver routines (DGELS, SGELSS, SGELSY, SGELSD).
|
||||
*> driver routines (DGELS, DGELST, DGETSLS, SGELSS, SGELSY, SGELSD).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -83,7 +83,8 @@
|
|||
EXTERNAL LSAMEN
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELSY
|
||||
EXTERNAL ALAESM, CHKXER, DGELS, DGELSD, DGELSS, DGELST,
|
||||
$ DGELSY, DGETSLS
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -130,10 +131,66 @@
|
|||
INFOT = 8
|
||||
CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGELS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* DGELST
|
||||
*
|
||||
SRNAMT = 'DGELST'
|
||||
INFOT = 1
|
||||
CALL DGELST( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL DGELST( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL DGELST( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGELST( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL DGELST( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGELST( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGELST( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL DGELST( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGELST', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* DGETSLS
|
||||
*
|
||||
SRNAMT = 'DGETSLS'
|
||||
INFOT = 1
|
||||
CALL DGETSLS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL DGETSLS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL DGETSLS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL DGETSLS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL DGETSLS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGETSLS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL DGETSLS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGETSLS', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* DGELSS
|
||||
*
|
||||
SRNAMT = 'DGELSS'
|
||||
|
|
|
|||
|
|
@ -31,8 +31,8 @@
|
|||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> SDRVLS tests the least squares driver routines SGELS, SGETSLS, SGELSS, SGELSY,
|
||||
*> and SGELSD.
|
||||
*> SDRVLS tests the least squares driver routines SGELS, SGELST,
|
||||
*> SGETSLS, SGELSS, SGELSY and SGELSD.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -211,7 +211,7 @@
|
|||
*
|
||||
* .. Parameters ..
|
||||
INTEGER NTESTS
|
||||
PARAMETER ( NTESTS = 16 )
|
||||
PARAMETER ( NTESTS = 18 )
|
||||
INTEGER SMLSIZ
|
||||
PARAMETER ( SMLSIZ = 25 )
|
||||
REAL ONE, TWO, ZERO
|
||||
|
|
@ -225,8 +225,8 @@
|
|||
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
|
||||
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB,
|
||||
$ MMAX, NMAX, NSMAX, LIWORK,
|
||||
$ LWORK_SGELS, LWORK_SGETSLS, LWORK_SGELSS,
|
||||
$ LWORK_SGELSY, LWORK_SGELSD
|
||||
$ LWORK_SGELS, LWORK_SGELST, LWORK_SGETSLS,
|
||||
$ LWORK_SGELSS, LWORK_SGELSY, LWORK_SGELSD
|
||||
REAL EPS, NORMA, NORMB, RCOND
|
||||
* ..
|
||||
* .. Local Arrays ..
|
||||
|
|
@ -243,12 +243,12 @@
|
|||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAERH, ALAHD, ALASVM, SAXPY, SERRLS, SGELS,
|
||||
$ SGELSD, SGELSS, SGELSY, SGEMM, SLACPY,
|
||||
$ SLARNV, SQRT13, SQRT15, SQRT16, SSCAL,
|
||||
$ XLAENV, SGETSLS
|
||||
$ SGELSD, SGELSS, SGELST, SGELSY, SGEMM,
|
||||
$ SGETSLS, SLACPY, SLARNV, SQRT13, SQRT15,
|
||||
$ SQRT16, SSCAL, XLAENV
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC INT, LOG, MAX, MIN, REAL, SQRT
|
||||
INTRINSIC INT, MAX, MIN, REAL, SQRT
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -330,7 +330,8 @@
|
|||
LIWORK = 1
|
||||
*
|
||||
* Iterate through all test cases and compute necessary workspace
|
||||
* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
|
||||
* sizes for ?GELS, ?GELST, ?GETSLS, ?GELSY, ?GELSS and ?GELSD
|
||||
* routines.
|
||||
*
|
||||
DO IM = 1, NM
|
||||
M = MVAL( IM )
|
||||
|
|
@ -357,6 +358,10 @@
|
|||
CALL SGELS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ( 1 ), -1, INFO )
|
||||
LWORK_SGELS = INT ( WQ( 1 ) )
|
||||
* Compute workspace needed for SGELST
|
||||
CALL SGELST( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_SGELST = INT ( WQ ( 1 ) )
|
||||
* Compute workspace needed for SGETSLS
|
||||
CALL SGETSLS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ( 1 ), -1, INFO )
|
||||
|
|
@ -378,9 +383,9 @@
|
|||
* Compute LIWORK workspace needed for SGELSY and SGELSD
|
||||
LIWORK = MAX( LIWORK, N, IWQ( 1 ) )
|
||||
* Compute LWORK workspace needed for all functions
|
||||
LWORK = MAX( LWORK, LWORK_SGELS, LWORK_SGETSLS,
|
||||
$ LWORK_SGELSY, LWORK_SGELSS,
|
||||
$ LWORK_SGELSD )
|
||||
LWORK = MAX( LWORK, LWORK_SGELS, LWORK_SGELST,
|
||||
$ LWORK_SGETSLS, LWORK_SGELSY,
|
||||
$ LWORK_SGELSS, LWORK_SGELSD )
|
||||
END IF
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
|
@ -411,21 +416,26 @@
|
|||
ITYPE = ( IRANK-1 )*3 + ISCALE
|
||||
IF( .NOT.DOTYPE( ITYPE ) )
|
||||
$ GO TO 110
|
||||
*
|
||||
* =====================================================
|
||||
* Begin test SGELS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Test SGELS
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL SQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 40 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
DO 30 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -469,20 +479,27 @@
|
|||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 1: Check correctness of results
|
||||
* for SGELS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL SQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK,
|
||||
$ RESULT( 1 ) )
|
||||
*
|
||||
* Test 2: Check correctness of results
|
||||
* for SGELS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 2 ) = SQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
|
|
@ -500,7 +517,7 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 20 K = 1, 2
|
||||
DO K = 1, 2
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
@ -509,26 +526,33 @@
|
|||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
20 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
*
|
||||
*
|
||||
* Test SGETSLS
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test SGELS
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test SGELST
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL SQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 65 INB = 1, NNB
|
||||
MB = NBVAL( INB )
|
||||
CALL XLAENV( 1, MB )
|
||||
DO 62 IMB = 1, NNB
|
||||
NB = NBVAL( IMB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
DO 60 ITRAN = 1, 2
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
*
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -563,31 +587,38 @@
|
|||
CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'SGETSLS '
|
||||
CALL SGETSLS( TRANS, M, N, NRHS, A,
|
||||
$ LDA, B, LDB, WORK, LWORK, INFO )
|
||||
SRNAMT = 'SGELST'
|
||||
CALL SGELST( TRANS, M, N, NRHS, A, LDA, B,
|
||||
$ LDB, WORK, LWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'SGETSLS ', INFO, 0,
|
||||
$ CALL ALAERH( PATH, 'SGELST', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 3: Check correctness of results
|
||||
* for SGELST, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL SQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK,
|
||||
$ RESULT( 15 ) )
|
||||
$ RESULT( 3 ) )
|
||||
*
|
||||
* Test 4: Check correctness of results
|
||||
* for SGELST.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 16 ) = SQRT17( TRANS, 1, M, N,
|
||||
RESULT( 4 ) = SQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
|
|
@ -595,7 +626,7 @@
|
|||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 16 ) = SQRT14( TRANS, M, N,
|
||||
RESULT( 4 ) = SQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
END IF
|
||||
|
|
@ -603,21 +634,151 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 50 K = 15, 16
|
||||
DO K = 3, 4
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 )TRANS, M,
|
||||
$ N, NRHS, MB, NB, ITYPE, K,
|
||||
WRITE( NOUT, FMT = 9999 ) TRANS, M,
|
||||
$ N, NRHS, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
50 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
60 CONTINUE
|
||||
62 CONTINUE
|
||||
65 CONTINUE
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test SGELST
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test SGETSLS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL SQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
*
|
||||
* Loop for testing different block sizes MB.
|
||||
*
|
||||
DO IMB = 1, NNB
|
||||
MB = NBVAL( IMB )
|
||||
CALL XLAENV( 1, MB )
|
||||
*
|
||||
* Loop for testing different block sizes NB.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
* Loop for testing non-transposed
|
||||
* and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
NCOLS = N
|
||||
ELSE
|
||||
TRANS = 'T'
|
||||
NROWS = N
|
||||
NCOLS = M
|
||||
END IF
|
||||
LDWORK = MAX( 1, NCOLS )
|
||||
*
|
||||
* Set up a consistent rhs
|
||||
*
|
||||
IF( NCOLS.GT.0 ) THEN
|
||||
CALL SLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL SSCAL( NCOLS*NRHS,
|
||||
$ ONE / REAL( NCOLS ),
|
||||
$ WORK, 1 )
|
||||
END IF
|
||||
CALL SGEMM( TRANS, 'No transpose',
|
||||
$ NROWS, NRHS, NCOLS, ONE,
|
||||
$ COPYA, LDA, WORK, LDWORK,
|
||||
$ ZERO, B, LDB )
|
||||
CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ B, LDB, COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL SLACPY( 'Full', M, N,
|
||||
$ COPYA, LDA, A, LDA )
|
||||
CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'SGETSLS'
|
||||
CALL SGETSLS( TRANS, M, N, NRHS,
|
||||
$ A, LDA, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'SGETSLS', INFO,
|
||||
$ 0, TRANS, M, N, NRHS,
|
||||
$ -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 5: Check correctness of results
|
||||
* for SGETSLS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL SLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL SQRT16( TRANS, M, N, NRHS,
|
||||
$ COPYA, LDA, B, LDB,
|
||||
$ C, LDB, WORK,
|
||||
$ RESULT( 5 ) )
|
||||
*
|
||||
* Test 6: Check correctness of results
|
||||
* for SGETSLS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 6 ) = SQRT17( TRANS, 1, M,
|
||||
$ N, NRHS, COPYA, LDA,
|
||||
$ B, LDB, COPYB, LDB,
|
||||
$ C, WORK, LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 6 ) = SQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA,
|
||||
$ B, LDB, WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO K = 5, 6
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 ) TRANS,
|
||||
$ M, N, NRHS, MB, NB, ITYPE,
|
||||
$ K, RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test SGETSLS
|
||||
* =====================================================
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE and rank
|
||||
* type IRANK.
|
||||
|
|
@ -662,37 +823,37 @@
|
|||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 3: Compute relative error in svd
|
||||
* Test 7: Compute relative error in svd
|
||||
* workspace: M*N + 4*MIN(M,N) + MAX(M,N)
|
||||
*
|
||||
RESULT( 3 ) = SQRT12( CRANK, CRANK, A, LDA,
|
||||
RESULT( 7 ) = SQRT12( CRANK, CRANK, A, LDA,
|
||||
$ COPYS, WORK, LWORK )
|
||||
*
|
||||
* Test 4: Compute error in solution
|
||||
* Test 8: Compute error in solution
|
||||
* workspace: M*NRHS + M
|
||||
*
|
||||
CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL SQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 4 ) )
|
||||
$ WORK( M*NRHS+1 ), RESULT( 8 ) )
|
||||
*
|
||||
* Test 5: Check norm of r'*A
|
||||
* Test 9: Check norm of r'*A
|
||||
* workspace: NRHS*(M+N)
|
||||
*
|
||||
RESULT( 5 ) = ZERO
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 5 ) = SQRT17( 'No transpose', 1, M,
|
||||
$ RESULT( 9 ) = SQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 6: Check if x is in the rowspace of A
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
* workspace: (M+NRHS)*(N+2)
|
||||
*
|
||||
RESULT( 6 ) = ZERO
|
||||
RESULT( 10 ) = ZERO
|
||||
*
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 6 ) = SQRT14( 'No transpose', M, N,
|
||||
$ RESULT( 10 ) = SQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
|
|
@ -716,66 +877,6 @@
|
|||
* workspace used: 3*min(m,n) +
|
||||
* max(2*min(m,n),nrhs,max(m,n))
|
||||
*
|
||||
* Test 7: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 7 ) = SASUM( MNMIN, S, 1 ) /
|
||||
$ SASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*REAL( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 7 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 8: Compute error in solution
|
||||
*
|
||||
CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL SQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 8 ) )
|
||||
*
|
||||
* Test 9: Check norm of r'*A
|
||||
*
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 9 ) = SQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 10 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 10 ) = SQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test SGELSD
|
||||
*
|
||||
* SGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
* Initialize vector IWORK.
|
||||
*
|
||||
DO 80 J = 1, N
|
||||
IWORK( J ) = 0
|
||||
80 CONTINUE
|
||||
*
|
||||
CALL SLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'SGELSD'
|
||||
CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, IWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'SGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 11: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
|
|
@ -811,10 +912,70 @@
|
|||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test SGELSD
|
||||
*
|
||||
* SGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
* Initialize vector IWORK.
|
||||
*
|
||||
DO 80 J = 1, N
|
||||
IWORK( J ) = 0
|
||||
80 CONTINUE
|
||||
*
|
||||
CALL SLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'SGELSD'
|
||||
CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, IWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'SGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 15: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL SAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 15 ) = SASUM( MNMIN, S, 1 ) /
|
||||
$ SASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*REAL( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 15 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 16: Compute error in solution
|
||||
*
|
||||
CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL SQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK,
|
||||
$ WORK( M*NRHS+1 ), RESULT( 16 ) )
|
||||
*
|
||||
* Test 17: Check norm of r'*A
|
||||
*
|
||||
RESULT( 17 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 17 ) = SQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 18: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 18 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 18 ) = SQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Print information about the tests that did not
|
||||
* pass the threshold.
|
||||
*
|
||||
DO 90 K = 3, 14
|
||||
DO 90 K = 7, 18
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
*> \verbatim
|
||||
*>
|
||||
*> SERRLS tests the error exits for the REAL least squares
|
||||
*> driver routines (SGELS, SGELSS, SGELSY, SGELSD).
|
||||
*> driver routines (SGELS, SGELST, SGETSLS, SGELSS, SGELSY, SGELSD).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -83,7 +83,8 @@
|
|||
EXTERNAL LSAMEN
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSY
|
||||
EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELST,
|
||||
$ SGELSY, SGETSLS
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -130,10 +131,66 @@
|
|||
INFOT = 8
|
||||
CALL SGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGELS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'DGELS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* SGELST
|
||||
*
|
||||
SRNAMT = 'SGELST'
|
||||
INFOT = 1
|
||||
CALL SGELST( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL SGELST( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL SGELST( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGELST( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL SGELST( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGELST( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGELST( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL SGELST( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGELST', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* SGETSLS
|
||||
*
|
||||
SRNAMT = 'SGETSLS'
|
||||
INFOT = 1
|
||||
CALL SGETSLS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL SGETSLS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL SGETSLS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL SGETSLS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL SGETSLS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGETSLS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL SGETSLS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'SGETSLS', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* SGELSS
|
||||
*
|
||||
SRNAMT = 'SGELSS'
|
||||
|
|
|
|||
|
|
@ -31,8 +31,8 @@
|
|||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> ZDRVLS tests the least squares driver routines ZGELS, ZGETSLS, ZGELSS, ZGELSY
|
||||
*> and ZGELSD.
|
||||
*> ZDRVLS tests the least squares driver routines ZGELS, ZGELST,
|
||||
*> ZGETSLS, ZGELSS, ZGELSY and ZGELSD.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -211,7 +211,7 @@
|
|||
*
|
||||
* .. Parameters ..
|
||||
INTEGER NTESTS
|
||||
PARAMETER ( NTESTS = 16 )
|
||||
PARAMETER ( NTESTS = 18 )
|
||||
INTEGER SMLSIZ
|
||||
PARAMETER ( SMLSIZ = 25 )
|
||||
DOUBLE PRECISION ONE, ZERO
|
||||
|
|
@ -228,8 +228,8 @@
|
|||
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
|
||||
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB,
|
||||
$ MMAX, NMAX, NSMAX, LIWORK, LRWORK,
|
||||
$ LWORK_ZGELS, LWORK_ZGETSLS, LWORK_ZGELSS,
|
||||
$ LWORK_ZGELSY, LWORK_ZGELSD,
|
||||
$ LWORK_ZGELS, LWORK_ZGELST, LWORK_ZGETSLS,
|
||||
$ LWORK_ZGELSS, LWORK_ZGELSY, LWORK_ZGELSD,
|
||||
$ LRWORK_ZGELSY, LRWORK_ZGELSS, LRWORK_ZGELSD
|
||||
DOUBLE PRECISION EPS, NORMA, NORMB, RCOND
|
||||
* ..
|
||||
|
|
@ -248,10 +248,10 @@
|
|||
EXTERNAL DASUM, DLAMCH, ZQRT12, ZQRT14, ZQRT17
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAERH, ALAHD, ALASVM, DAXPY, DLASRT, XLAENV,
|
||||
$ ZDSCAL, ZERRLS, ZGELS, ZGELSD, ZGELSS,
|
||||
$ ZGELSY, ZGEMM, ZLACPY, ZLARNV, ZQRT13, ZQRT15,
|
||||
$ ZQRT16, ZGETSLS
|
||||
EXTERNAL ALAERH, ALAHD, ALASVM, DAXPY, ZERRLS, ZGELS,
|
||||
$ ZGELSD, ZGELSS, ZGELST, ZGELSY, ZGEMM,
|
||||
$ ZGETSLS, ZLACPY, ZLARNV, ZQRT13, ZQRT15,
|
||||
$ ZQRT16, ZDSCAL, XLAENV
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC DBLE, MAX, MIN, INT, SQRT
|
||||
|
|
@ -334,7 +334,8 @@
|
|||
LIWORK = 1
|
||||
*
|
||||
* Iterate through all test cases and compute necessary workspace
|
||||
* sizes for ?GELS, ?GETSLS, ?GELSY, ?GELSS and ?GELSD routines.
|
||||
* sizes for ?GELS, ?GELST, ?GETSLS, ?GELSY, ?GELSS and ?GELSD
|
||||
* routines.
|
||||
*
|
||||
DO IM = 1, NM
|
||||
M = MVAL( IM )
|
||||
|
|
@ -361,6 +362,10 @@
|
|||
CALL ZGELS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_ZGELS = INT ( WQ( 1 ) )
|
||||
* Compute workspace needed for ZGELST
|
||||
CALL ZGELST( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
LWORK_ZGELST = INT ( WQ ( 1 ) )
|
||||
* Compute workspace needed for ZGETSLS
|
||||
CALL ZGETSLS( TRANS, M, N, NRHS, A, LDA,
|
||||
$ B, LDB, WQ, -1, INFO )
|
||||
|
|
@ -390,9 +395,9 @@
|
|||
LRWORK = MAX( LRWORK, LRWORK_ZGELSY,
|
||||
$ LRWORK_ZGELSS, LRWORK_ZGELSD )
|
||||
* Compute LWORK workspace needed for all functions
|
||||
LWORK = MAX( LWORK, LWORK_ZGELS, LWORK_ZGETSLS,
|
||||
$ LWORK_ZGELSY, LWORK_ZGELSS,
|
||||
$ LWORK_ZGELSD )
|
||||
LWORK = MAX( LWORK, LWORK_ZGELS, LWORK_ZGELST,
|
||||
$ LWORK_ZGETSLS, LWORK_ZGELSY,
|
||||
$ LWORK_ZGELSS, LWORK_ZGELSD )
|
||||
END IF
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
|
@ -425,21 +430,26 @@
|
|||
ITYPE = ( IRANK-1 )*3 + ISCALE
|
||||
IF( .NOT.DOTYPE( ITYPE ) )
|
||||
$ GO TO 100
|
||||
*
|
||||
* =====================================================
|
||||
* Begin test ZGELS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Test ZGELS
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL ZQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 40 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
DO 30 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -484,15 +494,20 @@
|
|||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 1: Check correctness of results
|
||||
* for ZGELS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL ZQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, RWORK,
|
||||
$ RESULT( 1 ) )
|
||||
*
|
||||
* Test 2: Check correctness of results
|
||||
* for ZGELS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
|
|
@ -515,7 +530,7 @@
|
|||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 20 K = 1, 2
|
||||
DO K = 1, 2
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
@ -524,26 +539,157 @@
|
|||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
20 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
30 CONTINUE
|
||||
40 CONTINUE
|
||||
*
|
||||
*
|
||||
* Test ZGETSLS
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test ZGELS
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test ZGELST
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL ZQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
DO 65 INB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
NB = NBVAL( INB )
|
||||
CALL XLAENV( 1, NB )
|
||||
CALL XLAENV( 3, NXVAL( INB ) )
|
||||
*
|
||||
* Loop for testing non-transposed and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
NCOLS = N
|
||||
ELSE
|
||||
TRANS = 'C'
|
||||
NROWS = N
|
||||
NCOLS = M
|
||||
END IF
|
||||
LDWORK = MAX( 1, NCOLS )
|
||||
*
|
||||
* Set up a consistent rhs
|
||||
*
|
||||
IF( NCOLS.GT.0 ) THEN
|
||||
CALL ZLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL ZDSCAL( NCOLS*NRHS,
|
||||
$ ONE / DBLE( NCOLS ), WORK,
|
||||
$ 1 )
|
||||
END IF
|
||||
CALL ZGEMM( TRANS, 'No transpose', NROWS,
|
||||
$ NRHS, NCOLS, CONE, COPYA, LDA,
|
||||
$ WORK, LDWORK, CZERO, B, LDB )
|
||||
CALL ZLACPY( 'Full', NROWS, NRHS, B, LDB,
|
||||
$ COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL ZLACPY( 'Full', M, N, COPYA, LDA,
|
||||
$ A, LDA )
|
||||
CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'ZGELST'
|
||||
CALL ZGELST( TRANS, M, N, NRHS, A, LDA, B,
|
||||
$ LDB, WORK, LWORK, INFO )
|
||||
*
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'ZGELST', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
*
|
||||
* Test 3: Check correctness of results
|
||||
* for ZGELST, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL ZQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, RWORK,
|
||||
$ RESULT( 3 ) )
|
||||
*
|
||||
* Test 4: Check correctness of results
|
||||
* for ZGELST.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
*
|
||||
RESULT( 4 ) = ZQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 4 ) = ZQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO K = 3, 4
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9999 )TRANS, M,
|
||||
$ N, NRHS, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test ZGELST
|
||||
* =====================================================
|
||||
* =====================================================
|
||||
* Begin test ZGELSTSLS
|
||||
* =====================================================
|
||||
IF( IRANK.EQ.1 ) THEN
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE
|
||||
*
|
||||
CALL ZQRT13( ISCALE, M, N, COPYA, LDA, NORMA,
|
||||
$ ISEED )
|
||||
*
|
||||
* Loop for testing different block sizes MB.
|
||||
*
|
||||
DO INB = 1, NNB
|
||||
MB = NBVAL( INB )
|
||||
CALL XLAENV( 1, MB )
|
||||
DO 62 IMB = 1, NNB
|
||||
*
|
||||
* Loop for testing different block sizes NB.
|
||||
*
|
||||
DO IMB = 1, NNB
|
||||
NB = NBVAL( IMB )
|
||||
CALL XLAENV( 2, NB )
|
||||
*
|
||||
DO 60 ITRAN = 1, 2
|
||||
* Loop for testing non-transposed
|
||||
* and transposed.
|
||||
*
|
||||
DO ITRAN = 1, 2
|
||||
IF( ITRAN.EQ.1 ) THEN
|
||||
TRANS = 'N'
|
||||
NROWS = M
|
||||
|
|
@ -561,78 +707,91 @@
|
|||
CALL ZLARNV( 2, ISEED, NCOLS*NRHS,
|
||||
$ WORK )
|
||||
CALL ZSCAL( NCOLS*NRHS,
|
||||
$ CONE / DBLE( NCOLS ), WORK,
|
||||
$ 1 )
|
||||
$ CONE / DBLE( NCOLS ),
|
||||
$ WORK, 1 )
|
||||
END IF
|
||||
CALL ZGEMM( TRANS, 'No transpose', NROWS,
|
||||
$ NRHS, NCOLS, CONE, COPYA, LDA,
|
||||
$ WORK, LDWORK, CZERO, B, LDB )
|
||||
CALL ZLACPY( 'Full', NROWS, NRHS, B, LDB,
|
||||
$ COPYB, LDB )
|
||||
CALL ZGEMM( TRANS, 'No transpose',
|
||||
$ NROWS, NRHS, NCOLS, CONE,
|
||||
$ COPYA, LDA, WORK, LDWORK,
|
||||
$ CZERO, B, LDB )
|
||||
CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ B, LDB, COPYB, LDB )
|
||||
*
|
||||
* Solve LS or overdetermined system
|
||||
*
|
||||
IF( M.GT.0 .AND. N.GT.0 ) THEN
|
||||
CALL ZLACPY( 'Full', M, N, COPYA, LDA,
|
||||
$ A, LDA )
|
||||
CALL ZLACPY( 'Full', M, N,
|
||||
$ COPYA, LDA, A, LDA )
|
||||
CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, B, LDB )
|
||||
END IF
|
||||
SRNAMT = 'ZGETSLS '
|
||||
CALL ZGETSLS( TRANS, M, N, NRHS, A,
|
||||
$ LDA, B, LDB, WORK, LWORK, INFO )
|
||||
$ LDA, B, LDB, WORK, LWORK,
|
||||
$ INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'ZGETSLS ', INFO, 0,
|
||||
$ TRANS, M, N, NRHS, -1, NB,
|
||||
$ ITYPE, NFAIL, NERRS,
|
||||
$ NOUT )
|
||||
$ CALL ALAERH( PATH, 'ZGETSLS ', INFO,
|
||||
$ 0, TRANS, M, N, NRHS,
|
||||
$ -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Check correctness of results
|
||||
* Test 5: Check correctness of results
|
||||
* for ZGETSLS, compute the residual:
|
||||
* RESID = norm(B - A*X) /
|
||||
* / ( max(m,n) * norm(A) * norm(X) * EPS )
|
||||
*
|
||||
LDWORK = MAX( 1, NROWS )
|
||||
IF( NROWS.GT.0 .AND. NRHS.GT.0 )
|
||||
$ CALL ZLACPY( 'Full', NROWS, NRHS,
|
||||
$ COPYB, LDB, C, LDB )
|
||||
CALL ZQRT16( TRANS, M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, C, LDB, WORK2,
|
||||
$ RESULT( 15 ) )
|
||||
CALL ZQRT16( TRANS, M, N, NRHS,
|
||||
$ COPYA, LDA, B, LDB,
|
||||
$ C, LDB, WORK2,
|
||||
$ RESULT( 5 ) )
|
||||
*
|
||||
* Test 6: Check correctness of results
|
||||
* for ZGETSLS.
|
||||
*
|
||||
IF( ( ITRAN.EQ.1 .AND. M.GE.N ) .OR.
|
||||
$ ( ITRAN.EQ.2 .AND. M.LT.N ) ) THEN
|
||||
*
|
||||
* Solving LS system
|
||||
* Solving LS system, compute:
|
||||
* r = norm((B- A*X)**T * A) /
|
||||
* / (norm(A)*norm(B)*max(M,N,NRHS)*EPS)
|
||||
*
|
||||
RESULT( 16 ) = ZQRT17( TRANS, 1, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK,
|
||||
$ LWORK )
|
||||
RESULT( 6 ) = ZQRT17( TRANS, 1, M,
|
||||
$ N, NRHS, COPYA, LDA,
|
||||
$ B, LDB, COPYB, LDB,
|
||||
$ C, WORK, LWORK )
|
||||
ELSE
|
||||
*
|
||||
* Solving overdetermined system
|
||||
*
|
||||
RESULT( 16 ) = ZQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
RESULT( 6 ) = ZQRT14( TRANS, M, N,
|
||||
$ NRHS, COPYA, LDA, B,
|
||||
$ LDB, WORK, LWORK )
|
||||
END IF
|
||||
*
|
||||
* Print information about the tests that
|
||||
* did not pass the threshold.
|
||||
*
|
||||
DO 50 K = 15, 16
|
||||
DO K = 5, 6
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
WRITE( NOUT, FMT = 9997 )TRANS, M,
|
||||
$ N, NRHS, MB, NB, ITYPE, K,
|
||||
WRITE( NOUT, FMT = 9997 )TRANS,
|
||||
$ M, N, NRHS, MB, NB, ITYPE, K,
|
||||
$ RESULT( K )
|
||||
NFAIL = NFAIL + 1
|
||||
END IF
|
||||
50 CONTINUE
|
||||
END DO
|
||||
NRUN = NRUN + 2
|
||||
60 CONTINUE
|
||||
62 CONTINUE
|
||||
65 CONTINUE
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END IF
|
||||
* =====================================================
|
||||
* End test ZGELSTSLS
|
||||
* =====================================================
|
||||
*
|
||||
* Generate a matrix of scaling type ISCALE and rank
|
||||
* type IRANK.
|
||||
|
|
@ -680,37 +839,37 @@
|
|||
*
|
||||
* workspace used: 2*MNMIN+NB*NB+NB*MAX(N,NRHS)
|
||||
*
|
||||
* Test 3: Compute relative error in svd
|
||||
* Test 7: Compute relative error in svd
|
||||
* workspace: M*N + 4*MIN(M,N) + MAX(M,N)
|
||||
*
|
||||
RESULT( 3 ) = ZQRT12( CRANK, CRANK, A, LDA,
|
||||
RESULT( 7 ) = ZQRT12( CRANK, CRANK, A, LDA,
|
||||
$ COPYS, WORK, LWORK, RWORK )
|
||||
*
|
||||
* Test 4: Compute error in solution
|
||||
* Test 8: Compute error in solution
|
||||
* workspace: M*NRHS + M
|
||||
*
|
||||
CALL ZLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL ZQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 4 ) )
|
||||
$ RESULT( 8 ) )
|
||||
*
|
||||
* Test 5: Check norm of r'*A
|
||||
* Test 9: Check norm of r'*A
|
||||
* workspace: NRHS*(M+N)
|
||||
*
|
||||
RESULT( 5 ) = ZERO
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 5 ) = ZQRT17( 'No transpose', 1, M,
|
||||
$ RESULT( 9 ) = ZQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 6: Check if x is in the rowspace of A
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
* workspace: (M+NRHS)*(N+2)
|
||||
*
|
||||
RESULT( 6 ) = ZERO
|
||||
RESULT( 10 ) = ZERO
|
||||
*
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 6 ) = ZQRT14( 'No transpose', M, N,
|
||||
$ RESULT( 10 ) = ZQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
|
|
@ -736,62 +895,6 @@
|
|||
* workspace used: 3*min(m,n) +
|
||||
* max(2*min(m,n),nrhs,max(m,n))
|
||||
*
|
||||
* Test 7: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL DAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 7 ) = DASUM( MNMIN, S, 1 ) /
|
||||
$ DASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*DBLE( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 7 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 8: Compute error in solution
|
||||
*
|
||||
CALL ZLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL ZQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 8 ) )
|
||||
*
|
||||
* Test 9: Check norm of r'*A
|
||||
*
|
||||
RESULT( 9 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 9 ) = ZQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 10: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 10 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 10 ) = ZQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test ZGELSD
|
||||
*
|
||||
* ZGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
CALL XLAENV( 9, 25 )
|
||||
*
|
||||
CALL ZLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL ZLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'ZGELSD'
|
||||
CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, RWORK,
|
||||
$ IWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'ZGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 11: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
|
|
@ -827,10 +930,66 @@
|
|||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Test ZGELSD
|
||||
*
|
||||
* ZGELSD: Compute the minimum-norm solution X
|
||||
* to min( norm( A * X - B ) ) using a
|
||||
* divide and conquer SVD.
|
||||
*
|
||||
CALL XLAENV( 9, 25 )
|
||||
*
|
||||
CALL ZLACPY( 'Full', M, N, COPYA, LDA, A, LDA )
|
||||
CALL ZLACPY( 'Full', M, NRHS, COPYB, LDB, B,
|
||||
$ LDB )
|
||||
*
|
||||
SRNAMT = 'ZGELSD'
|
||||
CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S,
|
||||
$ RCOND, CRANK, WORK, LWORK, RWORK,
|
||||
$ IWORK, INFO )
|
||||
IF( INFO.NE.0 )
|
||||
$ CALL ALAERH( PATH, 'ZGELSD', INFO, 0, ' ', M,
|
||||
$ N, NRHS, -1, NB, ITYPE, NFAIL,
|
||||
$ NERRS, NOUT )
|
||||
*
|
||||
* Test 15: Compute relative error in svd
|
||||
*
|
||||
IF( RANK.GT.0 ) THEN
|
||||
CALL DAXPY( MNMIN, -ONE, COPYS, 1, S, 1 )
|
||||
RESULT( 15 ) = DASUM( MNMIN, S, 1 ) /
|
||||
$ DASUM( MNMIN, COPYS, 1 ) /
|
||||
$ ( EPS*DBLE( MNMIN ) )
|
||||
ELSE
|
||||
RESULT( 15 ) = ZERO
|
||||
END IF
|
||||
*
|
||||
* Test 16: Compute error in solution
|
||||
*
|
||||
CALL ZLACPY( 'Full', M, NRHS, COPYB, LDB, WORK,
|
||||
$ LDWORK )
|
||||
CALL ZQRT16( 'No transpose', M, N, NRHS, COPYA,
|
||||
$ LDA, B, LDB, WORK, LDWORK, RWORK,
|
||||
$ RESULT( 16 ) )
|
||||
*
|
||||
* Test 17: Check norm of r'*A
|
||||
*
|
||||
RESULT( 17 ) = ZERO
|
||||
IF( M.GT.CRANK )
|
||||
$ RESULT( 17 ) = ZQRT17( 'No transpose', 1, M,
|
||||
$ N, NRHS, COPYA, LDA, B, LDB,
|
||||
$ COPYB, LDB, C, WORK, LWORK )
|
||||
*
|
||||
* Test 18: Check if x is in the rowspace of A
|
||||
*
|
||||
RESULT( 18 ) = ZERO
|
||||
IF( N.GT.CRANK )
|
||||
$ RESULT( 18 ) = ZQRT14( 'No transpose', M, N,
|
||||
$ NRHS, COPYA, LDA, B, LDB,
|
||||
$ WORK, LWORK )
|
||||
*
|
||||
* Print information about the tests that did not
|
||||
* pass the threshold.
|
||||
*
|
||||
DO 80 K = 3, 14
|
||||
DO 80 K = 7, 18
|
||||
IF( RESULT( K ).GE.THRESH ) THEN
|
||||
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
|
||||
$ CALL ALAHD( NOUT, PATH )
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
*> \verbatim
|
||||
*>
|
||||
*> ZERRLS tests the error exits for the COMPLEX*16 least squares
|
||||
*> driver routines (ZGELS, CGELSS, CGELSY, CGELSD).
|
||||
*> driver routines (ZGELS, ZGELST, ZGETSLS, CGELSS, CGELSY, CGELSD).
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
|
|
@ -83,7 +83,8 @@
|
|||
EXTERNAL LSAMEN
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL ALAESM, CHKXER, ZGELS, ZGELSD, ZGELSS, ZGELSY
|
||||
EXTERNAL ALAESM, CHKXER, ZGELS, ZGELSD, ZGELSS, ZGELST,
|
||||
$ ZGELSY, ZGETSLS
|
||||
* ..
|
||||
* .. Scalars in Common ..
|
||||
LOGICAL LERR, OK
|
||||
|
|
@ -130,10 +131,66 @@
|
|||
INFOT = 8
|
||||
CALL ZGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGELS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGELS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL ZGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELS ', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* ZGELST
|
||||
*
|
||||
SRNAMT = 'ZGELST'
|
||||
INFOT = 1
|
||||
CALL ZGELST( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGELST( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL ZGELST( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGELST( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL ZGELST( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGELST( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGELST( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 10
|
||||
CALL ZGELST( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGELST', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* ZGETSLS
|
||||
*
|
||||
SRNAMT = 'ZGETSLS'
|
||||
INFOT = 1
|
||||
CALL ZGETSLS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 2
|
||||
CALL ZGETSLS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 3
|
||||
CALL ZGETSLS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 4
|
||||
CALL ZGETSLS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 6
|
||||
CALL ZGETSLS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGETSLS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
INFOT = 8
|
||||
CALL ZGETSLS( 'N', 0, 2, 0, A, 1, B, 1, W, 2, INFO )
|
||||
CALL CHKXER( 'ZGETSLS', INFOT, NOUT, LERR, OK )
|
||||
*
|
||||
* ZGELSS
|
||||
*
|
||||
SRNAMT = 'ZGELSS'
|
||||
|
|
|
|||
Loading…
Reference in New Issue