/*  -- translated by f2c (version 20090411).
   You must link the resulting object file with libf2c:
	on Microsoft Windows system, link with libf2c.lib;
	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
	or, if you install libf2c.a in a standard place, with -lf2c -lm
	-- in that order, at the end of the command line, as in
		cc *.o -lf2c -lm
	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

		http://www.netlib.org/f2c/libf2c.zip
*/

#include "libtinyf2c.h"

/* Common Block Declarations */

struct {
    real v;
} value_;

#define value_1 value_

/* Table of constant values */

static integer c__36 = 36;

/* ----------------------------------------------------------------------- */
/* Main program */ int MAIN__(void)
{
    static integer ier;
    extern /* Subroutine */ int tfftpk_(integer *);

    tfftpk_(&ier);
    return 0;
} /* MAIN__ */

/* ----------------------------------------------------------------------- */
/* Subroutine */ int tfftpk_(integer *ierror)
{
    /* Initialized data */

    static real tol = .01f;

    /* Format strings */
    static char fmt_1001[] = "(\002 IN FFTPACK, ENTRY RFFTF RESULTS IN ERRO"
	    "R\002)";
    static char fmt_1002[] = "(\002 IN FFTPACK, ENTRY RFFTB RESULTS IN ERRO"
	    "R\002)";
    static char fmt_1003[] = "(\002 IN FFTPACK, ENTRY EZFFTF RESULTS IN ER"
	    "ROR\002)";
    static char fmt_1004[] = "(\002 IN FFTPACK, ENTRY EZFFTB RESULTS IN ER"
	    "ROR\002)";
    static char fmt_998[] = "(\002 FFTPACK TEST SUCCESSFUL\002)";
    static char fmt_999[] = "(\002 FFTPACK TEST UNSUCCESSFUL\002)";

    /* System generated locals */
    real r__1, r__2, r__3;

    /* Builtin functions */
    integer s_wsfe(cilist *), e_wsfe(void);

    /* Local variables */
    static real a[18], b[18];
    static integer i__, ier1, ier2, ier3, ier4;
    extern /* Subroutine */ int rfftb_(integer *, real *, real *);
    static real rldat[36];
    extern /* Subroutine */ int rfftf_(integer *, real *, real *), rffti_(
	    integer *, real *);
    static real azero, wrfft[87], error;
    extern real trunc_(real *);
    extern /* Subroutine */ int ezfftb_(integer *, real *, real *, real *, 
	    real *, real *), ezfftf_(integer *, real *, real *, real *, real *
	    , real *), ezffti_(integer *, real *);
    static real wezfft[123];

    /* Fortran I/O blocks */
    static cilist io___8 = { 0, 6, 0, fmt_1001, 0 };
    static cilist io___10 = { 0, 6, 0, fmt_1002, 0 };
    static cilist io___16 = { 0, 6, 0, fmt_1003, 0 };
    static cilist io___18 = { 0, 6, 0, fmt_1004, 0 };
    static cilist io___19 = { 0, 6, 0, fmt_998, 0 };
    static cilist io___20 = { 0, 6, 0, fmt_999, 0 };




/* PURPOSE                TO DEMONSTRATE THE USE OF FFTPACK, AND TO */
/*                        TEST THE PERFORMANCE OF FFTPACK ON ONE */
/*                        WELL-CONDITIONED PROBLEM. */

/* USAGE                  CALL TFFTPK (IERROR) */

/* ARGUMENTS */

/* ON OUTPUT              IERROR */
/*                          INTEGER VARIABLE SET TO ZERO IF FFTPACK */
/*                          CORRECTLY SOLVED THE TEST PROBLEM, AND */
/*                          ONE IF FFTPACK FAILED. */

/* I/O                    IF THE TEST SUCCEEDS(FAILS), THE MESSAGE */

/*                           FFTPACK TEST SUCCESSFUL (UNSUCCESSFUL) */

/*                        IS WRITTEN ON UNIT 6. IN THE CASE OF FAILURE, */
/*                        ADDITIONAL MESSAGES ARE WRITTEN IDENTIFYING THE */
/*                        FAILURE MORE EXPLICITLY. */

/* PRECISION              SINGLE */

/* REQUIRED LIBRARY       NONE */
/* FILES */

/* LANGUAGE               FORTRAN */

/* HISTORY                WRITTEN BY MEMBERS OF THE SCIENTIFIC */
/*                        COMPUTING DIVISION OF NCAR, */
/*                        BOULDER COLORADO. */

/* ALGORITHM              FOR EACH OF THE ROUTINES, RFFTF, RFFTB, EZFFTF, */
/*                        AND EZFFTB IN THE FFTPACK PACKAGE A SIMILAR */
/*                        TEST IS RUN. AN APPROPIATE VECTOR, FOR WHICH */
/*                        THE EXACT TRANSFORM IS KNOWN IS USED AS THE */
/*                        INPUT VECTOR. THE ROUTINE IS CALLED TO PERFORM */
/*                        THE TRANSFORM. THE CALCULATED TRANSFORM VECTOR */
/*                        IS COMPARED WITH THE EXACT TRANSFORM TO SEE */
/*                        WHETHER THE PERFORMANCE CRITERION IS MET WITHIN */
/*                        THE SPECIFED TOLERANCE. */

/*                        FOR RFFTF AND EZFFTF, A REAL VECTOR, THE ELEMEN */
/*                        WHICH ARE EQUAL TO ONE, IS USED AS INPUT. THE */
/*                        TRANSFORMED VECTOR HAS THE FIRST ELEMENT EQUAL */
/*                        TO THE LENGTH OF THE INPUT VECTOR. ALL OTHER */
/*                        ELEMENTS ARE EQUAL TO ZERO. */

/*                        FOR RFFTB AND EZFFTB, THE INPUT VECTOR HAS FIRS */
/*                        ELEMENT EQUAL TO ONE AND ALL THE OTHER ELEMENTS */
/*                        EQUAL TO ZERO. THE TRANSFORMED VECTOR HAS ALL */
/*                        COMPONENTS EQUAL TO ONE. */

/* PORTABILITY            ANSI STANDARD */



/* STATEMENT FUNCTION SMALL(EX) IS FOR TESTING WHETHER X IS CLOSE TO ZERO */
/* INDEPENDENTLY OF MACHINE WORD SIZE. SMALL(EX) IS EXACTLY ZERO ONLY IF */
/* ABS(X) .LT. EPS/TOL, WHERE EPS IS THE MACHINE PRECESION AND TOL IS A */
/* TOLERANCE FACTOR USED TO CONTROL THE STRICTNESS OF THE TEST. */


/* CALL INITIALIZATION ROUTINE FOR RFFTF AND RFFTB. */

    rffti_(&c__36, wrfft);

/* TEST OF RFFTF. */

    for (i__ = 1; i__ <= 36; ++i__) {
/* L10: */
	rldat[i__ - 1] = 1.f;
    }

    rfftf_(&c__36, rldat, wrfft);

/* TEST RESULTS OF RFFTF */

    error = (r__1 = 36.f - rldat[0], abs(r__1));
    for (i__ = 2; i__ <= 36; ++i__) {
/* L15: */
/* Computing MAX */
	r__2 = error, r__3 = (r__1 = rldat[i__ - 1], abs(r__1));
	error = max(r__2,r__3);
    }
    r__1 = 1.f + tol * abs(error);
    if (trunc_(&r__1) - 1.f == 0.f) {
	ier1 = 0;
    } else {
	ier1 = 1;
	s_wsfe(&io___8);
	e_wsfe();
    }

/* TEST OF RFFTB. */

    rldat[0] = 1.f;
    for (i__ = 2; i__ <= 36; ++i__) {
/* L20: */
	rldat[i__ - 1] = 0.f;
    }

    rfftb_(&c__36, rldat, wrfft);

/* TEST RESULTS OF RFFTB */

    error = 0.f;
    for (i__ = 1; i__ <= 36; ++i__) {
/* L25: */
/* Computing MAX */
	r__2 = error, r__3 = (r__1 = 1.f - rldat[i__ - 1], abs(r__1));
	error = max(r__2,r__3);
    }
    r__1 = 1.f + tol * abs(error);
    if (trunc_(&r__1) - 1.f == 0.f) {
	ier2 = 0;
    } else {
	ier2 = 1;
	s_wsfe(&io___10);
	e_wsfe();
    }

/* CALL INITIALIZATION ROUTINE EZFFTI FOR EZFFTF AND EZFFTB */

    ezffti_(&c__36, wezfft);

/* TEST OF EZFFTF. */

    for (i__ = 1; i__ <= 36; ++i__) {
/* L30: */
	rldat[i__ - 1] = 1.f;
    }

    ezfftf_(&c__36, rldat, &azero, a, b, wezfft);

/* TEST RESULTS OF EZFFTF */

    error = (r__1 = azero - 1.f, abs(r__1));
    for (i__ = 1; i__ <= 18; ++i__) {
/* L35: */
/* Computing MAX */
	r__3 = (r__1 = a[i__ - 1], abs(r__1)) + (r__2 = b[i__ - 1], abs(r__2))
		;
	error = max(r__3,error);
    }
    r__1 = 1.f + tol * abs(error);
    if (trunc_(&r__1) - 1.f == 0.f) {
	ier3 = 0;
    } else {
	ier3 = 1;
	s_wsfe(&io___16);
	e_wsfe();
    }

/* TEST OF EZFFTB. */

    azero = 1.f;
    for (i__ = 1; i__ <= 18; ++i__) {
	a[i__ - 1] = 0.f;
/* L40: */
	b[i__ - 1] = 0.f;
    }

    ezfftb_(&c__36, rldat, &azero, a, b, wezfft);

/* TEST RESULTS OF EZFFTB */

    error = 0.f;
    for (i__ = 1; i__ <= 36; ++i__) {
/* L45: */
/* Computing MAX */
	r__2 = (r__1 = 1.f - rldat[i__ - 1], abs(r__1));
	error = max(r__2,error);
    }
    r__1 = 1.f + tol * abs(error);
    if (trunc_(&r__1) - 1.f == 0.f) {
	ier4 = 0;
    } else {
	ier4 = 1;
	s_wsfe(&io___18);
	e_wsfe();
    }


    *ierror = ier1 + ier2 + ier3 + ier4;
    if (*ierror == 0) {
	s_wsfe(&io___19);
	e_wsfe();
    } else {
	*ierror = 1;
	s_wsfe(&io___20);
	e_wsfe();
    }
    return 0;
} /* tfftpk_ */

real trunc_(real *x)
{
    /* System generated locals */
    real ret_val;

    /* Local variables */
    extern /* Subroutine */ int stores_(real *);


/* TRUNC IS A PORTABLE FORTRAN FUNCTION WHICH TRUNCATES A VALUE TO THE */
/* MACHINE SINGLE PRECISION WORD SIZE, REGARDLESS OF WHETHER LONGER */
/* PRECISION INTERNAL REGISTERS ARE USED FOR FLOATING POINT ARITHMETIC IN */
/* COMPUTING THE VALUE INPUT TO TRUNC.  THE METHOD USED IS TO FORCE A */
/* STORE INTO MEMORY BY USING A COMMON BLOCK IN ANOTHER SUBROUTINE. */

    stores_(x);
    ret_val = value_1.v;
    return ret_val;
} /* trunc_ */

/* Subroutine */ int stores_(real *x)
{

/* FORCES THE ARGUMENT VALUE X TO BE STORED IN MEMORY LOCATION V. */

    value_1.v = *x;
    return 0;
} /* stores_ */

/* Main program alias */ int fftl02_ () { MAIN__ (); return 0; }
