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

#include "f2c.h"

/* Common Block Declarations */

struct {
    real aa1, aa2, aa3, aa4;
} coefs_;

#define coefs_1 coefs_

struct {
    real cth, sth, cph, sph;
    integer nline, nstart, iflag;
} pgsrf1_;

#define pgsrf1_1 pgsrf1_

/* Table of constant values */

static integer c__1 = 1;
static integer c__0 = 0;
static real c_b16 = .84705882352941175f;
static real c_b18 = .74901960784313726f;

real pot_(real *x, real *y)
{
    /* System generated locals */
    real ret_val;

    /* Local variables */
    static real x2, y2, xx, yy;



    y2 = *y * *y;
    x2 = *x * 12.f * *x;
    xx = (y2 + x2) * .5f;
    yy = y2 / 3.f + *y * x2;
    ret_val = 1.f - coefs_1.aa1 * xx - coefs_1.aa2 * yy + coefs_1.aa3 * xx * 
	    xx + coefs_1.aa4 * xx * yy;
    return ret_val;
} /* pot_ */

/* Subroutine */ int pgsurf_(real *a, integer *nx, integer *ny, real *xlims, 
	real *thd, real *phd)
{
    /* System generated locals */
    integer a_dim1, a_offset, i__1, i__2;
    real r__1;

    /* Builtin functions */
    double cos(doublereal), sin(doublereal);

    /* Local variables */
    static integer i__, j, k, n;
    static real t, a1, a2, a3, a4, b1, b2, b3;
    static integer i0, i1, k0, k1;
    static real b4, q1, q2, q3, z1, z2, ph, xa[2], ya[2], za[2], th, dx, dy, 
	    zz;
    static integer imax, jmax, isgn, jsgn;
    static real dtor;
    extern /* Subroutine */ int proj_(real *, real *, real *, integer *, 
	    integer *);
    static real xmin, ymin, xmax, ymax, zmin, zmax, xpmin, xpmax, ypmin, 
	    ypmax;
    extern /* Subroutine */ int pgbbuf_(void), pgebuf_(void), pgqcol_(integer 
	    *, integer *), window_(real *, real *, real *, real *);
    static real xstart, ystart;


/* This routine plots a 3d surface projected onto a 2D plane. */
/* The underside of the surface appears dotted or in blue, on */
/* clour terminals. This routine does the projection for you, */
/* you just need to specify the viewing direction in terms of */
/* spherical polar angles.  As a result, this routine calls */
/* pgwind for you. */

/* Arguments: */
/*  a (input) 	: data array, equally spaced in x and equally */
/* 		  spaced in y, although steps in x and y may */
/* 		  differ. */
/*  nx (input)	: dimension of data array in x direction. */
/*  ny (input)	: dimension of data array in y direction. */
/*  xlims (input): array of min and max values in x, y and z */
/* 		  respectively. */
/*  thd (input) 	: viewing direction given as spherical theta angle */
/* 		  in degrees. 0<= thd <= 90. */
/*  phd (input)	: viewing direction given as spherical phi angle */
/* 		  in degrees. -180 <= phd <= 180. */


    /* Parameter adjustments */
    a_dim1 = *nx;
    a_offset = 1 + a_dim1 * 1;
    a -= a_offset;
    xlims -= 4;

    /* Function Body */
    pgsrf1_1.iflag = 0;
    pgqcol_(&i0, &i1);
    if (i1 != 1) {
	pgsrf1_1.iflag = 1;
    }
    pgbbuf_();
    dtor = .0174533f;
    th = *thd * dtor;
    ph = *phd * dtor;
    pgsrf1_1.cth = cos(th);
    pgsrf1_1.sth = sin(th);
    pgsrf1_1.cph = cos(ph);
    pgsrf1_1.sph = sin(ph);
    xmin = xlims[4];
    xmax = xlims[7];
    ymin = xlims[5];
    ymax = xlims[8];
    zmin = xlims[6];
    zmax = xlims[9];

/* Calculate plotting order from */
/* viewing orientation */

    z1 = zmin * pgsrf1_1.sth;
    z2 = zmax * pgsrf1_1.sth;
    if (*phd > 0.f) {
	a1 = -xmax * pgsrf1_1.sph;
	a2 = -xmin * pgsrf1_1.sph;
	b3 = -ymax * pgsrf1_1.sph * pgsrf1_1.cth;
	b4 = -ymin * pgsrf1_1.sph * pgsrf1_1.cth;
	ystart = ymax;
	isgn = -1;
    } else {
	a1 = -xmin * pgsrf1_1.sph;
	a2 = -xmax * pgsrf1_1.sph;
	b3 = -ymin * pgsrf1_1.sph * pgsrf1_1.cth;
	b4 = -ymax * pgsrf1_1.sph * pgsrf1_1.cth;
	ystart = ymin;
	isgn = 1;
    }
    if (abs(*phd) < 90.f) {
	b1 = ymin * pgsrf1_1.cph;
	b2 = ymax * pgsrf1_1.cph;
	a3 = -xmax * pgsrf1_1.cph * pgsrf1_1.cth;
	a4 = -xmin * pgsrf1_1.cph * pgsrf1_1.cth;
	xstart = xmax;
	jsgn = -1;
    } else {
	b1 = ymax * pgsrf1_1.cph;
	b2 = ymin * pgsrf1_1.cph;
	a3 = -xmin * pgsrf1_1.cph * pgsrf1_1.cth;
	a4 = -xmax * pgsrf1_1.cph * pgsrf1_1.cth;
	xstart = xmin;
	jsgn = 1;
    }
    xpmin = min(a1,b1);
    xpmax = max(a2,b2);
/* Computing MAX */
    r__1 = max(a4,b4);
    ypmax = max(r__1,z2);
/* Computing MIN */
    r__1 = min(a3,b3);
    ypmin = min(r__1,z1);
    window_(&xpmin, &xpmax, &ypmin, &ypmax);

/* Draw coordinate axes */

    pgsrf1_1.nstart = 0;
    pgsrf1_1.nline = 1;
    xa[0] = 0.f;
    xa[1] = 0.f;
    ya[0] = ymin;
    ya[1] = ymax;
    proj_(xa, ya, xa, &c__1, &c__1);
    pgsrf1_1.nline = 1;
    ya[0] = xmin;
    ya[1] = xmax;
    proj_(ya, xa, xa, &c__1, &c__1);
    pgsrf1_1.nline = 1;
    ya[0] = zmin;
    ya[1] = zmax;
    proj_(xa, xa, ya, &c__1, &c__1);

/* Draw curves stepped in x */

    imax = *nx - 1;
    jmax = *ny - 1;
    dx = jsgn * (xmax - xmin) / imax;
    dy = (ymax - ymin) / jmax;
    q1 = dx * pgsrf1_1.sth * pgsrf1_1.sph;
    q2 = dy * pgsrf1_1.sth * pgsrf1_1.cph;
    q3 = dx * dy * pgsrf1_1.cth;
    if (jsgn == 1) {
	k0 = 1;
    } else {
	k0 = *nx;
    }
    i__1 = imax;
    for (i__ = 0; i__ <= i__1; ++i__) {
	pgsrf1_1.nstart = 0;
	pgsrf1_1.nline = 1;
	xa[0] = xstart + i__ * dx;
	xa[1] = xa[0];
	k = k0 + jsgn * i__;
	i__2 = jmax - 1;
	for (j = 0; j <= i__2; ++j) {
	    ya[0] = ymin + j * dy;
	    ya[1] = ya[0] + dy;
	    za[0] = a[k + (j + 1) * a_dim1];
	    za[1] = a[k + (j + 2) * a_dim1];
	    k1 = k + jsgn;
	    if (k1 >= 1 && k1 <= *nx) {
		zz = a[k1 + (j + 1) * a_dim1];
	    } else {
		k1 = k - jsgn;
		zz = za[0] * 2.f - a[k1 + (j + 1) * a_dim1];
	    }
	    t = q3 - q2 * (zz - za[0]) - q1 * (za[1] - za[0]);
	    t = jsgn * t;
	    if (t > 0.f) {
		n = pgsrf1_1.iflag + 1;
	    } else {
		n = 4;
	    }
	    proj_(xa, ya, za, &n, nx);
/* L2: */
	}
/* L1: */
    }

/* Draw curves stepped in y */

    dy = isgn * dy;
    dx = jsgn * dx;
    q1 = jsgn * q1;
    q2 = isgn * q2;
    q3 = isgn * jsgn * q3;
    if (isgn == 1) {
	k0 = 1;
    } else {
	k0 = *ny;
    }
    i__1 = jmax;
    for (j = 0; j <= i__1; ++j) {
	pgsrf1_1.nstart = 0;
	pgsrf1_1.nline = 1;
	ya[0] = ystart + j * dy;
	ya[1] = ya[0];
	k = k0 + isgn * j;
	i__2 = imax - 1;
	for (i__ = 0; i__ <= i__2; ++i__) {
	    xa[0] = xmin + i__ * dx;
	    xa[1] = xa[0] + dx;
	    za[0] = a[i__ + 1 + k * a_dim1];
	    za[1] = a[i__ + 2 + k * a_dim1];
	    k1 = k + isgn;
	    if (k1 >= 1 && k1 <= *ny) {
		zz = a[i__ + 1 + k1 * a_dim1];
	    } else {
		k1 = k - isgn;
		zz = za[0] * 2.f - a[i__ + 1 + k1 * a_dim1];
	    }
	    t = q3 - q1 * (zz - za[0]) - q2 * (za[1] - za[0]);
	    t = isgn * t;
	    if (t > 0.f) {
		n = pgsrf1_1.iflag + 1;
	    } else {
		n = 4;
	    }
	    proj_(xa, ya, za, &n, ny);
/* L4: */
	}
/* L3: */
    }
    pgebuf_();
    return 0;
} /* pgsurf_ */

