strexc.f.html

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

HTML
370 行
字号
12
<span class="comment">*</span><span class="comment">
</span>         HERE = IFST
<span class="comment">*</span><span class="comment">
</span>   10    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Swap block with next one below
</span><span class="comment">*</span><span class="comment">
</span>         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Current block either 1 by 1 or 2 by 2
</span><span class="comment">*</span><span class="comment">
</span>            NBNEXT = 1
            IF( HERE+NBF+1.LE.N ) THEN
               IF( T( HERE+NBF+1, HERE+NBF ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="SLAEXC.183"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, NBF, NBNEXT,
     $                   WORK, INFO )
            IF( INFO.NE.0 ) THEN
               ILST = HERE
               RETURN
            END IF
            HERE = HERE + NBNEXT
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Test if 2 by 2 block breaks into two 1 by 1 blocks
</span><span class="comment">*</span><span class="comment">
</span>            IF( NBF.EQ.2 ) THEN
               IF( T( HERE+1, HERE ).EQ.ZERO )
     $            NBF = 3
            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">           Current block consists of two 1 by 1 blocks each of which
</span><span class="comment">*</span><span class="comment">           must be swapped individually
</span><span class="comment">*</span><span class="comment">
</span>            NBNEXT = 1
            IF( HERE+3.LE.N ) THEN
               IF( T( HERE+3, HERE+2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="SLAEXC.208"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, NBNEXT,
     $                   WORK, INFO )
            IF( INFO.NE.0 ) THEN
               ILST = HERE
               RETURN
            END IF
            IF( NBNEXT.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Swap two 1 by 1 blocks, no problems possible
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="SLAEXC.218"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, NBNEXT,
     $                      WORK, INFO )
               HERE = HERE + 1
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Recompute NBNEXT in case 2 by 2 split
</span><span class="comment">*</span><span class="comment">
</span>               IF( T( HERE+2, HERE+1 ).EQ.ZERO )
     $            NBNEXT = 1
               IF( NBNEXT.EQ.2 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 2 by 2 Block did not split
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="SLAEXC.231"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, 1,
     $                         NBNEXT, WORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE + 2
               ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 2 by 2 Block did split
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="SLAEXC.242"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
     $                         WORK, INFO )
                  CALL <a name="SLAEXC.244"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE+1, 1, 1,
     $                         WORK, INFO )
                  HERE = HERE + 2
               END IF
            END IF
         END IF
         IF( HERE.LT.ILST )
     $      GO TO 10
<span class="comment">*</span><span class="comment">
</span>      ELSE
<span class="comment">*</span><span class="comment">
</span>         HERE = IFST
   20    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Swap block with next one above
</span><span class="comment">*</span><span class="comment">
</span>         IF( NBF.EQ.1 .OR. NBF.EQ.2 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Current block either 1 by 1 or 2 by 2
</span><span class="comment">*</span><span class="comment">
</span>            NBNEXT = 1
            IF( HERE.GE.3 ) THEN
               IF( T( HERE-1, HERE-2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="SLAEXC.269"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
     $                   NBF, WORK, INFO )
            IF( INFO.NE.0 ) THEN
               ILST = HERE
               RETURN
            END IF
            HERE = HERE - NBNEXT
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Test if 2 by 2 block breaks into two 1 by 1 blocks
</span><span class="comment">*</span><span class="comment">
</span>            IF( NBF.EQ.2 ) THEN
               IF( T( HERE+1, HERE ).EQ.ZERO )
     $            NBF = 3
            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">           Current block consists of two 1 by 1 blocks each of which
</span><span class="comment">*</span><span class="comment">           must be swapped individually
</span><span class="comment">*</span><span class="comment">
</span>            NBNEXT = 1
            IF( HERE.GE.3 ) THEN
               IF( T( HERE-1, HERE-2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="SLAEXC.294"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE-NBNEXT, NBNEXT,
     $                   1, WORK, INFO )
            IF( INFO.NE.0 ) THEN
               ILST = HERE
               RETURN
            END IF
            IF( NBNEXT.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Swap two 1 by 1 blocks, no problems possible
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="SLAEXC.304"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, NBNEXT, 1,
     $                      WORK, INFO )
               HERE = HERE - 1
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Recompute NBNEXT in case 2 by 2 split
</span><span class="comment">*</span><span class="comment">
</span>               IF( T( HERE, HERE-1 ).EQ.ZERO )
     $            NBNEXT = 1
               IF( NBNEXT.EQ.2 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 2 by 2 Block did not split
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="SLAEXC.317"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 2, 1,
     $                         WORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE - 2
               ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">                 2 by 2 Block did split
</span><span class="comment">*</span><span class="comment">
</span>                  CALL <a name="SLAEXC.328"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE, 1, 1,
     $                         WORK, INFO )
                  CALL <a name="SLAEXC.330"></a><a href="slaexc.f.html#SLAEXC.1">SLAEXC</a>( WANTQ, N, T, LDT, Q, LDQ, HERE-1, 1, 1,
     $                         WORK, INFO )
                  HERE = HERE - 2
               END IF
            END IF
         END IF
         IF( HERE.GT.ILST )
     $      GO TO 20
      END IF
      ILST = HERE
<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="STREXC.343"></a><a href="strexc.f.html#STREXC.1">STREXC</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
12

strexc.f.html - 源码说明

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

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

⌨️ 快捷键说明

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