/* mdf2d.f -- translated by f2c (version of 22 July 1992  22:54:52).
   You must link the resulting object file with the libraries:
	-lF77 -lI77 -lm -lc   (in that order)
*/

#include "f2c.h"

/* Common Block Declarations */

struct {
    integer ierr;
} gerror_;

#define gerror_1 gerror_

struct {
    doublereal pi, tol;
} gconst_;

#define gconst_1 gconst_

/* Table of constant values */

static doublereal c_b39 = 0.;
static integer c__1 = 1;


/*     The following code was excerpted from: dsmdf2.f */

/* Subroutine */ int dsmdf2_(hflag, nvc, npolg, maxwk, vcl, hvl, pvl, iang, 
	ivrt, xivrt, widsq, edgval, vrtval, area, wk)
logical *hflag;
integer *nvc, *npolg, *maxwk;
doublereal *vcl;
integer *hvl, *pvl;
doublereal *iang;
integer *ivrt, *xivrt;
doublereal *widsq, *edgval, *vrtval, *area, *wk;
{
    /* System generated locals */
    integer i__1, i__2;
    doublereal d__1, d__2, d__3, d__4;

    /* Local variables */
    static integer nvrt, i, j, k, l, m;
    static doublereal s;
    extern /* Subroutine */ int width2_();
    static integer il, jl, xc, yc;
    extern doublereal areapg_();
    static doublereal pimtol;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Set up data structure for heuristic mesh distribution */
/*        function from data structure for convex polygon decomposition */

/*        if HFLAG is .TRUE., else set up only IVRT and XIVRT. */
/*        Also compute areas of convex polygons. */

/*     Input parameters: */
/* 	 HFLAG - .TRUE. if data structure is to be constructed, */
/*              .FALSE. if only IVRT, XIVRT, AREA are to be computed */
/*        NVC - number of vertex coordinates in VCL array */
/*        NPOLG - number of polygonal subregions in HVL array */
/*        MAXWK - maximum size available for WK array; should be */
/*              2 times maximum number of vertices in any polygon */
/* 	 VCL(1:2,1:NVC) - vertex coordinate list */
/*        HVL(1:NPOLG) - head vertex list */
/*        PVL(1:4,1:*),IANG(1:*) - polygon vertex list, interior angles */


/*     Output parameters: */
/*        IVRT(1:*) - indices of polygon vertices in VCL, ordered by */
/*              polygon; same size as PVL */
/*        XIVRT(1:NPOLG+1) - pointer to first vertex of each polygon */
/*              in IVRT; vertices of polygon K are IVRT(I) for I from */
/*              XIVRT(K) to XIVRT(K+1)-1 */
/*        WIDSQ(1:NPOLG) - square of width of convex polygons */
/*        EDGVAL(1:*) - value associated with each edge of decomp.; */
/*              same size as PVL */
/*        VRTVAL(1:NVC) - value associated with each vertex of decomp. */
/*        [Note: Above 5 arrays are for heuristic mdf data structure.] */
/*        AREA(1:NPOLG) - area of convex polygons */

/*     Working parameters: */
/*        WK(1:MAXWK) - double precision work array */

/*     Abnormal return: */
/*        IERR is set to 7 or 201 */

/*     Routines called: */
/*        AREAPG, WIDTH2 */




/*     Compute area and square of width of polygons. */

    /* Parameter adjustments */
    --wk;
    --area;
    --vrtval;
    --edgval;
    --widsq;
    --xivrt;
    --ivrt;
    --iang;
    pvl -= 5;
    --hvl;
    vcl -= 3;

    /* Function Body */
    pimtol = gconst_1.pi - gconst_1.tol;
    i__1 = *npolg;
    for (k = 1; k <= i__1; ++k) {
	nvrt = 0;
	i = hvl[k];
L10:
	if (iang[i] < pimtol) {
	    ++nvrt;
	}
	i = pvl[(i << 2) + 3];
	if (i != hvl[k]) {
	    goto L10;
	}
	if (nvrt + nvrt > *maxwk) {
	    gerror_1.ierr = 7;
	    return 0;
	}
	xc = 0;
L20:
	if (iang[i] < pimtol) {
	    j = pvl[(i << 2) + 1];
	    ++xc;
	    wk[xc] = vcl[(j << 1) + 1];
	    wk[xc + nvrt] = vcl[(j << 1) + 2];
	}
	i = pvl[(i << 2) + 3];
	if (i != hvl[k]) {
	    goto L20;
	}
	xc = 1;
	yc = xc + nvrt;
	area[k] = areapg_(&nvrt, &wk[xc], &wk[yc]) * .5;
	if (*hflag) {
	    width2_(&nvrt, &wk[xc], &wk[yc], &i, &j, &widsq[k]);
	    if (gerror_1.ierr != 0) {
		return 0;
	    }
	}
/* L30: */
    }

/*     Set up IVRT, XIVRT, EDGVAL, VRTVAL arrays. */

    l = 1;
    i__1 = *npolg;
    for (k = 1; k <= i__1; ++k) {
	xivrt[k] = l;
	i = hvl[k];
	il = pvl[(i << 2) + 1];
L40:
	ivrt[l] = il;
	j = pvl[(i << 2) + 3];
	jl = pvl[(j << 2) + 1];
	if (*hflag) {
/* Computing MIN */
/* Computing 2nd power */
	    d__3 = vcl[(jl << 1) + 1] - vcl[(il << 1) + 1];
/* Computing 2nd power */
	    d__4 = vcl[(jl << 1) + 2] - vcl[(il << 1) + 2];
	    d__1 = d__3 * d__3 + d__4 * d__4, d__2 = widsq[k];
	    s = min(d__1,d__2);
	    m = pvl[(i << 2) + 4];
	    if (m > 0) {
/* Computing MIN */
		d__1 = s, d__2 = widsq[pvl[(m << 2) + 2]];
		s = min(d__1,d__2);
	    }
	    edgval[l] = s;
	}
	++l;
	i = j;
	il = jl;
	if (i != hvl[k]) {
	    goto L40;
	}
/* L50: */
    }
    xivrt[*npolg + 1] = l;
    if (! (*hflag)) {
	return 0;
    }
    i__1 = *nvc;
    for (i = 1; i <= i__1; ++i) {
	vrtval[i] = 0.;
/* L60: */
    }
    i__1 = *npolg;
    for (k = 1; k <= i__1; ++k) {
	j = xivrt[k + 1] - 1;
	l = j;
	i__2 = l;
	for (i = xivrt[k]; i <= i__2; ++i) {
	    il = ivrt[i];
	    if (vrtval[il] == 0.) {
/* Computing MIN */
		d__1 = edgval[i], d__2 = edgval[j];
		vrtval[il] = min(d__1,d__2);
	    } else {
/* Computing MIN */
		d__1 = vrtval[il], d__2 = edgval[i], d__1 = min(d__1,d__2), 
			d__2 = edgval[j];
		vrtval[il] = min(d__1,d__2);
	    }
	    j = i;
/* L70: */
	}
/* L80: */
    }
} /* dsmdf2_ */


/*     The following code was excerpted from: eqdis2.f */

