/* va04_ctffind.f -- translated by f2c (version 20100827).
   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 <wx/wx.h>
#ifdef __cplusplus
extern "C" {
#endif
#include "f2c.h"


/* Table of constant values */

static int c__1 = 1;


/* ****************************************************************************** */

/* Subroutine */ int calcfx_(int *nx, float *xpar, float *rf, float *ain,
	float *cs, float *wl, float *wgh1, float *wgh2, float *thetatr, float *
	rmin2, float *rmax2, int *nxyz, float *hw, float *dast)
{

/*     CALCULATES NEW VALUE FOR F TO INPUT TO SUBROUTINE VA04A */

/* ****************************************************************************** */



/*      RF=-EVALCTF(CS,WL,WGH1,WGH2,XPAR(1),XPAR(2),XPAR(3), */
/*     +		  THETATR,HW,AIN,NXYZ,RMIN2,RMAX2,DAST) */

    /* Parameter adjustments */
    --nxyz;
    --ain;
    --xpar;

    /* Function Body */
    *rf = (float)-1.;
    return 0;
} /* calcfx_ */

/* ************************************************************************** */
///* Subroutine */ int va04a_(real *x, real *e, integer *n, real *f, real *
//	escale, integer *iprint, integer *icon, integer *maxit, real *ain,
//	real *cs, real *wl, real *wgh1, real *wgh2, real *thetatr, real *
//	rmin2, real *rmax2, integer *nxyz, real *hw, real *dast)
//{

//int va04a_(integer *n, real *e, real *escale, int *num_function_calls, float (*target_function) (void* parameters, float[]), void *parameters, real *f,
//			integer *iprint, integer *icon, integer *maxit, real *x)
int va04a_(int *n, float *e, float *escale, int *num_function_calls, float (*target_function) (void* parameters, float[]), void *parameters, float *f,
			int *iprint, int *icon, int *maxit, float *x)

{

    /* Format strings */
    static char fmt_19[] = "(5x,\002VA04A MAXIMUM CHANGE DOES NOT ALTER FUNCTION\002)";
    static char fmt_52[] = "(/1x,\002ITERATION\002,i5,i15,\002 FUNCTION VALUES\002,10x,\002F =\002,e21.14/(5e24.14))";
    static char fmt_80[] = "(5x,\002VA04A ACCURACY LIMITED BY ERRORS IN F\002)";

    /* System generated locals */
    int i__1, i__2, maxx = 100 * *maxit;
    double r__1, r__2;

    /* Builtin functions */
    int s_wsfe(cilist *), e_wsfe();
//    double r_sign(real *, real *), sqrt(doublereal);
    int do_fio(int *, char *, ftnlen);

    /* Local variables */
    int icnt = 0;
    static double a, b, d__, xs[11];
    static int i__, j, k;
// work array w must have at least dimension n * (n + 3)
    static double w[154], da, db, fa, dd, fb, fc, dc, di, fi, dl;
    static int jj;
    static double fp;
    static int is;
    static double aaa;
    static int ind, jjj, jil, inn, ixp;
    static double tmp, sum, dacc, dmag;
    static int nfcc;
    static double dmax__, scer, ddmag, fkeep, fhold, ddmax;
    static int iline, idirn, iterc, itone;
    static double fprev;
    extern /* Subroutine */ int calcfx_(int *, float *, float *, float *,
	    float *, float *, float *, float *, float *, float *, float *, int *,
	     float *, float *);
    static int isgrad;

    /* Fortran I/O blocks */
    static cilist io___32 = { 0, 6, 0, fmt_19, 0 };
    static cilist io___42 = { 0, 6, 0, fmt_52, 0 };
    static cilist io___45 = { 0, 6, 0, fmt_80, 0 };


/* ************************************************************************** */
/*  STANDARD FORTRAN 66 (A VERIFIED PFORT SUBROUTINE) */
/* 	W[N*(N+3)] */
    /* Parameter adjustments */
    //--nxyz;
    //--ain;
    --e;
    --x;

    /* Function Body */
    ddmag = *escale * (float).1;
    scer = (float).05 / *escale;
    jj = *n * *n + *n;
    jjj = jj + *n;
    k = *n + 1;
    nfcc = 1;
    ind = 1;
    inn = 1;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; i__++) {xs[i__] = x[i__];};
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = *n;
	for (j = 1; j <= i__2; ++j) {
	    w[k - 1] = (float)0.;
	    if (i__ - j != 0) {
		goto L4;
	    } else {
		goto L3;
	    }
L3:
	    w[k - 1] = (r__1 = e[i__], dabs(r__1));
	    w[i__ - 1] = *escale;
L4:
	    ++k;
/* L2: */
	}
