Skip to content

Commit 690067c

Browse files
EduardFedorenkovEduardFedorenkov
committed
add firstv param in larf1l, #1011 
1 parent ba27bf0 commit 690067c

File tree

2 files changed

+59
-63
lines changed

2 files changed

+59
-63
lines changed

‎SRC/clarf1l.f

Lines changed: 32 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@
8484
*> \param[in] INCV
8585
*> \verbatim
8686
*> INCV is INTEGER
87-
*> The increment between elements of v. INCV <> 0.
87+
*> The increment between elements of v. INCV > 0.
8888
*> \endverbatim
8989
*>
9090
*> \param[in] TAU
@@ -149,7 +149,7 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
149149
* ..
150150
* .. Local Scalars ..
151151
LOGICAL APPLYLEFT
152-
INTEGER I, LASTV, LASTC
152+
INTEGER I, J, LASTV, LASTC, FIRSTV
153153
* ..
154154
* .. External Subroutines ..
155155
EXTERNAL CGEMV, CGERC, CSCAL
@@ -165,7 +165,7 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
165165
* .. Executable Statements ..
166166
*
167167
APPLYLEFT = LSAME( SIDE, 'L' )
168-
LASTV = 1
168+
FIRSTV = 1
169169
LASTC = 0
170170
IF( TAU.NE.ZERO ) THEN
171171
! Set up variables for scanning V. LASTV begins pointing to the end
@@ -175,15 +175,11 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
175175
ELSE
176176
LASTV = N
177177
END IF
178-
IF( INCV.GT.0 ) THEN
179-
I = 1 + (LASTV-1) * INCV
180-
ELSE
181-
I = 1
182-
END IF
178+
I = 1
183179
! Look for the last non-zero row in V.
184-
DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO )
185-
LASTV = LASTV - 1
186-
I = I - INCV
180+
DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO )
181+
FIRSTV = FIRSTV + 1
182+
I = I + INCV
187183
END DO
188184
IF( APPLYLEFT ) THEN
189185
! Scan for the last non-zero column in C(1:lastv,:).
@@ -200,51 +196,53 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
200196
*
201197
* Form H * C
202198
*
203-
IF( LASTV.EQ.1 ) THEN
199+
IF( LASTV.EQ.FIRSTV ) THEN
204200
*
205-
* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc)
201+
* C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc)
206202
*
207-
CALL CSCAL( LASTC, ONE - TAU, C, LDC )
203+
CALL CSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC )
208204
ELSE
209205
*
210-
* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1)
206+
* w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1)
211207
*
212-
CALL CGEMV( 'Conjugate transpose', LASTV - 1, LASTC,
213-
$ ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
208+
CALL CGEMV( 'Conjugate transpose', LASTV - FIRSTV, LASTC,
209+
$ ONE, C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO,
210+
$ WORK, 1 )
214211
*
215212
* w(1:lastc,1) += C(lastv,1:lastc)**H * v(lastv,1)
216213
*
217-
DO I = 1, LASTC
218-
WORK( I ) = WORK( I ) + CONJG( C( LASTV, I ) )
214+
DO J = 1, LASTC
215+
WORK( J ) = WORK( J ) + CONJG( C( LASTV, J ) )
219216
END DO
220217
*
221218
* C(lastv,1:lastc) += - tau * v(lastv,1) * w(1:lastc,1)**H
222219
*
223-
DO I = 1, LASTC
224-
C( LASTV, I ) = C( LASTV, I )
225-
$ - TAU * CONJG( WORK( I ) )
220+
DO J = 1, LASTC
221+
C( LASTV, J ) = C( LASTV, J )
222+
$ - TAU * CONJG( WORK( J ) )
226223
END DO
227224
*
228-
* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**H
225+
* C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**H
229226
*
230-
CALL CGERC( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C,
231-
$ LDC)
227+
CALL CGERC( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV,
228+
$ WORK, 1, C( FIRSTV, 1 ), LDC)
232229
END IF
233230
ELSE
234231
*
235232
* Form C * H
236233
*
237-
IF( LASTV.EQ.1 ) THEN
234+
IF( LASTV.EQ.FIRSTV ) THEN
238235
*
239-
* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1)
236+
* C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv)
240237
*
241-
CALL CSCAL( LASTC, ONE - TAU, C, 1 )
238+
CALL CSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 )
242239
ELSE
243240
*
244-
* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1)
241+
* w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1)
245242
*
246-
CALL CGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C,
247-
$ LDC, V, INCV, ZERO, WORK, 1 )
243+
CALL CGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE,
244+
$ C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO,
245+
$ WORK, 1 )
248246
*
249247
* w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1)
250248
*
@@ -254,10 +252,10 @@ SUBROUTINE CLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
254252
*
255253
CALL CAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 )
256254
*
257-
* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**H
255+
* C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**H
258256
*
259-
CALL CGERC( LASTC, LASTV - 1, -TAU, WORK, 1, V,
260-
$ INCV, C, LDC )
257+
CALL CGERC( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ),
258+
$ INCV, C( 1, FIRSTV ), LDC )
261259
END IF
262260
END IF
263261
RETURN

‎SRC/slarf1l.f

