--- rpl/lapack/lapack/dlasyf_aa.f 2018/05/29 06:55:20 1.3 +++ rpl/lapack/lapack/dlasyf_aa.f 2023/08/07 08:39:00 1.6 @@ -136,18 +136,15 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2017 -* *> \ingroup doubleSYcomputational * * ===================================================================== SUBROUTINE DLASYF_AA( UPLO, J1, M, NB, A, LDA, IPIV, $ H, LDH, WORK ) * -* -- LAPACK computational routine (version 3.8.0) -- +* -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2017 * IMPLICIT NONE * @@ -284,8 +281,9 @@ * * Swap A(I1, I2+1:M) with A(I2, I2+1:M) * - CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, - $ A( J1+I2-1, I2+1 ), LDA ) + IF( I2.LT.M ) + $ CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) * @@ -325,13 +323,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( K, J+1 ).NE.ZERO ) THEN - ALPHA = ONE / A( K, J+1 ) - CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) - CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) - ELSE - CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, - $ A( K, J+2 ), LDA) + IF( J.LT.(M-1) ) THEN + IF( A( K, J+1 ).NE.ZERO ) THEN + ALPHA = ONE / A( K, J+1 ) + CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) + CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) + ELSE + CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, + $ A( K, J+2 ), LDA) + END IF END IF END IF J = J + 1 @@ -432,8 +432,9 @@ * * Swap A(I2+1:M, I1) with A(I2+1:M, I2) * - CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, - $ A( I2+1, J1+I2-1 ), 1 ) + IF( I2.LT.M ) + $ CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) * @@ -473,13 +474,15 @@ * Compute L(J+2, J+1) = WORK( 3:M ) / T(J, J+1), * where A(J, J+1) = T(J, J+1) and A(J+2:M, J) = L(J+2:M, J+1) * - IF( A( J+1, K ).NE.ZERO ) THEN - ALPHA = ONE / A( J+1, K ) - CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) - CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) - ELSE - CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, - $ A( J+2, K ), LDA ) + IF( J.LT.(M-1) ) THEN + IF( A( J+1, K ).NE.ZERO ) THEN + ALPHA = ONE / A( J+1, K ) + CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) + CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) + ELSE + CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, + $ A( J+2, K ), LDA ) + END IF END IF END IF J = J + 1