zlarfb.f.html

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

HTML
633 行
字号
1234
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 C2 := C2 - W * V2
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZGEMM( <span class="string">'No transpose'</span>, <span class="string">'No transpose'</span>, M, N-K, K,
     $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
     $                        C( 1, K+1 ), LDC )
               END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * V1
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Upper'</span>, <span class="string">'No transpose'</span>, <span class="string">'Unit'</span>, M,
     $                     K, ONE, V, LDV, WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              C1 := C1 - W
</span><span class="comment">*</span><span class="comment">
</span>               DO 180 J = 1, K
                  DO 170 I = 1, M
                     C( I, J ) = C( I, J ) - WORK( I, J )
  170             CONTINUE
  180          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            END IF
<span class="comment">*</span><span class="comment">
</span>         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Let  V =  ( V1  V2 )    (V2: last K columns)
</span><span class="comment">*</span><span class="comment">           where  V2  is unit lower triangular.
</span><span class="comment">*</span><span class="comment">
</span>            IF( <a name="LSAME.487"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SIDE, <span class="string">'L'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Form  H * C  or  H' * C  where  C = ( C1 )
</span><span class="comment">*</span><span class="comment">                                                  ( C2 )
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := C2'
</span><span class="comment">*</span><span class="comment">
</span>               DO 190 J = 1, K
                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
                  CALL <a name="ZLACGV.498"></a><a href="zlacgv.f.html#ZLACGV.1">ZLACGV</a>( N, WORK( 1, J ), 1 )
  190          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * V2'
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, <span class="string">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, N, K, ONE, V( 1, M-K+1 ), LDV, WORK,
     $                     LDWORK )
               IF( M.GT.K ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 W := W + C1'*V1'
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZGEMM( <span class="string">'Conjugate transpose'</span>,
     $                        <span class="string">'Conjugate transpose'</span>, N, K, M-K, ONE, C,
     $                        LDC, V, LDV, ONE, WORK, LDWORK )
               END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * T'  or  W * T
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, TRANST, <span class="string">'Non-unit'</span>, N, K,
     $                     ONE, T, LDT, WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              C := C - V' * W'
</span><span class="comment">*</span><span class="comment">
</span>               IF( M.GT.K ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 C1 := C1 - V1' * W'
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZGEMM( <span class="string">'Conjugate transpose'</span>,
     $                        <span class="string">'Conjugate transpose'</span>, M-K, N, K, -ONE, V,
     $                        LDV, WORK, LDWORK, ONE, C, LDC )
               END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * V2
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, <span class="string">'No transpose'</span>, <span class="string">'Unit'</span>, N,
     $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              C2 := C2 - W'
</span><span class="comment">*</span><span class="comment">
</span>               DO 210 J = 1, K
                  DO 200 I = 1, N
                     C( M-K+J, I ) = C( M-K+J, I ) -
     $                               DCONJG( WORK( I, J ) )
  200             CONTINUE
  210          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            ELSE IF( <a name="LSAME.545"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SIDE, <span class="string">'R'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Form  C * H  or  C * H'  where  C = ( C1  C2 )
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := C2
</span><span class="comment">*</span><span class="comment">
</span>               DO 220 J = 1, K
                  CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
  220          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * V2'
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, <span class="string">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, M, K, ONE, V( 1, N-K+1 ), LDV, WORK,
     $                     LDWORK )
               IF( N.GT.K ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 W := W + C1 * V1'
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZGEMM( <span class="string">'No transpose'</span>, <span class="string">'Conjugate transpose'</span>, M,
     $                        K, N-K, ONE, C, LDC, V, LDV, ONE, WORK,
     $                        LDWORK )
               END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * T  or  W * T'
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, TRANS, <span class="string">'Non-unit'</span>, M, K,
     $                     ONE, T, LDT, WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              C := C - W * V
</span><span class="comment">*</span><span class="comment">
</span>               IF( N.GT.K ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 C1 := C1 - W * V1
</span><span class="comment">*</span><span class="comment">
</span>                  CALL ZGEMM( <span class="string">'No transpose'</span>, <span class="string">'No transpose'</span>, M, N-K, K,
     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
               END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              W := W * V2
</span><span class="comment">*</span><span class="comment">
</span>               CALL ZTRMM( <span class="string">'Right'</span>, <span class="string">'Lower'</span>, <span class="string">'No transpose'</span>, <span class="string">'Unit'</span>, M,
     $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              C1 := C1 - W
</span><span class="comment">*</span><span class="comment">
</span>               DO 240 J = 1, K
                  DO 230 I = 1, M
                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
  230             CONTINUE
  240          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            END IF
<span class="comment">*</span><span class="comment">
</span>         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZLARFB.606"></a><a href="zlarfb.f.html#ZLARFB.1">ZLARFB</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
1234

zlarfb.f.html - 源码说明

本页面展示了「famous linear algebra library (LAPACK) ports to windows」中的 zlarfb.f.html 源码文件，采用 HTML 编程语言编写，共 633 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与algebra相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?