Skip to content

Commit a26a82f

Browse files
langoulangou
authored
Merge pull request #166 from iyamazaki/master
fixing the definition of "info" in Aasen's
2 parents 5c39268 + fd5cae5 commit a26a82f

18 files changed

+283
-564
lines changed

‎SRC/chetrf_aa.f‎

Lines changed: 5 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -114,11 +114,7 @@
114114
*> \verbatim
115115
*> INFO is INTEGER
116116
*> = 0: successful exit
117-
*> < 0: if INFO = -i, the i-th argument had an illegal value
118-
*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
119-
*> has been completed, but the block diagonal matrix D is
120-
*> exactly singular, and division by zero will occur if it
121-
*> is used to solve a system of equations.
117+
*> < 0: if INFO = -i, the i-th argument had an illegal value.
122118
*> \endverbatim
123119
*
124120
* Authors:
@@ -159,7 +155,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
159155
*
160156
* .. Local Scalars ..
161157
LOGICAL LQUERY, UPPER
162-
INTEGER J, LWKOPT, IINFO
158+
INTEGER J, LWKOPT
163159
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
164160
COMPLEX ALPHA
165161
* ..
@@ -215,13 +211,10 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
215211
IPIV( 1 ) = 1
216212
IF ( N.EQ.1 ) THEN
217213
A( 1, 1 ) = REAL( A( 1, 1 ) )
218-
IF ( A( 1, 1 ).EQ.ZERO ) THEN
219-
INFO = 1
220-
END IF
221214
RETURN
222215
END IF
223216
*
224-
* Adjubst block size based on the workspace size
217+
* Adjust block size based on the workspace size
225218
*
226219
IF( LWORK.LT.((1+NB)*N) ) THEN
227220
NB = ( LWORK-N ) / N
@@ -261,11 +254,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
261254
*
262255
CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB,
263256
$ A( MAX(1, J), J+1 ), LDA,
264-
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
265-
$ IINFO )
266-
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
267-
INFO = IINFO+J
268-
ENDIF
257+
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
269258
*
270259
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
271260
*
@@ -385,10 +374,7 @@ SUBROUTINE CHETRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
385374
*
386375
CALL CLAHEF_AA( UPLO, 2-K1, N-J, JB,
387376
$ A( J+1, MAX(1, J) ), LDA,
388-
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
389-
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
390-
INFO = IINFO+J
391-
ENDIF
377+
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
392378
*
393379
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
394380
*

‎SRC/clahef_aa.f‎

Lines changed: 4 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,11 @@
1919
* ===========
2020
*
2121
* SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
22-
* H, LDH, WORK, INFO )
22+
* H, LDH, WORK )
2323
*
2424
* .. Scalar Arguments ..
2525
* CHARACTER UPLO
26-
* INTEGER J1, M, NB, LDA, LDH, INFO
26+
* INTEGER J1, M, NB, LDA, LDH
2727
* ..
2828
* .. Array Arguments ..
2929
* INTEGER IPIV( * )
@@ -127,16 +127,6 @@
127127
*> WORK is COMPLEX workspace, dimension (M).
128128
*> \endverbatim
129129
*>
130-
*> \param[out] INFO
131-
*> \verbatim
132-
*> INFO is INTEGER
133-
*> = 0: successful exit
134-
*> < 0: if INFO = -i, the i-th argument had an illegal value
135-
*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
136-
*> has been completed, but the block diagonal matrix D is
137-
*> exactly singular, and division by zero will occur if it
138-
*> is used to solve a system of equations.
139-
*> \endverbatim
140130
*
141131
* Authors:
142132
* ========
@@ -152,7 +142,7 @@
152142
*
153143
* =====================================================================
154144
SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
155-
$ H, LDH, WORK, INFO )
145+
$ H, LDH, WORK )
156146
*
157147
* -- LAPACK computational routine (version 3.7.1) --
158148
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -163,7 +153,7 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
163153
*
164154
* .. Scalar Arguments ..
165155
CHARACTER UPLO
166-
INTEGER M, NB, J1, LDA, LDH, INFO
156+
INTEGER M, NB, J1, LDA, LDH
167157
* ..
168158
* .. Array Arguments ..
169159
INTEGER IPIV( * )
@@ -192,7 +182,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
192182
* ..
193183
* .. Executable Statements ..
194184
*
195-
INFO = 0
196185
J = 1
197186
*
198187
* K1 is the first column of the panel to be factorized
@@ -319,12 +308,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
319308
* Set A(J, J+1) = T(J, J+1)
320309
*
321310
A( K, J+1 ) = WORK( 2 )
322-
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
323-
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
324-
IF(INFO .EQ. 0) THEN
325-
INFO = J
326-
END IF
327-
END IF
328311
*
329312
IF( J.LT.NB ) THEN
330313
*
@@ -345,13 +328,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
345328
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
346329
$ A( K, J+2 ), LDA)
347330
END IF
348-
ELSE
349-
IF( (A( K, J ).EQ.ZERO) .AND.
350-
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
351-
IF (INFO.EQ.0) THEN
352-
INFO = J
353-
END IF
354-
END IF
355331
END IF
356332
J = J + 1
357333
GO TO 10
@@ -476,11 +452,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
476452
* Set A(J+1, J) = T(J+1, J)
477453
*
478454
A( J+1, K ) = WORK( 2 )
479-
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
480-
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
481-
IF (INFO .EQ. 0)
482-
$ INFO = J
483-
END IF
484455
*
485456
IF( J.LT.NB ) THEN
486457
*
@@ -501,13 +472,6 @@ SUBROUTINE CLAHEF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
501472
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
502473
$ A( J+2, K ), LDA )
503474
END IF
504-
ELSE
505-
IF( (A( J, K ).EQ.ZERO) .AND.
506-
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
507-
IF (INFO.EQ.0) THEN
508-
INFO = J
509-
END IF
510-
END IF
511475
END IF
512476
J = J + 1
513477
GO TO 30

‎SRC/clasyf_aa.f‎

Lines changed: 4 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,11 @@
1919
* ===========
2020
*
2121
* SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
22-
* H, LDH, WORK, INFO )
22+
* H, LDH, WORK )
2323
*
2424
* .. Scalar Arguments ..
2525
* CHARACTER UPLO
26-
* INTEGER J1, M, NB, LDA, LDH, INFO
26+
* INTEGER J1, M, NB, LDA, LDH
2727
* ..
2828
* .. Array Arguments ..
2929
* INTEGER IPIV( * )
@@ -127,16 +127,6 @@
127127
*> WORK is REAL workspace, dimension (M).
128128
*> \endverbatim
129129
*>
130-
*> \param[out] INFO
131-
*> \verbatim
132-
*> INFO is INTEGER
133-
*> = 0: successful exit
134-
*> < 0: if INFO = -i, the i-th argument had an illegal value
135-
*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
136-
*> has been completed, but the block diagonal matrix D is
137-
*> exactly singular, and division by zero will occur if it
138-
*> is used to solve a system of equations.
139-
*> \endverbatim
140130
*
141131
* Authors:
142132
* ========
@@ -152,7 +142,7 @@
152142
*
153143
* =====================================================================
154144
SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
155-
$ H, LDH, WORK, INFO )
145+
$ H, LDH, WORK )
156146
*
157147
* -- LAPACK computational routine (version 3.7.1) --
158148
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -163,7 +153,7 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
163153
*
164154
* .. Scalar Arguments ..
165155
CHARACTER UPLO
166-
INTEGER M, NB, J1, LDA, LDH, INFO
156+
INTEGER M, NB, J1, LDA, LDH
167157
* ..
168158
* .. Array Arguments ..
169159
INTEGER IPIV( * )
@@ -192,7 +182,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
192182
* ..
193183
* .. Executable Statements ..
194184
*
195-
INFO = 0
196185
J = 1
197186
*
198187
* K1 is the first column of the panel to be factorized
@@ -315,12 +304,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
315304
* Set A(J, J+1) = T(J, J+1)
316305
*
317306
A( K, J+1 ) = WORK( 2 )
318-
IF( (A( K, J ).EQ.ZERO ) .AND. (A( K, J+1 ).EQ.ZERO) .AND.
319-
$ ((K.EQ.1) .OR. (A( K-1, J ).EQ.ZERO)) ) THEN
320-
IF(INFO .EQ. 0) THEN
321-
INFO = J
322-
ENDIF
323-
END IF
324307
*
325308
IF( J.LT.NB ) THEN
326309
*
@@ -341,13 +324,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
341324
CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO,
342325
$ A( K, J+2 ), LDA)
343326
END IF
344-
ELSE
345-
IF( (A( K, J ).EQ.ZERO) .AND.
346-
$ ((K.EQ.1) .OR. (A( J-1, J ).EQ.ZERO)) ) THEN
347-
IF (INFO.EQ.0) THEN
348-
INFO = J
349-
END IF
350-
END IF
351327
END IF
352328
J = J + 1
353329
GO TO 10
@@ -468,11 +444,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
468444
* Set A(J+1, J) = T(J+1, J)
469445
*
470446
A( J+1, K ) = WORK( 2 )
471-
IF( (A( J, K ).EQ.ZERO) .AND. (A( J+1, K ).EQ.ZERO) .AND.
472-
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
473-
IF (INFO .EQ. 0)
474-
$ INFO = J
475-
END IF
476447
*
477448
IF( J.LT.NB ) THEN
478449
*
@@ -493,13 +464,6 @@ SUBROUTINE CLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV,
493464
CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO,
494465
$ A( J+2, K ), LDA )
495466
END IF
496-
ELSE
497-
IF( (A( J, K ).EQ.ZERO) .AND.
498-
$ ((K.EQ.1) .OR. (A( J, K-1 ).EQ.ZERO)) ) THEN
499-
IF (INFO.EQ.0) THEN
500-
INFO = J
501-
END IF
502-
END IF
503467
END IF
504468
J = J + 1
505469
GO TO 30

