LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dlantr.f
Go to the documentation of this file.
00001 *> \brief \b DLANTR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DLANTR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
00022 *                        WORK )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER          DIAG, NORM, UPLO
00026 *       INTEGER            LDA, M, N
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       DOUBLE PRECISION   A( LDA, * ), WORK( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> DLANTR  returns the value of the one norm,  or the Frobenius norm, or
00039 *> the  infinity norm,  or the  element of  largest absolute value  of a
00040 *> trapezoidal or triangular matrix A.
00041 *> \endverbatim
00042 *>
00043 *> \return DLANTR
00044 *> \verbatim
00045 *>
00046 *>    DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
00047 *>             (
00048 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
00049 *>             (
00050 *>             ( normI(A),         NORM = 'I' or 'i'
00051 *>             (
00052 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
00053 *>
00054 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
00055 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
00056 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
00057 *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
00058 *> \endverbatim
00059 *
00060 *  Arguments:
00061 *  ==========
00062 *
00063 *> \param[in] NORM
00064 *> \verbatim
00065 *>          NORM is CHARACTER*1
00066 *>          Specifies the value to be returned in DLANTR as described
00067 *>          above.
00068 *> \endverbatim
00069 *>
00070 *> \param[in] UPLO
00071 *> \verbatim
00072 *>          UPLO is CHARACTER*1
00073 *>          Specifies whether the matrix A is upper or lower trapezoidal.
00074 *>          = 'U':  Upper trapezoidal
00075 *>          = 'L':  Lower trapezoidal
00076 *>          Note that A is triangular instead of trapezoidal if M = N.
00077 *> \endverbatim
00078 *>
00079 *> \param[in] DIAG
00080 *> \verbatim
00081 *>          DIAG is CHARACTER*1
00082 *>          Specifies whether or not the matrix A has unit diagonal.
00083 *>          = 'N':  Non-unit diagonal
00084 *>          = 'U':  Unit diagonal
00085 *> \endverbatim
00086 *>
00087 *> \param[in] M
00088 *> \verbatim
00089 *>          M is INTEGER
00090 *>          The number of rows of the matrix A.  M >= 0, and if
00091 *>          UPLO = 'U', M <= N.  When M = 0, DLANTR is set to zero.
00092 *> \endverbatim
00093 *>
00094 *> \param[in] N
00095 *> \verbatim
00096 *>          N is INTEGER
00097 *>          The number of columns of the matrix A.  N >= 0, and if
00098 *>          UPLO = 'L', N <= M.  When N = 0, DLANTR is set to zero.
00099 *> \endverbatim
00100 *>
00101 *> \param[in] A
00102 *> \verbatim
00103 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
00104 *>          The trapezoidal matrix A (A is triangular if M = N).
00105 *>          If UPLO = 'U', the leading m by n upper trapezoidal part of
00106 *>          the array A contains the upper trapezoidal matrix, and the
00107 *>          strictly lower triangular part of A is not referenced.
00108 *>          If UPLO = 'L', the leading m by n lower trapezoidal part of
00109 *>          the array A contains the lower trapezoidal matrix, and the
00110 *>          strictly upper triangular part of A is not referenced.  Note
00111 *>          that when DIAG = 'U', the diagonal elements of A are not
00112 *>          referenced and are assumed to be one.
00113 *> \endverbatim
00114 *>
00115 *> \param[in] LDA
00116 *> \verbatim
00117 *>          LDA is INTEGER
00118 *>          The leading dimension of the array A.  LDA >= max(M,1).
00119 *> \endverbatim
00120 *>
00121 *> \param[out] WORK
00122 *> \verbatim
00123 *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
00124 *>          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
00125 *>          referenced.
00126 *> \endverbatim
00127 *
00128 *  Authors:
00129 *  ========
00130 *
00131 *> \author Univ. of Tennessee 
00132 *> \author Univ. of California Berkeley 
00133 *> \author Univ. of Colorado Denver 
00134 *> \author NAG Ltd. 
00135 *
00136 *> \date November 2011
00137 *
00138 *> \ingroup doubleOTHERauxiliary
00139 *
00140 *  =====================================================================
00141       DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
00142      $                 WORK )
00143 *
00144 *  -- LAPACK auxiliary routine (version 3.4.0) --
00145 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00146 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00147 *     November 2011
00148 *
00149 *     .. Scalar Arguments ..
00150       CHARACTER          DIAG, NORM, UPLO
00151       INTEGER            LDA, M, N
00152 *     ..
00153 *     .. Array Arguments ..
00154       DOUBLE PRECISION   A( LDA, * ), WORK( * )
00155 *     ..
00156 *
00157 * =====================================================================
00158 *
00159 *     .. Parameters ..
00160       DOUBLE PRECISION   ONE, ZERO
00161       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00162 *     ..
00163 *     .. Local Scalars ..
00164       LOGICAL            UDIAG
00165       INTEGER            I, J
00166       DOUBLE PRECISION   SCALE, SUM, VALUE
00167 *     ..
00168 *     .. External Subroutines ..
00169       EXTERNAL           DLASSQ
00170 *     ..
00171 *     .. External Functions ..
00172       LOGICAL            LSAME
00173       EXTERNAL           LSAME
00174 *     ..
00175 *     .. Intrinsic Functions ..
00176       INTRINSIC          ABS, MAX, MIN, SQRT
00177 *     ..
00178 *     .. Executable Statements ..
00179 *
00180       IF( MIN( M, N ).EQ.0 ) THEN
00181          VALUE = ZERO
00182       ELSE IF( LSAME( NORM, 'M' ) ) THEN
00183 *
00184 *        Find max(abs(A(i,j))).
00185 *
00186          IF( LSAME( DIAG, 'U' ) ) THEN
00187             VALUE = ONE
00188             IF( LSAME( UPLO, 'U' ) ) THEN
00189                DO 20 J = 1, N
00190                   DO 10 I = 1, MIN( M, J-1 )
00191                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00192    10             CONTINUE
00193    20          CONTINUE
00194             ELSE
00195                DO 40 J = 1, N
00196                   DO 30 I = J + 1, M
00197                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00198    30             CONTINUE
00199    40          CONTINUE
00200             END IF
00201          ELSE
00202             VALUE = ZERO
00203             IF( LSAME( UPLO, 'U' ) ) THEN
00204                DO 60 J = 1, N
00205                   DO 50 I = 1, MIN( M, J )
00206                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00207    50             CONTINUE
00208    60          CONTINUE
00209             ELSE
00210                DO 80 J = 1, N
00211                   DO 70 I = J, M
00212                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00213    70             CONTINUE
00214    80          CONTINUE
00215             END IF
00216          END IF
00217       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
00218 *
00219 *        Find norm1(A).
00220 *
00221          VALUE = ZERO
00222          UDIAG = LSAME( DIAG, 'U' )
00223          IF( LSAME( UPLO, 'U' ) ) THEN
00224             DO 110 J = 1, N
00225                IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
00226                   SUM = ONE
00227                   DO 90 I = 1, J - 1
00228                      SUM = SUM + ABS( A( I, J ) )
00229    90             CONTINUE
00230                ELSE
00231                   SUM = ZERO
00232                   DO 100 I = 1, MIN( M, J )
00233                      SUM = SUM + ABS( A( I, J ) )
00234   100             CONTINUE
00235                END IF
00236                VALUE = MAX( VALUE, SUM )
00237   110       CONTINUE
00238          ELSE
00239             DO 140 J = 1, N
00240                IF( UDIAG ) THEN
00241                   SUM = ONE
00242                   DO 120 I = J + 1, M
00243                      SUM = SUM + ABS( A( I, J ) )
00244   120             CONTINUE
00245                ELSE
00246                   SUM = ZERO
00247                   DO 130 I = J, M
00248                      SUM = SUM + ABS( A( I, J ) )
00249   130             CONTINUE
00250                END IF
00251                VALUE = MAX( VALUE, SUM )
00252   140       CONTINUE
00253          END IF
00254       ELSE IF( LSAME( NORM, 'I' ) ) THEN
00255 *
00256 *        Find normI(A).
00257 *
00258          IF( LSAME( UPLO, 'U' ) ) THEN
00259             IF( LSAME( DIAG, 'U' ) ) THEN
00260                DO 150 I = 1, M
00261                   WORK( I ) = ONE
00262   150          CONTINUE
00263                DO 170 J = 1, N
00264                   DO 160 I = 1, MIN( M, J-1 )
00265                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00266   160             CONTINUE
00267   170          CONTINUE
00268             ELSE
00269                DO 180 I = 1, M
00270                   WORK( I ) = ZERO
00271   180          CONTINUE
00272                DO 200 J = 1, N
00273                   DO 190 I = 1, MIN( M, J )
00274                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00275   190             CONTINUE
00276   200          CONTINUE
00277             END IF
00278          ELSE
00279             IF( LSAME( DIAG, 'U' ) ) THEN
00280                DO 210 I = 1, N
00281                   WORK( I ) = ONE
00282   210          CONTINUE
00283                DO 220 I = N + 1, M
00284                   WORK( I ) = ZERO
00285   220          CONTINUE
00286                DO 240 J = 1, N
00287                   DO 230 I = J + 1, M
00288                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00289   230             CONTINUE
00290   240          CONTINUE
00291             ELSE
00292                DO 250 I = 1, M
00293                   WORK( I ) = ZERO
00294   250          CONTINUE
00295                DO 270 J = 1, N
00296                   DO 260 I = J, M
00297                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00298   260             CONTINUE
00299   270          CONTINUE
00300             END IF
00301          END IF
00302          VALUE = ZERO
00303          DO 280 I = 1, M
00304             VALUE = MAX( VALUE, WORK( I ) )
00305   280    CONTINUE
00306       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
00307 *
00308 *        Find normF(A).
00309 *
00310          IF( LSAME( UPLO, 'U' ) ) THEN
00311             IF( LSAME( DIAG, 'U' ) ) THEN
00312                SCALE = ONE
00313                SUM = MIN( M, N )
00314                DO 290 J = 2, N
00315                   CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
00316   290          CONTINUE
00317             ELSE
00318                SCALE = ZERO
00319                SUM = ONE
00320                DO 300 J = 1, N
00321                   CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
00322   300          CONTINUE
00323             END IF
00324          ELSE
00325             IF( LSAME( DIAG, 'U' ) ) THEN
00326                SCALE = ONE
00327                SUM = MIN( M, N )
00328                DO 310 J = 1, N
00329                   CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
00330      $                         SUM )
00331   310          CONTINUE
00332             ELSE
00333                SCALE = ZERO
00334                SUM = ONE
00335                DO 320 J = 1, N
00336                   CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
00337   320          CONTINUE
00338             END IF
00339          END IF
00340          VALUE = SCALE*SQRT( SUM )
00341       END IF
00342 *
00343       DLANTR = VALUE
00344       RETURN
00345 *
00346 *     End of DLANTR
00347 *
00348       END
 All Files Functions