phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Correct bug0069

Browse Source 
Bug was sent by nmozarto on Jan 27th (see forum topic 2156)

Problem in new function ?SYTRI2 was found: the part of A below the diagonal is changed in the case UPLO='U' .
But in the description of arguments 
If UPLO = 'U', the upper triangular part of the
inverse is formed and the part of A below the diagonal is not
referenced; if UPLO = 'L' the lower triangular part of the
inverse is formed and the part of A above the diagonal is
not referenced.

These elements zeroized after calling ?GEMM function in ?SYTRI2X.
CALL SGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
This commit is contained in:
julie
2011-01-28 23:04:40 +00:00
parent b472675224
commit 318f35554e
6 changed files with 91 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
SRC/chetri2x.f
+15 -3
View File
@@ -273,11 +273,17 @@
*
CALL CTRMM('L','U','C','U',NNB, NNB,
$ CONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL CGEMM('C','N',NNB,NNB,CUT,CONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -438,13 +444,19 @@
*
CALL CTRMM('L',UPLO,'C','U',NNB, NNB,
$ CONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL CGEMM('C','N',NNB,NNB,N-NNB-CUT,CONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01
SRC/csytri2x.f
+15 -3
View File
@@ -271,11 +271,17 @@
*
CALL CTRMM('L','U','T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL CGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -436,13 +442,19 @@
*
CALL CTRMM('L',UPLO,'T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL CGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01
SRC/dsytri2x.f
+16 -2
View File
@@ -270,11 +270,18 @@
*
CALL DTRMM('L','U','T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL DGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -436,12 +443,19 @@
CALL DTRMM('L',UPLO,'T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL DGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01
SRC/ssytri2x.f
+15 -2
View File
@@ -270,11 +270,17 @@
*
CALL STRMM('L','U','T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL SGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -436,12 +442,19 @@
CALL STRMM('L',UPLO,'T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL SGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01
SRC/zhetri2x.f
+15 -3
View File
@@ -273,11 +273,17 @@
*
CALL ZTRMM('L','U','C','U',NNB, NNB,
$ CONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL ZGEMM('C','N',NNB,NNB,CUT,CONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -438,13 +444,19 @@
*
CALL ZTRMM('L',UPLO,'C','U',NNB, NNB,
$ CONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL ZGEMM('C','N',NNB,NNB,N-NNB-CUT,CONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01
SRC/zsytri2x.f
+15 -2
View File
@@ -271,11 +271,17 @@
*
CALL ZTRMM('L','U','T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=I,NNB
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
* U01'invD*U01->A(CUT+I,CUT+J)
*
CALL ZGEMM('T','N',NNB,NNB,CUT,ONE,A(1,CUT+1),LDA,
$ WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* U11 = U11T*invD1*U11 + U01'invD*U01
*
@@ -436,13 +442,20 @@
*
CALL ZTRMM('L',UPLO,'T','U',NNB, NNB,
$ ONE,A(CUT+1,CUT+1),LDA,WORK(U11+1,1),N+NB+1)
*
DO I=1,NNB
DO J=1,I
A(CUT+I,CUT+J)=WORK(U11+I,J)
END DO
END DO
*
IF ( (CUT+NNB) .LT. N ) THEN
*
* L21T*invD2*L21->A(CUT+I,CUT+J)
*
CALL ZGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1)
$ ,LDA,WORK,N+NB+1, ZERO, A(CUT+1,CUT+1), LDA)
$ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
*
* L11 = L11T*invD1*L11 + U01'invD*U01