From a30cd23590fdc2462946df93d21ca60b1590ec08 Mon Sep 17 00:00:00 2001 From: Dmitry Klyuchinsky Date: Mon, 8 Apr 2024 16:37:56 +0700 Subject: [PATCH] call QR/LQ factorization before QRT02/LQT02 for each value of K in KVAL --- TESTING/LIN/cchklq.f | 12 +++++++----- TESTING/LIN/cchkqr.f | 12 +++++++----- TESTING/LIN/dchklq.f | 12 +++++++----- TESTING/LIN/dchkqr.f | 12 +++++++----- TESTING/LIN/schklq.f | 12 +++++++----- TESTING/LIN/schkqr.f | 12 +++++++----- TESTING/LIN/zchklq.f | 12 +++++++----- TESTING/LIN/zchkqr.f | 12 +++++++----- 8 files changed, 56 insertions(+), 40 deletions(-) diff --git a/TESTING/LIN/cchklq.f b/TESTING/LIN/cchklq.f index 4499de36f7..dc846520ca 100644 --- a/TESTING/LIN/cchklq.f +++ b/TESTING/LIN/cchklq.f @@ -237,7 +237,7 @@ SUBROUTINE CCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, CERRLQ, CGELS, CGET02, $ CLACPY, CLARHS, CLATB4, CLATMS, CLQT01, CLQT02, - $ CLQT03, XLAENV + $ CLQT03, CGELQF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -355,16 +355,18 @@ SUBROUTINE CCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * -* Test CUNGLQ, using factorization -* returned by CLQT01 +* Test CUNGLQ +* + CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL CGELQF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL CLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test CUNMLQ, using factorization returned -* by CLQT01 +* Test CUNMLQ * CALL CLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/cchkqr.f b/TESTING/LIN/cchkqr.f index 4fa7413f98..2f08333b50 100644 --- a/TESTING/LIN/cchkqr.f +++ b/TESTING/LIN/cchkqr.f @@ -246,7 +246,7 @@ SUBROUTINE CCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, CERRQR, CGELS, CGET02, $ CLACPY, CLARHS, CLATB4, CLATMS, CQRT01, - $ CQRT01P, CQRT02, CQRT03, XLAENV + $ CQRT01P, CQRT02, CQRT03, CGEQRF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -373,16 +373,18 @@ SUBROUTINE CCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NT = NT + 1 ELSE IF( M.GE.N ) THEN * -* Test CUNGQR, using factorization -* returned by CQRT01 +* Test CUNGQR +* + CALL CLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL CGEQRF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL CQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test CUNMQR, using factorization returned -* by CQRT01 +* Test CUNMQR * CALL CQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/dchklq.f b/TESTING/LIN/dchklq.f index a207e00565..156bf87192 100644 --- a/TESTING/LIN/dchklq.f +++ b/TESTING/LIN/dchklq.f @@ -237,7 +237,7 @@ SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, DERRLQ, DGELS, DGET02, $ DLACPY, DLARHS, DLATB4, DLATMS, DLQT01, DLQT02, - $ DLQT03, XLAENV + $ DLQT03, DGELQF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -355,8 +355,11 @@ SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * -* Test DORGLQ, using factorization -* returned by DLQT01 +* Test DORGLQ +* + CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL DGELQF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL DLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) @@ -366,8 +369,7 @@ SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, END IF IF( M.GE.K ) THEN * -* Test DORMLQ, using factorization returned -* by DLQT01 +* Test DORMLQ * CALL DLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/dchkqr.f b/TESTING/LIN/dchkqr.f index 8188d7a009..6a48d7e68d 100644 --- a/TESTING/LIN/dchkqr.f +++ b/TESTING/LIN/dchkqr.f @@ -246,7 +246,7 @@ SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, DERRQR, DGELS, DGET02, $ DLACPY, DLARHS, DLATB4, DLATMS, DQRT01, - $ DQRT01P, DQRT02, DQRT03, XLAENV + $ DQRT01P, DQRT02, DQRT03, DGEQRF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -374,16 +374,18 @@ SUBROUTINE DCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NT = NT + 1 ELSE IF( M.GE.N ) THEN * -* Test DORGQR, using factorization -* returned by DQRT01 +* Test DORGQR +* + CALL DLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL DGEQRF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL DQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test DORMQR, using factorization returned -* by DQRT01 +* Test DORMQR * CALL DQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/schklq.f b/TESTING/LIN/schklq.f index 9335503f96..28671d1d6f 100644 --- a/TESTING/LIN/schklq.f +++ b/TESTING/LIN/schklq.f @@ -237,7 +237,7 @@ SUBROUTINE SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, SERRLQ, SGET02, $ SLACPY, SLARHS, SLATB4, SLATMS, SLQT01, SLQT02, - $ SLQT03, XLAENV + $ SLQT03, SGELQF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -355,16 +355,18 @@ SUBROUTINE SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * -* Test SORGLQ, using factorization -* returned by SLQT01 +* Test SORGLQ +* + CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL SGELQF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL SLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test SORMLQ, using factorization returned -* by SLQT01 +* Test SORMLQ * CALL SLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/schkqr.f b/TESTING/LIN/schkqr.f index f72c8f1eba..f91f081b05 100644 --- a/TESTING/LIN/schkqr.f +++ b/TESTING/LIN/schkqr.f @@ -246,7 +246,7 @@ SUBROUTINE SCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, SERRQR, SGELS, SGET02, $ SLACPY, SLARHS, SLATB4, SLATMS, SQRT01, - $ SQRT01P, SQRT02, SQRT03, XLAENV + $ SQRT01P, SQRT02, SQRT03, SGEQRF, XLAENV * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -373,16 +373,18 @@ SUBROUTINE SCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NT = NT + 1 ELSE IF( M.GE.N ) THEN * -* Test SORGQR, using factorization -* returned by SQRT01 +* Test SORGQR +* + CALL SLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL SGEQRF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL SQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test SORMQR, using factorization returned -* by SQRT01 +* Test SORMQR * CALL SQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/zchklq.f b/TESTING/LIN/zchklq.f index ccef7b803a..a4f31d54ee 100644 --- a/TESTING/LIN/zchklq.f +++ b/TESTING/LIN/zchklq.f @@ -237,7 +237,7 @@ SUBROUTINE ZCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRLQ, ZGELS, $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLQT01, - $ ZLQT02, ZLQT03 + $ ZLQT02, ZLQT03, ZGELQF * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -355,16 +355,18 @@ SUBROUTINE ZCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ WORK, LWORK, RWORK, RESULT( 1 ) ) ELSE IF( M.LE.N ) THEN * -* Test ZUNGLQ, using factorization -* returned by ZLQT01 +* Test ZUNGLQ +* + CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL ZGELQF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL ZLQT02( M, N, K, A, AF, AQ, AL, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test ZUNMLQ, using factorization returned -* by ZLQT01 +* Test ZUNMLQ * CALL ZLQT03( M, N, K, AF, AC, AL, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) ) diff --git a/TESTING/LIN/zchkqr.f b/TESTING/LIN/zchkqr.f index c088bacc9e..8ec6895d78 100644 --- a/TESTING/LIN/zchkqr.f +++ b/TESTING/LIN/zchkqr.f @@ -246,7 +246,7 @@ SUBROUTINE ZCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRQR, ZGELS, $ ZGET02, ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZQRT01, - $ ZQRT01P, ZQRT02, ZQRT03 + $ ZQRT01P, ZQRT02, ZQRT03, ZGEQRF * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN @@ -373,16 +373,18 @@ SUBROUTINE ZCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NT = NT + 1 ELSE IF( M.GE.N ) THEN * -* Test ZUNGQR, using factorization -* returned by ZQRT01 +* Test ZUNGQR * CALL ZQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 1 ) ) END IF IF( M.GE.K ) THEN * -* Test ZUNMQR, using factorization returned -* by ZQRT01 +* Test ZUNMQR +* + CALL ZLACPY( 'Full', M, N, A, LDA, AF, LDA ) + CALL ZGEQRF( M, N, AF, LDA, TAU, WORK, LWORK, + $ INFO ) * CALL ZQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU, $ WORK, LWORK, RWORK, RESULT( 3 ) )