Skip to content

Commit d9bb8f3

Browse files
martin-frbgmartin-frbg
authored
Implement ?LARF1F and ?ORM2R (Reference-LAPACK PRs 1019/1020/1196)
1 parent f5f789f commit d9bb8f3

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

51 files changed

+1778
-766
lines changed

‎lapack-netlib/SRC/dgebd2.f‎

Lines changed: 15 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DGEBD2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebd2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebd2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebd2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -132,7 +130,7 @@
132130
*> \author Univ. of Colorado Denver
133131
*> \author NAG Ltd.
134132
*
135-
*> \ingroup doubleGEcomputational
133+
*> \ingroup gebd2
136134
*
137135
*> \par Further Details:
138136
* =====================
@@ -186,6 +184,7 @@
186184
*>
187185
* =====================================================================
188186
SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
187+
IMPLICIT NONE
189188
*
190189
* -- LAPACK computational routine --
191190
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -202,14 +201,14 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
202201
* =====================================================================
203202
*
204203
* .. Parameters ..
205-
DOUBLE PRECISION ZERO, ONE
206-
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
204+
DOUBLE PRECISION ZERO
205+
PARAMETER ( ZERO = 0.0D+0 )
207206
* ..
208207
* .. Local Scalars ..
209208
INTEGER I
210209
* ..
211210
* .. External Subroutines ..
212-
EXTERNAL DLARF, DLARFG, XERBLA
211+
EXTERNAL DLARF1F, DLARFG, XERBLA
213212
* ..
214213
* .. Intrinsic Functions ..
215214
INTRINSIC MAX, MIN
@@ -242,14 +241,13 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
242241
CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
243242
$ TAUQ( I ) )
244243
D( I ) = A( I, I )
245-
A( I, I ) = ONE
246244
*
247245
* Apply H(i) to A(i:m,i+1:n) from the left
248246
*
249247
IF( I.LT.N )
250-
$ CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAUQ( I ),
248+
$ CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
249+
$ TAUQ( I ),
251250
$ A( I, I+1 ), LDA, WORK )
252-
A( I, I ) = D( I )
253251
*
254252
IF( I.LT.N ) THEN
255253
*
@@ -259,13 +257,11 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
259257
CALL DLARFG( N-I, A( I, I+1 ), A( I, MIN( I+2, N ) ),
260258
$ LDA, TAUP( I ) )
261259
E( I ) = A( I, I+1 )
262-
A( I, I+1 ) = ONE
263260
*
264261
* Apply G(i) to A(i+1:m,i+1:n) from the right
265262
*
266-
CALL DLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
263+
CALL DLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
267264
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
268-
A( I, I+1 ) = E( I )
269265
ELSE
270266
TAUP( I ) = ZERO
271267
END IF
@@ -278,33 +274,32 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
278274
*
279275
* Generate elementary reflector G(i) to annihilate A(i,i+1:n)
280276
*
281-
CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
277+
CALL DLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ),
278+
$ LDA,
282279
$ TAUP( I ) )
283280
D( I ) = A( I, I )
284-
A( I, I ) = ONE
285281
*
286282
* Apply G(i) to A(i+1:m,i:n) from the right
287283
*
288284
IF( I.LT.M )
289-
$ CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
285+
$ CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
290286
$ TAUP( I ), A( I+1, I ), LDA, WORK )
291-
A( I, I ) = D( I )
292287
*
293288
IF( I.LT.M ) THEN
294289
*
295290
* Generate elementary reflector H(i) to annihilate
296291
* A(i+2:m,i)
297292
*
298-
CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ), 1,
293+
CALL DLARFG( M-I, A( I+1, I ), A( MIN( I+2, M ), I ),
294+
$ 1,
299295
$ TAUQ( I ) )
300296
E( I ) = A( I+1, I )
301-
A( I+1, I ) = ONE
302297
*
303298
* Apply H(i) to A(i+1:m,i+1:n) from the left
304299
*
305-
CALL DLARF( 'Left', M-I, N-I, A( I+1, I ), 1, TAUQ( I ),
300+
CALL DLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
301+
$ TAUQ( I ),
306302
$ A( I+1, I+1 ), LDA, WORK )
307-
A( I+1, I ) = E( I )
308303
ELSE
309304
TAUQ( I ) = ZERO
310305
END IF

