floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Update LAPACK to 3.9.0

This commit is contained in:
Martin Kroeker 2019-12-30 16:41:31 +01:00 committed by GitHub
parent ab74361a0c
commit abbc7941ff
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
48 changed files with 1038 additions and 455 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
lapack-netlib/TESTING/EIG/Makefile
View File

@ -1,5 +1,3 @@
include ../../make.inc
######################################################################## ########################################################################
# This is the makefile for the eigenvalue test program from LAPACK. # This is the makefile for the eigenvalue test program from LAPACK.
# The test files are organized as follows: # The test files are organized as follows:
@ -33,6 +31,9 @@ include ../../make.inc
# #
######################################################################## ########################################################################
TOPSRCDIR = ../..
include $(TOPSRCDIR)/make.inc
AEIGTST = \ AEIGTST = \
alahdg.o \ alahdg.o \
alasum.o \ alasum.o \
@ -117,24 +118,26 @@ ZEIGTST = zchkee.o \
zsgt01.o zslect.o \ zsgt01.o zslect.o \
zstt21.o zstt22.o zunt01.o zunt03.o zstt21.o zstt22.o zunt01.o zunt03.o
.PHONY: all
all: single complex double complex16 all: single complex double complex16
.PHONY: single complex double complex16
single: xeigtsts single: xeigtsts
complex: xeigtstc complex: xeigtstc
double: xeigtstd double: xeigtstd
complex16: xeigtstz complex16: xeigtstz
xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) xeigtsts: $(SEIGTST) $(SCIGTST) $(AEIGTST) $(TMGLIB) $(LAPACKLIB) $(BLASLIB)
$(LOADER) $(LOADOPTS) -o $@ $^ $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) xeigtstc: $(CEIGTST) $(SCIGTST) $(AEIGTST) $(TMGLIB) $(LAPACKLIB) $(BLASLIB)
$(LOADER) $(LOADOPTS) -o $@ $^ $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) xeigtstd: $(DEIGTST) $(DZIGTST) $(AEIGTST) $(TMGLIB) $(LAPACKLIB) $(BLASLIB)
$(LOADER) $(LOADOPTS) -o $@ $^ $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) ../../$(TMGLIB) ../../$(LAPACKLIB) $(BLASLIB) xeigtstz: $(ZEIGTST) $(DZIGTST) $(AEIGTST) $(TMGLIB) $(LAPACKLIB) $(BLASLIB)
$(LOADER) $(LOADOPTS) -o $@ $^ $(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
$(AEIGTST): $(FRC) $(AEIGTST): $(FRC)
$(SCIGTST): $(FRC) $(SCIGTST): $(FRC)
@ -147,6 +150,7 @@ $(ZEIGTST): $(FRC)
FRC: FRC:
@FRC=$(FRC) @FRC=$(FRC)
.PHONY: clean cleanobj cleanexe
clean: cleanobj cleanexe clean: cleanobj cleanexe
cleanobj: cleanobj:
rm -f *.o rm -f *.o
@ -154,13 +158,10 @@ cleanexe:
rm -f xeigtst* rm -f xeigtst*
schkee.o: schkee.f schkee.o: schkee.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $< $(FC) $(FFLAGS_DRV) -c -o $@ $<
dchkee.o: dchkee.f dchkee.o: dchkee.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $< $(FC) $(FFLAGS_DRV) -c -o $@ $<
cchkee.o: cchkee.f cchkee.o: cchkee.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $< $(FC) $(FFLAGS_DRV) -c -o $@ $<
zchkee.o: zchkee.f zchkee.o: zchkee.f
$(FORTRAN) $(DRVOPTS) -c -o $@ $< $(FC) $(FFLAGS_DRV) -c -o $@ $<
.f.o:
$(FORTRAN) $(OPTS) -c -o $@ $<

1
lapack-netlib/TESTING/EIG/cbdt05.f
View File

@ -52,6 +52,7 @@
*> \verbatim *> \verbatim
*> A is COMPLEX array, dimension (LDA,N) *> A is COMPLEX array, dimension (LDA,N)
*> The m by n matrix A. *> The m by n matrix A.
*> \endverbatim
*> *>
*> \param[in] LDA *> \param[in] LDA
*> \verbatim *> \verbatim

2
lapack-netlib/TESTING/EIG/cchkst.f
View File

@ -167,7 +167,7 @@
*> CSTEMR('V', 'I') *> CSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because CSTEMR *> Tests 29 through 34 are disable at present because CSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I') *> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/cchkst2stg.f
View File

@ -188,7 +188,7 @@
*> CSTEMR('V', 'I') *> CSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because CSTEMR *> Tests 29 through 34 are disable at present because CSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I') *> (29) | S - Z D Z* | / ( |S| n ulp ) CSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/cdrgsx.f
View File

@ -737,7 +737,7 @@
CALL CLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL CLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA )
CALL CLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) CALL CLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA )
* *
* Compute the Schur factorization while swaping the * Compute the Schur factorization while swapping the
* m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks.
* *
CALL CGGESX( 'V', 'V', 'S', CLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, CALL CGGESX( 'V', 'V', 'S', CLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA,

273
lapack-netlib/TESTING/EIG/cdrvbd.f
View File

@ -33,8 +33,9 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> CDRVBD checks the singular value decomposition (SVD) driver CGESVD *> CDRVBD checks the singular value decomposition (SVD) driver CGESVD,
*> and CGESDD. *> CGESDD, CGESVJ, CGEJSV, CGESVDX, and CGESVDQ.
*>
*> CGESVD and CGESDD factors A = U diag(S) VT, where U and VT are *> CGESVD and CGESDD factors A = U diag(S) VT, where U and VT are
*> unitary and diag(S) is diagonal with the entries of the array S on *> unitary and diag(S) is diagonal with the entries of the array S on
*> its diagonal. The entries of S are the singular values, nonnegative *> its diagonal. The entries of S are the singular values, nonnegative
@ -73,81 +74,92 @@
*> *>
*> Test for CGESDD: *> Test for CGESDD:
*> *>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for CGESVJ:
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for CGEJSV:
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for CGESVDX( 'V', 'V', 'A' )/CGESVDX( 'N', 'N', 'A' )
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for CGESVDX( 'V', 'V', 'I' )
*>
*> (8) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*> *>
*> (9) | I - U'U | / ( M ulp ) *> (9) | I - U'U | / ( M ulp )
*> *>
*> (10) | I - VT VT' | / ( N ulp ) *> (10) | I - VT VT' | / ( N ulp )
*> *>
*> (11) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for CGESVDQ:
*>
*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (37) | I - U'U | / ( M ulp )
*>
*> (38) | I - VT VT' | / ( N ulp )
*>
*> (39) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for CGESVJ:
*>
*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (16) | I - U'U | / ( M ulp )
*>
*> (17) | I - VT VT' | / ( N ulp )
*>
*> (18) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for CGEJSV:
*>
*> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (20) | I - U'U | / ( M ulp )
*>
*> (21) | I - VT VT' | / ( N ulp )
*>
*> (22) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for CGESVDX( 'V', 'V', 'A' )/CGESVDX( 'N', 'N', 'A' )
*>
*> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (24) | I - U'U | / ( M ulp )
*>
*> (25) | I - VT VT' | / ( N ulp )
*>
*> (26) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for CGESVDX( 'V', 'V', 'I' )
*>
*> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*>
*> (31) | I - U'U | / ( M ulp )
*>
*> (32) | I - VT VT' | / ( N ulp )
*>
*> Test for CGESVDX( 'V', 'V', 'V' ) *> Test for CGESVDX( 'V', 'V', 'V' )
*> *>
*> (11) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*> *>
*> (12) | I - U'U | / ( M ulp ) *> (34) | I - U'U | / ( M ulp )
*> *>
*> (13) | I - VT VT' | / ( N ulp ) *> (35) | I - VT VT' | / ( N ulp )
*> *>
*> The "sizes" are specified by the arrays MM(1:NSIZES) and *> The "sizes" are specified by the arrays MM(1:NSIZES) and
*> NN(1:NSIZES); the value of each element pair (MM(j),NN(j)) *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
@ -393,6 +405,8 @@
* -- 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..--
* June 2016 * June 2016
*
IMPLICIT NONE
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES,
@ -411,7 +425,7 @@
* ===================================================================== * =====================================================================
* *
* .. Parameters .. * .. Parameters ..
REAL ZERO, ONE, TWO, HALF REAL ZERO, ONE, TWO, HALF
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0, PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
$ HALF = 0.5E0 ) $ HALF = 0.5E0 )
COMPLEX CZERO, CONE COMPLEX CZERO, CONE
@ -431,10 +445,13 @@
REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
$ UNFL, VL, VU $ UNFL, VL, VU
* .. * ..
* .. Local Scalars for CGESVDQ ..
INTEGER LIWORK, NUMRANK
* ..
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
INTEGER IOLDSD( 4 ), ISEED2( 4 ) INTEGER IOLDSD( 4 ), ISEED2( 4 )
REAL RESULT( 35 ) REAL RESULT( 39 )
* .. * ..
* .. External Functions .. * .. External Functions ..
REAL SLAMCH, SLARND REAL SLAMCH, SLARND
@ -442,8 +459,8 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD, EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD,
$ CGESVD, CGESVJ, CGEJSV, CGESVDX, CLACPY, $ CGESVD, CGESVDQ, CGESVJ, CGEJSV, CGESVDX,
$ CLASET, CLATMS, CUNT01, CUNT03 $ CLACPY, CLASET, CLATMS, CUNT01, CUNT03
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, REAL, MAX, MIN INTRINSIC ABS, REAL, MAX, MIN
@ -838,8 +855,64 @@
130 CONTINUE 130 CONTINUE
* *
* Test CGESVJ: Factorize A * Test CGESVDQ
* Note: CGESVJ does not work for M < N * Note: CGESVDQ only works for M >= N
*
RESULT( 36 ) = ZERO
RESULT( 37 ) = ZERO
RESULT( 38 ) = ZERO
RESULT( 39 ) = ZERO
*
IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 )
IF( IWSPC.EQ.4 )
$ LSWORK = LWORK
*
CALL CLACPY( 'F', M, N, ASAV, LDA, A, LDA )
SRNAMT = 'CGESVDQ'
*
LRWORK = MAX(2, M, 5*N)
LIWORK = MAX( N, 1 )
CALL CGESVDQ( 'H', 'N', 'N', 'A', 'A',
$ M, N, A, LDA, SSAV, USAV, LDU,
$ VTSAV, LDVT, NUMRANK, IWORK, LIWORK,
$ WORK, LWORK, RWORK, LRWORK, IINFO )
*
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9995 )'CGESVDQ', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO )
RETURN
END IF
*
* Do tests 36--39
*
CALL CBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
$ VTSAV, LDVT, WORK, RWORK, RESULT( 36 ) )
IF( M.NE.0 .AND. N.NE.0 ) THEN
CALL CUNT01( 'Columns', M, M, USAV, LDU, WORK,
$ LWORK, RWORK, RESULT( 37 ) )
CALL CUNT01( 'Rows', N, N, VTSAV, LDVT, WORK,
$ LWORK, RWORK, RESULT( 38 ) )
END IF
RESULT( 39 ) = ZERO
DO 199 I = 1, MNMIN - 1
IF( SSAV( I ).LT.SSAV( I+1 ) )
$ RESULT( 39 ) = ULPINV
IF( SSAV( I ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
199 CONTINUE
IF( MNMIN.GE.1 ) THEN
IF( SSAV( MNMIN ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
END IF
END IF
*
* Test CGESVJ
* Note: CGESVJ only works for M >= N
* *
RESULT( 15 ) = ZERO RESULT( 15 ) = ZERO
RESULT( 16 ) = ZERO RESULT( 16 ) = ZERO
@ -847,13 +920,13 @@
RESULT( 18 ) = ZERO RESULT( 18 ) = ZERO
* *
IF( M.GE.N ) THEN IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK ) LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 ) LSWORK = MAX( LSWORK, 1 )
LRWORK = MAX(6,N) LRWORK = MAX(6,N)
IF( IWSPC.EQ.4 ) IF( IWSPC.EQ.4 )
$ LSWORK = LWORK $ LSWORK = LWORK
* *
CALL CLACPY( 'F', M, N, ASAV, LDA, USAV, LDA ) CALL CLACPY( 'F', M, N, ASAV, LDA, USAV, LDA )
SRNAMT = 'CGESVJ' SRNAMT = 'CGESVJ'
@ -861,8 +934,7 @@
& 0, A, LDVT, WORK, LWORK, RWORK, & 0, A, LDVT, WORK, LWORK, RWORK,
& LRWORK, IINFO ) & LRWORK, IINFO )
* *
* CGESVJ retuns V not VT, so we transpose to use the same * CGESVJ returns V not VH
* test suite.
* *
DO J=1,N DO J=1,N
DO I=1,N DO I=1,N
@ -900,31 +972,30 @@
END IF END IF
END IF END IF
* *
* Test CGEJSV: Factorize A * Test CGEJSV
* Note: CGEJSV does not work for M < N * Note: CGEJSV only works for M >= N
* *
RESULT( 19 ) = ZERO RESULT( 19 ) = ZERO
RESULT( 20 ) = ZERO RESULT( 20 ) = ZERO
RESULT( 21 ) = ZERO RESULT( 21 ) = ZERO
RESULT( 22 ) = ZERO RESULT( 22 ) = ZERO
IF( M.GE.N ) THEN IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK ) LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 ) LSWORK = MAX( LSWORK, 1 )
IF( IWSPC.EQ.4 ) IF( IWSPC.EQ.4 )
$ LSWORK = LWORK $ LSWORK = LWORK
LRWORK = MAX( 7, N + 2*M) LRWORK = MAX( 7, N + 2*M)
* *
CALL CLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA ) CALL CLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA )
SRNAMT = 'CGEJSV' SRNAMT = 'CGEJSV'
CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', CALL CGEJSV( 'G', 'U', 'V', 'R', 'N', 'N',
& M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
& WORK, LWORK, RWORK, & WORK, LWORK, RWORK,
& LRWORK, IWORK, IINFO ) & LRWORK, IWORK, IINFO )
* *
* CGEJSV retuns V not VT, so we transpose to use the same * CGEJSV returns V not VH
* test suite.
* *
DO 133 J=1,N DO 133 J=1,N
DO 132 I=1,N DO 132 I=1,N
@ -933,7 +1004,7 @@
133 END DO 133 END DO
* *
IF( IINFO.NE.0 ) THEN IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9995 )'GESVJ', IINFO, M, N, WRITE( NOUNIT, FMT = 9995 )'GEJSV', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD $ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO ) INFO = ABS( IINFO )
RETURN RETURN
@ -1160,7 +1231,7 @@
* *
NTEST = 0 NTEST = 0
NFAIL = 0 NFAIL = 0
DO 190 J = 1, 35 DO 190 J = 1, 39
IF( RESULT( J ).GE.ZERO ) IF( RESULT( J ).GE.ZERO )
$ NTEST = NTEST + 1 $ NTEST = NTEST + 1
IF( RESULT( J ).GE.THRESH ) IF( RESULT( J ).GE.THRESH )
@ -1175,7 +1246,7 @@
NTESTF = 2 NTESTF = 2
END IF END IF
* *
DO 200 J = 1, 35 DO 200 J = 1, 39
IF( RESULT( J ).GE.THRESH ) THEN IF( RESULT( J ).GE.THRESH ) THEN
WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC, WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC,
$ IOLDSD, J, RESULT( J ) $ IOLDSD, J, RESULT( J )
@ -1251,6 +1322,12 @@
$ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )', $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
$ / '34 = | I - U**T U | / ( M ulp ) ', $ / '34 = | I - U**T U | / ( M ulp ) ',
$ / '35 = | I - VT VT**T | / ( N ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ',
$ ' CGESVDQ(H,N,N,A,A',
$ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
$ / '37 = | I - U**T U | / ( M ulp ) ',
$ / '38 = | I - VT VT**T | / ( N ulp ) ',
$ / '39 = 0 if S contains min(M,N) nonnegative values in',
$ ' decreasing order, else 1/ulp',
$ / / ) $ / / )
9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
$ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )

