Skip to content

Commit 55bdf7f

Browse files
langoulangou
authored
Merge pull request #510 from scr2016/master
Fix for bug #481
2 parents 6ff9f83 + 7996ef1 commit 55bdf7f

File tree

8 files changed

+80
-20
lines changed

8 files changed

+80
-20
lines changed

‎SRC/cgetsqrhrt.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@
8686
*> \verbatim
8787
*> NB2 is INTEGER
8888
*> The block size to be used in the blocked QR that is
89-
*> output. NB >= 1.
89+
*> output. NB2 >= 1.
9090
*> \endverbatim
9191
*>
9292
*> \param[in,out] A
@@ -119,7 +119,7 @@
119119
*> \param[in] LDT
120120
*> \verbatim
121121
*> LDT is INTEGER
122-
*> The leading dimension of the array T. LDT >= NB.
122+
*> The leading dimension of the array T. LDT >= NB2.
123123
*> \endverbatim
124124
*>
125125
*> \param[out] WORK

‎SRC/cungtsqr_row.f

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -214,6 +214,9 @@ SUBROUTINE CUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
214214
$ LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
215215
$ KB, KB_LAST, KNB, MB1
216216
* ..
217+
* .. Local Arrays ..
218+
COMPLEX DUMMY( 1, 1 )
219+
* ..
217220
* .. External Subroutines ..
218221
EXTERNAL CLARFB_GETT, CLASET, XERBLA
219222
* ..
@@ -354,9 +357,21 @@ SUBROUTINE CUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
354357
*
355358
KNB = MIN( NBLOCAL, N - KB + 1 )
356359
*
357-
CALL CLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
358-
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
359-
$ A( KB+KNB, KB), LDA, WORK, KNB )
360+
IF( MB1-KB-KNB+1.EQ.0 ) THEN
361+
*
362+
* In SLARFB_GETT parameters, when M=0, then the matrix B
363+
* does not exist, hence we need to pass a dummy array
364+
* reference DUMMY(1,1) to B with LDDUMMY=1.
365+
*
366+
CALL CLARFB_GETT( 'N', 0, N-KB+1, KNB,
367+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
368+
$ DUMMY( 1, 1 ), 1, WORK, KNB )
369+
ELSE
370+
CALL CLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
371+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
372+
$ A( KB+KNB, KB), LDA, WORK, KNB )
373+
374+
END IF
360375
*
361376
END DO
362377
*

‎SRC/dgetsqrhrt.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@
8686
*> \verbatim
8787
*> NB2 is INTEGER
8888
*> The block size to be used in the blocked QR that is
89-
*> output. NB >= 1.
89+
*> output. NB2 >= 1.
9090
*> \endverbatim
9191
*>
9292
*> \param[in,out] A
@@ -119,7 +119,7 @@
119119
*> \param[in] LDT
120120
*> \verbatim
121121
*> LDT is INTEGER
122-
*> The leading dimension of the array T. LDT >= NB.
122+
*> The leading dimension of the array T. LDT >= NB2.
123123
*> \endverbatim
124124
*>
125125
*> \param[out] WORK

‎SRC/dorgtsqr_row.f

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,9 @@ SUBROUTINE DORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
213213
$ LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
214214
$ KB, KB_LAST, KNB, MB1
215215
* ..
216+
* .. Local Arrays ..
217+
DOUBLE PRECISION DUMMY( 1, 1 )
218+
* ..
216219
* .. External Subroutines ..
217220
EXTERNAL DLARFB_GETT, DLASET, XERBLA
218221
* ..
@@ -353,9 +356,21 @@ SUBROUTINE DORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
353356
*
354357
KNB = MIN( NBLOCAL, N - KB + 1 )
355358
*
356-
CALL DLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
357-
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
358-
$ A( KB+KNB, KB), LDA, WORK, KNB )
359+
IF( MB1-KB-KNB+1.EQ.0 ) THEN
360+
*
361+
* In SLARFB_GETT parameters, when M=0, then the matrix B
362+
* does not exist, hence we need to pass a dummy array
363+
* reference DUMMY(1,1) to B with LDDUMMY=1.
364+
*
365+
CALL DLARFB_GETT( 'N', 0, N-KB+1, KNB,
366+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
367+
$ DUMMY( 1, 1 ), 1, WORK, KNB )
368+
ELSE
369+
CALL DLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
370+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
371+
$ A( KB+KNB, KB), LDA, WORK, KNB )
372+
373+
END IF
359374
*
360375
END DO
361376
*

