dorgqr.f.html

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

      ELSE IF( K.LT.0 .OR. K.GT.N ) THEN
         INFO = -3
      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
         INFO = -5
      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
         INFO = -8
      END IF
      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.111"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="DORGQR.111"></a><a href="dorgqr.f.html#DORGQR.1">DORGQR</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( N.LE.0 ) THEN
         WORK( 1 ) = 1
         RETURN
      END IF
<span class="comment">*</span><span class="comment">
</span>      NBMIN = 2
      NX = 0
      IWS = N
      IF( NB.GT.1 .AND. NB.LT.K ) 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.131"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( 3, <span class="string">'<a name="DORGQR.131"></a><a href="dorgqr.f.html#DORGQR.1">DORGQR</a>'</span>, <span class="string">' '</span>, M, N, K, -1 ) )
         IF( NX.LT.K ) 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>            LDWORK = N
            IWS = LDWORK*NB
            IF( LWORK.LT.IWS ) 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 / LDWORK
               NBMIN = MAX( 2, <a name="ILAENV.144"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( 2, <span class="string">'<a name="DORGQR.144"></a><a href="dorgqr.f.html#DORGQR.1">DORGQR</a>'</span>, <span class="string">' '</span>, M, N, K, -1 ) )
            END IF
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Use blocked code after the last block.
</span><span class="comment">*</span><span class="comment">        The first kk columns are handled by the block method.
</span><span class="comment">*</span><span class="comment">
</span>         KI = ( ( K-NX-1 ) / NB )*NB
         KK = MIN( K, KI+NB )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Set A(1:kk,kk+1:n) to zero.
</span><span class="comment">*</span><span class="comment">
</span>         DO 20 J = KK + 1, N
            DO 10 I = 1, KK
               A( I, J ) = ZERO
   10       CONTINUE
   20    CONTINUE
      ELSE
         KK = 0
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Use unblocked code for the last or only block.
</span><span class="comment">*</span><span class="comment">
</span>      IF( KK.LT.N )
     $   CALL <a name="DORG2R.171"></a><a href="dorg2r.f.html#DORG2R.1">DORG2R</a>( M-KK, N-KK, K-KK, A( KK+1, KK+1 ), LDA,
     $                TAU( KK+1 ), WORK, IINFO )
<span class="comment">*</span><span class="comment">
</span>      IF( KK.GT.0 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Use blocked code
</span><span class="comment">*</span><span class="comment">
</span>         DO 50 I = KI + 1, 1, -NB
            IB = MIN( NB, K-I+1 )
            IF( I+IB.LE.N ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Form the triangular factor of the block reflector
</span><span class="comment">*</span><span class="comment">              H = H(i) H(i+1) . . . H(i+ib-1)
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="DLARFT.185"></a><a href="dlarft.f.html#DLARFT.1">DLARFT</a>( <span class="string">'Forward'</span>, <span class="string">'Columnwise'</span>, M-I+1, IB,
     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Apply H to A(i:m,i+ib:n) from the left
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="DLARFB.190"></a><a href="dlarfb.f.html#DLARFB.1">DLARFB</a>( <span class="string">'Left'</span>, <span class="string">'No transpose'</span>, <span class="string">'Forward'</span>,
     $                      <span class="string">'Columnwise'</span>, M-I+1, N-I-IB+1, IB,
     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
     $                      LDA, WORK( IB+1 ), LDWORK )
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply H to rows i:m of current block
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="DORG2R.198"></a><a href="dorg2r.f.html#DORG2R.1">DORG2R</a>( M-I+1, IB, IB, A( I, I ), LDA, TAU( I ), WORK,
     $                   IINFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Set rows 1:i-1 of current block to zero
</span><span class="comment">*</span><span class="comment">
</span>            DO 40 J = I, I + IB - 1
               DO 30 L = 1, I - 1
                  A( L, J ) = ZERO
   30          CONTINUE
   40       CONTINUE
   50    CONTINUE
      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="DORGQR.214"></a><a href="dorgqr.f.html#DORGQR.1">DORGQR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>