/* wfir.f -- translated by f2c (version 19940305).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* Table of constant values */

static integer c__1 = 1;
static integer c__3 = 3;
static integer c__4 = 4;
static doublereal c_b81 = 10.;
static doublereal c_b121 = .4;
static real c_b233 = (float)1.;
static real c_b234 = (float)0.;
static real c_b240 = (float).5;

/* @(#)wfir.f	1.2	1/11/91 */
/* main program: window design of linear phase, lowpass, highpass */
/*               bandpass, and bandstop fir digital filters */
/* author:       lawrence r. rabiner and carol a. mcgonegal */
/*               bell laboratories, murray hill, new jersey, 07974 */
/* modified jan. 1978 by doug paul, mit lincoln laboratories */
/* to include subroutines for obtaining filter band edges and ripples */

/* modified july. 1990 by Edward Lee, UCB, for Gabriel compatibility */

/* input:        nf is the filter length in samples */
/*                   3 <= nf <= 1024 */

/*               itype is the window type */
/*                   itype = 1     rectangular window */
/*                   itype = 2     triangular window */
/*                   itype = 3     hamming window */
/*                   itype = 4     generalized hamming window */
/*                   itype = 5     hanning window */
/*                   itype = 6     kaiser (i0-sinh) window */
/*                   itype = 7     chebyshev window */

/*               jtype is the filter type */
/*                   jtype = 1     lowpass filter */
/*                   jtype = 2     highpass filter */
/*                   jtype = 3     bandpass filter */
/*                   jtype = 4     bandstop filter */

/*               fc is the normalized cutoff frequency */
/*                   0 <= fc <= 0.5 */
/*               fl and fh are the normalized filter cutoff frequencies */
/*                   0 <= fl <= fh <= 0.5 */
/*               iwp optionally prints out the window values */
/*                   iwp = 0  do not print */
/*                   iwp = 1  print */
/*               imd requests additional runs */
/*                   imd = 1   new run */
/*                   imd = 0   terminates program */
/* ----------------------------------------------------------------------- */

