Skip to content

Commit 88b70fb

Browse files
martin-frbgmartin-frbg
authored
Add new tests for Householder reconstruction functions from 3.9.1
1 parent 4c1d470 commit 88b70fb

14 files changed

+2033
-134
lines changed

‎lapack-netlib/TESTING/LIN/CMakeLists.txt

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ set(SLINTST schkaa.f
4040
sgennd.f sqrt04.f sqrt05.f schkqrt.f serrqrt.f schkqrtp.f serrqrtp.f
4141
schklqt.f schklqtp.f schktsqr.f
4242
serrlqt.f serrlqtp.f serrtsqr.f stsqr01.f slqt04.f slqt05.f
43-
schkorhr_col.f serrorhr_col.f sorhr_col01.f)
43+
schkorhr_col.f serrorhr_col.f sorhr_col01.f sorhr_col02.f)
4444

4545
if(USE_XBLAS)
4646
list(APPEND SLINTST sdrvgbx.f sdrvgex.f sdrvsyx.f sdrvpox.f
@@ -96,7 +96,7 @@ set(CLINTST cchkaa.f
9696
cqrt04.f cqrt05.f cchkqrt.f cerrqrt.f cchkqrtp.f cerrqrtp.f
9797
cchklqt.f cchklqtp.f cchktsqr.f
9898
cerrlqt.f cerrlqtp.f cerrtsqr.f ctsqr01.f clqt04.f clqt05.f
99-
cchkunhr_col.f cerrunhr_col.f cunhr_col01.f)
99+
cchkunhr_col.f cerrunhr_col.f cunhr_col01.f cunhr_col02.f)
100100

101101
if(USE_XBLAS)
102102
list(APPEND CLINTST cdrvgbx.f cdrvgex.f cdrvhex.f cdrvsyx.f cdrvpox.f
@@ -142,7 +142,7 @@ set(DLINTST dchkaa.f
142142
dqrt04.f dqrt05.f dchkqrt.f derrqrt.f dchkqrtp.f derrqrtp.f
143143
dchklq.f dchklqt.f dchklqtp.f dchktsqr.f
144144
derrlqt.f derrlqtp.f derrtsqr.f dtsqr01.f dlqt04.f dlqt05.f
145-
dchkorhr_col.f derrorhr_col.f dorhr_col01.f)
145+
dchkorhr_col.f derrorhr_col.f dorhr_col01.f dorhr_col02.f)
146146

147147
if(USE_XBLAS)
148148
list(APPEND DLINTST ddrvgbx.f ddrvgex.f ddrvsyx.f ddrvpox.f
@@ -198,7 +198,7 @@ set(ZLINTST zchkaa.f
198198
zqrt04.f zqrt05.f zchkqrt.f zerrqrt.f zchkqrtp.f zerrqrtp.f
199199
zchklqt.f zchklqtp.f zchktsqr.f
200200
zerrlqt.f zerrlqtp.f zerrtsqr.f ztsqr01.f zlqt04.f zlqt05.f
201-
zchkunhr_col.f zerrunhr_col.f zunhr_col01.f)
201+
zchkunhr_col.f zerrunhr_col.f zunhr_col01.f zunhr_col02.f)
202202

