home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libblas / src_original / scnrm2.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  4.6 KB  |  162 lines
  1.       REAL             FUNCTION SCNRM2( N, CX, INCX )
  2. *
  3. *     unitary norm of the complex n-vector stored in cx() with storage
  4. *     increment incx .
  5. *     if    n .le. 0 return with result = 0.
  6. *     if n .ge. 1 then incx must be .ge. 1
  7. *
  8. *           c.l.lawson , 1978 jan 08
  9. *
  10. *     four phase method     using two built-in constants that are
  11. *     hopefully applicable to all machines.
  12. *         cutlo = maximum of  sqrt(u/eps)  over all known machines.
  13. *         cuthi = minimum of  sqrt(v)      over all known machines.
  14. *     where
  15. *         eps = smallest no. such that eps + 1. .gt. 1.
  16. *         u   = smallest positive no.   (underflow limit)
  17. *         v   = largest  no.            (overflow  limit)
  18. *
  19. *     brief outline of algorithm..
  20. *
  21. *     phase 1    scans zero components.
  22. *     move to phase 2 when a component is nonzero and .le. cutlo
  23. *     move to phase 3 when a component is .gt. cutlo
  24. *     move to phase 4 when a component is .ge. cuthi/m
  25. *     where m = n for x() real and m = 2*n for complex.
  26. *
  27. *     values for cutlo and cuthi..
  28. *     from the environmental parameters listed in the imsl converter
  29. *     document the limiting values are as follows..
  30. *     cutlo, s.p.   u/eps = 2**(-102) for  honeywell.  close seconds are
  31. *                   univac and dec at 2**(-103)
  32. *                   thus cutlo = 2**(-51) = 4.44089e-16
  33. *     cuthi, s.p.   v = 2**127 for univac, honeywell, and dec.
  34. *                   thus cuthi = 2**(63.5) = 1.30438e19
  35. *     cutlo, d.p.   u/eps = 2**(-67) for honeywell and dec.
  36. *                   thus cutlo = 2**(-33.5) = 8.23181d-11
  37. *     cuthi, d.p.   same as s.p.  cuthi = 1.30438d19
  38. *     data cutlo, cuthi / 8.232d-11,  1.304d19 /
  39. *     data cutlo, cuthi / 4.441e-16,  1.304e19 /
  40. *
  41. *     .. Scalar Arguments ..
  42.       INTEGER                           INCX, N
  43. *     ..
  44. *     .. Array Arguments ..
  45.       COMPLEX                           CX( 1 )
  46. *     ..
  47. *     .. Local Scalars ..
  48.       LOGICAL                           IMAG, SCALE
  49.       INTEGER                           I, NEXT, IX, NN
  50.       REAL                              ABSX, CUTHI, CUTLO, HITEST, ONE,
  51.      $                                  SUM, XMAX, ZERO
  52. *     ..
  53. *     .. Intrinsic Functions ..
  54.       INTRINSIC                         ABS, AIMAG, FLOAT, REAL, SQRT
  55. *     ..
  56. *     .. Data statements ..
  57.       DATA                              ZERO, ONE / 0.0E0, 1.0E0 /
  58.       DATA                              CUTLO, CUTHI / 4.441E-16,
  59.      $                                  1.304E19 /
  60. *     ..
  61. *     .. Executable Statements ..
  62. *
  63.       IF( N.GT.0 )
  64.      $   GO TO 10
  65.       SCNRM2 = ZERO
  66.       GO TO 140
  67. *
  68.    10 ASSIGN 20 TO NEXT
  69.       SUM = ZERO
  70.       IX = 1
  71.       IF( INCX.LT.0 )
  72.      $   IX = 1 - ( N-1 )*INCX
  73.       NN = IX + ( N-1 )*INCX
  74. *
  75. *        begin main loop
  76. *
  77.       DO 130 I = IX, NN, INCX
  78.          ABSX = ABS( REAL( CX( I ) ) )
  79.          IMAG = .FALSE.
  80.          GO TO NEXT( 20, 30, 60, 110, 70 )
  81.    20    IF( ABSX.GT.CUTLO )
  82.      $      GO TO 100
  83.          ASSIGN 30 TO NEXT
  84.          SCALE = .FALSE.
  85. *
  86. *           phase 1.  sum is zero
  87. *
  88.    30    IF( ABSX.EQ.ZERO )
  89.      $      GO TO 120
  90.          IF( ABSX.GT.CUTLO )
  91.      $      GO TO 100
  92. *
  93. *           prepare for phase 2.
  94. *
  95.          ASSIGN 60 TO NEXT
  96.          GO TO 50
  97. *
  98. *           prepare for phase 4.
  99. *
  100.    40    ASSIGN 70 TO NEXT
  101.          SUM = ( SUM / ABSX ) / ABSX
  102.    50    SCALE = .TRUE.
  103.          XMAX = ABSX
  104.          GO TO 80
  105. *
  106. *           phase 2.  sum is small.
  107. *                     scale to avoid destructive underflow.
  108. *
  109.    60    IF( ABSX.GT.CUTLO )
  110.      $      GO TO 90
  111. *
  112. *           common code for phases 2 and 4.
  113. *           in phase 4 sum is large.  scale to avoid overflow.
  114. *
  115.    70    IF( ABSX.LE.XMAX )
  116.      $      GO TO 80
  117.          SUM = ONE + SUM*( XMAX / ABSX )**2
  118.          XMAX = ABSX
  119.          GO TO 120
  120. *
  121.    80    SUM = SUM + ( ABSX / XMAX )**2
  122.          GO TO 120
  123. *
  124. *           prepare for phase 3.
  125. *
  126.    90    SUM = ( SUM*XMAX )*XMAX
  127. *
  128.   100    ASSIGN 110 TO NEXT
  129.          SCALE = .FALSE.
  130. *
  131. *           for real or d.p. set hitest = cuthi/n
  132. *           for complex      set hitest = cuthi/(2*n)
  133. *
  134.          HITEST = CUTHI / FLOAT( N )
  135. *
  136. *           phase 3.  sum is mid-range.  no scaling.
  137. *
  138.   110    IF( ABSX.GE.HITEST )
  139.      $      GO TO 40
  140.          SUM = SUM + ABSX**2
  141.   120    CONTINUE
  142. *
  143. *           control selection of real and imaginary parts.
  144. *
  145.          IF( IMAG )
  146.      $      GO TO 130
  147.          ABSX = ABS( AIMAG( CX( I ) ) )
  148.          IMAG = .TRUE.
  149.          GO TO NEXT( 30, 60, 110, 70 )
  150. *
  151.   130 CONTINUE
  152. *
  153. *           end of main loop.
  154. *           compute square root and adjust for scaling.
  155. *
  156.       SCNRM2 = SQRT( SUM )
  157.       IF( SCALE )
  158.      $   SCNRM2 = SCNRM2*XMAX
  159.   140 CONTINUE
  160.       RETURN
  161.       END
  162.