REAL FUNCTION SCNRM2(N,X,INCX) * .. Scalar Arguments .. INTEGER INCX,N * .. * .. Array Arguments .. COMPLEX X(*) * .. * * Purpose * ======= * * SCNRM2 returns the euclidean norm of a vector via the function * name, so that * * SCNRM2 := sqrt( conjg( x' )*x ) * * Further Details * =============== * * -- This version written on 25-October-1982. * Modified on 14-October-1993 to inline the call to CLASSQ. * Sven Hammarling, Nag Ltd. * * ===================================================================== * * .. Parameters .. REAL ONE,ZERO PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) * .. * .. Local Scalars .. REAL NORM,SCALE,SSQ,TEMP INTEGER IX * .. * .. Intrinsic Functions .. INTRINSIC ABS,AIMAG,REAL,SQRT * .. IF (N.LT.1 .OR. INCX.LT.1) THEN NORM = ZERO ELSE SCALE = ZERO SSQ = ONE * The following loop is equivalent to this call to the LAPACK * auxiliary routine: * CALL CLASSQ( N, X, INCX, SCALE, SSQ ) * DO 10 IX = 1,1 + (N-1)*INCX,INCX IF (REAL(X(IX)).NE.ZERO) THEN TEMP = ABS(REAL(X(IX))) IF (SCALE.LT.TEMP) THEN SSQ = ONE + SSQ* (SCALE/TEMP)**2 SCALE = TEMP ELSE SSQ = SSQ + (TEMP/SCALE)**2 END IF END IF IF (AIMAG(X(IX)).NE.ZERO) THEN TEMP = ABS(AIMAG(X(IX))) IF (SCALE.LT.TEMP) THEN SSQ = ONE + SSQ* (SCALE/TEMP)**2 SCALE = TEMP ELSE SSQ = SSQ + (TEMP/SCALE)**2 END IF END IF 10 CONTINUE NORM = SCALE*SQRT(SSQ) END IF * SCNRM2 = NORM RETURN * * End of SCNRM2. * END