*DECK ENORM REAL FUNCTION ENORM (N, X) C***BEGIN PROLOGUE ENORM C***SUBSIDIARY C***PURPOSE Subsidiary to SNLS1, SNLS1E, SNSQ and SNSQE C***LIBRARY SLATEC C***TYPE SINGLE PRECISION (ENORM-S, DENORM-D) C***AUTHOR (UNKNOWN) C***DESCRIPTION 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 REAL 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***SEE ALSO SNLS1, SNLS1E, SNSQ, SNSQE C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 800301 DATE WRITTEN C 890831 Modified array declarations. (WRB) C 891214 Prologue converted to Version 4.0 format. (BAB) C 900326 Removed duplicate information from DESCRIPTION section. C (WRB) C 900328 Added TYPE section. (WRB) C***END PROLOGUE ENORM INTEGER N REAL X(*) INTEGER I REAL AGIANT,FLOATN,ONE,RDWARF,RGIANT,S1,S2,S3,XABS,X1MAX,X3MAX, 1 ZERO SAVE ONE, ZERO, RDWARF, RGIANT DATA ONE,ZERO,RDWARF,RGIANT /1.0E0,0.0E0,3.834E-20,1.304E19/ C***FIRST EXECUTABLE STATEMENT ENORM S1 = ZERO S2 = ZERO S3 = ZERO X1MAX = ZERO X3MAX = ZERO FLOATN = N AGIANT = RGIANT/FLOATN DO 90 I = 1, N XABS = ABS(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*SQRT(S1+(S2/X1MAX)/X1MAX) GO TO 130 100 CONTINUE IF (S2 .EQ. ZERO) GO TO 110 IF (S2 .GE. X3MAX) 1 ENORM = SQRT(S2*(ONE+(X3MAX/S2)*(X3MAX*S3))) IF (S2 .LT. X3MAX) 1 ENORM = SQRT(X3MAX*((S2/X3MAX)+(X3MAX*S3))) GO TO 120 110 CONTINUE ENORM = X3MAX*SQRT(S3) 120 CONTINUE 130 CONTINUE RETURN C C LAST CARD OF FUNCTION ENORM. C END