claqr5.f.html

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

HTML
834 行
字号
12345
               J4 = KDU
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              ==== KZS and KNZ deal with the band of zeros
</span><span class="comment">*</span><span class="comment">              .    along the diagonal of one of the triangular
</span><span class="comment">*</span><span class="comment">              .    blocks. ====
</span><span class="comment">*</span><span class="comment">
</span>               KZS = ( J4-J2 ) - ( NS+1 )
               KNZ = NS + 1
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              ==== Horizontal multiply ====
</span><span class="comment">*</span><span class="comment">
</span>               DO 180 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
                  JLEN = MIN( NH, JBOT-JCOL+1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy bottom of H to top+KZS of scratch ====
</span><span class="comment">*</span><span class="comment">                  (The first KZS rows get multiplied by zero.) ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.667"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, KNZ, JLEN, H( INCOL+1+J2, JCOL ),
     $                         LDH, WH( KZS+1, 1 ), LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U21' ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLASET.672"></a><a href="claset.f.html#CLASET.1">CLASET</a>( <span class="string">'ALL'</span>, KZS, JLEN, ZERO, ZERO, WH, LDWH )
                  CALL CTRMM( <span class="string">'L'</span>, <span class="string">'U'</span>, <span class="string">'C'</span>, <span class="string">'N'</span>, KNZ, JLEN, ONE,
     $                        U( J2+1, 1+KZS ), LDU, WH( KZS+1, 1 ),
     $                        LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply top of H by U11' ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CGEMM( <span class="string">'C'</span>, <span class="string">'N'</span>, I2, JLEN, J2, ONE, U, LDU,
     $                        H( INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy top of H bottom of WH ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.684"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, J2, JLEN, H( INCOL+1, JCOL ), LDH,
     $                         WH( I2+1, 1 ), LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U21' ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CTRMM( <span class="string">'L'</span>, <span class="string">'L'</span>, <span class="string">'C'</span>, <span class="string">'N'</span>, J2, JLEN, ONE,
     $                        U( 1, I2+1 ), LDU, WH( I2+1, 1 ), LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U22 ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CGEMM( <span class="string">'C'</span>, <span class="string">'N'</span>, I4-I2, JLEN, J4-J2, ONE,
     $                        U( J2+1, I2+1 ), LDU,
     $                        H( INCOL+1+J2, JCOL ), LDH, ONE,
     $                        WH( I2+1, 1 ), LDWH )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy it back ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.701"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, KDU, JLEN, WH, LDWH,
     $                         H( INCOL+1, JCOL ), LDH )
  180          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              ==== Vertical multiply ====
</span><span class="comment">*</span><span class="comment">
</span>               DO 190 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
                  JLEN = MIN( NV, MAX( INCOL, KTOP )-JROW )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy right of H to scratch (the first KZS
</span><span class="comment">*</span><span class="comment">                 .    columns get multiplied by zero) ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.713"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, KNZ, H( JROW, INCOL+1+J2 ),
     $                         LDH, WV( 1, 1+KZS ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U21 ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLASET.718"></a><a href="claset.f.html#CLASET.1">CLASET</a>( <span class="string">'ALL'</span>, JLEN, KZS, ZERO, ZERO, WV, LDWV )
                  CALL CTRMM( <span class="string">'R'</span>, <span class="string">'U'</span>, <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, KNZ, ONE,
     $                        U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
     $                        LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U11 ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CGEMM( <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I2, J2, ONE,
     $                        H( JROW, INCOL+1 ), LDH, U, LDU, ONE, WV,
     $                        LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy left of H to right of scratch ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.731"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, J2, H( JROW, INCOL+1 ), LDH,
     $                         WV( 1, 1+I2 ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U21 ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CTRMM( <span class="string">'R'</span>, <span class="string">'L'</span>, <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I4-I2, ONE,
     $                        U( 1, I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Multiply by U22 ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL CGEMM( <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I4-I2, J4-J2, ONE,
     $                        H( JROW, INCOL+1+J2 ), LDH,
     $                        U( J2+1, I2+1 ), LDU, ONE, WV( 1, 1+I2 ),
     $                        LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 ==== Copy it back ====
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="CLACPY.748"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, KDU, WV, LDWV,
     $                         H( JROW, INCOL+1 ), LDH )
  190          CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              ==== Multiply Z (also vertical) ====
</span><span class="comment">*</span><span class="comment">
</span>               IF( WANTZ ) THEN
                  DO 200 JROW = ILOZ, IHIZ, NV
                     JLEN = MIN( NV, IHIZ-JROW+1 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Copy right of Z to left of scratch (first
</span><span class="comment">*</span><span class="comment">                    .     KZS columns get multiplied by zero) ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL <a name="CLACPY.761"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, KNZ,
     $                            Z( JROW, INCOL+1+J2 ), LDZ,
     $                            WV( 1, 1+KZS ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Multiply by U12 ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL <a name="CLASET.767"></a><a href="claset.f.html#CLASET.1">CLASET</a>( <span class="string">'ALL'</span>, JLEN, KZS, ZERO, ZERO, WV,
     $                            LDWV )
                     CALL CTRMM( <span class="string">'R'</span>, <span class="string">'U'</span>, <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, KNZ, ONE,
     $                           U( J2+1, 1+KZS ), LDU, WV( 1, 1+KZS ),
     $                           LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Multiply by U11 ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL CGEMM( <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I2, J2, ONE,
     $                           Z( JROW, INCOL+1 ), LDZ, U, LDU, ONE,
     $                           WV, LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Copy left of Z to right of scratch ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL <a name="CLACPY.781"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, J2, Z( JROW, INCOL+1 ),
     $                            LDZ, WV( 1, 1+I2 ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Multiply by U21 ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL CTRMM( <span class="string">'R'</span>, <span class="string">'L'</span>, <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I4-I2, ONE,
     $                           U( 1, I2+1 ), LDU, WV( 1, 1+I2 ),
     $                           LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Multiply by U22 ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL CGEMM( <span class="string">'N'</span>, <span class="string">'N'</span>, JLEN, I4-I2, J4-J2, ONE,
     $                           Z( JROW, INCOL+1+J2 ), LDZ,
     $                           U( J2+1, I2+1 ), LDU, ONE,
     $                           WV( 1, 1+I2 ), LDWV )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                    ==== Copy the result back to Z ====
</span><span class="comment">*</span><span class="comment">
</span>                     CALL <a name="CLACPY.799"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>( <span class="string">'ALL'</span>, JLEN, KDU, WV, LDWV,
     $                            Z( JROW, INCOL+1 ), LDZ )
  200             CONTINUE
               END IF
            END IF
         END IF
  210 CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ==== End of <a name="CLAQR5.807"></a><a href="claqr5.f.html#CLAQR5.1">CLAQR5</a> ====
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
12345

claqr5.f.html - 源码说明

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

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

⌨️ 快捷键说明

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