/* Subroutine */ int eqdis2_(hflag, umdf, kappa, angspc, angtol, dmin__, nmin,
	 ntrid, nvc, npolg, nvert, maxvc, maxhv, maxpv, maxiw, maxwk, vcl, 
	regnum, hvl, pvl, iang, area, psi, h, iwk, wk)
logical *hflag;
doublereal (*umdf) ();
doublereal *kappa, *angspc, *angtol, *dmin__;
integer *nmin, *ntrid, *nvc, *npolg, *nvert, *maxvc, *maxhv, *maxpv, *maxiw, *
	maxwk;
doublereal *vcl;
integer *regnum, *hvl, *pvl;
doublereal *iang, *area, *psi, *h;
integer *iwk;
doublereal *wk;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static integer ivrt, m, n, widsq;
    extern /* Subroutine */ int mfdec2_();
    static integer xivrt;
    extern /* Subroutine */ int dsmdf2_();
    static integer edgval, vrtval;
    extern /* Subroutine */ int trisiz_();


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Further subdivide convex polygons so that an approx. */
/*        equidistributing triangular mesh can be constructed with */
/*        respect to heuristic or user-supplied mesh distribution */
/*        function, and determine triangle size for each polygon of */
/*        decomposition. */

/*     Input parameters: */
/*        HFLAG - .TRUE. if heuristic mdf, .FALSE. if user-supplied mdf */

/*        UMDF(X,Y) - d.p user-supplied mdf with d.p arguments */
/*        KAPPA - mesh smoothness parameter in interval [0.0,1.0] */
/*        ANGSPC - angle spacing parameter in radians used to determine */

/*              extra points as possible endpoints of separators */
/*        ANGTOL - angle tolerance parameter in radians used in */
/*              accepting separators */
/*        DMIN - parameter used to determine if variation of mdf in */
/*              polygon is 'sufficiently high' */
/*        NMIN - parameter used to determine if 'sufficiently large' */
/*              number of triangles in polygon */
/*        NTRID - desired number of triangles in mesh */
/*        NVC - number of vertex coordinates or positions used in VCL */
/*              array */
/*        NPOLG - number of polygonal subregions or positions used in */
/*              HVL array */
/*        NVERT - number of polygon vertices or positions used in PVL */
/*              array */
/*        MAXVC - maximum size available for VCL array, should be >= */
/*              number of vertex coordinates required for decomposition */

/*              (approx NVC + 2*NS where NS is expected number of new */
/*              separators) */
/*        MAXHV - maximum size available for HVL, REGNUM, AREA, PSI, H */
/*              arrays; should be >= number of polygons required for */
/*              decomposition (approx NPOLG + NS) */
/*        MAXPV - maximum size available for PVL, IANG arrays; should be 
*/
/*              >= number of polygon vertices required for decomposition 
*/
/*              (approx NVERT + 5*NS) */
/*        MAXIW - maximum size available for IWK array; should be >= */
/*              MAX(2*NP, NVERT + NPOLG + 3*NVRT + INT(2*PI/ANGSPC)) */
/*              where NVRT is maximum number of vertices in a convex */
/*              polygon of the (input) decomposition, NP is expected */
/*              value of NPOLG on output */
/*        MAXWK - maximum size available for WK array; should be >= */
/*              NVC + NVERT + 2*NPOLG + 3*(NVRT + INT(2*PI/ANGSPC)) */
/*        VCL(1:2,1:NVC) - vertex coordinate list */
/*        REGNUM(1:NPOLG) - region numbers */
/*        HVL(1:NPOLG) - head vertex list */
/*        PVL(1:4,1:NVERT),IANG(1:NVERT) - polygon vertex list and */
/*              interior angles; see routine DSPGDC for more details */
/*        [Note: The data structures should be as output from routine */
/*              CVDEC2.] */

/*     Updated parameters: */
/*        NVC,NPOLG,NVERT,VCL,REGNUM,HVL,PVL,IANG */

/*     Output parameters: */
/*        AREA(1:NPOLG) - area of convex polygons in decomposition */
/*        PSI(1:NPOLG) - smoothed mean mdf values in the convex polygons 
*/
/*        H(1:NPOLG) - triangle size for convex polygons */

/*     Working parameters: */
/*        IWK(1:MAXIW) - integer work array */
/*        WK(1:MAXWK) - double precsion work array */

/*     Abnormal return: */
/*        IERR is set to 3, 4, 5, 6, 7, 200, 201, or 222 */

/*     Routines called: */
/*        DSMDF2, MFDEC2, TRISIZ */



    /* Parameter adjustments */
    --wk;
    --iwk;
    --h;
    --psi;
    --area;
    --iang;
    pvl -= 5;
    --hvl;
    --regnum;
    vcl -= 3;

    /* Function Body */
    ivrt = 1;
    xivrt = ivrt + *nvert;
    m = xivrt + *npolg;
    if (m > *maxiw) {
	gerror_1.ierr = 6;
	return 0;
    }
    widsq = 1;
    if (*hflag) {
	edgval = widsq + *npolg;
	vrtval = edgval + *nvert;
	n = *npolg + *nvert + *nvc;
	if (n > *maxwk) {
	    gerror_1.ierr = 7;
	    return 0;
	}
    } else {
	edgval = 1;
	vrtval = 1;
	n = 0;
    }
    i__1 = *maxwk - n;
    dsmdf2_(hflag, nvc, npolg, &i__1, &vcl[3], &hvl[1], &pvl[5], &iang[1], &
	    iwk[ivrt], &iwk[xivrt], &wk[widsq], &wk[edgval], &wk[vrtval], &
	    area[1], &wk[n + 1]);
    if (gerror_1.ierr != 0) {
	return 0;
    }
    i__1 = *maxiw - m;
    i__2 = *maxwk - n;
    mfdec2_(hflag, umdf, kappa, angspc, angtol, dmin__, nmin, ntrid, nvc, 
	    npolg, nvert, maxvc, maxhv, maxpv, &i__1, &i__2, &vcl[3], &regnum[
	    1], &hvl[1], &pvl[5], &iang[1], &iwk[ivrt], &iwk[xivrt], &wk[
	    widsq], &wk[edgval], &wk[vrtval], &area[1], &psi[1], &iwk[m + 1], 
	    &wk[n + 1]);
    if (gerror_1.ierr != 0) {
	return 0;
    }
    if (*npolg << 1 > *maxiw) {
	gerror_1.ierr = 6;
	return 0;
    }
    trisiz_(ntrid, npolg, &hvl[1], &pvl[5], &area[1], &psi[1], &h[1], &iwk[1],
	     &iwk[*npolg + 1]);
} /* eqdis2_ */


/*     The following code was excerpted from: intpg.f */

/* Subroutine */ int intpg_(nvrt, xc, yc, ctrx, ctry, arpoly, hflag, umdf, 
	wsq, nev, ifv, listev, ivrt, edgval, vrtval, vcl, mdfint, mean, stdv, 
	mdftr)
