Mercurial > hg > octave-nkf
view libcruft/minpack/enorm.f @ 4175:b3cd3d12da7e
[project @ 2002-11-13 02:45:39 by jwe]
author | jwe |
---|---|
date | Wed, 13 Nov 2002 02:45:39 +0000 |
parents | 30c606bec7a8 |
children |
line wrap: on
line source
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