zlarfb.f.html

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

HTML
633 行
字号
1234
                     C( M-K+J, I ) = C( M-K+J, I ) -
     $                               DCONJG( WORK( I, J ) )
   80             CONTINUE
   90          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            ELSE IF( <a name="LSAME.305"></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 100 J = 1, K
                  CALL ZCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
  100          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">'Upper'</span>, <span class="string">'No transpose'</span>, <span class="string">'Unit'</span>, M,
     $                     K, ONE, V( N-K+1, 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">'No 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">'Conjugate 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">'Upper'</span>, <span class="string">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, M, K, ONE, V( N-K+1, 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 120 J = 1, K
                  DO 110 I = 1, M
                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
  110             CONTINUE
  120          CONTINUE
            END IF
         END IF
<span class="comment">*</span><span class="comment">
</span>      ELSE IF( <a name="LSAME.361"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( STOREV, <span class="string">'R'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span>         IF( <a name="LSAME.363"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIRECT, <span class="string">'F'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Let  V =  ( V1  V2 )    (V1: first K columns)
</span><span class="comment">*</span><span class="comment">           where  V1  is unit upper triangular.
</span><span class="comment">*</span><span class="comment">
</span>            IF( <a name="LSAME.368"></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 := C1'
</span><span class="comment">*</span><span class="comment">
</span>               DO 130 J = 1, K
                  CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
                  CALL <a name="ZLACGV.379"></a><a href="zlacgv.f.html#ZLACGV.1">ZLACGV</a>( N, WORK( 1, J ), 1 )
  130          CONTINUE
<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">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, N, K, ONE, V, 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 + C2'*V2'
</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( K+1, 1 ), LDC, V( 1, K+1 ), 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">'Upper'</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">                 C2 := C2 - V2' * 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( 1, K+1 ), LDV, WORK, LDWORK, ONE,
     $                        C( K+1, 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>, N,
     $                     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 150 J = 1, K
                  DO 140 I = 1, N
                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
  140             CONTINUE
  150          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            ELSE IF( <a name="LSAME.426"></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 := C1
</span><span class="comment">*</span><span class="comment">
</span>               DO 160 J = 1, K
                  CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
  160          CONTINUE
<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">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, M, K, ONE, V, 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 + C2 * V2'
</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( 1, K+1 ), LDC,
     $                        V( 1, K+1 ), 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">'Upper'</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
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 + -
显示快捷键?