Skip to content

Commit 35d6a7b

Browse files
jprhynejprhyne
committed
updating documentation, using xLARF1y where applicable, and removing some extraneous variables
1 parent d219017 commit 35d6a7b

22 files changed

+74
-82
lines changed

‎SRC/dgebd2.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -202,8 +202,8 @@ SUBROUTINE DGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
202202
* =====================================================================
203203
*
204204
* .. Parameters ..
205-
DOUBLE PRECISION ZERO, ONE
206-
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
205+
DOUBLE PRECISION ZERO
206+
PARAMETER ( ZERO = 0.0D+0 )
207207
* ..
208208
* .. Local Scalars ..
209209
INTEGER I

‎SRC/dgeqp3rk.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -670,7 +670,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
670670
* 1) DGEQP3RK and DLAQP2RK: 2*N to store full and partial
671671
* column 2-norms.
672672
* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
673-
* in DLARF subroutine inside DLAQP2RK to apply an
673+
* in DLARF1F subroutine inside DLAQP2RK to apply an
674674
* elementary reflector from the left.
675675
* TOTAL_WORK_SIZE = 3*N + NRHS - 1
676676
*
@@ -686,7 +686,7 @@ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
686686
* 1) DGEQP3RK, DLAQP2RK, DLAQP3RK: 2*N to store full and
687687
* partial column 2-norms.
688688
* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
689-
* in DLARF subroutine to apply an elementary reflector
689+
* in DLARF1F subroutine to apply an elementary reflector
690690
* from the left.
691691
* 3) DLAQP3RK: NB*(N+NRHS) to use in the work array F that
692692
* is used to apply a block reflector from

‎SRC/dlaqp2rk.f‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -253,7 +253,7 @@
253253
*> \param[out] WORK
254254
*> \verbatim
255255
*> WORK is DOUBLE PRECISION array, dimension (N-1)
256-
*> Used in DLARF subroutine to apply an elementary
256+
*> Used in DLARF1F subroutine to apply an elementary
257257
*> reflector from the left.
258258
*> \endverbatim
259259
*>
@@ -370,7 +370,7 @@ SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
370370
DOUBLE PRECISION HUGEVAL, TEMP, TEMP2, TOL3Z
371371
* ..
372372
* .. External Subroutines ..
373-
EXTERNAL DLARF, DLARFG, DSWAP
373+
EXTERNAL DLARF1F, DLARFG, DSWAP
374374
* ..
375375
* .. Intrinsic Functions ..
376376
INTRINSIC ABS, MAX, MIN, SQRT