/* L1: */
    }
    iterc = 1;
    isgrad = 2;
    //calcfx_(n, &x[1], f, &ain[1], cs, wl, wgh1, wgh2, thetatr, rmin2, rmax2, &
	//    nxyz[1], hw, dast);
    icnt++;
	if (icnt > maxx) goto L999;
    *f = target_function(parameters, x + 1);
    fkeep = dabs(*f) + dabs(*f);
L5:
    itone = 1;
    fp = *f;
    sum = (float)0.;
    ixp = jj;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++ixp;
	w[ixp - 1] = x[i__];
/* L6: */
    }
    idirn = *n + 1;
    iline = 1;
L7:
    dmax__ = w[iline - 1];
    dacc = dmax__ * scer;
/* Computing MIN */
    r__1 = ddmag, r__2 = dmax__ * (float).1;
    dmag = dmin(r__1,r__2);
/* Computing MAX */
    r__1 = dmag, r__2 = dacc * (float)20.;
    dmag = dmax(r__1,r__2);
    ddmax = dmag * (float)10.;
    switch (itone) {
	case 1:  goto L70;
	case 2:  goto L70;
	case 3:  goto L71;
    }
L70:
    dl = (float)0.;
    d__ = dmag;
    fprev = *f;
    is = 5;
    fa = *f;
    da = dl;
L8:
    dd = d__ - dl;
    dl = d__;
L58:
    k = idirn;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] += dd * w[k - 1];
	++k;
/* L9: */
    }
    //calcfx_(n, &x[1], f, &ain[1], cs, wl, wgh1, wgh2, thetatr, rmin2, rmax2, &
	//    nxyz[1], hw, dast);
    icnt++;
	if (icnt > maxx) goto L999;
    *f = target_function(parameters, x + 1);

    ++nfcc;
    switch (is) {
	case 1:  goto L10;
	case 2:  goto L11;
	case 3:  goto L12;
	case 4:  goto L13;
	case 5:  goto L14;
	case 6:  goto L96;
    }
L14:
    if ((r__1 = *f - fa) < (float)0.) {
	goto L15;
    } else if (r__1 == 0) {
	goto L16;
    } else {
	goto L24;
    }
L16:
    if (dabs(d__) - dmax__ <= (float)0.) {
	goto L17;
    } else {
	goto L18;
    }
L17:
    d__ += d__;
    goto L8;
L18:
    //s_wsfe(&io___32);
    //e_wsfe();
	// Removed this statement since it does not seem to be very informative
    // wxPrintf("Warning(VA04): maximum change does not alter target function\n");
    goto L20;
L15:
    fb = *f;
    db = d__;
    goto L21;
L24:
    fb = fa;
    db = da;
    fa = *f;
    da = d__;
L21:
    switch (isgrad) {
	case 1:  goto L83;
	case 2:  goto L23;
    }
L23:
    d__ = db + db - da;
    is = 1;
    goto L8;
L83:
    d__ = (da + db - (fa - fb) / (da - db)) * (float).5;
    is = 4;
    if ((da - d__) * (d__ - db) >= (float)0.) {
	goto L8;
    } else {
	goto L25;
    }
L25:
    is = 1;
    if ((r__1 = d__ - db, dabs(r__1)) - ddmax <= (float)0.) {
	goto L8;
    } else {
	goto L26;
    }
L26:
    r__1 = db - da;
    d__ = db + copysign(ddmax, r__1); //d__ = db + r_sign(&ddmax, &r__1);
    is = 1;
    ddmax += ddmax;
    ddmag += ddmag;
    if (ddmax - dmax__ <= (float)0.) {
	goto L8;
    } else {
	goto L27;
    }
L27:
    ddmax = dmax__;
    goto L8;
L13:
    if (*f - fa >= (float)0.) {
	goto L23;
    } else {
	goto L28;
    }
L28:
    fc = fb;
    dc = db;
L29:
    fb = *f;
    db = d__;
    goto L30;
L12:
    if (*f - fb <= (float)0.) {
	goto L28;
    } else {
	goto L31;
    }
L31:
    fa = *f;
    da = d__;
    goto L30;
L11:
    if (*f - fb >= (float)0.) {
	goto L10;
    } else {
	goto L32;
    }
L32:
    fa = fb;
    da = db;
    goto L29;
