LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages

◆ dlantp()

double precision function dlantp ( character norm,
character uplo,
character diag,
integer n,
double precision, dimension( * ) ap,
double precision, dimension( * ) work )

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.

Download DLANTP + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!> !> DLANTP returns the value of the one norm, or the Frobenius norm, or !> the infinity norm, or the element of largest absolute value of a !> triangular matrix A, supplied in packed form. !>
Returns
DLANTP
!> !> DLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm' !> ( !> ( norm1(A), NORM = '1', 'O' or 'o' !> ( !> ( normI(A), NORM = 'I' or 'i' !> ( !> ( normF(A), NORM = 'F', 'f', 'E' or 'e' !> !> where norm1 denotes the one norm of a matrix (maximum column sum), !> normI denotes the infinity norm of a matrix (maximum row sum) and !> normF denotes the Frobenius norm of a matrix (square root of sum of !> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. !>
Parameters
[in]NORM
!> NORM is CHARACTER*1 !> Specifies the value to be returned in DLANTP as described !> above. !>
[in]UPLO
!> UPLO is CHARACTER*1 !> Specifies whether the matrix A is upper or lower triangular. !> = 'U': Upper triangular !> = 'L': Lower triangular !>
[in]DIAG
!> DIAG is CHARACTER*1 !> Specifies whether or not the matrix A is unit triangular. !> = 'N': Non-unit triangular !> = 'U': Unit triangular !>
[in]N
!> N is INTEGER !> The order of the matrix A. N >= 0. When N = 0, DLANTP is !> set to zero. !>
[in]AP
!> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2) !> The upper or lower triangular matrix A, packed columnwise in !> a linear array. The j-th column of A is stored in the array !> AP as follows: !> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; !> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n. !> Note that when DIAG = 'U', the elements of the array AP !> corresponding to the diagonal elements of the matrix A are !> not referenced, but are assumed to be one. !>
[out]WORK
!> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)), !> where LWORK >= N when NORM = 'I'; otherwise, WORK is not !> referenced. !>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 121 of file dlantp.f.

123*
124* -- LAPACK auxiliary routine --
125* -- LAPACK is a software package provided by Univ. of Tennessee, --
126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
127*
128* .. Scalar Arguments ..
129 CHARACTER DIAG, NORM, UPLO
130 INTEGER N
131* ..
132* .. Array Arguments ..
133 DOUBLE PRECISION AP( * ), WORK( * )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 DOUBLE PRECISION ONE, ZERO
140 parameter( one = 1.0d+0, zero = 0.0d+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL UDIAG
144 INTEGER I, J, K
145 DOUBLE PRECISION SCALE, SUM, VALUE
146* ..
147* .. External Subroutines ..
148 EXTERNAL dlassq
149* ..
150* .. External Functions ..
151 LOGICAL LSAME, DISNAN
152 EXTERNAL lsame, disnan
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC abs, sqrt
156* ..
157* .. Executable Statements ..
158*
159 IF( n.EQ.0 ) THEN
160 VALUE = zero
161 ELSE IF( lsame( norm, 'M' ) ) THEN
162*
163* Find max(abs(A(i,j))).
164*
165 k = 1
166 IF( lsame( diag, 'U' ) ) THEN
167 VALUE = one
168 IF( lsame( uplo, 'U' ) ) THEN
169 DO 20 j = 1, n
170 DO 10 i = k, k + j - 2
171 sum = abs( ap( i ) )
172 IF( VALUE .LT. sum .OR.
173 $ 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.
182 $ disnan( sum ) ) VALUE = sum
183 30 CONTINUE
184 k = k + n - j + 1
185 40 CONTINUE
186 END IF
187 ELSE
188 VALUE = zero
189 IF( lsame( uplo, 'U' ) ) THEN
190 DO 60 j = 1, n
191 DO 50 i = k, k + j - 1
192 sum = abs( ap( i ) )
193 IF( VALUE .LT. sum .OR.
194 $ disnan( sum ) ) VALUE = sum
195 50 CONTINUE
196 k = k + j
197 60 CONTINUE
198 ELSE
199 DO 80 j = 1, n
200 DO 70 i = k, k + n - j
201 sum = abs( ap( i ) )
202 IF( VALUE .LT. sum .OR.
203 $ disnan( 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. disnan( 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. disnan( 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. disnan( sum ) ) VALUE = sum
305 270 CONTINUE
306 ELSE IF( ( lsame( norm, 'F' ) ) .OR.
307 $ ( lsame( norm, 'E' ) ) ) THEN
308*
309* Find normF(A).
310*
311 IF( lsame( uplo, 'U' ) ) THEN
312 IF( lsame( diag, 'U' ) ) THEN
313 scale = one
314 sum = n
315 k = 2
316 DO 280 j = 2, n
317 CALL dlassq( j-1, ap( k ), 1, scale, sum )
318 k = k + j
319 280 CONTINUE
320 ELSE
321 scale = zero
322 sum = one
323 k = 1
324 DO 290 j = 1, n
325 CALL dlassq( j, ap( k ), 1, scale, sum )
326 k = k + j
327 290 CONTINUE
328 END IF
329 ELSE
330 IF( lsame( diag, 'U' ) ) THEN
331 scale = one
332 sum = n
333 k = 2
334 DO 300 j = 1, n - 1
335 CALL dlassq( n-j, ap( k ), 1, scale, sum )
336 k = k + n - j + 1
337 300 CONTINUE
338 ELSE
339 scale = zero
340 sum = one
341 k = 1
342 DO 310 j = 1, n
343 CALL dlassq( n-j+1, ap( k ), 1, scale, sum )
344 k = k + n - j + 1
345 310 CONTINUE
346 END IF
347 END IF
348 VALUE = scale*sqrt( sum )
349 END IF
350*
351 dlantp = VALUE
352 RETURN
353*
354* End of DLANTP
355*
logical function disnan(din)
DISNAN tests input for NaN.
Definition disnan.f:57
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:123
subroutine dlassq(n, x, incx, scale, sumsq)
DLASSQ updates a sum of squares represented in scaled form.
Definition dlassq.f90:122
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: