zlantb.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 310 行 · 第 1/2 页
HTML
310 行
ELSE
DO 80 J = 1, N
DO 70 I = 1, MIN( N+1-J, K+1 )
VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
70 CONTINUE
80 CONTINUE
END IF
END IF
ELSE IF( ( <a name="LSAME.145"></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.150"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> )
IF( <a name="LSAME.151"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
DO 110 J = 1, N
IF( UDIAG ) THEN
SUM = ONE
DO 90 I = MAX( K+2-J, 1 ), K
SUM = SUM + ABS( AB( I, J ) )
90 CONTINUE
ELSE
SUM = ZERO
DO 100 I = MAX( K+2-J, 1 ), K + 1
SUM = SUM + ABS( AB( 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 = 2, MIN( N+1-J, K+1 )
SUM = SUM + ABS( AB( I, J ) )
120 CONTINUE
ELSE
SUM = ZERO
DO 130 I = 1, MIN( N+1-J, K+1 )
SUM = SUM + ABS( AB( I, J ) )
130 CONTINUE
END IF
VALUE = MAX( VALUE, SUM )
140 CONTINUE
END IF
ELSE IF( <a name="LSAME.182"></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> VALUE = ZERO
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, N
WORK( I ) = ONE
150 CONTINUE
DO 170 J = 1, N
L = K + 1 - J
DO 160 I = MAX( 1, J-K ), J - 1
WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
160 CONTINUE
170 CONTINUE
ELSE
DO 180 I = 1, N
WORK( I ) = ZERO
180 CONTINUE
DO 200 J = 1, N
L = K + 1 - J
DO 190 I = MAX( 1, J-K ), J
WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
190 CONTINUE
200 CONTINUE
END IF
ELSE
IF( <a name="LSAME.210"></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 230 J = 1, N
L = 1 - J
DO 220 I = J + 1, MIN( N, J+K )
WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
220 CONTINUE
230 CONTINUE
ELSE
DO 240 I = 1, N
WORK( I ) = ZERO
240 CONTINUE
DO 260 J = 1, N
L = 1 - J
DO 250 I = J, MIN( N, J+K )
WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
250 CONTINUE
260 CONTINUE
END IF
END IF
DO 270 I = 1, N
VALUE = MAX( VALUE, WORK( I ) )
270 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 = N
IF( K.GT.0 ) THEN
DO 280 J = 2, N
CALL <a name="ZLASSQ.245"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( J-1, K ),
$ AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
$ SUM )
280 CONTINUE
END IF
ELSE
SCALE = ZERO
SUM = ONE
DO 290 J = 1, N
CALL <a name="ZLASSQ.254"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
$ 1, SCALE, SUM )
290 CONTINUE
END IF
ELSE
IF( <a name="LSAME.259"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'U'</span> ) ) THEN
SCALE = ONE
SUM = N
IF( K.GT.0 ) THEN
DO 300 J = 1, N - 1
CALL <a name="ZLASSQ.264"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
$ SUM )
300 CONTINUE
END IF
ELSE
SCALE = ZERO
SUM = ONE
DO 310 J = 1, N
CALL <a name="ZLASSQ.272"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
$ SUM )
310 CONTINUE
END IF
END IF
VALUE = SCALE*SQRT( SUM )
END IF
<span class="comment">*</span><span class="comment">
</span> <a name="ZLANTB.280"></a><a href="zlantb.f.html#ZLANTB.1">ZLANTB</a> = VALUE
RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> End of <a name="ZLANTB.283"></a><a href="zlantb.f.html#ZLANTB.1">ZLANTB</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?