Skip to content

Commit 4342764

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

File tree

4 files changed

+19
-38
lines changed

4 files changed

+19
-38
lines changed

‎lapack-netlib/SRC/cunml2.f‎

Lines changed: 6 additions & 14 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 CUNML2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunml2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cunml2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunml2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -151,11 +149,12 @@
151149
*> \author Univ. of Colorado Denver
152150
*> \author NAG Ltd.
153151
*
154-
*> \ingroup complexOTHERcomputational
152+
*> \ingroup unml2
155153
*
156154
* =====================================================================
157155
SUBROUTINE CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
158156
$ WORK, INFO )
157+
IMPLICIT NONE
159158
*
160159
* -- LAPACK computational routine --
161160
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -171,21 +170,17 @@ SUBROUTINE CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
171170
*
172171
* =====================================================================
173172
*
174-
* .. Parameters ..
175-
COMPLEX ONE
176-
PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
177-
* ..
178173
* .. Local Scalars ..
179174
LOGICAL LEFT, NOTRAN
180175
INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ
181-
COMPLEX AII, TAUI
176+
COMPLEX TAUI
182177
* ..
183178
* .. External Functions ..
184179
LOGICAL LSAME
185180
EXTERNAL LSAME
186181
* ..
187182
* .. External Subroutines ..
188-
EXTERNAL CLACGV, CLARF, XERBLA
183+
EXTERNAL CLACGV, CLARF1F, XERBLA
189184
* ..
190185
* .. Intrinsic Functions ..
191186
INTRINSIC CONJG, MAX
@@ -272,11 +267,8 @@ SUBROUTINE CUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
272267
END IF
273268
IF( I.LT.NQ )
274269
$ CALL CLACGV( NQ-I, A( I, I+1 ), LDA )
275-
AII = A( I, I )
276-
A( I, I ) = ONE
277-
CALL CLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ),
278-
$ LDC, WORK )
279-
A( I, I ) = AII
270+
CALL CLARF1F( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC,
271+
$ JC ), LDC, WORK )
280272
IF( I.LT.NQ )
281273
$ CALL CLACGV( NQ-I, A( I, I+1 ), LDA )
282274
10 CONTINUE

‎lapack-netlib/SRC/dgeql2.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 DGEQL2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeql2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgeql2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeql2.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 doubleGEcomputational
99+
*> \ingroup geql2
102100
*
103101
*> \par Further Details:
104102
* =====================
@@ -120,6 +118,7 @@
120118
*>
121119
* =====================================================================
122120
SUBROUTINE DGEQL2( 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, --
@@ -140,10 +139,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
140139
* ..
141140
* .. Local Scalars ..
142141
INTEGER I, K
143-
DOUBLE PRECISION AII
144142
* ..
145143
* .. External Subroutines ..
146-
EXTERNAL DLARF, DLARFG, XERBLA
144+
EXTERNAL DLARF1L, DLARFG, XERBLA
147145
* ..
148146
* .. Intrinsic Functions ..
149147
INTRINSIC MAX, MIN
@@ -177,11 +175,9 @@ SUBROUTINE DGEQL2( M, N, A, LDA, TAU, WORK, INFO )
177175
*
178176
* Apply H(i) to A(1:m-k+i,1:n-k+i-1) from the left
179177
*
180-
AII = A( M-K+I, N-K+I )
181-
A( M-K+I, N-K+I ) = ONE
182-
CALL DLARF( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1, TAU( I ),
178+
CALL DLARF1L( 'Left', M-K+I, N-K+I-1, A( 1, N-K+I ), 1,
179+
$ TAU( I ),
183180
$ A, LDA, WORK )
184-
A( M-K+I, N-K+I ) = AII
185181
10 CONTINUE
186182
RETURN
187183
*

‎lapack-netlib/SRC/dgerq2.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 DGERQ2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgerq2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgerq2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgerq2.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 doubleGEcomputational
99+
*> \ingroup gerq2
102100
*
103101
*> \par Further Details:
104102
* =====================
@@ -120,6 +118,7 @@
120118
*>
121119
* =====================================================================
122120
SUBROUTINE DGERQ2( 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, --
@@ -140,10 +139,9 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
140139
* ..
141140
* .. Local Scalars ..
142141
INTEGER I, K
143-
DOUBLE PRECISION AII
144142
* ..
145143
* .. External Subroutines ..
146-
EXTERNAL DLARF, DLARFG, XERBLA
144+
EXTERNAL DLARF1L, DLARFG, XERBLA
147145
* ..
148146
* .. Intrinsic Functions ..
149147
INTRINSIC MAX, MIN
@@ -177,11 +175,8 @@ SUBROUTINE DGERQ2( M, N, A, LDA, TAU, WORK, INFO )
177175
*
178176
* Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
179177
*
180-
AII = A( M-K+I, N-K+I )
181-
A( M-K+I, N-K+I ) = ONE
182-
CALL DLARF( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
178+
CALL DLARF1L( 'Right', M-K+I-1, N-K+I, A( M-K+I, 1 ), LDA,
183179
$ TAU( I ), A, LDA, WORK )
184-
A( M-K+I, N-K+I ) = AII
185180
10 CONTINUE
186181
RETURN
187182
*

‎lapack-netlib/SRC/dorgl2.f‎

Lines changed: 4 additions & 6 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 DORGL2 + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgl2.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgl2.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgl2.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -106,10 +104,11 @@
106104
*> \author Univ. of Colorado Denver
107105
*> \author NAG Ltd.
108106
*
109-
*> \ingroup doubleOTHERcomputational
107+
*> \ingroup ungl2
110108
*
111109
* =====================================================================
112110
SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
111+
IMPLICIT NONE
113112
*
114113
* -- LAPACK computational routine --
115114
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -132,7 +131,7 @@ SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
132131
INTEGER I, J, L
133132
* ..
134133
* .. External Subroutines ..
135-
EXTERNAL DLARF, DSCAL, XERBLA
134+
EXTERNAL DLARF1F, DSCAL, XERBLA
136135
* ..
137136
* .. Intrinsic Functions ..
138137
INTRINSIC MAX
@@ -180,8 +179,7 @@ SUBROUTINE DORGL2( M, N, K, A, LDA, TAU, WORK, INFO )
180179
*
181180
IF( I.LT.N ) THEN
182181
IF( I.LT.M ) THEN
183-
A( I, I ) = ONE
184-
CALL DLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
182+
CALL DLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
185183
$ TAU( I ), A( I+1, I ), LDA, WORK )
186184
END IF
187185
CALL DSCAL( N-I, -TAU( I ), A( I, I+1 ), LDA )

0 commit comments

Comments
 (0)