59
lapack-netlib/TESTING/EIG/cerred.f
View File

@ -36,6 +36,8 @@
*> CGEJSV compute SVD of an M-by-N matrix A where M >= N *> CGEJSV compute SVD of an M-by-N matrix A where M >= N
*> CGESVDX compute SVD of an M-by-N matrix A(by bisection *> CGESVDX compute SVD of an M-by-N matrix A(by bisection
*> and inverse iteration) *> and inverse iteration)
*> CGESVDQ compute SVD of an M-by-N matrix A(with a
*> QR-Preconditioned )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -101,7 +103,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV, EXTERNAL CHKXER, CGEES, CGEESX, CGEEV, CGEEVX, CGEJSV,
$ CGESDD, CGESVD $ CGESDD, CGESVD, CGESVDX, CGESVDQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAMEN, CSLECT LOGICAL LSAMEN, CSLECT
@ -495,6 +497,61 @@
ELSE ELSE
WRITE( NOUT, FMT = 9998 ) WRITE( NOUT, FMT = 9998 )
END IF END IF
*
* Test CGESVDQ
*
SRNAMT = 'CGESVDQ'
INFOT = 1
CALL CGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL CGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL CGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL CGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 6
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 7
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 9
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 12
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ -1, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 14
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, -1, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 17
CALL CGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, 1, NS, IW, -5, W, 1, RW, 1, INFO )
CALL CHKXER( 'CGESVDQ', INFOT, NOUT, LERR, OK )
NT = 11
IF( OK ) THEN
WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
$ NT
ELSE
WRITE( NOUT, FMT = 9998 )
END IF
END IF END IF
* *
* Print a summary line. * Print a summary line.

17
lapack-netlib/TESTING/EIG/cget51.f
View File

@ -29,12 +29,13 @@
*> *>
*> CGET51 generally checks a decomposition of the form *> CGET51 generally checks a decomposition of the form
*> *>
*> A = U B VC> *> A = U B V**H
*> where * means conjugate transpose and U and V are unitary. *>
*> where **H means conjugate transpose and U and V are unitary.
*> *>
*> Specifically, if ITYPE=1 *> Specifically, if ITYPE=1
*> *>
*> RESULT = | A - U B V* | / ( |A| n ulp ) *> RESULT = | A - U B V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
@ -42,7 +43,7 @@
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT = | I - UU* | / ( n ulp ) *> RESULT = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -52,9 +53,9 @@
*> \verbatim *> \verbatim
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> =1: RESULT = | A - U B V* | / ( |A| n ulp ) *> =1: RESULT = | A - U B V**H | / ( |A| n ulp )
*> =2: RESULT = | A - B | / ( |A| n ulp ) *> =2: RESULT = | A - B | / ( |A| n ulp )
*> =3: RESULT = | I - UU* | / ( n ulp ) *> =3: RESULT = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] N *> \param[in] N
@ -218,7 +219,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: Compute W = A - UBV' * ITYPE=1: Compute W = A - U B V**H
* *
CALL CLACPY( ' ', N, N, A, LDA, WORK, N ) CALL CLACPY( ' ', N, N, A, LDA, WORK, N )
CALL CGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO, CALL CGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO,
@ -259,7 +260,7 @@
* *
* Tests not scaled by norm(A) * Tests not scaled by norm(A)
* *
* ITYPE=3: Compute UU' - I * ITYPE=3: Compute U U**H - I
* *
CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,
$ WORK, N ) $ WORK, N )

12
lapack-netlib/TESTING/EIG/chbt21.f
View File

@ -28,14 +28,16 @@
*> *>
*> CHBT21 generally checks a decomposition of the form *> CHBT21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian banded, U is *>
*> where **H means conjugate transpose, A is hermitian banded, U is
*> unitary, and S is diagonal (if KS=0) or symmetric *> unitary, and S is diagonal (if KS=0) or symmetric
*> tridiagonal (if KS=1). *> tridiagonal (if KS=1).
*> *>
*> Specifically: *> Specifically:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -220,7 +222,7 @@
* *
ANORM = MAX( CLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL ) ANORM = MAX( CLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL )
* *
* Compute error matrix: Error = A - U S U* * Compute error matrix: Error = A - U S U**H
* *
* Copy A from SB to SP storage format. * Copy A from SB to SP storage format.
* *
@ -271,7 +273,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK,
$ N ) $ N )

34
lapack-netlib/TESTING/EIG/chet21.f
View File

@ -29,8 +29,9 @@
*> *>
*> CHET21 generally checks a decomposition of the form *> CHET21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian, U is unitary, and *>
*> where **H means conjugate transpose, A is hermitian, U is unitary, and
*> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if *> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if
*> KBAND=1). *> KBAND=1).
*> *>
@ -42,18 +43,19 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> *>
*> For ITYPE > 1, the transformation U is expressed as a product *> For ITYPE > 1, the transformation U is expressed as a product
*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)C> and each *> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**H and each
*> vector v(j) has its first j elements 0 and the remaining n-j elements *> vector v(j) has its first j elements 0 and the remaining n-j elements
*> stored in V(j+1:n,j). *> stored in V(j+1:n,j).
*> \endverbatim *> \endverbatim
@ -66,14 +68,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense unitary matrix: *> 1: U expressed as a dense unitary matrix:
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense unitary matrix and *> 3: U expressed both as a dense unitary matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -171,7 +174,7 @@
*> \verbatim *> \verbatim
*> TAU is COMPLEX array, dimension (N) *> TAU is COMPLEX array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)* in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -294,7 +297,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U* * ITYPE=1: error = A - U S U**H
* *
CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
CALL CLACPY( CUPLO, N, N, A, LDA, WORK, N ) CALL CLACPY( CUPLO, N, N, A, LDA, WORK, N )
@ -304,8 +307,7 @@
10 CONTINUE 10 CONTINUE
* *
IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
CMK DO 20 J = 1, N - 1 DO 20 J = 1, N - 1
DO 20 J = 2, N - 1
CALL CHER2( CUPLO, N, -CMPLX( E( J ) ), U( 1, J ), 1, CALL CHER2( CUPLO, N, -CMPLX( E( J ) ), U( 1, J ), 1,
$ U( 1, J-1 ), 1, WORK, N ) $ U( 1, J-1 ), 1, WORK, N )
20 CONTINUE 20 CONTINUE
@ -314,7 +316,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V* - A * ITYPE=2: error = V S V**H - A
* *
CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
* *
@ -371,7 +373,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V* - I * ITYPE=3: error = U V**H - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -407,7 +409,7 @@ CMK DO 20 J = 1, N - 1
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,

12
lapack-netlib/TESTING/EIG/chet22.f
View File

@ -42,7 +42,8 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) *> RESULT(1) = | U**H A U - S | / ( |A| m ulp ) and
*> RESULT(2) = | I - U**H U | / ( m ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -52,7 +53,8 @@
*> ITYPE INTEGER *> ITYPE INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> UPLO CHARACTER *> UPLO CHARACTER
*> If UPLO='U', the upper triangle of A will be used and the *> If UPLO='U', the upper triangle of A will be used and the
@ -122,7 +124,7 @@
*> *>
*> TAU COMPLEX array, dimension (N) *> TAU COMPLEX array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> Not modified. *> Not modified.
@ -215,7 +217,7 @@
* *
* Compute error matrix: * Compute error matrix:
* *
* ITYPE=1: error = U' A U - S * ITYPE=1: error = U**H A U - S
* *
CALL CHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK, CALL CHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK,
$ N ) $ N )
@ -249,7 +251,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute U'U - I * Compute U**H U - I
* *
IF( ITYPE.EQ.1 ) IF( ITYPE.EQ.1 )
$ CALL CUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK, $ CALL CUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK,

