00001
00002
00003
00004 #include <iostream>
00005 #include <cmath>
00006 #include <complex>
00007 #include "ucofpak_CC.h"
00008 #include "constants.h"
00009
00010 using namespace std;
00011
00012 double_complex cdgamma(double_complex Z)
00013 {
00014 double_complex CDGAMMA;
00015 double_complex U,V,H,S,FK;
00016 const double PI=4.0*atan(1.0);
00017 double G[16],X;
00018 int L;
00019
00020 G[0]=41.624436916439068;
00021 G[1]=-51.224241022374774;
00022 G[2]=+11.338755813488977;
00023 G[3]=-0.747732687772388;
00024 G[4]=+0.008782877493061;
00025 G[5]=-0.000001899030264;
00026 G[6]=+0.000000001946335;
00027 G[7]=-0.000000000199345;
00028 G[8]=+0.000000000008433;
00029 G[9]=+0.000000000001486;
00030 G[10]=-0.000000000000806;
00031 G[11]=+0.000000000000293;
00032 G[12]=-0.000000000000102;
00033 G[13]=+0.000000000000037;
00034 G[14]=-0.000000000000014;
00035 G[15]=+0.000000000000006;
00036
00037 U=Z;
00038 X=real(U);
00039
00040 V=1.0-U;
00041 L=1;
00042 if (X>=0.0)
00043 {
00044 V=U+1.0;
00045 L=2;
00046 }
00047 if (X>=1.0)
00048 {
00049 V=U;
00050 L=3;
00051 }
00052
00053 H=double_complex(1.0,0.0);
00054
00055 S=G[0];
00056 FK=0;
00057 for(int K=1;K<16;K++){
00058 FK=K-1.0;
00059 H=((V-(FK+1.0))/(V+FK))*H;
00060 S=S+G[K]*H;
00061 }
00062
00063 H=V+4.5;
00064 CDGAMMA=2.506628274631001*exp((V-0.5)*log(H)-H)*S;
00065 if(L==1){
00066 CDGAMMA=PI/(sin(PI*U)*CDGAMMA);
00067 return CDGAMMA;
00068 }
00069
00070 if(L==2){
00071 CDGAMMA=CDGAMMA/U;
00072 return CDGAMMA;
00073 }
00074 if(L==3){
00075 return CDGAMMA;
00076 }
00077 cerr<<"Should not get here"<<endl;
00078 return 0.0;
00079 }
00080
00081
00082 double_complex cdfhg(double_complex A, double_complex B, double_complex Z)
00083 {
00084
00085
00086
00087
00088
00089
00090 double_complex CDFHG;
00091 double_complex AA,ZZ,FZZ;
00092 double_complex DCON,BA,A1;
00093 double_complex CI(0.0,1.0);
00094 const int KMAX=150;
00095 const int KMAX1=20;
00096 const double TOL=2e-15;
00097 const double TOLA=2e-15;
00098
00099 const double PI=4.0*atan(1.0);
00100 int IA,IBA,N;
00101 double RZ;
00102
00103 IA=int(A.real());
00104 if(IA<=0 && abs(A-(double_complex)(IA))<TOL)
00105 {
00106 FZZ=1.0;
00107 AA=A;
00108 ZZ=Z;
00109 goto label100;
00110 }
00111
00112 IBA=int((B-A).real());
00113 if(IBA<=0 && abs(B-A-(double_complex)(IBA))<TOL)
00114 {
00115 FZZ=exp(Z);
00116 AA=B-A;
00117 ZZ=-Z;
00118 goto label100;
00119 }
00120
00121 RZ=real(Z);
00122 if(RZ>0.0)
00123 {
00124 FZZ=1.0;
00125 AA=A;
00126 ZZ=Z;
00127 }else{
00128 FZZ=exp(Z);
00129 AA=B-A;
00130 ZZ=-Z;
00131 }
00132
00133 if(abs(AA)<TOL)
00134 {
00135 CDFHG=1.0;
00136 goto label200;
00137 }
00138
00139 if(abs(AA-B)<TOL*abs(AA))
00140 {
00141 CDFHG=exp(ZZ);
00142 goto label200;
00143 }
00144
00145 if(abs(ZZ)<24.0)goto label100;
00146
00147 CDFHG=exp(ZZ)*pow(ZZ,(AA-B))*cdgamma(B)/cdgamma(AA);
00148 N=1;
00149 BA=B-AA;
00150 A1=1.0-AA;
00151 DCON=CDFHG*BA*A1/ZZ;
00152 CDFHG=CDFHG+DCON;
00153
00154 for(int K=2;K<KMAX1;K++)
00155 {
00156 N=N+1;
00157 BA=BA+1.0;
00158 A1=A1+1.0;
00159 DCON=DCON*BA*A1/((double_complex)(N)*ZZ);
00160 CDFHG=CDFHG+DCON;
00161 if(abs(DCON)<=TOLA*abs(CDFHG))goto label40;
00162 }
00163
00164 DCON=DCON*(-.5+(.125+.25*B-.5*AA+.25*(ZZ-(double_complex)(KMAX1)))/ZZ);
00165 CDFHG=CDFHG+DCON;
00166 label40:
00167
00168 DCON=exp(CI*PI*AA)/pow(ZZ,AA)*cdgamma(B)/cdgamma(B-AA);
00169 CDFHG=CDFHG+DCON;
00170 N=1;
00171 BA=1.0+AA-B;
00172 A1=AA;
00173 DCON=DCON*A1*BA/(-ZZ);
00174 CDFHG=CDFHG+DCON;
00175
00176 for(int K=2;K<KMAX1;K++)
00177 {
00178 N=N+1;
00179 BA=BA+1.0;
00180 A1=A1+1.0;
00181 DCON=DCON*BA*A1/(-(double_complex)(N)*ZZ);
00182 CDFHG=CDFHG+DCON;
00183 if(abs(DCON)<=TOLA*abs(CDFHG))goto label200;
00184 }
00185 DCON=DCON*(-1.0/3.0-B+AA+AA+ZZ-(double_complex)(KMAX1));
00186 CDFHG=CDFHG+DCON;
00187
00188 goto label200;
00189
00190 label100:
00191
00192 N=1;
00193 BA=B;
00194 A1=AA;
00195 DCON=A1*ZZ/BA;
00196 CDFHG=1.0+DCON;
00197 for(int K=2;K<KMAX;K++)
00198 {
00199 N=N+1;
00200 BA=BA+1.0;
00201 A1=A1+1.0;
00202 DCON=DCON*A1*ZZ/((double_complex)(N)*BA);
00203 CDFHG=CDFHG+DCON;
00204 if(abs(DCON)<=TOL*abs(CDFHG))goto label200;
00205 }
00206
00207 cerr<<"NO CONVERGENCE IN CDFHG"<<endl;
00208
00209 label200:
00210 CDFHG=CDFHG*FZZ;
00211 return CDFHG;
00212 }
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237