zgeqp3.f.html

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

            INFO = -8
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.146"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="ZGEQP3.146"></a><a href="zgeqp3.f.html#ZGEQP3.1">ZGEQP3</a>'</span>, -INFO )
         RETURN
      ELSE IF( LQUERY ) THEN
         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( MINMN.EQ.0 ) THEN
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Move initial columns up front.
</span><span class="comment">*</span><span class="comment">
</span>      NFXD = 1
      DO 10 J = 1, N
         IF( JPVT( J ).NE.0 ) THEN
            IF( J.NE.NFXD ) THEN
               CALL ZSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
               JPVT( J ) = JPVT( NFXD )
               JPVT( NFXD ) = J
            ELSE
               JPVT( J ) = J
            END IF
            NFXD = NFXD + 1
         ELSE
            JPVT( J ) = J
         END IF
   10 CONTINUE
      NFXD = NFXD - 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Factorize fixed columns
</span><span class="comment">*</span><span class="comment">     =======================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Compute the QR factorization of fixed columns and update
</span><span class="comment">*</span><span class="comment">     remaining columns.
</span><span class="comment">*</span><span class="comment">
</span>      IF( NFXD.GT.0 ) THEN
         NA = MIN( M, NFXD )
<span class="comment">*</span><span class="comment">CC      CALL <a name="ZGEQR2.185"></a><a href="zgeqr2.f.html#ZGEQR2.1">ZGEQR2</a>( M, NA, A, LDA, TAU, WORK, INFO )
</span>         CALL <a name="ZGEQRF.186"></a><a href="zgeqrf.f.html#ZGEQRF.1">ZGEQRF</a>( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
         IWS = MAX( IWS, INT( WORK( 1 ) ) )
         IF( NA.LT.N ) THEN
<span class="comment">*</span><span class="comment">CC         CALL <a name="ZUNM2R.189"></a><a href="zunm2r.f.html#ZUNM2R.1">ZUNM2R</a>( 'Left', 'Conjugate Transpose', M, N-NA,
</span><span class="comment">*</span><span class="comment">CC  $                   NA, A, LDA, TAU, A( 1, NA+1 ), LDA, WORK,
</span><span class="comment">*</span><span class="comment">CC  $                   INFO )
</span>            CALL <a name="ZUNMQR.192"></a><a href="zunmqr.f.html#ZUNMQR.1">ZUNMQR</a>( <span class="string">'Left'</span>, <span class="string">'Conjugate Transpose'</span>, M, N-NA, NA, A,
     $                   LDA, TAU, A( 1, NA+1 ), LDA, WORK, LWORK,
     $                   INFO )
            IWS = MAX( IWS, INT( WORK( 1 ) ) )
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Factorize free columns
</span><span class="comment">*</span><span class="comment">     ======================
</span><span class="comment">*</span><span class="comment">
</span>      IF( NFXD.LT.MINMN ) THEN
<span class="comment">*</span><span class="comment">
</span>         SM = M - NFXD
         SN = N - NFXD
         SMINMN = MINMN - NFXD
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Determine the block size.
</span><span class="comment">*</span><span class="comment">
</span>         NB = <a name="ILAENV.210"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( INB, <span class="string">'<a name="ZGEQRF.210"></a><a href="zgeqrf.f.html#ZGEQRF.1">ZGEQRF</a>'</span>, <span class="string">' '</span>, SM, SN, -1, -1 )
         NBMIN = 2
         NX = 0
<span class="comment">*</span><span class="comment">
</span>         IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Determine when to cross over from blocked to unblocked code.
</span><span class="comment">*</span><span class="comment">
</span>            NX = MAX( 0, <a name="ILAENV.218"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( IXOVER, <span class="string">'<a name="ZGEQRF.218"></a><a href="zgeqrf.f.html#ZGEQRF.1">ZGEQRF</a>'</span>, <span class="string">' '</span>, SM, SN, -1,
     $           -1 ) )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span>            IF( NX.LT.SMINMN ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Determine if workspace is large enough for blocked code.
</span><span class="comment">*</span><span class="comment">
</span>               MINWS = ( SN+1 )*NB
               IWS = MAX( IWS, MINWS )
               IF( LWORK.LT.MINWS ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 Not enough workspace to use optimal NB: Reduce NB and
</span><span class="comment">*</span><span class="comment">                 determine the minimum value of NB.
</span><span class="comment">*</span><span class="comment">
</span>                  NB = LWORK / ( SN+1 )
                  NBMIN = MAX( 2, <a name="ILAENV.234"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( INBMIN, <span class="string">'<a name="ZGEQRF.234"></a><a href="zgeqrf.f.html#ZGEQRF.1">ZGEQRF</a>'</span>, <span class="string">' '</span>, SM, SN,
     $                    -1, -1 ) )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span>               END IF
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Initialize partial column norms. The first N elements of work
</span><span class="comment">*</span><span class="comment">        store the exact column norms.
</span><span class="comment">*</span><span class="comment">
</span>         DO 20 J = NFXD + 1, N
            RWORK( J ) = DZNRM2( SM, A( NFXD+1, J ), 1 )
            RWORK( N+J ) = RWORK( J )
   20    CONTINUE
<span class="comment">*</span><span class="comment">
</span>         IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
     $       ( NX.LT.SMINMN ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Use blocked code initially.
</span><span class="comment">*</span><span class="comment">
</span>            J = NFXD + 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Compute factorization: while loop.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span>            TOPBMN = MINMN - NX
   30       CONTINUE
            IF( J.LE.TOPBMN ) THEN
               JB = MIN( NB, TOPBMN-J+1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Factorize JB columns among columns J:N.
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="ZLAQPS.267"></a><a href="zlaqps.f.html#ZLAQPS.1">ZLAQPS</a>( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
     $                      JPVT( J ), TAU( J ), RWORK( J ),
     $                      RWORK( N+J ), WORK( 1 ), WORK( JB+1 ),
     $                      N-J+1 )
<span class="comment">*</span><span class="comment">
</span>               J = J + FJB
               GO TO 30
            END IF
         ELSE
            J = NFXD + 1
         END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Use unblocked code to factor the last or only block.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">
</span>         IF( J.LE.MINMN )
     $      CALL <a name="ZLAQP2.283"></a><a href="zlaqp2.f.html#ZLAQP2.1">ZLAQP2</a>( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
     $                   TAU( J ), RWORK( J ), RWORK( N+J ), WORK( 1 ) )
<span class="comment">*</span><span class="comment">
</span>      END IF
<span class="comment">*</span><span class="comment">
</span>      WORK( 1 ) = IWS
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZGEQP3.291"></a><a href="zgeqp3.f.html#ZGEQP3.1">ZGEQP3</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>