zlanhb.f.html

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

<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      IF( N.EQ.0 ) THEN
         VALUE = ZERO
      ELSE IF( <a name="LSAME.103"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'M'</span> ) ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">        Find max(abs(A(i,j))).
</span><span class="comment">*</span><span class="comment">
</span>         VALUE = ZERO
         IF( <a name="LSAME.108"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
            DO 20 J = 1, N
               DO 10 I = MAX( K+2-J, 1 ), K
                  VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
   10          CONTINUE
               VALUE = MAX( VALUE, ABS( DBLE( AB( K+1, J ) ) ) )
   20       CONTINUE
         ELSE
            DO 40 J = 1, N
               VALUE = MAX( VALUE, ABS( DBLE( AB( 1, J ) ) ) )
               DO 30 I = 2, MIN( N+1-J, K+1 )
                  VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
   30          CONTINUE
   40       CONTINUE
         END IF
      ELSE IF( ( <a name="LSAME.123"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'I'</span> ) ) .OR. ( <a name="LSAME.123"></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 normI(A) ( = norm1(A), since A is hermitian).
</span><span class="comment">*</span><span class="comment">
</span>         VALUE = ZERO
         IF( <a name="LSAME.129"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
            DO 60 J = 1, N
               SUM = ZERO
               L = K + 1 - J
               DO 50 I = MAX( 1, J-K ), J - 1
                  ABSA = ABS( AB( L+I, J ) )
                  SUM = SUM + ABSA
                  WORK( I ) = WORK( I ) + ABSA
   50          CONTINUE
               WORK( J ) = SUM + ABS( DBLE( AB( K+1, J ) ) )
   60       CONTINUE
            DO 70 I = 1, N
               VALUE = MAX( VALUE, WORK( I ) )
   70       CONTINUE
         ELSE
            DO 80 I = 1, N
               WORK( I ) = ZERO
   80       CONTINUE
            DO 100 J = 1, N
               SUM = WORK( J ) + ABS( DBLE( AB( 1, J ) ) )
               L = 1 - J
               DO 90 I = J + 1, MIN( N, J+K )
                  ABSA = ABS( AB( L+I, J ) )
                  SUM = SUM + ABSA
                  WORK( I ) = WORK( I ) + ABSA
   90          CONTINUE
               VALUE = MAX( VALUE, SUM )
  100       CONTINUE
         END IF
      ELSE IF( ( <a name="LSAME.158"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'F'</span> ) ) .OR. ( <a name="LSAME.158"></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>         SCALE = ZERO
         SUM = ONE
         IF( K.GT.0 ) THEN
            IF( <a name="LSAME.165"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> ) ) THEN
               DO 110 J = 2, N
                  CALL <a name="ZLASSQ.167"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
     $                         1, SCALE, SUM )
  110          CONTINUE
               L = K + 1
            ELSE
               DO 120 J = 1, N - 1
                  CALL <a name="ZLASSQ.173"></a><a href="zlassq.f.html#ZLASSQ.1">ZLASSQ</a>( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
     $                         SUM )
  120          CONTINUE
               L = 1
            END IF
            SUM = 2*SUM
         ELSE
            L = 1
         END IF
         DO 130 J = 1, N
            IF( DBLE( AB( L, J ) ).NE.ZERO ) THEN
               ABSA = ABS( DBLE( AB( L, J ) ) )
               IF( SCALE.LT.ABSA ) THEN
                  SUM = ONE + SUM*( SCALE / ABSA )**2
                  SCALE = ABSA
               ELSE
                  SUM = SUM + ( ABSA / SCALE )**2
               END IF
            END IF
  130    CONTINUE
         VALUE = SCALE*SQRT( SUM )
      END IF
<span class="comment">*</span><span class="comment">
</span>      <a name="ZLANHB.196"></a><a href="zlanhb.f.html#ZLANHB.1">ZLANHB</a> = VALUE
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="ZLANHB.199"></a><a href="zlanhb.f.html#ZLANHB.1">ZLANHB</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>