double dmvt(const unsigned int n, const gsl_vector *x, const gsl_vector *location, const gsl_matrix *scale, const unsigned int dof) { int s; double ax,ay,az=0.5*(dof + n); gsl_vector *ym, *xm; gsl_matrix *work = gsl_matrix_alloc(n,n), *winv = gsl_matrix_alloc(n,n); gsl_permutation *p = gsl_permutation_alloc(n); gsl_matrix_memcpy( work, scale ); gsl_linalg_LU_decomp( work, p, &s ); gsl_linalg_LU_invert( work, p, winv ); ax = gsl_linalg_LU_det( work, s ); gsl_matrix_free( work ); gsl_permutation_free( p ); xm = gsl_vector_alloc(n); gsl_vector_memcpy( xm, x); gsl_vector_sub( xm, location ); ym = gsl_vector_alloc(n); gsl_blas_dsymv(CblasUpper,1.0,winv,xm,0.0,ym); gsl_matrix_free( winv ); gsl_blas_ddot( xm, ym, &ay); gsl_vector_free(xm); gsl_vector_free(ym); ay = pow((1+ay/dof),-az)*gsl_sf_gamma(az)/(gsl_sf_gamma(0.5*dof)*sqrt( pow((dof*M_PI),double(n))*ax )); return ay; }
scalar sasfit_ff_gauss_generalized_3(scalar q, sasfit_param * param) { scalar u,i0, v, na, beta; SASFIT_ASSERT_PTR(param); SASFIT_CHECK_COND1((q < 0.0), param, "q(%lg) < 0",q); SASFIT_CHECK_COND1((RG <= 0.0), param, "RG(%lg) < 0",RG); SASFIT_CHECK_COND1((NU <= 0.0), param, "nu(%lg) <= 0",NU); SASFIT_CHECK_COND1((NU > 1.0), param, "nu(%lg) > 1",NU); u = (2.0*NU+1.0)*(2.0*NU+2.0)*q*q*RG*RG/6.0; na = 6.0221415e23; v = MW/RHO_P/na; beta = B_P - v*ETA_S; i0 = beta*beta; if (q*RG<0.1) return i0*exp(-q*q*RG*RG/3); // if (u>1000.0){ // return i0*( // gsl_sf_gamma(1.0/(2.*NU))/(NU*pow(u,1.0/(2.0*NU))) // - gsl_sf_gamma(1.0/NU) /(NU*pow(u,1.0/NU)) // ); // } else { return i0* (pow(u,1/(2.*NU)) * gsl_sf_gamma(1.0/(2.*NU)) - gsl_sf_gamma(1.0/NU) - pow(u,1/(2.*NU)) * gsl_sf_gamma_inc(1.0/(2.*NU),u) + gsl_sf_gamma_inc(1.0/NU,u) )/(NU*pow(u,1/NU)); // } }
double Anl_tilde(int n ,int l){ double K_nl, factor, A_nl; double gamma_factor; K_nl = 0.5*n*(n+4.*l+3.) + (l+1.)*(2.*l+1.); factor = pow(2,8.*l+6.) / (4.*M_PI*K_nl); gamma_factor = pow(gsl_sf_gamma(2.0*l+1.5),2)/gsl_sf_gamma(n+4.*l+3.); A_nl =-factor* gsl_sf_fact(n)*(n+2.*l+1.5)*gamma_factor; return A_nl; }
scalar sasfit_peak_pearsonVII_area(scalar x, sasfit_param * param) { scalar z,a0; SASFIT_ASSERT_PTR( param ); SASFIT_CHECK_COND1((WIDTH <= 0), param, "width(%lg) <= 0",WIDTH); SASFIT_CHECK_COND1((SHAPE <= .5), param, "shape(%lg) <= 1/2",SHAPE); z = (x-CENTER)/WIDTH; a0 = AREA*SHAPE*gsl_sf_gamma(SHAPE)*sqrt((pow(2.,1./SHAPE)-1.)/SHAPE) / (WIDTH*sqrt(M_PI*SHAPE)*gsl_sf_gamma(SHAPE-0.5)); return BACKGR+a0/pow(1.+4.*z*z*(pow(2,1./SHAPE)-1),SHAPE); }
scalar sasfit_peak_PearsonVIIArea(scalar x, sasfit_param * param) { scalar z; scalar bckgr, a0, area, center, width, shape; SASFIT_ASSERT_PTR( param ); sasfit_get_param(param, 5, &area, ¢er, &width, &shape, &bckgr); SASFIT_CHECK_COND1((width <= 0), param, "width(%lg) <= 0",width); SASFIT_CHECK_COND1((shape <= .5), param, "shape(%lg) <= 1/2",shape); z = (x-center)/width; a0 = area*shape*gsl_sf_gamma(shape)*sqrt((pow(2.,1./shape)-1.)/shape) / (width*sqrt(M_PI*shape)*gsl_sf_gamma(shape-0.5)); return bckgr+a0/pow(1.+4.*z*z*(pow(2,1./shape)-1),shape); }
// ../src/tools/tools__gamma_function.cpp =================================================== // // // Catalyst Lib is free software: you can redistribute it and/or modifyit under the terms of // the GNU General Public License as published bythe Free Software Foundation, either version // 3 of the License, or(at your option) any later version. // // Catalyst Lib is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; // without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. // See the GNU General Public License for more details. // // You should have received a copy of the GNU General Public License along with Catalyst Lib. // If not, see <http://www.gnu.org/licenses/>. // // ========================================================================================== // // // // /// @param [in] a A real number, where @f$ 0.0 < a \leq 171.0 @f$. // /// @brief Calls the GSL library to calculate the value of the gamma function. // /// @return @f$ \Gamma(a) \equiv (a - 1)! @f$. If @f$ a @f$ is out of range, /// the function returns zero. // /// @cite gsl // inline double gamma_function(const double &a) { switch(a <= 0.0 or a > GSL_SF_GAMMA_XMAX) { case false: return gsl_sf_gamma(a); break; case true: return 0.0; break; } };
double mv_gamma(double a, double d){ double val = 1.0; int i; for(i = 1; i <= d; i++){ val *= gsl_sf_gamma(a - (0.5 * (i - 1))); } val *= pow(M_PI, (d * (d - 1) / 4.0)); return(val); }
//-------------------------------------------------------------------------------------------------- double matern_kernel( const double& h, const double& v, const double& sigma, const double& theta ) { double H = sqrt( v ) * h / theta; if ( H > 0 ) { return sigma * sigma * 2 * pow( H, v ) * gsl_sf_bessel_Knu( v, 2 * H ) / gsl_sf_gamma( v ); } else { return 1.0; } }
/** * form factor of a mass fractal consisting of spheres with a radius R, a * fractal dimesnion of D, a cut-off length of xi and a scattering length * density eta */ scalar sasfit_sq_MassFractalGaussianCutOff(scalar q, sasfit_param * param) { scalar P16, r0, xi, D; int status; gsl_sf_result pFq_1F1; SASFIT_ASSERT_PTR( param ); sasfit_get_param(param, 3, &r0, &xi, &D); gsl_set_error_handler_off(); SASFIT_CHECK_COND1((q < 0.0), param, "q(%lg) < 0",q); SASFIT_CHECK_COND1((r0 <= 0.0), param, "r0(%lg) <= 0",r0); SASFIT_CHECK_COND2((xi < r0), param, "xi(%lg) < r0(%lg)",xi,r0); SASFIT_CHECK_COND1((D <= 1.0), param, "D(%lg) <= 1",D); if ((xi == 0) || (r0 == 0)) { return 1.0; } P16 = gsl_sf_gamma(D/2.)*D/2.; P16 = P16*pow(xi/r0,D); status = gsl_sf_hyperg_1F1_e(D/2.,1.5,-0.25*pow(q*xi,2.),&pFq_1F1); if (status && (q*xi >= 10)) { pFq_1F1.val = (sqrt(M_PI)*(pow(2.,D)/(pow(q,D)*pow(pow(xi,2),D/2.)*gsl_sf_gamma(1.5 - D/2.)) + (pow(4,1.5 - D/2.)*pow(q,-3 + D)*pow(-pow(xi,2),-1.5 + D/2.))/ (exp((pow(q,2)*pow(xi,2))/4.)*gsl_sf_gamma(D/2.))))/2. ; // gsl_sf_gamma(1.5)/gsl_sf_gamma(1.5-D/2.0)*pow(0.25*pow(q*xi,2.),D/2.); } else if (status && (q*xi < 10)) { sasfit_param_set_err(param, DBGINFO("%s,q=%lf"), gsl_strerror(status), q); return SASFIT_RETURNVAL_ON_ERROR; } else { return 1.0+P16*pFq_1F1.val; } return P16; }
scalar sasfit_peak_GeneralizedGaussian1Area(scalar x, sasfit_param * param) { scalar z, a0; SASFIT_ASSERT_PTR( param ); SASFIT_CHECK_COND1((SCALE <= 0.0), param, "alpha(%lg) <= 0",SCALE); SASFIT_CHECK_COND1((SHAPE <= 0.0), param, "beta(%lg) <= 0",SHAPE); a0 = AREA*SHAPE/(2.*SCALE*gsl_sf_gamma(1./SHAPE)); z = (fabs(x-LOCATION)/SCALE); return BCKGR+a0*exp(-pow(z,SHAPE)); }
// Returns point where 0.999 of integral of p(a,t) double site::solve_patchage_dist(double site_mean) { switch(type){ default:case(0): // Single patch return 0.0; case(1): // Weibull distribution a_mean = site_mean; // Solve lam as function of site average patch age lam = pow(gsl_sf_gamma(1.0/psi)/psi/a_mean, psi); // Solve for density age zero p0 = psi*pow(lam, 1.0/psi)/gsl_sf_gamma(1.0/psi); return 2.633*a_mean /3.0*4.0; case(2): // Exponential distribution a_mean = site_mean; // Solve lam as function of site average patch age p0 = lam = 1.0/site_mean; return -log(0.0001)/lam; } return 0.0; }
double ran_mv_t_pdf(const gsl_vector *x, const gsl_vector *mu, const gsl_matrix *Sigma, const double nu) { const int k = x->size; int s; double det,temp, den; gsl_vector *y = gsl_vector_alloc(k); gsl_vector *work_k = gsl_vector_alloc(k); gsl_matrix *work_k_k = gsl_matrix_alloc(k, k); gsl_matrix *Sigmainv = gsl_matrix_alloc(k, k); gsl_permutation *p = gsl_permutation_alloc(k); gsl_vector_memcpy(y, x); gsl_vector_sub(y, mu); gsl_matrix_memcpy(work_k_k, Sigma); gsl_linalg_LU_decomp(work_k_k, p, &s); gsl_linalg_LU_invert(work_k_k, p, Sigmainv); det = gsl_linalg_LU_det(work_k_k, s); gsl_blas_dgemv(CblasNoTrans, 1.0/k, Sigmainv, y, 0.0, work_k); gsl_blas_ddot(y, work_k, &temp); temp = pow((1+temp), (nu+ (double) k)/2 ); temp *= gsl_sf_gamma(nu/2) * pow(nu, k/2) * pow(M_PI, k/2) * sqrt(det); den = gsl_sf_gamma((nu+ (double) k)/2); den /= temp; gsl_vector_free(y); gsl_vector_free(work_k); gsl_matrix_free(work_k_k); gsl_matrix_free(Sigmainv); gsl_permutation_free(p); return den; }
double sf_mv_gamma(const double x, const int p) { double v; int i; v = pow(M_PI, p*(p-1)/4); for (i=0; i<p; i++) { v *= gsl_sf_gamma(x+(1-i)/2); } return v; }
int Gamma_cal (double k, void *p) // calculate the value of \Gamma(k/2), which will be used by error.c { struct my_params *fp=(struct my_params *)p; //double k=63.0; //double k=64.0; //printf("k is: %lf\n", k); //printf("Gamma(k/2) is: %e\n", gsl_sf_gamma (k/2.0)); fp->a=k; fp->b=gsl_sf_gamma (k/2.0); //printf ("Gamma_cal: %lf %lf\n", fp->a, fp->b); //(*Gamma)=gsl_sf_gamma (k/2.0); return 0; }
double mle_gamma_val(const vector<double>& data, double *k, double *theta) { double s1 = 0.0, s2 = 0.0, s3 = 0.0; for (unsigned int i = 1; i < data.size(); i++) { s1 += data[i]; s2 += i * data[i]; s3 += log(i) * data[i]; } // double s1 = s2 = s3 = 0.0: double c = log(s2) - log(s1) - s3 / s1; *k = gamma_solver(c); *theta = s2 / (*k * s1); return (*k - 1) * s3 - 1.0 / *theta * s2 - *k * log(*theta) * s1 - log(gsl_sf_gamma(*k)) * s1; // return (*k - 1) * s3 - *k * s1 - *k * log(s2 / (*k * s1)) - s1 * log(gsl_sf_gamma(*k)); //return 5; }
// volume of unit ball in n-dim space double volume(int dim) { return pow(M_PI,dim/2.)/gsl_sf_gamma(dim/2.+1); }
long double tgamma(long double z) { return gsl_sf_gamma(z); }
float tgamma(float z) { return (float)gsl_sf_gamma(z); }
//------------------------------------------------------------------------------ /// Gamma function \f$ \Gamma(x) \f$ inline double gamma(const double x) { return gsl_sf_gamma(x); }
double gsl_sf_fact(double x){ return gsl_sf_gamma(x+1.0); }
/* Special Functions */ double FC_FUNC_(oct_gamma, OCT_GAMMA) (const double *x) { return gsl_sf_gamma(*x); }
scalar sasfit_peak_inverted_gamma_area(scalar x, sasfit_param * param) { scalar z,u; SASFIT_ASSERT_PTR( param ); SASFIT_CHECK_COND1((WIDTH <= 0), param, "width(%lg) <= 0",WIDTH); SASFIT_CHECK_COND1((SHAPE <= 0), param, "shape(%lg) <= 0",SHAPE); u = SHAPE*x+x+WIDTH-CENTER*SHAPE-CENTER; z = x-CENTER; if (u <= 0) return BACKGR; return BACKGR+AREA*(SHAPE+1.)*exp(-WIDTH*(SHAPE+1.)/u)*pow(WIDTH*(SHAPE+1.)/u,SHAPE)/u/gsl_sf_gamma(SHAPE); }
/// Returns the integral of the weight function double Laguerre::weightIntegral() const { return gsl_sf_gamma( getParameter("Alpha") + 1.0 ); }
double ho_A (int n, int l, double b) { return sqrt (2. * gsl_sf_fact ((unsigned) (n - 1)) / (b * gsl_sf_gamma ((double)n + (double)l + 1. / 2.))); }
// Uses a variant of the bounded harmonic mean approximation to determine the evidence. // Essentially, the regulator chosen is an ellipsoid with radius nsigma standard deviations // along each principal axis. The regulator is then 1/V inside the ellipsoid and 0 without, // where V is the volume of the ellipsoid. In this form, the harmonic mean approximation // has finite variance. See Gelfand & Dey (1994) and Robert & Wraith (2009) for details. double TChain::get_ln_Z_harmonic(bool use_peak, double nsigma_max, double nsigma_peak, double chain_frac) const { // Get the covariance and determinant of the chain gsl_matrix* Sigma = gsl_matrix_alloc(N, N); gsl_matrix* invSigma = gsl_matrix_alloc(N, N); double detSigma; stats.get_cov_matrix(Sigma, invSigma, &detSigma); // Determine the center of the prior volume to use double* mu = new double[N]; if(use_peak) { // Use the peak density as the center find_center(mu, Sigma, invSigma, &detSigma, nsigma_peak, 5); //density_peak(mu, nsigma_peak); } else { // Get the mean from the stats class for(unsigned int i=0; i<N; i++) { mu[i] = stats.mean(i); } } // Sort elements in chain by distance from center, filtering out values of L which are not finite std::vector<TChainSort> sorted_indices; sorted_indices.reserve(length); unsigned int filt_length = 0; for(unsigned int i=0; i<length; i++) { if(!(isnan(L[i]) || is_inf_replacement(L[i]))) { TChainSort tmp_el; tmp_el.index = i; tmp_el.dist2 = metric_dist2(invSigma, get_element(i), mu, N); sorted_indices.push_back(tmp_el); filt_length++; } } unsigned int npoints = (unsigned int)(chain_frac * (double)filt_length); std::partial_sort(sorted_indices.begin(), sorted_indices.begin() + npoints, sorted_indices.end()); // Determine <1/L> inside the prior volume double sum_invL = 0.; double tmp_invL; double nsigma = sqrt(sorted_indices[npoints-1].dist2); unsigned int tmp_index = sorted_indices[0].index;; double L_0 = L[tmp_index]; //std::cout << "index_0 = " << sorted_indices[0].index << std::endl; for(unsigned int i=0; i<npoints; i++) { if(sorted_indices[i].dist2 > nsigma_max * nsigma_max) { nsigma = nsigma_max; break; } tmp_index = sorted_indices[i].index; tmp_invL = w[tmp_index] / exp(L[tmp_index] - L_0); //std::cout << w[tmp_index] << ", " << L[tmp_index] << std::endl; //if(isnan(tmp_invL)) { // std::cout << "\t\tL, L_0 = " << L[tmp_index] << ", " << L_0 << std::endl; //} if((tmp_invL + sum_invL > 1.e100) && (i != 0)) { nsigma = sqrt(sorted_indices[i-1].dist2); break; } sum_invL += tmp_invL; } // Determine the volume normalization (the prior volume) double V = sqrt(detSigma) * 2. * pow(SQRTPI * nsigma, (double)N) / (double)(N) / gsl_sf_gamma((double)(N)/2.); // Return an estimate of ln(Z) double lnZ = log(V) - log(sum_invL) + log(total_weight) + L_0; if(isnan(lnZ)) { std::cout << std::endl; std::cout << "NaN Error! lnZ = " << lnZ << std::endl; std::cout << "\tsum_invL = e^(" << -L_0 << ") * " << sum_invL << " = " << exp(-L_0) * sum_invL << std::endl; std::cout << "\tV = " << V << std::endl; std::cout << "\ttotal_weight = " << total_weight << std::endl; std::cout << std::endl; } else if(is_inf_replacement(lnZ)) { std::cout << std::endl; std::cout << "inf Error! lnZ = " << lnZ << std::endl; std::cout << "\tsum_invL = e^(" << -L_0 << ") * " << sum_invL << " = " << exp(-L_0) * sum_invL << std::endl; std::cout << "\tV = " << V << std::endl; std::cout << "\ttotal_weight = " << total_weight << std::endl; std::cout << "\tnsigma = " << nsigma << std::endl; std::cout << "\tIndex\tDist^2:" << std::endl; for(unsigned int i=0; i<10; i++) { std::cout << sorted_indices[i].index << "\t\t" << sorted_indices[i].dist2 << std::endl; std::cout << " "; const double *tmp_x = get_element(sorted_indices[i].index); for(unsigned int k=0; k<N; k++) { std::cout << " " << tmp_x[k]; } std::cout << std::endl; } std::cout << "mu ="; for(unsigned int i=0; i<N; i++) { std::cout << " " << mu[i]; } std::cout << std::endl; } // Cleanup gsl_matrix_free(Sigma); gsl_matrix_free(invSigma); delete[] mu; return lnZ; }
void vHRedLinearLogLike(double *Cube, int &ndim, int &npars, double &lnew, void *context) { int numfit=((MNStruct *)context)->numFitTiming + ((MNStruct *)context)->numFitJumps+1; double Fitparams[numfit]; double *EFAC; double EQUAD, redamp, redalpha; int pcount=0; // printf("here1\n"); for(int p=0;p<ndim;p++){ // printf("param %i %g %g\n",p,((MNStruct *)context)->Dpriors[p][0],((MNStruct *)context)->Dpriors[p][1]); Cube[p]=(((MNStruct *)context)->Dpriors[p][1]-((MNStruct *)context)->Dpriors[p][0])*Cube[p]+((MNStruct *)context)->Dpriors[p][0]; } // printf("here1.5\n"); for(int p=0;p < numfit; p++){ Fitparams[p]=Cube[p]; pcount++; // printf("param: %i %g \n",p,Fitparams[p]); } if(((MNStruct *)context)->numFitEFAC == 0){ EFAC=new double[1]; EFAC[0]=1; // } else if(((MNStruct *)context)->numFitEFAC == 1){ EFAC=new double[1]; EFAC[0]=Cube[pcount]; pcount++; } else if(((MNStruct *)context)->numFitEFAC > 1){ EFAC=new double[((MNStruct *)context)->numFitEFAC]; for(int p=0;p< ((MNStruct *)context)->numFitEFAC; p++){ EFAC[p]=Cube[pcount]; pcount++; } } if(((MNStruct *)context)->numFitEQUAD == 0){ EQUAD=0; // printf("EQUAD: %g \n",EQUAD); } else{ EQUAD=pow(10.0,2*Cube[pcount]); pcount++; // printf("E: %g %g \n",EQUAD,EFAC[0]); } redamp=Cube[pcount]; pcount++; redalpha=Cube[pcount]; pcount++; double *Fitvec=new double[((MNStruct *)context)->pulse->nobs]; double *Diffvec=new double[((MNStruct *)context)->pulse->nobs]; dgemv(((MNStruct *)context)->DMatrix,Fitparams,Fitvec,((MNStruct *)context)->pulse->nobs,numfit,'N'); for(int o=0;o<((MNStruct *)context)->pulse->nobs; o++){ Diffvec[o]=((MNStruct *)context)->pulse->obsn[o].residual-Fitvec[o]; } double secday=24*60*60; double LongestPeriod=1.0/pow(10.0,-5); double flo=1.0/LongestPeriod; double modelalpha=redalpha; double gwamp=pow(10.0,redamp); double gwampsquared=gwamp*gwamp*(pow((365.25*secday),2)/(12*M_PI*M_PI))*(pow(365.25,(1-modelalpha)))/(pow(flo,(modelalpha-1))); double timdiff=0; double covconst=gsl_sf_gamma(1-modelalpha)*sin(0.5*M_PI*modelalpha); // printf("constants: %g %g \n",gwampsquared,covconst); double **CovMatrix = new double*[((MNStruct *)context)->pulse->nobs]; for(int o1=0;o1<((MNStruct *)context)->pulse->nobs;o1++)CovMatrix[o1]=new double[((MNStruct *)context)->pulse->nobs]; for(int o1=0;o1<((MNStruct *)context)->pulse->nobs; o1++){ for(int o2=0;o2<((MNStruct *)context)->pulse->nobs; o2++){ timdiff=((MNStruct *)context)->pulse->obsn[o1].bat-((MNStruct *)context)->pulse->obsn[o2].bat; double tau=2.0*M_PI*fabs(timdiff); double covsum=0; for(int k=0; k <=10; k++){ covsum=covsum+pow(-1.0,k)*(pow(flo*tau,2*k))/(iter_factorial(2*k)*(2*k+1-modelalpha)); } CovMatrix[o1][o2]=gwampsquared*(covconst*pow((flo*tau),(modelalpha-1)) - covsum); // printf("%i %i %g %g %g\n",o1,o2,CovMatrix[o1][o2],fabs(timdiff),covsum); if(o1==o2){ CovMatrix[o1][o2] += pow(((((MNStruct *)context)->pulse->obsn[o1].toaErr)*pow(10.0,-6))*EFAC[((MNStruct *)context)->sysFlags[o1]],2) + EQUAD; } } } double covdet=0; double *WorkDiffvec = new double[((MNStruct *)context)->pulse->nobs]; for(int o1=0;o1<((MNStruct *)context)->pulse->nobs; o1++){ WorkDiffvec[o1]=Diffvec[o1]; } dpotrf(CovMatrix, ((MNStruct *)context)->pulse->nobs, covdet); dpotrs(CovMatrix, WorkDiffvec, ((MNStruct *)context)->pulse->nobs); double Chisq=0; for(int o1=0;o1<((MNStruct *)context)->pulse->nobs; o1++){ Chisq += Diffvec[o1]*WorkDiffvec[o1]; } if(isnan(covdet) || isinf(covdet) || isnan(Chisq) || isinf(Chisq)){ lnew=-pow(10.0,200); // printf("red amp and alpha %g %g\n",redamp,redalpha); // printf("Like: %g %g %g \n",lnew,Chisq,covdet); } else{ lnew = -0.5*(((MNStruct *)context)->pulse->nobs*log(2*M_PI) + covdet + Chisq); // printf("red amp and alpha %g %g\n",redamp,redalpha); } // endClock = clock(); // // printf("Finishing off: time taken = %.2f (s)\n",(endClock-startClock)/(float)CLOCKS_PER_SEC); delete[] EFAC; for(int o=0;o<((MNStruct *)context)->pulse->nobs;o++){delete[] CovMatrix[o];} delete[] CovMatrix; delete[] WorkDiffvec; delete[] Diffvec; delete[] Fitvec; printf("Like: %g %g %g \n",lnew,Chisq,covdet); }
// ############################################ // Function to calculate vacuum matching matrix // ############################################ void Thawc::Vacuum (int interactive) { // Calculate vacuum matrix Couple (1.); gsl_matrix *Mat = gsl_matrix_alloc (dim, dim); gsl_matrix *Inv = gsl_matrix_alloc (dim, dim); gsl_permutation *p = gsl_permutation_alloc (dim); int s; for (int i = 0; i < dim; i++) for (int j = 0; j < dim; j++) gsl_matrix_set (Mat, i, j, gsl_matrix_get (Pmat, i, j)); gsl_linalg_LU_decomp (Mat, p, &s); gsl_linalg_LU_invert (Mat, p, Inv); gsl_matrix_free (Mat); gsl_permutation_free (p); double *rhs = new double [dim]; double *xi = new double [dim]; for (int l = 0; l < dim; l++) { double fac = cos (double (ntor+1) * M_PI) *gsl_sf_gamma (double (- mpol[l] - ntor) + 0.5) /gsl_sf_gamma (double (- mpol[l] + ntor) + 0.5); int ml = abs (mpol[l]); double fl = (mpol[l] < 0) ? 1. : -1.; for (int j = 0; j < dim; j++) { int mj = abs (mpol[j]); double fcj = (mj == 0) ? 1. : 0.5; double fsj = (mpol[j] > 0) ? 0.5 : -0.5; double sum = 0.; for (int jj = 0; jj < dim; jj++) { int mjj = abs (mpol[jj]); double fcjj = (mjj == 0) ? 1. : 0.5; double fsjj = (mpol[jj] > 0) ? 0.5 : -0.5; sum += gsl_matrix_get (Nmat, j, jj) * (fcjj * gsl_matrix_get (Qc, mjj, ml) + fl*fsjj * gsl_matrix_get (Qs, mjj, ml)); } rhs[j] = (double (mpol[j]) - double (ntor) * qa) * (fcj * gsl_matrix_get (dQcdr, mj, ml) + fl*fsj * gsl_matrix_get (dQsdr, mj, ml)) - sum; } for (int j = 0; j < dim; j++) { xi[j] = 0.; for (int jj = 0; jj < dim; jj++) xi[j] += gsl_matrix_get (Inv, j, jj) * rhs[jj]; } for (int j = 0; j < dim; j++) { int mj = abs (mpol[j]); double fcj = (mj == 0) ? 1. : 0.5; double fsj = (mpol[j] > 0) ? 0.5 : -0.5; gsl_matrix_set (Vmat, j, l, - fac * (fcj * gsl_matrix_get (Qc, mj, ml) + fl*fsj * gsl_matrix_get (Qs, mj, ml))); gsl_matrix_set (Vmat, dim+j, l, fac * xi[j]); } } for (int l = 0; l < dim; l++) { double fac = - cos (double (ntor+1) * M_PI) * gsl_sf_gamma (double (- mpol[l] - ntor) + 0.5) / gsl_sf_gamma (double (- mpol[l] + ntor) + 0.5); int ml = abs (mpol[l]); double fl = (mpol[l] < 0) ? 1. : -1.; for (int j = 0; j < dim; j++) { int mj = abs (mpol[j]); double fcj = (mj == 0) ? 1. : 0.5; double fsj = (mpol[j] > 0) ? 0.5 : -0.5; double sum = 0.; for (int jj = 0; jj < dim; jj++) { int mjj = abs (mpol[jj]); double fcjj = (mjj == 0) ? 1. : 0.5; double fsjj = (mpol[jj] > 0) ? 0.5 : -0.5; sum += gsl_matrix_get (Nmat, j, jj) * (fcjj * gsl_matrix_get (Pc, mjj, ml) + fl*fsjj * gsl_matrix_get (Ps, mjj, ml)); } rhs[j] = (double (mpol[j]) - double (ntor) * qa) * (fcj * gsl_matrix_get (dPcdr, mj, ml) + fl*fsj * gsl_matrix_get (dPsdr, mj, ml)) - sum; } for (int j = 0; j < dim; j++) { xi[j] = 0.; for (int jj = 0; jj < dim; jj++) xi[j] += gsl_matrix_get (Inv, j, jj) * rhs[jj]; } for (int j = 0; j < dim; j++) { int mj = abs (mpol[j]); double fcj = (mj == 0) ? 1. : 0.5; double fsj = (mpol[j] > 0) ? 0.5 : -0.5; gsl_matrix_set (Vmat, j, dim+l, - fac * (fcj * gsl_matrix_get (Pc, mj, ml) + fl*fsj * gsl_matrix_get (Ps, mj, ml))); gsl_matrix_set (Vmat, dim+j, dim+l, fac * xi[j]); } } gsl_matrix_free (Inv); delete[] rhs; delete[] xi; // Diagonalize vacuum matrix printf ("Vacuum matrix residual: %11.4e\n", VacuumResidual ()); double res; do { for (int i = 0; i < dim; i++) { double sumii = 0.; for (int k = 0; k < dim; k++) sumii += (+ gsl_matrix_get (Vmat, k, i) * gsl_matrix_get (Vmat, dim+k, dim+i) - gsl_matrix_get (Vmat, dim+k, i) * gsl_matrix_get (Vmat, k, dim+i)) * (double (mpol[k]) - double (ntor) * qa); for (int j = 0; j < dim; j++) if (j != i) { double sumij = 0.; for (int k = 0; k < dim; k++) sumij += (+ gsl_matrix_get (Vmat, k, i) * gsl_matrix_get (Vmat, dim+k, dim+j) - gsl_matrix_get (Vmat, dim+k, i) * gsl_matrix_get (Vmat, k, dim+j)) * (double (mpol[k]) - double (ntor) * qa); for (int k = 0; k < dim1; k++) { double val = gsl_matrix_get (Vmat, k, dim+j) - (sumij/sumii) * gsl_matrix_get (Vmat, k, dim+i); gsl_matrix_set (Vmat, k, dim+j, val); } } } for (int i = 0; i < dim; i++) { double sumii = 0.; for (int k = 0; k < dim; k++) sumii += (+ gsl_matrix_get (Vmat, k, i) * gsl_matrix_get (Vmat, dim+k, dim+i) - gsl_matrix_get (Vmat, dim+k, i) * gsl_matrix_get (Vmat, k, dim+i)) * (double (mpol[k]) - double (ntor) * qa); for (int j = 0; j < dim; j++) if (j != i) { double sumij = 0.; for (int k = 0; k < dim; k++) sumij += (+ gsl_matrix_get (Vmat, k, i) * gsl_matrix_get (Vmat, dim+k, j) - gsl_matrix_get (Vmat, dim+k, i) * gsl_matrix_get (Vmat, k, j)) * (double (mpol[k]) - double (ntor) * qa); for (int k = 0; k < dim1; k++) { double val = gsl_matrix_get (Vmat, k, j) - (sumij/sumii) * gsl_matrix_get (Vmat, k, dim+i); gsl_matrix_set (Vmat, k, j, val); } } } for (int i = 0; i < dim; i++) { double sumii = 0.; for (int k = 0; k < dim; k++) sumii += (+ gsl_matrix_get (Vmat, k, dim+i) * gsl_matrix_get (Vmat, dim+k, i) - gsl_matrix_get (Vmat, dim+k, dim+i) * gsl_matrix_get (Vmat, k, i)) * (double (mpol[k]) - double (ntor) * qa); for (int j = 0; j < dim; j++) if (j != i) { double sumij = 0.; for (int k = 0; k < dim; k++) sumij += (+ gsl_matrix_get (Vmat, k, dim+i) * gsl_matrix_get (Vmat, dim+k, dim+j) - gsl_matrix_get (Vmat, dim+k, dim+i) * gsl_matrix_get (Vmat, k, dim+j)) * (double (mpol[k]) - double (ntor) * qa); for (int k = 0; k < dim1; k++) { double val = gsl_matrix_get (Vmat, k, dim+j) - (sumij/sumii) * gsl_matrix_get (Vmat, k, i); gsl_matrix_set (Vmat, k, dim+j, val); } } } res = VacuumResidual (); printf ("Vacuum matrix residual: %11.4e\n", res); } while (res > 1.e-6); // Log vacuum matrix if (interactive) LogVmat (); }