static void whittle2 (Array acf, Array Aold, Array Bold, int lag,
char *direction, Array A, Array K, Array E)
{
int d, i, nser=DIM(acf)[1];
const void *vmax;
Array beta, tmp, id;
d = strcmp(direction, "forward") == 0;
vmax = vmaxget();
beta = make_zero_matrix(nser,nser);
tmp = make_zero_matrix(nser, nser);
id = make_identity_matrix(nser);
set_array_to_zero(E);
copy_array(id, subarray(A,0));
for(i = 0; i < lag; i++) {
matrix_prod(subarray(acf,lag - i), subarray(Aold,i), d, 1, tmp);
array_op(beta, tmp, '+', beta);
matrix_prod(subarray(acf,i), subarray(Bold,i), d, 1, tmp);
array_op(E, tmp, '+', E);
}
qr_solve(E, beta, K);
transpose_matrix(K,K);
for (i = 1; i <= lag; i++) {
matrix_prod(K, subarray(Bold,lag - i), 0, 0, tmp);
array_op(subarray(Aold,i), tmp, '-', subarray(A,i));
}
vmaxset(vmax);
}
void main( )
{
Matrix *m, *mT, *eig_vec_J, *eig_vec_T, *L;
Vector *eig_val_J, *eig_val_T;
int i, j, tt_ja, tt_ho;
m = matrix_alloc( 100, 50 );
for( i = 0; i < m->dim_M; i++ )
for( j = 0; j < m->dim_N; j++ )
{
M( m, i, j) = (double) i*i + 120.0;
}
mT = matrix_alloc( 50, 100 );
matrix_transpose( m, mT );
eig_vec_J = matrix_alloc( 100, 100 );
eig_val_J = vector_alloc( 100 );
L = matrix_alloc( 100, 100 );
matrix_prod( m, mT, L );
Start_Clock_once( &tt_ja );
jacobi( L, eig_val_J, eig_vec_J );
End_ms_Clock_once( tt_ja, 1, "jacobi used " );
printf("done with jacobi\n" );
/* for( i = 0; i < 100; i++ ) printf(" %f", V(eig_val_J,i) );
printf("\n");
for( i = 0; i < 100; i++ ) printf(" %f", M(eig_vec_J,i,0) );
printf("\n");
*/
matrix_prod( m, mT, L );
eig_vec_T = matrix_alloc( 100, 100 );
eig_val_T = vector_alloc( 100 );
Start_Clock_once( &tt_ho );
eigen_householder( L, eig_val_T, eig_vec_T );
End_ms_Clock_once( tt_ho, 1, "householder used " );
printf(" done with householder\n" );
/* for( i = 0; i < 100; i++ ) printf(" %f", V(eig_val_T,i) );
printf("\n");
for( i = 0; i < 100; i++ ) printf(" %f", M(eig_vec_T,i,0) );
printf("\n");
*/
}
static void whittle(Array acf, int nlag, Array *A, Array *B, Array p_forward,
Array v_forward, Array p_back, Array v_back)
{
int lag, nser = DIM(acf)[1];
const void *vmax;
Array EA, EB; /* prediction variance */
Array KA, KB; /* partial correlation coefficient */
Array id, tmp;
vmax = vmaxget();
KA = make_zero_matrix(nser, nser);
EA = make_zero_matrix(nser, nser);
KB = make_zero_matrix(nser, nser);
EB = make_zero_matrix(nser, nser);
id = make_identity_matrix(nser);
copy_array(id, subarray(A[0],0));
copy_array(id, subarray(B[0],0));
copy_array(id, subarray(p_forward,0));
copy_array(id, subarray(p_back,0));
for (lag = 1; lag <= nlag; lag++) {
whittle2(acf, A[lag-1], B[lag-1], lag, "forward", A[lag], KA, EB);
whittle2(acf, B[lag-1], A[lag-1], lag, "back", B[lag], KB, EA);
copy_array(EA, subarray(v_forward,lag-1));
copy_array(EB, subarray(v_back,lag-1));
copy_array(KA, subarray(p_forward,lag));
copy_array(KB, subarray(p_back,lag));
}
tmp = make_zero_matrix(nser,nser);
matrix_prod(KB,KA, 1, 1, tmp);
array_op(id, tmp, '-', tmp);
matrix_prod(EA, tmp, 0, 0, subarray(v_forward, nlag));
vmaxset(vmax);
}
SPRIG_INLINE boost::numeric::ublas::matrix<T> matrix_prod(
boost::numeric::ublas::matrix<T> const& m1,
boost::numeric::ublas::matrix<T> const& m2,
boost::numeric::ublas::matrix<T> const& m3
)
{
return boost::numeric::ublas::prod(matrix_prod(m1, m2), m3);
}
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 convex_reg(int* tlist,double* vlist,int nfac,int nvert,double *D,int dm,int dn,double *res,double *drdv)
{
/*Calculate convex reg term
* OUTPUT:
* res a double
* drdv 3*nvert+3 array (dn array if D!=NULL)
*/
int nedge;
double result=0;
int *E,*N,*E2,*A;
double *v1,*v2,*v3,n1[3],n2[3];
double *w1,*w2,*w3;
double cangle;
double TA=0;
double *dTAdx,*dTAdy,*dTAdz;
dTAdx=calloc(nvert,sizeof(double));
dTAdy=calloc(nvert,sizeof(double));
dTAdz=calloc(nvert,sizeof(double));
double dn1dx1[3],dn1dx2[3],dn1dx3[3];
double dn1dy1[3],dn1dy2[3],dn1dy3[3];
double dn1dz1[3],dn1dz2[3],dn1dz3[3];
double dn2dx1[3],dn2dx2[3],dn2dx3[3];
double dn2dy1[3],dn2dy2[3],dn2dy3[3];
double dn2dz1[3],dn2dz2[3],dn2dz3[3];
double area1,area2;
double dA1dx[3],dA1dy[3],dA1dz[3];
double dA2dx[3],dA2dy[3],dA2dz[3];
double *dresdx,*dresdy,*dresdz;
dresdx=calloc(nvert,sizeof(double));
dresdy=calloc(nvert,sizeof(double));
dresdz=calloc(nvert,sizeof(double));
E=calloc(nvert*nvert,sizeof(int));
N=calloc(nvert*nfac,sizeof(int));
E2=calloc(nvert*nvert,sizeof(int));
A=calloc(nfac*nfac,sizeof(int));
if(D!=NULL && dm!=nvert)
{
puts("Error: Number of vertex coordinates is not equal to the number of rows in D.");
exit(1);
}
if(D==NULL)
dn=nvert;
double *drdx,*drdy,*drdz;
drdx=calloc(dn,sizeof(double));
drdy=calloc(dn,sizeof(double));
drdz=calloc(dn,sizeof(double));
find_neighborhood(tlist,vlist,nfac,nvert,E,N,E2,A);
free(E);
free(E2);
free(N);
nedge=nfac+nvert-2;
int ind;
int CB=0;
int i1,i2,i3;
int j1,j2,j3;
int count=0;
int *NumofBlocks;
int *IndexofBlocks;
double *normal,*centroid;
NumofBlocks=calloc(nfac,sizeof(int));
IndexofBlocks=calloc(nfac*nfac,sizeof(int));
normal=malloc(3*nfac*sizeof(double)); //We don't really need these
centroid=malloc(3*nfac*sizeof(double));
FacetsOverHorizon(tlist,vlist,nfac,nvert,normal,centroid,NumofBlocks,IndexofBlocks);
free(normal);
free(centroid);
for(int k=0;k<nfac;k++)
{
i1=tlist[3*k]-1;
i2=tlist[3*k+1]-1;
i3=tlist[3*k+2]-1;
v1=vlist+3*i1;
v2=vlist+3*i2;
v3=vlist+3*i3;
Calculate_Area_and_Normal_Derivative(v1,v2,v3,n1,dn1dx1,dn1dx2,dn1dx3,dn1dy1,dn1dy2,dn1dy3,dn1dz1,dn1dz2,dn1dz3,&area1,dA1dx,dA1dy,dA1dz);
TA+=area1;
dTAdx[i1]+=dA1dx[0];
dTAdx[i2]+=dA1dx[1];
dTAdx[i3]+=dA1dx[2];
dTAdy[i1]+=dA1dy[0];
dTAdy[i2]+=dA1dy[1];
dTAdy[i3]+=dA1dy[2];
dTAdz[i1]+=dA1dz[0];
dTAdz[i2]+=dA1dz[1];
dTAdz[i3]+=dA1dz[2];
if(NumofBlocks[k]==0)
continue; //There are no facets above the local horizon of current facets
for(int j=0;j<NumofBlocks[k];j++)
{
CB=IndexofBlocks[nfac*k+j]-1; //Current potential blocker
if(A[nfac*k+CB]==0)
continue; //Facets are not adjacent
j1=tlist[3*CB]-1;
j2=tlist[3*CB+1]-1;
j3=tlist[3*CB+2]-1;
w1=vlist+3*j1;
w2=vlist+3*j2;
w3=vlist+3*j3;
Calculate_Area_and_Normal_Derivative(w1,w2,w3,n2,dn2dx1,dn2dx2,dn2dx3,dn2dy1,dn2dy2,dn2dy3,dn2dz1,dn2dz2,dn2dz3,&area2,dA2dx,dA2dy,dA2dz);
cangle=DOT(n1,n2);
result+=(area2)*(1-cangle);
dresdx[i1]+=(area2)*(-DOT(dn1dx1,n2));
dresdx[i2]+=(area2)*(-DOT(dn1dx2,n2));
dresdx[i3]+=(area2)*(-DOT(dn1dx3,n2));
dresdy[i1]+=(area2)*(-DOT(dn1dy1,n2));
dresdy[i2]+=(area2)*(-DOT(dn1dy2,n2));
dresdy[i3]+=(area2)*(-DOT(dn1dy3,n2));
dresdz[i1]+=(area2)*(-DOT(dn1dz1,n2));
dresdz[i2]+=(area2)*(-DOT(dn1dz2,n2));
dresdz[i3]+=(area2)*(-DOT(dn1dz3,n2));
dresdx[j1]+=dA2dx[0]*(1-cangle)+(area2)*(-DOT(dn2dx1,n1));
dresdx[j2]+=dA2dx[1]*(1-cangle)+(area2)*(-DOT(dn2dx2,n1));
dresdx[j3]+=dA2dx[2]*(1-cangle)+(area2)*(-DOT(dn2dx3,n1));
dresdy[j1]+=dA2dy[0]*(1-cangle)+(area2)*(-DOT(dn2dy1,n1));
dresdy[j2]+=dA2dy[1]*(1-cangle)+(area2)*(-DOT(dn2dy2,n1));
dresdy[j3]+=dA2dy[2]*(1-cangle)+(area2)*(-DOT(dn2dy3,n1));
dresdz[j1]+=dA2dz[0]*(1-cangle)+(area2)*(-DOT(dn2dz1,n1));
dresdz[j2]+=dA2dz[1]*(1-cangle)+(area2)*(-DOT(dn2dz2,n1));
dresdz[j3]+=dA2dz[2]*(1-cangle)+(area2)*(-DOT(dn2dz3,n1));
}
}
free(A);
(*res)=result/TA;
if(D==NULL)
{
for(int j=0;j<nvert;j++)
{
drdx[j]=(dresdx[j]*TA-result*dTAdx[j])/pow(TA,2);
drdy[j]=(dresdy[j]*TA-result*dTAdy[j])/pow(TA,2);
drdz[j]=(dresdz[j]*TA-result*dTAdz[j])/pow(TA,2);
}
set_submatrix(drdv,1,3*dn+3,drdx,1,dn,0,0);
set_submatrix(drdv,1,3*dn+3,drdy,1,dn,0,dn);
set_submatrix(drdv,1,3*dn+3,drdz,1,dn,0,2*dn);
}
else
{
for(int j=0;j<nvert;j++)
{
dresdx[j]=(dresdx[j]*TA-result*dTAdx[j])/pow(TA,2);
dresdy[j]=(dresdy[j]*TA-result*dTAdy[j])/pow(TA,2);
dresdz[j]=(dresdz[j]*TA-result*dTAdz[j])/pow(TA,2);
}
matrix_prod(dresdx,1,nvert,D,dn,drdx);
matrix_prod(dresdy,1,nvert,D,dn,drdy);
matrix_prod(dresdz,1,nvert,D,dn,drdz);
set_submatrix(drdv,1,3*dn+3,drdx,1,dn,0,0);
set_submatrix(drdv,1,3*dn+3,drdy,1,dn,0,dn);
set_submatrix(drdv,1,3*dn+3,drdz,1,dn,0,2*dn);
}
free(drdx);
free(drdy);
free(drdz);
free(dTAdx);
free(dTAdy);
free(dTAdz);
free(dresdx);
free(dresdy);
free(dresdz);
free(NumofBlocks);
free(IndexofBlocks);
}
main(int argc, char *argv[])
{
float **a,**b,**c;
int n;
int NB;
int i,j;
int x;
//double t0,t1;
struct timeval t0,t1;
long mtime, seconds, useconds;
// Using PAPI - from countloop.c
if (PAPI_VER_CURRENT !=
PAPI_library_init(PAPI_VER_CURRENT))
ehandler("PAPI_library_init error.");
const size_t EVENT_MAX = PAPI_num_counters();
// Suppressing output
// printf("# Max counters = %zd\n", EVENT_MAX);
if (PAPI_OK != PAPI_query_event(PAPI_TOT_INS))
ehandler("Cannot count PAPI_TOT_INS.");
if (PAPI_OK != PAPI_query_event(PAPI_FP_OPS))
ehandler("Cannot count PAPI_FP_OPS.");
if (PAPI_OK != PAPI_query_event(PAPI_L1_DCM))
ehandler("Cannot count PAPI_L1_DCM.");
size_t EVENT_COUNT = 3;
int events[] = { PAPI_TOT_INS, PAPI_FP_OPS, PAPI_L1_DCM };
long long values[EVENT_COUNT];
// Take size from args, not prompt
// printf("Enter n: "); scanf("%d",&n); printf("n = %d\n",n);
n = atoi(argv[1]);
NB = atoi(argv[2]);
a = matrix(1,n,1,n);
for (i=1; i<=n; i++)
for (j=1; j<=n; j++)
a[i][j] = i+j;
b = matrix(1,n,1,n);
for (i=1; i<=n; i++)
for (j=1; j<=n; j++)
b[i][j] = i-j;
//t0 = get_seconds();
gettimeofday(&t0, NULL);
// Start PAPI
PAPI_start_counters(events, EVENT_COUNT);
if (PAPI_OK != PAPI_read_counters(values, EVENT_COUNT))
ehandler("Problem reading counters.");
//for (x=0;x<1000;x++){
c = matrix_prod(n,n,n,n,a,b,NB);
//}
if (PAPI_OK != PAPI_read_counters(values, EVENT_COUNT))
ehandler("Problem reading counters.");
//t1 = get_seconds();
gettimeofday(&t1, NULL);
seconds = t1.tv_sec - t0.tv_sec;
useconds = t1.tv_usec - t0.tv_usec;
mtime = ((seconds) * 1000 + useconds/1000.0) + 0.5;
//printf("Time for matrix_prod = %f sec\n",t1-t0);
printf("%d\t%lld\t%lld\t%lld\t%ld\n", n, values[0], values[1],
values[2], mtime);
}
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 dihedral_angle_reg(int *tlist,double *vlist,int nfac,int nvert,double *D,int dm,int dn,double *result,double *drsdv)
{
/*OUTPUT:
* result a double
* dresdx 1x3*nvert+3 array
*/
*result=0;
int nedge=nfac+nvert-2;
double *res,*drdx,*drdy,*drdz;
int *EV;
res=calloc(nedge,sizeof(double));
drdx=calloc(nedge*nvert,sizeof(double));
drdy=calloc(nedge*nvert,sizeof(double));
drdz=calloc(nedge*nvert,sizeof(double));
double *drsdx,*drsdy,*drsdz;
double *dresdx,*dresdy,*dresdz;
EV=malloc(nvert*nvert*sizeof(int));
dihedral_angle(tlist,vlist,nfac,nvert,res,EV,drdx,drdy,drdz);
if(D!=NULL && dm!=nvert)
{
puts("Error: Number of vertex coordinates is not equal to the number of rows in D.");
exit(1);
}
if(D==NULL)
dn=nvert;
drsdx=calloc(nedge*dn,sizeof(double));
drsdy=calloc(nedge*dn,sizeof(double));
drsdz=calloc(nedge*dn,sizeof(double));
if(D==NULL)
for(int j=0;j<nedge;j++)
{
(*result)+=pow(1-res[j],2);
for(int k=0;k<nvert;k++)
{
drsdx[k]+=-2*(1-res[j])*drdx[j*nvert+k];
drsdy[k]+=-2*(1-res[j])*drdy[j*nvert+k];
drsdz[k]+=-2*(1-res[j])*drdz[j*nvert+k];
}
}
else
{
dresdx=calloc(nvert,sizeof(double));
dresdy=calloc(nvert,sizeof(double));
dresdz=calloc(nvert,sizeof(double));
for(int j=0;j<nedge;j++)
{
(*result)+=pow(1-res[j],2);
for(int k=0;k<nvert;k++)
{
dresdx[k]+=-2*(1-res[j])*drdx[j*nvert+k];
dresdy[k]+=-2*(1-res[j])*drdy[j*nvert+k];
dresdz[k]+=-2*(1-res[j])*drdz[j*nvert+k];
}
}
matrix_prod(dresdx,1,nvert,D,dn,drsdx);
matrix_prod(dresdy,1,nvert,D,dn,drsdy);
matrix_prod(dresdz,1,nvert,D,dn,drsdz);
free(dresdx);
free(dresdy);
free(dresdz);
}
set_submatrix(drsdv,1,3*dn+3,drsdx,1,dn,0,0);
set_submatrix(drsdv,1,3*dn+3,drsdy,1,dn,0,dn);
set_submatrix(drsdv,1,3*dn+3,drsdz,1,dn,0,2*dn);
free(drsdx);
free(drsdy);
free(drsdz);
free(res);
free(drdx);
free(drdy);
free(drdz);
free(EV);
}
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);
}
}
static void burg2(Array ss_ff, Array ss_bb, Array ss_fb, Array E,
Array KA, Array KB)
/*
Estimate partial correlation by minimizing (1/2)*log(det(s)) where
"s" is the the sum of the forward and backward prediction errors.
In the multivariate case, the forward (KA) and backward (KB) partial
correlation coefficients are related by
KA = solve(E) %*% t(KB) %*% E
where E is the prediction variance.
*/
{
int i, j, k, l, nser = NROW(ss_ff);
int iter;
Array ss_bf;
Array s, tmp, d1;
Array D1, D2, THETA, THETAOLD, THETADIFF, TMP;
Array obj;
Array e, f, g, h, sg, sh;
Array theta;
ss_bf = make_zero_matrix(nser,nser);
transpose_matrix(ss_fb, ss_bf);
s = make_zero_matrix(nser, nser);
tmp = make_zero_matrix(nser, nser);
d1 = make_zero_matrix(nser, nser);
e = make_zero_matrix(nser, nser);
f = make_zero_matrix(nser, nser);
g = make_zero_matrix(nser, nser);
h = make_zero_matrix(nser, nser);
sg = make_zero_matrix(nser, nser);
sh = make_zero_matrix(nser, nser);
theta = make_zero_matrix(nser, nser);
D1 = make_zero_matrix(nser*nser, 1);
D2 = make_zero_matrix(nser*nser, nser*nser);
THETA = make_zero_matrix(nser*nser, 1); /* theta in vector form */
THETAOLD = make_zero_matrix(nser*nser, 1);
THETADIFF = make_zero_matrix(nser*nser, 1);
TMP = make_zero_matrix(nser*nser, 1);
obj = make_zero_matrix(1,1);
/* utility matrices e,f,g,h */
qr_solve(E, ss_bf, e);
qr_solve(E, ss_fb, f);
qr_solve(E, ss_bb, tmp);
transpose_matrix(tmp, tmp);
qr_solve(E, tmp, g);
qr_solve(E, ss_ff, tmp);
transpose_matrix(tmp, tmp);
qr_solve(E, tmp, h);
for(iter = 0; iter < BURG_MAX_ITER; iter++)
{
/* Forward and backward partial correlation coefficients */
transpose_matrix(theta, tmp);
qr_solve(E, tmp, tmp);
transpose_matrix(tmp, KA);
qr_solve(E, theta, tmp);
transpose_matrix(tmp, KB);
/* Sum of forward and backward prediction errors ... */
set_array_to_zero(s);
/* Forward */
array_op(s, ss_ff, '+', s);
matrix_prod(KA, ss_bf, 0, 0, tmp);
array_op(s, tmp, '-', s);
transpose_matrix(tmp, tmp);
array_op(s, tmp, '-', s);
matrix_prod(ss_bb, KA, 0, 1, tmp);
matrix_prod(KA, tmp, 0, 0, tmp);
array_op(s, tmp, '+', s);
/* Backward */
array_op(s, ss_bb, '+', s);
matrix_prod(KB, ss_fb, 0, 0, tmp);
array_op(s, tmp, '-', s);
transpose_matrix(tmp, tmp);
array_op(s, tmp, '-', s);
matrix_prod(ss_ff, KB, 0, 1, tmp);
matrix_prod(KB, tmp, 0, 0, tmp);
array_op(s, tmp, '+', s);
matrix_prod(s, f, 0, 0, d1);
matrix_prod(e, s, 1, 0, tmp);
array_op(d1, tmp, '+', d1);
/*matrix_prod(g,s,0,0,sg);*/
matrix_prod(s,g,0,0,sg);
matrix_prod(s,h,0,0,sh);
for (i = 0; i < nser; i++) {
for (j = 0; j < nser; j++) {
MATRIX(D1)[nser*i+j][0] = MATRIX(d1)[i][j];
for (k = 0; k < nser; k++)
for (l = 0; l < nser; l++) {
MATRIX(D2)[nser*i+j][nser*k+l] =
(i == k) * MATRIX(sg)[j][l] +
MATRIX(sh)[i][k] * (j == l);
}
}
}
copy_array(THETA, THETAOLD);
qr_solve(D2, D1, THETA);
for (i = 0; i < vector_length(theta); i++)
VECTOR(theta)[i] = VECTOR(THETA)[i];
matrix_prod(D2, THETA, 0, 0, TMP);
array_op(THETAOLD, THETA, '-', THETADIFF);
matrix_prod(D2, THETADIFF, 0, 0, TMP);
matrix_prod(THETADIFF, TMP, 1, 0, obj);
if (VECTOR(obj)[0] < BURG_TOL)
break;
}
if (iter == BURG_MAX_ITER)
error(_("Burg's algorithm failed to find partial correlation"));
}
static void burg0(int omax, Array resid_f, Array resid_b, Array *A, Array *B,
Array P, Array V, int vmethod)
{
int i, j, m, n = NCOL(resid_f), nser=NROW(resid_f);
Array ss_ff, ss_bb, ss_fb;
Array resid_f_tmp, resid_b_tmp;
Array KA, KB, E;
Array id, tmp;
ss_ff = make_zero_matrix(nser, nser);
ss_fb = make_zero_matrix(nser, nser);
ss_bb = make_zero_matrix(nser, nser);
resid_f_tmp = make_zero_matrix(nser, n);
resid_b_tmp = make_zero_matrix(nser, n);
id = make_identity_matrix(nser);
tmp = make_zero_matrix(nser, nser);
E = make_zero_matrix(nser, nser);
KA = make_zero_matrix(nser, nser);
KB = make_zero_matrix(nser, nser);
set_array_to_zero(A[0]);
set_array_to_zero(B[0]);
copy_array(id, subarray(A[0],0));
copy_array(id, subarray(B[0],0));
matrix_prod(resid_f, resid_f, 0, 1, E);
scalar_op(E, n, '/', E);
copy_array(E, subarray(V,0));
for (m = 0; m < omax; m++) {
for(i = 0; i < nser; i++) {
for (j = n - 1; j > m; j--) {
MATRIX(resid_b)[i][j] = MATRIX(resid_b)[i][j-1];
}
MATRIX(resid_f)[i][m] = 0.0;
MATRIX(resid_b)[i][m] = 0.0;
}
matrix_prod(resid_f, resid_f, 0, 1, ss_ff);
matrix_prod(resid_b, resid_b, 0, 1, ss_bb);
matrix_prod(resid_f, resid_b, 0, 1, ss_fb);
burg2(ss_ff, ss_bb, ss_fb, E, KA, KB); /* Update K */
for (i = 0; i <= m + 1; i++) {
matrix_prod(KA, subarray(B[m], m + 1 - i), 0, 0, tmp);
array_op(subarray(A[m], i), tmp, '-', subarray(A[m+1], i));
matrix_prod(KB, subarray(A[m], m + 1 - i), 0, 0, tmp);
array_op(subarray(B[m], i), tmp, '-', subarray(B[m+1], i));
}
matrix_prod(KA, resid_b, 0, 0, resid_f_tmp);
matrix_prod(KB, resid_f, 0, 0, resid_b_tmp);
array_op(resid_f, resid_f_tmp, '-', resid_f);
array_op(resid_b, resid_b_tmp, '-', resid_b);
if (vmethod == 1) {
matrix_prod(KA, KB, 0, 0, tmp);
array_op(id, tmp, '-', tmp);
matrix_prod(tmp, E, 0, 0, E);
}
else if (vmethod == 2) {
matrix_prod(resid_f, resid_f, 0, 1, E);
matrix_prod(resid_b, resid_b, 0, 1, tmp);
array_op(E, tmp, '+', E);
scalar_op(E, 2.0*(n - m - 1), '/', E);
}
else error(_("Invalid vmethod"));
copy_array(E, subarray(V,m+1));
copy_array(KA, subarray(P,m+1));
}
}
void multi_burg(int *pn, double *x, int *pomax, int *pnser, double *coef,
double *pacf, double *var, double *aic, int *porder, int *useaic,
int *vmethod)
{
int i, j, m, omax = *pomax, n = *pn, nser=*pnser, order=*porder;
int dim1[3];
double aicmin;
Array xarr, resid_f, resid_b, resid_f_tmp;
Array *A, *B, P, V;
dim1[0] = omax+1; dim1[1] = dim1[2] = nser;
A = (Array *) R_alloc(omax+1, sizeof(Array));
B = (Array *) R_alloc(omax+1, sizeof(Array));
for (i = 0; i <= omax; i++) {
A[i] = make_zero_array(dim1, 3);
B[i] = make_zero_array(dim1, 3);
}
P = make_array(pacf, dim1, 3);
V = make_array(var, dim1, 3);
xarr = make_matrix(x, nser, n);
resid_f = make_zero_matrix(nser, n);
resid_b = make_zero_matrix(nser, n);
set_array_to_zero(resid_b);
copy_array(xarr, resid_f);
copy_array(xarr, resid_b);
resid_f_tmp = make_zero_matrix(nser, n);
burg0(omax, resid_f, resid_b, A, B, P, V, *vmethod);
/* Model order selection */
for (i = 0; i <= omax; i++) {
aic[i] = n * ldet(subarray(V,i)) + 2 * i * nser * nser;
}
if (*useaic) {
order = 0;
aicmin = aic[0];
for (i = 1; i <= omax; i++) {
if (aic[i] < aicmin) {
aicmin = aic[i];
order = i;
}
}
}
else order = omax;
*porder = order;
for(i = 0; i < vector_length(A[order]); i++)
coef[i] = VECTOR(A[order])[i];
if (*useaic) {
/* Recalculate residuals for chosen model */
set_array_to_zero(resid_f);
set_array_to_zero(resid_f_tmp);
for (m = 0; m <= order; m++) {
for (i = 0; i < NROW(resid_f_tmp); i++) {
for (j = 0; j < NCOL(resid_f_tmp) - order; j++) {
MATRIX(resid_f_tmp)[i][j + order] = MATRIX(xarr)[i][j + order - m];
}
}
matrix_prod(subarray(A[order],m), resid_f_tmp, 0, 0, resid_f_tmp);
array_op(resid_f_tmp, resid_f, '+', resid_f);
}
}
copy_array(resid_f, xarr);
}
