/src/igraph/vendor/lapack/dlanhs.c

Source (jump to first uncovered line)
/*  -- translated by f2c (version 20191129).
   You must link the resulting object file with libf2c:
  on Microsoft Windows system, link with libf2c.lib;
  on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  or, if you install libf2c.a in a standard place, with -lf2c -lm
  -- in that order, at the end of the command line, as in
    cc *.o -lf2c -lm
  Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

    http://www.netlib.org/f2c/libf2c.zip
*/

#include "f2c.h"

/* Table of constant values */

static integer c__1 = 1;

/* > \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute 
value of any element of an upper Hessenberg matrix.   

    =========== DOCUMENTATION ===========   

   Online html documentation available at   
              http://www.netlib.org/lapack/explore-html/   

   > \htmlonly   
   > Download DLANHS + dependencies   
   > <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanhs.
f">   
   > [TGZ]</a>   
   > <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanhs.
f">   
   > [ZIP]</a>   
   > <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanhs.
f">   
   > [TXT]</a>   
   > \endhtmlonly   

    Definition:   
    ===========   

         DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )   

         CHARACTER          NORM   
         INTEGER            LDA, N   
         DOUBLE PRECISION   A( LDA, * ), WORK( * )   


   > \par Purpose:   
    =============   
   >   
   > \verbatim   
   >   
   > DLANHS  returns the value of the one norm,  or the Frobenius norm, or   
   > the  infinity norm,  or the  element of  largest absolute value  of a   
   > Hessenberg matrix A.   
   > \endverbatim   
   >   
   > \return DLANHS   
   > \verbatim   
   >   
   >    DLANHS = ( 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.   
   > \endverbatim   

    Arguments:   
    ==========   

   > \param[in] NORM   
   > \verbatim   
   >          NORM is CHARACTER*1   
   >          Specifies the value to be returned in DLANHS as described   
   >          above.   
   > \endverbatim   
   >   
   > \param[in] N   
   > \verbatim   
   >          N is INTEGER   
   >          The order of the matrix A.  N >= 0.  When N = 0, DLANHS is   
   >          set to zero.   
   > \endverbatim   
   >   
   > \param[in] A   
   > \verbatim   
   >          A is DOUBLE PRECISION array, dimension (LDA,N)   
   >          The n by n upper Hessenberg matrix A; the part of A below the   
   >          first sub-diagonal is not referenced.   
   > \endverbatim   
   >   
   > \param[in] LDA   
   > \verbatim   
   >          LDA is INTEGER   
   >          The leading dimension of the array A.  LDA >= max(N,1).   
   > \endverbatim   
   >   
   > \param[out] WORK   
   > \verbatim   
   >          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),   
   >          where LWORK >= N when NORM = 'I'; otherwise, WORK is not   
   >          referenced.   
   > \endverbatim   

    Authors:   
    ========   

   > \author Univ. of Tennessee   
   > \author Univ. of California Berkeley   
   > \author Univ. of Colorado Denver   
   > \author NAG Ltd.   

   > \date September 2012   

   > \ingroup doubleOTHERauxiliary   

    ===================================================================== */
doublereal igraphdlanhs_(char *norm, integer *n, doublereal *a, integer *lda, 
  doublereal *work)
{
    /* System generated locals */
    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
    doublereal ret_val, d__1;

    /* Builtin functions */
    double sqrt(doublereal);

    /* Local variables */
    integer i__, j;
    doublereal sum, scale;
    extern logical igraphlsame_(char *, char *);
    doublereal value = 0.;
    extern logical igraphdisnan_(doublereal *);
    extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *, 
      doublereal *, doublereal *);