integer *nvrt;
doublereal *xc, *yc, *ctrx, *ctry, *arpoly;
logical *hflag;
doublereal (*umdf) ();
doublereal *wsq;
integer *nev, *ifv, *listev, *ivrt;
doublereal *edgval, *vrtval, *vcl, *mdfint, *mean, *stdv, *mdftr;
{
    /* Initialized data */

    static doublereal wt[3] = { .3333333333333333,.3333333333333333,
	    .3333333333333333 };
    static doublereal qc[9]	/* was [3][3] */ = { .6666666666666666,
	    .1666666666666667,.1666666666666667,.1666666666666667,
	    .6666666666666666,.1666666666666667,.1666666666666667,
	    .1666666666666667,.6666666666666666 };

    /* System generated locals */
    integer i__1, i__2;
    doublereal d__1, d__2, d__3;

    /* Builtin functions */
    double sqrt();

    /* Local variables */
    static doublereal temp, d;
    static integer i, j, k, l, m;
    static doublereal s, x, y, x0, x1, y0, y1, areatr, xx, yy, mdfsqi;
    static integer kp1;
    static doublereal val, sum1, sum2;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Compute integral of MDF2(X,Y) [heuristic mdf] or */
/*        UMDF(X,Y) [user-supplied mdf] in convex polygon. */

/*     Input parameters: */
/*        NVRT - number of vertices in polygon */
/*        XC(0:NVRT),YC(0:NVRT) - coordinates of polygon vertices in */
/*              CCW order, translated so that centroid is at origin; */
/*              (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)) */
/*        CTRX, CTRY - coordinates of centroid before translation */
/*        ARPOLY - area of polygon */
/*        HFLAG - .TRUE. if heuristic mdf, .FALSE. if user-supplied mdf */

/*        UMDF(X,Y) - d.p user-supplied mdf with d.p arguments */
/*        WSQ - square of width of original polygon of decomposition */
/*        NEV,IFV,LISTEV(1:NEV) - output from routine PRMDF2 */
/*        IVRT(1:*),EDGVAL(1:*),VRTVAL(1:*) - arrays output from DSMDF2; 
*/
/*              if .NOT. HFLAG then only first array exists */
/*        VCL(1:2,1:*) - vertex coordinate list */

/*     Output parameters: */
/*        MDFINT - integral of mdf in polygon */
/*        MEAN - mean mdf value in polygon */
/*        STDV - standard deviation of mdf in polygon */
/*        MDFTR(0:NVRT-1) - mean mdf value in each triangle of polygon; */

/*              triangles are determined by polygon vertices and centroid 
*/

/*     Routines called: */
/*        UMDF */



    /* Parameter adjustments */
    vcl -= 3;
    --vrtval;
    --edgval;
    --ivrt;
    --listev;

    /* Function Body */

/*     NQPT is number of quad pts for numerical integration in triangle */

/*     WT(I) is weight of Ith quadrature point */
/*     QC(1:3,I) are barycentric coordinates of Ith quadrature point */

    *mdfint = 0.;
    mdfsqi = 0.;
    i__1 = *nvrt - 1;
    for (l = 0; l <= i__1; ++l) {
	areatr = (xc[l] * yc[l + 1] - xc[l + 1] * yc[l]) * .5;
	sum1 = 0.;
	sum2 = 0.;
	for (m = 1; m <= 3; ++m) {
	    xx = qc[m * 3 - 3] * xc[l] + qc[m * 3 - 2] * xc[l + 1];
	    yy = qc[m * 3 - 3] * yc[l] + qc[m * 3 - 2] * yc[l + 1];
	    if (*hflag) {
/* 	       VAL = MDF2(XX+CTRX,YY+CTRY,WSQ,NEV,IFV,LISTEV,IVRT,
 */
/*    $            EDGVAL,VRTVAL,VCL) */
/*              Insert code for function MDF2 to reduce number
 of calls. */

		x = xx + *ctrx;
		y = yy + *ctry;
		s = *wsq;
		i__2 = *nev;
		for (i = 1; i <= i__2; ++i) {
		    k = listev[i];
		    if (k < 0) {
			k = -k;
/* Computing 2nd power */
			d__1 = vcl[(k << 1) + 1] - x;
/* Computing 2nd power */
			d__2 = vcl[(k << 1) + 2] - y;
			d = d__1 * d__1 + d__2 * d__2;
/* Computing MAX */
			d__1 = d * .25, d__2 = vrtval[k];
			d = max(d__1,d__2);
			s = min(s,d);
		    } else {
			kp1 = k + 1;
			if (i == *nev && *ifv > 0) {
			    kp1 = *ifv;
			}
			j = ivrt[kp1];
			x0 = x - vcl[(j << 1) + 1];
			y0 = y - vcl[(j << 1) + 2];
			x1 = vcl[(ivrt[k] << 1) + 1] - vcl[(j << 1) + 1];
			y1 = vcl[(ivrt[k] << 1) + 2] - vcl[(j << 1) + 2];
			if (x0 * x1 + y0 * y1 <= 0.) {
/* Computing 2nd power */
			    d__1 = x0;
/* Computing 2nd power */
			    d__2 = y0;
			    d = d__1 * d__1 + d__2 * d__2;
			} else {
			    x0 -= x1;
			    y0 -= y1;
			    if (x0 * x1 + y0 * y1 >= 0.) {
/* Computing 2nd power */
				d__1 = x0;
/* Computing 2nd power */
				d__2 = y0;
				d = d__1 * d__1 + d__2 * d__2;
			    } else {
/* Computing 2nd power */
				d__1 = x1 * y0 - y1 * x0;
/* Computing 2nd power */
				d__2 = x1;
/* Computing 2nd power */
				d__3 = y1;
				d = d__1 * d__1 / (d__2 * d__2 + d__3 * d__3);

			    }
			}
/* Computing MAX */
			d__1 = d * .25, d__2 = edgval[k];
			d = max(d__1,d__2);
			s = min(s,d);
		    }
/* L10: */
		}
		val = 1. / s;
	    } else {
		d__1 = xx + *ctrx;
		d__2 = yy + *ctry;
		val = (*umdf)(&d__1, &d__2);
	    }
	    temp = wt[m - 1] * val;
	    sum1 += temp;
	    sum2 += temp * val;
/* L20: */
	}
	mdftr[l] = sum1;
	*mdfint += sum1 * areatr;
	mdfsqi += sum2 * areatr;
/* L30: */
    }
    *mean = *mdfint / *arpoly;
/* Computing 2nd power */
    d__1 = *mean;
    *stdv = mdfsqi / *arpoly - d__1 * d__1;
    *stdv = sqrt((max(*stdv,0.)));
} /* intpg_ */


/*     The following code was excerpted from: mfdec2.f */

/* Subroutine */ int mfdec2_(hflag, umdf, kappa, angspc, angtol, dmin__, nmin,
	 ntrid, nvc, npolg, nvert, maxvc, maxhv, maxpv, maxiw, maxwk, vcl, 
	regnum, hvl, pvl, iang, ivrt, xivrt, widsq, edgval, vrtval, area, psi,
	 iwk, wk)
logical *hflag;
doublereal (*umdf) ();
doublereal *kappa, *angspc, *angtol, *dmin__;
integer *nmin, *ntrid, *nvc, *npolg, *nvert, *maxvc, *maxhv, *maxpv, *maxiw, *
	maxwk;
