NLSL: enorm.f90 Source File

NLSL

- Main Page
- Modules
- Data Types List
- Files

- File List
- File Members

enorm.f90
Go to the documentation of this file.
1 function enorm(n,x)
2 implicit none
3 integer n
4 double precision x(n),enorm
5 c **********
6 c
7 c function enorm
8 c
9 c Given an n-vector x, this function calculates the
10 c Euclidean norm of x.
11 c
12 c The Euclidean norm is computed by accumulating the sum of
13 c squares in three different sums. The sums of squares for the
14 c small and large components are scaled so that no overflows
15 c occur. Non-destructive underflows are permitted. Underflows
16 c and overflows do not occur in the computation of the unscaled
17 c sum of squares for the intermediate components.
18 c The definitions of small, intermediate and large components
19 c depend on two constants, rdwarf and rgiant. The main
20 c restrictions on these constants are that rdwarf**2 not
21 c underflow and rgiant**2 not overflow. The constants
22 c given here are suitable for every known computer.
23 c
24 c the function statement is
25 c
26 c double precision function enorm(n,x)
27 c
28 c where
29 c
30 c n is a positive integer input variable.
31 c
32 c x is an input array of length n.
33 c
34 c Subprograms called
35 c
36 c Fortran-supplied ... dabs,dsqrt
37 c
38 c Argonne National Laboratory. MINPACK project. March 1980.
39 c Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More
40 c
41 c **********
42 integer i
43 double precision agiant,floatn,one,rdwarf,rgiant,s1,s2,s3,xabs,
44 * x1max,x3max,zero
45 data one,zero,rdwarf,rgiant /1.0d0,0.0d0,3.834d-20,1.304d19/
46 s1 = zero
47 s2 = zero
48 s3 = zero
49 x1max = zero
50 x3max = zero
51 floatn = n
52 agiant = rgiant/floatn
53 do 90 i = 1, n
54 xabs = dabs(x(i))
55
56 if (xabs .ge. agiant) then
57 c
58 c ----- Sum for large components --------
59 c
60 if (xabs .gt. x1max) then
61 s1 = one + s1*(x1max/xabs)**2
62 x1max = xabs
63 else
64 s1 = s1 + (xabs/x1max)**2
65 end if
66
67 else if (xabs .le. rdwarf) then
68 c
69 c ----- Sum for small components -------
70 c
71 if (xabs .gt. x3max) then
72 s3 = one + s3*(x3max/xabs)**2
73 x3max = xabs
74 else
75 if (xabs .ne. zero) s3 = s3 + (xabs/x3max)**2
76 end if
77 c
78 else
79 c
80 c ----- Sum for intermediate components ------
81 c
82 s2 = s2 + xabs**2
83 end if
84 90 continue
85 c
86 c ----- Calculation of norm ------
87 c
88 if (s1 .ne. zero) then
89 enorm = x1max*dsqrt(s1+(s2/x1max)/x1max)
90 else
91 if (s2 .ne. zero) then
92 if (s2 .ge. x3max)
93 * enorm = dsqrt(s2*(one+(x3max/s2)*(x3max*s3)))
94 if (s2 .lt. x3max)
95 * enorm = dsqrt(x3max*((s2/x3max)+(x3max*s3)))
96 else
97 enorm = x3max*dsqrt(s3)
98 end if
99 end if
100 return
101 end
enorm
double precision function enorm(n, x)
Definition: enorm.f90:2