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