00001 #include "cdflib.h"
00002 void E0001(int IENTRY,int *status,double *x,double *fx,
00003                   double *xlo,double *xhi,unsigned long *qleft,
00004                   unsigned long *qhi,double *zabstl,double *zreltl,
00005                   double *zxhi,double *zxlo)
00006 {
00007 #define ftol(zx) (0.5e0*fifdmax1(abstol,reltol*fabs((zx))))
00008 static double a,abstol,b,c,d,fa,fb,fc,fd,fda,fdb,m,mb,p,q,reltol,tol,w,xxhi,xxlo;
00009 static int ext,i99999;
00010 static unsigned long first,qrzero;
00011     switch(IENTRY){case 0: goto DZROR; case 1: goto DSTZR;}
00012 DZROR:
00013     if(*status > 0) goto S280;
00014     *xlo = xxlo;
00015     *xhi = xxhi;
00016     b = *x = *xlo;
00017 /*
00018      GET-FUNCTION-VALUE
00019 */
00020     i99999 = 1;
00021     goto S270;
00022 S10:
00023     fb = *fx;
00024     *xlo = *xhi;
00025     a = *x = *xlo;
00026 /*
00027      GET-FUNCTION-VALUE
00028 */
00029     i99999 = 2;
00030     goto S270;
00031 S20:
00032 /*
00033      Check that F(ZXLO) < 0 < F(ZXHI)  or
00034                 F(ZXLO) > 0 > F(ZXHI)
00035 */
00036     if(!(fb < 0.0e0)) goto S40;
00037     if(!(*fx < 0.0e0)) goto S30;
00038     *status = -1;
00039     *qleft = *fx < fb;
00040     *qhi = 0;
00041     return;
00042 S40:
00043 S30:
00044     if(!(fb > 0.0e0)) goto S60;
00045     if(!(*fx > 0.0e0)) goto S50;
00046     *status = -1;
00047     *qleft = *fx > fb;
00048     *qhi = 1;
00049     return;
00050 S60:
00051 S50:
00052     fa = *fx;
00053     first = 1;
00054 S70:
00055     c = a;
00056     fc = fa;
00057     ext = 0;
00058 S80:
00059     if(!(fabs(fc) < fabs(fb))) goto S100;
00060     if(!(c != a)) goto S90;
00061     d = a;
00062     fd = fa;
00063 S90:
00064     a = b;
00065     fa = fb;
00066     *xlo = c;
00067     b = *xlo;
00068     fb = fc;
00069     c = a;
00070     fc = fa;
00071 S100:
00072     tol = ftol(*xlo);
00073     m = (c+b)*.5e0;
00074     mb = m-b;
00075     if(!(fabs(mb) > tol)) goto S240;
00076     if(!(ext > 3)) goto S110;
00077     w = mb;
00078     goto S190;
00079 S110:
00080     tol = fifdsign(tol,mb);
00081     p = (b-a)*fb;
00082     if(!first) goto S120;
00083     q = fa-fb;
00084     first = 0;
00085     goto S130;
00086 S120:
00087     fdb = (fd-fb)/(d-b);
00088     fda = (fd-fa)/(d-a);
00089     p = fda*p;
00090     q = fdb*fa-fda*fb;
00091 S130:
00092     if(!(p < 0.0e0)) goto S140;
00093     p = -p;
00094     q = -q;
00095 S140:
00096     if(ext == 3) p *= 2.0e0;
00097     if(!(p*1.0e0 == 0.0e0 || p <= q*tol)) goto S150;
00098     w = tol;
00099     goto S180;
00100 S150:
00101     if(!(p < mb*q)) goto S160;
00102     w = p/q;
00103     goto S170;
00104 S160:
00105     w = mb;
00106 S190:
00107 S180:
00108 S170:
00109     d = a;
00110     fd = fa;
00111     a = b;
00112     fa = fb;
00113     b += w;
00114     *xlo = b;
00115     *x = *xlo;
00116 /*
00117      GET-FUNCTION-VALUE
00118 */
00119     i99999 = 3;
00120     goto S270;
00121 S200:
00122     fb = *fx;
00123     if(!(fc*fb >= 0.0e0)) goto S210;
00124     goto S70;
00125 S210:
00126     if(!(w == mb)) goto S220;
00127     ext = 0;
00128     goto S230;
00129 S220:
00130     ext += 1;
00131 S230:
00132     goto S80;
00133 S240:
00134     *xhi = c;
00135     qrzero = fc >= 0.0e0 && fb <= 0.0e0 || fc < 0.0e0 && fb >= 0.0e0;
00136     if(!qrzero) goto S250;
00137     *status = 0;
00138     goto S260;
00139 S250:
00140     *status = -1;
00141 S260:
00142     return;
00143 DSTZR:
00144     xxlo = *zxlo;
00145     xxhi = *zxhi;
00146     abstol = *zabstl;
00147     reltol = *zreltl;
00148     return;
00149 S270:
00150 /*
00151      TO GET-FUNCTION-VALUE
00152 */
00153     *status = 1;
00154     return;
00155 S280:
00156     switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S200;
00157       default: break;}
00158 #undef ftol
00159 } /* END */