37
lapack-netlib/TESTING/EIG/chpt21.f
View File

@ -29,8 +29,9 @@
*> *>
*> CHPT21 generally checks a decomposition of the form *> CHPT21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian, U is *>
*> where **H means conjugate transpose, A is hermitian, U is
*> unitary, and S is diagonal (if KBAND=0) or (real) symmetric *> unitary, and S is diagonal (if KBAND=0) or (real) symmetric
*> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as
*> a dense matrix, otherwise the U is expressed as a product of *> a dense matrix, otherwise the U is expressed as a product of
@ -41,15 +42,16 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> *>
*> Packed storage means that, for example, if UPLO='U', then the columns *> Packed storage means that, for example, if UPLO='U', then the columns
*> of the upper triangle of A are stored one after another, so that *> of the upper triangle of A are stored one after another, so that
@ -70,14 +72,16 @@
*> *>
*> If UPLO='U', then V = H(n-1)...H(1), where *> If UPLO='U', then V = H(n-1)...H(1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)C> *> H(j) = I - tau(j) v(j) v(j)**H
*>
*> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1),
*> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ),
*> the j-th element is 1, and the last n-j elements are 0. *> the j-th element is 1, and the last n-j elements are 0.
*> *>
*> If UPLO='L', then V = H(1)...H(n-1), where *> If UPLO='L', then V = H(1)...H(n-1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)C> *> H(j) = I - tau(j) v(j) v(j)**H
*>
*> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the
*> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e.,
*> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .) *> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .)
@ -91,14 +95,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense unitary matrix: *> 1: U expressed as a dense unitary matrix:
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense unitary matrix and *> 3: U expressed both as a dense unitary matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -181,7 +186,7 @@
*> \verbatim *> \verbatim
*> TAU is COMPLEX array, dimension (N) *> TAU is COMPLEX array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)* in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -313,7 +318,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U* * ITYPE=1: error = A - U S U**H
* *
CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
CALL CCOPY( LAP, AP, 1, WORK, 1 ) CALL CCOPY( LAP, AP, 1, WORK, 1 )
@ -323,7 +328,7 @@
10 CONTINUE 10 CONTINUE
* *
IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
DO 20 J = 2, N - 1 DO 20 J = 1, N - 1
CALL CHPR2( CUPLO, N, -CMPLX( E( J ) ), U( 1, J ), 1, CALL CHPR2( CUPLO, N, -CMPLX( E( J ) ), U( 1, J ), 1,
$ U( 1, J-1 ), 1, WORK ) $ U( 1, J-1 ), 1, WORK )
20 CONTINUE 20 CONTINUE
@ -332,7 +337,7 @@
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V* - A * ITYPE=2: error = V S V**H - A
* *
CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL CLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
* *
@ -400,7 +405,7 @@
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V* - I * ITYPE=3: error = U V**H - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -431,7 +436,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,

13
lapack-netlib/TESTING/EIG/cstt21.f
View File

@ -28,14 +28,15 @@
*> *>
*> CSTT21 checks a decomposition of the form *> CSTT21 checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is real symmetric tridiagonal, *>
*> where **H means conjugate transpose, A is real symmetric tridiagonal,
*> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric *> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric
*> tridiagonal (if KBAND=1). Two tests are performed: *> tridiagonal (if KBAND=1). Two tests are performed:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp )
*> *>
*> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(2) = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -201,7 +202,7 @@
WORK( N**2 ) = AD( N ) WORK( N**2 ) = AD( N )
ANORM = MAX( ANORM, ABS( AD( N ) )+TEMP1, UNFL ) ANORM = MAX( ANORM, ABS( AD( N ) )+TEMP1, UNFL )
* *
* Norm of A - USU* * Norm of A - U S U**H
* *
DO 20 J = 1, N DO 20 J = 1, N
CALL CHER( 'L', N, -SD( J ), U( 1, J ), 1, WORK, N ) CALL CHER( 'L', N, -SD( J ), U( 1, J ), 1, WORK, N )
@ -228,7 +229,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, CALL CGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK,
$ N ) $ N )

1
lapack-netlib/TESTING/EIG/dbdt05.f
View File

@ -52,6 +52,7 @@
*> \verbatim *> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N) *> A is DOUBLE PRECISION array, dimension (LDA,N)
*> The m by n matrix A. *> The m by n matrix A.
*> \endverbatim
*> *>
*> \param[in] LDA *> \param[in] LDA
*> \verbatim *> \verbatim

2
lapack-netlib/TESTING/EIG/dchkst.f
View File

@ -166,7 +166,7 @@
*> DSTEMR('V', 'I') *> DSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because DSTEMR *> Tests 29 through 34 are disable at present because DSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I') *> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/dchkst2stg.f
View File

@ -187,7 +187,7 @@
*> DSTEMR('V', 'I') *> DSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because DSTEMR *> Tests 29 through 34 are disable at present because DSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I') *> (29) | S - Z D Z' | / ( |S| n ulp ) DSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/ddrgsx.f
View File

@ -769,7 +769,7 @@
CALL DLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL DLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA )
CALL DLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) CALL DLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA )
* *
* Compute the Schur factorization while swaping the * Compute the Schur factorization while swapping the
* m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks.
* *
CALL DGGESX( 'V', 'V', 'S', DLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, CALL DGGESX( 'V', 'V', 'S', DLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA,

113
lapack-netlib/TESTING/EIG/ddrvbd.f
View File

@ -32,7 +32,7 @@
*> \verbatim *> \verbatim
*> *>
*> DDRVBD checks the singular value decomposition (SVD) drivers *> DDRVBD checks the singular value decomposition (SVD) drivers
*> DGESVD, DGESDD, DGESVJ, and DGEJSV. *> DGESVD, DGESDD, DGESVDQ, DGESVJ, DGEJSV, and DGESVDX.
*> *>
*> Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are *> Both DGESVD and DGESDD factor A = U diag(S) VT, where U and VT are
*> orthogonal and diag(S) is diagonal with the entries of the array S *> orthogonal and diag(S) is diagonal with the entries of the array S
@ -90,6 +90,17 @@
*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD *> vector of singular values from the partial SVD
*> *>
*> Test for DGESVDQ:
*>
*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (37) | I - U'U | / ( M ulp )
*>
*> (38) | I - VT VT' | / ( N ulp )
*>
*> (39) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for DGESVJ: *> Test for DGESVJ:
*> *>
*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
@ -354,6 +365,8 @@
SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, SUBROUTINE DDRVBD( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
$ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
$ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO ) $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
*
IMPLICIT NONE
* *
* -- LAPACK test routine (version 3.7.0) -- * -- LAPACK test routine (version 3.7.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- LAPACK is a software package provided by Univ. of Tennessee, --
@ -390,13 +403,19 @@
$ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK, $ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK,
$ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL, $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL,
$ NMAX, NS, NSI, NSV, NTEST $ NMAX, NS, NSI, NSV, NTEST
DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
$ ULPINV, UNFL, VL, VU $ ULPINV, UNFL, VL, VU
* ..
* .. Local Scalars for DGESVDQ ..
INTEGER LIWORK, LRWORK, NUMRANK
* ..
* .. Local Arrays for DGESVDQ ..
DOUBLE PRECISION RWORK( 2 )
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
INTEGER IOLDSD( 4 ), ISEED2( 4 ) INTEGER IOLDSD( 4 ), ISEED2( 4 )
DOUBLE PRECISION RESULT( 40 ) DOUBLE PRECISION RESULT( 39 )
* .. * ..
* .. External Functions .. * .. External Functions ..
DOUBLE PRECISION DLAMCH, DLARND DOUBLE PRECISION DLAMCH, DLARND
@ -404,8 +423,8 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD, EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD,
$ DGESVDX, DGESVJ, DLABAD, DLACPY, DLASET, $ DGESVDQ, DGESVDX, DGESVJ, DLABAD, DLACPY,
$ DLATMS, DORT01, DORT03, XERBLA $ DLASET, DLATMS, DORT01, DORT03, XERBLA
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, INT, MAX, MIN INTRINSIC ABS, DBLE, INT, MAX, MIN
@ -781,8 +800,64 @@
RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
110 CONTINUE 110 CONTINUE
* *
* Test DGESVJ: Factorize A * Test DGESVDQ
* Note: DGESVJ does not work for M < N * Note: DGESVDQ only works for M >= N
*
RESULT( 36 ) = ZERO
RESULT( 37 ) = ZERO
RESULT( 38 ) = ZERO
RESULT( 39 ) = ZERO
*
IF( M.GE.N ) THEN
IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 )
IF( IWS.EQ.4 )
$ LSWORK = LWORK
*
CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
SRNAMT = 'DGESVDQ'
*
LRWORK = 2
LIWORK = MAX( N, 1 )
CALL DGESVDQ( 'H', 'N', 'N', 'A', 'A',
$ M, N, A, LDA, SSAV, USAV, LDU,
$ VTSAV, LDVT, NUMRANK, IWORK, LIWORK,
$ WORK, LWORK, RWORK, LRWORK, IINFO )
*
IF( IINFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9995 )'DGESVDQ', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO )
RETURN
END IF
*
* Do tests 36--39
*
CALL DBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
$ VTSAV, LDVT, WORK, RESULT( 36 ) )
IF( M.NE.0 .AND. N.NE.0 ) THEN
CALL DORT01( 'Columns', M, M, USAV, LDU, WORK,
$ LWORK, RESULT( 37 ) )
CALL DORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
$ LWORK, RESULT( 38 ) )
END IF
RESULT( 39 ) = ZERO
DO 199 I = 1, MNMIN - 1
IF( SSAV( I ).LT.SSAV( I+1 ) )
$ RESULT( 39 ) = ULPINV
IF( SSAV( I ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
199 CONTINUE
IF( MNMIN.GE.1 ) THEN
IF( SSAV( MNMIN ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
END IF
END IF
*
* Test DGESVJ
* Note: DGESVJ only works for M >= N
* *
RESULT( 15 ) = ZERO RESULT( 15 ) = ZERO
RESULT( 16 ) = ZERO RESULT( 16 ) = ZERO
@ -802,8 +877,7 @@
CALL DGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV, CALL DGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV,
& 0, A, LDVT, WORK, LWORK, INFO ) & 0, A, LDVT, WORK, LWORK, INFO )
* *
* DGESVJ retuns V not VT, so we transpose to use the same * DGESVJ returns V not VT
* test suite.
* *
DO J=1,N DO J=1,N
DO I=1,N DO I=1,N
@ -841,8 +915,8 @@
END IF END IF
END IF END IF
* *
* Test DGEJSV: Factorize A * Test DGEJSV
* Note: DGEJSV does not work for M < N * Note: DGEJSV only works for M >= N
* *
RESULT( 19 ) = ZERO RESULT( 19 ) = ZERO
RESULT( 20 ) = ZERO RESULT( 20 ) = ZERO
@ -862,8 +936,7 @@
& M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
& WORK, LWORK, IWORK, INFO ) & WORK, LWORK, IWORK, INFO )
* *
* DGEJSV retuns V not VT, so we transpose to use the same * DGEJSV returns V not VT
* test suite.
* *
DO 140 J=1,N DO 140 J=1,N
DO 130 I=1,N DO 130 I=1,N
@ -872,7 +945,7 @@
140 END DO 140 END DO
* *
IF( IINFO.NE.0 ) THEN IF( IINFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N, WRITE( NOUT, FMT = 9995 )'GEJSV', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD $ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO ) INFO = ABS( IINFO )
RETURN RETURN
@ -1086,7 +1159,7 @@
* *
* End of Loop -- Check for RESULT(j) > THRESH * End of Loop -- Check for RESULT(j) > THRESH
* *
DO 210 J = 1, 35 DO 210 J = 1, 39
IF( RESULT( J ).GE.THRESH ) THEN IF( RESULT( J ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 ) THEN IF( NFAIL.EQ.0 ) THEN
WRITE( NOUT, FMT = 9999 ) WRITE( NOUT, FMT = 9999 )
@ -1097,7 +1170,7 @@
NFAIL = NFAIL + 1 NFAIL = NFAIL + 1
END IF END IF
210 CONTINUE 210 CONTINUE
NTEST = NTEST + 35 NTEST = NTEST + 39
220 CONTINUE 220 CONTINUE
230 CONTINUE 230 CONTINUE
240 CONTINUE 240 CONTINUE
@ -1158,6 +1231,12 @@
$ ' DGESVDX(V,V,V) ', $ ' DGESVDX(V,V,V) ',
$ / '34 = | I - U**T U | / ( M ulp ) ', $ / '34 = | I - U**T U | / ( M ulp ) ',
$ / '35 = | I - VT VT**T | / ( N ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ',
$ ' DGESVDQ(H,N,N,A,A',
$ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
$ / '37 = | I - U**T U | / ( M ulp ) ',
$ / '38 = | I - VT VT**T | / ( N ulp ) ',
$ / '39 = 0 if S contains min(M,N) nonnegative values in',
$ ' decreasing order, else 1/ulp',
$ / / ) $ / / )
9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
$ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )

