Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
cdf_40.c
Go to the documentation of this file.00001 #include "cdflib.h"
00002 void E0000(int IENTRY,int *status,double *x,double *fx,
00003 unsigned long *qleft,unsigned long *qhi,double *zabsst,
00004 double *zabsto,double *zbig,double *zrelst,
00005 double *zrelto,double *zsmall,double *zstpmu)
00006 {
00007 #define qxmon(zx,zy,zz) (int)((zx) <= (zy) && (zy) <= (zz))
00008 static double absstp,abstol,big,fbig,fsmall,relstp,reltol,small,step,stpmul,xhi,
00009 xlb,xlo,xsave,xub,yy;
00010 static int i99999;
00011 static unsigned long qbdd,qcond,qdum1,qdum2,qincr,qlim,qok,qup;
00012 switch(IENTRY){case 0: goto DINVR; case 1: goto DSTINV;}
00013 DINVR:
00014 if(*status > 0) goto S310;
00015 qcond = !qxmon(small,*x,big);
00016 if(qcond) ftnstop(" SMALL, X, BIG not monotone in INVR");
00017 xsave = *x;
00018
00019
00020
00021 *x = small;
00022
00023
00024
00025 i99999 = 1;
00026 goto S300;
00027 S10:
00028 fsmall = *fx;
00029 *x = big;
00030
00031
00032
00033 i99999 = 2;
00034 goto S300;
00035 S20:
00036 fbig = *fx;
00037 qincr = fbig > fsmall;
00038 if(!qincr) goto S50;
00039 if(fsmall <= 0.0e0) goto S30;
00040 *status = -1;
00041 *qleft = *qhi = 1;
00042 return;
00043 S30:
00044 if(fbig >= 0.0e0) goto S40;
00045 *status = -1;
00046 *qleft = *qhi = 0;
00047 return;
00048 S40:
00049 goto S80;
00050 S50:
00051 if(fsmall >= 0.0e0) goto S60;
00052 *status = -1;
00053 *qleft = 1;
00054 *qhi = 0;
00055 return;
00056 S60:
00057 if(fbig <= 0.0e0) goto S70;
00058 *status = -1;
00059 *qleft = 0;
00060 *qhi = 1;
00061 return;
00062 S80:
00063 S70:
00064 *x = xsave;
00065 step = fifdmax1(absstp,relstp*fabs(*x));
00066
00067
00068
00069
00070 i99999 = 3;
00071 goto S300;
00072 S90:
00073 yy = *fx;
00074 if(!(yy == 0.0e0)) goto S100;
00075 *status = 0;
00076 qok = 1;
00077 return;
00078 S100:
00079 qup = qincr && yy < 0.0e0 || !qincr && yy > 0.0e0;
00080
00081
00082
00083
00084
00085 if(!qup) goto S170;
00086 xlb = xsave;
00087 xub = fifdmin1(xlb+step,big);
00088 goto S120;
00089 S110:
00090 if(qcond) goto S150;
00091 S120:
00092
00093
00094
00095 *x = xub;
00096
00097
00098
00099 i99999 = 4;
00100 goto S300;
00101 S130:
00102 yy = *fx;
00103 qbdd = qincr && yy >= 0.0e0 || !qincr && yy <= 0.0e0;
00104 qlim = xub >= big;
00105 qcond = qbdd || qlim;
00106 if(qcond) goto S140;
00107 step = stpmul*step;
00108 xlb = xub;
00109 xub = fifdmin1(xlb+step,big);
00110 S140:
00111 goto S110;
00112 S150:
00113 if(!(qlim && !qbdd)) goto S160;
00114 *status = -1;
00115 *qleft = 0;
00116 *qhi = !qincr;
00117 *x = big;
00118 return;
00119 S160:
00120 goto S240;
00121 S170:
00122
00123
00124
00125
00126
00127 xub = xsave;
00128 xlb = fifdmax1(xub-step,small);
00129 goto S190;
00130 S180:
00131 if(qcond) goto S220;
00132 S190:
00133
00134
00135
00136 *x = xlb;
00137
00138
00139
00140 i99999 = 5;
00141 goto S300;
00142 S200:
00143 yy = *fx;
00144 qbdd = qincr && yy <= 0.0e0 || !qincr && yy >= 0.0e0;
00145 qlim = xlb <= small;
00146 qcond = qbdd || qlim;
00147 if(qcond) goto S210;
00148 step = stpmul*step;
00149 xub = xlb;
00150 xlb = fifdmax1(xub-step,small);
00151 S210:
00152 goto S180;
00153 S220:
00154 if(!(qlim && !qbdd)) goto S230;
00155 *status = -1;
00156 *qleft = 1;
00157 *qhi = qincr;
00158 *x = small;
00159 return;
00160 S240:
00161 S230:
00162 dstzr(&xlb,&xub,&abstol,&reltol);
00163
00164
00165
00166
00167
00168 *status = 0;
00169 goto S260;
00170 S250:
00171 if(!(*status == 1)) goto S290;
00172 S260:
00173 dzror(status,x,fx,&xlo,&xhi,&qdum1,&qdum2);
00174 if(!(*status == 1)) goto S280;
00175
00176
00177
00178 i99999 = 6;
00179 goto S300;
00180 S280:
00181 S270:
00182 goto S250;
00183 S290:
00184 *x = xlo;
00185 *status = 0;
00186 return;
00187 DSTINV:
00188 small = *zsmall;
00189 big = *zbig;
00190 absstp = *zabsst;
00191 relstp = *zrelst;
00192 stpmul = *zstpmu;
00193 abstol = *zabsto;
00194 reltol = *zrelto;
00195 return;
00196 S300:
00197
00198
00199
00200 *status = 1;
00201 return;
00202 S310:
00203 switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S90;case
00204 4: goto S130;case 5: goto S200;case 6: goto S270;default: break;}
00205 #undef qxmon
00206 }