ERROR_CODE ran_service() {
/* allocates the return value */
ERROR_CODE return_value;
/* in case the service status is open */
if(service->status == STATUS_CLOSED) {
/* prints a debug message */
V_DEBUG("No service to be stopped\n");
} else {
/* prints a debug message */
V_DEBUG("Stopping service\n");
/* stops the service, this call should make the
required changes in the service structure so that
it's stopped as soon as possible */
return_value = stop_service(service);
/* tests the error code for error */
if(IS_ERROR_CODE(return_value)) {
/* runs the socket finish so that the proper cleanup
operations are performed and then re-raises the error*/
SOCKET_FINISH();
RAISE_AGAIN(return_value);
}
/* prints a debug message */
V_DEBUG("Finished stopping service\n");
}
/* raises no error */
RAISE_NO_ERROR;
}
ERROR_CODE destroy_service() {
/* prints a debug message about the initial stage
of the service structures destruction */
V_DEBUG("Destroying the service structures\n");
/* deletes the service, disallowing any further
access to the service instance, and then sets its
reference back to the original (unset sate) */
delete_service(service);
service = NULL;
/* prints a debug message about the final stage
of the service structures destruction */
V_DEBUG("Finished destroying the service structures\n");
/* raises no error to the caller method, normal
exit operation (should provide no problem) */
RAISE_NO_ERROR;
}
void cleanup(struct hash_map_t *arguments) {
/* allocates space for the possible argument
to be executed from the arguments map */
void *value;
/* prints a debug message */
V_DEBUG("Cleaning the process information\n");
/* in case no arguments map is provided must return
immediately nothing left to be processed */
if(arguments == NULL) {
return;
}
/* tries to retrieve the daemon argument from the
arguments map in case the value is set daemonclean
the current process so that no structures remaining
from the daemon process are left */
get_value_string_hash_map(arguments, (unsigned char *) "daemon", &value);
if(value != NULL) {
daemonclean();
}
}
/*
* n_vars is the number of variables to be considered,
* d is the data array of variables d[0],...,d[n_vars-1],
* pred determines which estimate is required: BLUE, BLUP, or BLP
*/
void gls(DATA **d /* pointer to DATA array */,
int n_vars, /* length of DATA array (to consider) */
enum GLS_WHAT pred, /* what type of prediction is requested */
DPOINT *where, /* prediction location */
double *est /* output: array that holds the predicted values and variances */)
{
GLM *glm = NULL; /* to be copied to/from d */
static MAT *X0 = MNULL, *C0 = MNULL, *MSPE = MNULL, *CinvC0 = MNULL,
*Tmp1 = MNULL, *Tmp2 = MNULL, *Tmp3, *R = MNULL;
static VEC *blup = VNULL, *tmpa = VNULL, *tmpb = VNULL;
volatile unsigned int i, rows_C;
unsigned int j, k, l = 0, row, col, start_i, start_j, start_X, global;
VARIOGRAM *v = NULL;
static enum GLS_WHAT last_pred = GLS_INIT; /* the initial value */
double c_value, *X_ori;
if (d == NULL) { /* clean up */
if (X0 != MNULL) M_FREE(X0);
if (C0 != MNULL) M_FREE(C0);
if (MSPE != MNULL) M_FREE(MSPE);
if (CinvC0 != MNULL) M_FREE(CinvC0);
if (Tmp1 != MNULL) M_FREE(Tmp1);
if (Tmp2 != MNULL) M_FREE(Tmp2);
if (Tmp3 != MNULL) M_FREE(Tmp3);
if (R != MNULL) M_FREE(R);
if (blup != VNULL) V_FREE(blup);
if (tmpa != VNULL) V_FREE(tmpa);
if (tmpb != VNULL) V_FREE(tmpb);
last_pred = GLS_INIT;
return;
}
#ifndef HAVE_SPARSE
if (gl_sparse) {
pr_warning("sparse matrices not supported: compile with --with-sparse");
gl_sparse = 0;
}
#endif
if (DEBUG_COV) {
printlog("we're at %s X: %g Y: %g Z: %g\n",
IS_BLOCK(where) ? "block" : "point",
where->x, where->y, where->z);
}
if (pred != UPDATE) /* it right away: */
last_pred = pred;
assert(last_pred != GLS_INIT);
if (d[0]->glm == NULL) { /* allocate and initialize: */
glm = new_glm();
d[0]->glm = (void *) glm;
} else
glm = (GLM *) d[0]->glm;
glm->mu0 = v_resize(glm->mu0, n_vars);
MSPE = m_resize(MSPE, n_vars, n_vars);
if (pred == GLS_BLP || UPDATE_BLP) {
X_ori = where->X;
for (i = 0; i < n_vars; i++) { /* mu(0) */
glm->mu0->ve[i] = calc_mu(d[i], where);
blup = v_copy(glm->mu0, v_resize(blup, glm->mu0->dim));
where->X += d[i]->n_X; /* shift to next x0 entry */
}
where->X = X_ori; /* ... and set back */
for (i = 0; i < n_vars; i++) { /* Cij(0,0): */
for (j = 0; j <= i; j++) {
v = get_vgm(LTI(d[i]->id,d[j]->id));
MSPE->me[i][j] = MSPE->me[j][i] = COVARIANCE0(v, where, where, d[j]->pp_norm2);
}
}
fill_est(NULL, blup, MSPE, n_vars, est); /* in case of empty neighbourhood */
}
/* xxx */
/*
logprint_variogram(v, 1);
*/
/*
* selection dependent problem dimensions:
*/
for (i = rows_C = 0; i < n_vars; i++)
rows_C += d[i]->n_sel;
if (rows_C == 0) { /* empty selection list(s) */
if (pred == GLS_BLP || UPDATE_BLP)
debug_result(blup, MSPE, pred);
return;
}
for (i = 0, global = 1; i < n_vars && global; i++)
global = (d[i]->sel == d[i]->list && d[i]->n_list == d[i]->n_original);
/*
* global things: enter whenever (a) first time, (b) local selections or
* (c) the size of the problem grew since the last call (e.g. simulation)
*/
if ((glm->C == NULL && glm->spC == NULL) || !global || rows_C > glm->C->m) {
/*
* fill y:
*/
glm->y = get_y(d, glm->y, n_vars);
if (pred != UPDATE) {
if (! gl_sparse) {
glm->C = m_resize(glm->C, rows_C, rows_C);
m_zero(glm->C);
}
#ifdef HAVE_SPARSE
else {
if (glm->C == NULL) {
glm->spC = sp_get(rows_C, rows_C, gl_sparse);
/* d->spLLT = spLLT = sp_get(rows_C, rows_C, gl_sparse); */
} else {
glm->spC = sp_resize(glm->spC, rows_C, rows_C);
/* d->spLLT = spLLT = sp_resize(spLLT, rows_C, rows_C); */
}
sp_zero(glm->spC);
}
#endif
glm->X = get_X(d, glm->X, n_vars);
M_DEBUG(glm->X, "X");
glm->CinvX = m_resize(glm->CinvX, rows_C, glm->X->n);
glm->XCinvX = m_resize(glm->XCinvX, glm->X->n, glm->X->n);
glm->beta = v_resize(glm->beta, glm->X->n);
for (i = start_X = start_i = 0; i < n_vars; i++) { /* row var */
/* fill C, mu: */
for (j = start_j = 0; j <= i; j++) { /* col var */
v = get_vgm(LTI(d[i]->id,d[j]->id));
for (k = 0; k < d[i]->n_sel; k++) { /* rows */
row = start_i + k;
for (l = 0, col = start_j; col <= row && l < d[j]->n_sel; l++, col++) {
if (pred == GLS_BLUP)
c_value = GCV(v, d[i]->sel[k], d[j]->sel[l]);
else
c_value = COVARIANCE(v, d[i]->sel[k], d[j]->sel[l]);
/* on the diagonal, if necessary, add measurement error variance */
if (d[i]->colnvariance && i == j && k == l)
c_value += d[i]->sel[k]->variance;
if (! gl_sparse)
glm->C->me[row][col] = c_value;
#ifdef HAVE_SPARSE
else {
if (c_value != 0.0)
sp_set_val(glm->spC, row, col, c_value);
}
#endif
} /* for l */
} /* for k */
start_j += d[j]->n_sel;
} /* for j */
start_i += d[i]->n_sel;
if (d[i]->n_sel > 0)
start_X += d[i]->n_X - d[i]->n_merge;
} /* for i */
/*
if (d[0]->colnvmu)
glm->C = convert_vmuC(glm->C, d[0]);
*/
if (d[0]->variance_fn) {
glm->mu = get_mu(glm->mu, glm->y, d, n_vars);
convert_C(glm->C, glm->mu, d[0]->variance_fn);
}
if (DEBUG_COV && pred == GLS_BLUP)
printlog("[using generalized covariances: max_val - semivariance()]");
if (! gl_sparse) {
M_DEBUG(glm->C, "Covariances (x_i, x_j) matrix C (lower triangle only)");
}
#ifdef HAVE_SPARSE
else {
SM_DEBUG(glm->spC, "Covariances (x_i, x_j) sparse matrix C (lower triangle only)")
}
#endif
/* check for singular C: */
if (! gl_sparse && gl_cn_max > 0.0) {
for (i = 0; i < rows_C; i++) /* row */
for (j = i+1; j < rows_C; j++) /* col > row */
glm->C->me[i][j] = glm->C->me[j][i]; /* fill symmetric */
if (is_singular(glm->C, gl_cn_max)) {
pr_warning("Covariance matrix (nearly) singular at location [%g,%g,%g]: skipping...",
where->x, where->y, where->z);
m_free(glm->C); glm->C = MNULL; /* assure re-entrance if global */
return;
}
}
/*
* factorize C:
*/
if (! gl_sparse)
LDLfactor(glm->C);
#ifdef HAVE_SPARSE
else {
sp_compact(glm->spC, 0.0);
spCHfactor(glm->spC);
}
#endif
} /* if (pred != UPDATE) */
if (pred != GLS_BLP && !UPDATE_BLP) { /* C-1 X and X'C-1 X, beta */
/*
* calculate CinvX:
*/
tmpa = v_resize(tmpa, rows_C);
for (i = 0; i < glm->X->n; i++) {
tmpa = get_col(glm->X, i, tmpa);
if (! gl_sparse)
tmpb = LDLsolve(glm->C, tmpa, tmpb);
#ifdef HAVE_SPARSE
else
tmpb = spCHsolve(glm->spC, tmpa, tmpb);
#endif
set_col(glm->CinvX, i, tmpb);
}
/*
* calculate X'C-1 X:
*/
glm->XCinvX = mtrm_mlt(glm->X, glm->CinvX, glm->XCinvX); /* X'C-1 X */
M_DEBUG(glm->XCinvX, "X'C-1 X");
if (gl_cn_max > 0.0 && is_singular(glm->XCinvX, gl_cn_max)) {
pr_warning("X'C-1 X matrix (nearly) singular at location [%g,%g,%g]: skipping...",
where->x, where->y, where->z);
m_free(glm->C); glm->C = MNULL; /* assure re-entrance if global */
return;
}
m_inverse(glm->XCinvX, glm->XCinvX);
/*
* calculate beta:
*/
tmpa = vm_mlt(glm->CinvX, glm->y, tmpa); /* X'C-1 y */
glm->beta = vm_mlt(glm->XCinvX, tmpa, glm->beta); /* (X'C-1 X)-1 X'C-1 y */
V_DEBUG(glm->beta, "beta");
M_DEBUG(glm->XCinvX, "Cov(beta), (X'C-1 X)-1");
M_DEBUG(R = get_corr_mat(glm->XCinvX, R), "Corr(beta)");
} /* if pred != GLS_BLP */
} /* if redo the heavy part */
