LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zlantp()

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

ZLANTP 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 ZLANTP + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> ZLANTP  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
ZLANTP 
!>
!>    ZLANTP = ( 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 ZLANTP 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, ZLANTP is
!>          set to zero.
!>
[in]AP
!>          AP is COMPLEX*16 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 122 of file zlantp.f.

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 WORK( * )
135 COMPLEX*16 AP( * )
136* ..
137*
138* =====================================================================
139*
140* .. Parameters ..
141 DOUBLE PRECISION ONE, ZERO
142 parameter( one = 1.0d+0, zero = 0.0d+0 )
143* ..
144* .. Local Scalars ..
145 LOGICAL UDIAG
146 INTEGER I, J, K
147 DOUBLE PRECISION SCALE, SUM, VALUE
148* ..
149* .. External Functions ..
150 LOGICAL LSAME, DISNAN
151 EXTERNAL lsame, disnan
152* ..
153* .. External Subroutines ..
154 EXTERNAL zlassq
155* ..
156* .. Intrinsic Functions ..
157 INTRINSIC abs, sqrt
158* ..
159* .. Executable Statements ..
160*
161 IF( n.EQ.0 ) THEN
162 VALUE = zero
163 ELSE IF( lsame( norm, 'M' ) ) THEN
164*
165* Find max(abs(A(i,j))).
166*
167 k = 1
168 IF( lsame( diag, 'U' ) ) THEN
169 VALUE = one
170 IF( lsame( uplo, 'U' ) ) THEN
171 DO 20 j = 1, n
172 DO 10 i = k, k + j - 2
173 sum = abs( ap( i ) )
174 IF( VALUE .LT. sum .OR.
175 $ disnan( sum ) ) VALUE = sum
176 10 CONTINUE
177 k = k + j
178 20 CONTINUE
179 ELSE
180 DO 40 j = 1, n
181 DO 30 i = k + 1, k + n - j
182 sum = abs( ap( i ) )
183 IF( VALUE .LT. sum .OR.
184 $ disnan( 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.
196 $ disnan( sum ) ) VALUE = sum
197 50 CONTINUE
198 k = k + j
199 60 CONTINUE
200 ELSE
201 DO 80 j = 1, n
202 DO 70 i = k, k + n - j
203 sum = abs( ap( i ) )
204 IF( VALUE .LT. sum .OR.
205 $ disnan( sum ) ) VALUE = sum
206 70 CONTINUE
207 k = k + n - j + 1
208 80 CONTINUE
209 END IF
210 END IF
211 ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN
212*
213* Find norm1(A).
214*
215 VALUE = zero
216 k = 1
217 udiag = lsame( diag, 'U' )
218 IF( lsame( uplo, 'U' ) ) THEN
219 DO 110 j = 1, n
220 IF( udiag ) THEN
221 sum = one
222 DO 90 i = k, k + j - 2
223 sum = sum + abs( ap( i ) )
224 90 CONTINUE
225 ELSE
226 sum = zero
227 DO 100 i = k, k + j - 1
228 sum = sum + abs( ap( i ) )
229 100 CONTINUE
230 END IF
231 k = k + j
232 IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
233 110 CONTINUE
234 ELSE
235 DO 140 j = 1, n
236 IF( udiag ) THEN
237 sum = one
238 DO 120 i = k + 1, k + n - j
239 sum = sum + abs( ap( i ) )
240 120 CONTINUE
241 ELSE
242 sum = zero
243 DO 130 i = k, k + n - j
244 sum = sum + abs( ap( i ) )
245 130 CONTINUE
246 END IF
247 k = k + n - j + 1
248 IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
249 140 CONTINUE
250 END IF
251 ELSE IF( lsame( norm, 'I' ) ) THEN
252*
253* Find normI(A).
254*
255 k = 1
256 IF( lsame( uplo, 'U' ) ) THEN
257 IF( lsame( diag, 'U' ) ) THEN
258 DO 150 i = 1, n
259 work( i ) = one
260 150 CONTINUE
261 DO 170 j = 1, n
262 DO 160 i = 1, j - 1
263 work( i ) = work( i ) + abs( ap( k ) )
264 k = k + 1
265 160 CONTINUE
266 k = k + 1
267 170 CONTINUE
268 ELSE
269 DO 180 i = 1, n
270 work( i ) = zero
271 180 CONTINUE
272 DO 200 j = 1, n
273 DO 190 i = 1, j
274 work( i ) = work( i ) + abs( ap( k ) )
275 k = k + 1
276 190 CONTINUE
277 200 CONTINUE
278 END IF
279 ELSE
280 IF( lsame( diag, 'U' ) ) THEN
281 DO 210 i = 1, n
282 work( i ) = one
283 210 CONTINUE
284 DO 230 j = 1, n
285 k = k + 1
286 DO 220 i = j + 1, n
287 work( i ) = work( i ) + abs( ap( k ) )
288 k = k + 1
289 220 CONTINUE
290 230 CONTINUE
291 ELSE
292 DO 240 i = 1, n
293 work( i ) = zero
294 240 CONTINUE
295 DO 260 j = 1, n
296 DO 250 i = j, n
297 work( i ) = work( i ) + abs( ap( k ) )
298 k = k + 1
299 250 CONTINUE
300 260 CONTINUE
301 END IF
302 END IF
303 VALUE = zero
304 DO 270 i = 1, n
305 sum = work( i )
306 IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
307 270 CONTINUE
308 ELSE IF( ( lsame( norm, 'F' ) ) .OR.
309 $ ( lsame( norm, 'E' ) ) ) THEN
310*
311* Find normF(A).
312*
313 IF( lsame( uplo, 'U' ) ) THEN
314 IF( lsame( diag, 'U' ) ) THEN
315 scale = one
316 sum = n
317 k = 2
318 DO 280 j = 2, n
319 CALL zlassq( j-1, ap( k ), 1, scale, sum )
320 k = k + j
321 280 CONTINUE
322 ELSE
323 scale = zero
324 sum = one
325 k = 1
326 DO 290 j = 1, n
327 CALL zlassq( j, ap( k ), 1, scale, sum )
328 k = k + j
329 290 CONTINUE
330 END IF
331 ELSE
332 IF( lsame( diag, 'U' ) ) THEN
333 scale = one
334 sum = n
335 k = 2
336 DO 300 j = 1, n - 1
337 CALL zlassq( n-j, ap( k ), 1, scale, sum )
338 k = k + n - j + 1
339 300 CONTINUE
340 ELSE
341 scale = zero
342 sum = one
343 k = 1
344 DO 310 j = 1, n
345 CALL zlassq( n-j+1, ap( k ), 1, scale, sum )
346 k = k + n - j + 1
347 310 CONTINUE
348 END IF
349 END IF
350 VALUE = scale*sqrt( sum )
351 END IF
352*
353 zlantp = VALUE
354 RETURN
355*
356* End of ZLANTP
357*
disnan
logical function disnan(din)
DISNAN tests input for NaN.
Definition disnan.f:57
zlantp
double precision function zlantp(norm, uplo, diag, n, ap, work)
ZLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition zlantp.f:124
zlassq
subroutine zlassq(n, x, incx, scale, sumsq)
ZLASSQ updates a sum of squares represented in scaled form.
Definition zlassq.f90:122
lsame
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: