/*  -- 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"

/* Table of constant values */

static logical c_true = TRUE_;
static logical c_false = FALSE_;
static integer c__200 = 200;
static integer c__800 = 800;
static integer c__400 = 400;
static integer c__3 = 3;
static integer c__1 = 1;
static real c_b30 = 1.f;
static real c_b31 = .5f;
static integer c__65341 = 65341;
static integer c__73 = 73;
static integer c__5 = 5;
static integer c__361 = 361;
static integer c__181 = 181;
static real c_b50 = 0.f;
static real c_b51 = 360.f;
static real c_b52 = -90.f;
static real c_b53 = 90.f;
static real c_b54 = 180.f;
static integer c__100 = 100;
static integer c__72 = 72;
static integer c__512 = 512;
static integer c__2 = 2;
static real c_b87 = -.5f;

/* ----------------------------------------------------------------------- */
/*     TOMS OZONE DISTRIBUTION (MONTHLY MEAN CLIMATOLOGY) */
/* ----------------------------------------------------------------------- */
/*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. */
/* ----------------------------------------------------------------------- */
/* Main program */ int MAIN__(void)
{
    /* System generated locals */
    integer i__1;
    olist o__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer f_open(olist *), s_rsle(cilist *), do_lio(integer *, integer *, 
	    char *, ftnlen), e_rsle(void), s_rsfe(cilist *), do_fio(integer *,
	     char *, ftnlen), e_rsfe(void);

    /* Local variables */
    static integer i__, j, m, jj, mon, iws;
    static char cdsn[80];
    extern /* Subroutine */ int rset0_(real *, integer *, integer *, real *), 
	    grcls_(void);
    static integer ipatn[100];
    extern /* Subroutine */ int grfrm_(void), gropn_(integer *), slrat_(real *
	    , real *);
    static real tlevn[101], rmiss;
    extern /* Subroutine */ int vrset_(real *, real *, integer *, integer *, 
	    integer *);
    static real bgdata[2701]	/* was [73][37] */, bkdata[925]	/* was [25][
	    37] */, gxdata[65341]	/* was [361][181] */;
    extern /* Subroutine */ int bktobg_(real *, real *), glrget_(char *, real 
	    *, ftnlen), gllset_(char *, logical *, ftnlen);
    extern integer isgtrc_(char *, ftnlen);
    extern /* Subroutine */ int umpgrd_(void), umpmap_(char *, ftnlen), 
	    uetonf_(real *, integer *, integer *, integer *), sglset_(char *, 
	    logical *, ftnlen), umplim_(void), grswnd_(real *, real *, real *,
	     real *), grsmpl_(real *, real *, real *), umpfit_(void), grstrf_(
	    void), ueitlv_(void), umlset_(char *, logical *, ftnlen), uestln_(
	    real *, integer *, integer *), grstrn_(integer *), sgpwsn_(void), 
	    vrintr_(real *, integer *, integer *), slpwwr_(integer *), 
	    swistx_(char *, integer *, ftnlen), swlstx_(char *, logical *, 
	    ftnlen);

    /* Fortran I/O blocks */
    static cilist io___5 = { 0, 5, 0, 0, 0 };
    static cilist io___9 = { 0, 11, 0, "(TR9,I2)", 0 };
    static cilist io___12 = { 0, 11, 0, "(F8.3,8F8.3,2(/TR8,8F8.3))", 0 };


    for (i__ = 1; i__ <= 100; ++i__) {
	ipatn[i__ - 1] = max(11,i__) * 1000 + 999;
/* L10: */
    }
    for (i__ = 1; i__ <= 101; ++i__) {
	tlevn[i__ - 1] = i__ * 3.f + 200;
/* L20: */
    }
    s_copy(cdsn, "tomsclm.dat", (ftnlen)80, (ftnlen)11);
    o__1.oerr = 0;
    o__1.ounit = 11;
    o__1.ofnmlen = 80;
    o__1.ofnm = cdsn;
    o__1.orl = 0;
    o__1.osta = 0;
    o__1.oacc = 0;
    o__1.ofm = "FORMATTED";
    o__1.oblnk = 0;
    f_open(&o__1);
    swlstx_("LWAIT", &c_true, (ftnlen)5);
    swlstx_("LWAIT0", &c_false, (ftnlen)6);
    swlstx_("LALT", &c_false, (ftnlen)4);
    swistx_("IPOSX", &c__200, (ftnlen)5);
    swistx_("IPOSY", &c__200, (ftnlen)5);
    swistx_("IWIDTH", &c__800, (ftnlen)6);
    swistx_("IHEIGHT", &c__400, (ftnlen)7);
    sgpwsn_();
    s_rsle(&io___5);
    do_lio(&c__3, &c__1, (char *)&iws, (ftnlen)sizeof(integer));
    e_rsle();
    gropn_(&iws);
    gllset_("LMISS", &c_true, (ftnlen)5);
    glrget_("RMISS", &rmiss, (ftnlen)5);
    sglset_("LFULL", &c_true, (ftnlen)5);
    sglset_("LSOFTF", &c_false, (ftnlen)6);
    umlset_("LGLOBE", &c_true, (ftnlen)6);
    slrat_(&c_b30, &c_b31);
    for (m = 1; m <= 12; ++m) {
	s_rsfe(&io___9);
	do_fio(&c__1, (char *)&mon, (ftnlen)sizeof(integer));
	e_rsfe();
	for (j = 1; j <= 37; ++j) {
	    s_rsfe(&io___12);
	    for (i__ = 1; i__ <= 25; ++i__) {
		do_fio(&c__1, (char *)&bkdata[i__ + j * 25 - 26], (ftnlen)
			sizeof(real));
	    }
	    e_rsfe();
/* L30: */
	}
	bktobg_(bkdata, bgdata);
	rset0_(gxdata, &c__65341, &c__1, &rmiss);
	for (j = 1; j <= 37; ++j) {
	    jj = (j - 1) * 5 + 1;
	    vrset_(&bgdata[j * 73 - 73], &gxdata[jj * 361 - 361], &c__73, &
		    c__1, &c__5);
	    vrintr_(&gxdata[jj * 361 - 361], &c__361, &c__1);
/* L40: */
	}
	for (i__ = 1; i__ <= 361; ++i__) {
	    vrintr_(&gxdata[i__ - 1], &c__181, &c__361);
/* L50: */
	}
	grfrm_();
	grswnd_(&c_b50, &c_b51, &c_b52, &c_b53);
	grsmpl_(&c_b54, &c_b53, &c_b50);
	i__1 = isgtrc_("HMR", (ftnlen)3);
	grstrn_(&i__1);
	umpfit_();
	grstrf_();
	slpwwr_(&c__1);
	ueitlv_();
	uestln_(tlevn, ipatn, &c__100);
	uetonf_(gxdata, &c__361, &c__361, &c__181);
	umpgrd_();
	umplim_();
	umpmap_("coast_world", (ftnlen)11);
/* L100: */
    }
    grcls_();
    return 0;
} /* MAIN__ */

