LAPACK: SRC/clantb.f Source File

Go to the documentation of this file.
00001       REAL             FUNCTION CLANTB( NORM, UPLO, DIAG, N, K, AB,
00002      $                 LDAB, WORK )
00003 *
00004 *  -- LAPACK auxiliary routine (version 3.2) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       CHARACTER          DIAG, NORM, UPLO
00011       INTEGER            K, LDAB, N
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               WORK( * )
00015       COMPLEX            AB( LDAB, * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *  CLANTB  returns the value of the one norm,  or the Frobenius norm, or
00022 *  the  infinity norm,  or the element of  largest absolute value  of an
00023 *  n by n triangular band matrix A,  with ( k + 1 ) diagonals.
00024 *
00025 *  Description
00026 *  ===========
00027 *
00028 *  CLANTB returns the value
00029 *
00030 *     CLANTB = ( max(abs(A(i,j))), NORM = 'M' or 'm'
00031 *              (
00032 *              ( norm1(A),         NORM = '1', 'O' or 'o'
00033 *              (
00034 *              ( normI(A),         NORM = 'I' or 'i'
00035 *              (
00036 *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
00037 *
00038 *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
00039 *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
00040 *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
00041 *  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
00042 *
00043 *  Arguments
00044 *  =========
00045 *
00046 *  NORM    (input) CHARACTER*1
00047 *          Specifies the value to be returned in CLANTB as described
00048 *          above.
00049 *
00050 *  UPLO    (input) CHARACTER*1
00051 *          Specifies whether the matrix A is upper or lower triangular.
00052 *          = 'U':  Upper triangular
00053 *          = 'L':  Lower triangular
00054 *
00055 *  DIAG    (input) CHARACTER*1
00056 *          Specifies whether or not the matrix A is unit triangular.
00057 *          = 'N':  Non-unit triangular
00058 *          = 'U':  Unit triangular
00059 *
00060 *  N       (input) INTEGER
00061 *          The order of the matrix A.  N >= 0.  When N = 0, CLANTB is
00062 *          set to zero.
00063 *
00064 *  K       (input) INTEGER
00065 *          The number of super-diagonals of the matrix A if UPLO = 'U',
00066 *          or the number of sub-diagonals of the matrix A if UPLO = 'L'.
00067 *          K >= 0.
00068 *
00069 *  AB      (input) COMPLEX array, dimension (LDAB,N)
00070 *          The upper or lower triangular band matrix A, stored in the
00071 *          first k+1 rows of AB.  The j-th column of A is stored
00072 *          in the j-th column of the array AB as follows:
00073 *          if UPLO = 'U', AB(k+1+i-j,j) = A(i,j) for max(1,j-k)<=i<=j;
00074 *          if UPLO = 'L', AB(1+i-j,j)   = A(i,j) for j<=i<=min(n,j+k).
00075 *          Note that when DIAG = 'U', the elements of the array AB
00076 *          corresponding to the diagonal elements of the matrix A are
00077 *          not referenced, but are assumed to be one.
00078 *
00079 *  LDAB    (input) INTEGER
00080 *          The leading dimension of the array AB.  LDAB >= K+1.
00081 *
00082 *  WORK    (workspace) REAL array, dimension (MAX(1,LWORK)),
00083 *          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
00084 *          referenced.
00085 *
00086 * =====================================================================
00087 *
00088 *     .. Parameters ..
00089       REAL               ONE, ZERO
00090       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00091 *     ..
00092 *     .. Local Scalars ..
00093       LOGICAL            UDIAG
00094       INTEGER            I, J, L
00095       REAL               SCALE, SUM, VALUE
00096 *     ..
00097 *     .. External Functions ..
00098       LOGICAL            LSAME
00099       EXTERNAL           LSAME
00100 *     ..
00101 *     .. External Subroutines ..
00102       EXTERNAL           CLASSQ
00103 *     ..
00104 *     .. Intrinsic Functions ..
00105       INTRINSIC          ABS, MAX, MIN, SQRT
00106 *     ..
00107 *     .. Executable Statements ..
00108 *
00109       IF( N.EQ.0 ) THEN
00110          VALUE = ZERO
00111       ELSE IF( LSAME( NORM, 'M' ) ) THEN
00112 *
00113 *        Find max(abs(A(i,j))).
00114 *
00115          IF( LSAME( DIAG, 'U' ) ) THEN
00116             VALUE = ONE
00117             IF( LSAME( UPLO, 'U' ) ) THEN
00118                DO 20 J = 1, N
00119                   DO 10 I = MAX( K+2-J, 1 ), K
00120                      VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
00121    10             CONTINUE
00122    20          CONTINUE
00123             ELSE
00124                DO 40 J = 1, N
00125                   DO 30 I = 2, MIN( N+1-J, K+1 )
00126                      VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
00127    30             CONTINUE
00128    40          CONTINUE
00129             END IF
00130          ELSE
00131             VALUE = ZERO
00132             IF( LSAME( UPLO, 'U' ) ) THEN
00133                DO 60 J = 1, N
00134                   DO 50 I = MAX( K+2-J, 1 ), K + 1
00135                      VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
00136    50             CONTINUE
00137    60          CONTINUE
00138             ELSE
00139                DO 80 J = 1, N
00140                   DO 70 I = 1, MIN( N+1-J, K+1 )
00141                      VALUE = MAX( VALUE, ABS( AB( I, J ) ) )
00142    70             CONTINUE
00143    80          CONTINUE
00144             END IF
00145          END IF
00146       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
00147 *
00148 *        Find norm1(A).
00149 *
00150          VALUE = ZERO
00151          UDIAG = LSAME( DIAG, 'U' )
00152          IF( LSAME( UPLO, 'U' ) ) THEN
00153             DO 110 J = 1, N
00154                IF( UDIAG ) THEN
00155                   SUM = ONE
00156                   DO 90 I = MAX( K+2-J, 1 ), K
00157                      SUM = SUM + ABS( AB( I, J ) )
00158    90             CONTINUE
00159                ELSE
00160                   SUM = ZERO
00161                   DO 100 I = MAX( K+2-J, 1 ), K + 1
00162                      SUM = SUM + ABS( AB( I, J ) )
00163   100             CONTINUE
00164                END IF
00165                VALUE = MAX( VALUE, SUM )
00166   110       CONTINUE
00167          ELSE
00168             DO 140 J = 1, N
00169                IF( UDIAG ) THEN
00170                   SUM = ONE
00171                   DO 120 I = 2, MIN( N+1-J, K+1 )
00172                      SUM = SUM + ABS( AB( I, J ) )
00173   120             CONTINUE
00174                ELSE
00175                   SUM = ZERO
00176                   DO 130 I = 1, MIN( N+1-J, K+1 )
00177                      SUM = SUM + ABS( AB( I, J ) )
00178   130             CONTINUE
00179                END IF
00180                VALUE = MAX( VALUE, SUM )
00181   140       CONTINUE
00182          END IF
00183       ELSE IF( LSAME( NORM, 'I' ) ) THEN
00184 *
00185 *        Find normI(A).
00186 *
00187          VALUE = ZERO
00188          IF( LSAME( UPLO, 'U' ) ) THEN
00189             IF( LSAME( DIAG, 'U' ) ) THEN
00190                DO 150 I = 1, N
00191                   WORK( I ) = ONE
00192   150          CONTINUE
00193                DO 170 J = 1, N
00194                   L = K + 1 - J
00195                   DO 160 I = MAX( 1, J-K ), J - 1
00196                      WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
00197   160             CONTINUE
00198   170          CONTINUE
00199             ELSE
00200                DO 180 I = 1, N
00201                   WORK( I ) = ZERO
00202   180          CONTINUE
00203                DO 200 J = 1, N
00204                   L = K + 1 - J
00205                   DO 190 I = MAX( 1, J-K ), J
00206                      WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
00207   190             CONTINUE
00208   200          CONTINUE
00209             END IF
00210          ELSE
00211             IF( LSAME( DIAG, 'U' ) ) THEN
00212                DO 210 I = 1, N
00213                   WORK( I ) = ONE
00214   210          CONTINUE
00215                DO 230 J = 1, N
00216                   L = 1 - J
00217                   DO 220 I = J + 1, MIN( N, J+K )
00218                      WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
00219   220             CONTINUE
00220   230          CONTINUE
00221             ELSE
00222                DO 240 I = 1, N
00223                   WORK( I ) = ZERO
00224   240          CONTINUE
00225                DO 260 J = 1, N
00226                   L = 1 - J
00227                   DO 250 I = J, MIN( N, J+K )
00228                      WORK( I ) = WORK( I ) + ABS( AB( L+I, J ) )
00229   250             CONTINUE
00230   260          CONTINUE
00231             END IF
00232          END IF
00233          DO 270 I = 1, N
00234             VALUE = MAX( VALUE, WORK( I ) )
00235   270    CONTINUE
00236       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
00237 *
00238 *        Find normF(A).
00239 *
00240          IF( LSAME( UPLO, 'U' ) ) THEN
00241             IF( LSAME( DIAG, 'U' ) ) THEN
00242                SCALE = ONE
00243                SUM = N
00244                IF( K.GT.0 ) THEN
00245                   DO 280 J = 2, N
00246                      CALL CLASSQ( MIN( J-1, K ),
00247      $                            AB( MAX( K+2-J, 1 ), J ), 1, SCALE,
00248      $                            SUM )
00249   280             CONTINUE
00250                END IF
00251             ELSE
00252                SCALE = ZERO
00253                SUM = ONE
00254                DO 290 J = 1, N
00255                   CALL CLASSQ( MIN( J, K+1 ), AB( MAX( K+2-J, 1 ), J ),
00256      $                         1, SCALE, SUM )
00257   290          CONTINUE
00258             END IF
00259          ELSE
00260             IF( LSAME( DIAG, 'U' ) ) THEN
00261                SCALE = ONE
00262                SUM = N
00263                IF( K.GT.0 ) THEN
00264                   DO 300 J = 1, N - 1
00265                      CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
00266      $                            SUM )
00267   300             CONTINUE
00268                END IF
00269             ELSE
00270                SCALE = ZERO
00271                SUM = ONE
00272                DO 310 J = 1, N
00273                   CALL CLASSQ( MIN( N-J+1, K+1 ), AB( 1, J ), 1, SCALE,
00274      $                         SUM )
00275   310          CONTINUE
00276             END IF
00277          END IF
00278          VALUE = SCALE*SQRT( SUM )
00279       END IF
00280 *
00281       CLANTB = VALUE
00282       RETURN
00283 *
00284 *     End of CLANTB
00285 *
00286       END