Doxygen Source Code Documentation
Main Page Alphabetical List Data Structures File List Data Fields Globals Search
cdf_23.c
Go to the documentation of this file.00001 #include "cdflib.h"
00002 void cdfpoi(int *which,double *p,double *q,double *s,double *xlam,
00003 int *status,double *bound)
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077 {
00078 #define tol (1.0e-8)
00079 #define atol (1.0e-50)
00080 #define inf 1.0e300
00081 static int K1 = 1;
00082 static double K2 = 0.0e0;
00083 static double K4 = 0.5e0;
00084 static double K5 = 5.0e0;
00085 static double fx,cum,ccum,pq;
00086 static unsigned long qhi,qleft,qporq;
00087 static double T3,T6,T7,T8,T9,T10;
00088
00089
00090
00091
00092
00093
00094
00095 if(!(*which < 1 || *which > 3)) goto S30;
00096 if(!(*which < 1)) goto S10;
00097 *bound = 1.0e0;
00098 goto S20;
00099 S10:
00100 *bound = 3.0e0;
00101 S20:
00102 *status = -1;
00103 return;
00104 S30:
00105 if(*which == 1) goto S70;
00106
00107
00108
00109 if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
00110 if(!(*p < 0.0e0)) goto S40;
00111 *bound = 0.0e0;
00112 goto S50;
00113 S40:
00114 *bound = 1.0e0;
00115 S50:
00116 *status = -2;
00117 return;
00118 S70:
00119 S60:
00120 if(*which == 1) goto S110;
00121
00122
00123
00124 if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
00125 if(!(*q <= 0.0e0)) goto S80;
00126 *bound = 0.0e0;
00127 goto S90;
00128 S80:
00129 *bound = 1.0e0;
00130 S90:
00131 *status = -3;
00132 return;
00133 S110:
00134 S100:
00135 if(*which == 2) goto S130;
00136
00137
00138
00139 if(!(*s < 0.0e0)) goto S120;
00140 *bound = 0.0e0;
00141 *status = -4;
00142 return;
00143 S130:
00144 S120:
00145 if(*which == 3) goto S150;
00146
00147
00148
00149 if(!(*xlam < 0.0e0)) goto S140;
00150 *bound = 0.0e0;
00151 *status = -5;
00152 return;
00153 S150:
00154 S140:
00155 if(*which == 1) goto S190;
00156
00157
00158
00159 pq = *p+*q;
00160 if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180;
00161 if(!(pq < 0.0e0)) goto S160;
00162 *bound = 0.0e0;
00163 goto S170;
00164 S160:
00165 *bound = 1.0e0;
00166 S170:
00167 *status = 3;
00168 return;
00169 S190:
00170 S180:
00171 if(!(*which == 1)) qporq = *p <= *q;
00172
00173
00174
00175
00176 if(1 == *which) {
00177
00178
00179
00180 cumpoi(s,xlam,p,q);
00181 *status = 0;
00182 }
00183 else if(2 == *which) {
00184
00185
00186
00187 *s = 5.0e0;
00188 T3 = inf;
00189 T6 = atol;
00190 T7 = tol;
00191 dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
00192 *status = 0;
00193 dinvr(status,s,&fx,&qleft,&qhi);
00194 S200:
00195 if(!(*status == 1)) goto S230;
00196 cumpoi(s,xlam,&cum,&ccum);
00197 if(!qporq) goto S210;
00198 fx = cum-*p;
00199 goto S220;
00200 S210:
00201 fx = ccum-*q;
00202 S220:
00203 dinvr(status,s,&fx,&qleft,&qhi);
00204 goto S200;
00205 S230:
00206 if(!(*status == -1)) goto S260;
00207 if(!qleft) goto S240;
00208 *status = 1;
00209 *bound = 0.0e0;
00210 goto S250;
00211 S240:
00212 *status = 2;
00213 *bound = inf;
00214 S260:
00215 S250:
00216 ;
00217 }
00218 else if(3 == *which) {
00219
00220
00221
00222 *xlam = 5.0e0;
00223 T8 = inf;
00224 T9 = atol;
00225 T10 = tol;
00226 dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10);
00227 *status = 0;
00228 dinvr(status,xlam,&fx,&qleft,&qhi);
00229 S270:
00230 if(!(*status == 1)) goto S300;
00231 cumpoi(s,xlam,&cum,&ccum);
00232 if(!qporq) goto S280;
00233 fx = cum-*p;
00234 goto S290;
00235 S280:
00236 fx = ccum-*q;
00237 S290:
00238 dinvr(status,xlam,&fx,&qleft,&qhi);
00239 goto S270;
00240 S300:
00241 if(!(*status == -1)) goto S330;
00242 if(!qleft) goto S310;
00243 *status = 1;
00244 *bound = 0.0e0;
00245 goto S320;
00246 S310:
00247 *status = 2;
00248 *bound = inf;
00249 S320:
00250 ;
00251 }
00252 S330:
00253 return;
00254 #undef tol
00255 #undef atol
00256 #undef inf
00257 }