‎SRC/csytrf_aa.f‎

Lines changed: 5 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -114,11 +114,7 @@
114114
*> \verbatim
115115
*> INFO is INTEGER
116116
*> = 0: successful exit
117-
*> < 0: if INFO = -i, the i-th argument had an illegal value
118-
*> > 0: if INFO = i, D(i,i) is exactly zero. The factorization
119-
*> has been completed, but the block diagonal matrix D is
120-
*> exactly singular, and division by zero will occur if it
121-
*> is used to solve a system of equations.
117+
*> < 0: if INFO = -i, the i-th argument had an illegal value.
122118
*> \endverbatim
123119
*
124120
* Authors:
@@ -159,7 +155,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
159155
*
160156
* .. Local Scalars ..
161157
LOGICAL LQUERY, UPPER
162-
INTEGER J, LWKOPT, IINFO
158+
INTEGER J, LWKOPT
163159
INTEGER NB, MJ, NJ, K1, K2, J1, J2, J3, JB
164160
COMPLEX ALPHA
165161
* ..
@@ -214,13 +210,10 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
214210
ENDIF
215211
IPIV( 1 ) = 1
216212
IF ( N.EQ.1 ) THEN
217-
IF ( A( 1, 1 ).EQ.ZERO ) THEN
218-
INFO = 1
219-
END IF
220213
RETURN
221214
END IF
222215
*
223-
* Adjubst block size based on the workspace size
216+
* Adjust block size based on the workspace size
224217
*
225218
IF( LWORK.LT.((1+NB)*N) ) THEN
226219
NB = ( LWORK-N ) / N
@@ -260,11 +253,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
260253
*
261254
CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
262255
$ A( MAX(1, J), J+1 ), LDA,
263-
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ),
264-
$ IINFO )
265-
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
266-
INFO = IINFO+J
267-
ENDIF
256+
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
268257
*
269258
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
270259
*
@@ -383,10 +372,7 @@ SUBROUTINE CSYTRF_AA( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
383372
*
384373
CALL CLASYF_AA( UPLO, 2-K1, N-J, JB,
385374
$ A( J+1, MAX(1, J) ), LDA,
386-
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO)
387-
IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN
388-
INFO = IINFO+J
389-
ENDIF
375+
$ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ) )
390376
*
391377
* Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot)
392378
*

0 commit comments

Comments
 (0)