Skip to content

Commit 5cb90cb

Browse files
martin-frbgmartin-frbg
authored
Add S/CLARF1F and S/CLARF1L and use in ?ORM2R (Reference-LAPACK PR 1011)
1 parent 1bd52da commit 5cb90cb

56 files changed

Lines changed: 1757 additions & 970 deletions

Some content is hidden

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

‎lapack-netlib/SRC/Makefile‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -155,7 +155,7 @@ SLASRC_O = \
155155
slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o \
156156
slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o \
157157
slarf.o slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o slargv.o \
158-
slarrv.o slartv.o \
158+
slarf1f.o slarf1l.o slarrv.o slartv.o \
159159
slarz.o slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o \
160160
slasyf_rk.o \
161161
slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrz.o \
@@ -271,6 +271,7 @@ CLASRC_O = \
271271
claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \
272272
claqz0.o claqz1.o claqz2.o claqz3.o \
273273
clarf.o clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \
274+
clarf1f.o clarf1l.o \
274275
clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \
275276
clarz.o clarzb.o clarzt.o clascl.o claset.o clasr.o classq.o \
276277
claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \
@@ -364,7 +365,7 @@ DLASRC_O = \
364365
dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \
365366
dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \
366367
dlarf.o dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \
367-
dlargv.o dlarrv.o dlartv.o \
368+
dlarf1f.o dlarf1l.o dlargv.o dlarrv.o dlartv.o \
368369
dlarz.o dlarzb.o dlarzt.o dlaswp.o dlasy2.o \
369370
dlasyf.o dlasyf_rook.o dlasyf_rk.o \
370371
dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrz.o dlauu2.o \
@@ -478,7 +479,7 @@ ZLASRC_O = \
478479
zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \
479480
zlaqz0.o zlaqz1.o zlaqz2.o zlaqz3.o \
480481
zlarcm.o zlarf.o zlarfb.o zlarfb_gett.o \
481-
zlarfg.o zlarft.o zlarfgp.o \
482+
zlarfg.o zlarft.o zlarfgp.o zlarf1f.o zlarf1l.o \
482483
zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \
483484
zlarz.o zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \
484485
zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o zlasyf_rk.o zlasyf_aa.o \

‎lapack-netlib/SRC/cgebd2.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 CGEBD2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebd2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgebd2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebd2.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 complexGEcomputational
133+
*> \ingroup gebd2
136134
* @precisions normal c -> s d z
137135
*
138136
*> \par Further Details:
@@ -187,6 +185,7 @@
187185
*>
188186
* =====================================================================
189187
SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
188+
IMPLICIT NONE
190189
*
191190
* -- LAPACK computational routine --
192191
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -203,16 +202,15 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
203202
* =====================================================================
204203
*
205204
* .. Parameters ..
206-
COMPLEX ZERO, ONE
207-
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ),
208-
$ ONE = ( 1.0E+0, 0.0E+0 ) )
205+
COMPLEX ZERO
206+
PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) )
209207
* ..
210208
* .. Local Scalars ..
211209
INTEGER I
212210
COMPLEX ALPHA
213211
* ..
214212
* .. External Subroutines ..
215-
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
213+
EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA
216214
* ..
217215
* .. Intrinsic Functions ..
218216
INTRINSIC CONJG, MAX, MIN
@@ -246,13 +244,13 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
246244
CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
247245
$ TAUQ( I ) )
248246
D( I ) = REAL( ALPHA )
249-
A( I, I ) = ONE
250247
*
251248
* Apply H(i)**H to A(i:m,i+1:n) from the left
252249
*
253250
IF( I.LT.N )
254-
$ CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
255-
$ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
251+
$ CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
252+
$ CONJG( TAUQ( I ) ), A( I, I+1 ), LDA,
253+
$ WORK )
256254
A( I, I ) = D( I )
257255
*
258256
IF( I.LT.N ) THEN
@@ -265,12 +263,11 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
265263
CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ),
266264
$ LDA, TAUP( I ) )
267265
E( I ) = REAL( ALPHA )
268-
A( I, I+1 ) = ONE
269266
*
270267
* Apply G(i) to A(i+1:m,i+1:n) from the right
271268
*
272-
CALL CLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
273-
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
269+
CALL CLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
270+
$ TAUP( I ), A( I+1, I+1 ), LDA, WORK )
274271
CALL CLACGV( N-I, A( I, I+1 ), LDA )
275272
A( I, I+1 ) = E( I )
276273
ELSE
@@ -290,13 +287,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
290287
CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
291288
$ TAUP( I ) )
292289
D( I ) = REAL( ALPHA )
293-
A( I, I ) = ONE
294290
*
295291
* Apply G(i) to A(i+1:m,i:n) from the right
296292
*
297293
IF( I.LT.M )
298-
$ CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
299-
$ TAUP( I ), A( I+1, I ), LDA, WORK )
294+
$ CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
295+
$ TAUP( I ), A( I+1, I ), LDA, WORK )
300296
CALL CLACGV( N-I+1, A( I, I ), LDA )
301297
A( I, I ) = D( I )
302298
*
@@ -309,13 +305,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
309305
CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
310306
$ TAUQ( I ) )
311307
E( I ) = REAL( ALPHA )
312-
A( I+1, I ) = ONE
313308
*
314309
* Apply H(i)**H to A(i+1:m,i+1:n) from the left
315310
*
316-
CALL CLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
317-
$ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
318-
$ WORK )
311+
CALL CLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
312+
$ CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
313+
$ WORK )
319314
A( I+1, I ) = E( I )
320315
ELSE
321316
TAUQ( I ) = ZERO