Lines changed: 27 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,7 @@
8282
*> \param[in] INCV
8383
*> \verbatim
8484
*> INCV is INTEGER
85-
*> The increment between elements of v. INCV <> 0.
85+
*> The increment between elements of v. INCV > 0.
8686
*> \endverbatim
8787
*>
8888
*> \param[in] TAU
@@ -146,7 +146,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
146146
* ..
147147
* .. Local Scalars ..
148148
LOGICAL APPLYLEFT
149-
INTEGER I, LASTV, LASTC
149+
INTEGER I, LASTV, LASTC, FIRSTV
150150
* ..
151151
* .. External Subroutines ..
152152
EXTERNAL SGEMV, SGER, SAXPY, SSCAL
@@ -159,7 +159,7 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
159159
* .. Executable Statements ..
160160
*
161161
APPLYLEFT = LSAME( SIDE, 'L' )
162-
LASTV = 1
162+
FIRSTV = 1
163163
LASTC = 0
164164
IF( TAU.NE.ZERO ) THEN
165165
! Set up variables for scanning V. LASTV begins pointing to the end
@@ -169,15 +169,11 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
169169
ELSE
170170
LASTV = N
171171
END IF
172-
IF( INCV.GT.0 ) THEN
173-
I = 1 + (LASTV-1) * INCV
174-
ELSE
175-
I = 1
176-
END IF
172+
I = 1
177173
! Look for the last non-zero row in V.
178-
DO WHILE( LASTV.GT.1 .AND. V( I ).EQ.ZERO )
179-
LASTV = LASTV - 1
180-
I = I - INCV
174+
DO WHILE( LASTV.GT.FIRSTV .AND. V( I ).EQ.ZERO )
175+
FIRSTV = FIRSTV + 1
176+
I = I + INCV
181177
END DO
182178
IF( APPLYLEFT ) THEN
183179
! Scan for the last non-zero column in C(1:lastv,:).
@@ -194,17 +190,18 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
194190
*
195191
* Form H * C
196192
*
197-
IF( LASTV.EQ.1 ) THEN
193+
IF( LASTV.EQ.FIRSTV ) THEN
198194
*
199-
* C(1,1:lastc) := ( 1 - tau ) * C(1,1:lastc)
195+
* C(lastv,1:lastc) := ( 1 - tau ) * C(lastv,1:lastc)
200196
*
201-
CALL SSCAL( LASTC, ONE - TAU, C, LDC )
197+
CALL SSCAL( LASTC, ONE - TAU, C( LASTV, 1 ), LDC )
202198
ELSE
203199
*
204-
* w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1)
200+
* w(1:lastc,1) := C(firstv:lastv-1,1:lastc)**T * v(firstv:lastv-1,1)
205201
*
206-
CALL SGEMV( 'Transpose', LASTV - 1, LASTC, ONE, C, LDC,
207-
$ V, INCV, ZERO, WORK, 1 )
202+
CALL SGEMV( 'Transpose', LASTV - FIRSTV, LASTC, ONE,
203+
$ C( FIRSTV, 1 ), LDC, V( I ), INCV, ZERO,
204+
$ WORK, 1 )
208205
*
209206
* w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1)
210207
*
@@ -214,26 +211,27 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
214211
*
215212
CALL SAXPY( LASTC, -TAU, WORK, 1, C( LASTV, 1 ), LDC )
216213
*
217-
* C(1:lastv-1,1:lastc) += - tau * v(1:lastv-1,1) * w(1:lastc,1)**T
214+
* C(firstv:lastv-1,1:lastc) += - tau * v(firstv:lastv-1,1) * w(1:lastc,1)**T
218215
*
219-
CALL SGER( LASTV - 1, LASTC, -TAU, V, INCV, WORK, 1, C,
220-
$ LDC)
216+
CALL SGER( LASTV - FIRSTV, LASTC, -TAU, V( I ), INCV,
217+
$ WORK, 1, C( FIRSTV, 1 ), LDC)
221218
END IF
222219
ELSE
223220
*
224221
* Form C * H
225222
*
226-
IF( LASTV.EQ.1 ) THEN
223+
IF( LASTV.EQ.FIRSTV ) THEN
227224
*
228-
* C(1:lastc,1) := ( 1 - tau ) * C(1:lastc,1)
225+
* C(1:lastc,lastv) := ( 1 - tau ) * C(1:lastc,lastv)
229226
*
230-
CALL SSCAL( LASTC, ONE - TAU, C, 1 )
227+
CALL SSCAL( LASTC, ONE - TAU, C( 1, LASTV ), 1 )
231228
ELSE
232229
*
233-
* w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1)
230+
* w(1:lastc,1) := C(1:lastc,firstv:lastv-1) * v(firstv:lastv-1,1)
234231
*
235-
CALL SGEMV( 'No transpose', LASTC, LASTV - 1, ONE, C,
236-
$ LDC, V, INCV, ZERO, WORK, 1 )
232+
CALL SGEMV( 'No transpose', LASTC, LASTV - FIRSTV, ONE,
233+
$ C( 1, FIRSTV ), LDC, V( I ), INCV, ZERO,
234+
$ WORK, 1 )
237235
*
238236
* w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1)
239237
*
@@ -243,10 +241,10 @@ SUBROUTINE SLARF1L( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
243241
*
244242
CALL SAXPY( LASTC, -TAU, WORK, 1, C( 1, LASTV ), 1 )
245243
*
246-
* C(1:lastc,1:lastv-1) += - tau * w(1:lastc,1) * v(1:lastv-1)**T
244+
* C(1:lastc,firstv:lastv-1) += - tau * w(1:lastc,1) * v(firstv:lastv-1)**T
247245
*
248-
CALL SGER( LASTC, LASTV - 1, -TAU, WORK, 1, V,
249-
$ INCV, C, LDC )
246+
CALL SGER( LASTC, LASTV - FIRSTV, -TAU, WORK, 1, V( I ),
247+
$ INCV, C( 1, FIRSTV ), LDC )
250248
END IF
251249
END IF
252250
RETURN

0 commit comments

Comments
 (0)