```001:       DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
002:      \$                 WORK )
003: *
004: *  -- LAPACK auxiliary routine (version 3.2) --
005: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       CHARACTER          DIAG, NORM, UPLO
010:       INTEGER            LDA, M, N
011: *     ..
012: *     .. Array Arguments ..
013:       DOUBLE PRECISION   A( LDA, * ), WORK( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DLANTR  returns the value of the one norm,  or the Frobenius norm, or
020: *  the  infinity norm,  or the  element of  largest absolute value  of a
021: *  trapezoidal or triangular matrix A.
022: *
023: *  Description
024: *  ===========
025: *
026: *  DLANTR returns the value
027: *
028: *     DLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
029: *              (
030: *              ( norm1(A),         NORM = '1', 'O' or 'o'
031: *              (
032: *              ( normI(A),         NORM = 'I' or 'i'
033: *              (
034: *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
035: *
036: *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
037: *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
038: *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
039: *  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
040: *
041: *  Arguments
042: *  =========
043: *
044: *  NORM    (input) CHARACTER*1
045: *          Specifies the value to be returned in DLANTR as described
046: *          above.
047: *
048: *  UPLO    (input) CHARACTER*1
049: *          Specifies whether the matrix A is upper or lower trapezoidal.
050: *          = 'U':  Upper trapezoidal
051: *          = 'L':  Lower trapezoidal
052: *          Note that A is triangular instead of trapezoidal if M = N.
053: *
054: *  DIAG    (input) CHARACTER*1
055: *          Specifies whether or not the matrix A has unit diagonal.
056: *          = 'N':  Non-unit diagonal
057: *          = 'U':  Unit diagonal
058: *
059: *  M       (input) INTEGER
060: *          The number of rows of the matrix A.  M >= 0, and if
061: *          UPLO = 'U', M <= N.  When M = 0, DLANTR is set to zero.
062: *
063: *  N       (input) INTEGER
064: *          The number of columns of the matrix A.  N >= 0, and if
065: *          UPLO = 'L', N <= M.  When N = 0, DLANTR is set to zero.
066: *
067: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
068: *          The trapezoidal matrix A (A is triangular if M = N).
069: *          If UPLO = 'U', the leading m by n upper trapezoidal part of
070: *          the array A contains the upper trapezoidal matrix, and the
071: *          strictly lower triangular part of A is not referenced.
072: *          If UPLO = 'L', the leading m by n lower trapezoidal part of
073: *          the array A contains the lower trapezoidal matrix, and the
074: *          strictly upper triangular part of A is not referenced.  Note
075: *          that when DIAG = 'U', the diagonal elements of A are not
076: *          referenced and are assumed to be one.
077: *
078: *  LDA     (input) INTEGER
079: *          The leading dimension of the array A.  LDA >= max(M,1).
080: *
081: *  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
082: *          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
083: *          referenced.
084: *
085: * =====================================================================
086: *
087: *     .. Parameters ..
088:       DOUBLE PRECISION   ONE, ZERO
089:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
090: *     ..
091: *     .. Local Scalars ..
092:       LOGICAL            UDIAG
093:       INTEGER            I, J
094:       DOUBLE PRECISION   SCALE, SUM, VALUE
095: *     ..
096: *     .. External Subroutines ..
097:       EXTERNAL           DLASSQ
098: *     ..
099: *     .. External Functions ..
100:       LOGICAL            LSAME
101:       EXTERNAL           LSAME
102: *     ..
103: *     .. Intrinsic Functions ..
104:       INTRINSIC          ABS, MAX, MIN, SQRT
105: *     ..
106: *     .. Executable Statements ..
107: *
108:       IF( MIN( M, N ).EQ.0 ) THEN
109:          VALUE = ZERO
110:       ELSE IF( LSAME( NORM, 'M' ) ) THEN
111: *
112: *        Find max(abs(A(i,j))).
113: *
114:          IF( LSAME( DIAG, 'U' ) ) THEN
115:             VALUE = ONE
116:             IF( LSAME( UPLO, 'U' ) ) THEN
117:                DO 20 J = 1, N
118:                   DO 10 I = 1, MIN( M, J-1 )
119:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
120:    10             CONTINUE
121:    20          CONTINUE
122:             ELSE
123:                DO 40 J = 1, N
124:                   DO 30 I = J + 1, M
125:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
126:    30             CONTINUE
127:    40          CONTINUE
128:             END IF
129:          ELSE
130:             VALUE = ZERO
131:             IF( LSAME( UPLO, 'U' ) ) THEN
132:                DO 60 J = 1, N
133:                   DO 50 I = 1, MIN( M, J )
134:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
135:    50             CONTINUE
136:    60          CONTINUE
137:             ELSE
138:                DO 80 J = 1, N
139:                   DO 70 I = J, M
140:                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
141:    70             CONTINUE
142:    80          CONTINUE
143:             END IF
144:          END IF
145:       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
146: *
147: *        Find norm1(A).
148: *
149:          VALUE = ZERO
150:          UDIAG = LSAME( DIAG, 'U' )
151:          IF( LSAME( UPLO, 'U' ) ) THEN
152:             DO 110 J = 1, N
153:                IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
154:                   SUM = ONE
155:                   DO 90 I = 1, J - 1
156:                      SUM = SUM + ABS( A( I, J ) )
157:    90             CONTINUE
158:                ELSE
159:                   SUM = ZERO
160:                   DO 100 I = 1, MIN( M, J )
161:                      SUM = SUM + ABS( A( I, J ) )
162:   100             CONTINUE
163:                END IF
164:                VALUE = MAX( VALUE, SUM )
165:   110       CONTINUE
166:          ELSE
167:             DO 140 J = 1, N
168:                IF( UDIAG ) THEN
169:                   SUM = ONE
170:                   DO 120 I = J + 1, M
171:                      SUM = SUM + ABS( A( I, J ) )
172:   120             CONTINUE
173:                ELSE
174:                   SUM = ZERO
175:                   DO 130 I = J, M
176:                      SUM = SUM + ABS( A( I, J ) )
177:   130             CONTINUE
178:                END IF
179:                VALUE = MAX( VALUE, SUM )
180:   140       CONTINUE
181:          END IF
182:       ELSE IF( LSAME( NORM, 'I' ) ) THEN
183: *
184: *        Find normI(A).
185: *
186:          IF( LSAME( UPLO, 'U' ) ) THEN
187:             IF( LSAME( DIAG, 'U' ) ) THEN
188:                DO 150 I = 1, M
189:                   WORK( I ) = ONE
190:   150          CONTINUE
191:                DO 170 J = 1, N
192:                   DO 160 I = 1, MIN( M, J-1 )
193:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
194:   160             CONTINUE
195:   170          CONTINUE
196:             ELSE
197:                DO 180 I = 1, M
198:                   WORK( I ) = ZERO
199:   180          CONTINUE
200:                DO 200 J = 1, N
201:                   DO 190 I = 1, MIN( M, J )
202:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
203:   190             CONTINUE
204:   200          CONTINUE
205:             END IF
206:          ELSE
207:             IF( LSAME( DIAG, 'U' ) ) THEN
208:                DO 210 I = 1, N
209:                   WORK( I ) = ONE
210:   210          CONTINUE
211:                DO 220 I = N + 1, M
212:                   WORK( I ) = ZERO
213:   220          CONTINUE
214:                DO 240 J = 1, N
215:                   DO 230 I = J + 1, M
216:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
217:   230             CONTINUE
218:   240          CONTINUE
219:             ELSE
220:                DO 250 I = 1, M
221:                   WORK( I ) = ZERO
222:   250          CONTINUE
223:                DO 270 J = 1, N
224:                   DO 260 I = J, M
225:                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
226:   260             CONTINUE
227:   270          CONTINUE
228:             END IF
229:          END IF
230:          VALUE = ZERO
231:          DO 280 I = 1, M
232:             VALUE = MAX( VALUE, WORK( I ) )
233:   280    CONTINUE
234:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
235: *
236: *        Find normF(A).
237: *
238:          IF( LSAME( UPLO, 'U' ) ) THEN
239:             IF( LSAME( DIAG, 'U' ) ) THEN
240:                SCALE = ONE
241:                SUM = MIN( M, N )
242:                DO 290 J = 2, N
243:                   CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
244:   290          CONTINUE
245:             ELSE
246:                SCALE = ZERO
247:                SUM = ONE
248:                DO 300 J = 1, N
249:                   CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
250:   300          CONTINUE
251:             END IF
252:          ELSE
253:             IF( LSAME( DIAG, 'U' ) ) THEN
254:                SCALE = ONE
255:                SUM = MIN( M, N )
256:                DO 310 J = 1, N
257:                   CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
258:      \$                         SUM )
259:   310          CONTINUE
260:             ELSE
261:                SCALE = ZERO
262:                SUM = ONE
263:                DO 320 J = 1, N
264:                   CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
265:   320          CONTINUE
266:             END IF
267:          END IF
268:          VALUE = SCALE*SQRT( SUM )
269:       END IF
270: *
271:       DLANTR = VALUE
272:       RETURN
273: *
274: *     End of DLANTR
275: *
276:       END
277: ```