void eri_aux1
( int l1,int l2,double a,double b,double gamma,
double* H,double* dHda, double* dHdb,
double* f, double* dfda, double* dfdb, int n_aux
){
int maxL = (l1+l2); // this is correct
int L,i,r,l;
binomial_expansion(l1,l2,a,b,f,dfda,dfdb, 1); // 1 - is_derivs
zero_array(H,n_aux);
zero_array(dHda,n_aux);
zero_array(dHdb,n_aux);
for(i=0;i<=maxL;i++){
for(r=0;r<=(i/2);r++){ //!!! Integer division
L = i - 2*r;
if(L>=0){
double prefact = ( (FACTORIAL(i)/(1.0*FACTORIAL(r)*FACTORIAL(L))) ) * FAST_POW((0.25/gamma),(i-r));
H[L] += prefact*f[i];
dHda[L] += prefact*dfda[i];
dHdb[L] += prefact*dfdb[i];
}// L>0
}// for r
}// for i
}
LOCAL boolean expand_set(
POINTER *p,
int size)
{
int *oldnum, *newnum;
int i;
POINTER old_array,new_array;
static const int SMALL_ARRAY = 20; /* Increment Size for Byte Arrays */
static int empty[2] = {0,0};
if (*p == NULL)
oldnum = empty;
else
{
oldnum = (int *)(*p);
oldnum -= 2;
}
if (oldnum[0]+size <= oldnum[1])
return FUNCTION_SUCCEEDED;
old_array = *p;
if ((new_array = zero_array(oldnum[1]+SMALL_ARRAY)) == NULL)
return FUNCTION_FAILED;
*p = new_array;
newnum = (int *)new_array;
newnum -= 2;
newnum[0] = oldnum[0];
newnum[1] = oldnum[1] + SMALL_ARRAY;
for (i=0; i<oldnum[1]; ++i)
((char *)new_array)[i] = ((char *)old_array)[i];
return expand_set(p,size);
} /*end expand_set*/
int main ()
{
int notpassed = 0;
int passed = 0;
struct array array1;
check (init_array (&array1))
test (add_element (&array1, 1), NO_ERRORS)
test (add_element (&array1, 8), NO_ERRORS)
test (change_element(&array1, 12, 33), WRITE_TO_UNALLOCATED_MEMORY)
test (change_element(&array1, 1, 33), NO_ERRORS)
test (add_element (&array1, 41), NO_ERRORS)
test (add_element (&array1, 3), NO_ERRORS)
test (add_element (&array1, 9), NO_ERRORS)
test (elements_sum (&array1), NO_ERRORS)
test (add_element (&array1, 13), NO_ERRORS)
test (verbose_full_print (&array1), NO_ERRORS)
test (remove_element (&array1, 4), NO_ERRORS)
test (print_array (&array1), NO_ERRORS)
test (find_element(&array1, 120), ELEMENT_NOT_FOUND)
test (print_array (&array1), NO_ERRORS)
test (print_array (&array1), NO_ERRORS)
test (print_element(&array1, 40), GARBAGE_READ)
test (zero_array (&array1), NO_ERRORS)
test (print_array (&array1), NO_ERRORS)
printf ("datalen = %i, memlen = %i\n", get_datalen (&array1), get_memlen (&array1));
for (int i = 0; i < 305; i ++)
check (add_element (&array1, 41));
printf ("Passed %i, not passed %i.\n", passed, notpassed);
test (delete_array (&array1), NO_ERRORS)
print_exit_message ();
return 0;
}
int main() {
int n, i=0; scanf("%d", &n);
int *p; int ar[n];
p = zero_array(ar, n);
for(; i<n; i++)
printf("\n%d", ar[i]);
return 0;
}
void set_mdot(int planet_torque) {
int i;
double lamm;
if (planet_torque && planet.nonlocal_torque) {
set_torque_nl(planet.a,lam,mdot,TRUE);
}
else {
zero_array(mdot,NR);
}
double rm,num,am,bm,drm;
for(i=1;i<NR;i++) {
rm = rmin[i];
num = nu(rm);
am = 3*num;
bm = 3*(num/rm)*(params.gamma-.5);
drm = rc[i]-rc[i-1];
//mdot[i] = -mdot[i]*2*sqrt(rmin[i]);
mdot[i] = -2*sqrt(rmin[i])*mdot[i] + (bm*(rc[i]-rm)-am)*lam[i-1]/drm + (am + bm*(rm-rc[i-1]))*lam[i]/drm;
//mdot[i] = -mdot[i]*2*sqrt(rmin[i]) + 1.5*( lam[i]*nu(rc[i])/sqrt(rc[i]) - lam[i-1]*nu(rc[i-1])/sqrt(rc[i-1]))/(sqrt(rc[i])-sqrt(rc[i-1]));
/*
if (planet_torque && !planet.nonlocal_torque) {
lamm = lam[i-1]*dr[i]/(dr[i-1]+dr[i]) + lam[i]*dr[i-1]/(dr[i-1]+dr[i]);
mdot[i] -= 2*sqrt(rmin[i])*dTr_ex(rmin[i],planet.a)*lamm;
}
*/
}
mdot[0] = get_inner_bc_mdot(lam[0]);
//mdot[0] = -mdot[0]*2*sqrt(rc[i]) + lam[0]*1.5*nu(rmin[0])/rmin[0];
/*
if (planet_torque && params.forced_torque) {
for(i=0;i<NR;i++) {
mdot[i] -= 2*sqrt(rmin[i]) * 2*M_PI*rmin[i] * fld.grid_torque[i];
}
}
*/
return;
}
/*
* InitEvents()
*
* This function initializes events stuff. This boils down to placing the
* various events into their types (implemented in SListBase structures), which
* automatically sorts them as they are added based on how close they are to
* the time they are supposed to occur.
*/
void InitEvents(char SetTime)
{
int i;
static char called = FALSE;
if (called) return ;
if (SetTime) InitEvTimes(); /* let doors cheat if needed */
called = TRUE;
zero_array(ClassActive); /* all classes off for now */
for (i = 0; i < cfg.EvNumber; i++) {
if (!(EventTab[i].EvFlags & EV_DAY_BASE))
AddData(&Types[EventTab[i].EvType].List, EventTab + i, NULL, FALSE);
else
AddData(&DayBased, EventTab + i, NULL, FALSE);
}
SetAbs(&Types[0], -1l);
SetAbs(&Types[1], -1l);
SetAbs(&Types[2], -1l);
}
void calculate_OCs(int *tlist,double *vlist,int nfac,int nvert,double *angles,OCstruct* OC,double *offset,double *W,double *D,int dm,int dn,double *Chordoffset,double* OCdist,double* dOdv,double *dOdoff,double *dChordoff)
{
/*Construct derivative matrix wrt shape parameters corresponding to chord interserctions*/
/*offset is 2*noc vector containing offsets
* Chordoffset is ntotal vector containing offset of each chord in seconds (optional)
* D optional derivative matrix by which the original derivative matrix is multiplied
* dOdv is 4*ntotal x (3*nvert+3) (or (3*dn+3) if D!=NULL) matrix containing derivatives
* dOdoff 4*ntotal x 2*noc matrix for derivatives wrt offset terms
* dChordoff 4*notalxntotal matrix for derivatives wrt chord offsets
*/
int noc=OC->noc;
int *nobs=OC->nobs;
int *cumcount=calloc(noc+1,sizeof(int));
if(D!=NULL && dm!=nvert)
{
fprintf(stderr,"nvert and dm must be equal if D is non-null\n");
exit(-1);
}
if(D==NULL)
dn=nvert;
cumcount[0]=0;
for(int j=1;j<=noc;j++)
cumcount[j]=cumcount[j-1]+nobs[j-1];
int ntotal=OC->ntotal;
zero_array(dOdv,4*ntotal*(3*dn+3));
zero_array(dOdoff,4*ntotal*2*noc);
for(int j=0;j<noc;j++)
{
double *dx=calloc(4*nobs[j]*nvert,sizeof(double));
double *dy=calloc(4*nobs[j]*nvert,sizeof(double));
double *dz=calloc(4*nobs[j]*nvert,sizeof(double));
double *dangles=calloc(4*nobs[j]*3,sizeof(double));
double *dtox=calloc(4*nobs[j],sizeof(double));
double *dtoy=calloc(4*nobs[j],sizeof(double));
double *COffset;
double *dCOdoff=calloc(4*nobs[j]*nobs[j],sizeof(double));
if(Chordoffset!=NULL)
COffset=Chordoffset+cumcount[j];
else
COffset=NULL;
Fit_Occ(tlist,vlist,nfac,nvert,angles,OC->up+3*j,OC->E+3*j,OC->V+3*j,OC->TIME[j],offset+2*j,OC->data[j],OC->type[j],nobs[j],W,COffset,OCdist+4*cumcount[j],dx,dy,dz,dangles,dtox,dtoy,dCOdoff);
if(D!=NULL)
{
double *dx2=calloc(4*nobs[j]*dn,sizeof(double));
double *dy2=calloc(4*nobs[j]*dn,sizeof(double));
double *dz2=calloc(4*nobs[j]*dn,sizeof(double));
matrix_prod(dx,4*nobs[j],nvert,D,dn,dx2);
matrix_prod(dy,4*nobs[j],nvert,D,dn,dy2);
matrix_prod(dz,4*nobs[j],nvert,D,dn,dz2);
set_submatrix(dOdv,4*ntotal,3*dn+3,dx2,4*nobs[j],dn,4*cumcount[j],0);
set_submatrix(dOdv,4*ntotal,3*dn+3,dy2,4*nobs[j],dn,4*cumcount[j],dn);
set_submatrix(dOdv,4*ntotal,3*dn+3,dz2,4*nobs[j],dn,4*cumcount[j],2*dn);
set_submatrix(dOdv,4*ntotal,3*dn+3,dangles,4*nobs[j],3,4*cumcount[j],3*dn);
set_submatrix(dOdoff,4*ntotal,2*noc,dtox,4*nobs[j],1,4*cumcount[j],2*j);
set_submatrix(dOdoff,4*ntotal,2*noc,dtoy,4*nobs[j],1,4*cumcount[j],2*j+1);
if(dChordoff!=NULL)
set_submatrix(dChordoff,4*ntotal,ntotal,dCOdoff,4*nobs[j],nobs[j],4*cumcount[j],cumcount[j]);
free(dx);
free(dy);
free(dz);
free(dangles);
free(dtox);
free(dtoy);
free(dx2);
free(dy2);
free(dz2);
}
else
{
set_submatrix(dOdv,4*ntotal,3*nvert+3,dx,4*nobs[j],nvert,4*cumcount[j],0);
set_submatrix(dOdv,4*ntotal,3*nvert+3,dy,4*nobs[j],nvert,4*cumcount[j],nvert);
set_submatrix(dOdv,4*ntotal,3*nvert+3,dz,4*nobs[j],nvert,4*cumcount[j],2*nvert);
set_submatrix(dOdv,4*ntotal,3*nvert+3,dangles,4*nobs[j],3,4*cumcount[j],3*nvert);
set_submatrix(dOdoff,4*ntotal,2*noc,dtox,4*nobs[j],1,4*cumcount[j],2*j);
set_submatrix(dOdoff,4*ntotal,2*noc,dtoy,4*nobs[j],1,4*cumcount[j],2*j+1);
if(dChordoff!=NULL)
set_submatrix(dChordoff,4*ntotal,ntotal,dCOdoff,4*nobs[j],nobs[j],4*cumcount[j],cumcount[j]);
free(dx);
free(dy);
free(dz);
free(dangles);
free(dtox);
free(dtoy);
}
free(dCOdoff);
}
free(cumcount);
}
void calculate_lcs(int *tlist,double *vlist,int nfac,int nvert,double *angles,LCstruct *LC,double *D,int dm,int dn,double *LCout,double *dLCdv,double *Albedo,double *Alimit,double *dAlb,double *params,double *dparams,int deriv)
{
/*Calculates the lightcurves corresponding to geometries described in LCstruct
* Optionally Alb contains facet albedos, Alimit albedo limits.
* OUTPUT:
* LCout ntpoints array, where nlcp is the total number of lightcurve points
* NOTE: LCout=lc_data-lc_model
* dLCdv ntpoints x 3*nvertf+3 matrix, (=dLCdv=dLCdx*D dLCdy*D dLCdz*D dLCdA)
* dAlb derivatives wrt albedo, ntpoints x nfac array */
if(D!=NULL && nvert!=dm)
{
puts("Error: Number of vertex coordinates is not equal to the number of rows in D.");
exit(1);
}
int nvertf=dn;
if(D==NULL)
nvertf=nvert;
int nlc,ntpoints;
int *cumpoints;
int *nobs;
nlc=LC->nlc;
nobs=LC->nobs;
cumpoints=malloc((nlc+1)*sizeof(int));
cumpoints[0]=0;
for(int i=1;i<=nlc;i++)
cumpoints[i]=cumpoints[i-1]+nobs[i-1]; //Cumulative sum of points
ntpoints=cumpoints[nlc]; //Total number of observed points
zero_array(dLCdv,ntpoints*(3*nvertf+3));
if(dAlb!=NULL)
zero_array(dAlb,ntpoints*nfac);
if(dparams!=NULL)
zero_array(dparams,ntpoints*3);
omp_set_num_threads(NUM_THREADS);
#pragma omp parallel for
for(int j=0;j<nlc;j++)
{
int cind=cumpoints[j]; //total number of points in previous lightcurves
int pinlc=nobs[j]; //points in current lightcurve
double *E,*E0,*TIME;
double *bright;
double *dbrightx;
double *dbrighty;
double *dbrightz;
double *dbrightxf;
double *dbrightyf;
double *dbrightzf;
double *dbrightb;
double *dbrightl;
double *dbrighto;
double *dbrightp;
double *dA;
double *lcs;
double lcw=INI_LC_WEIGHTS[j];
bright=calloc(pinlc,sizeof(double));
dbrightx=calloc(pinlc*nvertf,sizeof(double));
dbrighty=calloc(pinlc*nvertf,sizeof(double));
dbrightz=calloc(pinlc*nvertf,sizeof(double));
dbrightb=calloc(pinlc,sizeof(double));
dbrightl=calloc(pinlc,sizeof(double));
dbrighto=calloc(pinlc,sizeof(double));
dbrightp=calloc(pinlc*3,sizeof(double));
if(Albedo!=NULL)
dA=calloc(pinlc*nfac,sizeof(double)); //If no albedo, then no albedo derivatives
E=LC->E[j];
E0=LC->E0[j];
TIME=LC->TIME[j];
lcs=LC->lcs[j];
if(D!=NULL)
{
// printf("pinlc: %d nvert :%d nvertf: %d\n",pinlc,nvert,nvertf);
dbrightxf=calloc(pinlc*nvert,sizeof(double));
dbrightyf=calloc(pinlc*nvert,sizeof(double));
dbrightzf=calloc(pinlc*nvert,sizeof(double));
calculate_lcurve(tlist,vlist,nfac,nvert,angles,E,E0,pinlc,TIME,bright,dbrightxf,dbrightyf,dbrightzf,dbrightb,dbrightl,dbrighto,dbrightp,Albedo,Alimit,dA,LC->rel[j],params);
matrix_prod(dbrightxf,pinlc,nvert,D,nvertf,dbrightx);
matrix_prod(dbrightyf,pinlc,nvert,D,nvertf,dbrighty);
matrix_prod(dbrightzf,pinlc,nvert,D,nvertf,dbrightz);
free(dbrightxf);
free(dbrightyf);
free(dbrightzf);
}
else
calculate_lcurve(tlist,vlist,nfac,nvert,angles,E,E0,pinlc,TIME,bright,dbrightx,dbrighty,dbrightz,dbrightb,dbrightl,dbrighto,dbrightp,Albedo,Alimit,dA,LC->rel[j],params);
/*Copy stuff to correct places*/
// printf("\n dLdx at %d, cind is %d,ntpoints is %d\n",j,cind,ntpoints);
// print_matrix(dbrightx,pinlc,nvertf);
if(params!=NULL)
mult_with_cons(dbrightp,pinlc,3,lcw);
for(int k=0;k<pinlc;k++)
LCout[k+cumpoints[j]]=lcw*(lcs[k]-bright[k]);
free(bright);
if(deriv==1)
{
/*Copy derivatives*/
if(lcw!=1.0)
{
mult_with_cons(dbrightx,pinlc,nvertf,lcw);
mult_with_cons(dbrighty,pinlc,nvertf,lcw);
mult_with_cons(dbrightz,pinlc,nvertf,lcw);
mult_with_cons(dbrightb,pinlc,1,lcw);
mult_with_cons(dbrightl,pinlc,1,lcw);
mult_with_cons(dbrighto,pinlc,1,lcw);
}
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrightx,pinlc,nvertf,cind,0);
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrighty,pinlc,nvertf,cind,nvertf);
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrightz,pinlc,nvertf,cind,2*nvertf);
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrightb,pinlc,1,cind,3*nvertf);
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrightl,pinlc,1,cind,3*nvertf+1);
set_submatrix(dLCdv,ntpoints,3*nvertf+3,dbrighto,pinlc,1,cind,3*nvertf+2);
if(Albedo!=NULL)
{
mult_with_cons(dA,pinlc,nfac,lcw);
set_submatrix(dAlb,ntpoints,nfac,dA,pinlc,nfac,cind,0);
free(dA);
}
if(params!=NULL && dparams!=NULL)
set_submatrix(dparams,ntpoints,3,dbrightp,pinlc,3,cind,0);
}
free(dbrightx);
free(dbrighty);
free(dbrightz);
free(dbrightb);
free(dbrightl);
free(dbrighto);
free(dbrightp);
}
free(cumpoints);
}
void Calculate_RDs(int *tlist,double *vlist,int nfac,int nvert,double *angles,RDstruct *RDs,double *offset,double *D,int dm,int dn,double *Weight,double *scale,double rexp,double *FT,double *FTdv,double *FTdoff,double *FTdsc,double *FTdxp,int deriv)
{
/*Same as the original, only exception is the inclusion of matrix D (For effective memory usage)
*/
int DisNULL=0;
int D1V=0;
int D3V=0;
int UseScale=0;
int UseWeight=0;
if(scale!=NULL)
UseScale=1;
int nRD;
nRD=RDs->nRD; //Number of RD images
/*First some sanity checking*/
if(D==NULL)
DisNULL=1;
if(!DisNULL && nvert!=dm)
{
puts("Error: nvert is not equal dm.");
exit(1);
}
if(Weight!=NULL)
UseWeight=1;
int *nopoints,*cumpoints,ntpoints;
nopoints=RDs->nobs; //Array, number of samples in each RD image
cumpoints=malloc((nRD+1)*sizeof(int));
cumpoints[0]=0;
for(int i=1;i<=nRD;i++)
cumpoints[i]=cumpoints[i-1]+nopoints[i-1]; //cumpoints is the cumulative sum of all observation points, used for indexing
ntpoints=cumpoints[nRD];//Total number of points
if(deriv==0)
{
omp_set_num_threads(NUM_THREADS);
#pragma omp parallel for
for(int obsind=0;obsind<nRD;obsind++)
{
double *FTE,*FTTIME,*FTfreqx,*FTfreqy,*FTrfreq,*datar,*datai;
double *FTr,*FTi;
double W;
if(UseWeight==1)
W=Weight[obsind];
else
W=1;
FTr=calloc(nopoints[obsind],sizeof(double));
FTi=calloc(nopoints[obsind],sizeof(double));
FTE=RDs->E+3*obsind;
FTTIME=RDs->TIME+obsind;
FTfreqx=RDs->freqx[obsind];
FTfreqy=RDs->freqy[obsind];
FTrfreq=RDs->rfreq+obsind;
datar=RDs->datar[obsind];
datai=RDs->datai[obsind];
Calculate_Range_Doppler(tlist,vlist,nfac,nvert,angles,FTE,*FTTIME,FTfreqx,FTfreqy,nopoints[obsind],*FTrfreq,offset+2*obsind,scale[obsind],rexp,FTr,FTi);
for(int j=0;j<nopoints[obsind];j++)
{
FT[j+cumpoints[obsind]]=W*(datar[j]-FTr[j]);
FT[j+cumpoints[obsind]+ntpoints]=W*(datai[j]-FTi[j]);
}
//return;
free(FTr);
free(FTi);
}
return;
}
int nvertf;
if(D!=NULL)
nvertf=dn;
else
{
nvertf=nvert;
dn=nvert;
}
zero_array(FTdv,2*ntpoints*(3*nvertf+3));
zero_array(FTdoff,2*ntpoints*2*nRD);
zero_array(FTdsc,2*ntpoints*nRD);
zero_array(FTdxp,2*ntpoints);
omp_set_num_threads(NUM_THREADS);
#pragma omp parallel for
for(int obsind=0;obsind<nRD;obsind++)
{
int cind=0;
int oind=0;
double *FTdxr,*FTdxi,*FTdyr,*FTdyi,*FTdzr,*FTdzi,*FTdAr,*FTdAi,*FTdoffr,*FTdoffi,*FTdexpr,*FTdexpi,*FTdxfr,*FTdxfi,*FTdyfr,*FTdyfi,*FTdzfr,*FTdzfi;
double *FTE,*FTTIME,*FTfreqx,*FTfreqy,*FTrfreq;
double *FTr,*FTi,*datar,*datai;
double W;
if(UseWeight==1)
W=Weight[obsind];
else
W=1;
// obsind=omp_get_thread_num();
FTr=calloc(nopoints[obsind],sizeof(double));
FTi=calloc(nopoints[obsind],sizeof(double));
FTdxr=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdxi=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdyr=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdyi=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdzr=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdzi=calloc(nopoints[obsind]*nvertf,sizeof(double));
FTdAr=calloc(nopoints[obsind]*3,sizeof(double));
FTdAi=calloc(nopoints[obsind]*3,sizeof(double));
FTdoffr=calloc(nopoints[obsind]*2,sizeof(double));
FTdoffi=calloc(nopoints[obsind]*2,sizeof(double));
FTdexpr=calloc(nopoints[obsind],sizeof(double));
FTdexpi=calloc(nopoints[obsind],sizeof(double));
FTE=RDs->E+3*obsind;
FTTIME=RDs->TIME+obsind;
FTfreqx=RDs->freqx[obsind];
FTfreqy=RDs->freqy[obsind];
FTrfreq=RDs->rfreq+obsind;
datar=RDs->datar[obsind];
datai=RDs->datai[obsind];
if(D!=NULL)
{
FTdxfr=calloc(nopoints[obsind]*nvert,sizeof(double));
FTdyfr=calloc(nopoints[obsind]*nvert,sizeof(double));
FTdzfr=calloc(nopoints[obsind]*nvert,sizeof(double));
FTdxfi=calloc(nopoints[obsind]*nvert,sizeof(double));
FTdyfi=calloc(nopoints[obsind]*nvert,sizeof(double));
FTdzfi=calloc(nopoints[obsind]*nvert,sizeof(double));
Calculate_Range_Doppler_deriv(tlist,vlist,nfac,nvert,angles,FTE,*FTTIME,FTfreqx,FTfreqy,nopoints[obsind],*FTrfreq,offset+2*obsind,scale[obsind],rexp,FTr,FTi,FTdxfr,FTdxfi,FTdyfr,FTdyfi,FTdzfr,FTdzfi,FTdAr,FTdAi,FTdoffr,FTdoffi,FTdexpr,FTdexpi);
//Convert from vlistn->vlist. Only because we want to minimize memory usage
matrix_prod(FTdxfr,nopoints[obsind],nvert,D,nvertf,FTdxr);
matrix_prod(FTdxfi,nopoints[obsind],nvert,D,nvertf,FTdxi);
free(FTdxfr);
free(FTdxfi);
matrix_prod(FTdyfr,nopoints[obsind],nvert,D,nvertf,FTdyr);
matrix_prod(FTdyfi,nopoints[obsind],nvert,D,nvertf,FTdyi);
free(FTdyfr);
free(FTdyfi);
matrix_prod(FTdzfr,nopoints[obsind],nvert,D,nvertf,FTdzr);
matrix_prod(FTdzfi,nopoints[obsind],nvert,D,nvertf,FTdzi);
free(FTdzfr);
free(FTdzfi);
}
else
Calculate_Range_Doppler_deriv(tlist,vlist,nfac,nvert,angles,FTE,*FTTIME,FTfreqx,FTfreqy,nopoints[obsind],*FTrfreq,offset+2*obsind,scale[obsind],rexp,FTr,FTi,FTdxr,FTdxi,FTdyr,FTdyi,FTdzr,FTdzi,FTdAr,FTdAi,FTdoffr,FTdoffi,FTdexpr,FTdexpi);
for(int j=0;j<nopoints[obsind];j++)
{
FT[j+cumpoints[obsind]]=W*(datar[j]-FTr[j]);
FT[j+cumpoints[obsind]+ntpoints]=W*(datai[j]-FTi[j]);
}
// print_matrix(vlist,10,3);
// print_matrix(angles,1,3);
// print_matrix(offset,1,2);
// printf("Scale: %f rexp:%f TIME: %f, E: %f %f %f\n",scale[0],rexp,*FTTIME,FTE[0],FTE[1],FTE[2]);
// write_matrix_file("/tmp/FTfreqx.txt",FTfreqx,1,nopoints[obsind]);
// write_matrix_file("/tmp/FTfreqy.txt",FTfreqy,1,nopoints[obsind]);
// write_matrix_file("/tmp/FTr.txt",FTr,1,nopoints[obsind]);
// write_matrix_file("/tmp/FTi.txt",FTi,1,nopoints[obsind]);
//Copy variables to matlab
cind=cumpoints[obsind];
oind=nopoints[obsind];
if(UseWeight==1)
{
mult_with_cons(FTdxr,oind,dn,W);
mult_with_cons(FTdxi,oind,dn,W);
mult_with_cons(FTdyr,oind,dn,W);
mult_with_cons(FTdyi,oind,dn,W);
mult_with_cons(FTdzr,oind,dn,W);
mult_with_cons(FTdzi,oind,dn,W);
mult_with_cons(FTdAr,oind,3,W);
mult_with_cons(FTdAi,oind,3,W);
mult_with_cons(FTdoffr,oind,2,W);
mult_with_cons(FTdoffi,oind,2,W);
mult_with_cons(FTr,oind,1,W);
mult_with_cons(FTi,oind,1,W);
mult_with_cons(FTdexpr,oind,1,W);
mult_with_cons(FTdexpi,oind,1,W);
}
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdxr,oind,dn,cind,0);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdxi,oind,dn,cind+ntpoints,0);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdyr,oind,dn,cind,dn);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdyi,oind,dn,cind+ntpoints,dn);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdzr,oind,dn,cind,2*dn);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdzi,oind,dn,cind+ntpoints,2*dn);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdAr,oind,3,cind,3*dn);
set_submatrix(FTdv,2*ntpoints,3*dn+3,FTdAi,oind,3,cind+ntpoints,3*dn);
set_submatrix(FTdoff,2*ntpoints,2*nRD,FTdoffr,oind,2,cind,2*obsind);
set_submatrix(FTdoff,2*ntpoints,2*nRD,FTdoffi,oind,2,cind+ntpoints,2*obsind);
set_submatrix(FTdsc,2*ntpoints,nRD,FTr,oind,1,cind,obsind);
set_submatrix(FTdsc,2*ntpoints,nRD,FTi,oind,1,cind+ntpoints,obsind);
set_submatrix(FTdxp,2*ntpoints,1,FTdexpr,oind,1,cind,0);
set_submatrix(FTdxp,2*ntpoints,1,FTdexpi,oind,1,cind+ntpoints,0);
free(FTr);
free(FTi);
free(FTdxr);
free(FTdxi);
free(FTdyr);
free(FTdyi);
free(FTdzr);
free(FTdzi);
free(FTdAr);
free(FTdAi);
free(FTdoffr);
free(FTdoffi);
free(FTdexpr);
free(FTdexpi);
}
}
void power (int exp, int cp, struct pcp_vars *pcp)
{
register int *y = y_address;
register int p = pcp->p;
register int lastg = pcp->lastg;
register int x = cp;
register int a = pcp->submlg - (lastg + 1);
register int b = a - (lastg + 1);
register int z = b - (lastg + 1);
register int q, r, pp, nn;
register int i;
if (exp == 1) return;
/* nn is the exponent requested */
nn = exp;
/* first consider small primes */
if (p == 2 || p == 3) {
/* extract all powers of the prime from the exponent */
while (MOD (nn, p) == 0) {
nn /= p;
/* pack word in X into string for multiplication p - 1 times */
vector_to_string (x, a, pcp);
if (y[a + 1] == 0) return;
/* now multiply p - 1 times to get X^p */
for (i = 1; i <= p - 1; ++i) {
collect (-a, x, pcp);
}
}
if (nn == 1) return;
/* have extracted all powers of p from exponent -
now do rest using prime p expansion */
/* move X into Z, set X to 1 */
copy_array (x, lastg, z, pcp);
zero_array (x, lastg, pcp);
while (nn > 0) {
r = MOD (nn, p);
nn /= p;
/* move Z into A to multiply onto Z p - 1 times and
onto X r times */
vector_to_string (z, a, pcp);
/* now calculate Z = Z^p and X = X * Z^r */
if (y[a + 1] != 0) {
for (i = 1; i <= p - 1; ++i) {
if (i <= r)
collect (-a, x, pcp);
collect (-a, z, pcp);
}
}
}
}
/* for larger primes, use prime p decomposition and subsequent
binary expansion */
else {
/* move X into Z and set X to 1 */
vector_to_string (x, z, pcp);
zero_array (x, lastg, pcp);
while (nn > 0) {
/* move word w in Z into A, and set Z to 1; A will square each
iteration, and Z will accumulate some of these powers to
end up with w^p at end of while loop */
string_to_vector (z, a, pcp);
zero_array (z, lastg, pcp);
q = nn / p;
r = MOD (nn, p);
pp = p;
/* Now use binary expansion of both PP (ie p) and remainder R
to accumulate w^p in Z and w^R onto X from squaring of w.
Must continue until we have last w^R on X or until we get
w^p in Z if there is any remaining exponent (ie Q > 0) */
while (r > 0 || (pp > 0 && q > 0)) {
/* collect onto answer if needed (ie R = 1) */
if (MOD (r, 2) == 1) {
copy_array (a, lastg, b, pcp);
if (y[x + 1] > 0) {
collect (-x, b, pcp);
}
vector_to_string (b, x, pcp);
}
/* collect onto Z for next power of w if next iteration reqd */
if (MOD (pp, 2) == 1 && q > 0) {
copy_array (a, lastg, b, pcp);
if (y[z + 1] > 0) {
collect (-z, b, pcp);
}
vector_to_string (b, z, pcp);
}
r = r >> 1;
pp = pp >> 1;
/* if powers still needed for answer X or for w^p in Z for
another iteration (ie Q > 0) then square A by unpacking into
exponent vector B, collecting A and B, then repacking into A */
if (r > 0 || (pp > 0 && q > 0)) {
/* square A */
vector_to_string (a, b, pcp);
if (y[b + 1] > 0) {
collect (-b, a, pcp);
}
}
}
nn = q;
}
/* now X is the answer as a string, so convert to exponent vector */
string_to_vector (x, b, pcp);
copy_array (b, lastg, x, pcp);
}
}
//void Aux_Function6
void eri_aux2
( int l1,int l2,int l3,int l4,double PA,double PB,double QC,double QD,double p,double gamma1,double gamma2,
double* G, double* dGdA, double* dGdB, double* dGdC, double* dGdD, double* dGdp,
double* HL,double* dHLda, double* dHLdb,
double* HM,double* dHMda, double* dHMdb,
double* f, double* dfda, double* dfdb,
int n_aux
){
// This is C(G) function used in multiple summs for ERI calculations
// dGdA = dG / dPA
// dGdB = dG / dPB
// dGdC = dG / dQC
// dGdD = dG / dQD
// dGdp = dG / dp
zero_array(G,n_aux);
zero_array(dGdA,n_aux);
zero_array(dGdB,n_aux);
zero_array(dGdC,n_aux);
zero_array(dGdD,n_aux);
zero_array(dGdp,n_aux);
// This is C function used in multiple summs for ERI calculations
int maxL = l1 + l2;
int maxM = l3 + l4;
eri_aux1(l1,l2,PA,PB,gamma1,HL,dHLda,dHLdb,f,dfda,dfdb,n_aux); // HL of size l1+l2
eri_aux1(l3,l4,QC,QD,gamma2,HM,dHMda,dHMdb,f,dfda,dfdb,n_aux); // HM of size l3+l4
double d = 0.25*((1.0/gamma1) + (1.0/gamma2));
int L,M,u;
for(L=0;L<=maxL;L++){
for(M=0;M<=maxM;M++){
int maxU = ((L+M)/2); //INTEGER_DIVISION!!! "largest integer less of equal (L+M)/2"
for(u=0;u<=maxU;u++){
int I = L + M - u;
if(I>=0){
double prefac = FAST_POW(-1.0,(M+u)) * FACTORIAL(L+M)/ (1.0*FACTORIAL(u) * FACTORIAL(L+M-2*u) * FAST_POW(d,(L+M-u)));
double fp = FAST_POW(p,(L+M-2*u));
G[I] += prefac * HL[L] * HM[M] * fp;
dGdA[I] += prefac * dHLda[L] * HM[M] * fp;
dGdB[I] += prefac * dHLdb[L] * HM[M] * fp;
dGdC[I] += prefac * HL[L] * dHMda[M] * fp;
dGdD[I] += prefac * HL[L] * dHMdb[M] * fp;
if((L+M-2*u)>0){ // to avoid singularity when p = 0
dGdp[I] += (L+M-2*u) * prefac * HL[L] * HM[M] * FAST_POW(p,(L+M-2*u-1));
}
}
}// for u
}// for M
}// for L
}// eri_aux2
