/* try to find a 8.3 name in the cache, and if found then replace the string with the original long name. */ static bool lookup_name_from_8_3(TALLOC_CTX *ctx, const char *name, char **pp_out, /* talloced on the given context. */ const struct share_params *p) { unsigned int hash, multiplier; unsigned int i; char *prefix; char extension[4]; *pp_out = NULL; /* make sure that this is a mangled name from this cache */ if (!is_mangled(name, p)) { M_DEBUG(10,("lookup_name_from_8_3: %s -> not mangled\n", name)); return False; } /* we need to extract the hash from the 8.3 name */ hash = base_reverse[(unsigned char)name[7]]; for (multiplier=36, i=5;i>=mangle_prefix;i--) { unsigned int v = base_reverse[(unsigned char)name[i]]; hash += multiplier * v; multiplier *= 36; } /* now look in the prefix cache for that hash */ prefix = cache_lookup(ctx, hash); if (!prefix) { M_DEBUG(10,("lookup_name_from_8_3: %s -> %08X -> not found\n", name, hash)); return False; } /* we found it - construct the full name */ if (name[8] == '.') { strncpy(extension, name+9, 3); extension[3] = 0; } else { extension[0] = 0; } if (extension[0]) { M_DEBUG(10,("lookup_name_from_8_3: %s -> %s.%s\n", name, prefix, extension)); *pp_out = talloc_asprintf(ctx, "%s.%s", prefix, extension); } else { M_DEBUG(10,("lookup_name_from_8_3: %s -> %s\n", name, prefix)); *pp_out = talloc_strdup(ctx, prefix); } TALLOC_FREE(prefix); if (!*pp_out) { M_DEBUG(0,("talloc_fail")); return False; } return True; }
bool generate_default_ids(std::vector<std::string> & IDs) { // this leave one CPU to attend to everything else but our work int cpu_cnt = get_available_cpu_count(); if (1 > cpu_cnt) { M_NOTICE("CPU count does not meet minimum requirements"); return false; } M_DEBUG("cpu_cnt = %d\n", cpu_cnt); char host_name[MAXHOSTNAMELEN] = { '\0' }; if (gethostname(host_name, sizeof(host_name))) { M_ERROR("could not get host name %s", strerror(errno)); return false; } char domain_name[MAXHOSTNAMELEN] = { '\0' }; if (getdomainname(domain_name, sizeof(domain_name))) { M_ERROR("could not get domain name %s", strerror(errno)); return false; } IDs.clear(); std::string id; for (int n = 0; n < cpu_cnt; ++n) { id = host_name; id += "."; id += domain_name; id += n; IDs.push_back(id); } return true; }
/* determine if a string is possibly in a mangled format, ignoring case In this algorithm, mangled names use only pure ascii characters (no multi-byte) so we can avoid doing a UCS2 conversion */ static bool is_mangled_component(struct pvfs_mangle_context *ctx, const char *name, size_t len) { unsigned int i; M_DEBUG(10,("is_mangled_component %s (len %u) ?\n", name, (unsigned int)len)); /* check the length */ if (len > 12 || len < 8) return false; /* the best distinguishing characteristic is the ~ */ if (name[6] != '~') return false; /* check extension */ if (len > 8) { if (name[8] != '.') return false; for (i=9; name[i] && i < len; i++) { if (! FLAG_CHECK(name[i], FLAG_ASCII)) { return false; } } } /* check lead characters */ for (i=0;i<ctx->mangle_prefix;i++) { if (! FLAG_CHECK(name[i], FLAG_ASCII)) { return false; } } /* check rest of hash */ if (! FLAG_CHECK(name[7], FLAG_BASECHAR)) { return false; } for (i=ctx->mangle_prefix;i<6;i++) { if (! FLAG_CHECK(name[i], FLAG_BASECHAR)) { return false; } } M_DEBUG(10,("is_mangled_component %s (len %u) -> yes\n", name, (unsigned int)len)); return true; }
/* try to find a 8.3 name in the cache, and if found then replace the string with the original long name. */ static BOOL check_cache(char *name, size_t maxlen) { u32 hash, multiplier; unsigned int i; const char *prefix; char extension[4]; /* make sure that this is a mangled name from this cache */ if (!is_mangled(name)) { M_DEBUG(10,("check_cache: %s -> not mangled\n", name)); return False; } /* we need to extract the hash from the 8.3 name */ hash = base_reverse[(unsigned char)name[7]]; for (multiplier=36, i=5;i>=mangle_prefix;i--) { u32 v = base_reverse[(unsigned char)name[i]]; hash += multiplier * v; multiplier *= 36; } /* now look in the prefix cache for that hash */ prefix = cache_lookup(hash); if (!prefix) { M_DEBUG(10,("check_cache: %s -> %08X -> not found\n", name, hash)); return False; } /* we found it - construct the full name */ if (name[8] == '.') { strncpy(extension, name+9, 3); extension[3] = 0; } else { extension[0] = 0; } if (extension[0]) { M_DEBUG(10,("check_cache: %s -> %s.%s\n", name, prefix, extension)); slprintf(name, maxlen, "%s.%s", prefix, extension); } else { M_DEBUG(10,("check_cache: %s -> %s\n", name, prefix)); safe_strcpy(name, prefix, maxlen); } return True; }
/* try to find a 8.3 name in the cache, and if found then return the original long name. */ static char *check_cache(struct pvfs_mangle_context *ctx, TALLOC_CTX *mem_ctx, const char *name) { uint32_t hash, multiplier; unsigned int i; const char *prefix; char extension[4]; /* make sure that this is a mangled name from this cache */ if (!is_mangled(ctx, name)) { M_DEBUG(10,("check_cache: %s -> not mangled\n", name)); return NULL; } /* we need to extract the hash from the 8.3 name */ hash = ctx->base_reverse[(unsigned char)name[7]]; for (multiplier=36, i=5;i>=ctx->mangle_prefix;i--) { uint32_t v = ctx->base_reverse[(unsigned char)name[i]]; hash += multiplier * v; multiplier *= 36; } /* now look in the prefix cache for that hash */ prefix = cache_lookup(ctx, hash); if (!prefix) { M_DEBUG(10,("check_cache: %s -> %08X -> not found\n", name, hash)); return NULL; } /* we found it - construct the full name */ if (name[8] == '.') { strncpy(extension, name+9, 3); extension[3] = 0; } else { extension[0] = 0; } if (extension[0]) { return talloc_asprintf(mem_ctx, "%s.%s", prefix, extension); } return talloc_strdup(mem_ctx, prefix); }
static void _rpc_thread(void* param) { int tid; M_DEBUG("%s\n", __func__); M_PRINTF("RPC thread running\n"); tid = GetThreadId(); sceSifSetRpcQueue(&rpc_queue, tid); sceSifRegisterRpc(&rpc_server, SMAP_BIND_RPC_ID, (void *)_rpc_cmd_handler, _rpc_buffer, 0, 0, &rpc_queue); sceSifRpcLoop(&rpc_queue); }
/* determine if a string is possibly in a mangled format, ignoring case In this algorithm, mangled names use only pure ascii characters (no multi-byte) so we can avoid doing a UCS2 conversion NOTE! This interface must be able to handle a path with unix directory separators. It should return true if any component is mangled */ static bool is_mangled(struct pvfs_mangle_context *ctx, const char *name) { const char *p; const char *s; M_DEBUG(10,("is_mangled %s ?\n", name)); for (s=name; (p=strchr(s, '/')); s=p+1) { if (is_mangled_component(ctx, s, PTR_DIFF(p, s))) { return true; } } /* and the last part ... */ return is_mangled_component(ctx, s, strlen(s)); }
/* determine if a string is possibly in a mangled format, ignoring case In this algorithm, mangled names use only pure ascii characters (no multi-byte) so we can avoid doing a UCS2 conversion NOTE! This interface must be able to handle a path with unix directory separators. It should return true if any component is mangled */ static BOOL is_mangled(const char *name) { const char *p; const char *s; M_DEBUG(10,("is_mangled %s ?\n", name)); for (s=name; (p=strchr(s, '/')); s=p+1) { if (is_mangled_component(s, PTR_DIFF(p, s))) { return True; } } /* and the last part ... */ return is_mangled_component(s,strlen(s)); }
/* the main forward mapping function, which converts a long filename to a 8.3 name if need83 is not set then we only do the mangling if the name is illegal as a long name if cache83 is not set then we don't cache the result return NULL if we don't need to do any conversion */ static char *name_map(struct pvfs_mangle_context *ctx, const char *name, bool need83, bool cache83) { char *dot_p; char lead_chars[7]; char extension[4]; unsigned int extension_length, i; unsigned int prefix_len; uint32_t hash, v; char *new_name; const char *basechars = MANGLE_BASECHARS; /* reserved names are handled specially */ if (!is_reserved_name(ctx, name)) { /* if the name is already a valid 8.3 name then we don't need to do anything */ if (is_8_3(ctx, name, false, false)) { return NULL; } /* if the caller doesn't strictly need 8.3 then just check for illegal filenames */ if (!need83 && is_legal_name(ctx, name)) { return NULL; } } /* find the '.' if any */ dot_p = strrchr(name, '.'); if (dot_p) { /* if the extension contains any illegal characters or is too long or zero length then we treat it as part of the prefix */ for (i=0; i<4 && dot_p[i+1]; i++) { if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) { dot_p = NULL; break; } } if (i == 0 || i == 4) dot_p = NULL; } /* the leading characters in the mangled name is taken from the first characters of the name, if they are ascii otherwise '_' is used */ for (i=0;i<ctx->mangle_prefix && name[i];i++) { lead_chars[i] = name[i]; if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) { lead_chars[i] = '_'; } lead_chars[i] = toupper((unsigned char)lead_chars[i]); } for (;i<ctx->mangle_prefix;i++) { lead_chars[i] = '_'; } /* the prefix is anything up to the first dot */ if (dot_p) { prefix_len = PTR_DIFF(dot_p, name); } else { prefix_len = strlen(name); } /* the extension of the mangled name is taken from the first 3 ascii chars after the dot */ extension_length = 0; if (dot_p) { for (i=1; extension_length < 3 && dot_p[i]; i++) { unsigned char c = dot_p[i]; if (FLAG_CHECK(c, FLAG_ASCII)) { extension[extension_length++] = toupper(c); } } } /* find the hash for this prefix */ v = hash = mangle_hash(ctx, name, prefix_len); new_name = talloc_array(ctx, char, 13); if (new_name == NULL) { return NULL; } /* now form the mangled name. */ for (i=0;i<ctx->mangle_prefix;i++) { new_name[i] = lead_chars[i]; } new_name[7] = basechars[v % 36]; new_name[6] = '~'; for (i=5; i>=ctx->mangle_prefix; i--) { v = v / 36; new_name[i] = basechars[v % 36]; } /* add the extension */ if (extension_length) { new_name[8] = '.'; memcpy(&new_name[9], extension, extension_length); new_name[9+extension_length] = 0; } else { new_name[8] = 0; } if (cache83) { /* put it in the cache */ cache_insert(ctx, name, prefix_len, hash); } M_DEBUG(10,("name_map: %s -> %08X -> %s (cache=%d)\n", name, hash, new_name, cache83)); return new_name; }
/* the main forward mapping function, which converts a long filename to a 8.3 name if need83 is not set then we only do the mangling if the name is illegal as a long name if cache83 is not set then we don't cache the result the name parameter must be able to hold 13 bytes */ static void name_map(fstring name, BOOL need83, BOOL cache83, int default_case) { char *dot_p; char lead_chars[7]; char extension[4]; unsigned int extension_length, i; unsigned int prefix_len; u32 hash, v; char new_name[13]; /* reserved names are handled specially */ if (!is_reserved_name(name)) { /* if the name is already a valid 8.3 name then we don't need to do anything */ if (is_8_3(name, False, False)) { return; } /* if the caller doesn't strictly need 8.3 then just check for illegal filenames */ if (!need83 && is_legal_name(name)) { return; } } /* find the '.' if any */ dot_p = strrchr(name, '.'); if (dot_p) { /* if the extension contains any illegal characters or is too long or zero length then we treat it as part of the prefix */ for (i=0; i<4 && dot_p[i+1]; i++) { if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) { dot_p = NULL; break; } } if (i == 0 || i == 4) dot_p = NULL; } /* the leading characters in the mangled name is taken from the first characters of the name, if they are ascii otherwise '_' is used */ for (i=0;i<mangle_prefix && name[i];i++) { lead_chars[i] = name[i]; if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) { lead_chars[i] = '_'; } lead_chars[i] = toupper(lead_chars[i]); } for (;i<mangle_prefix;i++) { lead_chars[i] = '_'; } /* the prefix is anything up to the first dot */ if (dot_p) { prefix_len = PTR_DIFF(dot_p, name); } else { prefix_len = strlen(name); } /* the extension of the mangled name is taken from the first 3 ascii chars after the dot */ extension_length = 0; if (dot_p) { for (i=1; extension_length < 3 && dot_p[i]; i++) { char c = dot_p[i]; if (FLAG_CHECK(c, FLAG_ASCII)) { extension[extension_length++] = toupper(c); } } } /* find the hash for this prefix */ v = hash = mangle_hash(name, prefix_len); /* now form the mangled name. */ for (i=0;i<mangle_prefix;i++) { new_name[i] = lead_chars[i]; } new_name[7] = base_forward(v % 36); new_name[6] = '~'; for (i=5; i>=mangle_prefix; i--) { v = v / 36; new_name[i] = base_forward(v % 36); } /* add the extension */ if (extension_length) { new_name[8] = '.'; memcpy(&new_name[9], extension, extension_length); new_name[9+extension_length] = 0; } else { new_name[8] = 0; } if (cache83) { /* put it in the cache */ cache_insert(name, prefix_len, hash); } M_DEBUG(10,("name_map: %s -> %08X -> %s (cache=%d)\n", name, hash, new_name, cache83)); /* and overwrite the old name */ fstrcpy(name, new_name); /* all done, we've managed to mangle it */ }
/* * 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 = MNULL, *R = MNULL; static VEC *blup = VNULL, *tmpa = VNULL, *tmpb = VNULL; PERM *piv = PNULL; volatile unsigned int i, rows_C; unsigned int j, k, l = 0, row, col, start_i, start_j, start_X, global, one_nbh_empty; VARIOGRAM *v = NULL; static enum GLS_WHAT last_pred = GLS_INIT; /* the initial value */ double c_value, *X_ori; int info; 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; } 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)); ME(MSPE, i, j) = ME(MSPE, 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, one_nbh_empty = 0; i < n_vars; i++) { rows_C += d[i]->n_sel; if (d[i]->n_sel == 0) one_nbh_empty = 1; } if (rows_C == 0 /* all selection lists empty */ || one_nbh_empty == 1) { /* one selection list empty */ 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 && d[i]->n_list == d[i]->n_sel); /* * 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 || !global || rows_C > glm->C->m) { /* * fill y: */ glm->y = get_y(d, glm->y, n_vars); if (pred != UPDATE) { glm->C = m_resize(glm->C, rows_C, rows_C); if (gl_choleski == 0) /* use LDL' decomposition, allocate piv: */ piv = px_resize(piv, rows_C); m_zero(glm->C); 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; ME(glm->C, col, row) = c_value; /* fill upper */ if (col != row) ME(glm->C, row, col) = c_value; /* fill all */ } /* 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()]"); M_DEBUG(glm->C, "Covariances (x_i, x_j) matrix C (upper triangle)"); /* * factorize C: */ CHfactor(glm->C, piv, &info); if (info != 0) { /* singular: */ pr_warning("Covariance matrix 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 */ P_FREE(piv); return; } if (piv == NULL) M_DEBUG(glm->C, "glm->C, Choleski decomposed:") else M_DEBUG(glm->C, "glm->C, LDL' decomposed:") } /* if (pred != UPDATE) */
/* the main forward mapping function, which converts a long filename to a 8.3 name if cache83 is not set then we don't cache the result */ static bool hash2_name_to_8_3(const char *name, char new_name[13], bool cache83, int default_case, const struct share_params *p) { char *dot_p; char lead_chars[7]; char extension[4]; unsigned int extension_length, i; unsigned int prefix_len; unsigned int hash, v; /* reserved names are handled specially */ if (!is_reserved_name(name)) { /* if the name is already a valid 8.3 name then we don't need to * change anything */ if (is_legal_name(name) && is_8_3(name, False, False, p)) { safe_strcpy(new_name, name, 12); return True; } } /* find the '.' if any */ dot_p = strrchr(name, '.'); if (dot_p) { /* if the extension contains any illegal characters or is too long or zero length then we treat it as part of the prefix */ for (i=0; i<4 && dot_p[i+1]; i++) { if (! FLAG_CHECK(dot_p[i+1], FLAG_ASCII)) { dot_p = NULL; break; } } if (i == 0 || i == 4) { dot_p = NULL; } } /* the leading characters in the mangled name is taken from the first characters of the name, if they are ascii otherwise '_' is used */ for (i=0;i<mangle_prefix && name[i];i++) { lead_chars[i] = name[i]; if (! FLAG_CHECK(lead_chars[i], FLAG_ASCII)) { lead_chars[i] = '_'; } lead_chars[i] = toupper_m(lead_chars[i]); } for (;i<mangle_prefix;i++) { lead_chars[i] = '_'; } /* the prefix is anything up to the first dot */ if (dot_p) { prefix_len = PTR_DIFF(dot_p, name); } else { prefix_len = strlen(name); } /* the extension of the mangled name is taken from the first 3 ascii chars after the dot */ extension_length = 0; if (dot_p) { for (i=1; extension_length < 3 && dot_p[i]; i++) { char c = dot_p[i]; if (FLAG_CHECK(c, FLAG_ASCII)) { extension[extension_length++] = toupper_m(c); } } } /* find the hash for this prefix */ v = hash = mangle_hash(name, prefix_len); /* now form the mangled name. */ for (i=0;i<mangle_prefix;i++) { new_name[i] = lead_chars[i]; } new_name[7] = base_forward(v % 36); new_name[6] = '~'; for (i=5; i>=mangle_prefix; i--) { v = v / 36; new_name[i] = base_forward(v % 36); } /* add the extension */ if (extension_length) { new_name[8] = '.'; memcpy(&new_name[9], extension, extension_length); new_name[9+extension_length] = 0; } else { new_name[8] = 0; } if (cache83) { /* put it in the cache */ cache_insert(name, prefix_len, hash); } M_DEBUG(10,("hash2_name_to_8_3: %s -> %08X -> %s (cache=%d)\n", name, hash, new_name, cache83)); return True; }
/* * 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 */