sopmtr.f.html

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

      ELSE IF( .NOT.UPPER .AND. .NOT.<a name="LSAME.123"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'L'</span> ) ) THEN
         INFO = -2
      ELSE IF( .NOT.NOTRAN .AND. .NOT.<a name="LSAME.125"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( TRANS, <span class="string">'T'</span> ) ) THEN
         INFO = -3
      ELSE IF( M.LT.0 ) THEN
         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="SOPMTR.135"></a><a href="sopmtr.f.html#SOPMTR.1">SOPMTR</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="SSPTRD.146"></a><a href="ssptrd.f.html#SSPTRD.1">SSPTRD</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) 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) 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)
</span><span class="comment">*</span><span class="comment">
</span>            AII = AP( II )
            AP( II ) = ONE
            CALL <a name="SLARF.186"></a><a href="slarf.f.html#SLARF.1">SLARF</a>( SIDE, MI, NI, AP( II-I+1 ), 1, TAU( I ), 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="SSPTRD.198"></a><a href="ssptrd.f.html#SSPTRD.1">SSPTRD</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) 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) 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)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="SLARF.242"></a><a href="slarf.f.html#SLARF.1">SLARF</a>( SIDE, MI, NI, AP( II ), 1, TAU( I ),
     $                  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="SOPMTR.255"></a><a href="sopmtr.f.html#SOPMTR.1">SOPMTR</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>