slaqr5.f.html

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

HTML
837 行
字号
12345
<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 190 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="SLACPY.670"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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="SLASET.675"></a><a href="slaset.f.html#SLASET.1">SLASET</a>( <span class="string">'ALL'</span>, KZS, JLEN, ZERO, ZERO, WH, LDWH )
                  CALL STRMM( <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 SGEMM( <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="SLACPY.687"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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 STRMM( <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 SGEMM( <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="SLACPY.704"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</a>( <span class="string">'ALL'</span>, KDU, JLEN, WH, LDWH,
     $                         H( INCOL+1, JCOL ), LDH )
  190          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 200 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="SLACPY.716"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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="SLASET.721"></a><a href="slaset.f.html#SLASET.1">SLASET</a>( <span class="string">'ALL'</span>, JLEN, KZS, ZERO, ZERO, WV, LDWV )
                  CALL STRMM( <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 SGEMM( <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="SLACPY.734"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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 STRMM( <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 SGEMM( <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="SLACPY.751"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</a>( <span class="string">'ALL'</span>, JLEN, KDU, WV, LDWV,
     $                         H( JROW, INCOL+1 ), LDH )
  200          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 210 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="SLACPY.764"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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="SLASET.770"></a><a href="slaset.f.html#SLASET.1">SLASET</a>( <span class="string">'ALL'</span>, JLEN, KZS, ZERO, ZERO, WV,
     $                            LDWV )
                     CALL STRMM( <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 SGEMM( <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="SLACPY.784"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</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 STRMM( <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 SGEMM( <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="SLACPY.802"></a><a href="slacpy.f.html#SLACPY.1">SLACPY</a>( <span class="string">'ALL'</span>, JLEN, KDU, WV, LDWV,
     $                            Z( JROW, INCOL+1 ), LDZ )
  210             CONTINUE
               END IF
            END IF
         END IF
  220 CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     ==== End of <a name="SLAQR5.810"></a><a href="slaqr5.f.html#SLAQR5.1">SLAQR5</a> ====
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
12345

slaqr5.f.html - 源码说明

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

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

⌨️ 快捷键说明

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