LAPACK: SRC/dlantb.f Source File

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