59
lapack-netlib/TESTING/EIG/derred.f
View File

@ -36,6 +36,8 @@
*> DGEJSV compute SVD of an M-by-N matrix A where M >= N *> DGEJSV compute SVD of an M-by-N matrix A where M >= N
*> DGESVDX compute SVD of an M-by-N matrix A(by bisection *> DGESVDX compute SVD of an M-by-N matrix A(by bisection
*> and inverse iteration) *> and inverse iteration)
*> DGESVDQ compute SVD of an M-by-N matrix A(with a
*> QR-Preconditioned )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -100,7 +102,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV, EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV,
$ DGESDD, DGESVD $ DGESDD, DGESVD, DGESVDX, DGESVQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL DSLECT, LSAMEN LOGICAL DSLECT, LSAMEN
@ -486,6 +488,61 @@
ELSE ELSE
WRITE( NOUT, FMT = 9998 ) WRITE( NOUT, FMT = 9998 )
END IF END IF
*
* Test DGESVDQ
*
SRNAMT = 'DGESVDQ'
INFOT = 1
CALL DGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL DGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL DGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL DGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 6
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 7
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 9
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 12
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 14
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 17
CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO )
CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK )
NT = 11
IF( OK ) THEN
WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
$ NT
ELSE
WRITE( NOUT, FMT = 9998 )
END IF
END IF END IF
* *
* Print a summary line. * Print a summary line.

2
lapack-netlib/TESTING/EIG/dget39.f
View File

@ -194,7 +194,7 @@
VM5( 2 ) = EPS VM5( 2 ) = EPS
VM5( 3 ) = SQRT( SMLNUM ) VM5( 3 ) = SQRT( SMLNUM )
* *
* Initalization * Initialization
* *
KNT = 0 KNT = 0
RMAX = ZERO RMAX = ZERO

11
lapack-netlib/TESTING/EIG/dsbt21.f
View File

@ -28,15 +28,16 @@
*> *>
*> DSBT21 generally checks a decomposition of the form *> DSBT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric banded, U is *> where **T means transpose, A is symmetric banded, U is
*> orthogonal, and S is diagonal (if KS=0) or symmetric *> orthogonal, and S is diagonal (if KS=0) or symmetric
*> tridiagonal (if KS=1). *> tridiagonal (if KS=1).
*> *>
*> Specifically: *> Specifically:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -214,7 +215,7 @@
* *
ANORM = MAX( DLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL ) ANORM = MAX( DLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL )
* *
* Compute error matrix: Error = A - U S U' * Compute error matrix: Error = A - U S U**T
* *
* Copy A from SB to SP storage format. * Copy A from SB to SP storage format.
* *
@ -265,7 +266,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,
$ N ) $ N )

32
lapack-netlib/TESTING/EIG/dspt21.f
View File

@ -28,9 +28,9 @@
*> *>
*> DSPT21 generally checks a decomposition of the form *> DSPT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric (stored in packed format), U *> where **T means transpose, A is symmetric (stored in packed format), U
*> is orthogonal, and S is diagonal (if KBAND=0) or symmetric *> is orthogonal, and S is diagonal (if KBAND=0) or symmetric
*> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a
*> dense matrix, otherwise the U is expressed as a product of *> dense matrix, otherwise the U is expressed as a product of
@ -41,15 +41,16 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> *>
*> Packed storage means that, for example, if UPLO='U', then the columns *> Packed storage means that, for example, if UPLO='U', then the columns
*> of the upper triangle of A are stored one after another, so that *> of the upper triangle of A are stored one after another, so that
@ -70,7 +71,7 @@
*> *>
*> If UPLO='U', then V = H(n-1)...H(1), where *> If UPLO='U', then V = H(n-1)...H(1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)' *> H(j) = I - tau(j) v(j) v(j)**T
*> *>
*> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1),
*> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ),
@ -78,7 +79,7 @@
*> *>
*> If UPLO='L', then V = H(1)...H(n-1), where *> If UPLO='L', then V = H(1)...H(n-1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)' *> H(j) = I - tau(j) v(j) v(j)**T
*> *>
*> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the
*> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e.,
@ -93,14 +94,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense orthogonal matrix and *> 3: U expressed both as a dense orthogonal matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -183,7 +185,7 @@
*> \verbatim *> \verbatim
*> TAU is DOUBLE PRECISION array, dimension (N) *> TAU is DOUBLE PRECISION array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -303,7 +305,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U' * ITYPE=1: error = A - U S U**T
* *
CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
CALL DCOPY( LAP, AP, 1, WORK, 1 ) CALL DCOPY( LAP, AP, 1, WORK, 1 )
@ -322,7 +324,7 @@
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V' - A * ITYPE=2: error = V S V**T - A
* *
CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
* *
@ -389,7 +391,7 @@
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V' - I * ITYPE=3: error = U V**T - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -420,7 +422,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,

30
lapack-netlib/TESTING/EIG/dsyt21.f
View File

@ -28,9 +28,9 @@
*> *>
*> DSYT21 generally checks a decomposition of the form *> DSYT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric, U is orthogonal, and S is *> where **T means transpose, A is symmetric, U is orthogonal, and S is
*> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). *> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1).
*> *>
*> If ITYPE=1, then U is represented as a dense matrix; otherwise U is *> If ITYPE=1, then U is represented as a dense matrix; otherwise U is
@ -41,18 +41,19 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> *>
*> For ITYPE > 1, the transformation U is expressed as a product *> For ITYPE > 1, the transformation U is expressed as a product
*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)' and each *> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**T and each
*> vector v(j) has its first j elements 0 and the remaining n-j elements *> vector v(j) has its first j elements 0 and the remaining n-j elements
*> stored in V(j+1:n,j). *> stored in V(j+1:n,j).
*> \endverbatim *> \endverbatim
@ -65,14 +66,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense orthogonal matrix and *> 3: U expressed both as a dense orthogonal matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -170,7 +172,7 @@
*> \verbatim *> \verbatim
*> TAU is DOUBLE PRECISION array, dimension (N) *> TAU is DOUBLE PRECISION array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -283,7 +285,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U' * ITYPE=1: error = A - U S U**T
* *
CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
CALL DLACPY( CUPLO, N, N, A, LDA, WORK, N ) CALL DLACPY( CUPLO, N, N, A, LDA, WORK, N )
@ -302,7 +304,7 @@
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V' - A * ITYPE=2: error = V S V**T - A
* *
CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL DLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
* *
@ -359,7 +361,7 @@
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V' - I * ITYPE=3: error = U V**T - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -395,7 +397,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL DGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,

12
lapack-netlib/TESTING/EIG/dsyt22.f
View File

@ -41,7 +41,8 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) *> RESULT(1) = | U**T A U - S | / ( |A| m ulp ) and
*> RESULT(2) = | I - U**T U | / ( m ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -51,7 +52,8 @@
*> ITYPE INTEGER *> ITYPE INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> UPLO CHARACTER *> UPLO CHARACTER
*> If UPLO='U', the upper triangle of A will be used and the *> If UPLO='U', the upper triangle of A will be used and the
@ -122,7 +124,7 @@
*> *>
*> TAU DOUBLE PRECISION array, dimension (N) *> TAU DOUBLE PRECISION array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> Not modified. *> Not modified.
@ -207,7 +209,7 @@
* *
* Compute error matrix: * Compute error matrix:
* *
* ITYPE=1: error = U' A U - S * ITYPE=1: error = U**T A U - S
* *
CALL DSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N ) CALL DSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N )
NN = N*N NN = N*N
@ -240,7 +242,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute U'U - I * Compute U**T U - I
* *
IF( ITYPE.EQ.1 ) IF( ITYPE.EQ.1 )
$ CALL DORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, $ CALL DORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N,

1
lapack-netlib/TESTING/EIG/sbdt05.f
View File

@ -52,6 +52,7 @@
*> \verbatim *> \verbatim
*> A is REAL array, dimension (LDA,N) *> A is REAL array, dimension (LDA,N)
*> The m by n matrix A. *> The m by n matrix A.
*> \endverbatim
*> *>
*> \param[in] LDA *> \param[in] LDA
*> \verbatim *> \verbatim

2
lapack-netlib/TESTING/EIG/schkst.f
View File

@ -166,7 +166,7 @@
*> SSTEMR('V', 'I') *> SSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because SSTEMR *> Tests 29 through 34 are disable at present because SSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I') *> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/schkst2stg.f
View File

@ -187,7 +187,7 @@
*> SSTEMR('V', 'I') *> SSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because SSTEMR *> Tests 29 through 34 are disable at present because SSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I') *> (29) | S - Z D Z' | / ( |S| n ulp ) SSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/sdrgsx.f
View File

@ -770,7 +770,7 @@ c MINWRK = MAX( 10*( NSIZE+1 ), 5*NSIZE*NSIZE / 2-2 )
CALL SLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL SLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA )
CALL SLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) CALL SLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA )
* *
* Compute the Schur factorization while swaping the * Compute the Schur factorization while swapping the
* m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks.
* *
CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA,

111
lapack-netlib/TESTING/EIG/sdrvbd.f
View File

