zsytf2.f.html

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

</span><span class="comment">*</span><span class="comment">        Factorize A as L*D*L' using the lower triangle of A
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        K is the main loop index, increasing from 1 to N in steps of
</span><span class="comment">*</span><span class="comment">        1 or 2
</span><span class="comment">*</span><span class="comment">
</span>         K = 1
   40    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        If K &gt; N, exit from loop
</span><span class="comment">*</span><span class="comment">
</span>         IF( K.GT.N )
     $      GO TO 70
         KSTEP = 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Determine rows and columns to be interchanged and whether
</span><span class="comment">*</span><span class="comment">        a 1-by-1 or 2-by-2 pivot block will be used
</span><span class="comment">*</span><span class="comment">
</span>         ABSAKK = CABS1( A( K, K ) )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        IMAX is the row-index of the largest off-diagonal element in
</span><span class="comment">*</span><span class="comment">        column K, and COLMAX is its absolute value
</span><span class="comment">*</span><span class="comment">
</span>         IF( K.LT.N ) THEN
            IMAX = K + IZAMAX( N-K, A( K+1, K ), 1 )
            COLMAX = CABS1( A( IMAX, K ) )
         ELSE
            COLMAX = ZERO
         END IF
<span class="comment">*</span><span class="comment">
</span>         IF( MAX( ABSAKK, COLMAX ).EQ.ZERO .OR. <a name="DISNAN.377"></a><a href="disnan.f.html#DISNAN.1">DISNAN</a>(ABSAKK) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Column K is zero or contains a NaN: set INFO and continue
</span><span class="comment">*</span><span class="comment">
</span>            IF( INFO.EQ.0 )
     $         INFO = K
            KP = K
         ELSE
            IF( ABSAKK.GE.ALPHA*COLMAX ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              no interchange, use 1-by-1 pivot block
</span><span class="comment">*</span><span class="comment">
</span>               KP = K
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              JMAX is the column-index of the largest off-diagonal
</span><span class="comment">*</span><span class="comment">              element in row IMAX, and ROWMAX is its absolute value
</span><span class="comment">*</span><span class="comment">
</span>               JMAX = K - 1 + IZAMAX( IMAX-K, A( IMAX, K ), LDA )
               ROWMAX = CABS1( A( IMAX, JMAX ) )
               IF( IMAX.LT.N ) THEN
                  JMAX = IMAX + IZAMAX( N-IMAX, A( IMAX+1, IMAX ), 1 )
                  ROWMAX = MAX( ROWMAX, CABS1( A( JMAX, IMAX ) ) )
               END IF
<span class="comment">*</span><span class="comment">
</span>               IF( ABSAKK.GE.ALPHA*COLMAX*( COLMAX / ROWMAX ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 no interchange, use 1-by-1 pivot block
</span><span class="comment">*</span><span class="comment">
</span>                  KP = K
               ELSE IF( CABS1( A( IMAX, IMAX ) ).GE.ALPHA*ROWMAX ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 interchange rows and columns K and IMAX, use 1-by-1
</span><span class="comment">*</span><span class="comment">                 pivot block
</span><span class="comment">*</span><span class="comment">
</span>                  KP = IMAX
               ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 interchange rows and columns K+1 and IMAX, use 2-by-2
</span><span class="comment">*</span><span class="comment">                 pivot block
</span><span class="comment">*</span><span class="comment">
</span>                  KP = IMAX
                  KSTEP = 2
               END IF
            END IF
<span class="comment">*</span><span class="comment">
</span>            KK = K + KSTEP - 1
            IF( KP.NE.KK ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Interchange rows and columns KK and KP in the trailing
</span><span class="comment">*</span><span class="comment">              submatrix A(k:n,k:n)
</span><span class="comment">*</span><span class="comment">
</span>               IF( KP.LT.N )
     $            CALL ZSWAP( N-KP, A( KP+1, KK ), 1, A( KP+1, KP ), 1 )
               CALL ZSWAP( KP-KK-1, A( KK+1, KK ), 1, A( KP, KK+1 ),
     $                     LDA )
               T = A( KK, KK )
               A( KK, KK ) = A( KP, KP )
               A( KP, KP ) = T
               IF( KSTEP.EQ.2 ) THEN
                  T = A( K+1, K )
                  A( K+1, K ) = A( KP, K )
                  A( KP, K ) = T
               END IF
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Update the trailing submatrix
</span><span class="comment">*</span><span class="comment">
</span>            IF( KSTEP.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              1-by-1 pivot block D(k): column k now holds
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W(k) = L(k)*D(k)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              where L(k) is the k-th column of L
</span><span class="comment">*</span><span class="comment">
</span>               IF( K.LT.N ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Perform a rank-1 update of A(k+1:n,k+1:n) as
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 A := A - L(k)*D(k)*L(k)' = A - W(k)*(1/D(k))*W(k)'
</span><span class="comment">*</span><span class="comment">
</span>                  R1 = CONE / A( K, K )
                  CALL <a name="ZSYR.460"></a><a href="zsyr.f.html#ZSYR.1">ZSYR</a>( UPLO, N-K, -R1, A( K+1, K ), 1,
     $                       A( K+1, K+1 ), LDA )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Store L(k) in column K
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZSCAL( N-K, R1, A( K+1, K ), 1 )
               END IF
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              2-by-2 pivot block D(k)
</span><span class="comment">*</span><span class="comment">
</span>               IF( K.LT.N-1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Perform a rank-2 update of A(k+2:n,k+2:n) as
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 A := A - ( L(k) L(k+1) )*D(k)*( L(k) L(k+1) )'
</span><span class="comment">*</span><span class="comment">                    = A - ( W(k) W(k+1) )*inv(D(k))*( W(k) W(k+1) )'
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 where L(k) and L(k+1) are the k-th and (k+1)-th
</span><span class="comment">*</span><span class="comment">                 columns of L
</span><span class="comment">*</span><span class="comment">
</span>                  D21 = A( K+1, K )
                  D11 = A( K+1, K+1 ) / D21
                  D22 = A( K, K ) / D21
                  T = CONE / ( D11*D22-CONE )
                  D21 = T / D21
<span class="comment">*</span><span class="comment">
</span>                  DO 60 J = K + 2, N
                     WK = D21*( D11*A( J, K )-A( J, K+1 ) )
                     WKP1 = D21*( D22*A( J, K+1 )-A( J, K ) )
                     DO 50 I = J, N
                        A( I, J ) = A( I, J ) - A( I, K )*WK -
     $                              A( I, K+1 )*WKP1
   50                CONTINUE
                     A( J, K ) = WK
                     A( J, K+1 ) = WKP1
   60             CONTINUE
               END IF
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Store details of the interchanges in IPIV
</span><span class="comment">*</span><span class="comment">
</span>         IF( KSTEP.EQ.1 ) THEN
            IPIV( K ) = KP
         ELSE
            IPIV( K ) = -KP
            IPIV( K+1 ) = -KP
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Increase K and return to the start of the main loop
</span><span class="comment">*</span><span class="comment">
</span>         K = K + KSTEP
         GO TO 40
<span class="comment">*</span><span class="comment">
</span>      END IF
<span class="comment">*</span><span class="comment">
</span>   70 CONTINUE
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZSYTF2.520"></a><a href="zsytf2.f.html#ZSYTF2.1">ZSYTF2</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>