L71:
    dl = (float)1.;
    ddmax = (float)5.;
    fa = fp;
    da = (float)-1.;
    fb = fhold;
    db = (float)0.;
    d__ = (float)1.;
L10:
    fc = *f;
    dc = d__;
L30:
    a = (db - dc) * (fa - fc);
    b = (dc - da) * (fb - fc);
    if ((a + b) * (da - dc) <= (float)0.) {
	goto L33;
    } else {
	goto L34;
    }
L33:
    fa = fb;
    da = db;
    fb = fc;
    db = dc;
    goto L26;
L34:
    d__ = (a * (db + dc) + b * (da + dc)) * (float).5 / (a + b);
    di = db;
    fi = fb;
    if (fb - fc <= (float)0.) {
	goto L44;
    } else {
	goto L43;
    }
L43:
    di = dc;
    fi = fc;
L44:
    switch (itone) {
	case 1:  goto L86;
	case 2:  goto L86;
	case 3:  goto L85;
    }
L85:
    itone = 2;
    goto L45;
L86:
    if ((r__1 = d__ - di, dabs(r__1)) - dacc <= (float)0.) {
	goto L41;
    } else {
	goto L93;
    }
L93:
    if ((r__1 = d__ - di, dabs(r__1)) - dabs(d__) * (float).03 <= (float)0.) {
	goto L41;
    } else {
	goto L45;
    }
L45:
    if ((da - dc) * (dc - d__) >= (float)0.) {
	goto L46;
    } else {
	goto L47;
    }
L46:
    fa = fb;
    da = db;
    fb = fc;
    db = dc;
    goto L25;
L47:
    is = 2;
    if ((db - d__) * (d__ - dc) >= (float)0.) {
	goto L8;
    } else {
	goto L48;
    }
L48:
    is = 3;
    goto L8;
L41:
    *f = fi;
    d__ = di - dl;
    dd = sqrt((dc - db) * (dc - da) * (da - db) / (a + b));
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	x[i__] += d__ * w[idirn - 1];
	w[idirn - 1] = dd * w[idirn - 1];
	++idirn;
/* L49: */
    }
    if (dd == (float)0.) {
	dd = (float)1e-10;
    }
    w[iline - 1] /= dd;
    ++iline;
    if (*iprint - 1 != 0) {
	goto L51;
    } else {
	goto L50;
    }
L50:
    switch (*iprint) {
	case 1:  goto L51;
	case 2:  goto L53;
    }
L51:
    switch (itone) {
	case 1:  goto L55;
	case 2:  goto L38;
    }
L55:
    if (fprev - *f - sum >= (float)0.) {
	goto L95;
    } else {
	goto L94;
    }
L95:
    sum = fprev - *f;
    jil = iline;
L94:
    if (idirn - jj <= 0) {
	goto L7;
    } else {
	goto L84;
    }
L84:
    switch (ind) {
	case 1:  goto L92;
	case 2:  goto L72;
    }
L92:
    fhold = *f;
    is = 6;
    ixp = jj;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++ixp;
	w[ixp - 1] = x[i__] - w[ixp - 1];
/* L59: */
    }
    dd = (float)1.;
    goto L58;
L96:
    switch (ind) {
	case 1:  goto L112;
	case 2:  goto L87;
    }
L112:
    if (fp - *f <= (float)0.) {
	goto L37;
    } else {
	goto L91;
    }
L91:
/* Computing 2nd power */
    r__1 = fp - *f;
    d__ = (fp + *f - fhold * (float)2.) * (float)2. / (r__1 * r__1);
/* Computing 2nd power */
    r__1 = fp - fhold - sum;
    if (d__ * (r__1 * r__1) - sum >= (float)0.) {
	goto L37;
    } else {
	goto L87;
    }
L87:
    j = jil * *n + 1;
    if (j - jj <= 0) {
	goto L60;
    } else {
	goto L61;
    }
L60:
    i__1 = jj;
    for (i__ = j; i__ <= i__1; ++i__) {
	k = i__ - *n;
	w[k - 1] = w[i__ - 1];
/* L62: */
    }
    i__1 = *n;
    for (i__ = jil; i__ <= i__1; ++i__) {
	w[i__ - 2] = w[i__ - 1];
/* L97: */
    }
L61:
    idirn -= *n;
    itone = 3;
    k = idirn;
    ixp = jj;
    aaa = (float)0.;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++ixp;
	w[k - 1] = w[ixp - 1];
	if (aaa - (r__1 = w[k - 1] / e[i__], dabs(r__1)) >= (float)0.) {
	    goto L67;
	} else {
	    goto L66;
	}
