zupmtr.f.html

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

         INFO = -4
      ELSE IF( N.LT.0 ) THEN
         INFO = -5
      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
         INFO = -9
      END IF
      IF( INFO.NE.0 ) THEN
         CALL <a name="XERBLA.135"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="ZUPMTR.135"></a><a href="zupmtr.f.html#ZUPMTR.1">ZUPMTR</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( M.EQ.0 .OR. N.EQ.0 )
     $   RETURN
<span class="comment">*</span><span class="comment">
</span>      IF( UPPER ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Q was determined by a call to <a name="ZHPTRD.146"></a><a href="zhptrd.f.html#ZHPTRD.1">ZHPTRD</a> with UPLO = 'U'
</span><span class="comment">*</span><span class="comment">
</span>         FORWRD = ( LEFT .AND. NOTRAN ) .OR.
     $            ( .NOT.LEFT .AND. .NOT.NOTRAN )
<span class="comment">*</span><span class="comment">
</span>         IF( FORWRD ) THEN
            I1 = 1
            I2 = NQ - 1
            I3 = 1
            II = 2
         ELSE
            I1 = NQ - 1
            I2 = 1
            I3 = -1
            II = NQ*( NQ+1 ) / 2 - 1
         END IF
<span class="comment">*</span><span class="comment">
</span>         IF( LEFT ) THEN
            NI = N
         ELSE
            MI = M
         END IF
<span class="comment">*</span><span class="comment">
</span>         DO 10 I = I1, I2, I3
            IF( LEFT ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              H(i) or H(i)' is applied to C(1:i,1:n)
</span><span class="comment">*</span><span class="comment">
</span>               MI = I
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              H(i) or H(i)' is applied to C(1:m,1:i)
</span><span class="comment">*</span><span class="comment">
</span>               NI = I
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply H(i) or H(i)'
</span><span class="comment">*</span><span class="comment">
</span>            IF( NOTRAN ) THEN
               TAUI = TAU( I )
            ELSE
               TAUI = DCONJG( TAU( I ) )
            END IF
            AII = AP( II )
            AP( II ) = ONE
            CALL <a name="ZLARF.191"></a><a href="zlarf.f.html#ZLARF.1">ZLARF</a>( SIDE, MI, NI, AP( II-I+1 ), 1, TAUI, C, LDC,
     $                  WORK )
            AP( II ) = AII
<span class="comment">*</span><span class="comment">
</span>            IF( FORWRD ) THEN
               II = II + I + 2
            ELSE
               II = II - I - 1
            END IF
   10    CONTINUE
      ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Q was determined by a call to <a name="ZHPTRD.203"></a><a href="zhptrd.f.html#ZHPTRD.1">ZHPTRD</a> with UPLO = 'L'.
</span><span class="comment">*</span><span class="comment">
</span>         FORWRD = ( LEFT .AND. .NOT.NOTRAN ) .OR.
     $            ( .NOT.LEFT .AND. NOTRAN )
<span class="comment">*</span><span class="comment">
</span>         IF( FORWRD ) THEN
            I1 = 1
            I2 = NQ - 1
            I3 = 1
            II = 2
         ELSE
            I1 = NQ - 1
            I2 = 1
            I3 = -1
            II = NQ*( NQ+1 ) / 2 - 1
         END IF
<span class="comment">*</span><span class="comment">
</span>         IF( LEFT ) THEN
            NI = N
            JC = 1
         ELSE
            MI = M
            IC = 1
         END IF
<span class="comment">*</span><span class="comment">
</span>         DO 20 I = I1, I2, I3
            AII = AP( II )
            AP( II ) = ONE
            IF( LEFT ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              H(i) or H(i)' is applied to C(i+1:m,1:n)
</span><span class="comment">*</span><span class="comment">
</span>               MI = M - I
               IC = I + 1
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              H(i) or H(i)' is applied to C(1:m,i+1:n)
</span><span class="comment">*</span><span class="comment">
</span>               NI = N - I
               JC = I + 1
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Apply H(i) or H(i)'
</span><span class="comment">*</span><span class="comment">
</span>            IF( NOTRAN ) THEN
               TAUI = TAU( I )
            ELSE
               TAUI = DCONJG( TAU( I ) )
            END IF
            CALL <a name="ZLARF.252"></a><a href="zlarf.f.html#ZLARF.1">ZLARF</a>( SIDE, MI, NI, AP( II ), 1, TAUI, C( IC, JC ),
     $                  LDC, WORK )
            AP( II ) = AII
<span class="comment">*</span><span class="comment">
</span>            IF( FORWRD ) THEN
               II = II + NQ - I + 1
            ELSE
               II = II - NQ + I - 2
            END IF
   20    CONTINUE
      END IF
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZUPMTR.265"></a><a href="zupmtr.f.html#ZUPMTR.1">ZUPMTR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>