@ -32,7 +32,7 @@
*> \verbatim *> \verbatim
*> *>
*> SDRVBD checks the singular value decomposition (SVD) drivers *> SDRVBD checks the singular value decomposition (SVD) drivers
*> SGESVD, SGESDD, SGESVJ, and SGEJSV. *> SGESVD, SGESDD, SGESVDQ, SGESVJ, SGEJSV, and DGESVDX.
*> *>
*> Both SGESVD and SGESDD factor A = U diag(S) VT, where U and VT are *> Both SGESVD and SGESDD factor A = U diag(S) VT, where U and VT are
*> orthogonal and diag(S) is diagonal with the entries of the array S *> orthogonal and diag(S) is diagonal with the entries of the array S
@ -90,6 +90,17 @@
*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the *> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD *> vector of singular values from the partial SVD
*> *>
*> Test for SGESVDQ:
*>
*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (37) | I - U'U | / ( M ulp )
*>
*> (38) | I - VT VT' | / ( N ulp )
*>
*> (39) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for SGESVJ: *> Test for SGESVJ:
*> *>
*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
@ -359,6 +370,8 @@
* -- 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..--
* June 2016 * June 2016
*
IMPLICIT NONE
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES, INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
@ -391,12 +404,18 @@
$ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL, $ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL,
$ NMAX, NS, NSI, NSV, NTEST $ NMAX, NS, NSI, NSV, NTEST
REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
$ ULPINV, UNFL, VL, VU $ ULPINV, UNFL, VL, VU
* ..
* .. Local Scalars for DGESVDQ ..
INTEGER LIWORK, LRWORK, NUMRANK
* ..
* .. Local Arrays for DGESVDQ ..
REAL RWORK( 2 )
* .. * ..
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
INTEGER IOLDSD( 4 ), ISEED2( 4 ) INTEGER IOLDSD( 4 ), ISEED2( 4 )
REAL RESULT( 40 ) REAL RESULT( 39 )
* .. * ..
* .. External Functions .. * .. External Functions ..
REAL SLAMCH, SLARND REAL SLAMCH, SLARND
@ -404,8 +423,8 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD, EXTERNAL ALASVM, SBDT01, SGEJSV, SGESDD, SGESVD,
$ SGESVDX, SGESVJ, SLABAD, SLACPY, SLASET, $ SGESVDQ, SGESVDX, SGESVJ, SLABAD, SLACPY,
$ SLATMS, SORT01, SORT03, XERBLA $ SLASET, SLATMS, SORT01, SORT03, XERBLA
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, REAL, INT, MAX, MIN INTRINSIC ABS, REAL, INT, MAX, MIN
@ -781,8 +800,64 @@
RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
110 CONTINUE 110 CONTINUE
* *
* Test SGESVJ: Factorize A * Test SGESVDQ
* Note: SGESVJ does not work for M < N * Note: SGESVDQ only works for M >= N
*
RESULT( 36 ) = ZERO
RESULT( 37 ) = ZERO
RESULT( 38 ) = ZERO
RESULT( 39 ) = ZERO
*
IF( M.GE.N ) THEN
IWTMP = 5*MNMIN*MNMIN + 9*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 )
IF( IWS.EQ.4 )
$ LSWORK = LWORK
*
CALL SLACPY( 'F', M, N, ASAV, LDA, A, LDA )
SRNAMT = 'SGESVDQ'
*
LRWORK = 2
LIWORK = MAX( N, 1 )
CALL SGESVDQ( 'H', 'N', 'N', 'A', 'A',
$ M, N, A, LDA, SSAV, USAV, LDU,
$ VTSAV, LDVT, NUMRANK, IWORK, LIWORK,
$ WORK, LWORK, RWORK, LRWORK, IINFO )
*
IF( IINFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9995 )'SGESVDQ', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO )
RETURN
END IF
*
* Do tests 36--39
*
CALL SBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
$ VTSAV, LDVT, WORK, RESULT( 36 ) )
IF( M.NE.0 .AND. N.NE.0 ) THEN
CALL SORT01( 'Columns', M, M, USAV, LDU, WORK,
$ LWORK, RESULT( 37 ) )
CALL SORT01( 'Rows', N, N, VTSAV, LDVT, WORK,
$ LWORK, RESULT( 38 ) )
END IF
RESULT( 39 ) = ZERO
DO 199 I = 1, MNMIN - 1
IF( SSAV( I ).LT.SSAV( I+1 ) )
$ RESULT( 39 ) = ULPINV
IF( SSAV( I ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
199 CONTINUE
IF( MNMIN.GE.1 ) THEN
IF( SSAV( MNMIN ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
END IF
END IF
*
* Test SGESVJ
* Note: SGESVJ only works for M >= N
* *
RESULT( 15 ) = ZERO RESULT( 15 ) = ZERO
RESULT( 16 ) = ZERO RESULT( 16 ) = ZERO
@ -802,8 +877,7 @@
CALL SGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV, CALL SGESVJ( 'G', 'U', 'V', M, N, USAV, LDA, SSAV,
& 0, A, LDVT, WORK, LWORK, INFO ) & 0, A, LDVT, WORK, LWORK, INFO )
* *
* SGESVJ retuns V not VT, so we transpose to use the same * SGESVJ returns V not VT
* test suite.
* *
DO J=1,N DO J=1,N
DO I=1,N DO I=1,N
@ -841,8 +915,8 @@
END IF END IF
END IF END IF
* *
* Test SGEJSV: Factorize A * Test SGEJSV
* Note: SGEJSV does not work for M < N * Note: SGEJSV only works for M >= N
* *
RESULT( 19 ) = ZERO RESULT( 19 ) = ZERO
RESULT( 20 ) = ZERO RESULT( 20 ) = ZERO
@ -862,8 +936,7 @@
& M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT, & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
& WORK, LWORK, IWORK, INFO ) & WORK, LWORK, IWORK, INFO )
* *
* SGEJSV retuns V not VT, so we transpose to use the same * SGEJSV returns V not VT
* test suite.
* *
DO 140 J=1,N DO 140 J=1,N
DO 130 I=1,N DO 130 I=1,N
@ -872,7 +945,7 @@
140 END DO 140 END DO
* *
IF( IINFO.NE.0 ) THEN IF( IINFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9995 )'GESVJ', IINFO, M, N, WRITE( NOUT, FMT = 9995 )'GEJSV', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD $ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO ) INFO = ABS( IINFO )
RETURN RETURN
@ -1086,7 +1159,7 @@
* *
* End of Loop -- Check for RESULT(j) > THRESH * End of Loop -- Check for RESULT(j) > THRESH
* *
DO 210 J = 1, 35 DO 210 J = 1, 39
IF( RESULT( J ).GE.THRESH ) THEN IF( RESULT( J ).GE.THRESH ) THEN
IF( NFAIL.EQ.0 ) THEN IF( NFAIL.EQ.0 ) THEN
WRITE( NOUT, FMT = 9999 ) WRITE( NOUT, FMT = 9999 )
@ -1097,7 +1170,7 @@
NFAIL = NFAIL + 1 NFAIL = NFAIL + 1
END IF END IF
210 CONTINUE 210 CONTINUE
NTEST = NTEST + 35 NTEST = NTEST + 39
220 CONTINUE 220 CONTINUE
230 CONTINUE 230 CONTINUE
240 CONTINUE 240 CONTINUE
@ -1158,6 +1231,12 @@
$ ' SGESVDX(V,V,V) ', $ ' SGESVDX(V,V,V) ',
$ / '34 = | I - U**T U | / ( M ulp ) ', $ / '34 = | I - U**T U | / ( M ulp ) ',
$ / '35 = | I - VT VT**T | / ( N ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ',
$ ' SGESVDQ(H,N,N,A,A',
$ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
$ / '37 = | I - U**T U | / ( M ulp ) ',
$ / '38 = | I - VT VT**T | / ( N ulp ) ',
$ / '39 = 0 if S contains min(M,N) nonnegative values in',
$ ' decreasing order, else 1/ulp',
$ / / ) $ / / )
9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
$ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )

59
lapack-netlib/TESTING/EIG/serred.f
View File

@ -36,6 +36,8 @@
*> SGEJSV compute SVD of an M-by-N matrix A where M >= N *> SGEJSV compute SVD of an M-by-N matrix A where M >= N
*> SGESVDX compute SVD of an M-by-N matrix A(by bisection *> SGESVDX compute SVD of an M-by-N matrix A(by bisection
*> and inverse iteration) *> and inverse iteration)
*> SGESVDQ compute SVD of an M-by-N matrix A(with a
*> QR-Preconditioned )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -100,7 +102,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHKXER, SGEES, SGEESX, SGEEV, SGEEVX, SGEJSV, EXTERNAL CHKXER, SGEES, SGEESX, SGEEV, SGEEVX, SGEJSV,
$ SGESDD, SGESVD $ SGESDD, SGESVD, SGESVDX, SGESVDQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL SSLECT, LSAMEN LOGICAL SSLECT, LSAMEN
@ -486,6 +488,61 @@
ELSE ELSE
WRITE( NOUT, FMT = 9998 ) WRITE( NOUT, FMT = 9998 )
END IF END IF
*
* Test SGESVDQ
*
SRNAMT = 'SGESVDQ'
INFOT = 1
CALL SGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL SGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL SGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL SGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 6
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 7
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 9
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 12
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 14
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 17
CALL SGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO )
CALL CHKXER( 'SGESVDQ', INFOT, NOUT, LERR, OK )
NT = 11
IF( OK ) THEN
WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
$ NT
ELSE
WRITE( NOUT, FMT = 9998 )
END IF
END IF END IF
* *
* Print a summary line. * Print a summary line.

2
lapack-netlib/TESTING/EIG/sget39.f
View File

@ -194,7 +194,7 @@
VM5( 2 ) = EPS VM5( 2 ) = EPS
VM5( 3 ) = SQRT( SMLNUM ) VM5( 3 ) = SQRT( SMLNUM )
* *
* Initalization * Initialization
* *
KNT = 0 KNT = 0
RMAX = ZERO RMAX = ZERO

11
lapack-netlib/TESTING/EIG/ssbt21.f
View File

@ -28,15 +28,16 @@
*> *>
*> SSBT21 generally checks a decomposition of the form *> SSBT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric banded, U is *> where **T means transpose, A is symmetric banded, U is
*> orthogonal, and S is diagonal (if KS=0) or symmetric *> orthogonal, and S is diagonal (if KS=0) or symmetric
*> tridiagonal (if KS=1). *> tridiagonal (if KS=1).
*> *>
*> Specifically: *> Specifically:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -214,7 +215,7 @@
* *
ANORM = MAX( SLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL ) ANORM = MAX( SLANSB( '1', CUPLO, N, IKA, A, LDA, WORK ), UNFL )
* *
* Compute error matrix: Error = A - U S U' * Compute error matrix: Error = A - U S U**T
* *
* Copy A from SB to SP storage format. * Copy A from SB to SP storage format.
* *
@ -265,7 +266,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,
$ N ) $ N )

32
lapack-netlib/TESTING/EIG/sspt21.f
View File

@ -28,9 +28,9 @@
*> *>
*> SSPT21 generally checks a decomposition of the form *> SSPT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric (stored in packed format), U *> where **T means transpose, A is symmetric (stored in packed format), U
*> is orthogonal, and S is diagonal (if KBAND=0) or symmetric *> is orthogonal, and S is diagonal (if KBAND=0) or symmetric
*> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as a
*> dense matrix, otherwise the U is expressed as a product of *> dense matrix, otherwise the U is expressed as a product of
@ -41,15 +41,16 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> *>
*> Packed storage means that, for example, if UPLO='U', then the columns *> Packed storage means that, for example, if UPLO='U', then the columns
*> of the upper triangle of A are stored one after another, so that *> of the upper triangle of A are stored one after another, so that
@ -70,7 +71,7 @@
*> *>
*> If UPLO='U', then V = H(n-1)...H(1), where *> If UPLO='U', then V = H(n-1)...H(1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)' *> H(j) = I - tau(j) v(j) v(j)**T
*> *>
*> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1),
*> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ),
@ -78,7 +79,7 @@
*> *>
*> If UPLO='L', then V = H(1)...H(n-1), where *> If UPLO='L', then V = H(1)...H(n-1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)' *> H(j) = I - tau(j) v(j) v(j)**T
*> *>
*> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the
*> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e.,
@ -93,14 +94,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense orthogonal matrix and *> 3: U expressed both as a dense orthogonal matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -183,7 +185,7 @@
*> \verbatim *> \verbatim
*> TAU is REAL array, dimension (N) *> TAU is REAL array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -303,7 +305,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U' * ITYPE=1: error = A - U S U**T
* *
CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
CALL SCOPY( LAP, AP, 1, WORK, 1 ) CALL SCOPY( LAP, AP, 1, WORK, 1 )
@ -322,7 +324,7 @@
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V' - A * ITYPE=2: error = V S V**T - A
* *
CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
* *
@ -389,7 +391,7 @@
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V' - I * ITYPE=3: error = U V**T - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -420,7 +422,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,