doublereal *vcl;
integer *regnum, *hvl, *pvl;
doublereal *iang;
integer *ivrt, *xivrt;
doublereal *widsq, *edgval, *vrtval, *area, *psi;
integer *iwk;
doublereal *wk;
{
    /* System generated locals */
    integer i__1, i__2, i__3;
    doublereal d__1, d__2;

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

    /* Local variables */
    static doublereal mean;
    static integer maxn;
    static doublereal ctrx, ctry, stdv;
    static integer nvrt;
    static doublereal sumx, sumy;
    static integer i, j, k, l, m, p;
    static doublereal r, alpha;
    static integer v, w;
    static doublereal delta;
    static integer mdftr;
    extern /* Subroutine */ int intpg_();
    static doublereal c1, c2, numer;
    static integer i1, i2;
    static doublereal x1, x2, y1, y2;
    extern /* Subroutine */ int insed2_();
    static doublereal theta1, theta2, angsp2;
    extern /* Subroutine */ int prmdf2_();
    static integer ii;
    extern /* Subroutine */ int insvr2_();
    static integer xc, yc;
    static doublereal dx;
    static integer np;
    extern doublereal areapg_();
    static doublereal dy, arearg, nwarea;
    extern /* Subroutine */ int sepmdf_();
    static doublereal cosalp, mdfint, sinalp, intreg;
    static integer indpvl;
    extern /* Subroutine */ int sepshp_();
    static integer listev;
    static doublereal pi2;
    static integer inc, ifv, nev;
    static doublereal wsq;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Further subdivide convex polygons so that the variation */

/*        of heuristic or user-supplied mesh distribution function in */
/*        each polygon is limited. */

/*     Input parameters: */
/*        HFLAG - .TRUE. if heuristic mdf, .FALSE. if user-supplied mdf */

/*        UMDF(X,Y) - d.p user-supplied mdf with d.p arguments */
/*        KAPPA - mesh smoothness parameter in interval [0.0,1.0] */
/*        ANGSPC - angle spacing parameter in radians used to determine */

/*              extra points as possible endpoints of separators */
/*        ANGTOL - angle tolerance parameter in radians used in */
/*              accepting separators */
/*        DMIN - parameter used to determine if variation of mdf in */
/*              polygon is 'sufficiently high' */
/*        NMIN - parameter used to determine if 'sufficiently large' */
/*              number of triangles in polygon */
/*        NTRID - desired number of triangles in mesh */
/*        NVC - number of vertex coordinates or positions used in VCL */
/*              array */
/*        NPOLG - number of polygonal subregions or positions used in */
/*              HVL array */
/*        NVERT - number of polygon vertices or positions used in PVL */
/*              array */
/*        MAXVC - maximum size available for VCL array */
/*        MAXHV - maximum size available for HVL,REGNUM,AREA,PSI arrays */

/*        MAXPV - maximum size available for PVL, IANG arrays */
/*        MAXIW - maximum size available for IWK array; should be about */

/*              3*NVRT + INT(2*PI/ANGSPC) where NVRT is maximum number of 
*/
/*              vertices in a convex polygon of the (input) decomposition 
*/
/*        MAXWK - maximum size available for WK array; should be about */
/*              NPOLG + 3*(NVRT + INT(2*PI/ANGSPC)) + 2 */
/*        VCL(1:2,1:NVC) - vertex coordinate list */
/*        REGNUM(1:NPOLG) - region numbers */
/*        HVL(1:NPOLG) - head vertex list */
/*        PVL(1:4,1:NVERT),IANG(1:NVERT) - polygon vertex list and */
/*              interior angles */
/*        IVRT(1:NVERT),XIVRT(1:NPOLG+1),WIDSQ(1:NPOLG),EDGVAL(1:NVERT), 
*/
/*              VRTVAL(1:NVC) - arrays output from routine DSMDF2; */
/*              if .NOT. HFLAG then only first two arrays exist */
/*        AREA(1:NPOLG) - area of convex polygons in decomposition */

/*     Updated parameters: */
/*        NVC,NPOLG,NVERT,VCL,REGNUM,HVL,PVL,IANG,AREA */

/*     Output parameters: */
/*        PSI(1:NPOLG) - mean mdf values in the convex polygons */

/*     Working parameters: */
/*        IWK(1:MAXIW) - integer work array */
/*        WK(1:MAXWK) - double precision work array */

/*     Abnormal return: */
/*        IERR is set to 3, 4, 5, 6, 7, 200, or 222 */

/*     Routines called: */
/*        AREAPG, INSED2, INSVR2, INTPG, PRMDF2, SEPMDF, SEPSHP */




/*     WK(1:NPOLG) is used for mdf standard deviation in polygons. */
/*     Compute AREARG = area of region and INTREG = estimated integral */
/*     of MDF2(X,Y) or UMDF(X,Y). */

    /* Parameter adjustments */
    --wk;
    --iwk;
    --psi;
    --area;
    --vrtval;
    --edgval;
    --widsq;
    --xivrt;
    --ivrt;
    --iang;
    pvl -= 5;
    --hvl;
    --regnum;
    vcl -= 3;

    /* Function Body */
    nvrt = 0;
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
/* Computing MAX */
	i__2 = nvrt, i__3 = xivrt[i + 1] - xivrt[i];
	nvrt = max(i__2,i__3);
/* L10: */
    }
    if (*hflag && nvrt << 1 > *maxiw) {
	gerror_1.ierr = 6;
	return 0;
    } else if (*npolg + nvrt * 3 + 2 > *maxwk) {
	gerror_1.ierr = 7;
	return 0;
    }
    listev = 1;
    xc = *npolg + 1;
    yc = xc + nvrt + 1;
    mdftr = yc + nvrt + 1;
    arearg = 0.;
    intreg = 0.;
    nev = -1;
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
	if (*hflag) {
	    wsq = widsq[i];
	    prmdf2_(&i, &wsq, &ivrt[1], &xivrt[1], &edgval[1], &vrtval[1], &
		    nev, &ifv, &iwk[listev]);
	}
	if (nev == 0) {
	    psi[i] = 1. / wsq;
	    wk[i] = 0.;
	    mdfint = psi[i] * area[i];
	} else {
	    nvrt = xivrt[i + 1] - xivrt[i];
	    k = xivrt[i];
	    sumx = 0.;
	    sumy = 0.;
	    i__2 = nvrt - 1;
	    for (j = 0; j <= i__2; ++j) {
		l = ivrt[k];
		wk[xc + j] = vcl[(l << 1) + 1];
		wk[yc + j] = vcl[(l << 1) + 2];
		sumx += wk[xc + j];
		sumy += wk[yc + j];
		++k;
/* L20: */
	    }
	    ctrx = sumx / (doublereal) nvrt;
	    ctry = sumy / (doublereal) nvrt;
	    i__2 = nvrt - 1;
	    for (j = 0; j <= i__2; ++j) {
		wk[xc + j] -= ctrx;
		wk[yc + j] -= ctry;
/* L30: */
	    }
	    wk[xc + nvrt] = wk[xc];
	    wk[yc + nvrt] = wk[yc];
	    intpg_(&nvrt, &wk[xc], &wk[yc], &ctrx, &ctry, &area[i], hflag, 
		    umdf, &wsq, &nev, &ifv, &iwk[listev], &ivrt[1], &edgval[1]
		    , &vrtval[1], &vcl[3], &mdfint, &psi[i], &wk[i], &wk[
		    mdftr]);
	}
	arearg += area[i];
	intreg += mdfint;
