sgels.f.html

来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 447 行 · 第 1/3 页
HTML
447 行
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="SORMQR.281"></a><a href="sormqr.f.html#SORMQR.1">SORMQR</a>( <span class="string">'Left'</span>, <span class="string">'Transpose'</span>, M, NRHS, N, A, LDA,
     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
     $                   INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           workspace at least NRHS, optimally NRHS*NB
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="STRTRS.289"></a><a href="strtrs.f.html#STRTRS.1">STRTRS</a>( <span class="string">'Upper'</span>, <span class="string">'No transpose'</span>, <span class="string">'Non-unit'</span>, N, NRHS,
     $                   A, LDA, B, LDB, INFO )
<span class="comment">*</span><span class="comment">
</span>            IF( INFO.GT.0 ) THEN
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span>            SCLLEN = N
<span class="comment">*</span><span class="comment">
</span>         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Overdetermined system of equations A' * X = B
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:N,1:NRHS) := inv(R') * B(1:N,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="STRTRS.304"></a><a href="strtrs.f.html#STRTRS.1">STRTRS</a>( <span class="string">'Upper'</span>, <span class="string">'Transpose'</span>, <span class="string">'Non-unit'</span>, N, NRHS,
     $                   A, LDA, B, LDB, INFO )
<span class="comment">*</span><span class="comment">
</span>            IF( INFO.GT.0 ) THEN
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(N+1:M,1:NRHS) = ZERO
</span><span class="comment">*</span><span class="comment">
</span>            DO 20 J = 1, NRHS
               DO 10 I = N + 1, M
                  B( I, J ) = ZERO
   10          CONTINUE
   20       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="SORMQR.321"></a><a href="sormqr.f.html#SORMQR.1">SORMQR</a>( <span class="string">'Left'</span>, <span class="string">'No transpose'</span>, M, NRHS, N, A, LDA,
     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
     $                   INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           workspace at least NRHS, optimally NRHS*NB
</span><span class="comment">*</span><span class="comment">
</span>            SCLLEN = M
<span class="comment">*</span><span class="comment">
</span>         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">        Compute LQ factorization of A
</span><span class="comment">*</span><span class="comment">
</span>         CALL <a name="SGELQF.335"></a><a href="sgelqf.f.html#SGELQF.1">SGELQF</a>( M, N, A, LDA, WORK( 1 ), WORK( MN+1 ), LWORK-MN,
     $                INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        workspace at least M, optimally M*NB.
</span><span class="comment">*</span><span class="comment">
</span>         IF( .NOT.TPSD ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           underdetermined system of equations A * X = B
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="STRTRS.346"></a><a href="strtrs.f.html#STRTRS.1">STRTRS</a>( <span class="string">'Lower'</span>, <span class="string">'No transpose'</span>, <span class="string">'Non-unit'</span>, M, NRHS,
     $                   A, LDA, B, LDB, INFO )
<span class="comment">*</span><span class="comment">
</span>            IF( INFO.GT.0 ) THEN
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(M+1:N,1:NRHS) = 0
</span><span class="comment">*</span><span class="comment">
</span>            DO 40 J = 1, NRHS
               DO 30 I = M + 1, N
                  B( I, J ) = ZERO
   30          CONTINUE
   40       CONTINUE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:N,1:NRHS) := Q(1:N,:)' * B(1:M,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="SORMLQ.363"></a><a href="sormlq.f.html#SORMLQ.1">SORMLQ</a>( <span class="string">'Left'</span>, <span class="string">'Transpose'</span>, N, NRHS, M, A, LDA,
     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
     $                   INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           workspace at least NRHS, optimally NRHS*NB
</span><span class="comment">*</span><span class="comment">
</span>            SCLLEN = N
<span class="comment">*</span><span class="comment">
</span>         ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           overdetermined system min || A' * X - B ||
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="SORMLQ.377"></a><a href="sormlq.f.html#SORMLQ.1">SORMLQ</a>( <span class="string">'Left'</span>, <span class="string">'No transpose'</span>, N, NRHS, M, A, LDA,
     $                   WORK( 1 ), B, LDB, WORK( MN+1 ), LWORK-MN,
     $                   INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           workspace at least NRHS, optimally NRHS*NB
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           B(1:M,1:NRHS) := inv(L') * B(1:M,1:NRHS)
</span><span class="comment">*</span><span class="comment">
</span>            CALL <a name="STRTRS.385"></a><a href="strtrs.f.html#STRTRS.1">STRTRS</a>( <span class="string">'Lower'</span>, <span class="string">'Transpose'</span>, <span class="string">'Non-unit'</span>, M, NRHS,
     $                   A, LDA, B, LDB, INFO )
<span class="comment">*</span><span class="comment">
</span>            IF( INFO.GT.0 ) THEN
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span>            SCLLEN = M
<span class="comment">*</span><span class="comment">
</span>         END IF
<span class="comment">*</span><span class="comment">
</span>      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Undo scaling
</span><span class="comment">*</span><span class="comment">
</span>      IF( IASCL.EQ.1 ) THEN
         CALL <a name="SLASCL.401"></a><a href="slascl.f.html#SLASCL.1">SLASCL</a>( <span class="string">'G'</span>, 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
     $                INFO )
      ELSE IF( IASCL.EQ.2 ) THEN
         CALL <a name="SLASCL.404"></a><a href="slascl.f.html#SLASCL.1">SLASCL</a>( <span class="string">'G'</span>, 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
     $                INFO )
      END IF
      IF( IBSCL.EQ.1 ) THEN
         CALL <a name="SLASCL.408"></a><a href="slascl.f.html#SLASCL.1">SLASCL</a>( <span class="string">'G'</span>, 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
     $                INFO )
      ELSE IF( IBSCL.EQ.2 ) THEN
         CALL <a name="SLASCL.411"></a><a href="slascl.f.html#SLASCL.1">SLASCL</a>( <span class="string">'G'</span>, 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
     $                INFO )
      END IF
<span class="comment">*</span><span class="comment">
</span>   50 CONTINUE
      WORK( 1 ) = REAL( WSIZE )
<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="SGELS.420"></a><a href="sgels.f.html#SGELS.1">SGELS</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
sgels.f.html - 源码说明

本页面展示了「famous linear algebra library (LAPACK) ports to windows」中的 sgels.f.html 源码文件，采用 HTML 编程语言编写，共 447 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫下载站收录了大量与algebra相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

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