version 1.5, 2010/12/21 13:53:30
|
version 1.6, 2011/07/22 07:38:07
|
Line 1
|
Line 1
|
DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) |
DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK ) |
* |
* |
* -- LAPACK routine (version 3.3.0) -- |
* -- LAPACK routine (version 3.3.1) -- |
* |
* |
* -- Contributed by Fred Gustavson of the IBM Watson Research Center -- |
* -- Contributed by Fred Gustavson of the IBM Watson Research Center -- |
* November 2010 |
* -- April 2011 -- |
* |
* |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
Line 193
|
Line 193
|
* |
* |
NOE = 1 |
NOE = 1 |
IF( MOD( N, 2 ).EQ.0 ) |
IF( MOD( N, 2 ).EQ.0 ) |
+ NOE = 0 |
$ NOE = 0 |
* |
* |
* set ifm = 0 when form='T or 't' and 1 otherwise |
* set ifm = 0 when form='T or 't' and 1 otherwise |
* |
* |
IFM = 1 |
IFM = 1 |
IF( LSAME( TRANSR, 'T' ) ) |
IF( LSAME( TRANSR, 'T' ) ) |
+ IFM = 0 |
$ IFM = 0 |
* |
* |
* set ilu = 0 when uplo='U or 'u' and 1 otherwise |
* set ilu = 0 when uplo='U or 'u' and 1 otherwise |
* |
* |
ILU = 1 |
ILU = 1 |
IF( LSAME( UPLO, 'U' ) ) |
IF( LSAME( UPLO, 'U' ) ) |
+ ILU = 0 |
$ ILU = 0 |
* |
* |
* set lda = (n+1)/2 when ifm = 0 |
* set lda = (n+1)/2 when ifm = 0 |
* set lda = n when ifm = 1 and noe = 1 |
* set lda = n when ifm = 1 and noe = 1 |
Line 265
|
Line 265
|
END IF |
END IF |
END IF |
END IF |
ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. |
ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR. |
+ ( NORM.EQ.'1' ) ) THEN |
$ ( NORM.EQ.'1' ) ) THEN |
* |
* |
* Find normI(A) ( = norm1(A), since A is symmetric). |
* Find normI(A) ( = norm1(A), since A is symmetric). |
* |
* |
Line 289
|
Line 289
|
* -> A(j+k,j+k) |
* -> A(j+k,j+k) |
WORK( J+K ) = S + AA |
WORK( J+K ) = S + AA |
IF( I.EQ.K+K ) |
IF( I.EQ.K+K ) |
+ GO TO 10 |
$ GO TO 10 |
I = I + 1 |
I = I + 1 |
AA = ABS( A( I+J*LDA ) ) |
AA = ABS( A( I+J*LDA ) ) |
* -> A(j,j) |
* -> A(j,j) |
Line 724
|
Line 724
|
ELSE |
ELSE |
* A is xpose |
* A is xpose |
IF( ILU.EQ.0 ) THEN |
IF( ILU.EQ.0 ) THEN |
* A' is upper |
* A**T is upper |
DO J = 1, K - 2 |
DO J = 1, K - 2 |
CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) |
CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S ) |
* U at A(0,k) |
* U at A(0,k) |
Line 735
|
Line 735
|
END DO |
END DO |
DO J = 0, K - 2 |
DO J = 0, K - 2 |
CALL DLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1, |
CALL DLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1, |
+ SCALE, S ) |
$ SCALE, S ) |
* L at A(0,k-1) |
* L at A(0,k-1) |
END DO |
END DO |
S = S + S |
S = S + S |
Line 745
|
Line 745
|
CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S ) |
CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S ) |
* tri L at A(0,k-1) |
* tri L at A(0,k-1) |
ELSE |
ELSE |
* A' is lower |
* A**T is lower |
DO J = 1, K - 1 |
DO J = 1, K - 1 |
CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S ) |
CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S ) |
* U at A(0,0) |
* U at A(0,0) |
Line 806
|
Line 806
|
ELSE |
ELSE |
* A is xpose |
* A is xpose |
IF( ILU.EQ.0 ) THEN |
IF( ILU.EQ.0 ) THEN |
* A' is upper |
* A**T is upper |
DO J = 1, K - 1 |
DO J = 1, K - 1 |
CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) |
CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S ) |
* U at A(0,k+1) |
* U at A(0,k+1) |
Line 817
|
Line 817
|
END DO |
END DO |
DO J = 0, K - 2 |
DO J = 0, K - 2 |
CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, |
CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE, |
+ S ) |
$ S ) |
* L at A(0,k) |
* L at A(0,k) |
END DO |
END DO |
S = S + S |
S = S + S |
Line 827
|
Line 827
|
CALL DLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S ) |
CALL DLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S ) |
* tri L at A(0,k) |
* tri L at A(0,k) |
ELSE |
ELSE |
* A' is lower |
* A**T is lower |
DO J = 1, K - 1 |
DO J = 1, K - 1 |
CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) |
CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S ) |
* U at A(0,1) |
* U at A(0,1) |