/* L40: */
    }

/*     If HFLAG, compute mean mdf values from KAPPA, etc. Scale PSI(I)'s 
*/
/*     so that integral in region is 1. Determine which polygons need to 
*/
/*     be further subdivided (indicated by negative PSI(I) value). */

    if (*hflag) {
	c1 = (1. - *kappa) / intreg;
	c2 = *kappa / arearg;
    } else {
	c1 = 1. / intreg;
	c2 = 0.;
    }
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
	psi[i] = psi[i] * c1 + c2;
	if (c1 * wk[i] > psi[i] * *dmin__) {
	    if (*ntrid * psi[i] * area[i] > (doublereal) (*nmin)) {
		psi[i] = -psi[i];
	    }
	}
/* L50: */
    }

/*     Further subdivide polygons for which STDV/MEAN > DMIN and */
/*     (estimated number of triangles) > NMIN. */

    angsp2 = *angspc * 2.;
    pi2 = gconst_1.pi * 2.;
    inc = (integer) (pi2 / *angspc);
    nev = 0;
    np = *npolg;
    xc = 1;
    i__1 = np;
    for (i = 1; i <= i__1; ++i) {
	if (psi[i] < 0.) {
	    if (*hflag) {
		wsq = widsq[i];
		prmdf2_(&i, &wsq, &ivrt[1], &xivrt[1], &edgval[1], &vrtval[1],
			 &nev, &ifv, &iwk[listev]);
	    }
	    l = *npolg + 1;
	    k = i;
L60:
	    if (k > *npolg) {
		goto L130;
	    }
L70:
	    if (psi[k] >= 0.) {
		goto L120;
	    }
	    nvrt = 0;
	    sumx = 0.;
	    sumy = 0.;
	    j = hvl[k];
L80:
	    ++nvrt;
	    m = pvl[(j << 2) + 1];
	    sumx += vcl[(m << 1) + 1];
	    sumy += vcl[(m << 1) + 2];
	    j = pvl[(j << 2) + 3];
	    if (j != hvl[k]) {
		goto L80;
	    }
	    ctrx = sumx / (doublereal) nvrt;
	    ctry = sumy / (doublereal) nvrt;
	    maxn = nvrt + inc;
	    if (nev + maxn + 1 > *maxiw) {
		gerror_1.ierr = 6;
		return 0;
	    } else if (maxn * 3 + 2 > *maxwk) {
		gerror_1.ierr = 7;
		return 0;
	    }
	    yc = xc + maxn + 1;
	    mdftr = yc + maxn + 1;
	    indpvl = listev + nev;
	    nvrt = 0;
	    m = pvl[(j << 2) + 1];
	    x1 = vcl[(m << 1) + 1] - ctrx;
	    y1 = vcl[(m << 1) + 2] - ctry;
	    wk[xc] = x1;
	    wk[yc] = y1;
	    theta1 = atan2(y1, x1);
	    p = j;
	    iwk[indpvl] = j;
L90:
	    j = pvl[(j << 2) + 3];
	    m = pvl[(j << 2) + 1];
	    x2 = vcl[(m << 1) + 1] - ctrx;
	    y2 = vcl[(m << 1) + 2] - ctry;
	    theta2 = atan2(y2, x2);
	    if (theta2 < theta1) {
		theta2 += pi2;
	    }
	    delta = theta2 - theta1;
	    if (delta >= angsp2) {
		m = (integer) (delta / *angspc);
		delta /= (doublereal) m;
		dx = x2 - x1;
		dy = y2 - y1;
		numer = x1 * dy - y1 * dx;
		alpha = theta1;
		i__2 = m - 1;
		for (ii = 1; ii <= i__2; ++ii) {
		    alpha += delta;
		    cosalp = cos(alpha);
		    sinalp = sin(alpha);
		    r = numer / (dy * cosalp - dx * sinalp);
		    ++nvrt;
		    wk[xc + nvrt] = r * cosalp;
		    wk[yc + nvrt] = r * sinalp;
		    iwk[indpvl + nvrt] = -p;
/* L100: */
		}
	    }
	    ++nvrt;
	    wk[xc + nvrt] = x2;
	    wk[yc + nvrt] = y2;
	    x1 = x2;
	    y1 = y2;
	    theta1 = theta2;
	    p = j;
	    iwk[indpvl + nvrt] = j;
	    if (j != hvl[k]) {
		goto L90;
	    }
	    intpg_(&nvrt, &wk[xc], &wk[yc], &ctrx, &ctry, &area[k], hflag, 
		    umdf, &wsq, &nev, &ifv, &iwk[listev], &ivrt[1], &edgval[1]
		    , &vrtval[1], &vcl[3], &mdfint, &mean, &stdv, &wk[mdftr]);

	    psi[k] = mean * c1 + c2;
	    if (c1 * stdv > psi[k] * *dmin__) {
		if (*ntrid * psi[k] * area[k] > (doublereal) (*nmin)) {
		    sepmdf_(angtol, &nvrt, &wk[xc], &wk[yc], &area[k], &mean, 
			    &wk[mdftr], &iwk[indpvl], &iang[1], &i1, &i2);
		    if (i1 < 0) {
			if (yc + nvrt * 3 > *maxwk) {
			    gerror_1.ierr = 7;
			    return 0;
			}
			sepshp_(angtol, &nvrt, &wk[xc], &wk[yc], &iwk[indpvl],
				 &iang[1], &i1, &i2, &wk[yc + nvrt + 1]);
			if (gerror_1.ierr != 0) {
			    return 0;
			}
		    }
		    if (i1 < 0) {
			gerror_1.ierr = 222;
			return 0;
		    }
		    v = iwk[indpvl + i1];
		    if (v < 0) {
			d__1 = wk[xc + i1] + ctrx;
			d__2 = wk[yc + i1] + ctry;
			i__2 = -v;
			insvr2_(&d__1, &d__2, &i__2, nvc, nvert, maxvc, maxpv,
				 &vcl[3], &pvl[5], &iang[1], &v);
			if (gerror_1.ierr != 0) {
			    return 0;
			}
		    }
		    w = iwk[indpvl + i2];
		    if (w < 0) {
			d__1 = wk[xc + i2] + ctrx;
			d__2 = wk[yc + i2] + ctry;
			i__2 = -w;
			insvr2_(&d__1, &d__2, &i__2, nvc, nvert, maxvc, maxpv,
				 &vcl[3], &pvl[5], &iang[1], &w);
			if (gerror_1.ierr != 0) {
			    return 0;
			}
		    }
		    insed2_(&v, &w, npolg, nvert, maxhv, maxpv, &vcl[3], &
			    regnum[1], &hvl[1], &pvl[5], &iang[1]);
		    if (gerror_1.ierr != 0) {
			return 0;
		    }
		    nvrt = 0;
		    j = hvl[k];
L110:
		    m = pvl[(j << 2) + 1];
		    wk[xc + nvrt] = vcl[(m << 1) + 1];
		    wk[yc + nvrt] = vcl[(m << 1) + 2];
		    ++nvrt;
		    j = pvl[(j << 2) + 3];
		    if (j != hvl[k]) {
			goto L110;
		    }
		    nwarea = areapg_(&nvrt, &wk[xc], &wk[yc]) * .5;
		    area[*npolg] = area[k] - nwarea;
		    area[k] = nwarea;
		    psi[k] = -psi[k];
		    psi[*npolg] = psi[k];
		}
	    }
	    goto L70;
L120:
	    if (k == i) {
		k = l;
	    } else {
		++k;
	    }
	    goto L60;
L130:
	    ;
	}
/* L140: */
    }
} /* mfdec2_ */