‎SRC/dlarf1f.f‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,12 @@
77
* http://www.netlib.org/lapack/explore-html/
88
*
99
*> \htmlonly
10-
*> Download DLARF + dependencies
11-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
10+
*> Download DLARF1F + dependencies
11+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf1f.f">
1212
*> [TGZ]</a>
13-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
13+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf1f.f">
1414
*> [ZIP]</a>
15-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
15+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf1f.f">
1616
*> [TXT]</a>
1717
*> \endhtmlonly
1818
*
@@ -180,7 +180,7 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
180180
* ..
181181
* .. Local Scalars ..
182182
LOGICAL APPLYLEFT
183-
INTEGER I, LASTV, LASTC, J
183+
INTEGER I, LASTV, LASTC
184184
* ..
185185
* .. External Subroutines ..
186186
EXTERNAL DGEMV, DGER
@@ -283,6 +283,6 @@ SUBROUTINE DLARF1F( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
283283
END IF
284284
RETURN
285285
*
286-
* End of DLARF
286+
* End of DLARF1F
287287
*
288288
END

‎SRC/dlarf1l.f‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -9,11 +9,11 @@
99
*
1010
*> \htmlonly
1111
*> Download DLARF + dependencies
12-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
12+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf1l.f">
1313
*> [TGZ]</a>
14-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
14+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf1l.f">
1515
*> [ZIP]</a>
16-
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
16+
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf1l.f">
1717
*> [TXT]</a>
1818
*> \endhtmlonly
1919
*
@@ -250,6 +250,6 @@ SUBROUTINE DLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
250250
END IF
251251
RETURN
252252
*
253-
* End of DLARF
253+
* End of DLARF1L
254254
*
255255
END

‎SRC/dormqr.f‎

Lines changed: 40 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -272,68 +272,68 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
272272
END IF
273273
END IF
274274
*
275-
* IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
275+
IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
276276
*
277277
* Use unblocked code
278278
*
279279
CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
280280
$ WORK,
281281
$ IINFO )
282-
* ELSE
282+
ELSE
283283
*
284284
* Use blocked code
285285
*
286-
! IWT = 1 + NW*NB
287-
! IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
288-
! $ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
289-
! I1 = 1
290-
! I2 = K
291-
! I3 = NB
292-
! ELSE
293-
! I1 = ( ( K-1 ) / NB )*NB + 1
294-
! I2 = 1
295-
! I3 = -NB
296-
! END IF
297-
*
298-
! IF( LEFT ) THEN
299-
! NI = N
300-
! JC = 1
301-
! ELSE
302-
! MI = M
303-
! IC = 1
304-
! END IF
305-
*
306-
! DO 10 I = I1, I2, I3
307-
! IB = MIN( NB, K-I+1 )
286+
IWT = 1 + NW*NB
287+
IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
288+
$ ( .NOT.LEFT .AND. NOTRAN ) ) THEN
289+
I1 = 1
290+
I2 = K
291+
I3 = NB
292+
ELSE
293+
I1 = ( ( K-1 ) / NB )*NB + 1
294+
I2 = 1
295+
I3 = -NB
296+
END IF
297+
*
298+
IF( LEFT ) THEN
299+
NI = N
300+
JC = 1
301+
ELSE
302+
MI = M
303+
IC = 1
304+
END IF
305+
*
306+
DO 10 I = I1, I2, I3
307+
IB = MIN( NB, K-I+1 )
308308
*
309309
* Form the triangular factor of the block reflector
310310
* H = H(i) H(i+1) . . . H(i+ib-1)
311311
*
312-
! CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I,
313-
! $ I ),
314-
! $ LDA, TAU( I ), WORK( IWT ), LDT )
315-
! IF( LEFT ) THEN
312+
CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I,
313+
$ I ),
314+
$ LDA, TAU( I ), WORK( IWT ), LDT )
315+
IF( LEFT ) THEN
316316
*
317317
* H or H**T is applied to C(i:m,1:n)
318318
*
319-
! MI = M - I + 1
320-
! IC = I
321-
! ELSE
319+
MI = M - I + 1
320+
IC = I
321+
ELSE
322322
*
323323
* H or H**T is applied to C(1:m,i:n)
324324
*
325-
! NI = N - I + 1
326-
! JC = I
327-
! END IF
325+
NI = N - I + 1
326+
JC = I
327+
END IF
328328
*
329329
* Apply H or H**T
330330
*
331-
! CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI,
332-
! $ NI,
333-
! $ IB, A( I, I ), LDA, WORK( IWT ), LDT,
334-
! $ C( IC, JC ), LDC, WORK, LDWORK )
335-
! 10 CONTINUE
336-
! END IF
331+
CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI,
332+
$ NI,
333+
$ IB, A( I, I ), LDA, WORK( IWT ), LDT,
334+
$ C( IC, JC ), LDC, WORK, LDWORK )
335+
10 CONTINUE
336+
END IF
337337
WORK( 1 ) = LWKOPT
338338
RETURN
339339
*

‎SRC/la_constants.mod‎

-1.53 KB
Binary file not shown.

‎SRC/la_xisnan.mod‎

-321 Bytes
Binary file not shown.

‎SRC/zgehd2.f‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,6 @@ SUBROUTINE ZGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
166166
* ..
167167
* .. Local Scalars ..
168168
INTEGER I
169-
COMPLEX*16 ALPHA
170169
* ..
171170
* .. External Subroutines ..
172171
EXTERNAL XERBLA, ZLARF1F, ZLARFG

‎SRC/zgelq2.f‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -146,7 +146,6 @@ SUBROUTINE ZGELQ2( M, N, A, LDA, TAU, WORK, INFO )
146146
* ..
147147
* .. Local Scalars ..
148148
INTEGER I, K
149-
COMPLEX*16 ALPHA
150149
* ..
151150
* .. External Subroutines ..
152151
EXTERNAL XERBLA, ZLACGV, ZLARF1F, ZLARFG

0 commit comments

Comments
 (0)