‎lapack-netlib/SRC/cgehd2.f‎

Lines changed: 9 additions & 17 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 CGEHD2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgehd2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgehd2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgehd2.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 complexGEcomputational
107+
*> \ingroup gehd2
110108
*
111109
*> \par Further Details:
112110
* =====================
@@ -146,6 +144,7 @@
146144
*>
147145
* =====================================================================
148146
SUBROUTINE CGEHD2( 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, --
@@ -160,16 +159,11 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
160159
*
161160
* =====================================================================
162161
*
163-
* .. Parameters ..
164-
COMPLEX ONE
165-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
166-
* ..
167162
* .. Local Scalars ..
168163
INTEGER I
169-
COMPLEX ALPHA
170164
* ..
171165
* .. External Subroutines ..
172-
EXTERNAL CLARF, CLARFG, XERBLA
166+
EXTERNAL CLARF1F, CLARFG, XERBLA
173167
* ..
174168
* .. Intrinsic Functions ..
175169
INTRINSIC CONJG, MAX, MIN
@@ -197,21 +191,19 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
197191
*
198192
* Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
199193
*
200-
ALPHA = A( I+1, I )
201-
CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) )
202-
A( I+1, I ) = ONE
194+
CALL CLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
195+
$ TAU( I ) )
203196
*
204197
* Apply H(i) to A(1:ihi,i+1:ihi) from the right
205198
*
206-
CALL CLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
207-
$ A( 1, I+1 ), LDA, WORK )
199+
CALL CLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
200+
$ A( 1, I+1 ), LDA, WORK )
208201
*
209202
* Apply H(i)**H to A(i+1:ihi,i+1:n) from the left
210203
*
211-
CALL CLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
212-
$ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
204+
CALL CLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1,
205+
$ CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
213206
*
214-
A( I+1, I ) = ALPHA
215207
10 CONTINUE
216208
*
217209
RETURN

‎lapack-netlib/SRC/cgelq2.f‎