/*<       dimension w(512), g(512) >*/
/* Main program */ MAIN__()
{
    /* Format strings */
    static char fmt_9997[] = "(\002 filter length =\002,i4,\002 is out of bo\
unds\002)";
    static char fmt_9995[] = "(\002 Cutoff freq=\002,f14.7,\002 is out of bo\
unds, reenter da\002,\002ta\002)";
    static char fmt_9992[] = "(\002 fh=\002,f14.7,\002 is smaller than fl\
=\002,f14.7,\002 reenter\002,\002 data\002)";
    static char fmt_9993[] = "(2f14.7)";
    static char fmt_9989[] = "(\002 rectangular window-nf=\002,i4)";
    static char fmt_9988[] = "(\002 triangular window-nf=\002,i4)";
    static char fmt_9987[] = "(\002 hamming window length=\002,i4)";
    static char fmt_9986[] = "(\002 alpha=\002,f14.7)";
    static char fmt_9985[] = "(\002 specify alpha for generalized hamming wi\
ndow\002)";
    static char fmt_9984[] = "(\002 generalized hamming window length=\002,i\
4)";
    static char fmt_9983[] = "(\002 hanning window length=\002,i4)";
    static char fmt_9982[] = "(\002 specify attenuation in db(f14.7)\002,\
\002 for kaiser wind\002,\002ow\002)";
    static char fmt_9981[] = "(\002 kaiser window length=\002,i4)";
    static char fmt_9980[] = "(\002  attenuation=\002,f14.7,\002  beta=\002,\
f14.7)";
    static char fmt_9979[] = "(\002 Chebyshev window length=\002,i4)";
    static char fmt_9978[] = "(\002 ripple=\002,f14.7,\002  transition wid\
th=\002,f14.7)";
    static char fmt_9975[] = "(\002 window values\002)";
    static char fmt_9974[] = "(10x,\002 w(\002,i3,\002)=\002,e15.8,\002 =w\
(\002,i4,\002)\002)";
    static char fmt_9973[] = "(\002 **lowpass filter design**\002)";
    static char fmt_9972[] = "(\002 **highpass filter design**\002)";
    static char fmt_9971[] = "(\002 **bandpass filter design**\002)";
    static char fmt_9970[] = "(\002 **bandstop filter design**\002)";
    static char fmt_9969[] = "(\002 ideal lowpass cutoff=\002,f14.7)";
    static char fmt_9968[] = "(\002 ideal highpass cutoff=\002,f14.7)";
    static char fmt_9967[] = "(\002 ideal cutoff frequencies=\002,2f14.7)";
    static char fmt_9966[] = "(10x,\002 h(\002,i3,\002)=\002,e15.8,\002 =h\
(\002,i4,\002)\002)";
    static char fmt_9965[] = "(\002 \002/)";

    /* System generated locals */
    integer i__1;
    doublereal d__1;
    olist o__1;
    cllist cl__1;

    /* Builtin functions */
    double atan();
    integer s_wsfe(), do_fio(), e_wsfe(), s_rsfe(), e_rsfe(), s_cmp(), f_open(
	    ), s_rsle(), do_lio(), e_rsle();
    double pow_dd(), sin(), cos();
    integer f_clos();
    /* Subroutine */ int s_stop();

    /* Local variables */
    static real beta;
    static integer otcd1, otcd2;
    static real c;
    extern /* Subroutine */ int chebc_();
    static real g[512];
    static integer i, j, k, n;
    static real alpha;
    static char fname[100];
    static real w[512];
    extern /* Subroutine */ int cheby_();
    static integer incod;
    static real dplog;
    extern /* Subroutine */ int flush_();
    static real c1;
    static integer ioutd;
    static real c3;
    static integer itype, jtype, i1;
    static real twopi, x0, fc, df, fh, fl;
    static integer nf;
    static real dp, pi;
    extern /* Subroutine */ int flchar_();
    static real xn;
    extern /* Subroutine */ int hammin_(), kaiser_(), triang_();
    static char answer[1];
    extern /* Subroutine */ int outimp_();
    static integer ieo;
    static real att;

    /* Fortran I/O blocks */
    static cilist io___5 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___6 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___7 = { 0, 6, 0, "(/,a)", 0 };
    static cilist io___8 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___9 = { 0, 5, 0, "(a12)", 0 };
    static cilist io___12 = { 0, 6, 0, "(/,a)", 0 };
    static cilist io___13 = { 0, 0, 0, 0, 0 };
    static cilist io___15 = { 0, 0, 0, fmt_9997, 0 };
    static cilist io___16 = { 0, 6, 0, "(,a,/,10x,a)", 0 };
    static cilist io___17 = { 0, 0, 0, 0, 0 };
    static cilist io___19 = { 0, 6, 0, "(,a,/,20x,a)", 0 };
    static cilist io___20 = { 0, 0, 0, 0, 0 };
    static cilist io___23 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___24 = { 0, 0, 0, 0, 0 };
    static cilist io___26 = { 0, 0, 0, fmt_9995, 0 };
    static cilist io___27 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___28 = { 0, 0, 0, 0, 0 };
    static cilist io___30 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___31 = { 0, 0, 0, 0, 0 };
    static cilist io___33 = { 0, 0, 0, fmt_9995, 0 };
    static cilist io___34 = { 0, 0, 0, fmt_9995, 0 };
    static cilist io___35 = { 0, 0, 0, fmt_9992, 0 };
    static cilist io___36 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___37 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___38 = { 0, 0, 0, fmt_9993, 0 };
    static cilist io___45 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___52 = { 0, 0, 0, fmt_9989, 0 };
    static cilist io___54 = { 0, 0, 0, fmt_9988, 0 };
    static cilist io___56 = { 0, 0, 0, fmt_9987, 0 };
    static cilist io___58 = { 0, 0, 0, fmt_9986, 0 };
    static cilist io___59 = { 0, 0, 0, fmt_9985, 0 };
    static cilist io___60 = { 0, 0, 0, fmt_9993, 0 };
    static cilist io___61 = { 0, 0, 0, fmt_9984, 0 };
    static cilist io___62 = { 0, 0, 0, fmt_9983, 0 };
    static cilist io___63 = { 0, 0, 0, fmt_9982, 0 };
    static cilist io___64 = { 0, 0, 0, fmt_9993, 0 };
    static cilist io___66 = { 0, 0, 0, fmt_9981, 0 };
    static cilist io___67 = { 0, 0, 0, fmt_9980, 0 };
    static cilist io___68 = { 0, 0, 0, fmt_9979, 0 };
    static cilist io___69 = { 0, 0, 0, fmt_9978, 0 };
    static cilist io___70 = { 0, 6, 0, "(/,a)", 0 };
    static cilist io___71 = { 0, 5, 0, "(a1)", 0 };
    static cilist io___73 = { 0, 0, 0, fmt_9975, 0 };
    static cilist io___76 = { 0, 0, 0, fmt_9974, 0 };
    static cilist io___77 = { 0, 0, 0, fmt_9973, 0 };
    static cilist io___78 = { 0, 0, 0, fmt_9972, 0 };
    static cilist io___79 = { 0, 0, 0, fmt_9971, 0 };
    static cilist io___80 = { 0, 0, 0, fmt_9970, 0 };
    static cilist io___81 = { 0, 0, 0, fmt_9969, 0 };
    static cilist io___82 = { 0, 0, 0, fmt_9968, 0 };
    static cilist io___83 = { 0, 0, 0, fmt_9967, 0 };
    static cilist io___84 = { 0, 0, 0, fmt_9966, 0 };
    static cilist io___85 = { 0, 0, 0, fmt_9965, 0 };
    static cilist io___87 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___88 = { 0, 6, 0, "(,a)", 0 };
    static cilist io___89 = { 0, 0, 0, "(a)", 0 };
    static cilist io___90 = { 0, 6, 0, "(/,a)", 0 };
    static cilist io___91 = { 0, 5, 0, "(a1)", 0 };


/*<       integer otcd1, otcd2 >*/
/*<       character fname*100 >*/
/*<       character answer*1 >*/

/*<       pi = 4.0*atan(1.0) >*/
    pi = atan((float)1.) * (float)4.;
/*<       twopi = 2.0*pi >*/
    twopi = pi * (float)2.;

/* define i/o device codes */
/* input: input to this program is user-interactive */
/*        that is - a question is written on the user */
/*        terminal (otcd1) and the user types in the answer. */

/* output: standard output is otcd1 and otcd2 */

/*      otcd1 = i1mach(4) */
/*<       otcd1 = 6 >*/
    otcd1 = 6;
/*      otcd2 = i1mach(2) */
/*<       otcd2 = 6 >*/
    otcd2 = 6;

/*<       write (*,'(,a)') ' PROVISIONAL WINDOW FIR FILTER DESIGN ' >*/
    s_wsfe(&io___5);
    do_fio(&c__1, " PROVISIONAL WINDOW FIR FILTER DESIGN ", 38L);
    e_wsfe();
/*<       write (*,'(,a)') ' USE AT YOUR OWN RISK --------------- ' >*/
    s_wsfe(&io___6);
    do_fio(&c__1, " USE AT YOUR OWN RISK --------------- ", 38L);
    e_wsfe();

/* input the filter length(nf), window type(itype) and filter type(jtype) 
*/

/*<    >*/
L10:
    s_wsfe(&io___7);
    do_fio(&c__1, " Enter name of input command file (press <Enter> for manu\
al entry, ", 67L);
    e_wsfe();
/*<    >*/
    s_wsfe(&io___8);
    do_fio(&c__1, " Sorry, no tilde-expansion.  Give path relative to your h\
ome or startup directory): ", 84L);
    e_wsfe();
/*<       read (*,'(a12)') fname >*/
    s_rsfe(&io___9);
    do_fio(&c__1, fname, 100L);
    e_rsfe();
/*<       if (fname .eq. ' ') then >*/
    if (s_cmp(fname, " ", 100L, 1L) == 0) {
/*<          incod = 5 >*/
	incod = 5;
/*<       else >*/
    } else {
/*<          incod = 3 >*/
	incod = 3;
/*<          open (3, file=fname) >*/
	o__1.oerr = 0;
	o__1.ounit = 3;
	o__1.ofnmlen = 100;
	o__1.ofnm = fname;
	o__1.orl = 0;
	o__1.osta = 0;
	o__1.oacc = 0;
	o__1.ofm = 0;
	o__1.oblnk = 0;
	f_open(&o__1);
/*<       endif >*/
    }

/*<   15  write (*,'(/,a)') ' Enter filter length: ' >*/
L15:
    s_wsfe(&io___12);
    do_fio(&c__1, " Enter filter length: ", 22L);
    e_wsfe();
/*<       read (incod,*) nf >*/
    io___13.ciunit = incod;
    s_rsle(&io___13);
    do_lio(&c__3, &c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_rsle();
/*<       if (nf.le.1024) go to 30 >*/
    if (nf <= 1024) {
	goto L30;
    }
/*<   20  write (otcd2,9997) nf >*/
L20:
    io___15.ciunit = otcd2;
    s_wsfe(&io___15);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9997  format (16h filter length =, i4, 17h is out of bounds) >*/
/*<       go to 15 >*/
    goto L15;
/*<    >*/
L30:
    s_wsfe(&io___16);
    do_fio(&c__1, " Enter window type (1=Rectangular, 2=Triangular,", 48L);
    do_fio(&c__1, "3=Hamming, 4=Gen. Hamming, 5=Hanning, 6=Kaiser, 7=Chebysh\
ev): ", 62L);
    e_wsfe();
/*<       read (incod,*) itype >*/
    io___17.ciunit = incod;
    s_rsle(&io___17);
    do_lio(&c__3, &c__1, (char *)&itype, (ftnlen)sizeof(integer));
    e_rsle();
/*<   35  if (itype.ne.7 .and. nf.lt.3) go to 20 >*/
/* L35: */
    if (itype != 7 && nf < 3) {
	goto L20;
    }
/*<       if (itype.eq.7 .and. (nf.eq.1 .or. nf.eq.2)) go to 20 >*/
    if (itype == 7 && (nf == 1 || nf == 2)) {
	goto L20;
    }
/*<    >*/
    s_wsfe(&io___19);
    do_fio(&c__1, " Enter filter type (1=Lowpass, 2=Highpass,", 42L);
    do_fio(&c__1, "3=Bandpass, 4=Bandstop): ", 25L);
    e_wsfe();
/*<       read (incod,*) jtype >*/
    io___20.ciunit = incod;
    s_rsle(&io___20);
    do_lio(&c__3, &c__1, (char *)&jtype, (ftnlen)sizeof(integer));
    e_rsle();

/* n is half the length of the symmetric filter */

/*<       n = (nf+1)/2 >*/
    n = (nf + 1) / 2;
/*<       if (jtype.ne.1 .and. jtype.ne.2) go to 50 >*/
    if (jtype != 1 && jtype != 2) {
	goto L50;
    }

/* for the ideal lowpass or highpass design - input fc */

/*<    >*/
L40:
    s_wsfe(&io___23);
    do_fio(&c__1, " Enter cutoff frequency (as a fraction of sample frequenc\
y): ", 61L);
    e_wsfe();
/*<       read (incod,*) fc >*/
    io___24.ciunit = incod;
    s_rsle(&io___24);
    do_lio(&c__4, &c__1, (char *)&fc, (ftnlen)sizeof(real));
    e_rsle();
/*<       if (fc.gt.0.0 .and. fc.lt.0.5) go to 60 >*/
    if (fc > (float)0. && fc < (float).5) {
	goto L60;
    }
/*<       write (otcd1,9995) fc >*/
    io___26.ciunit = otcd1;
    s_wsfe(&io___26);
    do_fio(&c__1, (char *)&fc, (ftnlen)sizeof(real));
    e_wsfe();
/*< 99 >*/
/*<       go to 40 >*/
    goto L40;

/* for the ideal bandpass or bandstop design - input fl and fh */

/*<    >*/
L50:
    s_wsfe(&io___27);
    do_fio(&c__1, " Enter lower cutoff frequency (as a fraction of sample fr\
equency): ", 67L);
    e_wsfe();
/*<       read (incod,*) fl >*/
    io___28.ciunit = incod;
    s_rsle(&io___28);
    do_lio(&c__4, &c__1, (char *)&fl, (ftnlen)sizeof(real));
    e_rsle();
/*<    >*/
    s_wsfe(&io___30);
    do_fio(&c__1, " Enter upper cutoff frequency (as a fraction of sample fr\
equency): ", 67L);
    e_wsfe();
/*<       read (incod,*) fh >*/
    io___31.ciunit = incod;
    s_rsle(&io___31);
    do_lio(&c__4, &c__1, (char *)&fh, (ftnlen)sizeof(real));
    e_rsle();
/*<    >*/
    if (fl > (float)0. && fl < (float).5 && fh > (float)0. && fh < (float).5 
	    && fh > fl) {
	goto L60;
    }
/*<       if (fl.lt.0. .or. fl.gt.0.5) write (otcd1,9995) fl >*/
    if (fl < (float)0. || fl > (float).5) {
	io___33.ciunit = otcd1;
	s_wsfe(&io___33);
	do_fio(&c__1, (char *)&fl, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*<       if (fh.lt.0. .or. fh.gt.0.5) write (otcd1,9995) fh >*/
    if (fh < (float)0. || fh > (float).5) {
	io___34.ciunit = otcd1;
	s_wsfe(&io___34);
	do_fio(&c__1, (char *)&fh, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*<       if (fh.lt.fl) write (otcd1,9992) fh, fl >*/
    if (fh < fl) {
	io___35.ciunit = otcd1;
	s_wsfe(&io___35);
	do_fio(&c__1, (char *)&fh, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&fl, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*< 99 >*/
/*<       go to 50 >*/
    goto L50;
/*<   60  if (itype.ne.7) go to 70 >*/
L60:
    if (itype != 7) {
	goto L70;
    }

/* input for chebyshev window--2 of the 3 parameters nf, dplog, and df */
/* must be specified, where dplog is the desired filter ripple(db scale), 
*/
/* df is the transition width (normalized) of the filter, */
/* and nf is the filter length.  the unspecified parameter */
/* is read in with the zero value. */

/*<    >*/
    s_wsfe(&io___36);
    do_fio(&c__1, " Enter chebyshev ripple (in db), and optional transition \
width,", 63L);
    e_wsfe();
/*<       write (*,'(,a)') ' separated by a comma, using decimal points: ' >*/
    s_wsfe(&io___37);
    do_fio(&c__1, " separated by a comma, using decimal points: ", 45L);
    e_wsfe();
/*<       read (incod,9993) dplog, df >*/
    io___38.ciunit = incod;
    s_rsfe(&io___38);
    do_fio(&c__1, (char *)&dplog, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&df, (ftnlen)sizeof(real));
    e_rsfe();
/*< 9993  format (2f14.7) >*/
/*<       dp = 10.0**(-dplog/20.0) >*/
    d__1 = (doublereal) (-(doublereal)dplog / (float)20.);
    dp = pow_dd(&c_b81, &d__1);
/*<       call chebc(nf, dp, df, n, x0, xn) >*/
    chebc_(&nf, &dp, &df, &n, &x0, &xn);

/* ieo is an even, odd indicator, ieo = 0 for even, ieo = 1 for odd */

/*<   70  ieo = mod(nf,2) >*/
L70:
    ieo = nf % 2;

/*   The following seemed wrong: had 1 instead of 4.  Even length */
/*   lowpass filters could result in the original. */

/*<       if (ieo.eq.1 .or. jtype.eq.4 .or. jtype.eq.3) go to 80 >*/
    if (ieo == 1 || jtype == 4 || jtype == 3) {
	goto L80;
    }
/*<    >*/
    s_wsfe(&io___45);
    do_fio(&c__1, " Order must be odd for highpass of lowpass filters -- bei\
ng increased by 1. ", 76L);
    e_wsfe();
/*<       nf = nf + 1 >*/
    ++nf;
/*<       n = (1+nf)/2 >*/
    n = (nf + 1) / 2;
/*<       ieo = 1 >*/
    ieo = 1;
/*<   80  continue >*/
L80:

/* compute ideal (unwindowed) impulse response for filter */

/*<       c1 = fc >*/
    c1 = fc;
/*<       if (jtype.eq.3 .or. jtype.eq.4) c1 = fh - fl >*/
    if (jtype == 3 || jtype == 4) {
	c1 = fh - fl;
    }
/*<       if (ieo.eq.1) g(1) = 2.*c1 >*/
    if (ieo == 1) {
	g[0] = c1 * (float)2.;
    }
/*<       i1 = ieo + 1 >*/
    i1 = ieo + 1;
/*<       do 90 i=i1,n >*/
    i__1 = n;
    for (i = i1; i <= i__1; ++i) {
/*<         xn = i - 1 >*/
	xn = (real) (i - 1);
/*<         if (ieo.eq.0) xn = xn + 0.5 >*/
	if (ieo == 0) {
	    xn += (float).5;
	}
/*<         c = pi*xn >*/
	c = pi * xn;
/*<         c3 = c*c1 >*/
	c3 = c * c1;
/*<         if (jtype.eq.1 .or. jtype.eq.2) c3 = 2.*c3 >*/
	if (jtype == 1 || jtype == 2) {
	    c3 *= (float)2.;
	}
/*<         g(i) = sin(c3)/c >*/
	g[i - 1] = sin(c3) / c;
/*<         if (jtype.eq.3 .or. jtype.eq.4) g(i) = g(i)*2.*cos(c*(fl+fh)) >*/
	if (jtype == 3 || jtype == 4) {
	    g[i - 1] = g[i - 1] * (float)2. * cos(c * (fl + fh));
	}
/*<   90  continue >*/
/* L90: */
    }

/* compute a rectangular window */

/*<       if (itype.eq.1) write (otcd2,9989) nf >*/
    if (itype == 1) {
	io___52.ciunit = otcd2;
	s_wsfe(&io___52);
	do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
	e_wsfe();
    }
/*< 9989  format (23h rectangular window-nf=, i4) >*/
/*<       do 100 i=1,n >*/
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
/*<         w(i) = 1. >*/
	w[i - 1] = (float)1.;
/*<  100  continue >*/
/* L100: */
    }

/* dispatch on window type */

/*<       go to (200, 110, 120, 140, 150, 160, 170), itype >*/
    switch ((int)itype) {
	case 1:  goto L200;
	case 2:  goto L110;
	case 3:  goto L120;
	case 4:  goto L140;
	case 5:  goto L150;
	case 6:  goto L160;
	case 7:  goto L170;
    }

/* triangular window */

/*<  110  call triang(nf, w, n, ieo) >*/
L110:
    triang_(&nf, w, &n, &ieo);
/*<       write (otcd2,9988) nf >*/
    io___54.ciunit = otcd2;
    s_wsfe(&io___54);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9988  format (22h triangular window-nf=, i4) >*/
/*<       go to 180 >*/
    goto L180;

/* hamming window */

/*<  120  alpha = 0.54 >*/
L120:
    alpha = (float).54;
/*<       write (otcd2,9987) nf >*/
    io___56.ciunit = otcd2;
    s_wsfe(&io___56);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9987  format (23h hamming window length=, i4) >*/
/*<  130  beta = 1. - alpha >*/
L130:
    beta = (float)1. - alpha;
/*<       call hammin(nf, w, n, ieo, alpha, beta) >*/
    hammin_(&nf, w, &n, &ieo, &alpha, &beta);
/*<       write (otcd2,9986) alpha >*/
    io___58.ciunit = otcd2;
    s_wsfe(&io___58);
    do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
    e_wsfe();
/*< 9986  format (7h alpha=, f14.7) >*/
/*<       go to 180 >*/
    goto L180;

/* generalized hamming window */
/* form of window is w(m)=alpha+beta*cos((twopi*m)/(nf-1)) */
/* beta is automatically set to 1.-alpha */
/* read in alpha */

/*<  140  write (otcd1,9985) >*/
L140:
    io___59.ciunit = otcd1;
    s_wsfe(&io___59);
    e_wsfe();
/*< 9985  format (45h specify alpha for generalized hamming window) >*/
/*<       read (incod,9993) alpha >*/
    io___60.ciunit = incod;
    s_rsfe(&io___60);
    do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
    e_rsfe();
/*<       write (otcd2,9984) nf >*/
    io___61.ciunit = otcd2;
    s_wsfe(&io___61);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9984  format (35h generalized hamming window length=, i4) >*/
/*<       go to 130 >*/
    goto L130;

/* hanning window */

/*<  150  alpha = 0.5 >*/
L150:
    alpha = (float).5;
/*<       write (otcd2,9983) nf >*/
    io___62.ciunit = otcd2;
    s_wsfe(&io___62);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9983  format (23h hanning window length=, i4) >*/

/* increase nf by 2 and n by 1 for hanning window so zero */
/* endpoints are not part of window */

/*<       nf = nf + 2 >*/
    nf += 2;
/*<       n = n + 1 >*/
    ++n;
/*<       go to 130 >*/
    goto L130;

/* kaiser (i0-sinh) window */
/* need to specify parameter att=stopband attenuation in db */

/*<  160  write (otcd1,9982) >*/
L160:
    io___63.ciunit = otcd1;
    s_wsfe(&io___63);
    e_wsfe();
/*< 99 >*/
/*<       read (incod,9993) att >*/
    io___64.ciunit = incod;
    s_rsfe(&io___64);
    do_fio(&c__1, (char *)&att, (ftnlen)sizeof(real));
    e_rsfe();
/*<       if (att.gt.50.) beta = 0.1102*(att-8.7) >*/
    if (att > (float)50.) {
	beta = (att - (float)8.7) * (float).1102;
    }
/*<    >*/
    if (att >= (float)20.96 && att <= (float)50.) {
	d__1 = (doublereal) (att - (float)20.96);
	beta = pow_dd(&d__1, &c_b121) * (float).58417 + (att - (float)20.96) *
		 (float).07886;
    }
/*<       if (att.lt.20.96) beta = 0. >*/
    if (att < (float)20.96) {
	beta = (float)0.;
    }
/*<       call kaiser(nf, w, n, ieo, beta) >*/
    kaiser_(&nf, w, &n, &ieo, &beta);
/*<       write (otcd2,9981) nf >*/
    io___66.ciunit = otcd2;
    s_wsfe(&io___66);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9981  format (22h kaiser window length=, i4) >*/
/*<       write (otcd2,9980) att, beta >*/
    io___67.ciunit = otcd2;
    s_wsfe(&io___67);
    do_fio(&c__1, (char *)&att, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(real));
    e_wsfe();
/*< 9980  format (14h  attenuation=, f14.7, 7h  beta=, f14.7) >*/
/*<       go to 180 >*/
    goto L180;

/* chebyshev window */

/*<  170  call cheby(nf, w, n, ieo, dp, df, x0, xn) >*/
L170:
    cheby_(&nf, w, &n, &ieo, &dp, &df, &x0, &xn);
/*<       write (otcd2,9979) nf >*/
    io___68.ciunit = otcd2;
    s_wsfe(&io___68);
    do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
    e_wsfe();
/*< 9979  format (25h Chebyshev window length=, i4) >*/
/*<       write (otcd2,9978) dp, df >*/
    io___69.ciunit = otcd2;
    s_wsfe(&io___69);
    do_fio(&c__1, (char *)&dp, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&df, (ftnlen)sizeof(real));
    e_wsfe();
/*< 9978  format (8h ripple=, f14.7, 19h  transition width=, f14.7) >*/

/* window ideal filter response */
/* change back nf and n for hanning window */

/*<  180  if (itype.eq.5) nf = nf - 2 >*/
L180:
    if (itype == 5) {
	nf += -2;
    }
/*<       if (itype.eq.5) n = n - 1 >*/
    if (itype == 5) {
	--n;
    }
/*<       do 190 i=1,n >*/
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
/*<         g(i) = g(i)*w(i) >*/
	g[i - 1] *= w[i - 1];
/*<  190  continue >*/
/* L190: */
    }

/* optionally print out results */

/*<  200  write (*,'(/,a\)') ' Print window values? (y/n): ' >*/
L200:
    s_wsfe(&io___70);
    do_fio(&c__1, " Print window values? (y/n): ", 29L);
    e_wsfe();
/*<       read (*,'(a1)') answer >*/
    s_rsfe(&io___71);
    do_fio(&c__1, answer, 1L);
    e_rsfe();
/*<       if (answer .eq. 'n' .or. answer .eq. 'N') go to 220 >*/
    if (*answer == 'n' || *answer == 'N') {
	goto L220;
    }
/*<       write (otcd2,9975) >*/
    io___73.ciunit = otcd2;
    s_wsfe(&io___73);
    e_wsfe();
/*< 9975  format (14h window values) >*/
/*<       do 210 i=1,n >*/
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
/*<         j = n + 1 - i >*/
	j = n + 1 - i;
/*<         k = nf + 1 - i >*/
	k = nf + 1 - i;
/*<         write (otcd2,9974) i, w(j), k >*/
	io___76.ciunit = otcd2;
	s_wsfe(&io___76);
	do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
	do_fio(&c__1, (char *)&w[j - 1], (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
	e_wsfe();
/*< 9974    format (10x, 3h w(, i3, 2h)=, e15.8, 4h =w(, i4, 1h)) >*/
/*<  210  continue >*/
/* L210: */
    }
/*<  220  if (jtype.eq.1) write (otcd2,9973) >*/
L220:
    if (jtype == 1) {
	io___77.ciunit = otcd2;
	s_wsfe(&io___77);
	e_wsfe();
    }
/*< 9973  format (26h **lowpass filter design**) >*/
/*<       if (jtype.eq.2) write (otcd2,9972) >*/
    if (jtype == 2) {
	io___78.ciunit = otcd2;
	s_wsfe(&io___78);
	e_wsfe();
    }
/*< 9972  format (27h **highpass filter design**) >*/
/*<       if (jtype.eq.3) write (otcd2,9971) >*/
    if (jtype == 3) {
	io___79.ciunit = otcd2;
	s_wsfe(&io___79);
	e_wsfe();
    }
/*< 9971  format (27h **bandpass filter design**) >*/
/*<       if (jtype.eq.4) write (otcd2,9970) >*/
    if (jtype == 4) {
	io___80.ciunit = otcd2;
	s_wsfe(&io___80);
	e_wsfe();
    }
/*< 9970  format (27h **bandstop filter design**) >*/
/*<       if (jtype.eq.1) write (otcd2,9969) fc >*/
    if (jtype == 1) {
	io___81.ciunit = otcd2;
	s_wsfe(&io___81);
	do_fio(&c__1, (char *)&fc, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*< 9969  format (22h ideal lowpass cutoff=, f14.7) >*/
/*<       if (jtype.eq.2) write (otcd2,9968) fc >*/
    if (jtype == 2) {
	io___82.ciunit = otcd2;
	s_wsfe(&io___82);
	do_fio(&c__1, (char *)&fc, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*< 9968  format (23h ideal highpass cutoff=, f14.7) >*/
/*<       if (jtype.eq.3 .or. jtype.eq.4) write (otcd2,9967) fl, fh >*/
    if (jtype == 3 || jtype == 4) {
	io___83.ciunit = otcd2;
	s_wsfe(&io___83);
	do_fio(&c__1, (char *)&fl, (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&fh, (ftnlen)sizeof(real));
	e_wsfe();
    }
/*< 9967  format (26h ideal cutoff frequencies=, 2f14.7) >*/
/*<       if (jtype.eq.1 .or. jtype.eq.3) go to 240 >*/
    if (jtype == 1 || jtype == 3) {
	goto L240;
    }
/*<       do 230 i=2,n >*/
    i__1 = n;
    for (i = 2; i <= i__1; ++i) {
/*<         g(i) = -g(i) >*/
	g[i - 1] = -(doublereal)g[i - 1];
/*<  230  continue >*/
/* L230: */
    }
/*<       g(1) = 1.0 - g(1) >*/
    g[0] = (float)1. - g[0];

/* write out impulse response */



/*<  240  do 250 i=1,n >*/
L240:
    i__1 = n;
    for (i = 1; i <= i__1; ++i) {
/*<         j = n + 1 - i >*/
	j = n + 1 - i;
/*<         k = nf + 1 - i >*/
	k = nf + 1 - i;
/*<         write (otcd2,9966) i, g(j), k >*/
	io___84.ciunit = otcd2;
	s_wsfe(&io___84);
	do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
	do_fio(&c__1, (char *)&g[j - 1], (ftnlen)sizeof(real));
	do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
	e_wsfe();
/*< 9966    format (10x, 3h h(, i3, 2h)=, e15.8, 4h =h(, i4, 1h)) >*/
/*<  250  continue >*/
/* L250: */
    }
/*<       call flchar(nf, itype, jtype, fc, fl, fh, n, ieo, g, otcd2) >*/
    flchar_(&nf, &itype, &jtype, &fc, &fl, &fh, &n, &ieo, g, &otcd2);
/*<       write (otcd2,9965) >*/
    io___85.ciunit = otcd2;
    s_wsfe(&io___85);
    e_wsfe();
/*< 9965  format (1h /) >*/

/*   Open output file */

/*<       ioutd = 1 >*/
    ioutd = 1;
/*<    >*/
    s_wsfe(&io___87);
    do_fio(&c__1, " Enter name of window values output file or <enter> ", 52L)
	    ;
    e_wsfe();
/*<    >*/
    s_wsfe(&io___88);
    do_fio(&c__1, " (Sorry, no tilde-expansion.  Give path relative to your \
home directory) ", 73L);
    e_wsfe();
/*<       read (incod,'(a)') fname >*/
    io___89.ciunit = incod;
    s_rsfe(&io___89);
    do_fio(&c__1, fname, 100L);
    e_rsfe();
/*<       if (fname .eq. ' ') go to 260 >*/
    if (s_cmp(fname, " ", 100L, 1L) == 0) {
	goto L260;
    }
/*<       open (ioutd, file=fname) >*/
    o__1.oerr = 0;
    o__1.ounit = ioutd;
    o__1.ofnmlen = 100;
    o__1.ofnm = fname;
    o__1.orl = 0;
    o__1.osta = 0;
    o__1.oacc = 0;
    o__1.ofm = 0;
    o__1.oblnk = 0;
    f_open(&o__1);
/*<       call outimp(g,n,nf,ieo,ioutd) >*/
    outimp_(g, &n, &nf, &ieo, &ioutd);
/*<       call flush(ioutd) >*/
    flush_(&ioutd);
/*<       close(ioutd) >*/
    cl__1.cerr = 0;
    cl__1.cunit = ioutd;
    cl__1.csta = 0;
    f_clos(&cl__1);
/*<  260  close(3) >*/
L260:
    cl__1.cerr = 0;
    cl__1.cunit = 3;
    cl__1.csta = 0;
    f_clos(&cl__1);
/*<       write (*,'(/,a\)') ' Another design? (y/n): ' >*/
    s_wsfe(&io___90);
    do_fio(&c__1, " Another design? (y/n): ", 24L);
    e_wsfe();
/*<       read (*,'(a1)') answer >*/
    s_rsfe(&io___91);
    do_fio(&c__1, answer, 1L);
    e_rsfe();
/*<       if (answer .eq. 'y' .or. answer .eq. 'Y') go to 10 >*/
    if (*answer == 'y' || *answer == 'Y') {
	goto L10;
    }
/*<       stop 'End of program' >*/
    s_stop("End of program", 14L);
/*<       end >*/
} /* MAIN__ */


/* ----------------------------------------------------------------------- */
/* subroutine:  triang */
/* triangular window */
/* ----------------------------------------------------------------------- */

/*<       subroutine triang(nf, w, n, ieo) >*/
/* Subroutine */ int triang_(nf, w, n, ieo)
integer *nf;
real *w;
integer *n, *ieo;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer i;
    static real fn, xi;


/*  nf = filter length in samples */
/*   w = window coefficients for half the window */
/*   n = half window length=(nf+1)/2 */
/* ieo = even - odd indication--ieo=0 for nf even */

/*<       dimension w(1) >*/
/*<       fn = n >*/
    /* Parameter adjustments */
    --w;

    /* Function Body */
    fn = (real) (*n);
/*<       do 10 i=1,n >*/
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
/*<         xi = i - 1 >*/
	xi = (real) (i - 1);
/*<         if (ieo.eq.0) xi = xi + 0.5 >*/
	if (*ieo == 0) {
	    xi += (float).5;
	}
/*<         w(i) = 1. - xi/fn >*/
	w[i] = (float)1. - xi / fn;
/*<   10  continue >*/
/* L10: */
    }
/*<       return >*/
    return 0;
/*<       end >*/
} /* triang_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  hammin */
/* generalized hamming window routine */
/* window is w(n) = alpha + beta * cos( twopi*(n-1) / (nf-1) ) */
/* ----------------------------------------------------------------------- */

/*<       subroutine hammin(nf, w, n, ieo, alpha, beta) >*/
/* Subroutine */ int hammin_(nf, w, n, ieo, alpha, beta)
integer *nf;
real *w;
integer *n, *ieo;
real *alpha, *beta;
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double atan(), cos();

    /* Local variables */
    static integer i;
    static real fi, fn, pi2;


/*    nf = filter length in samples */
/*     w = window array of size n */
/*     n = half length of filter=(nf+1)/2 */
/*   ieo = even odd indicator--ieo=0 if nf even */
/* alpha = constant of window */
/*  beta = constant of window--generally beta=1-alpha */

/*<       dimension w(1) >*/
/*<       pi2 = 8.0*atan(1.0) >*/
    /* Parameter adjustments */
    --w;

    /* Function Body */
    pi2 = atan((float)1.) * (float)8.;
/*<       fn = nf - 1 >*/
    fn = (real) (*nf - 1);
/*<       do 10 i=1,n >*/
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
/*<         fi = i - 1 >*/
	fi = (real) (i - 1);
/*<         if (ieo.eq.0) fi = fi + 0.5 >*/
	if (*ieo == 0) {
	    fi += (float).5;
	}
/*<         w(i) = alpha + beta*cos((pi2*fi)/fn) >*/
	w[i] = *alpha + *beta * cos(pi2 * fi / fn);
/*<   10  continue >*/
/* L10: */
    }
/*<       return >*/
    return 0;
/*<       end >*/
} /* hammin_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  kaiser */
/* kaiser window */
/* ----------------------------------------------------------------------- */

/*<       subroutine kaiser(nf, w, n, ieo, beta) >*/
/* Subroutine */ int kaiser_(nf, w, n, ieo, beta)
integer *nf;
real *w;
integer *n, *ieo;
real *beta;
{
    /* System generated locals */
    integer i__1;
    real r__1;

    /* Builtin functions */
    double sqrt();

    /* Local variables */
    static real xind;
    static integer i;
    static real xi, bes;
    extern doublereal ino_();


/*   nf = filter length in samples */
/*    w = window array of size n */
/*    n = filter half length=(nf+1)/2 */
/*  ieo = even odd indicator--ieo=0 if nf even */
/* beta = parameter of kaiser window */

/*<       dimension w(1) >*/
/*<       real ino >*/
/*<       bes = ino(beta) >*/
    /* Parameter adjustments */
    --w;

    /* Function Body */
    bes = ino_(beta);
/*<       xind = float(nf-1)*float(nf-1) >*/
    xind = (real) (*nf - 1) * (real) (*nf - 1);
/*<       do 10 i=1,n >*/
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
/*<         xi = i - 1 >*/
	xi = (real) (i - 1);
/*<         if (ieo.eq.0) xi = xi + 0.5 >*/
	if (*ieo == 0) {
	    xi += (float).5;
	}
/*<         xi = 4.*xi*xi >*/
	xi = xi * (float)4. * xi;
/*<         w(i) = ino(beta*sqrt(1.-xi/xind)) >*/
	r__1 = *beta * sqrt((float)1. - xi / xind);
	w[i] = ino_(&r__1);
/*<         w(i) = w(i)/bes >*/
	w[i] /= bes;
/*<   10  continue >*/
/* L10: */
    }
/*<       return >*/
    return 0;
/*<       end >*/
} /* kaiser_ */


/* ----------------------------------------------------------------------- */
/* function:  ino */
/* bessel function for kaiser window */
/* ----------------------------------------------------------------------- */

/*<       real function ino(x) >*/
doublereal ino_(x)
real *x;
{
    /* System generated locals */
    real ret_val;

    /* Local variables */
    static real e;
    static integer i;
    static real t, y, de, xi, sde;

/*<       y = x/2. >*/
    y = *x / (float)2.;
/*<       t = 1.e-08 >*/
    t = (float)1e-8;
/*<       e = 1. >*/
    e = (float)1.;
/*<       de = 1. >*/
    de = (float)1.;
/*<       do 10 i=1,25 >*/
    for (i = 1; i <= 25; ++i) {
/*<         xi = i >*/
	xi = (real) i;
/*<         de = de*y/xi >*/
	de = de * y / xi;
/*<         sde = de*de >*/
	sde = de * de;
/*<         e = e + sde >*/
	e += sde;
/*<         if (e*t-sde) 10, 10, 20 >*/
	if (e * t - sde <= (float)0.) {
	    goto L10;
	} else {
	    goto L20;
	}
/*<   10  continue >*/
L10:
	;
    }
/*<   20  ino = e >*/
L20:
    ret_val = e;
/*<       return >*/
    return ret_val;
/*<       end >*/
} /* ino_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  chebc */
/* subroutine to generate chebyshev window parameters when */
/* one of the three parameters nf,dp and df is unspecified */
/* ----------------------------------------------------------------------- */

/*<       subroutine chebc(nf, dp, df, n, x0, xn) >*/
/* Subroutine */ int chebc_(nf, dp, df, n, x0, xn)
integer *nf;
real *dp, *df;
integer *n;
real *x0, *xn;
{
    /* System generated locals */
    real r__1;

    /* Builtin functions */
    double atan(), cos(), cosh();

    /* Local variables */
    static real x, c0, c1, c2, pi;
    extern doublereal arccos_(), coshin_();


/* nf = filter length (in samples) */
/* dp = filter ripple (absolute scale) */
/* df = normalized transition width of filter */
/*  n = (nf+1)/2 = filter half length */
/* x0 = (3-c0)/(1+c0) with c0=cos(pi*df) = chebyshev window constant */
/* xn = nf-1 */

/*<       pi = 4.*atan(1.0) >*/
    pi = atan((float)1.) * (float)4.;
/*<       if (nf.ne.0) go to 10 >*/
    if (*nf != 0) {
	goto L10;
    }

/* dp,df specified, determine nf */

/*<       c1 = coshin((1.+dp)/dp) >*/
    r__1 = (*dp + (float)1.) / *dp;
    c1 = coshin_(&r__1);
/*<       c0 = cos(pi*df) >*/
    c0 = cos(pi * *df);
/*<       x = 1. + c1/coshin(1./c0) >*/
    r__1 = (float)1. / c0;
    x = c1 / coshin_(&r__1) + (float)1.;

/* increment by 1 to give nf which meets or exceeds specs on dp and df */

/*<       nf = x + 1.0 >*/
    *nf = x + (float)1.;
/*<       n = (nf+1)/2 >*/
    *n = (*nf + 1) / 2;
/*<       xn = nf - 1 >*/
    *xn = (real) (*nf - 1);
/*<       go to 30 >*/
    goto L30;
/*<   10  if (df.ne.0.0) go to 20 >*/
L10:
    if (*df != (float)0.) {
	goto L20;
    }

/* nf,dp specified, determine df */

/*<       xn = nf - 1 >*/
    *xn = (real) (*nf - 1);
/*<       c1 = coshin((1.+dp)/dp) >*/
    r__1 = (*dp + (float)1.) / *dp;
    c1 = coshin_(&r__1);
/*<       c2 = cosh(c1/xn) >*/
    c2 = cosh(c1 / *xn);
/*<       df = arccos(1./c2)/pi >*/
    r__1 = (float)1. / c2;
    *df = arccos_(&r__1) / pi;
/*<       go to 30 >*/
    goto L30;

/* nf,df specified, determine dp */

/*<   20  xn = nf - 1 >*/
L20:
    *xn = (real) (*nf - 1);
/*<       c0 = cos(pi*df) >*/
    c0 = cos(pi * *df);
/*<       c1 = xn*coshin(1./c0) >*/
    r__1 = (float)1. / c0;
    c1 = *xn * coshin_(&r__1);
/*<       dp = 1./(cosh(c1)-1.) >*/
    *dp = (float)1. / (cosh(c1) - (float)1.);
/*<   30  x0 = (3.-cos(2.*pi*df))/(1.+cos(2.*pi*df)) >*/
L30:
    *x0 = ((float)3. - cos(pi * (float)2. * *df)) / (cos(pi * (float)2. * *df)
	     + (float)1.);
/*<       return >*/
    return 0;
/*<       end >*/
} /* chebc_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  cheby */
/* dolph chebyshev window design */
/* ----------------------------------------------------------------------- */

/*<       subroutine cheby(nf, w, n, ieo, dp, df, x0, xn) >*/
/* Subroutine */ int cheby_(nf, w, n, ieo, dp, df, x0, xn)
integer *nf;
real *w;
integer *n, *ieo;
real *dp, *df, *x0, *xn;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    double atan(), cos(), cosh(), sin();

    /* Local variables */
    static real beta, f;
    static integer i, j;
    static real p, alpha, x, c1, c2, twopi, pi[1024], xi, pr[1024], xj;
    extern doublereal arccos_(), coshin_();
    static real fnf, pie, sum, twn;


/*  nf = filter length in samples */
/*   w = window array of size n */
/*   n = half length of filter = (nf+1)/2 */
/* ieo = even-odd indicator--ieo=0 for nf even */
/*  dp = window ripple on an absolute scale */
/*  df = normalized transition width of window */
/*  x0 = window parameter related to transition width */
/*  xn = nf-1 */

/*<       dimension w(1) >*/
/*<       dimension pr(1024), pi(1024) >*/
/*<       pie = 4.*atan(1.0) >*/
    /* Parameter adjustments */
    --w;

    /* Function Body */
    pie = atan((float)1.) * (float)4.;
/*<       xn = nf - 1 >*/
    *xn = (real) (*nf - 1);
/*<       fnf = nf >*/
    fnf = (real) (*nf);
/*<       alpha = (x0+1.)/2. >*/
    alpha = (*x0 + (float)1.) / (float)2.;
/*<       beta = (x0-1.)/2. >*/
    beta = (*x0 - (float)1.) / (float)2.;
/*<       twopi = 2.*pie >*/
    twopi = pie * (float)2.;
/*<       c2 = xn/2. >*/
    c2 = *xn / (float)2.;
/*<       do 40 i=1,nf >*/
    i__1 = *nf;
    for (i = 1; i <= i__1; ++i) {
/*<         xi = i - 1 >*/
	xi = (real) (i - 1);
/*<         f = xi/fnf >*/
	f = xi / fnf;
/*<         x = alpha*cos(twopi*f) + beta >*/
	x = alpha * cos(twopi * f) + beta;
/*<         if (abs(x)-1.) 10, 10, 20 >*/
	if (dabs(x) - (float)1. <= (float)0.) {
	    goto L10;
	} else {
	    goto L20;
	}
/*<   10    p = dp*cos(c2*arccos(x)) >*/
L10:
	p = *dp * cos(c2 * arccos_(&x));
/*<         go to 30 >*/
	goto L30;
/*<   20    p = dp*cosh(c2*coshin(x)) >*/
L20:
	p = *dp * cosh(c2 * coshin_(&x));
/*<   30    pi(i) = 0. >*/
L30:
	pi[i - 1] = (float)0.;
/*<         pr(i) = p >*/
	pr[i - 1] = p;

/* for even length filters use a one-half sample delay */
/* also the frequency response is antisymmetric in frequency */

/*<         if (ieo.eq.1) go to 40 >*/
	if (*ieo == 1) {
	    goto L40;
	}
/*<         pr(i) = p*cos(pie*f) >*/
	pr[i - 1] = p * cos(pie * f);
/*<         pi(i) = -p*sin(pie*f) >*/
	pi[i - 1] = -(doublereal)p * sin(pie * f);
/*<         if (i.gt.(nf/2+1)) pr(i) = -pr(i) >*/
	if (i > *nf / 2 + 1) {
	    pr[i - 1] = -(doublereal)pr[i - 1];
	}
/*<         if (i.gt.(nf/2+1)) pi(i) = -pi(i) >*/
	if (i > *nf / 2 + 1) {
	    pi[i - 1] = -(doublereal)pi[i - 1];
	}
/*<   40  continue >*/
L40:
	;
    }

/* use dft to give window */

/*<       twn = twopi/fnf >*/
    twn = twopi / fnf;
/*<       do 60 i=1,n >*/
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
/*<         xi = i - 1 >*/
	xi = (real) (i - 1);
/*<         sum = 0. >*/
	sum = (float)0.;
/*<         do 50 j=1,nf >*/
	i__2 = *nf;
	for (j = 1; j <= i__2; ++j) {
/*<           xj = j - 1 >*/
	    xj = (real) (j - 1);
/*<           sum = sum + pr(j)*cos(twn*xj*xi) + pi(j)*sin(twn*xj*xi) >*/
	    sum = sum + pr[j - 1] * cos(twn * xj * xi) + pi[j - 1] * sin(twn *
		     xj * xi);
/*<   50    continue >*/
/* L50: */
	}
/*<         w(i) = sum >*/
	w[i] = sum;
/*<   60  continue >*/
/* L60: */
    }
/*<       c1 = w(1) >*/
    c1 = w[1];
/*<       do 70 i=1,n >*/
    i__1 = *n;
    for (i = 1; i <= i__1; ++i) {
/*<         w(i) = w(i)/c1 >*/
	w[i] /= c1;
/*<   70  continue >*/
/* L70: */
    }
/*<       return >*/
    return 0;
/*<       end >*/
} /* cheby_ */


/* ----------------------------------------------------------------------- */
/* function:  coshin */
/* function for hyperbolic inverse cosine of x */
/* ----------------------------------------------------------------------- */

/*<       real function coshin(x) >*/
doublereal coshin_(x)
real *x;
{
    /* System generated locals */
    real ret_val;

    /* Builtin functions */
    double sqrt(), log();

/*<       coshin = alog(x+sqrt(x*x-1.)) >*/
    ret_val = log(*x + sqrt(*x * *x - (float)1.));
/*<       return >*/
    return ret_val;
/*<       end >*/
} /* coshin_ */


/* ----------------------------------------------------------------------- */
/* function:  arccos */
/* function for inverse cosine of x */
/* ----------------------------------------------------------------------- */

/*<       function arccos(x) >*/
doublereal arccos_(x)
real *x;
{
    /* System generated locals */
    real ret_val;

    /* Builtin functions */
    double sqrt(), atan();

    /* Local variables */
    static real a;

/*<       if (x) 30, 20, 10 >*/
    if (*x < (float)0.) {
	goto L30;
    } else if (*x == 0) {
	goto L20;
    } else {
	goto L10;
    }
/*<   10  a = sqrt(1.-x*x)/x >*/
L10:
    a = sqrt((float)1. - *x * *x) / *x;
/*<       arccos = atan(a) >*/
    ret_val = atan(a);
/*<       return >*/
    return ret_val;
/*<   20  arccos = 2.*atan(1.0) >*/
L20:
    ret_val = atan((float)1.) * (float)2.;
/*<       return >*/
    return ret_val;
/*<   30  a = sqrt(1.-x*x)/x >*/
L30:
    a = sqrt((float)1. - *x * *x) / *x;
/*<       arccos = atan(a) + 4.*atan(1.0) >*/
    ret_val = atan(a) + atan((float)1.) * (float)4.;
/*<       return >*/
    return ret_val;
/*<       end >*/
} /* arccos_ */


/* ----------------------------------------------------------------------- */
/* function:  cosh */
/* function for hyperbolic cosine of x */
/* ----------------------------------------------------------------------- */

/*<       real function cosh(x) >*/
doublereal cosh_(x)
real *x;
{
    /* System generated locals */
    real ret_val;

    /* Builtin functions */
    double exp();

/*<       cosh = (exp(x)+exp(-x))/2. >*/
    ret_val = (exp(*x) + exp(-(doublereal)(*x))) / (float)2.;
/*<       return >*/
    return ret_val;
/*<       end >*/
} /* cosh_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  flchar */
/* subroutine to determine filter characteristics */
/* ----------------------------------------------------------------------- */

/*<       subroutine flchar(nf, itype, jtype, fc, fl, fh, n, ieo, g, otcd2) >*/
/* Subroutine */ int flchar_(nf, itype, jtype, fc, fl, fh, n, ieo, g, otcd2)
integer *nf, *itype, *jtype;
real *fc, *fl, *fh;
integer *n, *ieo;
real *g;
integer *otcd2;
{
    /* Format strings */
    static char fmt_9999[] = "(\002 passband cutoff \002,f6.4,\002  ripple\
 \002,f8.3,\002 db\002)";
    static char fmt_9998[] = "(\002 stopband cutoff \002,f6.4,\002  ripple\
 \002,f8.3,\002 db\002)";
    static char fmt_9997[] = "(\002 passband cutoffs \002,f6.4,2x,f6.4,\002 \
 ripple\002,f9.3,\002 db\002)";
    static char fmt_9996[] = "(\002 stopband cutoffs \002,f6.4,2x,f6.4,\002 \
 ripple\002,f9.3,\002 db\002)";

    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    double atan(), cos();
    integer s_wsfe(), do_fio(), e_wsfe();

    /* Local variables */
    static real resp[2048], sumi, twni;
    static integer i, j;
    static real f1, f2, db, pi;
    static integer nr;
    static real xi, xj;
    extern /* Subroutine */ int ripple_();
    static real sum, xnr, twn;

    /* Fortran I/O blocks */
    static cilist io___149 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___150 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___151 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___152 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___153 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___154 = { 0, 0, 0, fmt_9997, 0 };
    static cilist io___155 = { 0, 0, 0, fmt_9998, 0 };
    static cilist io___156 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___157 = { 0, 0, 0, fmt_9996, 0 };
    static cilist io___158 = { 0, 0, 0, fmt_9999, 0 };



/*    nf = filter length in samples */
/* itype = window type */
/* jtype = filter type */
/*    fc = ideal cutoff of lp or hp filter */
/*    fl = lower cutoff of bp or bs filter */
/*    fh = upper cutoff of bp or bs filter */
/*     n = filter half length = (nf+1) / 2 */
/*   ieo = even odd indicator */
/*     g = filter array of size n */
/* otcd2 = output code for line printer used in write statements */

/*<       dimension g(1) >*/
/*<       dimension resp(2048) >*/
/*<       integer otcd2 >*/

/* not for for triangular window */

/*<       if (itype.eq.2) return >*/
    /* Parameter adjustments */
    --g;

    /* Function Body */
    if (*itype == 2) {
	return 0;
    }

/* dft to get freq resp */

/*<       pi = 4.*atan(1.0) >*/
    pi = atan((float)1.) * (float)4.;

/* up to 4096 pt dft */

/*<       nr = 8*nf >*/
    nr = *nf << 3;
/*<       if (nr.gt.2048) nr = 2048 >*/
    if (nr > 2048) {
	nr = 2048;
    }
/*<       xnr = nr >*/
    xnr = (real) nr;
/*<       twn = pi/xnr >*/
    twn = pi / xnr;
/*<       sumi = -g(1)/2. >*/
    sumi = -(doublereal)g[1] / (float)2.;
/*<       if (ieo.eq.0) sumi = 0. >*/
    if (*ieo == 0) {
	sumi = (float)0.;
    }
/*<       do 20 i=1,nr >*/
    i__1 = nr;
    for (i = 1; i <= i__1; ++i) {
/*<         xi = i - 1 >*/
	xi = (real) (i - 1);
/*<         twni = twn*xi >*/
	twni = twn * xi;
/*<         sum = sumi >*/
	sum = sumi;
/*<         do 10 j=1,n >*/
	i__2 = *n;
	for (j = 1; j <= i__2; ++j) {
/*<           xj = j - 1 >*/
	    xj = (real) (j - 1);
/*<           if (ieo.eq.0) xj = xj + .5 >*/
	    if (*ieo == 0) {
		xj += (float).5;
	    }
/*<           sum = sum + g(j)*cos(xj*twni) >*/
	    sum += g[j] * cos(xj * twni);
/*<   10    continue >*/
/* L10: */
	}
/*<         resp(i) = 2.*sum >*/
	resp[i - 1] = sum * (float)2.;
/*<   20  continue >*/
/* L20: */
    }

/* dispatch on filter type */

/*<       go to (30, 40, 50, 60), jtype >*/
    switch ((int)*jtype) {
	case 1:  goto L30;
	case 2:  goto L40;
	case 3:  goto L50;
	case 4:  goto L60;
    }

/* lowpass */

/*<   30  call ripple(nr, 1., 0., fc, resp, f1, f2, db) >*/
L30:
    ripple_(&nr, &c_b233, &c_b234, fc, resp, &f1, &f2, &db);
/*<       write (otcd2,9999) f2, db >*/
    io___149.ciunit = *otcd2;
    s_wsfe(&io___149);
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*< 9999  format (17h passband cutoff , f6.4, 9h  ripple , f8.3, 3h db) >*/
/*<       call ripple(nr, 0., fc, .5, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b234, fc, &c_b240, resp, &f1, &f2, &db);
/*<       write (otcd2,9998) f1, db >*/
    io___150.ciunit = *otcd2;
    s_wsfe(&io___150);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*< 9998  format (17h stopband cutoff , f6.4, 9h  ripple , f8.3, 3h db) >*/
/*<       return >*/
    return 0;

/* highpass */

/*<   40  call ripple(nr, 0., 0., fc, resp, f1, f2, db) >*/
L40:
    ripple_(&nr, &c_b234, &c_b234, fc, resp, &f1, &f2, &db);
/*<       write (otcd2,9998) f2, db >*/
    io___151.ciunit = *otcd2;
    s_wsfe(&io___151);
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       call ripple(nr, 1., fc, .5, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b233, fc, &c_b240, resp, &f1, &f2, &db);
/*<       write (otcd2,9999) f1, db >*/
    io___152.ciunit = *otcd2;
    s_wsfe(&io___152);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       return >*/
    return 0;

/* bandpass */

/*<   50  call ripple(nr, 0., 0., fl, resp, f1, f2, db) >*/
L50:
    ripple_(&nr, &c_b234, &c_b234, fl, resp, &f1, &f2, &db);
/*<       write (otcd2,9998) f2, db >*/
    io___153.ciunit = *otcd2;
    s_wsfe(&io___153);
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       call ripple(nr, 1., fl, fh, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b233, fl, fh, resp, &f1, &f2, &db);
/*<       write (otcd2,9997) f1, f2, db >*/
    io___154.ciunit = *otcd2;
    s_wsfe(&io___154);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*< 99 >*/
/*<       call ripple(nr, 0., fh, .5, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b234, fh, &c_b240, resp, &f1, &f2, &db);
/*<       write (otcd2,9998) f1, db >*/
    io___155.ciunit = *otcd2;
    s_wsfe(&io___155);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       return >*/
    return 0;

/* stopband */

/*<   60  call ripple(nr, 1., 0., fl, resp, f1, f2, db) >*/
L60:
    ripple_(&nr, &c_b233, &c_b234, fl, resp, &f1, &f2, &db);
/*<       write (otcd2,9999) f2, db >*/
    io___156.ciunit = *otcd2;
    s_wsfe(&io___156);
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       call ripple(nr, 0., fl, fh, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b234, fl, fh, resp, &f1, &f2, &db);
/*<       write (otcd2,9996) f1, f2, db >*/
    io___157.ciunit = *otcd2;
    s_wsfe(&io___157);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&f2, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*< 99 >*/
/*<       call ripple(nr, 1., fh, .5, resp, f1, f2, db) >*/
    ripple_(&nr, &c_b233, fh, &c_b240, resp, &f1, &f2, &db);
/*<       write (otcd2,9999) f1, db >*/
    io___158.ciunit = *otcd2;
    s_wsfe(&io___158);
    do_fio(&c__1, (char *)&f1, (ftnlen)sizeof(real));
    do_fio(&c__1, (char *)&db, (ftnlen)sizeof(real));
    e_wsfe();
/*<       return >*/
    return 0;
/*<       end >*/
} /* flchar_ */


/* ----------------------------------------------------------------------- */
/* subroutine:  ripple */
/* finds largest ripple in band and locates band edges based on the */
/* point where the transition region crosses the measured ripple bound */
/* ----------------------------------------------------------------------- */

/*<       subroutine ripple(nr, rideal, flow, fhi, resp, f1, f2, db) >*/
/* Subroutine */ int ripple_(nr, rideal, flow, fhi, resp, f1, f2, db)
integer *nr;
real *rideal, *flow, *fhi, *resp, *f1, *f2, *db;
{
    /* System generated locals */
    integer i__1;
    real r__1, r__2;

    /* Builtin functions */
    double r_lg10();

    /* Local variables */
    static integer ifhi;
    static real rmin, ripl, rmax;
    static integer i, j, iflow;
    static real x0, x1, y1, y0, xi, xnr;


/*     nr = size of resp */
/* rideal = ideal frequency response */
/*   flow = low edge of ideal band */
/*    fhi = high edge of ideal band */
/*   resp = frequency response of size nr */
/*     f1 = computed lower band edge */
/*     f2 = computed upper band edge */
/*     db = deviation from ideal response in db */

/*<       dimension resp(1) >*/
/*<       xnr = nr >*/
    /* Parameter adjustments */
    --resp;

    /* Function Body */
    xnr = (real) (*nr);

/* band limits */

/*<       iflow = 2.*xnr*flow + 1.5 >*/
    iflow = xnr * (float)2. * *flow + (float)1.5;
/*<       ifhi = 2.*xnr*fhi + 1.5 >*/
    ifhi = xnr * (float)2. * *fhi + (float)1.5;
/*<       if (iflow.eq.0) iflow = 1 >*/
    if (iflow == 0) {
	iflow = 1;
    }
/*<       if (ifhi.ge.nr) ifhi = nr - 1 >*/
    if (ifhi >= *nr) {
	ifhi = *nr - 1;
    }

/* find max and min peaks in band */

/*<       rmin = rideal >*/
    rmin = *rideal;
/*<       rmax = rideal >*/
    rmax = *rideal;
/*<       do 20 i=iflow,ifhi >*/
    i__1 = ifhi;
    for (i = iflow; i <= i__1; ++i) {
/*<    >*/
	if (resp[i] <= rmax || resp[i] < resp[i - 1] || resp[i] < resp[i + 1])
		 {
	    goto L10;
	}
/*<         rmax = resp(i) >*/
	rmax = resp[i];
/*<    >*/
L10:
	if (resp[i] >= rmin || resp[i] > resp[i - 1] || resp[i] > resp[i + 1])
		 {
	    goto L20;
	}
/*<         rmin = resp(i) >*/
	rmin = resp[i];
/*<   20  continue >*/
L20:
	;
    }

/* peak deviation from ideal */

/*<       ripl = amax1(rmax-rideal,rideal-rmin) >*/
/* Computing MAX */
    r__1 = rmax - *rideal, r__2 = *rideal - rmin;
    ripl = dmax(r__1,r__2);

/* search for lower band edge */

/*<       f1 = flow >*/
    *f1 = *flow;
/*<       if (flow.eq.0.0) go to 50 >*/
    if (*flow == (float)0.) {
	goto L50;
    }
/*<       do 30 i=iflow,ifhi >*/
    i__1 = ifhi;
    for (i = iflow; i <= i__1; ++i) {
/*<         if (abs(resp(i)-rideal).le.ripl) go to 40 >*/
	if ((r__1 = resp[i] - *rideal, dabs(r__1)) <= ripl) {
	    goto L40;
	}
/*<   30  continue >*/
/* L30: */
    }
/*<   40  xi = i - 1 >*/
L40:
    xi = (real) (i - 1);

/* linear interpolation of band edge frequency to improve accuracy */

/*<       x1 = .5*xi/xnr >*/
    x1 = xi * (float).5 / xnr;
/*<       x0 = .5*(xi-1.)/xnr >*/
    x0 = (xi - (float)1.) * (float).5 / xnr;
/*<       y1 = abs(resp(i)-rideal) >*/
    y1 = (r__1 = resp[i] - *rideal, dabs(r__1));
/*<       y0 = abs(resp(i-1)-rideal) >*/
    y0 = (r__1 = resp[i - 1] - *rideal, dabs(r__1));
/*<       f1 = (x1-x0)/(y1-y0)*(ripl-y0) + x0 >*/
    *f1 = (x1 - x0) / (y1 - y0) * (ripl - y0) + x0;

/* search for upper band edge */

/*<   50  f2 = fhi >*/
L50:
    *f2 = *fhi;
/*<       if (fhi.eq.0.5) go to 80 >*/
    if (*fhi == (float).5) {
	goto L80;
    }
/*<       do 60 i=iflow,ifhi >*/
    i__1 = ifhi;
    for (i = iflow; i <= i__1; ++i) {
/*<         j = ifhi + iflow - i >*/
	j = ifhi + iflow - i;
/*<         if (abs(resp(j)-rideal).le.ripl) go to 70 >*/
	if ((r__1 = resp[j] - *rideal, dabs(r__1)) <= ripl) {
	    goto L70;
	}
/*<   60  continue >*/
/* L60: */
    }
/*<   70  xi = j - 1 >*/
L70:
    xi = (real) (j - 1);

/* linear interpolation of band edge frequency to improve accuracy */

/*<       x1 = .5*xi/xnr >*/
    x1 = xi * (float).5 / xnr;
/*<       x0 = .5*(xi+1.)/xnr >*/
    x0 = (xi + (float)1.) * (float).5 / xnr;
/*<       y1 = abs(resp(j)-rideal) >*/
    y1 = (r__1 = resp[j] - *rideal, dabs(r__1));
/*<       y0 = abs(resp(j+1)-rideal) >*/
    y0 = (r__1 = resp[j + 1] - *rideal, dabs(r__1));
/*<       f2 = (x1-x0)/(y1-y0)*(ripl-y0) + x0 >*/
    *f2 = (x1 - x0) / (y1 - y0) * (ripl - y0) + x0;

/* deviation from ideal in db */

/*<   80  db = 20.*alog10(ripl+rideal) >*/
L80:
    r__1 = ripl + *rideal;
    *db = r_lg10(&r__1) * (float)20.;
/*<       return >*/
    return 0;
/*<       end >*/
} /* ripple_ */


/* ----------------------------------------------------------------------- */

/* ----------------------------------------------------------------------- */
/* subroutine: outimp */
/*    Prints out on unit ioutd the full */
/*    impulse response as format 13x,f15.8.  This makes the impulse */
/*    response accessible to other programs without the need for parsing */
/*    the output of the program. */
/* ----------------------------------------------------------------------- */

/*<       subroutine outimp(g,n,nf,ieo,ioutd) >*/
/* Subroutine */ int outimp_(g, n, nf, ieo, ioutd)
real *g;
integer *n, *nf, *ieo, *ioutd;
{
    /* Format strings */
    static char fmt_50[] = "(e15.8)";

    /* System generated locals */
    integer i__1;
    cllist cl__1;

    /* Builtin functions */
    integer s_wsfe(), do_fio(), e_wsfe(), f_clos();

    /* Local variables */
    static integer i, j, l;

    /* Fortran I/O blocks */
    static cilist io___175 = { 0, 0, 0, fmt_50, 0 };
    static cilist io___176 = { 0, 0, 0, fmt_50, 0 };
    static cilist io___177 = { 0, 0, 0, fmt_50, 0 };


/*<       dimension g(512) >*/

/* 	Removed filter order output for Gabriel compatibility */

/*     write(ioutd,5) nf */
/*  5  format(i15) */
/*<       l = n >*/
    /* Parameter adjustments */
    --g;

    /* Function Body */
    l = *n;
/*<       if(ieo.eq.0) go to 10 >*/
    if (*ieo == 0) {
	goto L10;
    }
/*<       l = n-1 >*/
    l = *n - 1;
/*<   10  do 20 i=1,l >*/
L10:
    i__1 = l;
    for (i = 1; i <= i__1; ++i) {
/*<         j = n + 1 - i >*/
	j = *n + 1 - i;
/*<       write(ioutd,50) g(j) >*/
	io___175.ciunit = *ioutd;
	s_wsfe(&io___175);
	do_fio(&c__1, (char *)&g[j], (ftnlen)sizeof(real));
	e_wsfe();
/*<   20  continue >*/
/* L20: */
    }
/*< 	if(ieo.eq.0) go to 30 >*/
    if (*ieo == 0) {
	goto L30;
    }
/*<         write(ioutd,50) g(1) >*/
    io___176.ciunit = *ioutd;
    s_wsfe(&io___176);
    do_fio(&c__1, (char *)&g[1], (ftnlen)sizeof(real));
    e_wsfe();
/*<   30  do 40 i=l,1,-1 >*/
L30:
    for (i = l; i >= 1; --i) {
/*<         j = n + 1 - i >*/
	j = *n + 1 - i;
/*<       write(ioutd,50) g(j) >*/
	io___177.ciunit = *ioutd;
	s_wsfe(&io___177);
	do_fio(&c__1, (char *)&g[j], (ftnlen)sizeof(real));
	e_wsfe();
/*<   40  continue >*/
/* L40: */
    }
/*<   50  format(e15.8) >*/
/*<       close(unit=ioutd) >*/
    cl__1.cerr = 0;
    cl__1.cunit = *ioutd;
    cl__1.csta = 0;
    f_clos(&cl__1);
/*<   60  return >*/
/* L60: */
    return 0;
/*<       end >*/
} /* outimp_ */

