diff options
author | langou <langou@users.noreply.github.com> | 2009-01-12 05:17:21 +0000 |
---|---|---|
committer | langou <langou@users.noreply.github.com> | 2009-01-12 05:17:21 +0000 |
commit | 3cff0c0c7d6f581bb14e645fbd5d035a53581446 (patch) | |
tree | b16f6163f51de9ac12a691dcb407c55cb5086ed0 /SRC | |
parent | dc20e8382624a09011f4f57fac2f0dd543a0522d (diff) | |
download | lapack-3cff0c0c7d6f581bb14e645fbd5d035a53581446.tar.gz lapack-3cff0c0c7d6f581bb14e645fbd5d035a53581446.tar.bz2 lapack-3cff0c0c7d6f581bb14e645fbd5d035a53581446.zip |
============================================================================
Bug in RFP routines xTFSM for N=1 independently reported by Jason and Julie.
============================================================================
See Jason's email DEC/27/2009: "Similar problem in xTFSM".
Jason used gfortran with -fbounds-check and got:
> At line 328 of file stfsm.f
> Fortran runtime error: Array reference out of bounds for array 'b', upper bound of dimension 1 exceeded (1 > 0)
Julie also observed the bug with MS Visual Studio.
See ticket http://icl.cs.utk.edu/trac/lapack-dev/ticket/46
The problem is the following. Sometimes in the RFP routines, we
call routines like for example
DGEMM ( M, N, K, ... A( I, J), ...)
where M or N is 0 and A( I, J ) is out-of-bound. The rationale was since M or
N is 0, DGEMM simply exits without doing anything, therefore the out-of-bound
A(I,J) is not an issue. Well, this is not Fortran correct.
In this commit, I have fix the problem for xTFSM. This is a fix. This is not
rocket-science and one can certainly do something more elegant ... This bug is
blocking Julie from porting on Windows so the matter was urgent.
Now RFP + ( gfortan -fbounds-check ) works fine.
TODO: find a cleaner way to fix this,
TODO: Unfortunately I believe there are other bugs like this one in other RFP
routines, always when N=1. See for example xPFTRF. I do not understand why the
TESTING with gfortran -fbounds-check do not trigger an error though ...
Diffstat (limited to 'SRC')
-rw-r--r-- | SRC/ctfsm.f | 70 | ||||
-rw-r--r-- | SRC/dtfsm.f | 71 | ||||
-rw-r--r-- | SRC/stfsm.f | 70 | ||||
-rw-r--r-- | SRC/ztfsm.f | 70 |
4 files changed, 185 insertions, 96 deletions
diff --git a/SRC/ctfsm.f b/SRC/ctfsm.f index 9eeee773..303f0109 100644 --- a/SRC/ctfsm.f +++ b/SRC/ctfsm.f @@ -339,24 +339,34 @@ * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'N' * - CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, - + A( 0 ), M, B, LDB ) - CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), M, - + B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, - + A( M ), M, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A, M, B, LDB ) + ELSE + CALL CTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + CALL CGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), + + M, B, LDB, ALPHA, B( M1, 0 ), LDB ) + CALL CTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, + + A( M ), M, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'C' * - CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, - + A( M ), M, B( M1, 0 ), LDB ) - CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), M, - + B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, - + A( 0 ), M, B, LDB ) + IF( M.EQ.1 ) THEN + CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + ELSE + CALL CTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + + A( M ), M, B( M1, 0 ), LDB ) + CALL CGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), + + M, B( M1, 0 ), LDB, ALPHA, B, LDB ) + CALL CTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, + + A( 0 ), M, B, LDB ) + END IF * END IF * @@ -405,24 +415,36 @@ * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and * TRANS = 'N' * - CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, - + A( 0 ), M1, B, LDB ) - CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, A( M1*M1 ), - + M1, B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL CTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, - + A( 1 ), M1, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL CTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + CALL CGEMM( 'C', 'N', M2, N, M1, -CONE, + + A( M1*M1 ), M1, B, LDB, ALPHA, + + B( M1, 0 ), LDB ) + CALL CTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, + + A( 1 ), M1, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and * TRANS = 'C' * - CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, - + A( 1 ), M1, B( M1, 0 ), LDB ) - CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, A( M1*M1 ), - + M1, B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, - + A( 0 ), M1, B, LDB ) + IF( M.EQ.1 ) THEN + CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL CTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, + + A( 1 ), M1, B( M1, 0 ), LDB ) + CALL CGEMM( 'N', 'N', M1, N, M2, -CONE, + + A( M1*M1 ), M1, B( M1, 0 ), LDB, + + ALPHA, B, LDB ) + CALL CTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, + + A( 0 ), M1, B, LDB ) + END IF * END IF * diff --git a/SRC/dtfsm.f b/SRC/dtfsm.f index 7ba96a30..3f0fd16b 100644 --- a/SRC/dtfsm.f +++ b/SRC/dtfsm.f @@ -305,6 +305,7 @@ END IF END IF * +* IF( MISODD ) THEN * * SIDE = 'L' and N is odd @@ -322,24 +323,34 @@ * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'N' * - CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, - + A( 0 ), M, B, LDB ) - CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), M, - + B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, - + A( M ), M, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A, M, B, LDB ) + ELSE + CALL DTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + CALL DGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), + + M, B, LDB, ALPHA, B( M1, 0 ), LDB ) + CALL DTRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, + + A( M ), M, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'T' * - CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, - + A( M ), M, B( M1, 0 ), LDB ) - CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), M, - + B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, - + A( 0 ), M, B, LDB ) + IF( M.EQ.1 ) THEN + CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + ELSE + CALL DTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + + A( M ), M, B( M1, 0 ), LDB ) + CALL DGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), + + M, B( M1, 0 ), LDB, ALPHA, B, LDB ) + CALL DTRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, + + A( 0 ), M, B, LDB ) + END IF * END IF * @@ -388,24 +399,36 @@ * SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and * TRANS = 'N' * - CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, - + A( 0 ), M1, B, LDB ) - CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, A( M1*M1 ), - + M1, B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL DTRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, - + A( 1 ), M1, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL DTRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + CALL DGEMM( 'T', 'N', M2, N, M1, -ONE, + + A( M1*M1 ), M1, B, LDB, ALPHA, + + B( M1, 0 ), LDB ) + CALL DTRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, + + A( 1 ), M1, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and * TRANS = 'T' * - CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, - + A( 1 ), M1, B( M1, 0 ), LDB ) - CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, A( M1*M1 ), - + M1, B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, - + A( 0 ), M1, B, LDB ) + IF( M.EQ.1 ) THEN + CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL DTRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, + + A( 1 ), M1, B( M1, 0 ), LDB ) + CALL DGEMM( 'N', 'N', M1, N, M2, -ONE, + + A( M1*M1 ), M1, B( M1, 0 ), LDB, + + ALPHA, B, LDB ) + CALL DTRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, + + A( 0 ), M1, B, LDB ) + END IF * END IF * diff --git a/SRC/stfsm.f b/SRC/stfsm.f index 2ca36fb0..05ca537c 100644 --- a/SRC/stfsm.f +++ b/SRC/stfsm.f @@ -322,24 +322,34 @@ * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'N' * - CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, - + A( 0 ), M, B, LDB ) - CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), M, - + B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, - + A( M ), M, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A, M, B, LDB ) + ELSE + CALL STRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + CALL SGEMM( 'N', 'N', M2, N, M1, -ONE, A( M1 ), + + M, B, LDB, ALPHA, B( M1, 0 ), LDB ) + CALL STRSM( 'L', 'U', 'T', DIAG, M2, N, ONE, + + A( M ), M, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'T' * - CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, - + A( M ), M, B( M1, 0 ), LDB ) - CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), M, - + B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, - + A( 0 ), M, B, LDB ) + IF( M.EQ.1 ) THEN + CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + ELSE + CALL STRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + + A( M ), M, B( M1, 0 ), LDB ) + CALL SGEMM( 'T', 'N', M1, N, M2, -ONE, A( M1 ), M, + + M, B( M1, 0 ), LDB, ALPHA, B, LDB ) + CALL STRSM( 'L', 'L', 'T', DIAG, M1, N, ONE, + + A( 0 ), M, B, LDB ) + END IF * END IF * @@ -388,24 +398,36 @@ * SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and * TRANS = 'N' * - CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, - + A( 0 ), M1, B, LDB ) - CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, A( M1*M1 ), - + M1, B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL STRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, - + A( 1 ), M1, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL STRSM( 'L', 'U', 'T', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + CALL SGEMM( 'T', 'N', M2, N, M1, -ONE, + + A( M1*M1 ), M1, B, LDB, ALPHA, + + B( M1, 0 ), LDB ) + CALL STRSM( 'L', 'L', 'N', DIAG, M2, N, ONE, + + A( 1 ), M1, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'T', UPLO = 'L', and * TRANS = 'T' * - CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, - + A( 1 ), M1, B( M1, 0 ), LDB ) - CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, A( M1*M1 ), - + M1, B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, - + A( 0 ), M1, B, LDB ) + IF( M.EQ.1 ) THEN + CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL STRSM( 'L', 'L', 'T', DIAG, M2, N, ALPHA, + + A( 1 ), M1, B( M1, 0 ), LDB ) + CALL SGEMM( 'N', 'N', M1, N, M2, -ONE, + + A( M1*M1 ), M1, B( M1, 0 ), LDB, + + ALPHA, B, LDB ) + CALL STRSM( 'L', 'U', 'N', DIAG, M1, N, ONE, + + A( 0 ), M1, B, LDB ) + END IF * END IF * diff --git a/SRC/ztfsm.f b/SRC/ztfsm.f index fa9ce767..fcdcbbe6 100644 --- a/SRC/ztfsm.f +++ b/SRC/ztfsm.f @@ -339,24 +339,34 @@ * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'N' * - CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, - + A( 0 ), M, B, LDB ) - CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), M, - + B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, - + A( M ), M, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A, M, B, LDB ) + ELSE + CALL ZTRSM( 'L', 'L', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + CALL ZGEMM( 'N', 'N', M2, N, M1, -CONE, A( M1 ), + + M, B, LDB, ALPHA, B( M1, 0 ), LDB ) + CALL ZTRSM( 'L', 'U', 'C', DIAG, M2, N, CONE, + + A( M ), M, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'N', UPLO = 'L', and * TRANS = 'C' * - CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, - + A( M ), M, B( M1, 0 ), LDB ) - CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), M, - + B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, - + A( 0 ), M, B, LDB ) + IF( M.EQ.1 ) THEN + CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M, B, LDB ) + ELSE + CALL ZTRSM( 'L', 'U', 'N', DIAG, M2, N, ALPHA, + + A( M ), M, B( M1, 0 ), LDB ) + CALL ZGEMM( 'C', 'N', M1, N, M2, -CONE, A( M1 ), + + M, B( M1, 0 ), LDB, ALPHA, B, LDB ) + CALL ZTRSM( 'L', 'L', 'C', DIAG, M1, N, CONE, + + A( 0 ), M, B, LDB ) + END IF * END IF * @@ -405,24 +415,36 @@ * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and * TRANS = 'N' * - CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, - + A( 0 ), M1, B, LDB ) - CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, A( M1*M1 ), - + M1, B, LDB, ALPHA, B( M1, 0 ), LDB ) - CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, - + A( 1 ), M1, B( M1, 0 ), LDB ) + IF( M.EQ.1 ) THEN + CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL ZTRSM( 'L', 'U', 'C', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + CALL ZGEMM( 'C', 'N', M2, N, M1, -CONE, + + A( M1*M1 ), M1, B, LDB, ALPHA, + + B( M1, 0 ), LDB ) + CALL ZTRSM( 'L', 'L', 'N', DIAG, M2, N, CONE, + + A( 1 ), M1, B( M1, 0 ), LDB ) + END IF * ELSE * * SIDE ='L', N is odd, TRANSR = 'C', UPLO = 'L', and * TRANS = 'C' * - CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, - + A( 1 ), M1, B( M1, 0 ), LDB ) - CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, A( M1*M1 ), - + M1, B( M1, 0 ), LDB, ALPHA, B, LDB ) - CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, - + A( 0 ), M1, B, LDB ) + IF( M.EQ.1 ) THEN + CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, ALPHA, + + A( 0 ), M1, B, LDB ) + ELSE + CALL ZTRSM( 'L', 'L', 'C', DIAG, M2, N, ALPHA, + + A( 1 ), M1, B( M1, 0 ), LDB ) + CALL ZGEMM( 'N', 'N', M1, N, M2, -CONE, + + A( M1*M1 ), M1, B( M1, 0 ), LDB, + + ALPHA, B, LDB ) + CALL ZTRSM( 'L', 'U', 'N', DIAG, M1, N, CONE, + + A( 0 ), M1, B, LDB ) + END IF * END IF * |