void FORWARD_SAVE_SOLVE_BVP_FREE(FORWARD_SAVE_SOLVE_BVP_DATA *d) {
free_array1_i(d->ipiv);
XCAT(free_array2_, TYPE_POSTFIX)(d->lambda);
XCAT(free_array2_, TYPE_POSTFIX)(d->A);
XCAT(free_array1_, TYPE_POSTFIX)(d->B);
/*
XCAT(free_array2_, TYPE_POSTFIX)(d->c);
*/
}
int FORWARD_SAVE_SOLVE_BVP_ALLOC(FORWARD_SAVE_SOLVE_BVP_DATA *d, int n_layers, int n_quad_v, int m_comp, int n_comp) {
d->free = (void (*)(void *)) FORWARD_SAVE_SOLVE_BVP_FREE;
d->ipiv = alloc_array1_i(n_comp);
d->lambda = XCAT(alloc_array2_, TYPE_POSTFIX)(n_layers, n_quad_v);
d->A = XCAT(alloc_array2_, TYPE_POSTFIX)(n_comp, m_comp);
d->B = XCAT(alloc_array1_, TYPE_POSTFIX)(n_comp);
/*
d->c = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad_v, n_quad_v);
*/
return 0;
}
int FORWARD_SAVE_CALC_RADIANCE_LEVELS_ALLOC(FORWARD_SAVE_CALC_RADIANCE_LEVELS_DATA *d, int n_layers, int n_quad_v) {
d->free = (void (*)(void *)) FORWARD_SAVE_CALC_RADIANCE_LEVELS_FREE;
d->lambda = XCAT(alloc_array2_, TYPE_POSTFIX)(n_layers, n_quad_v);
return 0;
}
void FORWARD_SAVE_CALC_GLOBAL_R_AND_T_FREE(FORWARD_SAVE_CALC_GLOBAL_R_AND_T_DATA *d) {
free_array1_i(d->X_m_ip);
free_array1_i(d->c_ip);
XCAT(free_array2_, TYPE_POSTFIX)(d->X_m_lu);
XCAT(free_array1_, TYPE_POSTFIX)(d->lambda);
XCAT(free_array2_, TYPE_POSTFIX)(d->a);
XCAT(free_array2_, TYPE_POSTFIX)(d->b);
XCAT(free_array2_, TYPE_POSTFIX)(d->c_lu);
XCAT(free_array2_, TYPE_POSTFIX)(d->d);
XCAT(free_array2_, TYPE_POSTFIX)(d->e);
}
// Inicializacao com buffer pre-alocado
void rst_init_ptr(rst_buffer_t *ptr, u_int64_t id1, u_int64_t id2)
{
int fd;
char fname[30];
char hostname[MAXHOSTNAMELEN+1];
if ( ptr == NULL ) {
fprintf(stderr, "[rastro] error inicializing - invalid pointer\n");
return;
}
#ifdef THREADED
if (!rst_key_initialized) {
pthread_key_create(&rst_key, rst_destroy_buffer);
rst_key_initialized = 1;
}
#endif
if(!list_init){
list_initialize(&list, list_copy, list_cmp, list_destroy);
list_init=true;
}
RST_SET_PTR(ptr);
ptr->rst_buffer_size = 100000;
ptr->rst_buffer = malloc(ptr->rst_buffer_size);
RST_RESET(ptr);
sprintf(fname, "rastro-%"PRIu64"-%"PRIu64".rst",/* dirname,*/ id1, id2);
fd = open(fname, O_WRONLY | O_CREAT | O_TRUNC, 0666);
if (fd == -1) {
fprintf(stderr, "[rastro] cannot open file %s: %s\n",
fname, strerror(errno));
return;
}
list_insert_after(&list, NULL, (void *)ptr );
RST_SET_FD(ptr, fd);
// this will force first event to register sync time
RST_SET_T0(ptr, 0);
gethostname(hostname, sizeof(hostname));
XCAT(rst_event_,LETRA_UINT64,LETRA_STRING,_ptr)(ptr, RST_EVENT_INIT, id1, id2, hostname);
}
int FORWARD_SAVE_CALC_GLOBAL_R_AND_T_ALLOC(FORWARD_SAVE_CALC_GLOBAL_R_AND_T_DATA *d, int n_quad) {
d->free = (void (*)(void *)) FORWARD_SAVE_CALC_GLOBAL_R_AND_T_FREE;
d->X_m_ip = alloc_array1_i(n_quad);
d->c_ip = alloc_array1_i(n_quad);
d->X_m_lu = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
d->lambda = XCAT(alloc_array1_, TYPE_POSTFIX)(n_quad);
d->a = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
d->b = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
d->c_lu = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
d->d = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
d->e = XCAT(alloc_array2_, TYPE_POSTFIX)(n_quad, n_quad);
return 0;
}
static void SOLVE_BVP_A(int n_quad, int n_stokes, int n_layers,
double *ltau, double *ltau_a,
double **Rs_qq, double **Rs_qq_a,
double *atran, double *atran_a,
TYPE **nu, TYPE ***X_p, TYPE ***X_m,
double **F_p, double **F_m,
double **F0_p, double **F0_m, double **F1_p, double **F1_m,
TYPE **nu_a, TYPE ***X_p_a, TYPE ***X_m_a,
double **F_p_a, double **F_m_a,
double **F0_p_a, double **F0_m_a, double **F1_p_a, double **F1_m_a,
TYPE *B, TYPE *B_a,
double *I1_m, double *I1_m_a, double *In_p, double *In_p_a,
int surface, int thermal, uchar *derivs_h, uchar *derivs_p,
save_tree_data save_tree, work_data work) {
int i;
int ii;
int iii;
int j;
int k;
int l;
int n_quad_v;
int n_quad_v2;
int n_quad_v3;
int n_diags;
int m_comp;
int n_comp;
int info;
int nrhs = 1;
TYPE a;
TYPE b;
TYPE c;
TYPE d;
TYPE e;
TYPE **lambda_a;
FORWARD_SAVE_SOLVE_BVP_DATA *save;
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
n_quad_v = n_quad * n_stokes;
n_quad_v2 = n_quad_v * 2;
n_quad_v3 = n_quad_v * 3;
n_diags = 3 * n_quad_v - 1;
m_comp = 3 * n_diags + 1;
n_comp = 2 * n_quad_v * n_layers;
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
save_tree_encode_s(&save_tree, SOLVE_BVP_SAVE_TREE_STRING);
save_tree_retrieve_data(&save_tree, FORWARD_SAVE_SOLVE_BVP_DATA, &save);
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
lambda_a = get_work2(&work, WORK_XX, WORK_LAYERS_V, NULL);
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
xgbtrs_("T", &n_comp, &n_diags, &n_diags, &nrhs, *(save->A), &m_comp,
save->ipiv, B_a, &n_comp, &info);
if (info) {
eprintf("ERROR: xgbtrs() info = %d\n", info);
exit(1);
}
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
for (i = 0; i < n_layers; ++i) {
if (derivs_h[i]) {
for (j = 0; j < n_quad_v; ++j) {
lambda_a[i][j] = 0.;
}
}
}
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
for (i = 0; i < n_quad_v; ++i) {
a = B_a[i];
if (derivs_p[0])
F_m_a[0][i] -= XREAL(a);
if (derivs_h[0]) {
for (j = 0; j < n_quad_v; ++j) {
X_m_a[0][i][j] += a * save->B[j];
lambda_a[0][j] += a * save->B[j + n_quad_v] * X_p[0][i][j];
X_p_a[0][i][j] += a * save->B[j + n_quad_v] * save->lambda[0][j];
}
}
}
iii = n_quad_v;
for (i = 0; i < n_layers - 1; ++i) {
ii = i * n_quad_v2;
for (j = 0; j < n_quad_v; ++j) {
a = B_a[iii++];
if (derivs_p[i ]) {
F_p_a[i][j] -= XREAL(a) * atran[i];
atran_a [i] -= XREAL(a) * F_p[i][j];
}
if (derivs_p[i+1])
F_p_a[i+1][j] += XREAL(a);
for (k = 0; k < n_quad_v; ++k) {
if (derivs_h[i ]) {
lambda_a[i][k] -= a * save->B[ii + k] * X_p[i][j][k];
X_p_a[i][j][k] -= a * save->B[ii + k] * save->lambda[i][k];
X_m_a[i][j][k] -= a * save->B[ii + k + n_quad_v];
}
if (derivs_h[i+1]) {
lambda_a[i+1][k] += a * save->B[ii + k + n_quad_v3] * X_m[i+1][j][k];
X_m_a[i+1][j][k] += a * save->B[ii + k + n_quad_v3] * save->lambda[i+1][k];
X_p_a[i+1][j][k] += a * save->B[ii + k + n_quad_v2];
}
}
}
for (j = 0; j < n_quad_v; ++j) {
a = B_a[iii++];
if (derivs_p[i ]) {
F_m_a[i][j] -= XREAL(a) * atran[i];
atran_a [i] -= XREAL(a) * F_m[i][j];
}
if (derivs_p[i+1])
F_m_a[i+1][j] += XREAL(a);
for (k = 0; k < n_quad_v; ++k) {
if (derivs_h[i ]) {
lambda_a[i][k] += a * save->B[ii + k] * X_m[i][j][k];
X_m_a[i][j][k] += a * save->B[ii + k] * save->lambda[i][k];
X_p_a[i][j][k] += a * save->B[ii + k + n_quad_v];
}
if (derivs_h[i+1]) {
lambda_a[i+1][k] -= a * save->B[ii + k + n_quad_v3] * X_p[i+1][j][k];
X_p_a[i+1][j][k] -= a * save->B[ii + k + n_quad_v3] * save->lambda[i+1][k];
X_m_a[i+1][j][k] -= a * save->B[ii + k + n_quad_v2];
}
}
}
}
i = n_layers - 1;
ii = n_comp - n_quad_v2;
for (j = 0; j < n_quad_v; ++j) {
b = B_a[n_comp - n_quad_v + j];
if (derivs_p[i]) {
F_p_a[i][j] -= XREAL(b) * atran[i];
atran_a [i] -= XREAL(b) * F_p[i][j];
}
if (surface) {
c = b;
for (k = 0; k < n_quad_v; ++k) {
if (derivs_p[i ]) {
F_m_a[i][k] += XREAL(c) * Rs_qq[j][k] * atran[i];
atran_a[i] += XREAL(c) * Rs_qq[j][k] * F_m[i][k];
}
if (derivs_h[i+1])
Rs_qq_a[j][k] += XREAL(c) * F_m[i][k] * atran[i];
}
if (derivs_p[i+1])
In_p_a[j] += XREAL(b);
}
for (k = 0; k < n_quad_v; ++k) {
if (derivs_h[i]) {
lambda_a[i][k] -= b * save->B[ii + k] * X_p[i][j][k];
X_p_a[i][j][k] -= b * save->B[ii + k] * save->lambda[i][k];
X_m_a[i][j][k] -= b * save->B[ii + k + n_quad_v];
}
if (surface) {
c = 0.;
for (l = 0; l < n_quad_v; ++l)
c += Rs_qq[j][l] * -X_m[i][l][k];
if (derivs_h[i])
lambda_a[i][k] -= b * B[ii + k] * - c;
/*
lambda_a[i][k] -= b * B[ii + k] * -save->c[j][k];
*/
d = b * B[ii + k] * save->lambda[i][k];
e = b * B[ii + k + n_quad_v];
for (l = 0; l < n_quad_v; ++l) {
if (derivs_h[i ]) {
X_m_a[i][l][k] -= Rs_qq[j][l] * d;
X_p_a[i][l][k] -= Rs_qq[j][l] * e;
}
if (derivs_h[i+1]) {
Rs_qq_a[j][l] -= XREAL(X_m[i][l][k] * d);
Rs_qq_a[j][l] -= XREAL(X_p[i][l][k] * e);
}
}
}
}
}
/*-------------------------------------------------------------------------
*
*-----------------------------------------------------------------------*/
for (i = 0; i < n_layers; ++i) {
if (derivs_h[i]) {
for (j = 0; j < n_quad_v; ++j) {
nu_a[i][j] -= lambda_a[i][j] * ltau[i] * save->lambda[i][j];
ltau_a[i] -= XREAL(lambda_a[i][j] * nu[i][j] * save->lambda[i][j]);
}
}
}
XCAT(init_array1_, TYPE_POSTFIX)(B_a, n_comp, 0.);
}
void FORWARD_SAVE_CALC_RADIANCE_LEVELS_FREE(FORWARD_SAVE_CALC_RADIANCE_LEVELS_DATA *d) {
XCAT(free_array2_, TYPE_POSTFIX)(d->lambda);
}
static void __rst_init(rst_buffer_t *ptr,
u_int64_t id1,
u_int64_t id2,
timestamp_t (*stamping) (void),
timestamp_t (*resolution) (void))
{
int fd;
char fname[30];
char hostname[MAXHOSTNAMELEN + 1];
if (ptr == NULL) {
fprintf(stderr, "[rastro] error inicializing - invalid pointer\n");
return;
}
#ifdef LIBRASTRO_THREADED
static int rst_key_initialized = 0;
if (!rst_key_initialized) {
pthread_key_create(&rst_key, NULL);
rst_key_initialized = 1;
}
#endif
//define the timestamp function to be used by librastro
rastro_timestamping = stamping;
rastro_timeresolution = resolution;
RST_SET_PTR(ptr);
ptr->id1 = id1;
ptr->id2 = id2;
ptr->write_first_hour = 1;
char *env = getenv("RST_BUFFER_SIZE");
if (env) {
errno = 0;
/*
* Negative values don't trigger errno nor any error value is returned.
* They are interpreted as SIZE_MAX - abs(val) + 1
*/
if (sscanf(env, "%zu", &(ptr->rst_buffer_size)) != 1 || errno) {
ptr->rst_buffer_size = RST_DEFAULT_BUFFER_SIZE;
fprintf(stderr, "Error %d reading RST_BUFFER_SIZE, using default value:"\
"%zu.\n", errno, ptr->rst_buffer_size);
}
} else {
ptr->rst_buffer_size = RST_DEFAULT_BUFFER_SIZE;
}
ptr->rst_buffer = malloc(ptr->rst_buffer_size);
bzero(ptr->rst_buffer, ptr->rst_buffer_size);
RST_RESET(ptr);
sprintf(fname, "rastro-%" PRIu64 "-%" PRIu64 ".rst", id1, id2);
fd = open(fname, O_WRONLY | O_CREAT | O_TRUNC, 0666);
if (fd == -1) {
fprintf(stderr, "[rastro] cannot open file %s: %s\n",
fname, strerror(errno));
return;
}
RST_SET_FD(ptr, fd);
// this will force first event to register sync time
RST_SET_T0(ptr, 0);
gethostname(hostname, sizeof(hostname));
XCAT(rst_event_, LETTER_UINT64, LETTER_STRING, _ptr) (ptr, RST_EVENT_INIT,
id1, id2, hostname);
}