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 / blas / dnrm2.f < prev    next >
Text File  |  1996-09-28  |  4KB  |  123 lines
  1.       DOUBLE PRECISION FUNCTION DNRM2 ( N, DX, INCX)
  2.       INTEGER          NEXT
  3.       DOUBLE PRECISION   DX(1), CUTLO, CUTHI, HITEST, SUM, XMAX,ZERO,ONE
  4.       DATA   ZERO, ONE /0.0D0, 1.0D0/
  5. C
  6. C     EUCLIDEAN NORM OF THE N-VECTOR STORED IN DX() WITH STORAGE
  7. C     INCREMENT INCX .
  8. C     IF    N .LE. 0 RETURN WITH RESULT = 0.
  9. C     IF N .GE. 1 THEN INCX MUST BE .GE. 1
  10. C
  11. C           C.L.LAWSON, 1978 JAN 08
  12. C
  13. C     FOUR PHASE METHOD     USING TWO BUILT-IN CONSTANTS THAT ARE
  14. C     HOPEFULLY APPLICABLE TO ALL MACHINES.
  15. C         CUTLO = MAXIMUM OF  DSQRT(U/EPS)  OVER ALL KNOWN MACHINES.
  16. C         CUTHI = MINIMUM OF  DSQRT(V)      OVER ALL KNOWN MACHINES.
  17. C     WHERE
  18. C         EPS = SMALLEST NO. SUCH THAT EPS + 1. .GT. 1.
  19. C         U   = SMALLEST POSITIVE NO.   (UNDERFLOW LIMIT)
  20. C         V   = LARGEST  NO.            (OVERFLOW  LIMIT)
  21. C
  22. C     BRIEF OUTLINE OF ALGORITHM..
  23. C
  24. C     PHASE 1    SCANS ZERO COMPONENTS.
  25. C     MOVE TO PHASE 2 WHEN A COMPONENT IS NONZERO AND .LE. CUTLO
  26. C     MOVE TO PHASE 3 WHEN A COMPONENT IS .GT. CUTLO
  27. C     MOVE TO PHASE 4 WHEN A COMPONENT IS .GE. CUTHI/M
  28. C     WHERE M = N FOR X() REAL AND M = 2*N FOR COMPLEX.
  29. C
  30. C     VALUES FOR CUTLO AND CUTHI..
  31. C     FROM THE ENVIRONMENTAL PARAMETERS LISTED IN THE IMSL CONVERTER
  32. C     DOCUMENT THE LIMITING VALUES ARE AS FOLLOWS..
  33. C     CUTLO, S.P.   U/EPS = 2**(-102) FOR  HONEYWELL.  CLOSE SECONDS ARE
  34. C                   UNIVAC AND DEC AT 2**(-103)
  35. C                   THUS CUTLO = 2**(-51) = 4.44089E-16
  36. C     CUTHI, S.P.   V = 2**127 FOR UNIVAC, HONEYWELL, AND DEC.
  37. C                   THUS CUTHI = 2**(63.5) = 1.30438E19
  38. C     CUTLO, D.P.   U/EPS = 2**(-67) FOR HONEYWELL AND DEC.
  39. C                   THUS CUTLO = 2**(-33.5) = 8.23181D-11
  40. C     CUTHI, D.P.   SAME AS S.P.  CUTHI = 1.30438D19
  41. C     DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 /
  42. C     DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 /
  43.       DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 /
  44. C
  45.       IF(N .GT. 0) GO TO 10
  46.          DNRM2  = ZERO
  47.          GO TO 300
  48. C
  49.    10 ASSIGN 30 TO NEXT
  50.       SUM = ZERO
  51.       NN = N * INCX
  52. C                                                 BEGIN MAIN LOOP
  53.       I = 1
  54.    20    GO TO NEXT,(30, 50, 70, 110)
  55.    30 IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
  56.       ASSIGN 50 TO NEXT
  57.       XMAX = ZERO
  58. C
  59. C                        PHASE 1.  SUM IS ZERO
  60. C
  61.    50 IF( DX(I) .EQ. ZERO) GO TO 200
  62.       IF( DABS(DX(I)) .GT. CUTLO) GO TO 85
  63. C
  64. C                                PREPARE FOR PHASE 2.
  65.       ASSIGN 70 TO NEXT
  66.       GO TO 105
  67. C
  68. C                                PREPARE FOR PHASE 4.
  69. C
  70.   100 I = J
  71.       ASSIGN 110 TO NEXT
  72.       SUM = (SUM / DX(I)) / DX(I)
  73.   105 XMAX = DABS(DX(I))
  74.       GO TO 115
  75. C
  76. C                   PHASE 2.  SUM IS SMALL.
  77. C                             SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
  78. C
  79.    70 IF( DABS(DX(I)) .GT. CUTLO ) GO TO 75
  80. C
  81. C                     COMMON CODE FOR PHASES 2 AND 4.
  82. C                     IN PHASE 4 SUM IS LARGE.  SCALE TO AVOID OVERFLOW.
  83. C
  84.   110 IF( DABS(DX(I)) .LE. XMAX ) GO TO 115
  85.          SUM = ONE + SUM * (XMAX / DX(I))**2
  86.          XMAX = DABS(DX(I))
  87.          GO TO 200
  88. C
  89.   115 SUM = SUM + (DX(I)/XMAX)**2
  90.       GO TO 200
  91. C
  92. C
  93. C                  PREPARE FOR PHASE 3.
  94. C
  95.    75 SUM = (SUM * XMAX) * XMAX
  96. C
  97. C
  98. C     FOR REAL OR D.P. SET HITEST = CUTHI/N
  99. C     FOR COMPLEX      SET HITEST = CUTHI/(2*N)
  100. C
  101.    85 HITEST = CUTHI/FLOAT( N )
  102. C
  103. C                   PHASE 3.  SUM IS MID-RANGE.  NO SCALING.
  104. C
  105.       DO 95 J =I,NN,INCX
  106.       IF(DABS(DX(J)) .GE. HITEST) GO TO 100
  107.    95    SUM = SUM + DX(J)**2
  108.       DNRM2 = DSQRT( SUM )
  109.       GO TO 300
  110. C
  111.   200 CONTINUE
  112.       I = I + INCX
  113.       IF ( I .LE. NN ) GO TO 20
  114. C
  115. C              END OF MAIN LOOP.
  116. C
  117. C              COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
  118. C
  119.       DNRM2 = XMAX * DSQRT(SUM)
  120.   300 CONTINUE
  121.       RETURN
  122.       END
  123.