2 REAL FUNCTION ENORM (N, X)
3 C***BEGIN PROLOGUE ENORM
5 C***PURPOSE Subsidiary to SNLS1, SNLS1E, SNSQ and SNSQE
7 C***TYPE SINGLE PRECISION (ENORM-S, DENORM-D)
11 C Given an N-vector X, this function calculates the
12 C Euclidean norm of X.
14 C The Euclidean norm is computed by accumulating the sum of
15 C squares in three different sums. The sums of squares for the
16 C small and large components are scaled so that no overflows
17 C occur. Non-destructive underflows are permitted. Underflows
18 C and overflows do not occur in the computation of the unscaled
19 C sum of squares for the intermediate components.
20 C The definitions of small, intermediate and large components
21 C depend on two constants, RDWARF and RGIANT. The main
22 C restrictions on these constants are that RDWARF**2 not
23 C underflow and RGIANT**2 not overflow. The constants
24 C given here are suitable for every known computer.
26 C The function statement is
28 C REAL FUNCTION ENORM(N,X)
32 C N is a positive integer input variable.
34 C X is an input array of length N.
36 C***SEE ALSO SNLS1, SNLS1E, SNSQ, SNSQE
37 C***ROUTINES CALLED (NONE)
38 C***REVISION HISTORY (YYMMDD)
40 C 890831 Modified array declarations. (WRB)
41 C 891214 Prologue converted to Version 4.0 format. (BAB)
42 C 900326 Removed duplicate information from DESCRIPTION section.
44 C 900328 Added TYPE section. (WRB)
45 C***END PROLOGUE ENORM
49 REAL AGIANT,FLOATN,ONE,RDWARF,RGIANT,S1,S2,S3,XABS,X1MAX,X3MAX,
51 SAVE ONE, ZERO, RDWARF, RGIANT
52 DATA ONE,ZERO,RDWARF,RGIANT /1.0E0,0.0E0,3.834E-20,1.304E19/
53 C***FIRST EXECUTABLE STATEMENT ENORM
60 AGIANT = RGIANT/FLOATN
63 IF (XABS .GT. RDWARF .AND. XABS .LT. AGIANT) GO TO 70
64 IF (XABS .LE. RDWARF) GO TO 30
66 C SUM FOR LARGE COMPONENTS.
68 IF (XABS .LE. X1MAX) GO TO 10
69 S1 = ONE + S1*(X1MAX/XABS)**2
73 S1 = S1 + (XABS/X1MAX)**2
78 C SUM FOR SMALL COMPONENTS.
80 IF (XABS .LE. X3MAX) GO TO 40
81 S3 = ONE + S3*(X3MAX/XABS)**2
85 IF (XABS .NE. ZERO) S3 = S3 + (XABS/X3MAX)**2
91 C SUM FOR INTERMEDIATE COMPONENTS.
97 C CALCULATION OF NORM.
99 IF (S1 .EQ. ZERO) GO TO 100
100 ENORM = X1MAX*SQRT(S1+(S2/X1MAX)/X1MAX)
103 IF (S2 .EQ. ZERO) GO TO 110
105 1 ENORM = SQRT(S2*(ONE+(X3MAX/S2)*(X3MAX*S3)))
107 1 ENORM = SQRT(X3MAX*((S2/X3MAX)+(X3MAX*S3)))
110 ENORM = X3MAX*SQRT(S3)
115 C LAST CARD OF FUNCTION ENORM.