chpgv.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 221 行 · 第 1/2 页

</span><span class="comment">*</span><span class="comment">                    The factorization of B could not be completed and
</span><span class="comment">*</span><span class="comment">                    no eigenvalues or eigenvectors were computed.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      LOGICAL            UPPER, WANTZ
      CHARACTER          TRANS
      INTEGER            J, NEIG
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      LOGICAL            <a name="LSAME.104"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
      EXTERNAL           <a name="LSAME.105"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           <a name="CHPEV.108"></a><a href="chpev.f.html#CHPEV.1">CHPEV</a>, <a name="CHPGST.108"></a><a href="chpgst.f.html#CHPGST.1">CHPGST</a>, <a name="CPPTRF.108"></a><a href="cpptrf.f.html#CPPTRF.1">CPPTRF</a>, CTPMV, CTPSV, <a name="XERBLA.108"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Test the input parameters.
</span><span class="comment">*</span><span class="comment">
</span>      WANTZ = <a name="LSAME.114"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBZ, <span class="string">'V'</span> )
      UPPER = <a name="LSAME.115"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> )
<span class="comment">*</span><span class="comment">
</span>      INFO = 0
      IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
         INFO = -1
      ELSE IF( .NOT.( WANTZ .OR. <a name="LSAME.120"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBZ, <span class="string">'N'</span> ) ) ) THEN
         INFO = -2
      ELSE IF( .NOT.( UPPER .OR. <a name="LSAME.122"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'L'</span> ) ) ) THEN
         INFO = -3
      ELSE IF( N.LT.0 ) THEN
         INFO = -4
      ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
         INFO = -9
      END IF
      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.130"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="CHPGV.130"></a><a href="chpgv.f.html#CHPGV.1">CHPGV</a> '</span>, -INFO )
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Quick return if possible
</span><span class="comment">*</span><span class="comment">
</span>      IF( N.EQ.0 )
     $   RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Form a Cholesky factorization of B.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="CPPTRF.141"></a><a href="cpptrf.f.html#CPPTRF.1">CPPTRF</a>( UPLO, N, BP, INFO )
      IF( INFO.NE.0 ) THEN
         INFO = N + INFO
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Transform problem to standard eigenvalue problem and solve.
</span><span class="comment">*</span><span class="comment">
</span>      CALL <a name="CHPGST.149"></a><a href="chpgst.f.html#CHPGST.1">CHPGST</a>( ITYPE, UPLO, N, AP, BP, INFO )
      CALL <a name="CHPEV.150"></a><a href="chpev.f.html#CHPEV.1">CHPEV</a>( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO )
<span class="comment">*</span><span class="comment">
</span>      IF( WANTZ ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Backtransform eigenvectors to the original problem.
</span><span class="comment">*</span><span class="comment">
</span>         NEIG = N
         IF( INFO.GT.0 )
     $      NEIG = INFO - 1
         IF( ITYPE.EQ.1 .OR. ITYPE.EQ.2 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           For A*x=(lambda)*B*x and A*B*x=(lambda)*x;
</span><span class="comment">*</span><span class="comment">           backtransform eigenvectors: x = inv(L)'*y or inv(U)*y
</span><span class="comment">*</span><span class="comment">
</span>            IF( UPPER ) THEN
               TRANS = <span class="string">'N'</span>
            ELSE
               TRANS = <span class="string">'C'</span>
            END IF
<span class="comment">*</span><span class="comment">
</span>            DO 10 J = 1, NEIG
               CALL CTPSV( UPLO, TRANS, <span class="string">'Non-unit'</span>, N, BP, Z( 1, J ),
     $                     1 )
   10       CONTINUE
<span class="comment">*</span><span class="comment">
</span>         ELSE IF( ITYPE.EQ.3 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           For B*A*x=(lambda)*x;
</span><span class="comment">*</span><span class="comment">           backtransform eigenvectors: x = L*y or U'*y
</span><span class="comment">*</span><span class="comment">
</span>            IF( UPPER ) THEN
               TRANS = <span class="string">'C'</span>
            ELSE
               TRANS = <span class="string">'N'</span>
            END IF
<span class="comment">*</span><span class="comment">
</span>            DO 20 J = 1, NEIG
               CALL CTPMV( UPLO, TRANS, <span class="string">'Non-unit'</span>, N, BP, Z( 1, J ),
     $                     1 )
   20       CONTINUE
         END IF
      END IF
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="CHPGV.194"></a><a href="chpgv.f.html#CHPGV.1">CHPGV</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>