1*> \brief \b SLANTP 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.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLANTP + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slantp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slantp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slantp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       REAL             FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          DIAG, NORM, UPLO
25*       INTEGER            N
26*       ..
27*       .. Array Arguments ..
28*       REAL               AP( * ), WORK( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> SLANTP  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 SLANTP
43*> \verbatim
44*>
45*>    SLANTP = ( 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 SLANTP 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, SLANTP is
89*>          set to zero.
90*> \endverbatim
91*>
92*> \param[in] AP
93*> \verbatim
94*>          AP is REAL 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 REAL 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*
115*> \author Univ. of Tennessee
116*> \author Univ. of California Berkeley
117*> \author Univ. of Colorado Denver
118*> \author NAG Ltd.
119*
120*> \date September 2012
121*
122*> \ingroup realOTHERauxiliary
123*
124*  =====================================================================
125      REAL             FUNCTION SLANTP( NORM, UPLO, DIAG, N, AP, WORK )
126*
127*  -- LAPACK auxiliary routine (version 3.4.2) --
128*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
129*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130*     September 2012
131*
132*     .. Scalar Arguments ..
133      CHARACTER          DIAG, NORM, UPLO
134      INTEGER            N
135*     ..
136*     .. Array Arguments ..
137      REAL               AP( * ), WORK( * )
138*     ..
139*
140* =====================================================================
141*
142*     .. Parameters ..
143      REAL               ONE, ZERO
144      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
145*     ..
146*     .. Local Scalars ..
147      LOGICAL            UDIAG
148      INTEGER            I, J, K
149      REAL               SCALE, SUM, VALUE
150*     ..
151*     .. External Subroutines ..
152      EXTERNAL           SLASSQ
153*     ..
154*     .. External Functions ..
155      LOGICAL            LSAME, SISNAN
156      EXTERNAL           LSAME, SISNAN
157*     ..
158*     .. Intrinsic Functions ..
159      INTRINSIC          ABS, SQRT
160*     ..
161*     .. Executable Statements ..
162*
163      IF( N.EQ.0 ) THEN
164         VALUE = ZERO
165      ELSE IF( LSAME( NORM, 'M' ) ) THEN
166*
167*        Find max(abs(A(i,j))).
168*
169         K = 1
170         IF( LSAME( DIAG, 'U' ) ) THEN
171            VALUE = ONE
172            IF( LSAME( UPLO, 'U' ) ) THEN
173               DO 20 J = 1, N
174                  DO 10 I = K, K + J - 2
175                     SUM = ABS( AP( I ) )
176                     IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
177   10             CONTINUE
178                  K = K + J
179   20          CONTINUE
180            ELSE
181               DO 40 J = 1, N
182                  DO 30 I = K + 1, K + N - J
183                     SUM = ABS( AP( I ) )
184                     IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
185   30             CONTINUE
186                  K = K + N - J + 1
187   40          CONTINUE
188            END IF
189         ELSE
190            VALUE = ZERO
191            IF( LSAME( UPLO, 'U' ) ) THEN
192               DO 60 J = 1, N
193                  DO 50 I = K, K + J - 1
194                     SUM = ABS( AP( I ) )
195                     IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
196   50             CONTINUE
197                  K = K + J
198   60          CONTINUE
199            ELSE
200               DO 80 J = 1, N
201                  DO 70 I = K, K + N - J
202                     SUM = ABS( AP( I ) )
203                     IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
204   70             CONTINUE
205                  K = K + N - J + 1
206   80          CONTINUE
207            END IF
208         END IF
209      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
210*
211*        Find norm1(A).
212*
213         VALUE = ZERO
214         K = 1
215         UDIAG = LSAME( DIAG, 'U' )
216         IF( LSAME( UPLO, 'U' ) ) THEN
217            DO 110 J = 1, N
218               IF( UDIAG ) THEN
219                  SUM = ONE
220                  DO 90 I = K, K + J - 2
221                     SUM = SUM + ABS( AP( I ) )
222   90             CONTINUE
223               ELSE
224                  SUM = ZERO
225                  DO 100 I = K, K + J - 1
226                     SUM = SUM + ABS( AP( I ) )
227  100             CONTINUE
228               END IF
229               K = K + J
230               IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
231  110       CONTINUE
232         ELSE
233            DO 140 J = 1, N
234               IF( UDIAG ) THEN
235                  SUM = ONE
236                  DO 120 I = K + 1, K + N - J
237                     SUM = SUM + ABS( AP( I ) )
238  120             CONTINUE
239               ELSE
240                  SUM = ZERO
241                  DO 130 I = K, K + N - J
242                     SUM = SUM + ABS( AP( I ) )
243  130             CONTINUE
244               END IF
245               K = K + N - J + 1
246               IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
247  140       CONTINUE
248         END IF
249      ELSE IF( LSAME( NORM, 'I' ) ) THEN
250*
251*        Find normI(A).
252*
253         K = 1
254         IF( LSAME( UPLO, 'U' ) ) THEN
255            IF( LSAME( DIAG, 'U' ) ) THEN
256               DO 150 I = 1, N
257                  WORK( I ) = ONE
258  150          CONTINUE
259               DO 170 J = 1, N
260                  DO 160 I = 1, J - 1
261                     WORK( I ) = WORK( I ) + ABS( AP( K ) )
262                     K = K + 1
263  160             CONTINUE
264                  K = K + 1
265  170          CONTINUE
266            ELSE
267               DO 180 I = 1, N
268                  WORK( I ) = ZERO
269  180          CONTINUE
270               DO 200 J = 1, N
271                  DO 190 I = 1, J
272                     WORK( I ) = WORK( I ) + ABS( AP( K ) )
273                     K = K + 1
274  190             CONTINUE
275  200          CONTINUE
276            END IF
277         ELSE
278            IF( LSAME( DIAG, 'U' ) ) THEN
279               DO 210 I = 1, N
280                  WORK( I ) = ONE
281  210          CONTINUE
282               DO 230 J = 1, N
283                  K = K + 1
284                  DO 220 I = J + 1, N
285                     WORK( I ) = WORK( I ) + ABS( AP( K ) )
286                     K = K + 1
287  220             CONTINUE
288  230          CONTINUE
289            ELSE
290               DO 240 I = 1, N
291                  WORK( I ) = ZERO
292  240          CONTINUE
293               DO 260 J = 1, N
294                  DO 250 I = J, N
295                     WORK( I ) = WORK( I ) + ABS( AP( K ) )
296                     K = K + 1
297  250             CONTINUE
298  260          CONTINUE
299            END IF
300         END IF
301         VALUE = ZERO
302         DO 270 I = 1, N
303            SUM = WORK( I )
304            IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM
305  270    CONTINUE
306      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
307*
308*        Find normF(A).
309*
310         IF( LSAME( UPLO, 'U' ) ) THEN
311            IF( LSAME( DIAG, 'U' ) ) THEN
312               SCALE = ONE
313               SUM = N
314               K = 2
315               DO 280 J = 2, N
316                  CALL SLASSQ( J-1, AP( K ), 1, SCALE, SUM )
317                  K = K + J
318  280          CONTINUE
319            ELSE
320               SCALE = ZERO
321               SUM = ONE
322               K = 1
323               DO 290 J = 1, N
324                  CALL SLASSQ( J, AP( K ), 1, SCALE, SUM )
325                  K = K + J
326  290          CONTINUE
327            END IF
328         ELSE
329            IF( LSAME( DIAG, 'U' ) ) THEN
330               SCALE = ONE
331               SUM = N
332               K = 2
333               DO 300 J = 1, N - 1
334                  CALL SLASSQ( N-J, AP( K ), 1, SCALE, SUM )
335                  K = K + N - J + 1
336  300          CONTINUE
337            ELSE
338               SCALE = ZERO
339               SUM = ONE
340               K = 1
341               DO 310 J = 1, N
342                  CALL SLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
343                  K = K + N - J + 1
344  310          CONTINUE
345            END IF
346         END IF
347         VALUE = SCALE*SQRT( SUM )
348      END IF
349*
350      SLANTP = VALUE
351      RETURN
352*
353*     End of SLANTP
354*
355      END
356