‎lapack-netlib/SRC/dgehd2.f‎

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DGEHD2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgehd2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgehd2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgehd2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -106,7 +104,7 @@
106104
*> \author Univ. of Colorado Denver
107105
*> \author NAG Ltd.
108106
*
109-
*> \ingroup doubleGEcomputational
107+
*> \ingroup gehd2
110108
*
111109
*> \par Further Details:
112110
* =====================
@@ -146,6 +144,7 @@
146144
*>
147145
* =====================================================================
148146
SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
147+
IMPLICIT NONE
149148
*
150149
* -- LAPACK computational routine --
151150
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -166,10 +165,9 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
166165
* ..
167166
* .. Local Scalars ..
168167
INTEGER I
169-
DOUBLE PRECISION AII
170168
* ..
171169
* .. External Subroutines ..
172-
EXTERNAL DLARF, DLARFG, XERBLA
170+
EXTERNAL DLARF1F, DLARFG, XERBLA
173171
* ..
174172
* .. Intrinsic Functions ..
175173
INTRINSIC MAX, MIN
@@ -199,20 +197,17 @@ SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
199197
*
200198
CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
201199
$ TAU( I ) )
202-
AII = A( I+1, I )
203-
A( I+1, I ) = ONE
204200
*
205201
* Apply H(i) to A(1:ihi,i+1:ihi) from the right
206202
*
207-
CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
203+
CALL DLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
208204
$ A( 1, I+1 ), LDA, WORK )
209205
*
210206
* Apply H(i) to A(i+1:ihi,i+1:n) from the left
211207
*
212-
CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
208+
CALL DLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
213209
$ A( I+1, I+1 ), LDA, WORK )
214210
*
215-
A( I+1, I ) = AII
216211
10 CONTINUE
217212
*
218213
RETURN

‎lapack-netlib/SRC/dgelq2.f‎

Lines changed: 5 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DGELQ2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelq2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelq2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelq2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -104,7 +102,7 @@
104102
*> \author Univ. of Colorado Denver
105103
*> \author NAG Ltd.
106104
*
107-
*> \ingroup doubleGEcomputational
105+
*> \ingroup gelq2
108106
*
109107
*> \par Further Details:
110108
* =====================
@@ -126,6 +124,7 @@
126124
*>
127125
* =====================================================================
128126
SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
127+
IMPLICIT NONE
129128
*
130129
* -- LAPACK computational routine --
131130
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -146,10 +145,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
146145
* ..
147146
* .. Local Scalars ..
148147
INTEGER I, K
149-
DOUBLE PRECISION AII
150148
* ..
151149
* .. External Subroutines ..
152-
EXTERNAL DLARF, DLARFG, XERBLA
150+
EXTERNAL DLARF1F, DLARFG, XERBLA
153151
* ..
154152
* .. Intrinsic Functions ..
155153
INTRINSIC MAX, MIN
@@ -183,11 +181,9 @@ SUBROUTINE DGELQ2( M, N, A, LDA, TAU, WORK, INFO )
183181
*
184182
* Apply H(i) to A(i+1:m,i:n) from the right
185183
*
186-
AII = A( I, I )
187-
A( I, I ) = ONE
188-
CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
184+
CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
185+
$ TAU( I ),
189186
$ A( I+1, I ), LDA, WORK )
190-
A( I, I ) = AII
191187
END IF
192188
10 CONTINUE
193189
RETURN

‎lapack-netlib/SRC/dgeqp3rk.f‎

