LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ dlansp()

double precision function dlansp ( character  NORM,
character  UPLO,
integer  N,
double precision, dimension( * )  AP,
double precision, dimension( * )  WORK 
)

DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.

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

Purpose:
 DLANSP  returns the value of the one norm,  or the Frobenius norm, or
 the  infinity norm,  or the  element of  largest absolute value  of a
 real symmetric matrix A,  supplied in packed form.
Returns
DLANSP 
    DLANSP = ( 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 DLANSP as described
          above.
[in]UPLO
          UPLO is CHARACTER*1
          Specifies whether the upper or lower triangular part of the
          symmetric matrix A is supplied.
          = 'U':  Upper triangular part of A is supplied
          = 'L':  Lower triangular part of A is supplied
[in]N
          N is INTEGER
          The order of the matrix A.  N >= 0.  When N = 0, DLANSP is
          set to zero.
[in]AP
          AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
          The upper or lower triangle of the symmetric 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.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
          WORK is not referenced.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 116 of file dlansp.f.

116 *
117 * -- LAPACK auxiliary routine (version 3.7.0) --
118 * -- LAPACK is a software package provided by Univ. of Tennessee, --
119 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
120 * December 2016
121 *
122  IMPLICIT NONE
123 * .. Scalar Arguments ..
124  CHARACTER NORM, UPLO
125  INTEGER N
126 * ..
127 * .. Array Arguments ..
128  DOUBLE PRECISION AP( * ), WORK( * )
129 * ..
130 *
131 * =====================================================================
132 *
133 * .. Parameters ..
134  DOUBLE PRECISION ONE, ZERO
135  parameter( one = 1.0d+0, zero = 0.0d+0 )
136 * ..
137 * .. Local Scalars ..
138  INTEGER I, J, K
139  DOUBLE PRECISION ABSA, SUM, VALUE
140 * ..
141 * .. Local Arrays ..
142  DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 )
143 * ..
144 * .. External Functions ..
145  LOGICAL LSAME, DISNAN
146  EXTERNAL lsame, disnan
147 * ..
148 * .. External Subroutines ..
149  EXTERNAL dlassq, dcombssq
150 * ..
151 * .. Intrinsic Functions ..
152  INTRINSIC abs, sqrt
153 * ..
154 * .. Executable Statements ..
155 *
156  IF( n.EQ.0 ) THEN
157  VALUE = zero
158  ELSE IF( lsame( norm, 'M' ) ) THEN
159 *
160 * Find max(abs(A(i,j))).
161 *
162  VALUE = zero
163  IF( lsame( uplo, 'U' ) ) THEN
164  k = 1
165  DO 20 j = 1, n
166  DO 10 i = k, k + j - 1
167  sum = abs( ap( i ) )
168  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
169  10 CONTINUE
170  k = k + j
171  20 CONTINUE
172  ELSE
173  k = 1
174  DO 40 j = 1, n
175  DO 30 i = k, k + n - j
176  sum = abs( ap( i ) )
177  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
178  30 CONTINUE
179  k = k + n - j + 1
180  40 CONTINUE
181  END IF
182  ELSE IF( ( lsame( norm, 'I' ) ) .OR. ( lsame( norm, 'O' ) ) .OR.
183  $ ( norm.EQ.'1' ) ) THEN
184 *
185 * Find normI(A) ( = norm1(A), since A is symmetric).
186 *
187  VALUE = zero
188  k = 1
189  IF( lsame( uplo, 'U' ) ) THEN
190  DO 60 j = 1, n
191  sum = zero
192  DO 50 i = 1, j - 1
193  absa = abs( ap( k ) )
194  sum = sum + absa
195  work( i ) = work( i ) + absa
196  k = k + 1
197  50 CONTINUE
198  work( j ) = sum + abs( ap( k ) )
199  k = k + 1
200  60 CONTINUE
201  DO 70 i = 1, n
202  sum = work( i )
203  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
204  70 CONTINUE
205  ELSE
206  DO 80 i = 1, n
207  work( i ) = zero
208  80 CONTINUE
209  DO 100 j = 1, n
210  sum = work( j ) + abs( ap( k ) )
211  k = k + 1
212  DO 90 i = j + 1, n
213  absa = abs( ap( k ) )
214  sum = sum + absa
215  work( i ) = work( i ) + absa
216  k = k + 1
217  90 CONTINUE
218  IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum
219  100 CONTINUE
220  END IF
221  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
222 *
223 * Find normF(A).
224 * SSQ(1) is scale
225 * SSQ(2) is sum-of-squares
226 * For better accuracy, sum each column separately.
227 *
228  ssq( 1 ) = zero
229  ssq( 2 ) = one
230 *
231 * Sum off-diagonals
232 *
233  k = 2
234  IF( lsame( uplo, 'U' ) ) THEN
235  DO 110 j = 2, n
236  colssq( 1 ) = zero
237  colssq( 2 ) = one
238  CALL dlassq( j-1, ap( k ), 1, colssq( 1 ), colssq( 2 ) )
239  CALL dcombssq( ssq, colssq )
240  k = k + j
241  110 CONTINUE
242  ELSE
243  DO 120 j = 1, n - 1
244  colssq( 1 ) = zero
245  colssq( 2 ) = one
246  CALL dlassq( n-j, ap( k ), 1, colssq( 1 ), colssq( 2 ) )
247  CALL dcombssq( ssq, colssq )
248  k = k + n - j + 1
249  120 CONTINUE
250  END IF
251  ssq( 2 ) = 2*ssq( 2 )
252 *
253 * Sum diagonal
254 *
255  k = 1
256  colssq( 1 ) = zero
257  colssq( 2 ) = one
258  DO 130 i = 1, n
259  IF( ap( k ).NE.zero ) THEN
260  absa = abs( ap( k ) )
261  IF( colssq( 1 ).LT.absa ) THEN
262  colssq( 2 ) = one + colssq(2)*( colssq(1) / absa )**2
263  colssq( 1 ) = absa
264  ELSE
265  colssq( 2 ) = colssq( 2 ) + ( absa / colssq( 1 ) )**2
266  END IF
267  END IF
268  IF( lsame( uplo, 'U' ) ) THEN
269  k = k + i + 1
270  ELSE
271  k = k + n - i + 1
272  END IF
273  130 CONTINUE
274  CALL dcombssq( ssq, colssq )
275  VALUE = ssq( 1 )*sqrt( ssq( 2 ) )
276  END IF
277 *
278  dlansp = VALUE
279  RETURN
280 *
281 * End of DLANSP
282 *
Here is the call graph for this function:
disnan
logical function disnan(DIN)
DISNAN tests input for NaN.
Definition: disnan.f:61
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
dlassq
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
Definition: dlassq.f:105
dcombssq
subroutine dcombssq(V1, V2)
DCOMBSSQ adds two scaled sum of squares quantities.
Definition: dcombssq.f:62
dlansp
double precision function dlansp(NORM, UPLO, N, AP, WORK)
DLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: dlansp.f:116