/*  -- LAPACK auxiliary routine (version 3.4.2) --   
    -- LAPACK is a software package provided by Univ. of Tennessee,    --   
    -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--   
       September 2012   


   =====================================================================   


       Parameter adjustments */
    a_dim1 = *lda;
    a_offset = 1 + a_dim1;
    a -= a_offset;
    --work;

    /* Function Body */
    if (*n == 0) {
  value = 0.;
    } else if (igraphlsame_(norm, "M")) {

/*        Find max(abs(A(i,j))). */

  value = 0.;
  i__1 = *n;
  for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
      i__3 = *n, i__4 = j + 1;
      i__2 = min(i__3,i__4);
      for (i__ = 1; i__ <= i__2; ++i__) {
    sum = (d__1 = a[i__ + j * a_dim1], abs(d__1));
    if (value < sum || igraphdisnan_(&sum)) {
        value = sum;
    }
/* L10: */
      }
/* L20: */
  }
    } else if (igraphlsame_(norm, "O") || *(unsigned char *)
      norm == '1') {

/*        Find norm1(A). */

  value = 0.;
  i__1 = *n;
  for (j = 1; j <= i__1; ++j) {
      sum = 0.;
/* Computing MIN */
      i__3 = *n, i__4 = j + 1;
      i__2 = min(i__3,i__4);
      for (i__ = 1; i__ <= i__2; ++i__) {
    sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
/* L30: */
      }
      if (value < sum || igraphdisnan_(&sum)) {
    value = sum;
      }
/* L40: */
  }
    } else if (igraphlsame_(norm, "I")) {

/*        Find normI(A). */

  i__1 = *n;
  for (i__ = 1; i__ <= i__1; ++i__) {
      work[i__] = 0.;
/* L50: */
  }
  i__1 = *n;
  for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
      i__3 = *n, i__4 = j + 1;
      i__2 = min(i__3,i__4);
      for (i__ = 1; i__ <= i__2; ++i__) {
    work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
/* L60: */
      }
/* L70: */
  }
  value = 0.;
  i__1 = *n;
  for (i__ = 1; i__ <= i__1; ++i__) {
      sum = work[i__];
      if (value < sum || igraphdisnan_(&sum)) {
    value = sum;
      }
/* L80: */
  }
    } else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) {

/*        Find normF(A). */

  scale = 0.;
  sum = 1.;
  i__1 = *n;
  for (j = 1; j <= i__1; ++j) {
/* Computing MIN */
      i__3 = *n, i__4 = j + 1;
      i__2 = min(i__3,i__4);
      igraphdlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
/* L90: */
  }
  value = scale * sqrt(sum);
    }

    ret_val = value;
    return ret_val;

/*     End of DLANHS */

} /* igraphdlanhs_ */


Coverage Report

Created: 2023-09-25 06:04