Lines changed: 6 additions & 15 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 CGELQ2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgelq2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgelq2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgelq2.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 complexGEcomputational
105+
*> \ingroup gelq2
108106
*
109107
*> \par Further Details:
110108
* =====================
@@ -126,6 +124,7 @@
126124
*>
127125
* =====================================================================
128126
SUBROUTINE CGELQ2( 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, --
@@ -140,16 +139,11 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
140139
*
141140
* =====================================================================
142141
*
143-
* .. Parameters ..
144-
COMPLEX ONE
145-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
146-
* ..
147142
* .. Local Scalars ..
148143
INTEGER I, K
149-
COMPLEX ALPHA
150144
* ..
151145
* .. External Subroutines ..
152-
EXTERNAL CLACGV, CLARF, CLARFG, XERBLA
146+
EXTERNAL CLACGV, CLARF1F, CLARFG, XERBLA
153147
* ..
154148
* .. Intrinsic Functions ..
155149
INTRINSIC MAX, MIN
@@ -178,18 +172,15 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
178172
* Generate elementary reflector H(i) to annihilate A(i,i+1:n)
179173
*
180174
CALL CLACGV( N-I+1, A( I, I ), LDA )
181-
ALPHA = A( I, I )
182-
CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
175+
CALL CLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
183176
$ TAU( I ) )
184177
IF( I.LT.M ) THEN
185178
*
186179
* Apply H(i) to A(i+1:m,i:n) from the right
187180
*
188-
A( I, I ) = ONE
189-
CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
190-
$ A( I+1, I ), LDA, WORK )
181+
CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
182+
$ TAU( I ), A( I+1, I ), LDA, WORK )
191183
END IF
192-
A( I, I ) = ALPHA
193184
CALL CLACGV( N-I+1, A( I, I ), LDA )
194185
10 CONTINUE
195186
RETURN

‎lapack-netlib/SRC/cgeql2.f‎

Lines changed: 7 additions & 15 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 CGEQL2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeql2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgeql2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeql2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -98,7 +96,7 @@
9896
*> \author Univ. of Colorado Denver
9997
*> \author NAG Ltd.
10098
*
101-
*> \ingroup complexGEcomputational
99+
*> \ingroup geql2
102100
*
103101
*> \par Further Details:
104102
* =====================
@@ -120,6 +118,7 @@
120118
*>
121119
* =====================================================================
122120
SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO )
121+
IMPLICIT NONE
123122
*
124123
* -- LAPACK computational routine --
125124
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -134,16 +133,11 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO )
134133
*
135134
* =====================================================================
136135
*
137-
* .. Parameters ..
138-
COMPLEX ONE
139-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
140-
* ..
141136
* .. Local Scalars ..
142137
INTEGER I, K
143-
COMPLEX ALPHA
144138
* ..
145139
* .. External Subroutines ..
146-
EXTERNAL CLARF, CLARFG, XERBLA
140+
EXTERNAL CLARF1L, CLARFG, XERBLA
147141
* ..
148142
* .. Intrinsic Functions ..
149143
INTRINSIC CONJG, MAX, MIN
@@ -172,15 +166,13 @@ SUBROUTINE CGEQL2( M, N, A, LDA, TAU, WORK, INFO )
172166
* Generate elementary reflector H(i) to annihilate
173167
* A(1:m-k+i-1,n-k+i)
174168
*
175-
ALPHA = A( M-K+I, N-K+I )
176-
CALL CLARFG( M-K+I, ALPHA, A( 1, N-K+I ), 1, TAU( I ) )
169+
CALL CLARFG( M-K+I, A( M-K+I, N-K+I ), A( 1, N-K+I ), 1,
170+
$ TAU( I ) )
177171
*
178172
* Apply H(i)**H to A(1:m-k+i,1:n-k+i-1) from the left
179173
*
180-
A( M-K+I, N-K+I ) = ONE
181-
CALL CLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
182-
$ CONJG( TAU( I ) ), A, LDA, WORK )
183-
A( M-K+I, N-K+I ) = ALPHA
174+
CALL CLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
175+
$ CONJG( TAU( I ) ), A, LDA, WORK )
184176
10 CONTINUE
185177
RETURN
186178
*

0 commit comments

Comments
 (0)