/*     The following code was excerpted from: mmasep.f */

/* Subroutine */ int mmasep_(angtol, xc, yc, indpvl, iang, v, w, i1, i2)
doublereal *angtol, *xc, *yc;
integer *indpvl;
doublereal *iang;
integer *v, *w, *i1, *i2;
{
    /* System generated locals */
    doublereal d__1, d__2;

    /* Local variables */
    static doublereal beta;
    static integer i, j, k, l, m;
    static doublereal gamma, alpha;
    extern doublereal angle_();
    static doublereal delta, angmin, angmax;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Find best of four possible separators according to */
/*        max-min angle criterion. */

/*     Input parameters: */
/*        ANGTOL - angle tolerance parameter (in radians) for accepting */

/*              separator */
/*        XC(0:NVRT),YC(0:NVRT) - coordinates of polygon vertices in */
/*              CCW order where NVRT is number of vertices; */
/*              (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)) */
/*        INDPVL(0:NVRT) - indices in PVL of vertices; INDPVL(I) = -K if 
*/
/*              (XC(I),YC(I)) is extra vertex inserted on edge from */
/*              K to PVL(SUCC,K) */
/*        IANG(1:*) - interior angle array */
/*        V(1:2),W(1:2) - indices in XC, YC in range 0 to NVRT-1; four */
/*              possible separators are V(I),W(J), I,J = 1,2 */

/*     Output parameters: */
/*        I1,I2 - indices in range 0 to NVRT-1 of best separator */
/*              according to max-min angle criterion; I1 = -1 */
/*              if no satisfactory separator is found */

/*     Routines called: */
/*        ANGLE */



    /* Parameter adjustments */
    --w;
    --v;
    --iang;

    /* Function Body */
    angmax = 0.;
    for (i = 1; i <= 2; ++i) {
	l = v[i];
	k = indpvl[l];
	if (k > 0) {
	    alpha = iang[k];
	} else {
	    alpha = gconst_1.pi;
	}
	for (j = 1; j <= 2; ++j) {
	    m = w[j];
	    if (l == m) {
		goto L10;
	    }
	    k = indpvl[m];
	    if (k > 0) {
		beta = iang[k];
	    } else {
		beta = gconst_1.pi;
	    }
	    gamma = angle_(&xc[m], &yc[m], &xc[l], &yc[l], &xc[l + 1], &yc[l 
		    + 1]);
	    delta = angle_(&xc[l], &yc[l], &xc[m], &yc[m], &xc[m + 1], &yc[m 
		    + 1]);
/* Computing MIN */
	    d__1 = gamma, d__2 = alpha - gamma, d__1 = min(d__1,d__2), d__1 = 
		    min(d__1,delta), d__2 = beta - delta;
	    angmin = min(d__1,d__2);
	    if (angmin > angmax) {
		angmax = angmin;
		*i1 = l;
		*i2 = m;
	    }
L10:
	    ;
	}
/* L20: */
    }
    if (angmax < *angtol) {
	*i1 = -1;
    }
} /* mmasep_ */


/*     The following code was excerpted from: prmdf2.f */

/* Subroutine */ int prmdf2_(ipoly, wsq, ivrt, xivrt, edgval, vrtval, nev, 
	ifv, listev)
integer *ipoly;
doublereal *wsq;
integer *ivrt, *xivrt;
doublereal *edgval, *vrtval;
integer *nev, *ifv, *listev;
{
    /* System generated locals */
    integer i__1;
    doublereal d__1, d__2;

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


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Preprocessing step for evaluating mesh distribution */
/*        function in polygon IPOLY - the edges and vertices for */
/*        which distances must be computed are determined. */

/*     Input parameters: */
/*        IPOLY - index of polygon */
/*        WSQ - square of width of polygon IPOLY */
/*        IVRT(1:*) - indices of polygon vertices in VCL, ordered by */
/*              polygon */
/*        XIVRT(1:*) - pointer to first vertex of each polygon in IVRT; */

/*              vertices of polygon IPOLY are IVRT(I) for I from */
/*              XIVRT(IPOLY) to XIVRT(IPOLY+1)-1 */
/*        EDGVAL(1:*) - value associated with each edge of decomp. */
/*        VRTVAL(1:*) - value associated with each vertex of decomp. */

/*     Output parameters: */
/*        NEV - number of edges and vertices for which distances must */
/*              be evaluated */
/*        IFV - index of first vertex XIVRT(IPOLY) if LISTEV(NEV) */
/*              = XIVRT(IPOLY+1) - 1; 0 otherwise */
/*        LISTEV(1:*) - array of length <= [XIVRT(IPOLY+1)-XIVRT(IPOLY)] 
*/
/*              *2 containing indices of edges and vertices mentioned */
/*              above; indices of vertices are negated */


    /* Parameter adjustments */
    --listev;
    --vrtval;
    --edgval;
    --xivrt;
    --ivrt;

    /* Function Body */
    *ifv = 0;
    *nev = 0;
    im1 = xivrt[*ipoly + 1] - 1;
    l = im1;
    i__1 = l;
    for (i = xivrt[*ipoly]; i <= i__1; ++i) {
	j = ivrt[i];
/* Computing MIN */
	d__1 = edgval[i], d__2 = edgval[im1];
	if (vrtval[j] < min(d__1,d__2)) {
	    ++(*nev);
	    listev[*nev] = -j;
	}
	if (edgval[i] < *wsq) {
	    ++(*nev);
	    listev[*nev] = i;
	}
	im1 = i;
/* L10: */
    }
    if (*nev > 0) {
	if (listev[*nev] == l) {
	    *ifv = xivrt[*ipoly];
	}
    }
} /* prmdf2_ */


/*     The following code was excerpted from: sepmdf.f */

/* Subroutine */ int sepmdf_(angtol, nvrt, xc, yc, arpoly, mean, mdftr, 
	indpvl, iang, i1, i2)
