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 ();
}