int starma(int ip, int iq,double *phi,double *theta,double *A,double *P,double *V) {
int ifault,ir,np,nrbar,i,ind,j,ir1,irank,ifail;
int npr, npr1, ind1, ind2, indj,indi,indn;
double vj,ssqerr,phij,phii,ynext,weight,recres;
double *thetab, *xnext, *xrow, *rbar;
ifault = 0;
/*
c algorithm as 154 appl. statist. (1980) vol.29, no.3
c
c invoking this subroutine sets the values of v and phi, and obtains
c the initial values of a and p.
c this routine is not suitable for use with an ar(1) process.
c in this case the following instructions should be used for
c initialisation.
c v(1)=1.0
c a(1)=0.0
c p(1)=1.0/(1.0-phi(1)*phi(1))
c
*/
// Check for input errors
if (ip < 0) {
ifault = 1;
}
if (iq < 0) {
ifault = 2;
}
if (ip*ip + iq*iq == 0) {
ifault = 4;
}
ir = iq + 1;
if (ir < ip) {
ir = ip;
}
np = (ir * (ir + 1)) / 2;
nrbar = (np * (np - 1)) / 2;
if (ir == 1) {
ifault = 8;
}
if (ifault != 0) {
return ifault;
}
xnext = (double*)malloc(sizeof(double)* np);
thetab = (double*)malloc(sizeof(double)* np);
xrow = (double*)malloc(sizeof(double)* np);
rbar = (double*)malloc(sizeof(double)* nrbar);
for (i = 1; i < ir;++i) {
A[i] = 0.0;
if (i >= ip) {
phi[i] = 0.0;
}
V[i] = 0.0;
if (i < iq+1) {
V[i] = theta[i - 1];
}
}
A[0] = 0.0;
if (ip == 0) {
phi[0] = 0.0;
}
V[0] = 1.0;
ind = ir;
for (j = 1; j < ir; ++j) {
vj = V[j];
for (i = j; i < ir; ++i) {
V[ind] = V[i] * vj;
ind++;
}
}
if (ip != 0) {//300
/*
c now find p(0).
c the set of equations s*vec(p(0))=vec(v) is solved for vec(p(0)).
c s is generated row by row in the array xnext.
c the order of elements in p is changed, so as to bring more leading
c zeros into the rows of s, hence achieving a reduction of computing
c time.
*/
ir1 = ir - 1;
irank = 0;
ifail = 0;
ssqerr = 0.0;
for (i = 0; i < nrbar; ++i) {
rbar[i] = 0.0;
}
for (i = 0; i < np; ++i) {
P[i] = 0.0;
thetab[i] = 0.0;
xnext[i] = 0.0;
}
ind = 0;
ind1 = -1;
npr = np - ir;
npr1 = npr + 1;
indj = npr;
ind2 = npr-1;
for (j = 0; j < ir; ++j) {//110
phij = phi[j];
xnext[indj] = 0.0;
indj = indj + 1;
indi = npr1 + j;
for (i = j; i < ir; ++i) {//110
ynext = V[ind];
ind++;
phii = phi[i];
if (j != (ir - 1)) {
xnext[indj] = -phii;
if (i != (ir - 1)) {
xnext[indi] -= phij;
ind1 ++;
xnext[ind1] = -1.0;
}
}//100
xnext[npr] = -phii*phij;
ind2++;
if (ind2 >= np) {
ind2 = 0;
}
xnext[ind2] += 1.0;
weight = 1.0;
ifail = inclu2(np, nrbar, weight, xnext, xrow, ynext, P, rbar, thetab, &ssqerr, &recres, &irank);
//mdisplay(P, 1, np);
xnext[ind2] = 0.0;
if (i != (ir - 1)) {
xnext[indi] = 0.0;
indi++;
xnext[ind1] = 0.0;
}
}//110
}//110
//mdisplay(P, 1, np);
regres(np, nrbar, rbar, thetab, P);
/*
Now Re-order P
*/
ind = npr;
for (i = 0; i < ir; ++i) {
ind++;
xnext[i] = P[ind - 1];
}
ind = np;
ind1 = npr;
for (i = 0; i < npr; ++i) {
P[ind - 1] = P[ind1 - 1];
ind--;
ind1--;
}
for (i = 0; i < ir; ++i) {
P[i] = xnext[i];
}
//return ifault;
}
else {
// P[0] is obtained by back-substitution for a Moving Average process
indn = np;
ind = np;
for (i = 0; i < ir; i++) {
for (j = 0; j <= i; j++) {
ind--;
P[ind] = V[ind];
if (j != 0) {
indn--;
P[ind] += P[indn];
}
}
}
}
free(xnext);
free(thetab);
free(xrow);
free(rbar);
return ifault;
}
void starma(Starma G, int *ifault)
{
int p = G->p, q = G->q, r = G->r, np = G->np, nrbar = G->nrbar;
double *phi = G->phi, *theta = G->theta, *a = G->a,
*P = G->P, *V = G->V, *thetab = G->thetab, *xnext = G->xnext,
*xrow = G->xrow, *rbar = G->rbar;
int indi, indj, indn;
double phii, phij, ynext, vj, bi;
int i, j, k, ithisr, ind, npr, ind1, ind2, npr1, im, jm;
/* Invoking this subroutine sets the values of v and phi, and
obtains the initial values of a and p. */
/* Check if ar(1) */
if (!(q > 0 || p > 1)) {
V[0] = 1.0;
a[0] = 0.0;
P[0] = 1.0 / (1.0 - phi[0] * phi[0]);
return;
}
/* Check for failure indication. */
*ifault = 0;
if (p < 0) *ifault = 1;
if (q < 0) *ifault += 2;
if (p == 0 && q == 0) *ifault = 4;
k = q + 1;
if (k < p) k = p;
if (r != k) *ifault = 5;
if (np != r * (r + 1) / 2) *ifault = 6;
if (nrbar != np * (np - 1) / 2) *ifault = 7;
if (r == 1) *ifault = 8;
if (*ifault != 0) return;
/* Now set a(0), V and phi. */
for (i = 1; i < r; i++) {
a[i] = 0.0;
if (i >= p) phi[i] = 0.0;
V[i] = 0.0;
if (i < q + 1) V[i] = theta[i - 1];
}
a[0] = 0.0;
if (p == 0) phi[0] = 0.0;
V[0] = 1.0;
ind = r;
for (j = 1; j < r; j++) {
vj = V[j];
for (i = j; i < r; i++) V[ind++] = V[i] * vj;
}
/* Now find p(0). */
if (p > 0) {
/* The set of equations s * vec(p(0)) = vec(v) is solved for
vec(p(0)). s is generated row by row in the array xnext. The
order of elements in p is changed, so as to bring more leading
zeros into the rows of s. */
for (i = 0; i < nrbar; i++) rbar[i] = 0.0;
for (i = 0; i < np; i++) {
P[i] = 0.0;
thetab[i] = 0.0;
xnext[i] = 0.0;
}
ind = 0;
ind1 = -1;
npr = np - r;
npr1 = npr + 1;
indj = npr;
ind2 = npr - 1;
for (j = 0; j < r; j++) {
phij = phi[j];
xnext[indj++] = 0.0;
indi = npr1 + j;
for (i = j; i < r; i++) {
ynext = V[ind++];
phii = phi[i];
if (j != r - 1) {
xnext[indj] = -phii;
if (i != r - 1) {
xnext[indi] -= phij;
xnext[++ind1] = -1.0;
}
}
xnext[npr] = -phii * phij;
if (++ind2 >= np) ind2 = 0;
xnext[ind2] += 1.0;
inclu2(np, xnext, xrow, ynext, P, rbar, thetab);
xnext[ind2] = 0.0;
if (i != r - 1) {
xnext[indi++] = 0.0;
xnext[ind1] = 0.0;
}
}
}
ithisr = nrbar - 1;
im = np - 1;
for (i = 0; i < np; i++) {
bi = thetab[im];
for (jm = np - 1, j = 0; j < i; j++)
bi -= rbar[ithisr--] * P[jm--];
P[im--] = bi;
}
/* now re-order p. */
ind = npr;
for (i = 0; i < r; i++) xnext[i] = P[ind++];
ind = np - 1;
ind1 = npr - 1;
for (i = 0; i < npr; i++) P[ind--] = P[ind1--];
for (i = 0; i < r; i++) P[i] = xnext[i];
} else {
/* P(0) is obtained by backsubstitution for a moving average process. */
indn = np;
ind = np;
for (i = 0; i < r; i++)
for (j = 0; j <= i; j++) {
--ind;
P[ind] = V[ind];
if (j != 0) P[ind] += P[--indn];
}
}
}
