Skip to content

Commit 387830b

Browse files
martin-frbgmartin-frbg
authored
Implement truncated QR with pivoting (Reference-LAPACK PR 891)
1 parent 40109c0 commit 387830b

30 files changed

Lines changed: 4132 additions & 238 deletions

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

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ set(DZLNTST dlaord.f)
99
set(SLINTST schkaa.F
1010
schkeq.f schkgb.f schkge.f schkgt.f
1111
schklq.f schkpb.f schkpo.f schkps.f schkpp.f
12-
schkpt.f schkq3.f schkql.f schkqr.f schkrq.f
12+
schkpt.f schkq3.f schkqp3rk.f schkql.f schkqr.f schkrq.f
1313
schksp.f schksy.f schksy_rook.f schksy_rk.f
1414
schksy_aa.f schksy_aa_2stage.f
1515
schktb.f schktp.f schktr.f
@@ -56,7 +56,7 @@ set(CLINTST cchkaa.F
5656
cchkhe.f cchkhe_rook.f cchkhe_rk.f
5757
cchkhe_aa.f cchkhe_aa_2stage.f
5858
cchkhp.f cchklq.f cchkpb.f
59-
cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkql.f
59+
cchkpo.f cchkps.f cchkpp.f cchkpt.f cchkq3.f cchkqp3rk.f cchkql.f
6060
cchkqr.f cchkrq.f cchksp.f cchksy.f cchksy_rook.f cchksy_rk.f
6161
cchksy_aa.f cchksy_aa_2stage.f
6262
cchktb.f
@@ -110,7 +110,7 @@ endif()
110110
set(DLINTST dchkaa.F
111111
dchkeq.f dchkgb.f dchkge.f dchkgt.f
112112
dchklq.f dchkpb.f dchkpo.f dchkps.f dchkpp.f
113-
dchkpt.f dchkq3.f dchkql.f dchkqr.f dchkrq.f
113+
dchkpt.f dchkq3.f dchkqp3rk.f dchkql.f dchkqr.f dchkrq.f
114114
dchksp.f dchksy.f dchksy_rook.f dchksy_rk.f
115115
dchksy_aa.f dchksy_aa_2stage.f
116116
dchktb.f dchktp.f dchktr.f
@@ -158,7 +158,7 @@ set(ZLINTST zchkaa.F
158158
zchkhe.f zchkhe_rook.f zchkhe_rk.f
159159
zchkhe_aa.f zchkhe_aa_2stage.f
160160
zchkhp.f zchklq.f zchkpb.f
161-
zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkql.f
161+
zchkpo.f zchkps.f zchkpp.f zchkpt.f zchkq3.f zchkqp3rk.f zchkql.f
162162
zchkqr.f zchkrq.f zchksp.f zchksy.f zchksy_rook.f zchksy_rk.f
163163
zchksy_aa.f zchksy_aa_2stage.f
164164
zchktb.f
@@ -239,8 +239,7 @@ set(ZLINTSTRFP zchkrfp.f zdrvrfp.f zdrvrf1.f zdrvrf2.f zdrvrf3.f zdrvrf4.f zerrr
239239

240240
macro(add_lin_executable name)
241241
add_executable(${name} ${ARGN})
242-
target_link_libraries(${name} openblas${SUFFIX64_UNDERSCORE})
243-
#${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
242+
target_link_libraries(${name} ${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
244243
endmacro()
245244

246245
if(BUILD_SINGLE)

‎lapack-netlib/TESTING/LIN/Makefile‎

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ DZLNTST = dlaord.o
4545
SLINTST = schkaa.o \
4646
schkeq.o schkgb.o schkge.o schkgt.o \
4747
schklq.o schkpb.o schkpo.o schkps.o schkpp.o \
48-
schkpt.o schkq3.o schkql.o schkqr.o schkrq.o \
48+
schkpt.o schkq3.o schkqp3rk.o schkql.o schkqr.o schkrq.o \
4949
schksp.o schksy.o schksy_rook.o schksy_rk.o \
5050
schksy_aa.o schksy_aa_2stage.o schktb.o schktp.o schktr.o \
5151
schktz.o \
@@ -89,7 +89,7 @@ CLINTST = cchkaa.o \
8989
cchkeq.o cchkgb.o cchkge.o cchkgt.o \
9090
cchkhe.o cchkhe_rook.o cchkhe_rk.o \
9191
cchkhe_aa.o cchkhe_aa_2stage.o cchkhp.o cchklq.o cchkpb.o \
92-
cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkql.o \
92+
cchkpo.o cchkps.o cchkpp.o cchkpt.o cchkq3.o cchkqp3rk.o cchkql.o \
9393
cchkqr.o cchkrq.o cchksp.o cchksy.o cchksy_rook.o cchksy_rk.o \
9494
cchksy_aa.o cchksy_aa_2stage.o cchktb.o \
9595
cchktp.o cchktr.o cchktz.o \
@@ -137,7 +137,7 @@ endif
137137
DLINTST = dchkaa.o \
138138
dchkeq.o dchkgb.o dchkge.o dchkgt.o \
139139
dchklq.o dchkpb.o dchkpo.o dchkps.o dchkpp.o \
140-
dchkpt.o dchkq3.o dchkql.o dchkqr.o dchkrq.o \
140+
dchkpt.o dchkq3.o dchkqp3rk.o dchkql.o dchkqr.o dchkrq.o \
141141
dchksp.o dchksy.o dchksy_rook.o dchksy_rk.o \
142142
dchksy_aa.o dchksy_aa_2stage.o dchktb.o dchktp.o dchktr.o \
143143
dchktz.o \
@@ -182,7 +182,7 @@ ZLINTST = zchkaa.o \
182182
zchkeq.o zchkgb.o zchkge.o zchkgt.o \
183183
zchkhe.o zchkhe_rook.o zchkhe_rk.o zchkhe_aa.o zchkhe_aa_2stage.o \
184184
zchkhp.o zchklq.o zchkpb.o \
185-
zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkql.o \
185+
zchkpo.o zchkps.o zchkpp.o zchkpt.o zchkq3.o zchkqp3rk.o zchkql.o \
186186
zchkqr.o zchkrq.o zchksp.o zchksy.o zchksy_rook.o zchksy_rk.o \
187187
zchksy_aa.o zchksy_aa_2stage.o zchktb.o \
188188
zchktp.o zchktr.o zchktz.o \
@@ -269,35 +269,35 @@ proto-double: xlintstds xlintstrfd
269269
proto-complex: xlintstrfc
270270
proto-complex16: xlintstzc xlintstrfz
271271

272-
xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
273-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
272+
xlintsts: $(ALINTST) $(SLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
273+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
274274

275-
xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
276-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
275+
xlintstc: $(ALINTST) $(CLINTST) $(SCLNTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
276+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
277277

278-
xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
279-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
278+
xlintstd: $(ALINTST) $(DLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
279+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
280280

281-
xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
282-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
281+
xlintstz: $(ALINTST) $(ZLINTST) $(DZLNTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(XBLASLIB) $(BLASLIB)
282+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
283283

284-
xlintstds: $(DSLINTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
285-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
284+
xlintstds: $(DSLINTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
285+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
286286

287-
xlintstzc: $(ZCLINTST) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
288-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
287+
xlintstzc: $(ZCLINTST) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
288+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
289289

290-
xlintstrfs: $(SLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
291-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
290+
xlintstrfs: $(SLINTSTRFP) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
291+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
292292

293-
xlintstrfd: $(DLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
294-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
293+
xlintstrfd: $(DLINTSTRFP) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
294+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
295295

296-
xlintstrfc: $(CLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
297-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
296+
xlintstrfc: $(CLINTSTRFP) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
297+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
298298

299-
xlintstrfz: $(ZLINTSTRFP) $(TMGLIB) $(VARLIB) ../$(LAPACKLIB) $(BLASLIB)
300-
$(LOADER) $(FFLAGS) $(LDFLAGS) -o $@ $^
299+
xlintstrfz: $(ZLINTSTRFP) $(TMGLIB) $(VARLIB) $(LAPACKLIB) $(BLASLIB)
300+
$(FC) $(FFLAGS) $(LDFLAGS) -o $@ $^
301301

302302
$(ALINTST): $(FRC)
303303
$(SCLNTST): $(FRC)

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

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -797,6 +797,18 @@ SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
797797
WRITE( NOUT, FMT = 9978 )
798798
$ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT
799799
END IF
800+
*
801+
ELSE IF( LSAMEN( 2, P2, 'QK' ) ) THEN
802+
*
803+
* xQK: truncated QR factorization with pivoting
804+
*
805+
IF( LSAMEN( 7, SUBNAM( 2: 8 ), 'GEQP3RK' ) ) THEN
806+
WRITE( NOUT, FMT = 9930 )
807+
$ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, KL, N5, IMAT
808+
ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN
809+
WRITE( NOUT, FMT = 9978 )
810+
$ SUBNAM(1:LEN_TRIM( SUBNAM )), INFO, M, N, IMAT
811+
END IF
800812
*
801813
ELSE IF( LSAMEN( 2, P2, 'LQ' ) ) THEN
802814
*
@@ -1147,6 +1159,11 @@ SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
11471159
* What we do next
11481160
*
11491161
9949 FORMAT( ' ==> Doing only the condition estimate for this case' )
1162+
*
1163+
* SUBNAM, INFO, M, N, NB, IMAT
1164+
*
1165+
9930 FORMAT( ' *** Error code from ', A, '=', I5, / ' ==> M =', I5,
1166+
$ ', N =', I5, ', NX =', I5, ', NB =', I4, ', type ', I2 )
11501167
*
11511168
RETURN
11521169
*

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

Lines changed: 58 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -584,13 +584,27 @@ SUBROUTINE ALAHD( IOUNIT, PATH )
584584
*
585585
* QR decomposition with column pivoting
586586
*
587-
WRITE( IOUNIT, FMT = 9986 )PATH
587+
WRITE( IOUNIT, FMT = 8006 )PATH
588588
WRITE( IOUNIT, FMT = 9969 )
589589
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
590590
WRITE( IOUNIT, FMT = 9940 )1
591591
WRITE( IOUNIT, FMT = 9939 )2
592592
WRITE( IOUNIT, FMT = 9938 )3
593593
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
594+
*
595+
ELSE IF( LSAMEN( 2, P2, 'QK' ) ) THEN
596+
*
597+
* truncated QR decomposition with column pivoting
598+
*
599+
WRITE( IOUNIT, FMT = 8006 )PATH
600+
WRITE( IOUNIT, FMT = 9871 )
601+
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
602+
WRITE( IOUNIT, FMT = 8060 )1
603+
WRITE( IOUNIT, FMT = 8061 )2
604+
WRITE( IOUNIT, FMT = 8062 )3
605+
WRITE( IOUNIT, FMT = 8063 )4
606+
WRITE( IOUNIT, FMT = 8064 )5
607+
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
594608
*
595609
ELSE IF( LSAMEN( 2, P2, 'TZ' ) ) THEN
596610
*
@@ -779,6 +793,8 @@ SUBROUTINE ALAHD( IOUNIT, PATH )
779793
$ 'tall-skinny or short-wide matrices' )
780794
8005 FORMAT( / 1X, A3, ': Householder reconstruction from TSQR',
781795
$ ' factorization output ', /,' for tall-skinny matrices.' )
796+
8006 FORMAT( / 1X, A3, ': truncated QR factorization',
797+
$ ' with column pivoting' )
782798
*
783799
* GE matrix types
784800
*
@@ -922,6 +938,36 @@ SUBROUTINE ALAHD( IOUNIT, PATH )
922938
$ / 4X, '3. Geometric distribution', 10X,
923939
$ '6. Every second column fixed' )
924940
*
941+
* QK matrix types
942+
*
943+
9871 FORMAT( 4X, ' 1. Zero matrix', /
944+
$ 4X, ' 2. Random, Diagonal, CNDNUM = 2', /
945+
$ 4X, ' 3. Random, Upper triangular, CNDNUM = 2', /
946+
$ 4X, ' 4. Random, Lower triangular, CNDNUM = 2', /
947+
$ 4X, ' 5. Random, First column is zero, CNDNUM = 2', /
948+
$ 4X, ' 6. Random, Last MINMN column is zero, CNDNUM = 2', /
949+
$ 4X, ' 7. Random, Last N column is zero, CNDNUM = 2', /
950+
$ 4X, ' 8. Random, Middle column in MINMN is zero,',
951+
$ ' CNDNUM = 2', /
952+
$ 4X, ' 9. Random, First half of MINMN columns are zero,',
953+
$ ' CNDNUM = 2', /
954+
$ 4X, '10. Random, Last columns are zero starting from',
955+
$ ' MINMN/2+1, CNDNUM = 2', /
956+
$ 4X, '11. Random, Half MINMN columns in the middle are',
957+
$ ' zero starting from MINMN/2-(MINMN/2)/2+1,'
958+
$ ' CNDNUM = 2', /
959+
$ 4X, '12. Random, Odd columns are ZERO, CNDNUM = 2', /
960+
$ 4X, '13. Random, Even columns are ZERO, CNDNUM = 2', /
961+
$ 4X, '14. Random, CNDNUM = 2', /
962+
$ 4X, '15. Random, CNDNUM = sqrt(0.1/EPS)', /
963+
$ 4X, '16. Random, CNDNUM = 0.1/EPS', /
964+
$ 4X, '17. Random, CNDNUM = 0.1/EPS,',
965+
$ ' one small singular value S(N)=1/CNDNUM', /
966+
$ 4X, '18. Random, CNDNUM = 2, scaled near underflow,',
967+
$ ' NORM = SMALL = SAFMIN', /
968+
$ 4X, '19. Random, CNDNUM = 2, scaled near overflow,',
969+
$ ' NORM = LARGE = 1.0/( 0.25 * ( SAFMIN / EPS ) )' )
970+
*
925971
* TZ matrix types
926972
*
927973
9968 FORMAT( ' Matrix types (2-3 have condition 1/EPS):', / 4X,
@@ -1030,9 +1076,8 @@ SUBROUTINE ALAHD( IOUNIT, PATH )
10301076
$ ' * norm(C) * EPS )' )
10311077
9940 FORMAT( 3X, I2, ': norm(svd(A) - svd(R)) / ',
10321078
$ '( M * norm(svd(R)) * EPS )' )
1033-
9939 FORMAT( 3X, I2, ': norm( A*P - Q*R ) / ( M * norm(A) * EPS )'
1034-
$ )
1035-
9938 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( M * EPS )' )
1079+
9939 FORMAT( 3X, I2, ': norm( A*P - Q*R ) / ( M * norm(A) * EPS )')
1080+
9938 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( M * EPS )' )
10361081
9937 FORMAT( 3X, I2, ': norm( A - R*Q ) / ( M * norm(A) * EPS )'
10371082
$ )
10381083
9935 FORMAT( 3X, I2, ': norm( B - A * X ) / ',
@@ -1105,6 +1150,15 @@ SUBROUTINE ALAHD( IOUNIT, PATH )
11051150
8054 FORMAT(3X,I2,': norm( C*Q - C*Q ) / ( M * norm(C) * EPS )' )
11061151
8055 FORMAT(3X,I2,': norm( C*Q'' - C*Q'' ) / ( M * norm(C) * EPS )')
11071152

1153+
8060 FORMAT( 3X, I2, ': 2-norm(svd(A) - svd(R)) / ',
1154+
$ '( max(M,N) * 2-norm(svd(R)) * EPS )' )
1155+
8061 FORMAT( 3X, I2, ': 1-norm( A*P - Q*R ) / ( max(M,N) * 1-norm(A)',
1156+
$ ' * EPS )')
1157+
8062 FORMAT( 3X, I2, ': 1-norm( I - Q''*Q ) / ( M * EPS )' )
1158+
8063 FORMAT( 3X, I2, ': Returns 1.0D+100, if abs(R(K+1,K+1))',
1159+
$ ' > abs(R(K,K)), where K=1:KFACT-1' )
1160+
8064 FORMAT( 3X, I2, ': 1-norm(Q**T * B - Q**T * B ) / ( M * EPS )')
1161+
11081162
*
11091163
RETURN
11101164
*

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,12 +28,12 @@
2828
*> to evaluate the input line which requested NMATS matrix types for
2929
*> PATH. The flow of control is as follows:
3030
*>
31-
*> If NMATS = NTYPES then
31+
*> IF NMATS = NTYPES THEN
3232
*> DOTYPE(1:NTYPES) = .TRUE.
33-
*> else
33+
*> ELSE
3434
*> Read the next input line for NMATS matrix types
3535
*> Set DOTYPE(I) = .TRUE. for each valid type I
36-
*> endif
36+
*> END IF
3737
*> \endverbatim
3838
*
3939
* Arguments:

‎lapack-netlib/TESTING/LIN/cchkaa.F‎

Lines changed: 32 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@
6969
*> CLQ 8 List types on next line if 0 < NTYPES < 8
7070
*> CQL 8 List types on next line if 0 < NTYPES < 8
7171
*> CQP 6 List types on next line if 0 < NTYPES < 6
72+
*> ZQK 19 List types on next line if 0 < NTYPES < 19
7273
*> CTZ 3 List types on next line if 0 < NTYPES < 3
7374
*> CLS 6 List types on next line if 0 < NTYPES < 6
7475
*> CEQ
@@ -153,12 +154,11 @@ PROGRAM CCHKAA
153154
$ NBVAL( MAXIN ), NBVAL2( MAXIN ),
154155
$ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
155156
$ RANKVAL( MAXIN ), PIV( NMAX )
156-
REAL S( 2*NMAX )
157-
COMPLEX E( NMAX )
158157
* ..
159158
* .. Allocatable Arrays ..
160159
INTEGER AllocateStatus
161-
REAL, DIMENSION(:), ALLOCATABLE :: RWORK
160+
REAL, DIMENSION(:), ALLOCATABLE :: RWORK, S
161+
COMPLEX, DIMENSION(:), ALLOCATABLE :: E
162162
COMPLEX, DIMENSION(:,:), ALLOCATABLE :: A, B, WORK
163163
* ..
164164
* .. External Functions ..
@@ -170,14 +170,14 @@ PROGRAM CCHKAA
170170
EXTERNAL ALAREQ, CCHKEQ, CCHKGB, CCHKGE, CCHKGT, CCHKHE,
171171
$ CCHKHE_ROOK, CCHKHE_RK, CCHKHE_AA, CCHKHP,
172172
$ CCHKLQ, CCHKUNHR_COL, CCHKPB, CCHKPO, CCHKPS,
173-
$ CCHKPP, CCHKPT, CCHKQ3, CCHKQL, CCHKQR, CCHKRQ,
174-
$ CCHKSP, CCHKSY, CCHKSY_ROOK, CCHKSY_RK,
175-
$ CCHKSY_AA, CCHKTB, CCHKTP, CCHKTR, CCHKTZ,
176-
$ CDRVGB, CDRVGE, CDRVGT, CDRVHE, CDRVHE_ROOK,
177-
$ CDRVHE_RK, CDRVHE_AA, CDRVHP, CDRVLS, CDRVPB,
178-
$ CDRVPO, CDRVPP, CDRVPT, CDRVSP, CDRVSY,
179-
$ CDRVSY_ROOK, CDRVSY_RK, CDRVSY_AA, ILAVER,
180-
$ CCHKQRT, CCHKQRTP
173+
$ CCHKPP, CCHKPT, CCHKQ3, CCHKQP3RK, CCHKQL,
174+
$ CCHKQR, CCHKRQ, CCHKSP, CCHKSY, CCHKSY_ROOK,
175+
$ CCHKSY_RK, CCHKSY_AA, CCHKTB, CCHKTP, CCHKTR,
176+
$ CCHKTZ, CDRVGB, CDRVGE, CDRVGT, CDRVHE,
177+
$ CDRVHE_ROOK, CDRVHE_RK, CDRVHE_AA, CDRVHP,
178+
$ CDRVLS, CDRVPB, CDRVPO, CDRVPP, CDRVPT, CDRVSP,
179+
$ CDRVSY, CDRVSY_ROOK, CDRVSY_RK, CDRVSY_AA,
180+
$ ILAVER, CCHKQRT, CCHKQRTP
181181
* ..
182182
* .. Scalars in Common ..
183183
LOGICAL LERR, OK
@@ -203,6 +203,10 @@ PROGRAM CCHKAA
203203
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
204204
ALLOCATE ( WORK( NMAX, NMAX+MAXRHS+10 ), STAT = AllocateStatus )
205205
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
206+
ALLOCATE ( E( NMAX ), STAT = AllocateStatus )
207+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
208+
ALLOCATE ( S( 2*NMAX ), STAT = AllocateStatus)
209+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
206210
ALLOCATE ( RWORK( 150*NMAX+2*MAXRHS ), STAT = AllocateStatus )
207211
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
208212
* ..
@@ -1109,6 +1113,23 @@ PROGRAM CCHKAA
11091113
ELSE
11101114
WRITE( NOUT, FMT = 9989 )PATH
11111115
END IF
1116+
*
1117+
ELSE IF( LSAMEN( 2, C2, 'QK' ) ) THEN
1118+
*
1119+
* QK: truncated QR factorization with pivoting
1120+
*
1121+
NTYPES = 19
1122+
CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
1123+
*
1124+
IF( TSTCHK ) THEN
1125+
CALL CCHKQP3RK( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL,
1126+
$ NNB, NBVAL, NXVAL, THRESH, A( 1, 1 ),
1127+
$ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ),
1128+
$ S( 1 ), B( 1, 4 ),
1129+
$ WORK, RWORK, IWORK, NOUT )
1130+
ELSE
1131+
WRITE( NOUT, FMT = 9989 )PATH
1132+
END IF
11121133
*
11131134
ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN
11141135
*

0 commit comments

Comments
 (0)