‎SRC/sgetsqrhrt.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@
8686
*> \verbatim
8787
*> NB2 is INTEGER
8888
*> The block size to be used in the blocked QR that is
89-
*> output. NB >= 1.
89+
*> output. NB2 >= 1.
9090
*> \endverbatim
9191
*>
9292
*> \param[in,out] A
@@ -119,7 +119,7 @@
119119
*> \param[in] LDT
120120
*> \verbatim
121121
*> LDT is INTEGER
122-
*> The leading dimension of the array T. LDT >= NB.
122+
*> The leading dimension of the array T. LDT >= NB2.
123123
*> \endverbatim
124124
*>
125125
*> \param[out] WORK

‎SRC/sorgtsqr_row.f

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -213,6 +213,9 @@ SUBROUTINE SORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
213213
$ LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
214214
$ KB, KB_LAST, KNB, MB1
215215
* ..
216+
* .. Local Arrays ..
217+
REAL DUMMY( 1, 1 )
218+
* ..
216219
* .. External Subroutines ..
217220
EXTERNAL SLARFB_GETT, SLASET, XERBLA
218221
* ..
@@ -353,9 +356,21 @@ SUBROUTINE SORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
353356
*
354357
KNB = MIN( NBLOCAL, N - KB + 1 )
355358
*
356-
CALL SLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
357-
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
358-
$ A( KB+KNB, KB), LDA, WORK, KNB )
359+
IF( MB1-KB-KNB+1.EQ.0 ) THEN
360+
*
361+
* In SLARFB_GETT parameters, when M=0, then the matrix B
362+
* does not exist, hence we need to pass a dummy array
363+
* reference DUMMY(1,1) to B with LDDUMMY=1.
364+
*
365+
CALL SLARFB_GETT( 'N', 0, N-KB+1, KNB,
366+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
367+
$ DUMMY( 1, 1 ), 1, WORK, KNB )
368+
ELSE
369+
CALL SLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
370+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
371+
$ A( KB+KNB, KB), LDA, WORK, KNB )
372+
373+
END IF
359374
*
360375
END DO
361376
*

‎SRC/zgetsqrhrt.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,7 @@
8686
*> \verbatim
8787
*> NB2 is INTEGER
8888
*> The block size to be used in the blocked QR that is
89-
*> output. NB >= 1.
89+
*> output. NB2 >= 1.
9090
*> \endverbatim
9191
*>
9292
*> \param[in,out] A
@@ -119,7 +119,7 @@
119119
*> \param[in] LDT
120120
*> \verbatim
121121
*> LDT is INTEGER
122-
*> The leading dimension of the array T. LDT >= NB.
122+
*> The leading dimension of the array T. LDT >= NB2.
123123
*> \endverbatim
124124
*>
125125
*> \param[out] WORK

‎SRC/zungtsqr_row.f

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -214,6 +214,9 @@ SUBROUTINE ZUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
214214
$ LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
215215
$ KB, KB_LAST, KNB, MB1
216216
* ..
217+
* .. Local Arrays ..
218+
COMPLEX*16 DUMMY( 1, 1 )
219+
* ..
217220
* .. External Subroutines ..
218221
EXTERNAL ZLARFB_GETT, ZLASET, XERBLA
219222
* ..
@@ -354,9 +357,21 @@ SUBROUTINE ZUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
354357
*
355358
KNB = MIN( NBLOCAL, N - KB + 1 )
356359
*
357-
CALL ZLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
358-
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
359-
$ A( KB+KNB, KB), LDA, WORK, KNB )
360+
IF( MB1-KB-KNB+1.EQ.0 ) THEN
361+
*
362+
* In SLARFB_GETT parameters, when M=0, then the matrix B
363+
* does not exist, hence we need to pass a dummy array
364+
* reference DUMMY(1,1) to B with LDDUMMY=1.
365+
*
366+
CALL ZLARFB_GETT( 'N', 0, N-KB+1, KNB,
367+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
368+
$ DUMMY( 1, 1 ), 1, WORK, KNB )
369+
ELSE
370+
CALL ZLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
371+
$ T( 1, KB ), LDT, A( KB, KB ), LDA,
372+
$ A( KB+KNB, KB), LDA, WORK, KNB )
373+
374+
END IF
360375
*
361376
END DO
362377
*

0 commit comments

Comments
 (0)