203203
if(USE_XBLAS)
204204
list(APPEND ZLINTST zdrvgbx.f zdrvgex.f zdrvhex.f zdrvsyx.f zdrvpox.f

‎lapack-netlib/TESTING/LIN/Makefile

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ SLINTST = schkaa.o \
7474
sgennd.o sqrt04.o sqrt05.o schkqrt.o serrqrt.o schkqrtp.o serrqrtp.o \
7575
schklqt.o schklqtp.o schktsqr.o \
7676
serrlqt.o serrlqtp.o serrtsqr.o stsqr01.o slqt04.o slqt05.o \
77-
schkorhr_col.o serrorhr_col.o sorhr_col01.o
77+
schkorhr_col.o serrorhr_col.o sorhr_col01.o sorhr_col02.o
7878

7979
ifdef USEXBLAS
8080
SLINTST += sdrvgbx.o sdrvgex.o sdrvsyx.o sdrvpox.o \
@@ -123,7 +123,7 @@ CLINTST = cchkaa.o \
123123
cqrt04.o cqrt05.o cchkqrt.o cerrqrt.o cchkqrtp.o cerrqrtp.o \
124124
cchklqt.o cchklqtp.o cchktsqr.o \
125125
cerrlqt.o cerrlqtp.o cerrtsqr.o ctsqr01.o clqt04.o clqt05.o \
126-
cchkunhr_col.o cerrunhr_col.o cunhr_col01.o
126+
cchkunhr_col.o cerrunhr_col.o cunhr_col01.o cunhr_col02.o
127127

128128
ifdef USEXBLAS
129129
CLINTST += cdrvgbx.o cdrvgex.o cdrvhex.o cdrvsyx.o cdrvpox.o \
@@ -167,7 +167,7 @@ DLINTST = dchkaa.o \
167167
dqrt04.o dqrt05.o dchkqrt.o derrqrt.o dchkqrtp.o derrqrtp.o \
168168
dchklq.o dchklqt.o dchklqtp.o dchktsqr.o \
169169
derrlqt.o derrlqtp.o derrtsqr.o dtsqr01.o dlqt04.o dlqt05.o \
170-
dchkorhr_col.o derrorhr_col.o dorhr_col01.o
170+
dchkorhr_col.o derrorhr_col.o dorhr_col01.o dorhr_col02.o
171171

172172
ifdef USEXBLAS
173173
DLINTST += ddrvgbx.o ddrvgex.o ddrvsyx.o ddrvpox.o \
@@ -215,7 +215,7 @@ ZLINTST = zchkaa.o \
215215
zqrt04.o zqrt05.o zchkqrt.o zerrqrt.o zchkqrtp.o zerrqrtp.o \
216216
zchklqt.o zchklqtp.o zchktsqr.o \
217217
zerrlqt.o zerrlqtp.o zerrtsqr.o ztsqr01.o zlqt04.o zlqt05.o \
218-
zchkunhr_col.o zerrunhr_col.o zunhr_col01.o
218+
zchkunhr_col.o zerrunhr_col.o zunhr_col01.o zunhr_col02.o
219219

220220
ifdef USEXBLAS
221221
ZLINTST += zdrvgbx.o zdrvgex.o zdrvhex.o zdrvsyx.o zdrvpox.o \

‎lapack-netlib/TESTING/LIN/cchkunhr_col.f

Lines changed: 82 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -24,9 +24,12 @@
2424
*>
2525
*> \verbatim
2626
*>
27-
*> CCHKUNHR_COL tests CUNHR_COL using CLATSQR and CGEMQRT. Therefore, CLATSQR
28-
*> (used in CGEQR) and CGEMQRT (used in CGEMQR) have to be tested
29-
*> before this test.
27+
*> CCHKUNHR_COL tests:
28+
*> 1) CUNGTSQR and CUNHR_COL using CLATSQR, CGEMQRT,
29+
*> 2) CUNGTSQR_ROW and CUNHR_COL inside CGETSQRHRT
30+
*> (which calls CLATSQR, CUNGTSQR_ROW and CUNHR_COL) using CGEMQRT.
31+
*> Therefore, CLATSQR (part of CGEQR), CGEMQRT (part of CGEMQR)
32+
*> have to be tested before this test.
3033
*>
3134
*> \endverbatim
3235
*
@@ -97,19 +100,16 @@
97100
*> \author Univ. of Colorado Denver
98101
*> \author NAG Ltd.
99102
*
100-
*> \date November 2019
101-
*
102103
*> \ingroup complex_lin
103104
*
104105
* =====================================================================
105-
SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
106-
$ NBVAL, NOUT )
106+
SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL,
107+
$ NNB, NBVAL, NOUT )
107108
IMPLICIT NONE
108109
*
109-
* -- LAPACK test routine (version 3.7.0) --
110+
* -- LAPACK test routine --
110111
* -- LAPACK is a software package provided by Univ. of Tennessee, --
111112
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112-
* December 2016
113113
*
114114
* .. Scalar Arguments ..
115115
LOGICAL TSTERR
@@ -135,10 +135,11 @@ SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
135135
REAL RESULT( NTESTS )
136136
* ..
137137
* .. External Subroutines ..
138-
EXTERNAL ALAHD, ALASUM, CERRUNHR_COL, CUNHR_COL01
138+
EXTERNAL ALAHD, ALASUM, CERRUNHR_COL, CUNHR_COL01,
139+
$ CUNHR_COL02
139140
* ..
140141
* .. Intrinsic Functions ..
141-
INTRINSIC MAX, MIN
142+
INTRINSIC MAX, MIN
142143
* ..
143144
* .. Scalars in Common ..
144145
LOGICAL LERR, OK
@@ -201,8 +202,8 @@ SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
201202
*
202203
* Test CUNHR_COL
203204
*
204-
CALL CUNHR_COL01( M, N, MB1, NB1, NB2,
205-
$ RESULT )
205+
CALL CUNHR_COL01( M, N, MB1, NB1,
206+
$ NB2, RESULT )
206207
*
207208
* Print information about the tests that did
208209
* not pass the threshold.
@@ -226,12 +227,78 @@ SUBROUTINE CCHKUNHR_COL( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB,
226227
END DO
227228
END DO
228229
*
230+
* Do for each value of M in MVAL.
231+
*
232+
DO I = 1, NM
233+
M = MVAL( I )
234+
*
235+
* Do for each value of N in NVAL.
236+
*
237+
DO J = 1, NN
238+
N = NVAL( J )
239+
*
240+
* Only for M >= N
241+
*
242+
IF ( MIN( M, N ).GT.0 .AND. M.GE.N ) THEN
243+
*
244+
* Do for each possible value of MB1
245+
*
246+
DO IMB1 = 1, NNB
247+
MB1 = NBVAL( IMB1 )
248+
*
249+
* Only for MB1 > N
250+
*
251+
IF ( MB1.GT.N ) THEN
252+
*
253+
* Do for each possible value of NB1
254+
*
255+
DO INB1 = 1, NNB
256+
NB1 = NBVAL( INB1 )
257+
*
258+
* Do for each possible value of NB2
259+
*
260+
DO INB2 = 1, NNB
261+
NB2 = NBVAL( INB2 )
262+
*
263+
IF( NB1.GT.0 .AND. NB2.GT.0 ) THEN
264+
*
265+
* Test CUNHR_COL
266+
*
267+
CALL CUNHR_COL02( M, N, MB1, NB1,
268+
$ NB2, RESULT )
269+
*
270+
* Print information about the tests that did
271+
* not pass the threshold.
272+
*
273+
DO T = 1, NTESTS
274+
IF( RESULT( T ).GE.THRESH ) THEN
275+
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
276+
$ CALL ALAHD( NOUT, PATH )
277+
WRITE( NOUT, FMT = 9998 ) M, N, MB1,
278+
$ NB1, NB2, T, RESULT( T )
279+
NFAIL = NFAIL + 1
280+
END IF
281+
END DO
282+
NRUN = NRUN + NTESTS
283+
END IF
284+
END DO
285+
END DO
286+
END IF
287+
END DO
288+
END IF
289+
END DO
290+
END DO
291+
*
229292
* Print a summary of the results.
230293
*
231294
CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
232295
*
233-
9999 FORMAT( 'M=', I5, ', N=', I5, ', MB1=', I5,
234-
$ ', NB1=', I5, ', NB2=', I5,' test(', I2, ')=', G12.5 )
296+
9999 FORMAT( 'CUNGTSQR and CUNHR_COL: M=', I5, ', N=', I5,
297+
$ ', MB1=', I5, ', NB1=', I5, ', NB2=', I5,
298+
$ ' test(', I2, ')=', G12.5 )
299+
9998 FORMAT( 'CUNGTSQR_ROW and CUNHR_COL: M=', I5, ', N=', I5,
300+
$ ', MB1=', I5, ', NB1=', I5, ', NB2=', I5,
301+
$ ' test(', I2, ')=', G12.5 )
235302
RETURN
236303
*
237304
* End of CCHKUNHR_COL

‎lapack-netlib/TESTING/LIN/cunhr_col01.f

Lines changed: 48 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -13,16 +13,16 @@
1313
* .. Scalar Arguments ..
1414
* INTEGER M, N, MB1, NB1, NB2
1515
* .. Return values ..
16-
* REAL RESULT(6)
16+
* DOUBLE PRECISION RESULT(6)
1717
*
1818
*
1919
*> \par Purpose:
2020
* =============
2121
*>
2222
*> \verbatim
2323
*>
24-
*> CUNHR_COL01 tests CUNHR_COL using CLATSQR, CGEMQRT and CUNGTSQR.
25-
*> Therefore, CLATSQR (part of CGEQR), CGEMQRT (part CGEMQR), CUNGTSQR
24+
*> CUNHR_COL01 tests CUNGTSQR and CUNHR_COL using CLATSQR, CGEMQRT.
25+
*> Therefore, CLATSQR (part of CGEQR), CGEMQRT (part of CGEMQR)
2626
*> have to be tested before this test.
2727
*>
2828
*> \endverbatim
@@ -62,14 +62,46 @@
6262
*> \verbatim
6363
*> RESULT is REAL array, dimension (6)
6464
*> Results of each of the six tests below.
65-
*> ( C is a M-by-N random matrix, D is a N-by-M random matrix )
6665
*>
67-
*> RESULT(1) = | A - Q * R | / (eps * m * |A|)
68-
*> RESULT(2) = | I - (Q**H) * Q | / (eps * m )
69-
*> RESULT(3) = | Q * C - Q * C | / (eps * m * |C|)
70-
*> RESULT(4) = | (Q**H) * C - (Q**H) * C | / (eps * m * |C|)
71-
*> RESULT(5) = | (D * Q) - D * Q | / (eps * m * |D|)
72-
*> RESULT(6) = | D * (Q**H) - D * (Q**H) | / (eps * m * |D|)
66+
*> A is a m-by-n test input matrix to be factored.
67+
*> so that A = Q_gr * ( R )
68+
*> ( 0 ),
69+
*>
70+
*> Q_qr is an implicit m-by-m unitary Q matrix, the result
71+
*> of factorization in blocked WY-representation,
72+
*> stored in CGEQRT output format.
73+
*>
74+
*> R is a n-by-n upper-triangular matrix,
75+
*>
76+
*> 0 is a (m-n)-by-n zero matrix,
77+
*>
78+
*> Q is an explicit m-by-m unitary matrix Q = Q_gr * I
79+
*>
80+
*> C is an m-by-n random matrix,
81+
*>
82+
*> D is an n-by-m random matrix.
83+
*>
84+
*> The six tests are:
85+
*>
86+
*> RESULT(1) = |R - (Q**H) * A| / ( eps * m * |A| )
87+
*> is equivalent to test for | A - Q * R | / (eps * m * |A|),
88+
*>
89+
*> RESULT(2) = |I - (Q**H) * Q| / ( eps * m ),
90+
*>
91+
*> RESULT(3) = | Q_qr * C - Q * C | / (eps * m * |C|),
92+
*>
93+
*> RESULT(4) = | (Q_gr**H) * C - (Q**H) * C | / (eps * m * |C|)
94+
*>
95+
*> RESULT(5) = | D * Q_qr - D * Q | / (eps * m * |D|)
96+
*>
97+
*> RESULT(6) = | D * (Q_qr**H) - D * (Q**H) | / (eps * m * |D|),
98+
*>
99+
*> where:
100+
*> Q_qr * C, (Q_gr**H) * C, D * Q_qr, D * (Q_qr**H) are
101+
*> computed using CGEMQRT,
102+
*>
103+
*> Q * C, (Q**H) * C, D * Q, D * (Q**H) are
104+
*> computed using CGEMM.
73105
*> \endverbatim
74106
*
75107
* Authors:
@@ -80,18 +112,15 @@
80112
*> \author Univ. of Colorado Denver
81113
*> \author NAG Ltd.
82114
*
83-
*> \date November 2019
84-
*
85-
*> \ingroup complex16_lin
115+
*> \ingroup complex_lin
86116
*
87117
* =====================================================================
88118
SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT )
89119
IMPLICIT NONE
90120
*
91-
* -- LAPACK test routine (version 3.9.0) --
121+
* -- LAPACK test routine --
92122
* -- LAPACK is a software package provided by Univ. of Tennessee, --
93123
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94-
* November 2019
95124
*
96125
* .. Scalar Arguments ..
97126
INTEGER M, N, MB1, NB1, NB2
@@ -102,10 +131,10 @@ SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT )
102131
*
103132
* ..
104133
* .. Local allocatable arrays
105-
COMPLEX, ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:),
134+
COMPLEX , ALLOCATABLE :: A(:,:), AF(:,:), Q(:,:), R(:,:),
106135
$ WORK( : ), T1(:,:), T2(:,:), DIAG(:),
107136
$ C(:,:), CF(:,:), D(:,:), DF(:,:)
108-
REAL, ALLOCATABLE :: RWORK(:)
137+
REAL , ALLOCATABLE :: RWORK(:)
109138
*
110139
* .. Parameters ..
111140
REAL ZERO
@@ -218,7 +247,7 @@ SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT )
218247
* Copy the factor R into the array R.
219248
*
220249
SRNAMT = 'CLACPY'
221-
CALL CLACPY( 'U', M, N, AF, M, R, M )
250+
CALL CLACPY( 'U', N, N, AF, M, R, M )
222251
*
223252
* Reconstruct the orthogonal matrix Q.
224253
*
@@ -240,7 +269,7 @@ SUBROUTINE CUNHR_COL01( M, N, MB1, NB1, NB2, RESULT )
240269
* matrix S.
241270
*
242271
SRNAMT = 'CLACPY'
243-
CALL CLACPY( 'U', M, N, R, M, AF, M )
272+
CALL CLACPY( 'U', N, N, R, M, AF, M )
244273
*
245274
DO I = 1, N
246275
IF( DIAG( I ).EQ.-CONE ) THEN

0 commit comments

Comments
 (0)