Lines changed: 4 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DGEQP3RK + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqp3rk.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqp3rk.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqp3rk.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -546,27 +544,19 @@
546544
*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
547545
*> A BLAS-3 version of the QR factorization with column pivoting.
548546
*> LAPACK Working Note 114
549-
*> \htmlonly
550547
*> <a href="https://www.netlib.org/lapack/lawnspdf/lawn114.pdf">https://www.netlib.org/lapack/lawnspdf/lawn114.pdf</a>
551-
*> \endhtmlonly
552548
*> and in
553549
*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
554-
*> \htmlonly
555550
*> <a href="https://doi.org/10.1137/S1064827595296732">https://doi.org/10.1137/S1064827595296732</a>
556-
*> \endhtmlonly
557551
*>
558552
*> [2] A partial column norm updating strategy developed in 2006.
559553
*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
560554
*> On the failure of rank revealing QR factorization software – a case study.
561555
*> LAPACK Working Note 176.
562-
*> \htmlonly
563556
*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">http://www.netlib.org/lapack/lawnspdf/lawn176.pdf</a>
564-
*> \endhtmlonly
565557
*> and in
566558
*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
567-
*> \htmlonly
568559
*> <a href="https://doi.org/10.1145/1377612.1377616">https://doi.org/10.1145/1377612.1377616</a>
569-
*> \endhtmlonly
570560
*
571561
*> \par Contributors:
572562
* ==================
@@ -670,7 +660,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
670660
* 1) DGEQP3RK and DLAQP2RK: 2*N to store full and partial
671661
* column 2-norms.
672662
* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
673-
* in DLARF subroutine inside DLAQP2RK to apply an
663+
* in DLARF1F subroutine inside DLAQP2RK to apply an
674664
* elementary reflector from the left.
675665
* TOTAL_WORK_SIZE = 3*N + NRHS - 1
676666
*
@@ -686,7 +676,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
686676
* 1) DGEQP3RK, DLAQP2RK, DLAQP3RK: 2*N to store full and
687677
* partial column 2-norms.
688678
* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
689-
* in DLARF subroutine to apply an elementary reflector
679+
* in DLARF1F subroutine to apply an elementary reflector
690680
* from the left.
691681
* 3) DLAQP3RK: NB*(N+NRHS) to use in the work array F that
692682
* is used to apply a block reflector from
@@ -886,7 +876,8 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
886876
* Determine when to cross over from blocked to unblocked code.
887877
* (for N less than NX, unblocked code should be used).
888878
*
889-
NX = MAX( 0, ILAENV( IXOVER, 'DGEQP3RK', ' ', M, N, -1, -1 ))
879+
NX = MAX( 0, ILAENV( IXOVER, 'DGEQP3RK', ' ', M, N, -1,
880+
$ -1 ))
890881
*
891882
IF( NX.LT.MINMN ) THEN
892883
*

‎lapack-netlib/SRC/dgeqr2.f‎

Lines changed: 4 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DGEQR2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqr2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeqr2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqr2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -105,7 +103,7 @@
105103
*> \author Univ. of Colorado Denver
106104
*> \author NAG Ltd.
107105
*
108-
*> \ingroup doubleGEcomputational
106+
*> \ingroup geqr2
109107
*
110108
*> \par Further Details:
111109
* =====================
@@ -127,6 +125,7 @@
127125
*>
128126
* =====================================================================
129127
SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
128+
IMPLICIT NONE
130129
*
131130
* -- LAPACK computational routine --
132131
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -147,10 +146,9 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
147146
* ..
148147
* .. Local Scalars ..
149148
INTEGER I, K
150-
DOUBLE PRECISION AII
151149
* ..
152150
* .. External Subroutines ..
153-
EXTERNAL DLARF, DLARFG, XERBLA
151+
EXTERNAL DLARF1F, DLARFG, XERBLA
154152
* ..
155153
* .. Intrinsic Functions ..
156154
INTRINSIC MAX, MIN
@@ -184,11 +182,8 @@ SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO )
184182
*
185183
* Apply H(i) to A(i:m,i+1:n) from the left
186184
*
187-
AII = A( I, I )
188-
A( I, I ) = ONE
189-
CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
185+
CALL DLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
190186
$ A( I, I+1 ), LDA, WORK )
191-
A( I, I ) = AII
192187
END IF
193188
10 CONTINUE
194189
RETURN

0 commit comments

Comments
 (0)