/* l'ancienne commande... */
int reconnect_after_timeout(int refait_commande) {
int code, ret;
char *chaine_to_sauve, *ptr;
aff_try_reconnect();
close(tcp_fd);
ptr=strchr(line_write,'\n');
if (ptr) *(++ptr)='\0';
chaine_to_sauve=safe_strdup(line_write);
code=connect_server(Options.serveur_name,0);
if ((code!=200) && (code!=201)) { free(chaine_to_sauve); return -1; }
adjust_time(); /* il faut peut-être mieux le refaire, si c'est possible */
/* reste a envoyer la bonne commande pour GROUP */
if (refait_commande) {
ret=(Newsgroup_courant ? va_dans_groupe() : 1);
if (ret==-1) { free(chaine_to_sauve); return -1; }
if (ret==0) {
code=return_code();
if (code<0) { free(chaine_to_sauve); return -1; }
}
if (debug) fprintf(stderr, "Reste a renvoyer la commande bugguante\n");
raw_write_server(chaine_to_sauve, strlen(chaine_to_sauve));
/* on renvoie la commande... */
}
if (debug) fprintf(stderr, "Reconnexion réussie ...\n");
free(chaine_to_sauve);
aff_end_reconnect();
return 0;
}
/* public functions */
int msntp_set_clock(char *hostname, int port) {
int ret;
double offset;
setup(hostname, port);
operation = op_client;
if (ret = run_client(&hostname, 1, &offset))
return ret;
return adjust_time(offset, 1, 0);
}
static int stp_sync_clock(void *data)
{
static int first;
unsigned long long old_clock, delta, new_clock, clock_delta;
struct clock_sync_data *stp_sync;
struct ptff_qto qto;
int rc;
stp_sync = data;
if (xchg(&first, 1) == 1) {
/* Slave */
clock_sync_cpu(stp_sync);
return 0;
}
/* Wait until all other cpus entered the sync function. */
while (atomic_read(&stp_sync->cpus) != 0)
cpu_relax();
enable_sync_clock();
rc = 0;
if (stp_info.todoff[0] || stp_info.todoff[1] ||
stp_info.todoff[2] || stp_info.todoff[3] ||
stp_info.tmd != 2) {
old_clock = get_tod_clock();
rc = chsc_sstpc(stp_page, STP_OP_SYNC, 0, &clock_delta);
if (rc == 0) {
new_clock = old_clock + clock_delta;
delta = adjust_time(old_clock, new_clock, 0);
if (ptff_query(PTFF_QTO) &&
ptff(&qto, sizeof(qto), PTFF_QTO) == 0)
/* Update LPAR offset */
lpar_offset = qto.tod_epoch_difference;
atomic_notifier_call_chain(&s390_epoch_delta_notifier,
0, &clock_delta);
fixup_clock_comparator(delta);
rc = chsc_sstpi(stp_page, &stp_info,
sizeof(struct stp_sstpi));
if (rc == 0 && stp_info.tmd != 2)
rc = -EAGAIN;
}
}
if (rc) {
disable_sync_clock(NULL);
stp_sync->in_sync = -EAGAIN;
} else
stp_sync->in_sync = 1;
xchg(&first, 0);
return 0;
}
int
main(int argc, char *argv[])
{
GRID *g;
SIMPLEX *e;
DOF **u, **p, **T, **gradu,
*eu, *ep, *egradu, *ediv, *eT,
*dH = NULL;
FLOAT Time, *dt, res, non_du, non_dp, non_dT;
INT tstep = 0, nelem;
char mesh_file[100], hostname[256],
data_file[100], data_u[100], data_p[100], data_T[100], data_Crd[100];
size_t mem, mem_peak;
int verb;
double tt[3], tt1[3];
/* ---------- NS ---------- */
NSSolver *ns = NULL;
SURF_BAS *surf_bas = NULL;
LAYERED_MESH *gL = NULL;
//GEO_INFO *geo = NULL;
/* MG_BLOCK_DOFS *bk = NULL; */
/* ================================================================================
*
* Initialize Grid & parameters
*
* ================================================================================
*/
/* Global (static) options */
Unused(verb);
ns_params = phgParametersCreate();
phgInit(&argc, &argv);
phgOptionsShowUsed();
g = phgNewGrid(-1);
//phgSetPeriodicity(g, ns_params->periodicity);
phgImportSetBdryMapFunc(my_bc_map);
if (ns_params->resume) {
phgResumeStage(g, &Time, &tstep, mesh_file, data_file);
phgPrintf("================================\n\n");
phgPrintf("* RESUME from time:%E, tstep:%d\n", Time, tstep);
phgPrintf("* mesh:%s\n", mesh_file);
phgPrintf("* data:%s\n", data_file);
phgPrintf("================================\n");
if (!phgImport(g, mesh_file, FALSE))
phgError(1, "can't read file \"%s\".\n", ns_params->fn);
}
else {
phgPrintf("Using mesh: %s\n", ns_params->fn);
if (!phgImport(g, ns_params->fn, FALSE))
phgError(1, "can't read file \"%s\".\n", ns_params->fn);
}
checkBdry(g);
elapsed_time(g, FALSE, 0.); /* reset timer */
gethostname(hostname, sizeof(hostname));
printf("#%5d# runing PID %5d on %s \n", phgRank, getpid(), hostname);
NsSolver_Options();
phgPrintf(" Pre-refine & repartition ");
phgRefineAllElements(g, ns_params->pre_refines);
/* Set Reynolds number */
Time = ns_params->time_start; /* default: 0 */
setFuncTime(Time);
setFlowParameter(ns_params->Re, ns_params->nu, Time);
/* ================================================================================
*
* build ice grid
*
* ================================================================================
*/
iceInit(g, &gL);
phgPrintf("Geometry initialization done!\n");
phgExportVTK(g, "ice_domain.vtk", NULL, NULL);
/* ================================================================================
*
* Create INS solver
*
* ================================================================================
*/
/* Note: pointers u, p, gradu, dt
* DIRECTLY access private member of INS solver.
*/
phgPrintf(" Create INS solver");
tstep = 1; /* time step start at 1 */
setFuncTime(Time); /* in file ins-bc.c: static */
//data_sur_T = read_txt_data("./LAS_temp_for_mesh.txt");
ns = phgNSCreate(g, ns_params);
//get_mask_bot(ns);
ns->time[1] = Time;
u = ns->u;
p = ns->p;
T = ns->T;
gradu = ns->gradu;
dH = ns->dH;
dt = ns->dt; /* direct accses ns */
dt[0] = ns_params->dt0;
ns->gL = gL;
//ns->bk = bk = NULL; //init_line_block(T[1], gL); /* Use line block */
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
/* Init height & depth */
if (gL != NULL){
get_height_depth(ns);
}
/* surf bases */
//surf_bas = ns->surf_bas;
#if 0
DOF *beta = phgDofNew(g, DOF_P1, 1, "beta", func_beta);
phgExportEnsight(g, "check", beta, NULL);
phgFinalize();
exit(1);
#endif
/* ------------------------------------------------------------
*
* Resume dof data.
*
* ------------------------------------------------------------ */
if (ns_params->resume) {
FILE *fp = NULL;
char fname[1000];
phgResumeStage(g, &Time, &tstep, mesh_file, data_file);
/* resume coord */
{
const FLOAT *v = DofData(ns->coord);
int i, k;
//sprintf(data_Crd, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat.Crd", tstep - 1);
sprintf(data_Crd, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat.Crd", 2);
assert(ns->coord->type == DOF_P1);
load_dof_data3(g, ns->coord, data_Crd, mesh_file);
for (i = 0; i < g->nvert; i++)
for (k = 0; k < Dim; k++)
g->verts[i][k] = *(v++);
phgGeomInit_(g, TRUE);
}
#if 1
/* resmue u_{n-1} */
//sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", tstep - 2);
sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", 1);
DATA_FILE_SURFIX;
sprintf(fname, "%s.p%03d", data_u, g->rank);
if ((fp = fopen(fname, "r")) == NULL) {
phgPrintf("* u_{%d} unavailable.\n", tstep - 2);
}
else {
fclose(fp);
phgDofCopy(u[1], &u[0], NULL, "u_{n}");
phgDofCopy(p[1], &p[0], NULL, "p_{n}");
phgDofCopy(T[1], &T[0], NULL, "T_{n}");
gradu[0] = NULL;
load_dof_data3(g, u[0], data_u, mesh_file);
load_dof_data3(g, p[0], data_p, mesh_file);
load_dof_data3(g, T[0], data_T, mesh_file);
phgPrintf(" Resume u_ {%5d}[%8d]:%24.12E p_ {%5d}[%8d]:%24.12E\n",
tstep - 2, DofGetDataCountGlobal(u[0]), phgDofNormL2(u[0]),
tstep - 2, DofGetDataCountGlobal(p[0]), phgDofNormL2(p[0]));
phgPrintf(" Resume T_{%5d}[%8d]:%24.12E\n",
tstep - 2, DofGetDataCountGlobal(T[0]), phgDofNormL2(T[0]));
phgDofGradient(u[0], &gradu[0], NULL, "gradu_{n}");
phgDofSetFunction(u[0], DofInterpolation);
phgDofSetFunction(p[0], DofInterpolation);
//phgDofSetBdryDataByFunction(u[0], func_u, SETFLOW);
DOF_SCALE(u[0], "resume");
DOF_SCALE(p[0], "resume");
DOF_SCALE(T[0], "resume");
DOF_SCALE(gradu[0], "resume");
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
}
/* resmue u_{n} */
//sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", tstep - 1);
sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", 2);
DATA_FILE_SURFIX;
sprintf(fname, "%s.p%03d", data_u, g->rank);
if ((fp = fopen(fname, "r")) == NULL) {
phgError(1, "read Dof data %s failed!\n", data_file);
} else {
fclose(fp);
load_dof_data3(g, u[1], data_u, mesh_file);
load_dof_data3(g, p[1], data_p, mesh_file);
load_dof_data3(g, T[1], data_T, mesh_file);
phgPrintf(" Resume u_ {%5d}[%8d]:%24.12E p_ {%5d}[%8d]:%24.12E\n",
tstep - 1, DofGetDataCountGlobal(u[1]), phgDofNormL2(u[1]),
tstep - 1, DofGetDataCountGlobal(p[1]), phgDofNormL2(p[1]));
phgPrintf(" Resume T_{%5d}[%8d]:%24.12E\n",
tstep - 1, DofGetDataCountGlobal(T[1]), phgDofNormL2(T[1]));
phgDofGradient(u[1], &gradu[1], NULL, "gradu_{n+1}");
phgDofSetFunction(u[1], DofInterpolation);
phgDofSetFunction(p[1], DofInterpolation);
//phgDofSetBdryDataByFunction(u[1], func_u, SETFLOW);
DOF_SCALE(u[1], "resume");
DOF_SCALE(p[1], "resume");
DOF_SCALE(T[1], "resume");
DOF_SCALE(gradu[1], "resume");
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
}
#endif
/* Re init height & depth */
if (gL != NULL) {
get_height_depth(ns);
build_layered_mesh_height(g, gL);
check_height(g, gL);
}
/* reconstruct last time step */
//Time -= dt[0];
Time = tstep - 1;
ns->time[1] = Time;
ns->time[0] = Time;
setFuncTime(Time);
#if 0
phgExportEnsightT(g, OUTPUT_DIR "/ins_" NS_PROBLEM , tstep, tstep, u[1], p[1], NULL);
phgFinalize();
return 0;
#endif /* debug exit */
} /* end of resume */
/* Init temp field */
DOF_SCALE(ns->beta, "test");
if (ns_params->solve_temp && tstep == 1) {
phgPrintf("Init temp field!\n");
phgNSTempInit(ns);
}
/* ================================================================================
*
*
* Main loop:
* 1. Steady state: adaptive refinement.
* 2. Time dependent: time advance.
*
* ================================================================================
*/
while (TRUE) {
FLOAT all_memory_usage = phgMemoryUsage(g, NULL)/(1024.0*1024.0);
if (all_memory_usage > 10000)
break;
get_surf_bot_elev(ns);
DOF *grad_surf_elev = phgDofGradient(ns->surf_elev_P1, NULL, NULL, "gradu_surf_elev");
ns->grad_surf_elev = grad_surf_elev;
//phgPrintf("modify mask bot!!\n");
//modify_mask_bot(ns);
//modify_mask_bot(ns);
//phgDofSetDataByValue(u[1], 0.);
//phgDofSetDataByValue(p[1], 0.);
ns->surf_bas = get_surface_bases(g, DOF_P2);
surf_bas = ns->surf_bas;
static BOOLEAN initialized = FALSE;
FLOAT time_end = ns_params->time_end;
elapsed_time(g, FALSE, 0.); /* reset timer */
phgGetTime(tt);
if (Fabs(time_end - Time) < 1e-12) {
phgPrintf("\n=======\nTime reach end: %lf, exit.\n", Time);
phgPrintf("Time End %f\n", time_end);
break;
}
if (tstep > ns_params->max_tstep) {
phgPrintf("\n=======\nTime step reach end: %d, exit.\n",
tstep);
break;
}
#if 0
/* use time t^{n+1} */
dt[-1] = dt[0];
if (Time + dt[0] > time_end)
dt[0] = time_end - Time;
Time += dt[0];
setFuncTime(Time);
#endif
phgPrintf("\n==========\ntime: %lf, step:%d\n", (double)Time, tstep);
phgPrintf(" %d DOF (u:%d, p:%d), %d elements, %d submesh%s, load imbalance: %lg\n",
DofGetDataCountGlobal(u[1]) + DofGetDataCountGlobal(p[1]),
DofGetDataCountGlobal(u[1]), DofGetDataCountGlobal(p[1]),
g->nleaf_global, g->nprocs,
g->nprocs > 1 ? "es" : "", (double)g->lif);
/* save mesh */
if (ns_params->record
&& tstep % ns_params->step_span == 0) {
phgResumeLogUpdate(g, &Time, &tstep, ns_params->fn, NULL);
}
if (!initialized) {
/* reset mem_peak */
phgMemoryUsageReset();
initialized = TRUE;
}
/* ------------------------------------------------------------
*
* Time marching
*
* ------------------------------------------------------------ */
/* update variale,
* call this routine after time update and/or grid change.*/
phgNSTimeAdvance(ns, Time, tstep);
phgPrintf(" update solution");
elapsed_time(g, TRUE, 0.);
if (ns_params->pin_node)
phgNSPinNode(ns);
/* --------------------------------------------------------------------------------
*
* Step 3.
*
* Momentum Equations.
*
* -------------------------------------------------------------------------------- */
int mask_iter = 0, inverse_iter = 0;
INT IF_CHANGE_MASK;
#if 1
while (TRUE)
{
// iteration for ice shelf mask updating and inversion
if ((inverse_iter % 2) == 0)
ns->set_dirichlet_bc = 0;
/* newton bc for the surface, i.e. normal simulation */
else
ns->set_dirichlet_bc = 1;
/* constrain the surface with obs. vel. for inversion */
phgPrintf("----------------------------\n");
phgPrintf("ice shelf mask iteration: %d\n", mask_iter);
phgPrintf("----------------------------\n");
elapsed_time(g, FALSE, 0.); /* reset timer */
/*
* non-linear iteration.
* */
int max_nonstep = 0, newton_start = 0;
assert(ns_params->utype == DOF_P2);
/* For nonlinear iter */
int nonstep = 0;
non_du = non_dp = non_dT = 1e+10;
DOF *u_last = phgDofCopy(u[1], NULL, NULL, "u_last");
DOF *p_last = phgDofCopy(p[1], NULL, NULL, "p_last");
FLOAT non_res_last = 1.;
LTYPE ltype_last = PICARD;
/* First step, change max non step. */
if (tstep == 1) {
if (ns_params->max_nonstep0 > 0)
max_nonstep = ns_params->max_nonstep0;
else
max_nonstep = ns_params->max_nonstep;
if (ns_params->newton_start0 > 0)
newton_start = ns_params->newton_start0;
else
newton_start = ns_params->newton_start;
phgPrintf(" * Set max nonstep to %d for first step.\n", max_nonstep);
phgPrintf(" * Set Newton start to %d for first step.\n", newton_start);
} else {
max_nonstep = ns_params->max_nonstep;
newton_start = ns_params->newton_start;
}
while (TRUE) {
phgPrintf("\n ==================\n");
phgPrintf(" Non-linear interation step: %d\n", nonstep);
/* Init const viscosity */
if (ns_params->start_const_vis &&
tstep == 0 && nonstep == 0 && mask_iter == 0) {
phgPrintf("* vis: const\n");
ns->viscosity_type = VIS_CONST;
} else {
phgPrintf("* vis: strain\n");
ns->viscosity_type = VIS_STRAIN;
}
sayHello("Non linear solve begin");
phgNSInitSolverU(ns);
if (inverse_iter < 1)
get_viscosity(ns);
/* initiate viscosity field at the beginning
* afterwards use the updated viscosity field */
if (nonstep < newton_start)
ns->ltype = PICARD;
else
ns->ltype = NEWTON;
phgPrintf(" Build RHS: ");
phgNSBuildSolverURHS(ns, 1, nonstep, Time);
//phgNSBuildSolverURHS(ns);
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
ns->non_res =
res = phgVecNorm2(ns->solver_u->rhs, 0, NULL);
phgPrintf(" nonlinear residual: %24.12E\n", res);
/* Restore Picard if no improvement */
#if 1
if (ltype_last == NEWTON &&
res > non_res_last * .75) {
phgPrintf(" !!! Newton step failed, use Picard to run again\n");
ns->ltype = PICARD;
max_nonstep += 5; /* Add more Picard steps */
/* resotre dofs:
* Fix me: temprature */
phgDofCopy(u_last, &u[1], NULL, "u_{n+1}");
phgDofCopy(p_last, &p[1], NULL, "p_{n+1}");
phgDofGradient(u[1], &gradu[1], NULL, "gradu_{n+1}");
phgNSBuildSolverURHS(ns, 1, nonstep, Time);
ns->non_res =
res = phgVecNorm2(ns->solver_u->rhs, 0, NULL);
phgPrintf(" nonlinear residual: %24.12E\n", res);
}
#endif
/* save non res */
non_res_last = res;
ltype_last = ns->ltype;
/* build matrices */
//if (ns_params->use_PCD)
//phgNSInitPc(ns);
phgPrintf(" Build matrices:\n");
phgNSBuildSolverUMat(ns, 1, nonstep, Time);
//phgNSBuildSolverUMat(ns);
phgPrintf(" done ");
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
#if 0
if (ns_params->use_PCD) {
phgPrintf(" Build Pc: \n");
phgNSBuildPc(ns);
phgPrintf(" done ");
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
}
#endif
//elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
/*
* solve equation and update (u, p)
* */
phgPrintf("solver tol: %E\n", ns->solver_u->rtol);
phgSolverSolve(ns->solver_u, TRUE, ns->du, ns->dp, NULL);
// elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
//get_water_pressure(ns);
#if USE_NODAL_LOADS
get_nodal_force(ns);
phgMatDestroy(&ns->matF0);
phgMatDestroy(&ns->matB0);
phgMatDestroy(&ns->matBt0);
phgMatDestroy(&ns->matC0);
//phgSolverDestroy(&ns->solver_u0);
ns->solver_u0 = NULL;
#endif
//get_contact(ns);
#if USE_SLIDING_BC
rotate_dof_bases(ns->du, surf_bas, FALSE);
#endif
phgPrintf(" solver_u: nits = %d, resid = %0.4lg ",
ns->solver_u->nits, ns->solver_u->residual);
//elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
/* save dofs */
phgDofCopy(u[1], &u_last, NULL, "u_last");
phgDofCopy(p[1], &p_last, NULL, "p_last");
phgExportVTK(g, "u_test.vtk", ns->u[1], NULL);
/* nonlinear correction */
phgDofAXPY(1.0, ns->du, &u[1]);
phgDofAXPY(1.0, ns->dp, &p[1]);
assert(u[1]->type == ns_params->utype);
assert(p[1]->type == ns_params->ptype);
#if USE_SLIDING_BC
//dof_set_normal_data(u[1], surf_bas);
#else
#endif
/* non_du = phgDofNormL2(ns->du); */
/* non_dp = phgDofNormL2(ns->dp); */
non_du = phgDofNormInftyVec(ns->du);
non_dp = phgDofNormInftyVec(ns->dp);
phgPrintf(" \n du: %24.12E dp: %24.12E\n", non_du, non_dp);
phgPrintf(" u: [%24.12E, %24.12E]\n",
phgDofMinValVec(u[1]),
phgDofMaxValVec(u[1]));
phgPrintf(" p: [%24.12E, %24.12E]\n",
phgDofMinValVec(p[1]),
phgDofMaxValVec(p[1]));
phgDofGradient(u[1], &gradu[1], NULL, "gradu_{n+1}");
//get_avg_gu(ns);
//gradu[1] = ns->avg_gu;
//elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
//if (ns_params->use_PCD)
//phgNSDestroyPc(ns);
//
/* evolution of u */
//DOF_SCALE(u[1], "after solve");
//DOF_SCALE(p[1], "after solve");
#if 0
# warning check solution U,p
sprintf(vtk_file, OUTPUT_DIR "non_%02d_u.vtk", nonstep);
phgExportVTK(g, vtk_file, u[1], p[1], NULL);
phgExportEnsightT(g, OUTPUT_DIR "ins_" NS_PROBLEM ,
nonstep, nonstep, u[1], p[1], T[1],
ns->du, ns->dp, ns->dT, NULL);
#endif
#if 0
if (FALSE && nonstep % ns_params->step_span == 0) {
phgPrintf(" Output solution to ensight ");
phgExportEnsightT(g, OUTPUT_DIR "/ins_" NS_PROBLEM , nonstep, nonstep,
u[1], p[1], T[1], NULL); /* ensight */
sprintf(vtk_file, OUTPUT_DIR "non_%02d_T.vtk", nonstep);
phgExportVTK(g, vtk_file ,
u[1], p[1], T[1], ns->du, NULL);
elapsed_time(g, TRUE, 0.);
//ice_monitor(ns, nonstep);
}
#endif
/* Linearized */
#if 0
if (!ns_params->non_linear
&& nonstep >= 0) {
phgPrintf(" Linearized iteration converges.\n");
break;
}
#endif
phgGetTime(tt1);
phgPrintf(" time usage of current non step: %lfs\n",
(double)(tt1[2] - tt[2]));
nonstep++;
/*
* Nonliner iteration break,
* converge for characteristic value.
* Velocity: 100 m/a
* Pressure: 1e8 Pa
*
* */
INT u_convergence;
if (mask_iter < 1)
u_convergence = check_u_convergence0(ns, u[1], p[1], u_last, p_last, ns_params->u_tol0, ns_params->u_tol0);
else
u_convergence = check_u_convergence(ns, u[1], p[1], u_last, p_last, ns_params->u_tol, ns_params->u_tol);
//elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
const FLOAT U0 = 100;
const FLOAT P0 = 1e8;
if ( nonstep >= ns_params->min_nonstep
&& ns->viscosity_type != VIS_CONST
&& u_convergence
|| nonstep > ns_params->max_nonstep)
{
if (nonstep > ns_params->max_nonstep)
{
phgPrintf(" Non-linear iteration reach max step,"
" results may be inaccrate!\n");
#if 1 && USE_NODAL_LOADS
/*
get_nodal_force(ns);
phgMatDestroy(&ns->matF0);
phgMatDestroy(&ns->matB0);
phgMatDestroy(&ns->matBt0);
phgMatDestroy(&ns->matC0);
//phgSolverDestroy(&ns->solver_u0);
ns->solver_u0 = NULL;
*/
phgMatDestroy(&ns->matF);
phgMatDestroy(&ns->matB);
phgMatDestroy(&ns->matBt);
phgMatDestroy(&ns->matC);
phgSolverDestroy(&ns->solver_u);
ns->solver_u = NULL;
phgMapDestroy(&ns->Vmap);
phgMapDestroy(&ns->Pmap);
phgDofFree(&ns->u_shape);
phgDofFree(&ns->p_shape);
#endif
break;
}
else
{
phgPrintf(" Non-linear iteration converges.\n");
#if 1 && USE_NODAL_LOADS
/*
get_nodal_force(ns);
phgMatDestroy(&ns->matF0);
phgMatDestroy(&ns->matB0);
phgMatDestroy(&ns->matBt0);
phgMatDestroy(&ns->matC0);
//phgSolverDestroy(&ns->solver_u0);
ns->solver_u0 = NULL;
*/
phgMatDestroy(&ns->matF);
phgMatDestroy(&ns->matB);
phgMatDestroy(&ns->matBt);
phgMatDestroy(&ns->matC);
phgSolverDestroy(&ns->solver_u);
ns->solver_u = NULL;
phgMapDestroy(&ns->Vmap);
phgMapDestroy(&ns->Pmap);
phgDofFree(&ns->u_shape);
phgDofFree(&ns->p_shape);
#endif
break;
}
}
phgNSDestroySolverU(ns);
} /* solve */
phgDofFree(&u_last);
phgDofFree(&p_last);
//phgPrintf("Save Dofs\n");
//save_dof_data3(g, u[1], OUTPUT_DIR"u.dat");
//save_dof_data3(g, p[1], OUTPUT_DIR"p.dat");
#elif 0
/* Set velocity, for debugging */
ns->viscosity_type = VIS_STRAIN;
phgDofSetDataByFunction(u[1], func_u0);
//phgDofSetDataByFunction(p[1], func_p0);
phgDofGradient(u[1], &gradu[1], NULL, "gradu_{n+1}");
#else
phgPrintf("Load Dofs\n");
load_dof_data3(g, u[1], OUTPUT_DIR"u.dat", NULL);
load_dof_data3(g, p[1], OUTPUT_DIR"p.dat", NULL);
#endif
/* Project to continuous gradu */
#if 1
phgPrintf("\n ======================= \n");
phgPrintf("project velocity gradient");
phgPrintf("\n======================== \n");
proj_gradu(ns, ns->gradu[1]);
#endif
//DOF_SCALE(gradu[1], "grad u");
//DOF_SCALE(ns->Gradu, "Grad u");
phgPrintf("\n----------------------------\n");
phgPrintf("check ice shelf mask status");
phgPrintf("\n----------------------------\n");
get_mask_bot(ns);
if (!(ns_params->another_run_with_updated_mask))
{
mask_iter = 1;
phgPrintf("manually stops another run with updated mask!\n\n\n");
IF_CHANGE_MASK = if_update_shelf_mask(ns);
IF_CHANGE_MASK = 0;
get_mask_bot(ns);
if (tstep % ns_params->step_span == 0) {
phgPrintf("Save water and nodal forces to VTK \n");
DOF *water_P1 = phgDofCopy(ns->water_force, NULL, DOF_P1, NULL);
DOF *nodal_P1 = phgDofCopy(ns->nodal_force, NULL, DOF_P1, NULL);
sprintf(vtk_file, MASK_OUTPUT_DIR "MASK_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, water_P1,nodal_P1,ns->contact_force,ns->mask_bot,NULL);
phgDofFree(&water_P1);phgDofFree(&nodal_P1);
}
}
if (mask_iter < 1)
{
IF_CHANGE_MASK = if_update_shelf_mask(ns);
}
if ((ns_params->another_run_with_updated_mask)){
if (IF_CHANGE_MASK == 0)
{
phgPrintf("The lower surface mask remains unchanged. Stop the iteration of mask updating !\n");
if (tstep % ns_params->step_span == 0) {
get_mask_bot(ns);
phgPrintf("Save water and nodal forces to VTK \n");
DOF *water_P1 = phgDofCopy(ns->water_force, NULL, DOF_P1, NULL);
DOF *nodal_P1 = phgDofCopy(ns->nodal_force, NULL, DOF_P1, NULL);
sprintf(vtk_file, MASK_OUTPUT_DIR "MASK_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, water_P1,nodal_P1,ns->contact_force,ns->mask_bot,NULL);
phgDofFree(&water_P1);phgDofFree(&nodal_P1);
}
phgDofFree(&ns->nodal_force);
phgDofFree(&ns->water_force);
phgDofFree(&ns->contact_force);
break;
}
}
get_strain_rate(ns);
if (ns->set_dirichlet_bc) {
//DOF *u_d = phgDofCopy(ns->u[1], NULL, DOF_P2, NULL);
DOF *eu_d = phgDofCopy(ns->strain_rate, NULL, DOF_P1, NULL);
ns->eu_d = eu_d;
}
else {
//DOF *u_n = phgDofCopy(ns->u[1], NULL, DOF_P2, NULL);
DOF *eu_n = phgDofCopy(ns->strain_rate, NULL, DOF_P1, NULL);
ns->eu_n = eu_n;
}
DOF *visc_old = phgDofCopy(ns->viscosity, NULL, DOF_P1, NULL);
if (inverse_iter > 0)
update_viscosity_inversion(ns);
FLOAT tol = 0.01;
INT visc_convergence = check_visc_convergence(ns, visc_old, tol);
if((mask_iter >= 1) && (inverse_iter > 0) && (visc_convergence == 1))
{
phgPrintf("\n-------------------------\n");
phgPrintf("ice shelf mask updated \n");
phgPrintf("--------------------------\n");
break;
}
if (mask_iter < 1)
if (tstep % ns_params->step_span == 0) {
phgPrintf("Save water and nodal forces to VTK \n");
DOF *water_P1 = phgDofCopy(ns->water_force, NULL, DOF_P1, NULL);
DOF *nodal_P1 = phgDofCopy(ns->nodal_force, NULL, DOF_P1, NULL);
sprintf(vtk_file, MASK_OUTPUT_DIR "MASK_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, water_P1,nodal_P1,ns->contact_force,ns->mask_bot,NULL);
phgDofFree(&water_P1);phgDofFree(&nodal_P1);
}
phgDofFree(&ns->nodal_force);
phgDofFree(&ns->water_force);
phgDofFree(&ns->contact_force);
//phgDofFree(&ns->mask_bot);
//phgDofFree(&ns->water_pressure);
//phgDofFree(&ns->stress_nn);
// phgPrintf("Free stress_nn !\n");
//phgDofFree(&ns->stress);
//phgDofFree(&ns->water_pressure1);
//phgDofFree(&ns->stress_nn1);
//phgDofFree(&ns->stress1);
//phgDofFree(&ns->avg_gu);
mask_iter++;
inverse_iter++;
}
proj_gradu(ns, ns->gradu[1]);
get_stress(ns, ns->gradu[1], ns->p[1]);
#if 0
if (1) {
int i, k;
DOF *Gu[DDim], *gu[DDim], *guDG0, *stress[DDim];
guDG0 = phgDofCopy(ns->gradu[1], NULL, DOF_P0, NULL);
for (k = 0; k < DDim; k++) {
FLOAT *vGu;
INT n;
char name[1000];
sprintf(name, "Gu%d", k);
Gu[k] = phgDofNew(g, DOF_P1, 1, name, DofNoAction);
vGu = ns->Gradu->data; /* DOF_P1 */
n = DofGetDataCount(Gu[k]);
for (i = 0; i < n; i++)
Gu[k]->data[i] = vGu[i * DDim + k];
sprintf(name, "stress%d", k);
stress[k] = phgDofNew(g, DOF_P1, 1, name, DofNoAction);
vGu = ns->stress->data; /* DOF_P1 */
n = DofGetDataCount(stress[k]);
for (i = 0; i < n; i++)
stress[k]->data[i] = vGu[i * DDim + k];
sprintf(name, "gu%d", k);
gu[k] = phgDofNew(g, DOF_P0, 1, name, DofNoAction);
vGu = guDG0->data; /* DOF_P0 */
n = DofGetDataCount(gu[k]);
for (i = 0; i < n; i++)
gu[k]->data[i] = vGu[i * DDim + k];
}
phgExportVTK(g, "stress.vtk",
stress[0], stress[1], stress[2],
stress[3], stress[4], stress[5],
stress[6], stress[7], stress[8],
NULL);
phgExportVTK(g, "Gu.vtk",
Gu[0], Gu[1], Gu[2],
Gu[3], Gu[4], Gu[5],
Gu[6], Gu[7], Gu[8],
gu[0], gu[1], gu[2],
gu[3], gu[4], gu[5],
gu[6], gu[7], gu[8],
NULL);
// phgFinalize();
}
#endif
/* --------------------------------------------------------------------------------
*
* Step 4.
*
* Solve temperature.
*
* -------------------------------------------------------------------------------- */
#if 1
if (ns_params->solve_temp) {
phgPrintf("\n ==================\n");
phgPrintf(" Temperature solve \n");
phgPrintf(" ==================\n\n");
phgPrintf(" T type: %s\n", T[1]->type->name);
elapsed_time(g, FALSE, 0.); /* reset timer */
phgNSInitSolverT(ns);
phgPrintf(" Build Mat: ");
phgNSBuildSolverTMat(ns, FALSE);
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
phgPrintf(" Build RHS: ");
phgNSBuildSolverTRHS(ns, FALSE);
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
phgNSSolverTBuildConstrain(ns);
phgDofCopy(ns->T[1], &ns->dT, NULL, "dT");
phgNSSolverTSolve(ns, FALSE);
elapsed_time(g, TRUE, phgPerfGetMflops(g, NULL, NULL));
phgNSDestroySolverT(ns);
//find_melt_region(ns);
DOF_SCALE(ns->T[1], "after solve");
phgDofAXPY(-1.0, ns->T[1], &ns->dT);
non_dT = phgDofNormInftyVec(ns->dT);
phgPrintf(" dT: %24.12E\n", non_dT);
DOF *temp_diff = phgDofCopy(ns->T[1], NULL, NULL, "Td");
{
FLOAT *vt = temp_diff->data;
const FLOAT *vh = ns->depth_P2->data;
INT i, n = DofGetDataCount(temp_diff);
for (i = 0; i < n; i++, vh++, vt++)
*vt = TEMP_WATER - BETA_MELT * (*vh) *LEN_SCALING - (*vt);
}
} else {
phgPrintf("Temp not updated.\n");
non_dT = 0.;
}
#endif
/* ------------------------------------------------------------
*
* Error check
*
* ------------------------------------------------------------ */
#if 0
if (!ns_params->compute_error) {
eu = ep = egradu = eT = NULL;
ediv = phgDofDivergence(u[1], NULL, NULL, "err div u");
phgPrintf( " normL2(u, p) = (%20.12E, %20.12E)\n"
" normH1(u) = (%20.12E)\n"
" normDiv(u) = (%20.12E)\n"
" normGadu = (%20.12E)\n",
dofNormL2(u[1]), dofNormL2(p[1]),
dofNormL2(gradu[1]), dofNormL2(ediv),
dofNormL2(ns->gradu[1]));
elapsed_time(g, TRUE, 0.);
} else {
/* ----Error check------- */
phgPrintf(" Errors: \n");
eu = phgDofCopy(u[1], NULL, ns_params->utype, "erru");
ep = phgDofCopy(p[1], NULL, ns_params->ptype, "errp");
eT = phgDofCopy(T[1], NULL, NULL, "errT");
egradu = phgDofCopy(gradu[1], NULL, NULL, "err grad u");
ediv = phgDofDivergence(u[1], NULL, NULL, "err div u");
adjust_time(- (1. - ns_params->Theta) * dt[0]);
restore_time();
phgPrintf(" errL2(u, p) = (%20.12E, %20.12E)\n"
" errH1(u) = (%20.12E)\n"
" errDiv(u) = (%20.12E)\n",
dofNormL2(eu), dofNormL2(ep),
dofNormL2(egradu), dofNormL2(ediv));
elapsed_time(g, TRUE, 0.);
phgDofFree(&egradu);
dof_norm_L2(eT);
}
#endif
getPecletNum(g, u[1], ns_params->nu, 6);
mem = phgMemoryUsage(g, &mem_peak);
phgPrintf(" Memory usage: current %0.4lgMB, peak %0.4lgMB\n",
(double)mem / (1024.0 * 1024.0),
(double)mem_peak / (1024.0 * 1024.0));
/* ------------------------------------------------------------
*
* Move mesh
*
* ------------------------------------------------------------ */
FLOAT ice_volume_last = get_ice_volume(g);
// DOF *dH_last = phgDofCopy(ns->dH, NULL, NULL, "dH_last");
if (ns_params->solve_height) {
if (gL != NULL) {
/* Unstructed layered mesh */
phgPrintf("Move mesh.\n");
get_surf_dH(ns);
//DOF *dH_fem = phgDofCopy(ns->dH, NULL, NULL, NULL);
phgExportVTK(g, "dH_fem1.vtk", ns->dH, NULL);
get_smooth_surface_values(ns, ns->dH, 0);
get_smooth_surface_values(ns, ns->dH, 1);
phgExportVTK(g, "dH_fem.vtk", ns->dH, NULL);
/*
save_free_surface_elev(ns, 0);
save_free_surface_elev(ns, 1);
save_free_surface_velo(ns, 0, 0);
save_free_surface_velo(ns, 1, 0);
save_free_surface_velo(ns, 2, 0);
save_free_surface_velo(ns, 0, 1);
save_free_surface_velo(ns, 1, 1);
save_free_surface_velo(ns, 2, 1);
if (phgRank == 0)
{
system("python get_upper_ds.py");
system("python get_lower_ds.py");
}
load_dH_from_file(ns, ns->dH, 0);
load_dH_from_file(ns, ns->dH, 1);
//DOF *dH_fdm = phgDofCopy(ns->dH, NULL, NULL, NULL);
//phgDofAXPY(-1, dH_fem, &dH_fdm);
//phgExportVTK(g, "dH_diff.vtk", dH_fdm, NULL);
*///phgExportVTK(g, "dH_fdm.vtk", ns->dH, NULL);
get_moved_coord(ns, tstep);
phgExportVTK(g, "dH_fem2.vtk", NULL);
move_mesh(ns);
//phgExportVTK(g, "moved_geo.vtk", NULL);
//check_height(g, gL);
} else {
/* Structed layered mesh */
struct_mesh_update(ns, tstep, Time);
}
phgDofGradient(u[1], &gradu[1], NULL, "gradu_{n+1}");
phgDofGradient(u[0], &gradu[0], NULL, "gradu_{n}");
} else {
phgPrintf("Mesh not moved.\n");
}
phgPrintf("\n-----------------------------------------\n");
phgPrintf(" dH: [%4.2E, %4.2E]\n",
phgDofMinValVec(ns->dH),
phgDofMaxValVec(ns->dH));
phgPrintf("------------------------------------------\n\n");
FLOAT ice_volume = get_ice_volume(g);
//DOF *u_P1 = phgDofCopy(u[1], NULL, DOF_P1, NULL);
//phgExportVTK(g, "u_P1.vtk", u_P1, NULL);
#if 1
//INT dH_convergence = check_surf_convergence(ns, dH_last);
//if (dH_convergence == 1)
FLOAT dVdt = fabs(ice_volume-ice_volume_last)/ice_volume/dt[0];
if (Time > 10 && dVdt < ns_params->s_tol)
{
phgPrintf("-----------------------------------------------------\n");
phgPrintf("The ice domain reaches a steady state! Model stops! dVdt %e", dVdt);
phgPrintf("\n-----------------------------------------------------\n");
break;
}
else
{
phgPrintf("\n--------------------------------------------------------------\n");
phgPrintf("The ice domain is still in an unsteady state! Model continues! dVdt %e\n", dVdt);
phgPrintf("---------------------------------------------------------------\n\n");
}
#endif
update_grounding_line(ns, tstep);
// after we update the geometry, we need to check the ice shelf mask again
/* ------------------------------------------------------------
*
* Output solution
*
* ------------------------------------------------------------ */
if (tstep % ns_params->step_span == 0) {
//ice_monitor(ns, tstep);
#if 1
/* Temp check */
phgPrintf(" Output solution to VTK");
/* phgExportEnsightT(g, OUTPUT_DIR "/ins_" NS_PROBLEM , Time, tstep, */
/* u[1], p[1], T[1], ns->depth_P1, */
/* NULL); /\* ensight *\/ */
DOF *u_P1 = phgDofCopy(u[1], NULL, DOF_P1, NULL);
//phgExportVTK(g,"results.vtk",u_P1,p[1],NULL);
sprintf(vtk_file, dH_OUTPUT_DIR "ice_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, u_P1, NULL);
phgDofFree(&u_P1);
sprintf(vtk_file, dH_OUTPUT_DIR "dH_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, ns->dH, NULL);
sprintf(vtk_file, dH_OUTPUT_DIR "stress_%05d.vtk", tstep);
phgExportVTK(g, vtk_file, ns->stress, NULL);
//sprintf(vtk_file, OUTPUT_DIR "mask_%05d.vtk", tstep);
//phgExportVTK(g, vtk_file, ns->mask_bot, NULL);
elapsed_time(g, TRUE, 0.);
#endif
/* Save coord data */
#if 1
if (tstep % ns_params->step_span_resume == 0) {
{
//sprintf(data_Crd, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat.Crd", tstep);
sprintf(data_Crd, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat.Crd", 2);
assert(ns->coord->type == DOF_P1);
save_dof_data3(g, ns->coord, data_Crd);
}
if (ns_params->record) {
/* save dof data for time step {n}, {n+1} */
//sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", tstep - 1);
sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", 1);
DATA_FILE_SURFIX;
save_dof_data3(g, u[0], data_u);
save_dof_data3(g, p[0], data_p);
save_dof_data3(g, T[0], data_T);
phgPrintf(" Save u_ {%5d}[%8d]:%24.12E p_ {%5d}[%8d]:%24.12E\n",
tstep - 1, DofGetDataCountGlobal(u[0]), phgDofNormL2(u[0]),
tstep - 1, DofGetDataCountGlobal(p[0]), phgDofNormL2(p[0]));
phgPrintf(" Save T_{%5d}[%8d]:%24.12E\n",
tstep - 1, DofGetDataCountGlobal(T[0]), phgDofNormL2(T[0]));
DOF_SCALE(u[0], "save");
DOF_SCALE(p[0], "save");
DOF_SCALE(T[0], "save");
DOF_SCALE(gradu[0], "save");
//sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", tstep);
sprintf(data_file, OUTPUT_DIR "/ins_" NS_PROBLEM "_%05d.dat", 2);
DATA_FILE_SURFIX;
save_dof_data3(g, u[1], data_u);
save_dof_data3(g, p[1], data_p);
save_dof_data3(g, T[1], data_T);
phgPrintf(" Save u_ {%5d}[%8d]:%24.12E p_ {%5d}[%8d]:%24.12E\n",
tstep, DofGetDataCountGlobal(u[1]), phgDofNormL2(u[1]),
tstep, DofGetDataCountGlobal(p[1]), phgDofNormL2(p[1]));
phgPrintf(" Save T_{%5d}[%8d]:%24.12E\n",
tstep, DofGetDataCountGlobal(T[1]), phgDofNormL2(T[1]));
DOF_SCALE(u[1], "save");
DOF_SCALE(p[1], "save");
DOF_SCALE(T[1], "save");
DOF_SCALE(gradu[1], "save");
phgResumeLogUpdate(g, NULL, NULL, NULL, data_file);
} /* end of record */
if (gL != NULL) {
//check_height(g, gL);
}
sayHello("After record final solution data");
}
#endif
}
//phgDofFree(&dH_last);
/* clean up */
//phgDofFree(&ediv);
//phgDofFree(&eu);
//phgDofFree(&ep);
//phgDofFree(&eT);
/* ----------------------------------------------------------------------
*
* Compute drag force FD
*
* ----------------------------------------------------------------------
* */
phgGetTime(tt1);
phgPrintf(" total time usage of current time step: %lfs\n",
(double)(tt1[2] - tt[2]));
if (mem_peak > 1024 * (size_t)ns_params->mem_max * 1024) {
phgPrintf("\n=======\nMem usage reach max, exit.\n");
break;
}
tstep++;
#if 1
/* use time t^{n} */
dt[-1] = dt[0];
if (Time + dt[0] > time_end)
dt[0] = time_end - Time;
Time += dt[0];
setFuncTime(Time);
#endif
phgDofFree(&surf_bas->dof);
phgDofFree(&ns->surf_bas->dof);
} /* end of time advaning */
/* destroy line block */
//destroy_line_block(&ns->bk);
/* destroy reused solver */
if (ns->solver_u != NULL) {
if (ns_params->use_PCD)
phgNSDestroyPc(ns);
phgNSDestroySolverU(ns);
}
phgNSFinalize(&ns);
phgFreeGrid(&g);
phgFinalize();
phgFree(ns_params);
return 0;
}
/**********************************************************************
* C Code Documentation ************************************************
**********************************************************************
NAME time_sum
DESCRIPTION Sum a time span or time object.
To be called from R as
\\
{\tt
.Call("time_sum", time_vec, na_rm, cum)
}
where TIMECLASS is replaced by the name of the time or time
span class. Normally only time spans are summed, but a time
object can be summed to calculate mean.
ARGUMENTS
IARG time_vec The R time or time span vector object
IARG na_rm T to remove NAs
IARG cum T to do a cumulative sum vector, F for sum
RETURN If cum is T, na_rm is ignored and this function returns a
vector of the same type as the input whose elements are the
cumulative sum of the inputs through the corresponding input element.
If the jth element is NA, then all subsequent elements of the return
will be NA and a warning will be generated. If cum is F, this
function returns a length 1 vector of the same type as the input,
containing the sum of all the elements. If na_rm is False, any
NA in the input will generate an NA return value.
ALGORITHM The sums are calculated through addition, along with
the adjust_time or adjust_span function.
No special time zones or formats are put on the returned object.
EXCEPTIONR
NOTE
**********************************************************************/
SEXP time_sum( SEXP time_vec, SEXP na_rm, SEXP cum )
{
SEXP ret;
Sint *in_days, *in_ms, *out_days, *out_ms, *rm_na, *in_cum;
Sint i, lng, is_span, tmplng, tmp;
/* get the desired parts of the time object */
if( !time_get_pieces( time_vec, NULL, &in_days, &in_ms, &lng, NULL,
NULL, NULL ))
error( "Invalid time argument in C function time_sum" );
/* get na_rm and cum */
PROTECT(na_rm = AS_LOGICAL(na_rm));
if( length(na_rm) < 1L){
UNPROTECT(3);
error( "Problem extracting data from second argument in C function time_sum" );
}
rm_na = (Sint *) LOGICAL(na_rm);
PROTECT(cum = AS_LOGICAL(cum));
if( length(cum) < 1L){
UNPROTECT(4);
error( "Problem extracting data from third argument in C function time_sum" );
}
in_cum = (Sint *) LOGICAL(cum);
/* create output time or time span object */
is_span = 0;
if( checkClass( time_vec, IS_TIME_CLASS, 1L ))
PROTECT(ret = time_create_new( *in_cum ? lng : 1, &out_days, &out_ms ));
else if( checkClass( time_vec, IS_TSPAN_CLASS, 1L ))
{
is_span = 1;
PROTECT(ret = tspan_create_new( *in_cum ? lng : 1, &out_days, &out_ms ));
}
else{
UNPROTECT(4);
error( "Unknown class on first argument in C function time_sum" );
}
if( !out_days || !out_ms || !ret ){
UNPROTECT(5);
error( "Could not create return object in C function time_sum" );
}
out_days[0] = out_ms[0] = 0;
/* go through input and find sum */
for( i = 0; i < lng; i++ )
{
/* check for NA */
if( in_days[i] ==NA_INTEGER ||
in_ms[i] ==NA_INTEGER)
{
if( !*in_cum && *rm_na ) /* ignore NA */
continue;
else /* NA causes output to be NA */
{
if( *in_cum ) {
for( ; i < lng; i++ ) /* fill in all the rest */
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
}
warning( "Found NA value in cumsum" );
}
else /* make the sum NA */
{
out_days[0] = NA_INTEGER;
out_ms[0] = NA_INTEGER;
}
UNPROTECT(5);
return( ret );
}
}
/* add this value in */
if( *in_cum && ( i >= 1 ))
{
out_days[i] = out_days[i-1] + in_days[i];
out_ms[i] = out_ms[i-1] + in_ms[i];
if( is_span )
tmp = adjust_span( &(out_days[i]), &(out_ms[i] ));
else
tmp = adjust_time( &(out_days[i]), &(out_ms[i] ));
} else {
out_days[0] += in_days[i];
out_ms[0] += in_ms[i];
if( is_span )
tmp = adjust_span( &(out_days[0]), &(out_ms[0] ));
else
tmp = adjust_time( &(out_days[0]), &(out_ms[0] ));
}
if( !tmp )
{
out_days[0] = NA_INTEGER;
out_ms[0] = NA_INTEGER;
}
}
UNPROTECT(5); //3+2 from time_get_pieces
return ret;
}
/**********************************************************************
* C Code Documentation ************************************************
**********************************************************************
NAME time_num_op
DESCRIPTION Perform an arithmetic operation between a time or
time span and a numeric. Supported operations are "+", "-",
"*", and "/". To be called from R as
\\
{\tt
.Call("time_num_op", time_vec, num_vec, op)
}
where TIMECLASS is replaced by the name of the time or time
span class.
ARGUMENTS
IARG time_vec The R time or time span vector object
IARG num_vec The numeric vector object
IARG op Character string giving the operation
RETURN Returns a time or time span vector (same as passed in class)
that is the result of time_vec op num_vec.
ALGORITHM Addition and subtraction are performed by combining the integer
part of the numeric with the julian days of the time and the fractional
part of the numeric (converted from fraction of a day to milliseconds)
to the milliseconds of the time object. Multiplication and division
are performed by converting the time object to a numeric with its
integer part the number of days and fractional part the fraction of
the day (found by the ms_to_fraction function), multiplying or dividing,
and then converting back.
No special time zones or formats are put on the returned object.
If one of the two vectors has a length that is a multiple of the other,
the shorter one is repeated.
EXCEPTIONS
NOTE See also: time_time_add, time_rel_add
**********************************************************************/
SEXP time_num_op( SEXP time_vec, SEXP num_vec, SEXP op )
{
SEXP ret;
double *in_nums, tmpdbl;
Sint *in_days, *in_ms, *out_days, *out_ms, add_sign;
Sint i, lng1, lng2, lng, ind1, ind2, is_span, is_ok, tmp;
const char *in_op;
/* get the desired parts of the time object */
if( !time_get_pieces( time_vec, NULL, &in_days, &in_ms, &lng1, NULL,
NULL, NULL ))
error( "Invalid time argument in C function time_num_op" );
/* extract other input data */
PROTECT( num_vec = (SEXP) AS_NUMERIC(num_vec) );
if( (lng2 = length(num_vec)) < 1L){
UNPROTECT(3);
error( "Problem extracting numeric argument in C function time_num_op" );
}
in_nums = REAL(num_vec);
if(lng1 && lng2 && ( lng1 % lng2 ) && ( lng2 % lng1 )){
UNPROTECT(3);
error( "Length of longer operand is not a multiple of length of shorter in C function time_num_op" );
}
if( !isString(op) || length(op) < 1L){
UNPROTECT(3);
error( "Problem extracting operation argument in C function time_num_op" );
}
if( length(op) > 1L )
warning( "Using only the first string in operation argument in C function time_num_op" );
in_op = CHAR(STRING_ELT(op, 0));
if(( *in_op != '*' ) && ( *in_op != '+' ) && ( *in_op != '-' ) &&
( *in_op != '/' )){
UNPROTECT(3);
error( "Unknown operator in C function time_num_op" );
}
/* create output time or time span object */
if( !lng1 || !lng2 )
lng = 0;
else if( lng2 > lng1 )
lng = lng2;
else
lng = lng1;
is_span = 1;
if( checkClass( time_vec, IS_TIME_CLASS, 1L ))
{
is_span = 0;
PROTECT(ret = time_create_new( lng, &out_days, &out_ms ));
}
else if( checkClass( time_vec, IS_TSPAN_CLASS, 1L )){
PROTECT(ret = tspan_create_new( lng, &out_days, &out_ms ));
} else {
UNPROTECT(3);
error( "Unknown class on first argument in C function time_num_op" );
}
if( !out_days || !out_ms || !ret ){
UNPROTECT(4);
error( "Could not create return object in C function time_num_op" );
}
/* go through input and perform operation */
for( i = 0; i < lng; i++ )
{
ind1 = i % lng1;
ind2 = i % lng2;
/* check for NA */
if( in_days[ind1] == NA_INTEGER ||
in_ms[ind1] == NA_INTEGER ||
ISNA( in_nums[ind2]))
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
continue;
}
/* operate and adjust output */
add_sign = 1;
is_ok = 1;
switch( *in_op )
{
case '-':
add_sign = -1;
/*LINTED: Meant to fall through here */
case '+':
/* add/subtract integer part to days and fractional part to ms */
out_days[i] = in_days[ind1] + add_sign * (Sint) floor( in_nums[ind2] );
is_ok = ms_from_fraction( in_nums[ ind2 ] - floor( in_nums[ind2] ),
&(out_ms[i]));
out_ms[i] = in_ms[ind1] + add_sign * out_ms[i];
break;
case '*':
/* convert time to numeric, multiply, convert back */
if( in_ms[ind1] > 0 )
is_ok = ms_to_fraction( in_ms[ind1], &tmpdbl );
else
{
is_ok = ms_to_fraction( - in_ms[ind1], &tmpdbl );
tmpdbl = -tmpdbl;
}
tmpdbl = ( tmpdbl + in_days[ind1] ) * in_nums[ind2];
out_days[i] = (Sint) floor( tmpdbl );
is_ok = is_ok && ms_from_fraction( tmpdbl - out_days[i], &out_ms[i] );
break;
case '/':
/* convert time to numeric, divide, convert back */
if( in_ms[ind1] > 0 )
is_ok = ms_to_fraction( in_ms[ind1], &tmpdbl );
else
{
is_ok = ms_to_fraction( - in_ms[ind1], &tmpdbl );
tmpdbl = -tmpdbl;
}
if( in_nums[ind2] == 0 )
is_ok = 0;
else
tmpdbl = ( tmpdbl + in_days[ind1] ) / in_nums[ind2];
out_days[i] = (Sint) floor( tmpdbl );
is_ok = is_ok && ms_from_fraction( tmpdbl - out_days[i], &out_ms[i] );
break;
default:
is_ok = 0;
}
if( !is_ok )
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
continue;
}
if( is_span )
tmp = adjust_span( &(out_days[i]), &(out_ms[i] ));
else
tmp = adjust_time( &(out_days[i]), &(out_ms[i] ));
if( !tmp )
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
continue;
}
}
UNPROTECT(4); //2+2 from time_get_pieces
return ret;
}
/**********************************************************************
* C Code Documentation ************************************************
**********************************************************************
NAME time_time_add
DESCRIPTION Add or subtract two time or time span objects.
To be called from R as
\\
{\tt
.Call("time_time_add", time1, time2, add.sign, ret.class)
}
where TIMECLASS is replaced by the name of the time or time
span classes passed in those arguments.
ARGUMENTS
IARG time1 The first R time or time span vector object
IARG time2 The second R time or time span vector object
IARG sign Either +1. or -1., to add or subtract the second
IARG ret_class Return class, as a character string.
RETURN Returns a time or time span vector (depending on ret_class)
that is the sum or difference of the input time and time span vectors.
ALGORITHM Each element of the second object is added to or subtracted
from the corresponding element of the first object, by combining their
days and milliseconds and then carrying milliseconds over into days
as necessary using the adjust_time or adjust_span functions.
No special time zones or formats are put on the returned object.
If one of the two vectors has a length that is a multiple of the other,
the shorter one is repeated.
EXCEPTIONS
NOTE See also: time_num_op, time_rel_add
**********************************************************************/
SEXP time_time_add( SEXP time1, SEXP time2,
SEXP sign, SEXP ret_class )
{
SEXP ret;
double *in_sign;
Sint *in_days1, *in_ms1, *in_days2, *in_ms2, *out_days, *out_ms;
Sint i, lng1, lng2, lng, ind1, ind2, sign_na, is_span, tmp;
const char *in_class;
/* get the desired parts of the time objects */
if( !time_get_pieces( time1, NULL, &in_days1, &in_ms1, &lng1, NULL,
NULL, NULL ))
error( "Invalid time1 argument in C function time_time_add" );
if( !time_get_pieces( time2, NULL, &in_days2, &in_ms2, &lng2, NULL,
NULL, NULL ))
error( "Invalid time2 argument in C function time_time_add" );
if(lng1 && lng2 && ( lng1 % lng2 ) && ( lng2 % lng1 ))
error( "Length of longer operand is not a multiple of length of shorter in C function time_time_add" );
/* get the sign and class */
PROTECT(sign = AS_NUMERIC(sign));
in_sign = REAL(sign);
if( length(sign) < 1L ){
UNPROTECT(5);
error( "Problem extracting sign argument in C function time_time_add" );
}
sign_na = (Sint) ISNA( *in_sign );
if( !isString(ret_class) || length(ret_class) < 1L){
UNPROTECT(5);
error( "Problem extracting class argument in C function time_time_add" );
}
in_class = (char *) CHAR(STRING_ELT(ret_class, 0));
/* create output time or time span object */
if( !lng1 || !lng2 )
lng = 0;
else if( lng2 > lng1 )
lng = lng2;
else
lng = lng1;
is_span = 1;
if( !strcmp( in_class, TIME_CLASS_NAME ))
{
is_span = 0;
PROTECT(ret = time_create_new( lng, &out_days, &out_ms ));
}
else if( !strcmp( in_class, TSPAN_CLASS_NAME ))
PROTECT(ret = tspan_create_new( lng, &out_days, &out_ms ));
else{
UNPROTECT(5);
error( "Unknown class argument in C function time_time_add" );
}
if( !ret || !out_days || !out_ms )
error( "Could not create return object in C function time_time_add" );
/* go through input and add */
for( i = 0; i < lng; i++ )
{
ind1 = i % lng1;
ind2 = i % lng2;
/* check for NA */
if( sign_na ||
in_days1[ind1] ==NA_INTEGER ||
in_ms1[ind1] ==NA_INTEGER ||
in_days2[ind2] ==NA_INTEGER ||
in_ms2[ind2] ==NA_INTEGER)
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
continue;
}
/* add and adjust output */
out_days[i] = in_days1[ind1] + *in_sign * in_days2[ind2];
out_ms[i] = in_ms1[ind1] + *in_sign * in_ms2[ind2];
if( is_span )
tmp = adjust_span( &(out_days[i]), &(out_ms[i] ));
else
tmp = adjust_time( &(out_days[i]), &(out_ms[i] ));
if( !tmp )
{
out_days[i] = NA_INTEGER;
out_ms[i] = NA_INTEGER;
continue;
}
}
UNPROTECT(6); //2+4 from time_get_pieces
return ret;
}
int main(
int argc,
char **argv)
{
/*
* Args are: file TBS, keyfile, [update]
*/
struct Certificate cert;
Certificate(&cert, (ushort) 0);
struct CertificateRevocationList crl;
CertificateRevocationList(&crl, (ushort) 0);
struct Blob blob;
Blob(&blob, (ushort) 0);
struct AlgorithmIdentifier *algp,
*tbsalgp;
struct casn *casnp,
*sigp,
*selfp;
const char *keyfile = NULL;
OPEN_LOG("sign_cert", LOG_USER);
if (argc < 3)
FATAL(MSG_USAGE);
char *sfx = strrchr(argv[1], (int)'.');
keyfile = argv[2];
if (!strcmp(sfx, ".cer"))
{
selfp = &cert.self;
casnp = &cert.toBeSigned.self;
tbsalgp = &cert.toBeSigned.signature;
sigp = &cert.signature;
algp = &cert.algorithm;
}
else if (!strcmp(sfx, ".crl"))
{
selfp = &crl.self;
casnp = &crl.toBeSigned.self;
tbsalgp = &crl.toBeSigned.signature;
sigp = &crl.signature;
algp = &crl.algorithm;
}
else if (!strcmp(sfx, ".blb"))
{
selfp = &blob.self;
casnp = &blob.toBeSigned;
tbsalgp = NULL;
sigp = &blob.signature;
algp = &blob.algorithm;
}
else
{
FATAL(MSG_UNK_EXT, argv[1]);
}
if (get_casn_file(selfp, argv[1], 0) < 0)
FATAL(MSG_OPEN, argv[1]);
if (argv[3] && (*argv[3] & 1))
{
if (!strcmp(sfx, ".cer"))
adjust_time(&cert.toBeSigned.validity.notBefore.utcTime,
&cert.toBeSigned.validity.notAfter.utcTime);
else if (!strcmp(sfx, ".crl"))
adjust_time((struct casn *)&crl.toBeSigned.lastUpdate,
(struct casn *)&crl.toBeSigned.nextUpdate);
}
if (tbsalgp && (!argv[3] || !(*argv[3] & 2)))
{
write_objid(&tbsalgp->algorithm, id_sha_256WithRSAEncryption);
write_casn(&tbsalgp->parameters.rsadsi_SHA256_WithRSAEncryption,
(uchar *) "", 0);
}
if (!set_signature(casnp, sigp, keyfile, "label", "password", false))
{
FATAL(MSG_IN, "set_signature()");
}
if (!argv[3] || !(*argv[3] & 4))
{
write_objid(&algp->algorithm, id_sha_256WithRSAEncryption);
write_casn(&algp->parameters.rsadsi_SHA256_WithRSAEncryption,
(uchar *) "", 0);
}
put_casn_file(selfp, argv[1], 0);
DONE(MSG_OK, argv[1]);
return 0;
}