1 REAL FUNCTION SCNRM2( N, X, INCX ) 2* .. Scalar Arguments .. 3 INTEGER INCX, N 4* .. Array Arguments .. 5 COMPLEX X( * ) 6* .. 7* 8* SCNRM2 returns the euclidean norm of a vector via the function 9* name, so that 10* 11* SCNRM2 := sqrt( conjg( x' )*x ) 12* 13* 14* 15* -- This version written on 25-October-1982. 16* Modified on 14-October-1993 to inline the call to CLASSQ. 17* Sven Hammarling, Nag Ltd. 18* 19* 20* .. Parameters .. 21 REAL ONE , ZERO 22 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 23* .. Local Scalars .. 24 INTEGER IX 25 REAL NORM, SCALE, SSQ, TEMP 26* .. Intrinsic Functions .. 27 INTRINSIC ABS, AIMAG, REAL, SQRT 28* .. 29* .. Executable Statements .. 30 IF( N.LT.1 .OR. INCX.LT.1 )THEN 31 NORM = ZERO 32 ELSE 33 SCALE = ZERO 34 SSQ = ONE 35* The following loop is equivalent to this call to the LAPACK 36* auxiliary routine: 37* CALL CLASSQ( N, X, INCX, SCALE, SSQ ) 38* 39 DO 10, IX = 1, 1 + ( N - 1 )*INCX, INCX 40 IF( REAL( X( IX ) ).NE.ZERO )THEN 41 TEMP = ABS( REAL( X( IX ) ) ) 42 IF( SCALE.LT.TEMP )THEN 43 SSQ = ONE + SSQ*( SCALE/TEMP )**2 44 SCALE = TEMP 45 ELSE 46 SSQ = SSQ + ( TEMP/SCALE )**2 47 END IF 48 END IF 49 IF( AIMAG( X( IX ) ).NE.ZERO )THEN 50 TEMP = ABS( AIMAG( X( IX ) ) ) 51 IF( SCALE.LT.TEMP )THEN 52 SSQ = ONE + SSQ*( SCALE/TEMP )**2 53 SCALE = TEMP 54 ELSE 55 SSQ = SSQ + ( TEMP/SCALE )**2 56 END IF 57 END IF 58 10 CONTINUE 59 NORM = SCALE * SQRT( SSQ ) 60 END IF 61* 62 SCNRM2 = NORM 63 RETURN 64* 65* End of SCNRM2. 66* 67 END 68