/* ----------------------------------------------------------------------- */
/*     BKTOBG */
/* ----------------------------------------------------------------------- */
/* Subroutine */ int bktobg_(real *bkdata, real *bgdata)
{
    static integer j, kx, ixbk, jxbk;
    extern /* Subroutine */ int rset0_(real *, integer *, integer *, real *);
    static integer idxbk;
    static real rmiss;
    extern /* Subroutine */ int fftezb_(real *, integer *, real *, integer *),
	     glrget_(char *, real *, ftnlen);

    /* Parameter adjustments */
    bgdata -= 74;
    --bkdata;

    /* Function Body */
    glrget_("RMISS", &rmiss, (ftnlen)5);
/*     CALL DTPGET('MAXWN',KX) */
    kx = 12;
    ixbk = (kx << 1) + 1;
    jxbk = 37;
    for (j = 1; j <= 37; ++j) {
	idxbk = ixbk * (j - 1) + 1;
	if (bkdata[idxbk] == rmiss) {
	    rset0_(&bgdata[j * 73 + 1], &c__73, &c__1, &rmiss);
	} else {
	    fftezb_(&bkdata[idxbk], &kx, &bgdata[j * 73 + 1], &c__72);
	    bgdata[j * 73 + 73] = bgdata[j * 73 + 1];
	}
/* L10: */
    }
    return 0;
} /* bktobg_ */

/* ----------------------------------------------------------------------- */
/* Subroutine */ int fftezb_(real *fc, integer *maxwn, real *x, integer *nx)
{
    /* Initialized data */

    static integer nn = 0;

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void)
	    ;

    /* Local variables */
    static real y[513];
    static char cmsg[80];
    extern /* Subroutine */ int rset0_(real *, integer *, integer *, real *), 
	    rmlt0_(real *, integer *, integer *, real *), rfftb_(integer *, 
	    real *, real *), rffti_(integer *, real *);
    static real wsave[1039];
    extern /* Subroutine */ int vrset_(real *, real *, integer *, integer *, 
	    integer *), msgdmp_(char *, char *, char *, ftnlen, ftnlen, 
	    ftnlen);

    /* Fortran I/O blocks */
    static icilist io___25 = { 0, cmsg+47, 0, "(I4)", 4, 1 };


    /* Parameter adjustments */
    --x;

    /* Function Body */
    if (*nx > 512) {
	s_copy(cmsg, "WORKING AREA IS NOT ENOUGH / NX SHOULD BE .LE. ####.", (
		ftnlen)80, (ftnlen)52);
	s_wsfi(&io___25);
	do_fio(&c__1, (char *)&c__512, (ftnlen)sizeof(integer));
	e_wsfi();
	msgdmp_("E", "FFTEZB", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
    }
    if (*nx < *maxwn << 1) {
	s_copy(cmsg, "MAXWN CANNOT BE CALCULATED / NX SOULD BE .GE. MAXWN*2.",
		 (ftnlen)80, (ftnlen)54);
	msgdmp_("E", "FFTEZB", cmsg, (ftnlen)1, (ftnlen)6, (ftnlen)80);
    }
    if (*nx != nn) {
	rffti_(nx, wsave);
	nn = *nx;
    }
    i__1 = *nx + 1;
    rset0_(y, &i__1, &c__1, &c_b50);
    i__1 = (*maxwn << 1) + 1;
    vrset_(fc, y, &i__1, &c__1, &c__1);
    rmlt0_(&y[1], maxwn, &c__2, &c_b31);
    rmlt0_(&y[2], maxwn, &c__2, &c_b87);
    rfftb_(nx, y, wsave);
    vrset_(y, &x[1], nx, &c__1, &c__1);
    return 0;
} /* fftezb_ */

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