/* Subroutine */ int proj_(real *x, real *y, real *z__, integer *n, integer *
	ncurve)
{
    static integer m;
    static real xp[100], yp[100];
    extern /* Subroutine */ int pgsci_(integer *), pgsls_(integer *), pgline_(
	    integer *, real *, real *);


    /* Parameter adjustments */
    --z__;
    --y;
    --x;

    /* Function Body */
    if (pgsrf1_1.nline == 1) {
	xp[0] = y[1] * pgsrf1_1.cph - x[1] * pgsrf1_1.sph;
	yp[0] = z__[1] * pgsrf1_1.sth - (x[1] * pgsrf1_1.cph + y[1] * 
		pgsrf1_1.sph) * pgsrf1_1.cth;
	xp[1] = y[2] * pgsrf1_1.cph - x[2] * pgsrf1_1.sph;
	yp[1] = z__[2] * pgsrf1_1.sth - (x[2] * pgsrf1_1.cph + y[2] * 
		pgsrf1_1.sph) * pgsrf1_1.cth;
	if (*n != m) {
	    m = *n;
	    if (pgsrf1_1.iflag == 0) {
		pgsls_(n);
	    } else {
		pgsci_(n);
	    }
	}
	pgsrf1_1.nline = 2;
    } else {
	if (*n != m) {
	    pgline_(&pgsrf1_1.nline, xp, yp);
	    pgsrf1_1.nstart = pgsrf1_1.nstart + pgsrf1_1.nline - 1;
	    m = *n;
	    if (pgsrf1_1.iflag == 0) {
		pgsls_(n);
	    } else {
		pgsci_(n);
	    }
	    xp[0] = xp[pgsrf1_1.nline - 1];
	    yp[0] = yp[pgsrf1_1.nline - 1];
	    pgsrf1_1.nline = 1;
	}
	++pgsrf1_1.nline;
	xp[pgsrf1_1.nline - 1] = y[2] * pgsrf1_1.cph - x[2] * pgsrf1_1.sph;
	yp[pgsrf1_1.nline - 1] = z__[2] * pgsrf1_1.sth - (x[2] * pgsrf1_1.cph 
		+ y[2] * pgsrf1_1.sph) * pgsrf1_1.cth;
    }
    if (pgsrf1_1.nline + pgsrf1_1.nstart >= *ncurve) {
	pgline_(&pgsrf1_1.nline, xp, yp);
    }
    return 0;
} /* proj_ */

/* Subroutine */ int window_(real *xmin, real *xmax, real *ymin, real *ymax)
{
    extern /* Subroutine */ int pgsci_(integer *), pgscr_(integer *, real *, 
	    real *, real *), pgpage_(void), pgeras_(void), pgswin_(real *, 
	    real *, real *, real *);


/* This subroutine sets up the standard pgwind, but with a */
/* cream background. It can be ported to any program. */

    pgpage_();
    pgscr_(&c__0, &c_b16, &c_b16, &c_b18);
    pgeras_();
    pgswin_(xmin, xmax, ymin, ymax);
    pgsci_(&c__1);
    return 0;
} /* window_ */