doublereal *angtol;
integer *nvrt;
doublereal *xc, *yc, *arpoly, *mean, *mdftr;
integer *indpvl;
doublereal *iang;
integer *i1, *i2;
{
    /* System generated locals */
    integer i__1;

    /* Local variables */
    static integer i, l, m, v[2], w[2];
    extern doublereal angle_();
    static integer hi;
    static doublereal areatr;
    extern /* Subroutine */ int mmasep_();
    static doublereal sum;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Determine separator to split convex polygon into two */
/*        parts based on mesh distribution function. */

/*     Input parameters: */
/*        ANGTOL - angle tolerance parameter (in radians) */
/*        NVRT - number of vertices in polygon */
/*        XC(0:NVRT),YC(0:NVRT) - coordinates of polygon vertices in */
/*              CCW order, translated so that centroid is at origin; */
/*              (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)) */
/*        ARPOLY - area of polygon */
/*        MEAN - mean mdf value in polygon */
/*        MDFTR(0:NVRT-1) - mean mdf value in each triangle of polygon; */

/*              triangles are determined by polygon vertices and centroid 
*/
/*        INDPVL(0:NVRT) - indices in PVL of vertices; INDPVL(I) = -K if 
*/
/*              (XC(I),YC(I)) is extra vertex inserted on edge from */
/*              K to PVL(SUCC,K) */
/*        IANG(1:*) - interior angle array */

/*     Output parameters: */
/*        I1,I2 - indices in range 0 to NVRT-1 of best separator */
/*              according to mdf and max-min angle criterion; I1 = -1 */
/*              if no satisfactory separator is found */

/*     Routines called: */
/*        ANGLE, MMASEP */



/*     Determine triangle with highest mean mesh density; then determine 
*/
/*     triangles adjacent to this triangle with mesh density >= MEAN */
/*     such that the area of these triangles is <= ARPOLY/2. */
/*     Note that twice the triangle area is computed. */

    /* Parameter adjustments */
    --iang;

    /* Function Body */
    hi = 0;
    i__1 = *nvrt - 1;
    for (i = 1; i <= i__1; ++i) {
	if (mdftr[i] > mdftr[hi]) {
	    hi = i;
	}
/* L10: */
    }
    sum = xc[hi] * yc[hi + 1] - xc[hi + 1] * yc[hi];
    l = hi - 1;
    if (l < 0) {
	l = *nvrt - 1;
    }
    m = hi + 1;
    if (m >= *nvrt) {
	m = 0;
    }
L20:
    if (mdftr[l] >= mdftr[m]) {
	i = l;
    } else {
	i = m;
    }
    if (mdftr[i] < *mean) {
	goto L30;
    }
    areatr = xc[i] * yc[i + 1] - xc[i + 1] * yc[i];
    sum += areatr;
    if (sum > *arpoly) {
	goto L30;
    }
    if (i == l) {
	--l;
	if (l < 0) {
	    l = *nvrt - 1;
	}
    } else {
	++m;
	if (m >= *nvrt) {
	    m = 0;
	}
    }
    goto L20;
L30:
    ++l;
    if (l >= *nvrt) {
	l = 0;
    }

/*     Interchange role of L and M depending on angle determined by */
/*     (XC(M),YC(M)), (0,0), and (XC(L),YC(L)). */
/*     Possible separators are L,M; L,M+1; L+1,M; L+1,M+1. */

    if (angle_(&xc[m], &yc[m], &c_b39, &c_b39, &xc[l], &yc[l]) > gconst_1.pi) 
	    {
	i = l;
	l = m;
	m = i;
    }
    v[0] = l;
    v[1] = l - 1;
    if (v[1] < 0) {
	v[1] = *nvrt - 1;
    }
    w[0] = m;
    w[1] = m + 1;
    if (w[1] >= *nvrt) {
	w[1] = 0;
    }
    mmasep_(angtol, xc, yc, indpvl, &iang[1], v, w, i1, i2);
} /* sepmdf_ */


/*     The following code was excerpted from: sepshp.f */

/* Subroutine */ int sepshp_(angtol, nvrt, xc, yc, indpvl, iang, i1, i2, wk)
doublereal *angtol;
integer *nvrt;
doublereal *xc, *yc;
integer *indpvl;
doublereal *iang;
integer *i1, *i2;
doublereal *wk;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static doublereal dist;
    extern /* Subroutine */ int diam2_();
    static integer i, k, n, v[2], w[2];
    static doublereal xa, dx, dy, ya;
    extern /* Subroutine */ int mmasep_();
    static doublereal pimtol;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Determine separator to split convex polygon into two */
/*        parts based on shape (diameter) of polygon. */

/*     Input parameters: */
/*        ANGTOL - angle tolerance parameter (in radians) */
/*        NVRT - number of vertices in polygon */
/*        XC(0:NVRT), YC(0:NVRT) - coordinates of polygon vertices in */
/*              CCW order, translated so that centroid is at origin; */
/*              (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)) */
/*        INDPVL(0:NVRT) - indices in PVL of vertices; INDPVL(I) = -K if 
*/
/*              (XC(I),YC(I)) is extra vertex inserted on edge from */
/*              K to PVL(SUCC,K) */
/*        IANG(1:*) - interior angle array */

/*     Output parameters: */
/*        I1,I2 - indices in range 0 to NVRT-1 of best separator */
/*              according to shape and max-min angle criterion; I1 = -1 */

/*              if no satisfactory separator is found */

/*     Working parameters: */
/*        WK(1:2*NVRT) - space for two working arrays of length NVRT */

/*     Abnormal return: */
/*        IERR is set to 200 */

/*     Routines called: */
/*        DIAM2, MMASEP */



/*     Determine diameter of polygon. Possible separators endpoints (two 
*/
/*     on each side of polygon) are nearest to perpendicular bisector of 
*/
/*     diameter. (XA,YA) and (XA+DX,YA+DY) are on bisector. Distance to */

/*     bisector is proportional to two times triangle area. */

    /* Parameter adjustments */
    --wk;
    --iang;

    /* Function Body */
    pimtol = gconst_1.pi - gconst_1.tol;
    n = 0;
    i__1 = *nvrt - 1;
    for (i = 0; i <= i__1; ++i) {
	k = indpvl[i];
	if (k > 0) {
	    if (iang[k] < pimtol) {
		++n;
		wk[n] = xc[i];
		wk[n + *nvrt] = yc[i];
	    }
	}
/* L10: */
    }
    diam2_(&n, &wk[1], &wk[*nvrt + 1], i1, i2, &dist);
    if (gerror_1.ierr != 0) {
	return 0;
    }
    if (*i1 > *i2) {
	i = *i1;
	*i1 = *i2;
	*i2 = i;
    }
    dx = wk[*i2 + *nvrt] - wk[*i1 + *nvrt];
    dy = wk[*i1] - wk[*i2];
    xa = (wk[*i1] + wk[*i2] - dx) * .5;
    ya = (wk[*i1 + *nvrt] + wk[*i2 + *nvrt] - dy) * .5;

    i = *i1 - 1;
L20:
    if (xc[i] == wk[*i1] && yc[i] == wk[*i1 + *nvrt]) {
	*i1 = i;
    } else {
	++i;
	goto L20;
    }
/* Computing MAX */
    i__1 = *i2 - 1, i__2 = *i1 + 1;
    i = max(i__1,i__2);
L30:
    if (xc[i] == wk[*i2] && yc[i] == wk[*i2 + *nvrt]) {
	*i2 = i;
    } else {
	++i;
	goto L30;
    }
    i = *i1 + 1;
L40:
    dist = dx * (yc[i] - ya) - dy * (xc[i] - xa);
    if (dist >= 0.) {
	v[0] = i - 1;
	v[1] = i;
    } else {
	++i;
	goto L40;
    }
    i = *i2 + 1;
