db/d66/scnrm2_8f_source.html

00001       REAL FUNCTION SCNRM2(N,X,INCX)
00002 *     .. Scalar Arguments ..
00003       INTEGER INCX,N
00004 *     ..
00005 *     .. Array Arguments ..
00006       COMPLEX X(*)
00007 *     ..
00008 *
00009 *  Purpose
00010 *  =======
00011 *
00012 *  SCNRM2 returns the euclidean norm of a vector via the function
00013 *  name, so that
00014 *
00015 *     SCNRM2 := sqrt( x**H*x )
00016 *
00017 *  Further Details
00018 *  ===============
00019 *
00020 *  -- This version written on 25-October-1982.
00021 *     Modified on 14-October-1993 to inline the call to CLASSQ.
00022 *     Sven Hammarling, Nag Ltd.
00023 *
00024 *  =====================================================================
00025 *
00026 *     .. Parameters ..
00027       REAL ONE,ZERO
00028       PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
00029 *     ..
00030 *     .. Local Scalars ..
00031       REAL NORM,SCALE,SSQ,TEMP
00032       INTEGER IX
00033 *     ..
00034 *     .. Intrinsic Functions ..
00035       INTRINSIC ABS,AIMAG,REAL,SQRT
00036 *     ..
00037       IF (N.LT.1 .OR. INCX.LT.1) THEN
00038           NORM = ZERO
00039       ELSE
00040           SCALE = ZERO
00041           SSQ = ONE
00042 *        The following loop is equivalent to this call to the LAPACK
00043 *        auxiliary routine:
00044 *        CALL CLASSQ( N, X, INCX, SCALE, SSQ )
00045 *
00046           DO 10 IX = 1,1 + (N-1)*INCX,INCX
00047               IF (REAL(X(IX)).NE.ZERO) THEN
00048                   TEMP = ABS(REAL(X(IX)))
00049                   IF (SCALE.LT.TEMP) THEN
00050                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
00051                       SCALE = TEMP
00052                   ELSE
00053                       SSQ = SSQ + (TEMP/SCALE)**2
00054                   END IF
00055               END IF
00056               IF (AIMAG(X(IX)).NE.ZERO) THEN
00057                   TEMP = ABS(AIMAG(X(IX)))
00058                   IF (SCALE.LT.TEMP) THEN
00059                       SSQ = ONE + SSQ* (SCALE/TEMP)**2
00060                       SCALE = TEMP
00061                   ELSE
00062                       SSQ = SSQ + (TEMP/SCALE)**2
00063                   END IF
00064               END IF
00065    10     CONTINUE
00066           NORM = SCALE*SQRT(SSQ)
00067       END IF
00068 *
00069       SCNRM2 = NORM
00070       RETURN
00071 *
00072 *     End of SCNRM2.
00073 *
00074       END