diff options
Diffstat (limited to 'SRC/dsytri2x.f')
| -rw-r--r-- | SRC/dsytri2x.f | 68 |
1 files changed, 34 insertions, 34 deletions
diff --git a/SRC/dsytri2x.f b/SRC/dsytri2x.f index a2474d8b..7800a5f4 100644 --- a/SRC/dsytri2x.f +++ b/SRC/dsytri2x.f @@ -2,24 +2,24 @@ * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download DSYTRI2X + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri2x.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri2x.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri2x.f"> +*> Download DSYTRI2X + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytri2x.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytri2x.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytri2x.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER INFO, LDA, N, NB @@ -28,7 +28,7 @@ * INTEGER IPIV( * ) * DOUBLE PRECISION A( LDA, * ), WORK( N+NB+1,* ) * .. -* +* * *> \par Purpose: * ============= @@ -108,10 +108,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date November 2011 * @@ -212,7 +212,7 @@ INFO = 0 * * Splitting Workspace -* U01 is a block (N,NB+1) +* U01 is a block (N,NB+1) * The first element of U01 is in WORK(1,1) * U11 is a block (NB+1,NB+1) * The first element of U11 is in WORK(N+1,1) @@ -228,7 +228,7 @@ CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO ) * * inv(D) and inv(D)*inv(U) -* +* K=1 DO WHILE ( K .LE. N ) IF( IPIV( K ).GT.0 ) THEN @@ -245,8 +245,8 @@ D = T*( AK*AKP1-ONE ) WORK(K,INVD) = AKP1 / D WORK(K+1,INVD+1) = AK / D - WORK(K,INVD+1) = -AKKP1 / D - WORK(K+1,INVD) = -AKKP1 / D + WORK(K,INVD+1) = -AKKP1 / D + WORK(K+1,INVD) = -AKKP1 / D K=K+2 END IF END DO @@ -262,7 +262,7 @@ NNB=CUT ELSE COUNT = 0 -* count negative elements, +* count negative elements, DO I=CUT+1-NNB,CUT IF (IPIV(I) .LT. 0) COUNT=COUNT+1 END DO @@ -272,7 +272,7 @@ CUT=CUT-NNB * -* U01 Block +* U01 Block * DO I=1,CUT DO J=1,NNB @@ -335,7 +335,7 @@ I=I+2 END IF END DO -* +* * U11**T*invD1*U11->U11 * CALL DTRMM('L','U','T','U',NNB, NNB, @@ -345,13 +345,13 @@ DO J=I,NNB A(CUT+I,CUT+J)=WORK(U11+I,J) END DO - END DO + END DO * * U01**T*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, WORK(U11+1,1), N+NB+1) - + * * U11 = U11**T*invD1*U11 + U01**T*invD*U01 * @@ -380,7 +380,7 @@ END DO * * Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T -* +* I=1 DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN @@ -390,9 +390,9 @@ ELSE IP=-IPIV(I) I=I+1 - IF ( (I-1) .LT. IP) + IF ( (I-1) .LT. IP) $ CALL DSYSWAPR( UPLO, N, A, LDA, I-1 ,IP ) - IF ( (I-1) .GT. IP) + IF ( (I-1) .GT. IP) $ CALL DSYSWAPR( UPLO, N, A, LDA, IP ,I-1 ) ENDIF I=I+1 @@ -406,7 +406,7 @@ CALL DTRTRI( UPLO, 'U', N, A, LDA, INFO ) * * inv(D) and inv(D)*inv(U) -* +* K=N DO WHILE ( K .GE. 1 ) IF( IPIV( K ).GT.0 ) THEN @@ -423,8 +423,8 @@ D = T*( AK*AKP1-ONE ) WORK(K-1,INVD) = AKP1 / D WORK(K,INVD) = AK / D - WORK(K,INVD+1) = -AKKP1 / D - WORK(K-1,INVD+1) = -AKKP1 / D + WORK(K,INVD+1) = -AKKP1 / D + WORK(K-1,INVD+1) = -AKKP1 / D K=K-2 END IF END DO @@ -440,7 +440,7 @@ NNB=N-CUT ELSE COUNT = 0 -* count negative elements, +* count negative elements, DO I=CUT+1,CUT+NNB IF (IPIV(I) .LT. 0) COUNT=COUNT+1 END DO @@ -507,7 +507,7 @@ I=I-2 END IF END DO -* +* * L11**T*invD1*L11->L11 * CALL DTRMM('L',UPLO,'T','U',NNB, NNB, @@ -526,7 +526,7 @@ * CALL DGEMM('T','N',NNB,NNB,N-NNB-CUT,ONE,A(CUT+NNB+1,CUT+1) $ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1) - + * * L11 = L11**T*invD1*L11 + U01**T*invD*U01 * @@ -566,7 +566,7 @@ END DO * * Apply PERMUTATIONS P and P**T: P * inv(U**T)*inv(D)*inv(U) *P**T -* +* I=N DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN |