1      REAL FUNCTION SCNRM2(N,CX,INCX)
2C***BEGIN PROLOGUE  SCNRM2
3C***DATE WRITTEN   791001   (YYMMDD)
4C***REVISION DATE  820801   (YYMMDD)
5C***REVISION HISTORY  (YYMMDD)
6C   000330  Modified array declarations.  (JEC)
7C
8C***CATEGORY NO.  D1A3B
9C***KEYWORDS  BLAS,COMPLEX,LINEAR ALGEBRA,NORM,UNITARY,VECTOR
10C***AUTHOR  LAWSON, C. L., (JPL)
11C           HANSON, R. J., (SNLA)
12C           KINCAID, D. R., (U. OF TEXAS)
13C           KROGH, F. T., (JPL)
14C***PURPOSE  Unitary norm of complex vector
15C***DESCRIPTION
16C
17C                B L A S  Subprogram
18C    Description of Parameters
19C
20C     --Input--
21C        N  number of elements in input vector(s)
22C       CX  complex vector with N elements
23C     INCX  storage spacing between elements of CX
24C
25C     --Output--
26C   SCNRM2  single precision result (zero if N .LE. 0)
27C
28C     unitary norm of the complex N-vector stored in CX() with storage
29C     increment INCX .
30C     If N .LE. 0, return with result = 0.
31C     If N .GE. 1, then INCX must be .GE. 1
32C
33C           C. L. Lawson, 1978 Jan 08
34C
35C     Four phase method     using two built-in constants that are
36C     hopefully applicable to all machines.
37C         CUTLO = maximum of  SQRT(U/EPS)  over all known machines.
38C         CUTHI = minimum of  SQRT(V)      over all known machines.
39C     where
40C         EPS = smallest no. such that EPS + 1. .GT. 1.
41C         U   = smallest positive no.   (underflow limit)
42C         V   = largest  no.            (overflow  limit)
43C
44C     Brief outline of algorithm..
45C
46C     Phase 1    scans zero components.
47C     Move to phase 2 when a component is nonzero and .LE. CUTLO
48C     Move to phase 3 when a component is .GT. CUTLO
49C     Move to phase 4 when a component is .GE. CUTHI/M
50C     where M = N for X() real and M = 2*N for complex.
51C
52C     Values for CUTLO and CUTHI..
53C     From the environmental parameters listed in the IMSL converter
54C     document the limiting values are as follows..
55C     CUTLO, S.P.   U/EPS = 2**(-102) for  Honeywell.  Close seconds are
56C                   Univac and DEC at 2**(-103)
57C                   Thus CUTLO = 2**(-51) = 4.44089E-16
58C     CUTHI, S.P.   V = 2**127 for Univac, Honeywell, and DEC.
59C                   Thus CUTHI = 2**(63.5) = 1.30438E19
60C     CUTLO, D.P.   U/EPS = 2**(-67) for Honeywell and DEC.
61C                   Thus CUTLO = 2**(-33.5) = 8.23181D-11
62C     CUTHI, D.P.   same as S.P.  CUTHI = 1.30438D19
63C     DATA CUTLO, CUTHI / 8.232D-11,  1.304D19 /
64C     DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 /
65C***REFERENCES  LAWSON C.L., HANSON R.J., KINCAID D.R., KROGH F.T.,
66C                 *BASIC LINEAR ALGEBRA SUBPROGRAMS FOR FORTRAN USAGE*,
67C                 ALGORITHM NO. 539, TRANSACTIONS ON MATHEMATICAL
68C                 SOFTWARE, VOLUME 5, NUMBER 3, SEPTEMBER 1979, 308-323
69C***ROUTINES CALLED  (NONE)
70C***END PROLOGUE  SCNRM2
71      LOGICAL IMAG, SCALE
72      INTEGER          NEXT
73      REAL         CUTLO, CUTHI, HITEST, SUM, XMAX, ABSX, ZERO, ONE
74      COMPLEX      CX(*)
75      DATA         ZERO, ONE /0.0E0, 1.0E0/
76C
77      DATA CUTLO, CUTHI / 4.441E-16,  1.304E19 /
78C***FIRST EXECUTABLE STATEMENT  SCNRM2
79      IF(N .GT. 0) GO TO 10
80         SCNRM2  = ZERO
81         GO TO 300
82C
83   10 ASSIGN 30 TO NEXT
84      SUM = ZERO
85      NN = N * INCX
86C                                                 BEGIN MAIN LOOP
87      DO 210 I=1,NN,INCX
88         ABSX = ABS(REAL(CX(I)))
89         IMAG = .FALSE.
90         GO TO NEXT,(30, 50, 70, 90, 110)
91   30 IF( ABSX .GT. CUTLO) GO TO 85
92      ASSIGN 50 TO NEXT
93      SCALE = .FALSE.
94C
95C                        PHASE 1.  SUM IS ZERO
96C
97   50 IF( ABSX .EQ. ZERO) GO TO 200
98      IF( ABSX .GT. CUTLO) GO TO 85
99C
100C                                PREPARE FOR PHASE 2.
101      ASSIGN 70 TO NEXT
102      GO TO 105
103C
104C                                PREPARE FOR PHASE 4.
105C
106  100 ASSIGN 110 TO NEXT
107      SUM = (SUM / ABSX) / ABSX
108  105 SCALE = .TRUE.
109      XMAX = ABSX
110      GO TO 115
111C
112C                   PHASE 2.  SUM IS SMALL.
113C                             SCALE TO AVOID DESTRUCTIVE UNDERFLOW.
114C
115   70 IF( ABSX .GT. CUTLO ) GO TO 75
116C
117C                     COMMON CODE FOR PHASES 2 AND 4.
118C                     IN PHASE 4 SUM IS LARGE.  SCALE TO AVOID OVERFLOW.
119C
120  110 IF( ABSX .LE. XMAX ) GO TO 115
121         SUM = ONE + SUM * (XMAX / ABSX)**2
122         XMAX = ABSX
123         GO TO 200
124C
125  115 SUM = SUM + (ABSX/XMAX)**2
126      GO TO 200
127C
128C
129C                  PREPARE FOR PHASE 3.
130C
131   75 SUM = (SUM * XMAX) * XMAX
132C
133   85 ASSIGN 90 TO NEXT
134      SCALE = .FALSE.
135C
136C     FOR REAL OR D.P. SET HITEST = CUTHI/N
137C     FOR COMPLEX      SET HITEST = CUTHI/(2*N)
138C
139      HITEST = CUTHI/FLOAT( N )
140C
141C                   PHASE 3.  SUM IS MID-RANGE.  NO SCALING.
142C
143   90 IF(ABSX .GE. HITEST) GO TO 100
144         SUM = SUM + ABSX**2
145  200 CONTINUE
146C                  CONTROL SELECTION OF REAL AND IMAGINARY PARTS.
147C
148      IF(IMAG) GO TO 210
149         ABSX = ABS(AIMAG(CX(I)))
150         IMAG = .TRUE.
151      GO TO NEXT,(  50, 70, 90, 110 )
152C
153  210 CONTINUE
154C
155C              END OF MAIN LOOP.
156C              COMPUTE SQUARE ROOT AND ADJUST FOR SCALING.
157C
158      SCNRM2 = SQRT(SUM)
159      IF(SCALE) SCNRM2 = SCNRM2 * XMAX
160  300 CONTINUE
161      RETURN
162      END
163