1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
DOUBLE PRECISION FUNCTION ENORM(N,X)
INTEGER N
DOUBLE PRECISION X(N)
C **********
C
C FUNCTION ENORM
C
C GIVEN AN N-VECTOR X, THIS FUNCTION CALCULATES THE
C EUCLIDEAN NORM OF X.
C
C THE EUCLIDEAN NORM IS COMPUTED BY ACCUMULATING THE SUM OF
C SQUARES IN THREE DIFFERENT SUMS. THE SUMS OF SQUARES FOR THE
C SMALL AND LARGE COMPONENTS ARE SCALED SO THAT NO OVERFLOWS
C OCCUR. NON-DESTRUCTIVE UNDERFLOWS ARE PERMITTED. UNDERFLOWS
C AND OVERFLOWS DO NOT OCCUR IN THE COMPUTATION OF THE UNSCALED
C SUM OF SQUARES FOR THE INTERMEDIATE COMPONENTS.
C THE DEFINITIONS OF SMALL, INTERMEDIATE AND LARGE COMPONENTS
C DEPEND ON TWO CONSTANTS, RDWARF AND RGIANT. THE MAIN
C RESTRICTIONS ON THESE CONSTANTS ARE THAT RDWARF**2 NOT
C UNDERFLOW AND RGIANT**2 NOT OVERFLOW. THE CONSTANTS
C GIVEN HERE ARE SUITABLE FOR EVERY KNOWN COMPUTER.
C
C THE FUNCTION STATEMENT IS
C
C DOUBLE PRECISION FUNCTION ENORM(N,X)
C
C WHERE
C
C N IS A POSITIVE INTEGER INPUT VARIABLE.
C
C X IS AN INPUT ARRAY OF LENGTH N.
C
C SUBPROGRAMS CALLED
C
C FORTRAN-SUPPLIED ... DABS,DSQRT
C
C MINPACK. VERSION OF OCTOBER 1979.
C BURTON S. GARBOW, KENNETH E. HILLSTROM, JORGE J. MORE
C
C **********
INTEGER I
DOUBLE PRECISION AGIANT,FLOATN,ONE,RDWARF,RGIANT,S1,S2,S3,XABS,
* X1MAX,X3MAX,ZERO
DATA ONE,ZERO,RDWARF,RGIANT /1.0D0,0.0D0,3.834D-20,1.304D19/
S1 = ZERO
S2 = ZERO
S3 = ZERO
X1MAX = ZERO
X3MAX = ZERO
FLOATN = N
AGIANT = RGIANT/FLOATN
DO 90 I = 1, N
XABS = DABS(X(I))
IF (XABS .GT. RDWARF .AND. XABS .LT. AGIANT) GO TO 70
IF (XABS .LE. RDWARF) GO TO 30
C
C SUM FOR LARGE COMPONENTS.
C
IF (XABS .LE. X1MAX) GO TO 10
S1 = ONE + S1*(X1MAX/XABS)**2
X1MAX = XABS
GO TO 20
10 CONTINUE
S1 = S1 + (XABS/X1MAX)**2
20 CONTINUE
GO TO 60
30 CONTINUE
C
C SUM FOR SMALL COMPONENTS.
C
IF (XABS .LE. X3MAX) GO TO 40
S3 = ONE + S3*(X3MAX/XABS)**2
X3MAX = XABS
GO TO 50
40 CONTINUE
IF (XABS .NE. ZERO) S3 = S3 + (XABS/X3MAX)**2
50 CONTINUE
60 CONTINUE
GO TO 80
70 CONTINUE
C
C SUM FOR INTERMEDIATE COMPONENTS.
C
S2 = S2 + XABS**2
80 CONTINUE
90 CONTINUE
C
C CALCULATION OF NORM.
C
IF (S1 .EQ. ZERO) GO TO 100
ENORM = X1MAX*DSQRT(S1+(S2/X1MAX)/X1MAX)
GO TO 130
100 CONTINUE
IF (S2 .EQ. ZERO) GO TO 110
IF (S2 .GE. X3MAX)
* ENORM = DSQRT(S2*(ONE+(X3MAX/S2)*(X3MAX*S3)))
IF (S2 .LT. X3MAX)
* ENORM = DSQRT(X3MAX*((S2/X3MAX)+(X3MAX*S3)))
GO TO 120
110 CONTINUE
ENORM = X3MAX*DSQRT(S3)
120 CONTINUE
130 CONTINUE
RETURN
C
C LAST CARD OF FUNCTION ENORM.
C
END
|
