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