L50:
    if (i >= *nvrt) {
	i = 0;
    }
    dist = dx * (yc[i] - ya) - dy * (xc[i] - xa);
    if (dist <= 0.) {
	w[0] = i - 1;
	w[1] = i;
	if (i <= 0) {
	    w[0] = *nvrt - 1;
	}
    } else {
	++i;
	goto L50;
    }
    mmasep_(angtol, xc, yc, indpvl, &iang[1], v, w, i1, i2);
} /* sepshp_ */


/*     The following code was excerpted from: sfdwmf.f */

/* Subroutine */ int sfdwmf_(l, r, psi, indp, loch)
integer *l, *r;
doublereal *psi;
integer *indp, *loch;
{
    static integer i, j, k;
    static doublereal t;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Sift PSI(INDP(L)) down heap which has maximum PSI value */

/*        at root of heap and is maintained by pointers in INDP. */

/*     Input parameters: */
/* 	 L - element of heap to be sifted down */
/*        R - upper bound of heap */
/* 	 PSI(1:*) - key values for heap */
/*        INDP(1:R) - indices of PSI which are maintained in heap */
/*        LOCH(1:*) - location of indices in heap (inverse of INDP) */

/*     Updated parameters: */
/*        INDP,LOCH */


    /* Parameter adjustments */
    --loch;
    --indp;
    --psi;

    /* Function Body */
    i = *l;
    j = i << 1;
    k = indp[i];
    t = psi[k];
L10:
    if (j > *r) {
	goto L20;
    }
    if (j < *r) {
	if (psi[indp[j]] < psi[indp[j + 1]]) {
	    ++j;
	}
    }
    if (t >= psi[indp[j]]) {
	goto L20;
    }
    indp[i] = indp[j];
    loch[indp[i]] = i;
    i = j;
    j = i << 1;
    goto L10;
L20:
    indp[i] = k;
    loch[k] = i;
} /* sfdwmf_ */


/*     The following code was excerpted from: sfupmf.f */

/* Subroutine */ int sfupmf_(r, psi, indp, loch)
integer *r;
doublereal *psi;
integer *indp, *loch;
{
    static integer i, j, k;
    static doublereal t;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Sift PSI(INDP(R)) up heap which has maximum PSI value */
/*        at root of heap and is maintained by pointers in INDP. */

/*     Input parameters: */
/* 	 R - element of heap to be sifted up */
/* 	 PSI(1:*) - key values for heap */
/*        INDP(1:R) - indices of PSI which are maintained in heap */
/*        LOCH(1:*) - location of indices in heap (inverse of INDP) */

/*     Updated parameters: */
/*        INDP,LOCH */


    /* Parameter adjustments */
    --loch;
    --indp;
    --psi;

    /* Function Body */
    i = *r;
    j = i / 2;
    k = indp[i];
    t = psi[k];
L10:
    if (i <= 1) {
	goto L20;
    }
    if (t <= psi[indp[j]]) {
	goto L20;
    }
    indp[i] = indp[j];
    loch[indp[i]] = i;
    i = j;
    j = i / 2;
    goto L10;
L20:
    indp[i] = k;
    loch[k] = i;
} /* sfupmf_ */


/*     The following code was excerpted from: trisiz.f */

/* Subroutine */ int trisiz_(ntrid, npolg, hvl, pvl, area, psi, h, indp, loch)

integer *ntrid, *npolg, *hvl, *pvl;
doublereal *area, *psi, *h;
integer *indp, *loch;
{
    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    double sqrt();

    /* Local variables */
    static integer i, j, k, l, r;
    static doublereal factor;
    extern /* Subroutine */ int sfdwmf_(), sfupmf_();
    static doublereal sum;


/*     Written and copyright by: */
/*        Barry Joe, Dept. of Computing Science, Univ. of Alberta */
/*        Edmonton, Alberta, Canada  T6G 2H1 */
/*        Phone: (403) 492-5757      Email: barry@cs.ualberta.ca */

/*     Purpose: Smooth PSI (mean mesh distribution function) values using 
*/
/*        heap so that they differ by a factor of at most 4 in adjacent */

/*        polygons and then compute triangle sizes for each polygon. */

/*     Input parameters: */
/* 	 NTRID - desired number of triangles in mesh */
/*        NPOLG - number of polygons or positions used in HVL array */
/*        HVL(1:NPOLG) - head vertex list */
/*        PVL(1:4,1:*) - polygon vertex list */
/*        AREA(1:NPOLG) - area of convex polygons in decomposition */
/*        PSI(1:NPOLG) - mean mdf values in the convex polygons */

/*     Updated parameters: */
/* 	 PSI(1:NPOLG) - values are 'smoothed' on output */

/*     Output parameters: */
/*        H(1:NPOLG) - triangle size for convex polygons */

/*     Working parameters: */
/*        INDP(1:NPOLG) - indices of polygon or PSI which are maintained 
*/
/*              in heap according to PSI values */
/*        LOCH(1:NPOLG) - location of polygon indices in heap */

/*     Routines called: */
/*        SFDWMF, SFUPMF */



    /* Parameter adjustments */
    --loch;
    --indp;
    --h;
    --psi;
    --area;
    pvl -= 5;
    --hvl;

    /* Function Body */
    factor = .25;
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
	indp[i] = i;
	loch[i] = i;
/* L10: */
    }
    k = *npolg / 2;
    for (l = k; l >= 1; --l) {
	sfdwmf_(&l, npolg, &psi[1], &indp[1], &loch[1]);
/* L20: */
    }
    for (r = *npolg; r >= 2; --r) {
	j = indp[1];
	indp[1] = indp[r];
	loch[indp[1]] = 1;
	i__1 = r - 1;
	sfdwmf_(&c__1, &i__1, &psi[1], &indp[1], &loch[1]);
	i = hvl[j];
L30:
	k = pvl[(i << 2) + 4];
	if (k > 0) {
	    k = pvl[(k << 2) + 2];
	    if (psi[k] < psi[j] * factor) {
		psi[k] = psi[j] * factor;
		sfupmf_(&loch[k], &psi[1], &indp[1], &loch[1]);
	    }
	}
	i = pvl[(i << 2) + 3];
	if (i != hvl[j]) {
	    goto L30;
	}
/* L40: */
    }

    sum = 0.;
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
	sum += psi[i] * area[i];
/* L50: */
    }
    factor = 2. / (doublereal) (*ntrid);
    i__1 = *npolg;
    for (i = 1; i <= i__1; ++i) {
	psi[i] /= sum;
	h[i] = sqrt(factor / psi[i]);
/* L60: */
    }
} /* trisiz_ */


/*     The following code was excerpted from: umdf2.f */

doublereal umdf2_(x, y)
doublereal *x, *y;
{
    /* System generated locals */
    doublereal ret_val;


/*     Purpose: Dummy user-supplied mesh distribution function which */
/*        is provided if heuristic mesh distribution function is used. */

/*     Input parameters: */
/*        X,Y - coordinates of 2-D point */

/*     Returned function value: */
/*        UMDF2 - mesh distribution function value at (X,Y) */

    ret_val = 1.;
    return ret_val;
} /* umdf2_ */