30
lapack-netlib/TESTING/EIG/ssyt21.f
View File

@ -28,9 +28,9 @@
*> *>
*> SSYT21 generally checks a decomposition of the form *> SSYT21 generally checks a decomposition of the form
*> *>
*> A = U S U' *> A = U S U**T
*> *>
*> where ' means transpose, A is symmetric, U is orthogonal, and S is *> where **T means transpose, A is symmetric, U is orthogonal, and S is
*> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). *> diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1).
*> *>
*> If ITYPE=1, then U is represented as a dense matrix; otherwise U is *> If ITYPE=1, then U is represented as a dense matrix; otherwise U is
@ -41,18 +41,19 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> *>
*> For ITYPE > 1, the transformation U is expressed as a product *> For ITYPE > 1, the transformation U is expressed as a product
*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)' and each *> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**T and each
*> vector v(j) has its first j elements 0 and the remaining n-j elements *> vector v(j) has its first j elements 0 and the remaining n-j elements
*> stored in V(j+1:n,j). *> stored in V(j+1:n,j).
*> \endverbatim *> \endverbatim
@ -65,14 +66,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V' | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**T | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense orthogonal matrix and *> 3: U expressed both as a dense orthogonal matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - VU' | / ( n ulp ) *> RESULT(1) = | I - V U**T | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -170,7 +172,7 @@
*> \verbatim *> \verbatim
*> TAU is REAL array, dimension (N) *> TAU is REAL array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -283,7 +285,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U' * ITYPE=1: error = A - U S U**T
* *
CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
CALL SLACPY( CUPLO, N, N, A, LDA, WORK, N ) CALL SLACPY( CUPLO, N, N, A, LDA, WORK, N )
@ -302,7 +304,7 @@
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V' - A * ITYPE=2: error = V S V**T - A
* *
CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N )
* *
@ -359,7 +361,7 @@
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V' - I * ITYPE=3: error = U V**T - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -395,7 +397,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU' - I * Compute U U**T - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK,

12
lapack-netlib/TESTING/EIG/ssyt22.f
View File

@ -41,7 +41,8 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) *> RESULT(1) = | U**T A U - S | / ( |A| m ulp ) and
*> RESULT(2) = | I - U**T U | / ( m ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -51,7 +52,8 @@
*> ITYPE INTEGER *> ITYPE INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**T | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**T | / ( n ulp )
*> *>
*> UPLO CHARACTER *> UPLO CHARACTER
*> If UPLO='U', the upper triangle of A will be used and the *> If UPLO='U', the upper triangle of A will be used and the
@ -122,7 +124,7 @@
*> *>
*> TAU REAL array, dimension (N) *> TAU REAL array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**T in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> Not modified. *> Not modified.
@ -207,7 +209,7 @@
* *
* Compute error matrix: * Compute error matrix:
* *
* ITYPE=1: error = U' A U - S * ITYPE=1: error = U**T A U - S
* *
CALL SSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N ) CALL SSYMM( 'L', UPLO, N, M, ONE, A, LDA, U, LDU, ZERO, WORK, N )
NN = N*N NN = N*N
@ -240,7 +242,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute U'U - I * Compute U**T U - I
* *
IF( ITYPE.EQ.1 ) IF( ITYPE.EQ.1 )
$ CALL SORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, $ CALL SORT01( 'Columns', N, M, U, LDU, WORK, 2*N*N,

1
lapack-netlib/TESTING/EIG/zbdt05.f
View File

@ -52,6 +52,7 @@
*> \verbatim *> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N) *> A is COMPLEX*16 array, dimension (LDA,N)
*> The m by n matrix A. *> The m by n matrix A.
*> \endverbatim
*> *>
*> \param[in] LDA *> \param[in] LDA
*> \verbatim *> \verbatim

2
lapack-netlib/TESTING/EIG/zchkst.f
View File

@ -167,7 +167,7 @@
*> ZSTEMR('V', 'I') *> ZSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because ZSTEMR *> Tests 29 through 34 are disable at present because ZSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I') *> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/zchkst2stg.f
View File

@ -188,7 +188,7 @@
*> ZSTEMR('V', 'I') *> ZSTEMR('V', 'I')
*> *>
*> Tests 29 through 34 are disable at present because ZSTEMR *> Tests 29 through 34 are disable at present because ZSTEMR
*> does not handle partial specturm requests. *> does not handle partial spectrum requests.
*> *>
*> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I') *> (29) | S - Z D Z* | / ( |S| n ulp ) ZSTEMR('V', 'I')
*> *>

2
lapack-netlib/TESTING/EIG/zdrgev3.f
View File

@ -389,7 +389,7 @@
*> \author Univ. of Colorado Denver *> \author Univ. of Colorado Denver
*> \author NAG Ltd. *> \author NAG Ltd.
* *
*> \date Febuary 2015 *> \date February 2015
* *
*> \ingroup complex16_eig *> \ingroup complex16_eig
* *

2
lapack-netlib/TESTING/EIG/zdrgsx.f
View File

@ -738,7 +738,7 @@
CALL ZLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA ) CALL ZLACPY( 'Full', MPLUSN, MPLUSN, AI, LDA, A, LDA )
CALL ZLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA ) CALL ZLACPY( 'Full', MPLUSN, MPLUSN, BI, LDA, B, LDA )
* *
* Compute the Schur factorization while swaping the * Compute the Schur factorization while swapping the
* m-by-m (1,1)-blocks with n-by-n (2,2)-blocks. * m-by-m (1,1)-blocks with n-by-n (2,2)-blocks.
* *
CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA, CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', MPLUSN, AI, LDA, BI, LDA,

272
lapack-netlib/TESTING/EIG/zdrvbd.f
View File

