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