zlarfb.f.html

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

HTML
633 行
字号
1234
                  CALL <a name="ZLACGV.141"></a><a href="zlacgv.f.html#ZLACGV.1">ZLACGV</a>( N, WORK( 1, J ), 1 )
   10          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">'Lower'</span>, <span class="string">'No 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">'No transpose'</span>, N,
     $                        K, M-K, ONE, C( K+1, 1 ), LDC,
     $                        V( K+1, 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">'No transpose'</span>, <span class="string">'Conjugate transpose'</span>,
     $                        M-K, N, K, -ONE, V( K+1, 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">'Lower'</span>, <span class="string">'Conjugate 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 30 J = 1, K
                  DO 20 I = 1, N
                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
   20             CONTINUE
   30          CONTINUE
<span class="comment">*</span><span class="comment">
</span>            ELSE IF( <a name="LSAME.186"></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 40 J = 1, K
                  CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
   40          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">'Lower'</span>, <span class="string">'No 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">'No transpose'</span>, M, K, N-K,
     $                        ONE, C( 1, K+1 ), LDC, V( K+1, 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
<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">'Conjugate transpose'</span>, M,
     $                        N-K, K, -ONE, WORK, LDWORK, V( K+1, 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">'Lower'</span>, <span class="string">'Conjugate 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 60 J = 1, K
                  DO 50 I = 1, M
                     C( I, J ) = C( I, J ) - WORK( I, J )
   50             CONTINUE
   60          CONTINUE
            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 )
</span><span class="comment">*</span><span class="comment">                     ( V2 )    (last K rows)
</span><span class="comment">*</span><span class="comment">           where  V2  is unit upper triangular.
</span><span class="comment">*</span><span class="comment">
</span>            IF( <a name="LSAME.247"></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 70 J = 1, K
                  CALL ZCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
                  CALL <a name="ZLACGV.258"></a><a href="zlacgv.f.html#ZLACGV.1">ZLACGV</a>( N, WORK( 1, J ), 1 )
   70          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>, N,
     $                     K, ONE, V( M-K+1, 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">'No 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">'No 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">'Upper'</span>, <span class="string">'Conjugate transpose'</span>,
     $                     <span class="string">'Unit'</span>, N, K, ONE, V( M-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 90 J = 1, K
                  DO 80 I = 1, N
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 + -
显示快捷键?