@ -33,8 +33,9 @@
*> *>
*> \verbatim *> \verbatim
*> *>
*> ZDRVBD checks the singular value decomposition (SVD) driver ZGESVD *> ZDRVBD checks the singular value decomposition (SVD) driver ZGESVD,
*> and ZGESDD. *> ZGESDD, ZGESVJ, ZGEJSV, ZGESVDX, and ZGESVDQ.
*>
*> ZGESVD and ZGESDD factors A = U diag(S) VT, where U and VT are *> ZGESVD and ZGESDD factors A = U diag(S) VT, where U and VT are
*> unitary and diag(S) is diagonal with the entries of the array S on *> unitary and diag(S) is diagonal with the entries of the array S on
*> its diagonal. The entries of S are the singular values, nonnegative *> its diagonal. The entries of S are the singular values, nonnegative
@ -73,81 +74,92 @@
*> *>
*> Test for ZGESDD: *> Test for ZGESDD:
*> *>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp ) *> (8) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for ZGESVJ:
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for ZGEJSV:
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for ZGESVDX( 'V', 'V', 'A' )/ZGESVDX( 'N', 'N', 'A' )
*>
*> (1) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (2) | I - U'U | / ( M ulp )
*>
*> (3) | I - VT VT' | / ( N ulp )
*>
*> (4) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (5) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (6) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (7) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for ZGESVDX( 'V', 'V', 'I' )
*>
*> (8) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*> *>
*> (9) | I - U'U | / ( M ulp ) *> (9) | I - U'U | / ( M ulp )
*> *>
*> (10) | I - VT VT' | / ( N ulp ) *> (10) | I - VT VT' | / ( N ulp )
*> *>
*> (11) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (12) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (13) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (14) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for ZGESVDQ:
*>
*> (36) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (37) | I - U'U | / ( M ulp )
*>
*> (38) | I - VT VT' | / ( N ulp )
*>
*> (39) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for ZGESVJ:
*>
*> (15) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (16) | I - U'U | / ( M ulp )
*>
*> (17) | I - VT VT' | / ( N ulp )
*>
*> (18) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for ZGEJSV:
*>
*> (19) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (20) | I - U'U | / ( M ulp )
*>
*> (21) | I - VT VT' | / ( N ulp )
*>
*> (22) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> Test for ZGESVDX( 'V', 'V', 'A' )/ZGESVDX( 'N', 'N', 'A' )
*>
*> (23) | A - U diag(S) VT | / ( |A| max(M,N) ulp )
*>
*> (24) | I - U'U | / ( M ulp )
*>
*> (25) | I - VT VT' | / ( N ulp )
*>
*> (26) S contains MNMIN nonnegative values in decreasing order.
*> (Return 0 if true, 1/ULP if false.)
*>
*> (27) | U - Upartial | / ( M ulp ) where Upartial is a partially
*> computed U.
*>
*> (28) | VT - VTpartial | / ( N ulp ) where VTpartial is a partially
*> computed VT.
*>
*> (29) | S - Spartial | / ( MNMIN ulp |S| ) where Spartial is the
*> vector of singular values from the partial SVD
*>
*> Test for ZGESVDX( 'V', 'V', 'I' )
*>
*> (30) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*>
*> (31) | I - U'U | / ( M ulp )
*>
*> (32) | I - VT VT' | / ( N ulp )
*>
*> Test for ZGESVDX( 'V', 'V', 'V' ) *> Test for ZGESVDX( 'V', 'V', 'V' )
*> *>
*> (11) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp ) *> (33) | U' A VT''' - diag(S) | / ( |A| max(M,N) ulp )
*> *>
*> (12) | I - U'U | / ( M ulp ) *> (34) | I - U'U | / ( M ulp )
*> *>
*> (13) | I - VT VT' | / ( N ulp ) *> (35) | I - VT VT' | / ( N ulp )
*> *>
*> The "sizes" are specified by the arrays MM(1:NSIZES) and *> The "sizes" are specified by the arrays MM(1:NSIZES) and
*> NN(1:NSIZES); the value of each element pair (MM(j),NN(j)) *> NN(1:NSIZES); the value of each element pair (MM(j),NN(j))
@ -393,6 +405,8 @@
* -- 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..--
* June 2016 * June 2016
*
IMPLICIT NONE
* *
* .. Scalar Arguments .. * .. Scalar Arguments ..
INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES, INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES,
@ -411,7 +425,7 @@
* ===================================================================== * =====================================================================
* *
* .. Parameters .. * .. Parameters ..
DOUBLE PRECISION ZERO, ONE, TWO, HALF DOUBLE PRECISION ZERO, ONE, TWO, HALF
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
$ HALF = 0.5D0 ) $ HALF = 0.5D0 )
COMPLEX*16 CZERO, CONE COMPLEX*16 CZERO, CONE
@ -431,10 +445,13 @@
DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV, DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
$ UNFL, VL, VU $ UNFL, VL, VU
* .. * ..
* .. Local Scalars for ZGESVDQ ..
INTEGER LIWORK, NUMRANK
* ..
* .. Local Arrays .. * .. Local Arrays ..
CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 ) CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
INTEGER IOLDSD( 4 ), ISEED2( 4 ) INTEGER IOLDSD( 4 ), ISEED2( 4 )
DOUBLE PRECISION RESULT( 35 ) DOUBLE PRECISION RESULT( 39 )
* .. * ..
* .. External Functions .. * .. External Functions ..
DOUBLE PRECISION DLAMCH, DLARND DOUBLE PRECISION DLAMCH, DLARND
@ -442,8 +459,8 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL ALASVM, XERBLA, ZBDT01, ZBDT05, ZGESDD, EXTERNAL ALASVM, XERBLA, ZBDT01, ZBDT05, ZGESDD,
$ ZGESVD, ZGESVJ, ZGEJSV, ZGESVDX, ZLACPY, $ ZGESVD, ZGESVDQ, ZGESVJ, ZGEJSV, ZGESVDX,
$ ZLASET, ZLATMS, ZUNT01, ZUNT03 $ ZLACPY, ZLASET, ZLATMS, ZUNT01, ZUNT03
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, MAX, MIN INTRINSIC ABS, DBLE, MAX, MIN
@ -836,10 +853,65 @@
120 CONTINUE 120 CONTINUE
RESULT( 14 ) = MAX( RESULT( 14 ), DIF ) RESULT( 14 ) = MAX( RESULT( 14 ), DIF )
130 CONTINUE 130 CONTINUE
* *
* Test ZGESVJ: Factorize A * Test ZGESVDQ
* Note: ZGESVJ does not work for M < N * Note: ZGESVDQ only works for M >= N
*
RESULT( 36 ) = ZERO
RESULT( 37 ) = ZERO
RESULT( 38 ) = ZERO
RESULT( 39 ) = ZERO
*
IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 )
IF( IWSPC.EQ.4 )
$ LSWORK = LWORK
*
CALL ZLACPY( 'F', M, N, ASAV, LDA, A, LDA )
SRNAMT = 'ZGESVDQ'
*
LRWORK = MAX(2, M, 5*N)
LIWORK = MAX( N, 1 )
CALL ZGESVDQ( 'H', 'N', 'N', 'A', 'A',
$ M, N, A, LDA, SSAV, USAV, LDU,
$ VTSAV, LDVT, NUMRANK, IWORK, LIWORK,
$ WORK, LWORK, RWORK, LRWORK, IINFO )
*
IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9995 )'ZGESVDQ', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO )
RETURN
END IF
*
* Do tests 36--39
*
CALL ZBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
$ VTSAV, LDVT, WORK, RWORK, RESULT( 36 ) )
IF( M.NE.0 .AND. N.NE.0 ) THEN
CALL ZUNT01( 'Columns', M, M, USAV, LDU, WORK,
$ LWORK, RWORK, RESULT( 37 ) )
CALL ZUNT01( 'Rows', N, N, VTSAV, LDVT, WORK,
$ LWORK, RWORK, RESULT( 38 ) )
END IF
RESULT( 39 ) = ZERO
DO 199 I = 1, MNMIN - 1
IF( SSAV( I ).LT.SSAV( I+1 ) )
$ RESULT( 39 ) = ULPINV
IF( SSAV( I ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
199 CONTINUE
IF( MNMIN.GE.1 ) THEN
IF( SSAV( MNMIN ).LT.ZERO )
$ RESULT( 39 ) = ULPINV
END IF
END IF
*
* Test ZGESVJ
* Note: ZGESVJ only works for M >= N
* *
RESULT( 15 ) = ZERO RESULT( 15 ) = ZERO
RESULT( 16 ) = ZERO RESULT( 16 ) = ZERO
@ -847,13 +919,13 @@
RESULT( 18 ) = ZERO RESULT( 18 ) = ZERO
* *
IF( M.GE.N ) THEN IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK ) LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 ) LSWORK = MAX( LSWORK, 1 )
LRWORK = MAX(6,N) LRWORK = MAX(6,N)
IF( IWSPC.EQ.4 ) IF( IWSPC.EQ.4 )
$ LSWORK = LWORK $ LSWORK = LWORK
* *
CALL ZLACPY( 'F', M, N, ASAV, LDA, USAV, LDA ) CALL ZLACPY( 'F', M, N, ASAV, LDA, USAV, LDA )
SRNAMT = 'ZGESVJ' SRNAMT = 'ZGESVJ'
@ -861,8 +933,7 @@
& 0, A, LDVT, WORK, LWORK, RWORK, & 0, A, LDVT, WORK, LWORK, RWORK,
& LRWORK, IINFO ) & LRWORK, IINFO )
* *
* ZGESVJ retuns V not VT, so we transpose to use the same * ZGESVJ returns V not VH
* test suite.
* *
DO J=1,N DO J=1,N
DO I=1,N DO I=1,N
@ -900,21 +971,21 @@
END IF END IF
END IF END IF
* *
* Test ZGEJSV: Factorize A * Test ZGEJSV
* Note: ZGEJSV does not work for M < N * Note: ZGEJSV only works for M >= N
* *
RESULT( 19 ) = ZERO RESULT( 19 ) = ZERO
RESULT( 20 ) = ZERO RESULT( 20 ) = ZERO
RESULT( 21 ) = ZERO RESULT( 21 ) = ZERO
RESULT( 22 ) = ZERO RESULT( 22 ) = ZERO
IF( M.GE.N ) THEN IF( M.GE.N ) THEN
IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N ) IWTMP = 2*MNMIN*MNMIN + 2*MNMIN + MAX( M, N )
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3 LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
LSWORK = MIN( LSWORK, LWORK ) LSWORK = MIN( LSWORK, LWORK )
LSWORK = MAX( LSWORK, 1 ) LSWORK = MAX( LSWORK, 1 )
IF( IWSPC.EQ.4 ) IF( IWSPC.EQ.4 )
$ LSWORK = LWORK $ LSWORK = LWORK
LRWORK = MAX( 7, N + 2*M) LRWORK = MAX( 7, N + 2*M)
* *
CALL ZLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA ) CALL ZLACPY( 'F', M, N, ASAV, LDA, VTSAV, LDA )
SRNAMT = 'ZGEJSV' SRNAMT = 'ZGEJSV'
@ -923,8 +994,7 @@
& WORK, LWORK, RWORK, & WORK, LWORK, RWORK,
& LRWORK, IWORK, IINFO ) & LRWORK, IWORK, IINFO )
* *
* ZGEJSV retuns V not VT, so we transpose to use the same * ZGEJSV returns V not VH
* test suite.
* *
DO 133 J=1,N DO 133 J=1,N
DO 132 I=1,N DO 132 I=1,N
@ -933,7 +1003,7 @@
133 END DO 133 END DO
* *
IF( IINFO.NE.0 ) THEN IF( IINFO.NE.0 ) THEN
WRITE( NOUNIT, FMT = 9995 )'GESVJ', IINFO, M, N, WRITE( NOUNIT, FMT = 9995 )'GEJSV', IINFO, M, N,
$ JTYPE, LSWORK, IOLDSD $ JTYPE, LSWORK, IOLDSD
INFO = ABS( IINFO ) INFO = ABS( IINFO )
RETURN RETURN
@ -1160,7 +1230,7 @@
* *
NTEST = 0 NTEST = 0
NFAIL = 0 NFAIL = 0
DO 190 J = 1, 35 DO 190 J = 1, 39
IF( RESULT( J ).GE.ZERO ) IF( RESULT( J ).GE.ZERO )
$ NTEST = NTEST + 1 $ NTEST = NTEST + 1
IF( RESULT( J ).GE.THRESH ) IF( RESULT( J ).GE.THRESH )
@ -1175,7 +1245,7 @@
NTESTF = 2 NTESTF = 2
END IF END IF
* *
DO 200 J = 1, 35 DO 200 J = 1, 39
IF( RESULT( J ).GE.THRESH ) THEN IF( RESULT( J ).GE.THRESH ) THEN
WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC, WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC,
$ IOLDSD, J, RESULT( J ) $ IOLDSD, J, RESULT( J )
@ -1251,6 +1321,12 @@
$ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )', $ / '33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
$ / '34 = | I - U**T U | / ( M ulp ) ', $ / '34 = | I - U**T U | / ( M ulp ) ',
$ / '35 = | I - VT VT**T | / ( N ulp ) ', $ / '35 = | I - VT VT**T | / ( N ulp ) ',
$ ' ZGESVDQ(H,N,N,A,A',
$ / '36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
$ / '37 = | I - U**T U | / ( M ulp ) ',
$ / '38 = | I - VT VT**T | / ( N ulp ) ',
$ / '39 = 0 if S contains min(M,N) nonnegative values in',
$ ' decreasing order, else 1/ulp',
$ / / ) $ / / )
9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1, 9997 FORMAT( ' M=', I5, ', N=', I5, ', type ', I1, ', IWS=', I1,
$ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 ) $ ', seed=', 4( I4, ',' ), ' test(', I2, ')=', G11.4 )

59
lapack-netlib/TESTING/EIG/zerred.f
View File

@ -36,6 +36,8 @@
*> ZGEJSV compute SVD of an M-by-N matrix A where M >= N *> ZGEJSV compute SVD of an M-by-N matrix A where M >= N
*> ZGESVDX compute SVD of an M-by-N matrix A(by bisection *> ZGESVDX compute SVD of an M-by-N matrix A(by bisection
*> and inverse iteration) *> and inverse iteration)
*> ZGESVDQ compute SVD of an M-by-N matrix A(with a
*> QR-Preconditioned )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -101,7 +103,7 @@
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CHKXER, ZGEES, ZGEESX, ZGEEV, ZGEEVX, ZGESVJ, EXTERNAL CHKXER, ZGEES, ZGEESX, ZGEEV, ZGEEVX, ZGESVJ,
$ ZGESDD, ZGESVD $ ZGESDD, ZGESVD, ZGESVDX, ZGESVQ
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAMEN, ZSLECT LOGICAL LSAMEN, ZSLECT
@ -495,6 +497,61 @@
ELSE ELSE
WRITE( NOUT, FMT = 9998 ) WRITE( NOUT, FMT = 9998 )
END IF END IF
*
* Test ZGESVDQ
*
SRNAMT = 'ZGESVDQ'
INFOT = 1
CALL ZGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 2
CALL ZGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 3
CALL ZGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 4
CALL ZGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 5
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 6
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 7
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 9
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U,
$ 0, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 12
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ -1, VT, 0, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 14
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, -1, NS, IW, 1, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
INFOT = 17
CALL ZGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U,
$ 1, VT, 1, NS, IW, -5, W, 1, RW, 1, INFO )
CALL CHKXER( 'ZGESVDQ', INFOT, NOUT, LERR, OK )
NT = 11
IF( OK ) THEN
WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ),
$ NT
ELSE
WRITE( NOUT, FMT = 9998 )
END IF
END IF END IF
* *
* Print a summary line. * Print a summary line.

17
lapack-netlib/TESTING/EIG/zget51.f
View File

@ -29,12 +29,13 @@
*> *>
*> ZGET51 generally checks a decomposition of the form *> ZGET51 generally checks a decomposition of the form
*> *>
*> A = U B VC> *> A = U B V**H
*> where * means conjugate transpose and U and V are unitary. *>
*> where **H means conjugate transpose and U and V are unitary.
*> *>
*> Specifically, if ITYPE=1 *> Specifically, if ITYPE=1
*> *>
*> RESULT = | A - U B V* | / ( |A| n ulp ) *> RESULT = | A - U B V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
@ -42,7 +43,7 @@
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT = | I - UU* | / ( n ulp ) *> RESULT = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -52,9 +53,9 @@
*> \verbatim *> \verbatim
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> =1: RESULT = | A - U B V* | / ( |A| n ulp ) *> =1: RESULT = | A - U B V**H | / ( |A| n ulp )
*> =2: RESULT = | A - B | / ( |A| n ulp ) *> =2: RESULT = | A - B | / ( |A| n ulp )
*> =3: RESULT = | I - UU* | / ( n ulp ) *> =3: RESULT = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] N *> \param[in] N
@ -218,7 +219,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: Compute W = A - UBV' * ITYPE=1: Compute W = A - U B V**H
* *
CALL ZLACPY( ' ', N, N, A, LDA, WORK, N ) CALL ZLACPY( ' ', N, N, A, LDA, WORK, N )
CALL ZGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO, CALL ZGEMM( 'N', 'N', N, N, N, CONE, U, LDU, B, LDB, CZERO,
@ -259,7 +260,7 @@
* *
* Tests not scaled by norm(A) * Tests not scaled by norm(A)
* *
* ITYPE=3: Compute UU' - I * ITYPE=3: Compute U U**H - I
* *
CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,
$ WORK, N ) $ WORK, N )