L66:
	aaa = (r__1 = w[k - 1] / e[i__], dabs(r__1));
L67:
	++k;
/* L65: */
    }
    ddmag = (float)1.;
    if (aaa == (float)0.) {
	aaa = (float)1e-10;
    }
    w[*n - 1] = *escale / aaa;
    iline = *n;
    goto L7;
L37:
    ixp = jj;
    aaa = (float)0.;
    *f = fhold;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++ixp;
	x[i__] -= w[ixp - 1];
	if (aaa * (r__1 = e[i__], dabs(r__1)) - (r__2 = w[ixp - 1], dabs(r__2)
		) >= (float)0.) {
	    goto L99;
	} else {
	    goto L98;
	}
L98:
	aaa = (r__1 = w[ixp - 1] / e[i__], dabs(r__1));
L99:
	;
    }
    goto L72;
L38:
    aaa *= di + (float)1.;
    switch (ind) {
	case 1:  goto L72;
	case 2:  goto L106;
    }
L72:
    if (*iprint - 2 >= 0) {
	goto L50;
    } else {
	goto L53;
    }
L53:
    switch (ind) {
	case 1:  goto L109;
	case 2:  goto L88;
    }
L109:
    if (aaa - (float).1 <= (float)0.) {
	goto L89;
    } else {
	goto L76;
    }
L89:
    switch (*icon) {
	case 1:  goto L20;
	case 2:  goto L116;
    }
L116:
    ind = 2;
    switch (inn) {
	case 1:  goto L100;
	case 2:  goto L101;
    }
L100:
    inn = 2;
    k = jjj;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++k;
	w[k - 1] = x[i__];
	x[i__] += e[i__] * (float)10.;
/* L102: */
    }
    fkeep = *f;
    //calcfx_(n, &x[1], f, &ain[1], cs, wl, wgh1, wgh2, thetatr, rmin2, rmax2, &
	//    nxyz[1], hw, dast);
    icnt++;
	if (icnt > maxx) goto L999;
    *f = target_function(parameters, x + 1);
    ++nfcc;
    ddmag = (float)0.;
    goto L108;
L76:
    if (*f - fp >= (float)0.) {
	goto L78;
    } else {
	goto L35;
    }
L78:
    //s_wsfe(&io___45);
    //e_wsfe();
	// Removed this statement since it does not seem to be very informative
    // wxPrintf("Warning(VA04): accuracy limited by errors in target function\n");
    goto L20;
L88:
    ind = 1;
L35:
    tmp = fp - *f;
    if (tmp > (float)0.) {
	ddmag = sqrt(tmp) * (float).4;
    } else {
	ddmag = (float)0.;
    }
    isgrad = 1;
L108:
    ++iterc;
    if (iterc - *maxit <= 0) {
	goto L5;
    } else {
	goto L81;
    }
L81:
/*   81 WRITE(6,82) MAXIT */
/* L82: */
    if (*f - fkeep <= (float)0.) {
	goto L20;
    } else {
	goto L110;
    }
L110:
    *f = fkeep;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++jjj;
	x[i__] = w[jjj - 1];
/* L111: */
    }
    goto L20;
L101:
    jil = 1;
    fp = fkeep;
    if ((r__1 = *f - fkeep) < (float)0.) {
	goto L105;
    } else if (r__1 == 0) {
	goto L78;
    } else {
	goto L104;
    }
L104:
    jil = 2;
    fp = *f;
    *f = fkeep;
L105:
    ixp = jj;
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	++ixp;
	k = ixp + *n;
	switch (jil) {
	    case 1:  goto L114;
	    case 2:  goto L115;
	}
L114:
	w[ixp - 1] = w[k - 1];
	goto L113;
L115:
	w[ixp - 1] = x[i__];
	x[i__] = w[k - 1];
L113:
	;
    }
    jil = 2;
    goto L92;
L106:
    if (aaa - (float).1 <= (float)0.) {
	goto L20;
    } else {
	goto L107;
    }
L20:
    return 0;
L107:
    inn = 1;
    goto L35;
L999:
	for (i__ = 1; i__ <= i__1; i__++) {x[i__] = xs[i__];};
    *f = target_function(parameters, x + 1);
	// Removed this statement since it does not seem to be very informative
    // wxPrintf("Warning(VA04): Endless loop safety catch, icnt = %i\n", icnt);
    return 0;
} /* va04a_ */

#ifdef __cplusplus
	}
#endif
