stgexc.f.html

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

HTML
465 行
字号
12
      END IF
      NBL = 1
      IF( ILST.LT.N ) THEN
         IF( A( ILST+1, ILST ).NE.ZERO )
     $      NBL = 2
      END IF
      IF( IFST.EQ.ILST )
     $   RETURN
<span class="comment">*</span><span class="comment">
</span>      IF( IFST.LT.ILST ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Update ILST.
</span><span class="comment">*</span><span class="comment">
</span>         IF( NBF.EQ.2 .AND. NBL.EQ.1 )
     $      ILST = ILST - 1
         IF( NBF.EQ.1 .AND. NBL.EQ.2 )
     $      ILST = ILST + 1
<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 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( A( HERE+NBF+1, HERE+NBF ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="STGEX2.248"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                   LDZ, HERE, NBF, NBNEXT, WORK, LWORK, 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( A( 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( A( HERE+3, HERE+2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="STGEX2.273"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                   LDZ, HERE+1, 1, NBNEXT, WORK, LWORK, 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.
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="STGEX2.283"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                      LDZ, HERE, 1, 1, WORK, LWORK, INFO )
               IF( INFO.NE.0 ) THEN
                  ILST = HERE
                  RETURN
               END IF
               HERE = HERE + 1
<span class="comment">*</span><span class="comment">
</span>            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">              Recompute NBNEXT in case of 2-by-2 split.
</span><span class="comment">*</span><span class="comment">
</span>               IF( A( 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="STGEX2.301"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE, 1, NBNEXT, WORK, LWORK,
     $                         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="STGEX2.313"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE + 1
                  CALL <a name="STGEX2.320"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE + 1
               END IF
<span class="comment">*</span><span class="comment">
</span>            END IF
         END IF
         IF( HERE.LT.ILST )
     $      GO TO 10
      ELSE
         HERE = IFST
<span class="comment">*</span><span class="comment">
</span>   20    CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Swap 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.GE.3 ) THEN
               IF( A( HERE-1, HERE-2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="STGEX2.349"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                   LDZ, HERE-NBNEXT, NBNEXT, NBF, WORK, LWORK,
     $                   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( A( 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( A( HERE-1, HERE-2 ).NE.ZERO )
     $            NBNEXT = 2
            END IF
            CALL <a name="STGEX2.375"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                   LDZ, HERE-NBNEXT, NBNEXT, 1, WORK, LWORK,
     $                   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.
</span><span class="comment">*</span><span class="comment">
</span>               CALL <a name="STGEX2.386"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
     $                      LDZ, HERE, NBNEXT, 1, WORK, LWORK, INFO )
               IF( INFO.NE.0 ) THEN
                  ILST = HERE
                  RETURN
               END IF
               HERE = HERE - 1
            ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">             Recompute NBNEXT in case of 2-by-2 split.
</span><span class="comment">*</span><span class="comment">
</span>               IF( A( 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="STGEX2.403"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE-1, 2, 1, WORK, LWORK, 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="STGEX2.414"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE - 1
                  CALL <a name="STGEX2.421"></a><a href="stgex2.f.html#STGEX2.1">STGEX2</a>( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ,
     $                         Z, LDZ, HERE, 1, 1, WORK, LWORK, INFO )
                  IF( INFO.NE.0 ) THEN
                     ILST = HERE
                     RETURN
                  END IF
                  HERE = HERE - 1
               END IF
            END IF
         END IF
         IF( HERE.GT.ILST )
     $      GO TO 20
      END IF
      ILST = HERE
      WORK( 1 ) = LWMIN
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="STGEXC.438"></a><a href="stgexc.f.html#STGEXC.1">STGEXC</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
12

stgexc.f.html - 源码说明

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

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

⌨️ 快捷键说明

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