12
lapack-netlib/TESTING/EIG/zhbt21.f
View File

@ -28,14 +28,16 @@
*> *>
*> ZHBT21 generally checks a decomposition of the form *> ZHBT21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian banded, U is *>
*> where **H means conjugate transpose, A is hermitian banded, U is
*> unitary, and S is diagonal (if KS=0) or symmetric *> unitary, and S is diagonal (if KS=0) or symmetric
*> tridiagonal (if KS=1). *> tridiagonal (if KS=1).
*> *>
*> Specifically: *> Specifically:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -220,7 +222,7 @@
* *
ANORM = MAX( ZLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL ) ANORM = MAX( ZLANHB( '1', CUPLO, N, IKA, A, LDA, RWORK ), UNFL )
* *
* Compute error matrix: Error = A - U S U* * Compute error matrix: Error = A - U S U**H
* *
* Copy A from SB to SP storage format. * Copy A from SB to SP storage format.
* *
@ -271,7 +273,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK,
$ N ) $ N )

34
lapack-netlib/TESTING/EIG/zhet21.f
View File

@ -29,8 +29,9 @@
*> *>
*> ZHET21 generally checks a decomposition of the form *> ZHET21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian, U is unitary, and *>
*> where **H means conjugate transpose, A is hermitian, U is unitary, and
*> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if *> S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if
*> KBAND=1). *> KBAND=1).
*> *>
@ -42,18 +43,19 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> *>
*> For ITYPE > 1, the transformation U is expressed as a product *> For ITYPE > 1, the transformation U is expressed as a product
*> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)C> and each *> V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)**H and each
*> vector v(j) has its first j elements 0 and the remaining n-j elements *> vector v(j) has its first j elements 0 and the remaining n-j elements
*> stored in V(j+1:n,j). *> stored in V(j+1:n,j).
*> \endverbatim *> \endverbatim
@ -66,14 +68,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense unitary matrix: *> 1: U expressed as a dense unitary matrix:
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense unitary matrix and *> 3: U expressed both as a dense unitary matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -171,7 +174,7 @@
*> \verbatim *> \verbatim
*> TAU is COMPLEX*16 array, dimension (N) *> TAU is COMPLEX*16 array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)* in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -294,7 +297,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U* * ITYPE=1: error = A - U S U**H
* *
CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
CALL ZLACPY( CUPLO, N, N, A, LDA, WORK, N ) CALL ZLACPY( CUPLO, N, N, A, LDA, WORK, N )
@ -304,8 +307,7 @@
10 CONTINUE 10 CONTINUE
* *
IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
CMK DO 20 J = 1, N - 1 DO 20 J = 1, N - 1
DO 20 J = 2, N - 1
CALL ZHER2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1, CALL ZHER2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1,
$ U( 1, J-1 ), 1, WORK, N ) $ U( 1, J-1 ), 1, WORK, N )
20 CONTINUE 20 CONTINUE
@ -314,7 +316,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V* - A * ITYPE=2: error = V S V**H - A
* *
CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
* *
@ -371,7 +373,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V* - I * ITYPE=3: error = U V**H - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -407,7 +409,7 @@ CMK DO 20 J = 1, N - 1
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,

12
lapack-netlib/TESTING/EIG/zhet22.f
View File

@ -42,7 +42,8 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | U' A U - S | / ( |A| m ulp ) *andC> RESULT(2) = | I - U'U | / ( m ulp ) *> RESULT(1) = | U**H A U - S | / ( |A| m ulp ) and
*> RESULT(2) = | I - U**H U | / ( m ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -52,7 +53,8 @@
*> ITYPE INTEGER *> ITYPE INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense orthogonal matrix: *> 1: U expressed as a dense orthogonal matrix:
*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU' | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) *and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> UPLO CHARACTER *> UPLO CHARACTER
*> If UPLO='U', the upper triangle of A will be used and the *> If UPLO='U', the upper triangle of A will be used and the
@ -122,7 +124,7 @@
*> *>
*> TAU COMPLEX*16 array, dimension (N) *> TAU COMPLEX*16 array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)' in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> Not modified. *> Not modified.
@ -215,7 +217,7 @@
* *
* Compute error matrix: * Compute error matrix:
* *
* ITYPE=1: error = U' A U - S * ITYPE=1: error = U**H A U - S
* *
CALL ZHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK, CALL ZHEMM( 'L', UPLO, N, M, CONE, A, LDA, U, LDU, CZERO, WORK,
$ N ) $ N )
@ -249,7 +251,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute U'U - I * Compute U**H U - I
* *
IF( ITYPE.EQ.1 ) IF( ITYPE.EQ.1 )
$ CALL ZUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK, $ CALL ZUNT01( 'Columns', N, M, U, LDU, WORK, 2*N*N, RWORK,

38
lapack-netlib/TESTING/EIG/zhpt21.f
View File

@ -29,8 +29,9 @@
*> *>
*> ZHPT21 generally checks a decomposition of the form *> ZHPT21 generally checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is hermitian, U is *>
*> where **H means conjugate transpose, A is hermitian, U is
*> unitary, and S is diagonal (if KBAND=0) or (real) symmetric *> unitary, and S is diagonal (if KBAND=0) or (real) symmetric
*> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as *> tridiagonal (if KBAND=1). If ITYPE=1, then U is represented as
*> a dense matrix, otherwise the U is expressed as a product of *> a dense matrix, otherwise the U is expressed as a product of
@ -41,15 +42,16 @@
*> *>
*> Specifically, if ITYPE=1, then: *> Specifically, if ITYPE=1, then:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> If ITYPE=2, then: *> If ITYPE=2, then:
*> *>
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> If ITYPE=3, then: *> If ITYPE=3, then:
*> *>
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> *>
*> Packed storage means that, for example, if UPLO='U', then the columns *> Packed storage means that, for example, if UPLO='U', then the columns
*> of the upper triangle of A are stored one after another, so that *> of the upper triangle of A are stored one after another, so that
@ -70,14 +72,16 @@
*> *>
*> If UPLO='U', then V = H(n-1)...H(1), where *> If UPLO='U', then V = H(n-1)...H(1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)C> *> H(j) = I - tau(j) v(j) v(j)**H
*>
*> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1), *> and the first j-1 elements of v(j) are stored in V(1:j-1,j+1),
*> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ), *> (i.e., VP( j*(j+1)/2 + 1 : j*(j+1)/2 + j-1 ) ),
*> the j-th element is 1, and the last n-j elements are 0. *> the j-th element is 1, and the last n-j elements are 0.
*> *>
*> If UPLO='L', then V = H(1)...H(n-1), where *> If UPLO='L', then V = H(1)...H(n-1), where
*> *>
*> H(j) = I - tau(j) v(j) v(j)C> *> H(j) = I - tau(j) v(j) v(j)**H
*>
*> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the *> and the first j elements of v(j) are 0, the (j+1)-st is 1, and the
*> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e., *> (j+2)-nd through n-th elements are stored in V(j+2:n,j) (i.e.,
*> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .) *> in VP( (2*n-j)*(j-1)/2 + j+2 : (2*n-j)*(j-1)/2 + n ) .)
@ -91,14 +95,15 @@
*> ITYPE is INTEGER *> ITYPE is INTEGER
*> Specifies the type of tests to be performed. *> Specifies the type of tests to be performed.
*> 1: U expressed as a dense unitary matrix: *> 1: U expressed as a dense unitary matrix:
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *andC> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp ) and
*> RESULT(2) = | I - U U**H | / ( n ulp )
*> *>
*> 2: U expressed as a product V of Housholder transformations: *> 2: U expressed as a product V of Housholder transformations:
*> RESULT(1) = | A - V S V* | / ( |A| n ulp ) *> RESULT(1) = | A - V S V**H | / ( |A| n ulp )
*> *>
*> 3: U expressed both as a dense unitary matrix and *> 3: U expressed both as a dense unitary matrix and
*> as a product of Housholder transformations: *> as a product of Housholder transformations:
*> RESULT(1) = | I - UV* | / ( n ulp ) *> RESULT(1) = | I - U V**H | / ( n ulp )
*> \endverbatim *> \endverbatim
*> *>
*> \param[in] UPLO *> \param[in] UPLO
@ -181,7 +186,7 @@
*> \verbatim *> \verbatim
*> TAU is COMPLEX*16 array, dimension (N) *> TAU is COMPLEX*16 array, dimension (N)
*> If ITYPE >= 2, then TAU(j) is the scalar factor of *> If ITYPE >= 2, then TAU(j) is the scalar factor of
*> v(j) v(j)* in the Householder transformation H(j) of *> v(j) v(j)**H in the Householder transformation H(j) of
*> the product U = H(1)...H(n-2) *> the product U = H(1)...H(n-2)
*> If ITYPE < 2, then TAU is not referenced. *> If ITYPE < 2, then TAU is not referenced.
*> \endverbatim *> \endverbatim
@ -313,7 +318,7 @@
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
* *
* ITYPE=1: error = A - U S U* * ITYPE=1: error = A - U S U**H
* *
CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
CALL ZCOPY( LAP, AP, 1, WORK, 1 ) CALL ZCOPY( LAP, AP, 1, WORK, 1 )
@ -323,8 +328,7 @@
10 CONTINUE 10 CONTINUE
* *
IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
CMK DO 20 J = 1, N - 1 DO 20 J = 1, N - 1
DO 20 J = 2, N - 1
CALL ZHPR2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1, CALL ZHPR2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1,
$ U( 1, J-1 ), 1, WORK ) $ U( 1, J-1 ), 1, WORK )
20 CONTINUE 20 CONTINUE
@ -333,7 +337,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.2 ) THEN ELSE IF( ITYPE.EQ.2 ) THEN
* *
* ITYPE=2: error = V S V* - A * ITYPE=2: error = V S V**H - A
* *
CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N ) CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
* *
@ -401,7 +405,7 @@ CMK DO 20 J = 1, N - 1
* *
ELSE IF( ITYPE.EQ.3 ) THEN ELSE IF( ITYPE.EQ.3 ) THEN
* *
* ITYPE=3: error = U V* - I * ITYPE=3: error = U V**H - I
* *
IF( N.LT.2 ) IF( N.LT.2 )
$ RETURN $ RETURN
@ -432,7 +436,7 @@ CMK DO 20 J = 1, N - 1
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
IF( ITYPE.EQ.1 ) THEN IF( ITYPE.EQ.1 ) THEN
CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,

11
lapack-netlib/TESTING/EIG/zstt21.f
View File

@ -28,14 +28,15 @@
*> *>
*> ZSTT21 checks a decomposition of the form *> ZSTT21 checks a decomposition of the form
*> *>
*> A = U S UC> *> A = U S U**H
*> where * means conjugate transpose, A is real symmetric tridiagonal, *>
*> where **H means conjugate transpose, A is real symmetric tridiagonal,
*> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric *> U is unitary, and S is real and diagonal (if KBAND=0) or symmetric
*> tridiagonal (if KBAND=1). Two tests are performed: *> tridiagonal (if KBAND=1). Two tests are performed:
*> *>
*> RESULT(1) = | A - U S U* | / ( |A| n ulp ) *> RESULT(1) = | A - U S U**H | / ( |A| n ulp )
*> *>
*> RESULT(2) = | I - UU* | / ( n ulp ) *> RESULT(2) = | I - U U**H | / ( n ulp )
*> \endverbatim *> \endverbatim
* *
* Arguments: * Arguments:
@ -228,7 +229,7 @@
* *
* Do Test 2 * Do Test 2
* *
* Compute UU* - I * Compute U U**H - I
* *
CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK, CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO, WORK,
$ N ) $ N )