diff options
Diffstat (limited to 'SRC/chetri2x.f')
| -rw-r--r-- | SRC/chetri2x.f | 60 |
1 files changed, 30 insertions, 30 deletions
diff --git a/SRC/chetri2x.f b/SRC/chetri2x.f index 68163fc4..01f03d5f 100644 --- a/SRC/chetri2x.f +++ b/SRC/chetri2x.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 CHETRI2X + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetri2x.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetri2x.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetri2x.f"> +*> Download CHETRI2X + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetri2x.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetri2x.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetri2x.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER INFO, LDA, N, NB @@ -28,7 +28,7 @@ * INTEGER IPIV( * ) * COMPLEX 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 2015 * @@ -215,7 +215,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) @@ -231,7 +231,7 @@ CALL CTRTRI( 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 @@ -248,7 +248,7 @@ 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,INVD+1) = -AKKP1 / D WORK(K+1,INVD) = CONJG (WORK(K,INVD+1) ) K=K+2 END IF @@ -265,7 +265,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 @@ -275,7 +275,7 @@ CUT=CUT-NNB * -* U01 Block +* U01 Block * DO I=1,CUT DO J=1,NNB @@ -338,7 +338,7 @@ I=I+2 END IF END DO -* +* * U11**H*invD1*U11->U11 * CALL CTRMM('L','U','C','U',NNB, NNB, @@ -382,7 +382,7 @@ END DO * * Apply PERMUTATIONS P and P**H: P * inv(U**H)*inv(D)*inv(U) *P**H -* +* I=1 DO WHILE ( I .LE. N ) IF( IPIV(I) .GT. 0 ) THEN @@ -392,9 +392,9 @@ ELSE IP=-IPIV(I) I=I+1 - IF ( (I-1) .LT. IP) + IF ( (I-1) .LT. IP) $ CALL CHESWAPR( UPLO, N, A, LDA, I-1 ,IP ) - IF ( (I-1) .GT. IP) + IF ( (I-1) .GT. IP) $ CALL CHESWAPR( UPLO, N, A, LDA, IP ,I-1 ) ENDIF I=I+1 @@ -408,7 +408,7 @@ CALL CTRTRI( 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 @@ -425,7 +425,7 @@ D = T*( AK*AKP1-ONE ) WORK(K-1,INVD) = AKP1 / D WORK(K,INVD) = AK / D - WORK(K,INVD+1) = -AKKP1 / D + WORK(K,INVD+1) = -AKKP1 / D WORK(K-1,INVD+1) = CONJG (WORK(K,INVD+1) ) K=K-2 END IF @@ -442,7 +442,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 @@ -509,7 +509,7 @@ I=I-2 END IF END DO -* +* * L11**H*invD1*L11->L11 * CALL CTRMM('L',UPLO,'C','U',NNB, NNB, @@ -527,7 +527,7 @@ * CALL CGEMM('C','N',NNB,NNB,N-NNB-CUT,CONE,A(CUT+NNB+1,CUT+1) $ ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1) - + * * L11 = L11**H*invD1*L11 + U01**H*invD*U01 * @@ -565,7 +565,7 @@ END DO * * Apply PERMUTATIONS P and P**H: P * inv(U**H)*inv(D)*inv(U) *P**H -* +* I=N DO WHILE ( I .GE. 1 ) IF( IPIV(I) .GT. 0 ) THEN |