clantr.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 302 行 · 第 1/2 页
HTML
302 行
DO 60 J = 1, N
DO 50 I = 1, MIN( M, J )
VALUE = MAX( VALUE, ABS( A( I, J ) ) )
50 CONTINUE
60 CONTINUE
ELSE
DO 80 J = 1, N
DO 70 I = J, M
VALUE = MAX( VALUE, ABS( A( I, J ) ) )
70 CONTINUE
80 CONTINUE
END IF
END IF
ELSE IF( ( <a name="LSAME.146"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'O'</span> ) ) .OR. ( NORM.EQ.<span class="string">'1'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Find norm1(A).
</span><span class="comment">*</span><span class="comment">
</span> VALUE = ZERO
UDIAG = <a name="LSAME.151"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> )
IF( <a name="LSAME.152"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
DO 110 J = 1, N
IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
SUM = ONE
DO 90 I = 1, J - 1
SUM = SUM + ABS( A( I, J ) )
90 CONTINUE
ELSE
SUM = ZERO
DO 100 I = 1, MIN( M, J )
SUM = SUM + ABS( A( I, J ) )
100 CONTINUE
END IF
VALUE = MAX( VALUE, SUM )
110 CONTINUE
ELSE
DO 140 J = 1, N
IF( UDIAG ) THEN
SUM = ONE
DO 120 I = J + 1, M
SUM = SUM + ABS( A( I, J ) )
120 CONTINUE
ELSE
SUM = ZERO
DO 130 I = J, M
SUM = SUM + ABS( A( I, J ) )
130 CONTINUE
END IF
VALUE = MAX( VALUE, SUM )
140 CONTINUE
END IF
ELSE IF( <a name="LSAME.183"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'I'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Find normI(A).
</span><span class="comment">*</span><span class="comment">
</span> IF( <a name="LSAME.187"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
IF( <a name="LSAME.188"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> ) ) THEN
DO 150 I = 1, M
WORK( I ) = ONE
150 CONTINUE
DO 170 J = 1, N
DO 160 I = 1, MIN( M, J-1 )
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
160 CONTINUE
170 CONTINUE
ELSE
DO 180 I = 1, M
WORK( I ) = ZERO
180 CONTINUE
DO 200 J = 1, N
DO 190 I = 1, MIN( M, J )
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
190 CONTINUE
200 CONTINUE
END IF
ELSE
IF( <a name="LSAME.208"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> ) ) THEN
DO 210 I = 1, N
WORK( I ) = ONE
210 CONTINUE
DO 220 I = N + 1, M
WORK( I ) = ZERO
220 CONTINUE
DO 240 J = 1, N
DO 230 I = J + 1, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
230 CONTINUE
240 CONTINUE
ELSE
DO 250 I = 1, M
WORK( I ) = ZERO
250 CONTINUE
DO 270 J = 1, N
DO 260 I = J, M
WORK( I ) = WORK( I ) + ABS( A( I, J ) )
260 CONTINUE
270 CONTINUE
END IF
END IF
VALUE = ZERO
DO 280 I = 1, M
VALUE = MAX( VALUE, WORK( I ) )
280 CONTINUE
ELSE IF( ( <a name="LSAME.235"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'F'</span> ) ) .OR. ( <a name="LSAME.235"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'E'</span> ) ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Find normF(A).
</span><span class="comment">*</span><span class="comment">
</span> IF( <a name="LSAME.239"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
IF( <a name="LSAME.240"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
DO 290 J = 2, N
CALL <a name="CLASSQ.244"></a><a href="classq.f.html#CLASSQ.1">CLASSQ</a>( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
290 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 300 J = 1, N
CALL <a name="CLASSQ.250"></a><a href="classq.f.html#CLASSQ.1">CLASSQ</a>( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
300 CONTINUE
END IF
ELSE
IF( <a name="LSAME.254"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
DO 310 J = 1, N
CALL <a name="CLASSQ.258"></a><a href="classq.f.html#CLASSQ.1">CLASSQ</a>( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
DO 320 J = 1, N
CALL <a name="CLASSQ.265"></a><a href="classq.f.html#CLASSQ.1">CLASSQ</a>( M-J+1, A( J, J ), 1, SCALE, SUM )
320 CONTINUE
END IF
END IF
VALUE = SCALE*SQRT( SUM )
END IF
<span class="comment">*</span><span class="comment">
</span> <a name="CLANTR.272"></a><a href="clantr.f.html#CLANTR.1">CLANTR</a> = VALUE
RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> End of <a name="CLANTR.275"></a><a href="clantr.f.html#CLANTR.1">CLANTR</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?