Annotation of rpl/lapack/lapack/dlantr.f, revision 1.2

1.1       bertrand    1:       DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
                      2:      $                 WORK )
                      3: *
                      4: *  -- LAPACK auxiliary routine (version 3.2) --
                      5: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                      6: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                      7: *     November 2006
                      8: *
                      9: *     .. Scalar Arguments ..
                     10:       CHARACTER          DIAG, NORM, UPLO
                     11:       INTEGER            LDA, M, N
                     12: *     ..
                     13: *     .. Array Arguments ..
                     14:       DOUBLE PRECISION   A( LDA, * ), WORK( * )
                     15: *     ..
                     16: *
                     17: *  Purpose
                     18: *  =======
                     19: *
                     20: *  DLANTR  returns the value of the one norm,  or the Frobenius norm, or
                     21: *  the  infinity norm,  or the  element of  largest absolute value  of a
                     22: *  trapezoidal or triangular matrix A.
                     23: *
                     24: *  Description
                     25: *  ===========
                     26: *
                     27: *  DLANTR returns the value
                     28: *
                     29: *     DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
                     30: *              (
                     31: *              ( norm1(A),         NORM = '1', 'O' or 'o'
                     32: *              (
                     33: *              ( normI(A),         NORM = 'I' or 'i'
                     34: *              (
                     35: *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
                     36: *
                     37: *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
                     38: *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
                     39: *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
                     40: *  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
                     41: *
                     42: *  Arguments
                     43: *  =========
                     44: *
                     45: *  NORM    (input) CHARACTER*1
                     46: *          Specifies the value to be returned in DLANTR as described
                     47: *          above.
                     48: *
                     49: *  UPLO    (input) CHARACTER*1
                     50: *          Specifies whether the matrix A is upper or lower trapezoidal.
                     51: *          = 'U':  Upper trapezoidal
                     52: *          = 'L':  Lower trapezoidal
                     53: *          Note that A is triangular instead of trapezoidal if M = N.
                     54: *
                     55: *  DIAG    (input) CHARACTER*1
                     56: *          Specifies whether or not the matrix A has unit diagonal.
                     57: *          = 'N':  Non-unit diagonal
                     58: *          = 'U':  Unit diagonal
                     59: *
                     60: *  M       (input) INTEGER
                     61: *          The number of rows of the matrix A.  M >= 0, and if
                     62: *          UPLO = 'U', M <= N.  When M = 0, DLANTR is set to zero.
                     63: *
                     64: *  N       (input) INTEGER
                     65: *          The number of columns of the matrix A.  N >= 0, and if
                     66: *          UPLO = 'L', N <= M.  When N = 0, DLANTR is set to zero.
                     67: *
                     68: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
                     69: *          The trapezoidal matrix A (A is triangular if M = N).
                     70: *          If UPLO = 'U', the leading m by n upper trapezoidal part of
                     71: *          the array A contains the upper trapezoidal matrix, and the
                     72: *          strictly lower triangular part of A is not referenced.
                     73: *          If UPLO = 'L', the leading m by n lower trapezoidal part of
                     74: *          the array A contains the lower trapezoidal matrix, and the
                     75: *          strictly upper triangular part of A is not referenced.  Note
                     76: *          that when DIAG = 'U', the diagonal elements of A are not
                     77: *          referenced and are assumed to be one.
                     78: *
                     79: *  LDA     (input) INTEGER
                     80: *          The leading dimension of the array A.  LDA >= max(M,1).
                     81: *
                     82: *  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
                     83: *          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
                     84: *          referenced.
                     85: *
                     86: * =====================================================================
                     87: *
                     88: *     .. Parameters ..
                     89:       DOUBLE PRECISION   ONE, ZERO
                     90:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
                     91: *     ..
                     92: *     .. Local Scalars ..
                     93:       LOGICAL            UDIAG
                     94:       INTEGER            I, J
                     95:       DOUBLE PRECISION   SCALE, SUM, VALUE
                     96: *     ..
                     97: *     .. External Subroutines ..
                     98:       EXTERNAL           DLASSQ
                     99: *     ..
                    100: *     .. External Functions ..
                    101:       LOGICAL            LSAME
                    102:       EXTERNAL           LSAME
                    103: *     ..
                    104: *     .. Intrinsic Functions ..
                    105:       INTRINSIC          ABS, MAX, MIN, SQRT
                    106: *     ..
                    107: *     .. Executable Statements ..
                    108: *
                    109:       IF( MIN( M, N ).EQ.0 ) THEN
                    110:          VALUE = ZERO
                    111:       ELSE IF( LSAME( NORM, 'M' ) ) THEN
                    112: *
                    113: *        Find max(abs(A(i,j))).
                    114: *
                    115:          IF( LSAME( DIAG, 'U' ) ) THEN
                    116:             VALUE = ONE
                    117:             IF( LSAME( UPLO, 'U' ) ) THEN
                    118:                DO 20 J = 1, N
                    119:                   DO 10 I = 1, MIN( M, J-1 )
                    120:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
                    121:    10             CONTINUE
                    122:    20          CONTINUE
                    123:             ELSE
                    124:                DO 40 J = 1, N
                    125:                   DO 30 I = J + 1, M
                    126:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
                    127:    30             CONTINUE
                    128:    40          CONTINUE
                    129:             END IF
                    130:          ELSE
                    131:             VALUE = ZERO
                    132:             IF( LSAME( UPLO, 'U' ) ) THEN
                    133:                DO 60 J = 1, N
                    134:                   DO 50 I = 1, MIN( M, J )
                    135:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
                    136:    50             CONTINUE
                    137:    60          CONTINUE
                    138:             ELSE
                    139:                DO 80 J = 1, N
                    140:                   DO 70 I = J, M
                    141:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
                    142:    70             CONTINUE
                    143:    80          CONTINUE
                    144:             END IF
                    145:          END IF
                    146:       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
                    147: *
                    148: *        Find norm1(A).
                    149: *
                    150:          VALUE = ZERO
                    151:          UDIAG = LSAME( DIAG, 'U' )
                    152:          IF( LSAME( UPLO, 'U' ) ) THEN
                    153:             DO 110 J = 1, N
                    154:                IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
                    155:                   SUM = ONE
                    156:                   DO 90 I = 1, J - 1
                    157:                      SUM = SUM + ABS( A( I, J ) )
                    158:    90             CONTINUE
                    159:                ELSE
                    160:                   SUM = ZERO
                    161:                   DO 100 I = 1, MIN( M, J )
                    162:                      SUM = SUM + ABS( A( I, J ) )
                    163:   100             CONTINUE
                    164:                END IF
                    165:                VALUE = MAX( VALUE, SUM )
                    166:   110       CONTINUE
                    167:          ELSE
                    168:             DO 140 J = 1, N
                    169:                IF( UDIAG ) THEN
                    170:                   SUM = ONE
                    171:                   DO 120 I = J + 1, M
                    172:                      SUM = SUM + ABS( A( I, J ) )
                    173:   120             CONTINUE
                    174:                ELSE
                    175:                   SUM = ZERO
                    176:                   DO 130 I = J, M
                    177:                      SUM = SUM + ABS( A( I, J ) )
                    178:   130             CONTINUE
                    179:                END IF
                    180:                VALUE = MAX( VALUE, SUM )
                    181:   140       CONTINUE
                    182:          END IF
                    183:       ELSE IF( LSAME( NORM, 'I' ) ) THEN
                    184: *
                    185: *        Find normI(A).
                    186: *
                    187:          IF( LSAME( UPLO, 'U' ) ) THEN
                    188:             IF( LSAME( DIAG, 'U' ) ) THEN
                    189:                DO 150 I = 1, M
                    190:                   WORK( I ) = ONE
                    191:   150          CONTINUE
                    192:                DO 170 J = 1, N
                    193:                   DO 160 I = 1, MIN( M, J-1 )
                    194:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
                    195:   160             CONTINUE
                    196:   170          CONTINUE
                    197:             ELSE
                    198:                DO 180 I = 1, M
                    199:                   WORK( I ) = ZERO
                    200:   180          CONTINUE
                    201:                DO 200 J = 1, N
                    202:                   DO 190 I = 1, MIN( M, J )
                    203:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
                    204:   190             CONTINUE
                    205:   200          CONTINUE
                    206:             END IF
                    207:          ELSE
                    208:             IF( LSAME( DIAG, 'U' ) ) THEN
                    209:                DO 210 I = 1, N
                    210:                   WORK( I ) = ONE
                    211:   210          CONTINUE
                    212:                DO 220 I = N + 1, M
                    213:                   WORK( I ) = ZERO
                    214:   220          CONTINUE
                    215:                DO 240 J = 1, N
                    216:                   DO 230 I = J + 1, M
                    217:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
                    218:   230             CONTINUE
                    219:   240          CONTINUE
                    220:             ELSE
                    221:                DO 250 I = 1, M
                    222:                   WORK( I ) = ZERO
                    223:   250          CONTINUE
                    224:                DO 270 J = 1, N
                    225:                   DO 260 I = J, M
                    226:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
                    227:   260             CONTINUE
                    228:   270          CONTINUE
                    229:             END IF
                    230:          END IF
                    231:          VALUE = ZERO
                    232:          DO 280 I = 1, M
                    233:             VALUE = MAX( VALUE, WORK( I ) )
                    234:   280    CONTINUE
                    235:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
                    236: *
                    237: *        Find normF(A).
                    238: *
                    239:          IF( LSAME( UPLO, 'U' ) ) THEN
                    240:             IF( LSAME( DIAG, 'U' ) ) THEN
                    241:                SCALE = ONE
                    242:                SUM = MIN( M, N )
                    243:                DO 290 J = 2, N
                    244:                   CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
                    245:   290          CONTINUE
                    246:             ELSE
                    247:                SCALE = ZERO
                    248:                SUM = ONE
                    249:                DO 300 J = 1, N
                    250:                   CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
                    251:   300          CONTINUE
                    252:             END IF
                    253:          ELSE
                    254:             IF( LSAME( DIAG, 'U' ) ) THEN
                    255:                SCALE = ONE
                    256:                SUM = MIN( M, N )
                    257:                DO 310 J = 1, N
                    258:                   CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
                    259:      $                         SUM )
                    260:   310          CONTINUE
                    261:             ELSE
                    262:                SCALE = ZERO
                    263:                SUM = ONE
                    264:                DO 320 J = 1, N
                    265:                   CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
                    266:   320          CONTINUE
                    267:             END IF
                    268:          END IF
                    269:          VALUE = SCALE*SQRT( SUM )
                    270:       END IF
                    271: *
                    272:       DLANTR = VALUE
                    273:       RETURN
                    274: *
                    275: *     End of DLANTR
                    276: *
                    277:       END

CVSweb interface <joel.bertrand@systella.fr>