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