zgtts2.f.html

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

<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve U*x = b.
</span><span class="comment">*</span><span class="comment">
</span>               B( N, J ) = B( N, J ) / D( N )
               IF( N.GT.1 )
     $            B( N-1, J ) = ( B( N-1, J )-DU( N-1 )*B( N, J ) ) /
     $                          D( N-1 )
               DO 50 I = N - 2, 1, -1
                  B( I, J ) = ( B( I, J )-DU( I )*B( I+1, J )-DU2( I )*
     $                        B( I+2, J ) ) / D( I )
   50          CONTINUE
   60       CONTINUE
         END IF
      ELSE IF( ITRANS.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Solve A**T * X = B.
</span><span class="comment">*</span><span class="comment">
</span>         IF( NRHS.LE.1 ) THEN
            J = 1
   70       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve U**T * x = b.
</span><span class="comment">*</span><span class="comment">
</span>            B( 1, J ) = B( 1, J ) / D( 1 )
            IF( N.GT.1 )
     $         B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
            DO 80 I = 3, N
               B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-DU2( I-2 )*
     $                     B( I-2, J ) ) / D( I )
   80       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve L**T * x = b.
</span><span class="comment">*</span><span class="comment">
</span>            DO 90 I = N - 1, 1, -1
               IF( IPIV( I ).EQ.I ) THEN
                  B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
               ELSE
                  TEMP = B( I+1, J )
                  B( I+1, J ) = B( I, J ) - DL( I )*TEMP
                  B( I, J ) = TEMP
               END IF
   90       CONTINUE
            IF( J.LT.NRHS ) THEN
               J = J + 1
               GO TO 70
            END IF
         ELSE
            DO 120 J = 1, NRHS
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve U**T * x = b.
</span><span class="comment">*</span><span class="comment">
</span>               B( 1, J ) = B( 1, J ) / D( 1 )
               IF( N.GT.1 )
     $            B( 2, J ) = ( B( 2, J )-DU( 1 )*B( 1, J ) ) / D( 2 )
               DO 100 I = 3, N
                  B( I, J ) = ( B( I, J )-DU( I-1 )*B( I-1, J )-
     $                        DU2( I-2 )*B( I-2, J ) ) / D( I )
  100          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve L**T * x = b.
</span><span class="comment">*</span><span class="comment">
</span>               DO 110 I = N - 1, 1, -1
                  IF( IPIV( I ).EQ.I ) THEN
                     B( I, J ) = B( I, J ) - DL( I )*B( I+1, J )
                  ELSE
                     TEMP = B( I+1, J )
                     B( I+1, J ) = B( I, J ) - DL( I )*TEMP
                     B( I, J ) = TEMP
                  END IF
  110          CONTINUE
  120       CONTINUE
         END IF
      ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Solve A**H * X = B.
</span><span class="comment">*</span><span class="comment">
</span>         IF( NRHS.LE.1 ) THEN
            J = 1
  130       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve U**H * x = b.
</span><span class="comment">*</span><span class="comment">
</span>            B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
            IF( N.GT.1 )
     $         B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) ) /
     $                     DCONJG( D( 2 ) )
            DO 140 I = 3, N
               B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*B( I-1, J )-
     $                     DCONJG( DU2( I-2 ) )*B( I-2, J ) ) /
     $                     DCONJG( D( I ) )
  140       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve L**H * x = b.
</span><span class="comment">*</span><span class="comment">
</span>            DO 150 I = N - 1, 1, -1
               IF( IPIV( I ).EQ.I ) THEN
                  B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*B( I+1, J )
               ELSE
                  TEMP = B( I+1, J )
                  B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
                  B( I, J ) = TEMP
               END IF
  150       CONTINUE
            IF( J.LT.NRHS ) THEN
               J = J + 1
               GO TO 130
            END IF
         ELSE
            DO 180 J = 1, NRHS
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve U**H * x = b.
</span><span class="comment">*</span><span class="comment">
</span>               B( 1, J ) = B( 1, J ) / DCONJG( D( 1 ) )
               IF( N.GT.1 )
     $            B( 2, J ) = ( B( 2, J )-DCONJG( DU( 1 ) )*B( 1, J ) )
     $                         / DCONJG( D( 2 ) )
               DO 160 I = 3, N
                  B( I, J ) = ( B( I, J )-DCONJG( DU( I-1 ) )*
     $                        B( I-1, J )-DCONJG( DU2( I-2 ) )*
     $                        B( I-2, J ) ) / DCONJG( D( I ) )
  160          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Solve L**H * x = b.
</span><span class="comment">*</span><span class="comment">
</span>               DO 170 I = N - 1, 1, -1
                  IF( IPIV( I ).EQ.I ) THEN
                     B( I, J ) = B( I, J ) - DCONJG( DL( I ) )*
     $                           B( I+1, J )
                  ELSE
                     TEMP = B( I+1, J )
                     B( I+1, J ) = B( I, J ) - DCONJG( DL( I ) )*TEMP
                     B( I, J ) = TEMP
                  END IF
  170          CONTINUE
  180       CONTINUE
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZGTTS2.269"></a><a href="zgtts2.f.html#ZGTTS2.1">ZGTTS2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>