/* dznrm2.f -- translated by f2c (version of 23 April 1993  18:34:30).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

doublereal dznrm2_(n, zx, incx)
integer *n;
doublecomplex *zx;
integer *incx;
{
    /* Initialized data */

    static doublereal zero = 0.;
    static doublereal one = 1.;
    static doublereal cutlo = 8.232e-11;
    static doublereal cuthi = 1.304e19;

    /* Format strings */
    static char fmt_30[] = "";
    static char fmt_50[] = "";
    static char fmt_70[] = "";
    static char fmt_90[] = "";
    static char fmt_110[] = "";

    /* System generated locals */
    integer i__1, i__2;
    doublereal ret_val, d__1;
    doublecomplex z__1;

    /* Builtin functions */
    double sqrt();

    /* Local variables */
    static logical imag;
    static doublereal absx, xmax;
    static integer next, i;
    static logical scale;
    static integer ix;
    static doublereal hitest, sum;

    /* Assigned format variables */
    char *next_fmt;

    /* Parameter adjustments */
    --zx;

    /* Function Body */

/*     unitary norm of the complex n-vector stored in zx() with storage */
/*     increment incx . */
/*     if    n .le. 0 return with result = 0. */
/*     if n .ge. 1 then incx must be .ge. 1 */

/*           c.l.lawson , 1978 jan 08 */
/*     modified to correct problem with negative increment, 8/21/90. */

/*     four phase method     using two built-in constants that are */
/*     hopefully applicable to all machines. */
/*         cutlo = maximum of  sqrt(u/eps)  over all known machines. */
/*         cuthi = minimum of  sqrt(v)      over all known machines. */
/*     where */
/*         eps = smallest no. such that eps + 1. .gt. 1. */
/*         u   = smallest positive no.   (underflow limit) */
/*         v   = largest  no.            (overflow  limit) */

/*     brief outline of algorithm.. */

/*     phase 1    scans zero components. */
/*     move to phase 2 when a component is nonzero and .le. cutlo */
/*     move to phase 3 when a component is .gt. cutlo */
/*     move to phase 4 when a component is .ge. cuthi/m */
/*     where m = n for x() real and m = 2*n for complex. */

/*     values for cutlo and cuthi.. */
/*     from the environmental parameters listed in the imsl converter */
/*     document the limiting values are as follows.. */
/*     cutlo, s.p.   u/eps = 2**(-102) for  honeywell.  close seconds are 
*/
/*                   univac and dec at 2**(-103) */
/*                   thus cutlo = 2**(-51) = 4.44089e-16 */
/*     cuthi, s.p.   v = 2**127 for univac, honeywell, and dec. */
/*                   thus cuthi = 2**(63.5) = 1.30438e19 */
/*     cutlo, d.p.   u/eps = 2**(-67) for honeywell and dec. */
/*                   thus cutlo = 2**(-33.5) = 8.23181d-11 */
/*     cuthi, d.p.   same as s.p.  cuthi = 1.30438d19 */
/*     data cutlo, cuthi / 8.232d-11,  1.304d19 / */
/*     data cutlo, cuthi / 4.441e-16,  1.304e19 / */

    if (*n > 0) {
	goto L10;
    }
    ret_val = zero;
    goto L300;

L10:
    next = 0;
    next_fmt = fmt_30;
    sum = zero;
    i = 1;
    if (*incx < 0) {
	i = (-(*n) + 1) * *incx + 1;
    }
/*                                                 begin main loop */
    i__1 = *n;
    for (ix = 1; ix <= i__1; ++ix) {
	i__2 = i;
	absx = (d__1 = zx[i__2].r, abs(d__1));
	imag = FALSE_;
	switch ((int)next) {
	    case 0: goto L30;
	    case 1: goto L50;
	    case 2: goto L70;
	    case 3: goto L110;
	    case 4: goto L90;
	}
L30:
	if (absx > cutlo) {
	    goto L85;
	}
	next = 1;
	next_fmt = fmt_50;
	scale = FALSE_;

/*                        phase 1.  sum is zero */

L50:
	if (absx == zero) {
	    goto L200;
	}
	if (absx > cutlo) {
	    goto L85;
	}

/*                                prepare for phase 2. */
	next = 2;
	next_fmt = fmt_70;
	goto L105;

/*                                prepare for phase 4. */

L100:
	next = 3;
	next_fmt = fmt_110;
	sum = sum / absx / absx;
L105:
	scale = TRUE_;
	xmax = absx;
	goto L115;

/*                   phase 2.  sum is small. */
/*                             scale to avoid destructive underflow. 
*/

L70:
	if (absx > cutlo) {
	    goto L75;
	}

/*                     common code for phases 2 and 4. */
/*                     in phase 4 sum is large.  scale to avoid overfl
ow. */

L110:
	if (absx <= xmax) {
	    goto L115;
	}
/* Computing 2nd power */
	d__1 = xmax / absx;
	sum = one + sum * (d__1 * d__1);
	xmax = absx;
	goto L200;

L115:
/* Computing 2nd power */
	d__1 = absx / xmax;
	sum += d__1 * d__1;
	goto L200;


/*                  prepare for phase 3. */

L75:
	sum = sum * xmax * xmax;

L85:
	next = 4;
	next_fmt = fmt_90;
	scale = FALSE_;

/*     for real or d.p. set hitest = cuthi/n */
/*     for complex      set hitest = cuthi/(2*n) */

	hitest = cuthi / (doublereal) (*n << 1);

/*                   phase 3.  sum is mid-range.  no scaling. */

L90:
	if (absx >= hitest) {
	    goto L100;
	}
/* Computing 2nd power */
	d__1 = absx;
	sum += d__1 * d__1;
L200:
/*                  control selection of real and imaginary parts. */

	if (imag) {
	    goto L210;
	}
	i__2 = i;
	z__1.r = zx[i__2].r * 0. - zx[i__2].i * -1., z__1.i = zx[i__2].r * 
		-1. + zx[i__2].i * 0.;
	absx = (d__1 = z__1.r, abs(d__1));
	imag = TRUE_;
	switch ((int)next) {
	    case 0: goto L30;
	    case 1: goto L50;
	    case 2: goto L70;
	    case 3: goto L110;
	    case 4: goto L90;
	}

L210:
	i += *incx;
/* L220: */
    }

/*              end of main loop. */
/*              compute square root and adjust for scaling. */

    ret_val = sqrt(sum);
    if (scale) {
	ret_val *= xmax;
    }
L300:
    return ret_val;
} /* dznrm2_ */

