Annotation of rpl/lapack/lapack/dlantp.f, revision 1.18

1.11      bertrand    1: *> \brief \b DLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
1.8       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.15      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.8       bertrand    7: *
                      8: *> \htmlonly
1.15      bertrand    9: *> Download DLANTP + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlantp.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlantp.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlantp.f">
1.8       bertrand   15: *> [TXT]</a>
1.15      bertrand   16: *> \endhtmlonly
1.8       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
1.15      bertrand   22: *
1.8       bertrand   23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          DIAG, NORM, UPLO
                     25: *       INTEGER            N
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       DOUBLE PRECISION   AP( * ), WORK( * )
                     29: *       ..
1.15      bertrand   30: *
1.8       bertrand   31: *
                     32: *> \par Purpose:
                     33: *  =============
                     34: *>
                     35: *> \verbatim
                     36: *>
                     37: *> DLANTP  returns the value of the one norm,  or the Frobenius norm, or
                     38: *> the  infinity norm,  or the  element of  largest absolute value  of a
                     39: *> triangular matrix A, supplied in packed form.
                     40: *> \endverbatim
                     41: *>
                     42: *> \return DLANTP
                     43: *> \verbatim
                     44: *>
                     45: *>    DLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
                     46: *>             (
                     47: *>             ( norm1(A),         NORM = '1', 'O' or 'o'
                     48: *>             (
                     49: *>             ( normI(A),         NORM = 'I' or 'i'
                     50: *>             (
                     51: *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
                     52: *>
                     53: *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
                     54: *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
                     55: *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
                     56: *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
                     57: *> \endverbatim
                     58: *
                     59: *  Arguments:
                     60: *  ==========
                     61: *
                     62: *> \param[in] NORM
                     63: *> \verbatim
                     64: *>          NORM is CHARACTER*1
                     65: *>          Specifies the value to be returned in DLANTP as described
                     66: *>          above.
                     67: *> \endverbatim
                     68: *>
                     69: *> \param[in] UPLO
                     70: *> \verbatim
                     71: *>          UPLO is CHARACTER*1
                     72: *>          Specifies whether the matrix A is upper or lower triangular.
                     73: *>          = 'U':  Upper triangular
                     74: *>          = 'L':  Lower triangular
                     75: *> \endverbatim
                     76: *>
                     77: *> \param[in] DIAG
                     78: *> \verbatim
                     79: *>          DIAG is CHARACTER*1
                     80: *>          Specifies whether or not the matrix A is unit triangular.
                     81: *>          = 'N':  Non-unit triangular
                     82: *>          = 'U':  Unit triangular
                     83: *> \endverbatim
                     84: *>
                     85: *> \param[in] N
                     86: *> \verbatim
                     87: *>          N is INTEGER
                     88: *>          The order of the matrix A.  N >= 0.  When N = 0, DLANTP is
                     89: *>          set to zero.
                     90: *> \endverbatim
                     91: *>
                     92: *> \param[in] AP
                     93: *> \verbatim
                     94: *>          AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
                     95: *>          The upper or lower triangular matrix A, packed columnwise in
                     96: *>          a linear array.  The j-th column of A is stored in the array
                     97: *>          AP as follows:
                     98: *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
                     99: *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
                    100: *>          Note that when DIAG = 'U', the elements of the array AP
                    101: *>          corresponding to the diagonal elements of the matrix A are
                    102: *>          not referenced, but are assumed to be one.
                    103: *> \endverbatim
                    104: *>
                    105: *> \param[out] WORK
                    106: *> \verbatim
                    107: *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
                    108: *>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
                    109: *>          referenced.
                    110: *> \endverbatim
                    111: *
                    112: *  Authors:
                    113: *  ========
                    114: *
1.15      bertrand  115: *> \author Univ. of Tennessee
                    116: *> \author Univ. of California Berkeley
                    117: *> \author Univ. of Colorado Denver
                    118: *> \author NAG Ltd.
1.8       bertrand  119: *
1.15      bertrand  120: *> \date December 2016
1.8       bertrand  121: *
                    122: *> \ingroup doubleOTHERauxiliary
                    123: *
                    124: *  =====================================================================
1.1       bertrand  125:       DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
                    126: *
1.15      bertrand  127: *  -- LAPACK auxiliary routine (version 3.7.0) --
1.1       bertrand  128: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    129: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.15      bertrand  130: *     December 2016
1.1       bertrand  131: *
1.18    ! bertrand  132:       IMPLICIT NONE
1.1       bertrand  133: *     .. Scalar Arguments ..
                    134:       CHARACTER          DIAG, NORM, UPLO
                    135:       INTEGER            N
                    136: *     ..
                    137: *     .. Array Arguments ..
                    138:       DOUBLE PRECISION   AP( * ), WORK( * )
                    139: *     ..
                    140: *
                    141: * =====================================================================
                    142: *
                    143: *     .. Parameters ..
                    144:       DOUBLE PRECISION   ONE, ZERO
                    145:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
                    146: *     ..
                    147: *     .. Local Scalars ..
                    148:       LOGICAL            UDIAG
                    149:       INTEGER            I, J, K
1.18    ! bertrand  150:       DOUBLE PRECISION   SUM, VALUE
1.1       bertrand  151: *     ..
1.18    ! bertrand  152: *     .. Local Arrays ..
        !           153:       DOUBLE PRECISION   SSQ( 2 ), COLSSQ( 2 )
1.1       bertrand  154: *     ..
                    155: *     .. External Functions ..
1.11      bertrand  156:       LOGICAL            LSAME, DISNAN
                    157:       EXTERNAL           LSAME, DISNAN
1.1       bertrand  158: *     ..
1.18    ! bertrand  159: *     .. External Subroutines ..
        !           160:       EXTERNAL           DLASSQ, DCOMBSSQ
        !           161: *     ..
1.1       bertrand  162: *     .. Intrinsic Functions ..
1.11      bertrand  163:       INTRINSIC          ABS, SQRT
1.1       bertrand  164: *     ..
                    165: *     .. Executable Statements ..
                    166: *
                    167:       IF( N.EQ.0 ) THEN
                    168:          VALUE = ZERO
                    169:       ELSE IF( LSAME( NORM, 'M' ) ) THEN
                    170: *
                    171: *        Find max(abs(A(i,j))).
                    172: *
                    173:          K = 1
                    174:          IF( LSAME( DIAG, 'U' ) ) THEN
                    175:             VALUE = ONE
                    176:             IF( LSAME( UPLO, 'U' ) ) THEN
                    177:                DO 20 J = 1, N
                    178:                   DO 10 I = K, K + J - 2
1.11      bertrand  179:                      SUM = ABS( AP( I ) )
                    180:                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  181:    10             CONTINUE
                    182:                   K = K + J
                    183:    20          CONTINUE
                    184:             ELSE
                    185:                DO 40 J = 1, N
                    186:                   DO 30 I = K + 1, K + N - J
1.11      bertrand  187:                      SUM = ABS( AP( I ) )
                    188:                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  189:    30             CONTINUE
                    190:                   K = K + N - J + 1
                    191:    40          CONTINUE
                    192:             END IF
                    193:          ELSE
                    194:             VALUE = ZERO
                    195:             IF( LSAME( UPLO, 'U' ) ) THEN
                    196:                DO 60 J = 1, N
                    197:                   DO 50 I = K, K + J - 1
1.11      bertrand  198:                      SUM = ABS( AP( I ) )
                    199:                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  200:    50             CONTINUE
                    201:                   K = K + J
                    202:    60          CONTINUE
                    203:             ELSE
                    204:                DO 80 J = 1, N
                    205:                   DO 70 I = K, K + N - J
1.11      bertrand  206:                      SUM = ABS( AP( I ) )
                    207:                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  208:    70             CONTINUE
                    209:                   K = K + N - J + 1
                    210:    80          CONTINUE
                    211:             END IF
                    212:          END IF
                    213:       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
                    214: *
                    215: *        Find norm1(A).
                    216: *
                    217:          VALUE = ZERO
                    218:          K = 1
                    219:          UDIAG = LSAME( DIAG, 'U' )
                    220:          IF( LSAME( UPLO, 'U' ) ) THEN
                    221:             DO 110 J = 1, N
                    222:                IF( UDIAG ) THEN
                    223:                   SUM = ONE
                    224:                   DO 90 I = K, K + J - 2
                    225:                      SUM = SUM + ABS( AP( I ) )
                    226:    90             CONTINUE
                    227:                ELSE
                    228:                   SUM = ZERO
                    229:                   DO 100 I = K, K + J - 1
                    230:                      SUM = SUM + ABS( AP( I ) )
                    231:   100             CONTINUE
                    232:                END IF
                    233:                K = K + J
1.11      bertrand  234:                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  235:   110       CONTINUE
                    236:          ELSE
                    237:             DO 140 J = 1, N
                    238:                IF( UDIAG ) THEN
                    239:                   SUM = ONE
                    240:                   DO 120 I = K + 1, K + N - J
                    241:                      SUM = SUM + ABS( AP( I ) )
                    242:   120             CONTINUE
                    243:                ELSE
                    244:                   SUM = ZERO
                    245:                   DO 130 I = K, K + N - J
                    246:                      SUM = SUM + ABS( AP( I ) )
                    247:   130             CONTINUE
                    248:                END IF
                    249:                K = K + N - J + 1
1.11      bertrand  250:                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  251:   140       CONTINUE
                    252:          END IF
                    253:       ELSE IF( LSAME( NORM, 'I' ) ) THEN
                    254: *
                    255: *        Find normI(A).
                    256: *
                    257:          K = 1
                    258:          IF( LSAME( UPLO, 'U' ) ) THEN
                    259:             IF( LSAME( DIAG, 'U' ) ) THEN
                    260:                DO 150 I = 1, N
                    261:                   WORK( I ) = ONE
                    262:   150          CONTINUE
                    263:                DO 170 J = 1, N
                    264:                   DO 160 I = 1, J - 1
                    265:                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
                    266:                      K = K + 1
                    267:   160             CONTINUE
                    268:                   K = K + 1
                    269:   170          CONTINUE
                    270:             ELSE
                    271:                DO 180 I = 1, N
                    272:                   WORK( I ) = ZERO
                    273:   180          CONTINUE
                    274:                DO 200 J = 1, N
                    275:                   DO 190 I = 1, J
                    276:                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
                    277:                      K = K + 1
                    278:   190             CONTINUE
                    279:   200          CONTINUE
                    280:             END IF
                    281:          ELSE
                    282:             IF( LSAME( DIAG, 'U' ) ) THEN
                    283:                DO 210 I = 1, N
                    284:                   WORK( I ) = ONE
                    285:   210          CONTINUE
                    286:                DO 230 J = 1, N
                    287:                   K = K + 1
                    288:                   DO 220 I = J + 1, N
                    289:                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
                    290:                      K = K + 1
                    291:   220             CONTINUE
                    292:   230          CONTINUE
                    293:             ELSE
                    294:                DO 240 I = 1, N
                    295:                   WORK( I ) = ZERO
                    296:   240          CONTINUE
                    297:                DO 260 J = 1, N
                    298:                   DO 250 I = J, N
                    299:                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
                    300:                      K = K + 1
                    301:   250             CONTINUE
                    302:   260          CONTINUE
                    303:             END IF
                    304:          END IF
                    305:          VALUE = ZERO
                    306:          DO 270 I = 1, N
1.11      bertrand  307:             SUM = WORK( I )
                    308:             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  309:   270    CONTINUE
                    310:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
                    311: *
                    312: *        Find normF(A).
1.18    ! bertrand  313: *        SSQ(1) is scale
        !           314: *        SSQ(2) is sum-of-squares
        !           315: *        For better accuracy, sum each column separately.
1.1       bertrand  316: *
                    317:          IF( LSAME( UPLO, 'U' ) ) THEN
                    318:             IF( LSAME( DIAG, 'U' ) ) THEN
1.18    ! bertrand  319:                SSQ( 1 ) = ONE
        !           320:                SSQ( 2 ) = N
1.1       bertrand  321:                K = 2
                    322:                DO 280 J = 2, N
1.18    ! bertrand  323:                   COLSSQ( 1 ) = ZERO
        !           324:                   COLSSQ( 2 ) = ONE
        !           325:                   CALL DLASSQ( J-1, AP( K ), 1,
        !           326:      $                         COLSSQ( 1 ), COLSSQ( 2 ) )
        !           327:                   CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  328:                   K = K + J
                    329:   280          CONTINUE
                    330:             ELSE
1.18    ! bertrand  331:                SSQ( 1 ) = ZERO
        !           332:                SSQ( 2 ) = ONE
1.1       bertrand  333:                K = 1
                    334:                DO 290 J = 1, N
1.18    ! bertrand  335:                   COLSSQ( 1 ) = ZERO
        !           336:                   COLSSQ( 2 ) = ONE
        !           337:                   CALL DLASSQ( J, AP( K ), 1,
        !           338:      $                         COLSSQ( 1 ), COLSSQ( 2 ) )
        !           339:                   CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  340:                   K = K + J
                    341:   290          CONTINUE
                    342:             END IF
                    343:          ELSE
                    344:             IF( LSAME( DIAG, 'U' ) ) THEN
1.18    ! bertrand  345:                SSQ( 1 ) = ONE
        !           346:                SSQ( 2 ) = N
1.1       bertrand  347:                K = 2
                    348:                DO 300 J = 1, N - 1
1.18    ! bertrand  349:                   COLSSQ( 1 ) = ZERO
        !           350:                   COLSSQ( 2 ) = ONE
        !           351:                   CALL DLASSQ( N-J, AP( K ), 1,
        !           352:      $                         COLSSQ( 1 ), COLSSQ( 2 ) )
        !           353:                   CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  354:                   K = K + N - J + 1
                    355:   300          CONTINUE
                    356:             ELSE
1.18    ! bertrand  357:                SSQ( 1 ) = ZERO
        !           358:                SSQ( 2 ) = ONE
1.1       bertrand  359:                K = 1
                    360:                DO 310 J = 1, N
1.18    ! bertrand  361:                   COLSSQ( 1 ) = ZERO
        !           362:                   COLSSQ( 2 ) = ONE
        !           363:                   CALL DLASSQ( N-J+1, AP( K ), 1,
        !           364:      $                         COLSSQ( 1 ), COLSSQ( 2 ) )
        !           365:                   CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  366:                   K = K + N - J + 1
                    367:   310          CONTINUE
                    368:             END IF
                    369:          END IF
1.18    ! bertrand  370:          VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
1.1       bertrand  371:       END IF
                    372: *
                    373:       DLANTP = VALUE
                    374:       RETURN
                    375: *
                    376: *     End of DLANTP
                    377: *
                    378:       END

CVSweb interface <joel.bertrand@systella.fr>