libdspl-2.0/dspl/blas/src/dznrm2.f

141 wiersze
3.3 KiB
Fortran

*> \brief \b DZNRM2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
*
* .. Scalar Arguments ..
* INTEGER INCX,N
* ..
* .. Array Arguments ..
* COMPLEX*16 X(*)
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DZNRM2 returns the euclidean norm of a vector via the function
*> name, so that
*>
*> DZNRM2 := sqrt( x**H*x )
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in] X
*> \verbatim
*> X is COMPLEX*16 array, dimension (N)
*> complex vector with N elements
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> storage spacing between elements of X
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2017
*
*> \ingroup double_blas_level1
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> -- This version written on 25-October-1982.
*> Modified on 14-October-1993 to inline the call to ZLASSQ.
*> Sven Hammarling, Nag Ltd.
*> \endverbatim
*>
* =====================================================================
DOUBLE PRECISION FUNCTION DZNRM2(N,X,INCX)
*
* -- Reference BLAS level1 routine (version 3.8.0) --
* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2017
*
* .. Scalar Arguments ..
INTEGER INCX,N
* ..
* .. Array Arguments ..
COMPLEX*16 X(*)
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE,ZERO
PARAMETER (ONE=1.0D+0,ZERO=0.0D+0)
* ..
* .. Local Scalars ..
DOUBLE PRECISION NORM,SCALE,SSQ,TEMP
INTEGER IX
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS,DBLE,DIMAG,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 ZLASSQ( N, X, INCX, SCALE, SSQ )
*
DO 10 IX = 1,1 + (N-1)*INCX,INCX
IF (DBLE(X(IX)).NE.ZERO) THEN
TEMP = ABS(DBLE(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 (DIMAG(X(IX)).NE.ZERO) THEN
TEMP = ABS(DIMAG(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
*
DZNRM2 = NORM
RETURN
*
* End of DZNRM2.
*
END