LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
dlantp.f
Go to the documentation of this file.
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.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
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">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * DOUBLE PRECISION FUNCTION DLANTP( NORM, UPLO, DIAG, N, AP, WORK )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER DIAG, NORM, UPLO
25 * INTEGER N
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION AP( * ), WORK( * )
29 * ..
30 *
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 *
115 *> \author Univ. of Tennessee
116 *> \author Univ. of California Berkeley
117 *> \author Univ. of Colorado Denver
118 *> \author NAG Ltd.
119 *
120 *> \ingroup doubleOTHERauxiliary
121 *
122 * =====================================================================
123  DOUBLE PRECISION FUNCTION dlantp( NORM, UPLO, DIAG, N, AP, WORK )
124 *
125 * -- LAPACK auxiliary routine --
126 * -- LAPACK is a software package provided by Univ. of Tennessee, --
127 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128 *
129 * .. Scalar Arguments ..
130  CHARACTER diag, norm, uplo
131  INTEGER n
132 * ..
133 * .. Array Arguments ..
134  DOUBLE PRECISION ap( * ), work( * )
135 * ..
136 *
137 * =====================================================================
138 *
139 * .. Parameters ..
140  DOUBLE PRECISION one, zero
141  parameter( one = 1.0d+0, zero = 0.0d+0 )
142 * ..
143 * .. Local Scalars ..
144  LOGICAL udiag
145  INTEGER i, j, k
146  DOUBLE PRECISION scale, sum, value
147 * ..
148 * .. External Subroutines ..
149  EXTERNAL dlassq
150 * ..
151 * .. External Functions ..
152  LOGICAL lsame, disnan
153  EXTERNAL lsame, disnan
154 * ..
155 * .. Intrinsic Functions ..
156  INTRINSIC abs, sqrt
157 * ..
158 * .. Executable Statements ..
159 *
160  IF( n.EQ.0 ) THEN
161  VALUE = zero
162  ELSE IF( lsame( norm, 'M' ) ) THEN
163 *
164 * Find max(abs(A(i,j))).
165 *
166  k = 1
167  IF( lsame( diag, 'U' ) ) THEN
168  VALUE = one
169  IF( lsame( uplo, 'U' ) ) THEN
170  DO 20 j = 1, n
171  DO 10 i = k, k + j - 2
172  sum = abs( ap( i ) )
173  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
174  10 CONTINUE
175  k = k + j
176  20 CONTINUE
177  ELSE
178  DO 40 j = 1, n
179  DO 30 i = k + 1, k + n - j
180  sum = abs( ap( i ) )
181  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
182  30 CONTINUE
183  k = k + n - j + 1
184  40 CONTINUE
185  END IF
186  ELSE
187  VALUE = zero
188  IF( lsame( uplo, 'U' ) ) THEN
189  DO 60 j = 1, n
190  DO 50 i = k, k + j - 1
191  sum = abs( ap( i ) )
192  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
193  50 CONTINUE
194  k = k + j
195  60 CONTINUE
196  ELSE
197  DO 80 j = 1, n
198  DO 70 i = k, k + n - j
199  sum = abs( ap( i ) )
200  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
201  70 CONTINUE
202  k = k + n - j + 1
203  80 CONTINUE
204  END IF
205  END IF
206  ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
207 *
208 * Find norm1(A).
209 *
210  VALUE = zero
211  k = 1
212  udiag = lsame( diag, 'U' )
213  IF( lsame( uplo, 'U' ) ) THEN
214  DO 110 j = 1, n
215  IF( udiag ) THEN
216  sum = one
217  DO 90 i = k, k + j - 2
218  sum = sum + abs( ap( i ) )
219  90 CONTINUE
220  ELSE
221  sum = zero
222  DO 100 i = k, k + j - 1
223  sum = sum + abs( ap( i ) )
224  100 CONTINUE
225  END IF
226  k = k + j
227  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
228  110 CONTINUE
229  ELSE
230  DO 140 j = 1, n
231  IF( udiag ) THEN
232  sum = one
233  DO 120 i = k + 1, k + n - j
234  sum = sum + abs( ap( i ) )
235  120 CONTINUE
236  ELSE
237  sum = zero
238  DO 130 i = k, k + n - j
239  sum = sum + abs( ap( i ) )
240  130 CONTINUE
241  END IF
242  k = k + n - j + 1
243  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
244  140 CONTINUE
245  END IF
246  ELSE IF( lsame( norm, 'I' ) ) THEN
247 *
248 * Find normI(A).
249 *
250  k = 1
251  IF( lsame( uplo, 'U' ) ) THEN
252  IF( lsame( diag, 'U' ) ) THEN
253  DO 150 i = 1, n
254  work( i ) = one
255  150 CONTINUE
256  DO 170 j = 1, n
257  DO 160 i = 1, j - 1
258  work( i ) = work( i ) + abs( ap( k ) )
259  k = k + 1
260  160 CONTINUE
261  k = k + 1
262  170 CONTINUE
263  ELSE
264  DO 180 i = 1, n
265  work( i ) = zero
266  180 CONTINUE
267  DO 200 j = 1, n
268  DO 190 i = 1, j
269  work( i ) = work( i ) + abs( ap( k ) )
270  k = k + 1
271  190 CONTINUE
272  200 CONTINUE
273  END IF
274  ELSE
275  IF( lsame( diag, 'U' ) ) THEN
276  DO 210 i = 1, n
277  work( i ) = one
278  210 CONTINUE
279  DO 230 j = 1, n
280  k = k + 1
281  DO 220 i = j + 1, n
282  work( i ) = work( i ) + abs( ap( k ) )
283  k = k + 1
284  220 CONTINUE
285  230 CONTINUE
286  ELSE
287  DO 240 i = 1, n
288  work( i ) = zero
289  240 CONTINUE
290  DO 260 j = 1, n
291  DO 250 i = j, n
292  work( i ) = work( i ) + abs( ap( k ) )
293  k = k + 1
294  250 CONTINUE
295  260 CONTINUE
296  END IF
297  END IF
298  VALUE = zero
299  DO 270 i = 1, n
300  sum = work( i )
301  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
302  270 CONTINUE
303  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
304 *
305 * Find normF(A).
306 *
307  IF( lsame( uplo, 'U' ) ) THEN
308  IF( lsame( diag, 'U' ) ) THEN
309  scale = one
310  sum = n
311  k = 2
312  DO 280 j = 2, n
313  CALL dlassq( j-1, ap( k ), 1, scale, sum )
314  k = k + j
315  280 CONTINUE
316  ELSE
317  scale = zero
318  sum = one
319  k = 1
320  DO 290 j = 1, n
321  CALL dlassq( j, ap( k ), 1, scale, sum )
322  k = k + j
323  290 CONTINUE
324  END IF
325  ELSE
326  IF( lsame( diag, 'U' ) ) THEN
327  scale = one
328  sum = n
329  k = 2
330  DO 300 j = 1, n - 1
331  CALL dlassq( n-j, ap( k ), 1, scale, sum )
332  k = k + n - j + 1
333  300 CONTINUE
334  ELSE
335  scale = zero
336  sum = one
337  k = 1
338  DO 310 j = 1, n
339  CALL dlassq( n-j+1, ap( k ), 1, scale, sum )
340  k = k + n - j + 1
341  310 CONTINUE
342  END IF
343  END IF
344  VALUE = scale*sqrt( sum )
345  END IF
346 *
347  dlantp = VALUE
348  RETURN
349 *
350 * End of DLANTP
351 *
352  END
logical function disnan(DIN)
DISNAN tests input for NaN.
Definition: disnan.f:59
subroutine dlassq(n, x, incx, scl, sumsq)
DLASSQ updates a sum of squares represented in scaled form.
Definition: dlassq.f90:137
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
double precision function dlantp(NORM, UPLO, DIAG, N, AP, WORK)
DLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: dlantp.f:124