[BACK]Return to zhetrs_aa.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zhetrs_aa.f between versions 1.4 and 1.5

version 1.4, 2018/05/29 07:18:21 version 1.5, 2020/05/21 21:46:06
Line 38 Line 38
 *> \verbatim  *> \verbatim
 *>  *>
 *> ZHETRS_AA solves a system of linear equations A*X = B with a complex  *> ZHETRS_AA solves a system of linear equations A*X = B with a complex
 *> hermitian matrix A using the factorization A = U*T*U**H or  *> hermitian matrix A using the factorization A = U**H*T*U or
 *> A = L*T*L**T computed by ZHETRF_AA.  *> A = L*T*L**H computed by ZHETRF_AA.
 *> \endverbatim  *> \endverbatim
 *  *
 *  Arguments:  *  Arguments:
Line 50 Line 50
 *>          UPLO is CHARACTER*1  *>          UPLO is CHARACTER*1
 *>          Specifies whether the details of the factorization are stored  *>          Specifies whether the details of the factorization are stored
 *>          as an upper or lower triangular matrix.  *>          as an upper or lower triangular matrix.
 *>          = 'U':  Upper triangular, form is A = U*T*U**H;  *>          = 'U':  Upper triangular, form is A = U**H*T*U;
 *>          = 'L':  Lower triangular, form is A = L*T*L**H.  *>          = 'L':  Lower triangular, form is A = L*T*L**H.
 *> \endverbatim  *> \endverbatim
 *>  *>
Line 98 Line 98
 *>          The leading dimension of the array B.  LDB >= max(1,N).  *>          The leading dimension of the array B.  LDB >= max(1,N).
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] WORK  *> \param[out] WORK
 *> \verbatim  *> \verbatim
 *>          WORK is DOUBLE array, dimension (MAX(1,LWORK))  *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] LWORK  *> \param[in] LWORK
 *> \verbatim  *> \verbatim
 *>          LWORK is INTEGER, LWORK >= MAX(1,3*N-2).  *>          LWORK is INTEGER
   *>          The dimension of the array WORK. LWORK >= max(1,3*N-2).
   *> \endverbatim
 *>  *>
 *> \param[out] INFO  *> \param[out] INFO
 *> \verbatim  *> \verbatim
Line 199 Line 201
 *  *
       IF( UPPER ) THEN        IF( UPPER ) THEN
 *  *
 *        Solve A*X = B, where A = U*T*U**T.  *        Solve A*X = B, where A = U**H*T*U.
 *  *
 *        Pivot, P**T * B  *        1) Forward substitution with U**H
 *  *
          DO K = 1, N           IF( N.GT.1 ) THEN
             KP = IPIV( K )  
             IF( KP.NE.K )  
      $          CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )  
          END DO  
 *  *
 *        Compute (U \P**T * B) -> B    [ (U \P**T * B) ]  *           Pivot, P**T * B -> B
 *  *
          CALL ZTRSM('L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,              DO K = 1, N
      $               B( 2, 1 ), LDB)                 KP = IPIV( K )
                  IF( KP.NE.K )
        $            CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
               END DO
 *  *
 *        Compute T \ B -> B   [ T \ (U \P**T * B) ]  *           Compute U**H \ B -> B    [ (U**H \P**T * B) ]
 *  *
          CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1)              CALL ZTRSM( 'L', 'U', 'C', 'U', N-1, NRHS, ONE, A( 1, 2 ),
        $                  LDA, B( 2, 1 ), LDB )
            END IF
   *
   *        2) Solve with triangular matrix T
   *
   *        Compute T \ B -> B   [ T \ (U**H \P**T * B) ]
   *
            CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1 )
          IF( N.GT.1 ) THEN           IF( N.GT.1 ) THEN
              CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)               CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1)
              CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1)               CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 1 ), 1 )
              CALL ZLACGV( N-1, WORK( 1 ), 1 )               CALL ZLACGV( N-1, WORK( 1 ), 1 )
          END IF           END IF
          CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,           CALL ZGTSV( N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
      $              INFO)       $               INFO )
   *
   *        3) Backward substitution with U
   *
            IF( N.GT.1 ) THEN
 *  *
 *        Compute (U**T \ B) -> B   [ U**T \ (T \ (U \P**T * B) ) ]  *           Compute U \ B -> B   [ U \ (T \ (U**H \P**T * B) ) ]
 *  *
          CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA,              CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ),
      $               B(2, 1), LDB)       $                  LDA, B(2, 1), LDB)
 *  *
 *        Pivot, P * B  [ P * (U**T \ (T \ (U \P**T * B) )) ]  *           Pivot, P * B  [ P * (U**H \ (T \ (U \P**T * B) )) ]
 *  *
          DO K = N, 1, -1              DO K = N, 1, -1
             KP = IPIV( K )                 KP = IPIV( K )
             IF( KP.NE.K )                 IF( KP.NE.K )
      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )       $            CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
          END DO              END DO
            END IF
 *  *
       ELSE        ELSE
 *  *
 *        Solve A*X = B, where A = L*T*L**T.  *        Solve A*X = B, where A = L*T*L**H.
   *
   *        1) Forward substitution with L
 *  *
 *        Pivot, P**T * B           IF( N.GT.1 ) THEN
   *
   *           Pivot, P**T * B -> B
 *  *
          DO K = 1, N              DO K = 1, N
             KP = IPIV( K )                 KP = IPIV( K )
             IF( KP.NE.K )                 IF( KP.NE.K )
      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )       $            CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
          END DO              END DO
 *  *
 *        Compute (L \P**T * B) -> B    [ (L \P**T * B) ]  *           Compute L \ B -> B    [ (L \P**T * B) ]
 *  *
          CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,              CALL ZTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1 ),
      $               B(2, 1), LDB)       $                  LDA, B(2, 1), LDB)
            END IF
   *
   *        2) Solve with triangular matrix T
 *  *
 *        Compute T \ B -> B   [ T \ (L \P**T * B) ]  *        Compute T \ B -> B   [ T \ (L \P**T * B) ]
 *  *
Line 266 Line 287
          CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,           CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB,
      $              INFO)       $              INFO)
 *  *
 *        Compute (L**T \ B) -> B   [ L**T \ (T \ (L \P**T * B) ) ]  *        3) Backward substitution with L**H
   *
            IF( N.GT.1 ) THEN
 *  *
          CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA,  *           Compute L**H \ B -> B   [ L**H \ (T \ (L \P**T * B) ) ]
      $              B( 2, 1 ), LDB)  
 *  *
 *        Pivot, P * B  [ P * (L**T \ (T \ (L \P**T * B) )) ]              CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ),
        $                  LDA, B( 2, 1 ), LDB)
 *  *
          DO K = N, 1, -1  *           Pivot, P * B  [ P * (L**H \ (T \ (L \P**T * B) )) ]
             KP = IPIV( K )  *
             IF( KP.NE.K )              DO K = N, 1, -1
      $         CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )                 KP = IPIV( K )
          END DO                 IF( KP.NE.K )
        $            CALL ZSWAP( NRHS, B( K, 1 ), LDB, B( KP, 1 ), LDB )
               END DO
            END IF
 *  *
       END IF        END IF
 *  *
Removed from v.1.4  
changed lines
  Added in v.1.5

CVSweb interface <joel.bertrand@systella.fr>