Line	Count	Source (jump to first uncovered line)
1		/* -- translated by f2c (version 20191129).
2		You must link the resulting object file with libf2c:
3		on Microsoft Windows system, link with libf2c.lib;
4		on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5		or, if you install libf2c.a in a standard place, with -lf2c -lm
6		-- in that order, at the end of the command line, as in
7		cc *.o -lf2c -lm
8		Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
9
10		http://www.netlib.org/f2c/libf2c.zip
11		*/
12
13		#include "f2c.h"
14
15		/* Table of constant values */
16
17		static integer c__1 = 1;
18
19		/* > \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute
20		value of any element of an upper Hessenberg matrix.
21
22		=========== DOCUMENTATION ===========
23
24		Online html documentation available at
25		http://www.netlib.org/lapack/explore-html/
26
27		> \htmlonly
28		> Download DLANHS + dependencies
29		> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanhs.
30		f">
31		> [TGZ]</a>
32		> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanhs.
33		f">
34		> [ZIP]</a>
35		> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanhs.
36		f">
37		> [TXT]</a>
38		> \endhtmlonly
39
40		Definition:
41		===========
42
43		DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
44
45		CHARACTER NORM
46		INTEGER LDA, N
47		DOUBLE PRECISION A( LDA, * ), WORK( * )
48
49
50		> \par Purpose:
51		=============
52		>
53		> \verbatim
54		>
55		> DLANHS returns the value of the one norm, or the Frobenius norm, or
56		> the infinity norm, or the element of largest absolute value of a
57		> Hessenberg matrix A.
58		> \endverbatim
59		>
60		> \return DLANHS
61		> \verbatim
62		>
63		> DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
64		> (
65		> ( norm1(A), NORM = '1', 'O' or 'o'
66		> (
67		> ( normI(A), NORM = 'I' or 'i'
68		> (
69		> ( normF(A), NORM = 'F', 'f', 'E' or 'e'
70		>
71		> where norm1 denotes the one norm of a matrix (maximum column sum),
72		> normI denotes the infinity norm of a matrix (maximum row sum) and
73		> normF denotes the Frobenius norm of a matrix (square root of sum of
74		> squares). Note that max(abs(A(i,j))) is not a consistent matrix norm.
75		> \endverbatim
76
77		Arguments:
78		==========
79
80		> \param[in] NORM
81		> \verbatim
82		> NORM is CHARACTER*1
83		> Specifies the value to be returned in DLANHS as described
84		> above.
85		> \endverbatim
86		>
87		> \param[in] N
88		> \verbatim
89		> N is INTEGER
90		> The order of the matrix A. N >= 0. When N = 0, DLANHS is
91		> set to zero.
92		> \endverbatim
93		>
94		> \param[in] A
95		> \verbatim
96		> A is DOUBLE PRECISION array, dimension (LDA,N)
97		> The n by n upper Hessenberg matrix A; the part of A below the
98		> first sub-diagonal is not referenced.
99		> \endverbatim
100		>
101		> \param[in] LDA
102		> \verbatim
103		> LDA is INTEGER
104		> The leading dimension of the array A. LDA >= max(N,1).
105		> \endverbatim
106		>
107		> \param[out] WORK
108		> \verbatim
109		> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
110		> where LWORK >= N when NORM = 'I'; otherwise, WORK is not
111		> referenced.
112		> \endverbatim
113
114		Authors:
115		========
116
117		> \author Univ. of Tennessee
118		> \author Univ. of California Berkeley
119		> \author Univ. of Colorado Denver
120		> \author NAG Ltd.
121
122		> \date September 2012
123
124		> \ingroup doubleOTHERauxiliary
125
126		===================================================================== */
127		doublereal igraphdlanhs_(char norm, integer n, doublereal a, integer lda,
128		doublereal *work)
129	0	{
130		/* System generated locals */
131	0	integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
132	0	doublereal ret_val, d__1;
133
134		/* Builtin functions */
135	0	double sqrt(doublereal);
136
137		/* Local variables */
138	0	integer i__, j;
139	0	doublereal sum, scale;
140	0	extern logical igraphlsame_(char , char );
141	0	doublereal value = 0.;
142	0	extern logical igraphdisnan_(doublereal *);
143	0	extern /* Subroutine / int igraphdlassq_(integer , doublereal , integer ,
144	0	doublereal , doublereal );
145
146
147		/* -- LAPACK auxiliary routine (version 3.4.2) --
148		-- LAPACK is a software package provided by Univ. of Tennessee, --
149		-- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
150		September 2012
151
152
153		=====================================================================
154
155
156		Parameter adjustments */
157	0	a_dim1 = *lda;
158	0	a_offset = 1 + a_dim1;
159	0	a -= a_offset;
160	0	--work;
161
162		/* Function Body */
163	0	if (*n == 0) {
164	0	value = 0.;
165	0	} else if (igraphlsame_(norm, "M")) {
166
167		/* Find max(abs(A(i,j))). */
168
169	0	value = 0.;
170	0	i__1 = *n;
171	0	for (j = 1; j <= i__1; ++j) {
172		/* Computing MIN */
173	0	i__3 = *n, i__4 = j + 1;
174	0	i__2 = min(i__3,i__4);
175	0	for (i__ = 1; i__ <= i__2; ++i__) {
176	0	sum = (d__1 = a[i__ + j * a_dim1], abs(d__1));
177	0	if (value < sum \|\| igraphdisnan_(&sum)) {
178	0	value = sum;
179	0	}
180		/* L10: */
181	0	}
182		/* L20: */
183	0	}
184	0	} else if (igraphlsame_(norm, "O") \|\| (unsigned char )
185	0	norm == '1') {
186
187		/* Find norm1(A). */
188
189	0	value = 0.;
190	0	i__1 = *n;
191	0	for (j = 1; j <= i__1; ++j) {
192	0	sum = 0.;
193		/* Computing MIN */
194	0	i__3 = *n, i__4 = j + 1;
195	0	i__2 = min(i__3,i__4);
196	0	for (i__ = 1; i__ <= i__2; ++i__) {
197	0	sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
198		/* L30: */
199	0	}
200	0	if (value < sum \|\| igraphdisnan_(&sum)) {
201	0	value = sum;
202	0	}
203		/* L40: */
204	0	}
205	0	} else if (igraphlsame_(norm, "I")) {
206
207		/* Find normI(A). */
208
209	0	i__1 = *n;
210	0	for (i__ = 1; i__ <= i__1; ++i__) {
211	0	work[i__] = 0.;
212		/* L50: */
213	0	}
214	0	i__1 = *n;
215	0	for (j = 1; j <= i__1; ++j) {
216		/* Computing MIN */
217	0	i__3 = *n, i__4 = j + 1;
218	0	i__2 = min(i__3,i__4);
219	0	for (i__ = 1; i__ <= i__2; ++i__) {
220	0	work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
221		/* L60: */
222	0	}
223		/* L70: */
224	0	}
225	0	value = 0.;
226	0	i__1 = *n;
227	0	for (i__ = 1; i__ <= i__1; ++i__) {
228	0	sum = work[i__];
229	0	if (value < sum \|\| igraphdisnan_(&sum)) {
230	0	value = sum;
231	0	}
232		/* L80: */
233	0	}
234	0	} else if (igraphlsame_(norm, "F") \|\| igraphlsame_(norm, "E")) {
235
236		/* Find normF(A). */
237
238	0	scale = 0.;
239	0	sum = 1.;
240	0	i__1 = *n;
241	0	for (j = 1; j <= i__1; ++j) {
242		/* Computing MIN */
243	0	i__3 = *n, i__4 = j + 1;
244	0	i__2 = min(i__3,i__4);
245	0	igraphdlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
246		/* L90: */
247	0	}
248	0	value = scale * sqrt(sum);
249	0	}
250
251	0	ret_val = value;
252	0	return ret_val;
253
254		/* End of DLANHS */
255
256	0	} /* igraphdlanhs_ */
257