LGM_PROBLEM* NS_DIM_PREFIX CreateProblem (const char *name, InitProcPtr init, DomainSizeConfig domconfig, BndCondProcPtr BndCond, int numOfCoefficients, CoeffProcPtr coeffs[], int numOfUserFct, UserProcPtr userfct[])
{
LGM_PROBLEM *newProblem;
int i;
if (ChangeEnvDir("/LGM_PROBLEM")==NULL) return(NULL);
/* allocate new problem structure */
newProblem = (LGM_PROBLEM *) MakeEnvItem (name,theProblemVarID,sizeof(LGM_PROBLEM)+(numOfCoefficients+numOfUserFct-1)*sizeof(void*));
if (newProblem==NULL) return(NULL);
/* fill in data */
LGM_PROBLEM_INIT(newProblem) = init;
LGM_PROBLEM_CONFIG(newProblem) = NULL;
LGM_PROBLEM_DOMCONFIG(newProblem) = domconfig;
LGM_PROBLEM_BNDCOND(newProblem) = BndCond;
LGM_PROBLEM_INNERBNDCOND(newProblem)= NULL;
LGM_PROBLEM_NCOEFF(newProblem) = numOfCoefficients;
LGM_PROBLEM_NUSERF(newProblem) = numOfUserFct;
for (i=0; i<numOfCoefficients; i++) LGM_PROBLEM_SETCOEFF(newProblem,i,coeffs[i]);
for (i=0; i<numOfUserFct; i++) LGM_PROBLEM_SETUSERF(newProblem,i,userfct[i]);
UserWrite("lgm_problem "); UserWrite(name); UserWrite(" installed\n");
return (newProblem);
}
INT NS_DIM_PREFIX NPNLIterDisplay (NP_NL_ITER *np)
{
if ((np->A == NULL) && (np->x == NULL) && (np->b == NULL))
return(0);
UserWrite("symbolic user data:\n");
if (np->A != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"A",ENVITEM_NAME(np->A));
if (np->x != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"x",ENVITEM_NAME(np->x));
if (np->b != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"r",ENVITEM_NAME(np->b));
UserWrite("\n");
return(0);
}
INT NS_DIM_PREFIX NPTSolverInit (NP_T_SOLVER *np, INT argc , char **argv)
{
INT r;
r = NP_EXECUTABLE; /* highest state */
/* The solution is required for execution */
np->y = ReadArgvVecDesc(np->nlass.base.mg,"y",argc,argv);
if (np->y == NULL)
{
r = NP_NOT_ACTIVE;
UserWrite("Warning: solution y is required for execution !\n");
}
/* assemble numproc is required for execution */
np->tass = (NP_T_ASSEMBLE *)
ReadArgvNumProc(np->nlass.base.mg,"A",T_ASSEMBLE_CLASS_NAME,argc,argv);
if (np->tass == NULL) r = NP_NOT_ACTIVE;
/* solver numproc is required for execution */
np->nlsolve = (NP_NL_SOLVER *)
ReadArgvNumProc(np->nlass.base.mg,"S",NL_SOLVER_CLASS_NAME,argc,argv);
if (np->nlsolve == NULL) r = NP_NOT_ACTIVE;
return(r);
}
static INT NonLinearDefect (MULTIGRID *mg, INT level, INT init, VECDATA_DESC *x, NP_NEWTON *newton, NP_NL_ASSEMBLE *ass, VEC_SCALAR defect, INT *error)
{
LRESULT lr; /* result of linear solver */
INT i,n_unk;
n_unk = VD_NCOMP(x);
/* project solution to all grid levels */
if (newton->trans->PreProcessProject!=NULL)
if ((*newton->trans->PreProcessProject)(newton->trans,0,level,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
if ((*newton->trans->ProjectSolution)(newton->trans,0,level,x,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
if (newton->trans->PostProcessProject!=NULL)
if ((*newton->trans->PostProcessProject)(newton->trans,0,level,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
if (init)
{
/* preprocess assemble once before all calls */
if (ass->PreProcess!=NULL)
if ((*ass->PreProcess)(ass,0,level,x,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
/* set dirichlet conditions on all grid levels */
if ((*ass->NLAssembleSolution)(ass,0,level,x,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
}
/* compute new nonlinear defect */
CSTART();
dset(mg,0,level,ALL_VECTORS,newton->d,0.0);
*error = 0;
if ((*ass->NLAssembleDefect)(ass,0,level,x,newton->d,newton->J,error)) { *error = __LINE__; REP_ERR_RETURN(*error); }
if (*error) return(0);
CSTOP(defect_t,defect_c);
if (newton->lineSearch == 3)
dcopy(mg,0,level,ALL_VECTORS,newton->dsave,newton->d);
if (UG_math_error) { UserWrite("math error in NLAssembleDefect\n"); UG_math_error = 0; *error = __LINE__; REP_ERR_RETURN(*error); }
IFDEBUG(np,3)
UserWrite("---- After computation of nonlinear defect\n");
ListVectorRange(mg,0,level,0,0,1000,FALSE,TRUE,~(INT)1,LV_MOD_DEFAULT);
ENDDEBUG
/* compute norm of defect */
if ((*newton->solve->Residuum)(newton->solve,0,level,newton->v,newton->d,newton->J,&lr)) { *error = __LINE__; REP_ERR_RETURN(*error); }
for (i=0; i<n_unk; i++) defect[i] = lr.last_defect[i];
return (0);
}
static INT EWDisplay (NP_BASE *theNP)
{
INT i;
NP_EW_SOLVER *npew;
NP_EWN *np;
np = (NP_EWN *) theNP;
npew = (NP_EW_SOLVER *) theNP;
if (npew->nev > 0) UserWrite("symbolic user data:\n");
for (i=0; i<npew->nev; i++)
if (i<10) UserWriteF("ev[%d] = %-35.32s\n", i,ENVITEM_NAME(npew->ev[i]));
else UserWriteF("ev[%d] = %-35.32s\n", i,ENVITEM_NAME(npew->ev[i]));
UserWrite("\n");
UserWrite("configuration parameters:\n");
if (sc_disp(npew->reduction,npew->ev[0],"red")) return (1);
if (sc_disp(npew->abslimit,npew->ev[0],"abslimit")) return (1);
UserWriteF(DISPLAY_NP_FORMAT_SI,"m",(int)np->maxiter);
if (np->LS != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"L",ENVITEM_NAME(np->LS));
else
UserWriteF(DISPLAY_NP_FORMAT_SS,"L","---");
if (np->Transfer != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"T",ENVITEM_NAME(np->Transfer));
else
UserWriteF(DISPLAY_NP_FORMAT_SS,"T","---");
if (np->display == PCR_NO_DISPLAY)
UserWriteF(DISPLAY_NP_FORMAT_SS,"DispMode","NO_DISPLAY");
else if (np->display == PCR_RED_DISPLAY)
UserWriteF(DISPLAY_NP_FORMAT_SS,"DispMode","RED_DISPLAY");
else if (np->display == PCR_FULL_DISPLAY)
UserWriteF(DISPLAY_NP_FORMAT_SS,"DispMode","FULL_DISPLAY");
if (np->r != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"r",ENVITEM_NAME(np->r));
if (np->t != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"t",ENVITEM_NAME(np->t));
if (np->M != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"M",ENVITEM_NAME(np->M));
return(0);
}
INT NS_DIM_PREFIX NPTSolverDisplay (NP_T_SOLVER *np)
{
UserWrite("symbolic user data:\n");
if (np->y != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"y",ENVITEM_NAME(np->y));
UserWrite("\n");
UserWrite("configuration parameters:\n");
if (np->y != NULL)
{
if (sc_disp(np->reduction,np->y,"reduction")) return (1);
if (sc_disp(np->abslimit,np->y,"abslimit")) return (1);
}
if (np->tass != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"tass",ENVITEM_NAME(np->tass));
if (np->nlsolve != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"nlsolve",ENVITEM_NAME(np->nlsolve));
return(0);
}
INT NS_DIM_PREFIX REINIT_Display (NP_BASE *base)
{
NP_REINIT *reinit;
INT i;
reinit=(NP_REINIT*)base;
UserWrite("\nreinit configuration:\n");
for (i=0; i<reinit->n; i++)
UserWriteF(DISPLAY_NP_FORMAT_SF,reinit->name[i],(float)reinit->parameter[i]);
return (0);
}
static INT NLSmoother (NP_NL_ITER *theNP, INT level,
VECDATA_DESC *x, VECDATA_DESC *b,MATDATA_DESC *A,
NP_NL_ASSEMBLE *ass, INT *result)
{
NP_NL_SMOOTHER *np;
GRID *theGrid;
/* store passed XXXDATA_DESCs */
NPINL_A(theNP) = A;
NPINL_x(theNP) = x;
NPINL_b(theNP) = b;
np = (NP_NL_SMOOTHER *) theNP;
theGrid = NP_GRID(theNP,level);
/* check function pointers in numprocs */
if (ass->NLAssembleMatrix==NULL)
{
UserWrite("NLGS: ass->NLAssembleMatrix not defined\n");
REP_ERR_RETURN (1);
}
if (ass->NLNAssembleMatrix==NULL)
{
UserWrite("NLGS: ass->NLNAssembleMatrix not defined\n");
REP_ERR_RETURN (1);
}
np->iter.Assemble = ass;
if ((*np->Step)(np,level,x,b,np->c,A,np->L,result))
REP_ERR_RETURN (1);
#ifdef ModelP
if (l_vector_consistent(theGrid,x) != NUM_OK) NP_RETURN(1,result[0]);
#endif
if (dscalx(NP_MG(theNP),level,level,ALL_VECTORS,x,np->damp) != NUM_OK)
NP_RETURN(1,result[0]);
if (dmatmul_minus(NP_MG(theNP),level,level,ALL_VECTORS,b,A,x)!= NUM_OK)
NP_RETURN(1,result[0]);
return (0);
}
static INT AMGSolverDisplay (NP_BASE *theNP)
{
NP_AMG *theAMGC;
theAMGC = (NP_AMG *)theNP;
/* display symbols */
NPLinearSolverDisplay(&theAMGC->ls);
/* display configuration parameters */
UserWrite("configuration parameters:\n");
return (0);
}
void FAMGWrite(ostrstream &OutputString)
{
#ifdef UG_DRAW
ostrstream ostr(testf,FAMG_IOBUFFFER_LEN);
assert(OutputString.pcount()<FAMG_IOBUFFFER_LEN);
ostr << OutputString.rdbuf() << '\0';
UserWrite( ostr.str() );
#else
#ifdef ModelP
cout << me << ": ";
#endif
cout << OutputString.rdbuf() << flush;
#endif
}
static INT NewtonPreProcess (NP_NL_SOLVER *solve, INT level, VECDATA_DESC *x, INT *result)
{
NP_NEWTON *newton;
newton = (NP_NEWTON *) solve;
if (AllocMDFromVD(solve->base.mg,0,level,x,x,&newton->J))
NP_RETURN(1,result[0]);
/* check function pointers in numprocs */
if (newton->trans->base.status < NP_ACTIVE)
{
UserWrite("Newton: newton->trans not active\n");
NP_RETURN(1,result[0]);
}
if (newton->trans->ProjectSolution==NULL)
{
UserWrite("Newton: newton->trans->ProjectSolution not defined\n");
NP_RETURN(1,result[0]);
}
if (newton->solve->base.status < NP_ACTIVE)
{
UserWrite("Newton: newton->solve not active\n");
NP_RETURN(1,result[0]);
}
if (newton->solve->Solver==NULL)
{
UserWrite("Newton: newton->solve->Solver not defined\n");
NP_RETURN(1,result[0]);
}
if (newton->solve->Residuum==NULL)
{
UserWrite("Newton: newton->solve->Residuum not defined\n");
NP_RETURN(1,result[0]);
}
return(0);
}
static INT NLSmootherDisplay (NP_NL_SMOOTHER *theNP)
{
NPNLIterDisplay(&theNP->iter);
UserWrite("configuration parameters:\n");
if (sc_disp(theNP->damp,theNP->iter.b,"damp")) REP_ERR_RETURN (1);
if (theNP->c != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"c",ENVITEM_NAME(theNP->c));
if (theNP->L != NULL)
UserWriteF(DISPLAY_NP_FORMAT_SS,"L",ENVITEM_NAME(theNP->L));
#ifdef ModelP
UserWriteF(DISPLAY_NP_FORMAT_SI,"cons_mode",(int)theNP->cons_mode);
#endif
return (0);
}
static INT EWInit (NP_BASE *theNP, INT argc , char **argv)
{
NP_EW_SOLVER *npew;
NP_EWN *np;
INT i,n;
char *token,*names,buffer[128];
npew = (NP_EW_SOLVER *) theNP;
np = (NP_EWN *) theNP;
np->reset = 1;
np->LS = (NP_LINEAR_SOLVER *)ReadArgvNumProc(theNP->mg,"L",LINEAR_SOLVER_CLASS_NAME,argc,argv);
if (np->LS == NULL) return(NP_NOT_ACTIVE);
np->Transfer = (NP_TRANSFER *)ReadArgvNumProc(theNP->mg,"T",TRANSFER_CLASS_NAME,argc,argv);
np->Project = (NP_PROJECT *)ReadArgvNumProc(theNP->mg,"P",PROJECT_CLASS_NAME,argc,argv);
np->M = ReadArgvMatDesc(theNP->mg,"M",argc,argv);
if (np->M==NULL) return(NP_NOT_ACTIVE);
np->N = ReadArgvMatDesc(theNP->mg,"N",argc,argv);
if (np->N==NULL || np->M==np->N) return(NP_NOT_ACTIVE);
np->E = ReadArgvVecDesc(theNP->mg,"E",argc,argv);
if (np->E==NULL) return(NP_NOT_ACTIVE);
np->t = ReadArgvVecDesc(theNP->mg,"t",argc,argv);
np->r = ReadArgvVecDesc(theNP->mg,"r",argc,argv);
if (ReadArgvINT("m",&(np->maxiter),argc,argv))
return(NP_NOT_ACTIVE);
np->display = ReadArgvDisplay(argc,argv);
np->baselevel = 0;
n = 0;
for (i=1; i<argc; i++)
if (argv[i][0]=='e')
{
if (sscanf(argv[i],"e %s",buffer)!=1)
{
UserWrite("Missing symbol for eigenvector in init of ew\n");
return(NP_NOT_ACTIVE);
}
names=argv[i];
names++;
while ((*names==' ')||(*names=='\t')) names++;
token = strtok(names," ");
npew->ev[n] = GetVecDataDescByName(npew->base.mg,token);
if (npew->ev[n] == NULL) npew->ev[n] = CreateVecDescOfTemplate(npew->base.mg,token,NULL);
if (npew->ev[n++] == NULL) return(NP_NOT_ACTIVE);
token = strtok(NULL," ");
if (token!=NULL)
if (sscanf(token,"%d",&n) != 1)
{
n = 1;
while (token!=NULL) {
npew->ev[n] = GetVecDataDescByName(npew->base.mg,token);
if (npew->ev[n] == NULL)
npew->ev[n] = CreateVecDescOfTemplate(npew->base.mg,
token,NULL);
if (npew->ev[n++] == NULL)
return(NP_NOT_ACTIVE);
token = strtok(NULL," ");
}
}
}
npew->nev = n;
if (ReadArgvINT("c_n",&np->c_n,argc,argv)) np->c_n=npew->nev;
if (np->c_n<1 || np->c_n>npew->nev) return(NP_NOT_ACTIVE);
if (ReadArgvINT("c_d",&np->c_d,argc,argv)) np->c_d=6;
if (np->c_d<1 || np->c_d>16) return(NP_NOT_ACTIVE);
if (sc_read(npew->abslimit,NP_FMT(npew),npew->ev[0],"abslimit",argc,argv))
for (i=0; i<MAX_VEC_COMP; i++)
npew->abslimit[i] = ABS_LIMIT;
if (sc_read(npew->reduction,NP_FMT(npew),npew->ev[0],"red",argc,argv))
return(NP_ACTIVE);
if (ReadArgvChar("type",buffer,argc,argv)) return(NP_ACTIVE);
if (strcmp(buffer,"std")==0) np->type=MD_STD;
else if (strcmp(buffer,"0")==0) np->type=MD_0;
else if (strcmp(buffer,"id")==0) np->type=MD_ID;
else np->type=MD_UNDEF;
if (ReadArgvDOUBLE("scale",&np->scale,argc,argv)) np->scale=1.0;
if (np->scale<=0.0) return(NP_ACTIVE);
if (ReadArgvDOUBLE("smin",&np->shift_min,argc,argv)) np->shift_min=0.0;
if (ReadArgvDOUBLE("smax",&np->shift_max,argc,argv)) np->shift_max=0.0;
if (ReadArgvDOUBLE("imax",&np->imag_max,argc,argv)) np->imag_max=0.0;
if (sc_read(np->weight,NP_FMT(npew),npew->ev[0],"weight",argc,argv))
for (i=0; i<MAX_VEC_COMP; i++)
np->weight[i]=1.0;
if (ReadArgvChar("cmode",buffer,argc,argv)) np->conv_mode=0;
else
{
if (strcmp(buffer,"val")==0) np->conv_mode=0;
else if (strcmp(buffer,"vec")==0) np->conv_mode=1;
else return(NP_ACTIVE);
}
if (ReadArgvChar("order",buffer,argc,argv)) np->order=ORDER_REAL_UP;
else
{
if (strcmp(buffer,"real_up")==0) np->order=ORDER_REAL_UP;
else if (strcmp(buffer,"real_down")==0) np->order=ORDER_REAL_DOWN;
else if (strcmp(buffer,"abs_up")==0) np->order=ORDER_ABS_UP;
else if (strcmp(buffer,"abs_down")==0) np->order=ORDER_ABS_DOWN;
else return(NP_ACTIVE);
}
return(NP_EXECUTABLE);
}
int NS_DIM_PREFIX BalanceGridRCB (MULTIGRID *theMG, int level)
{
HEAP *theHeap = theMG->theHeap;
GRID *theGrid = GRID_ON_LEVEL(theMG,level); /* balance grid of level */
LB_INFO *lbinfo;
ELEMENT *e;
int i, son;
INT MarkKey;
/* distributed grids cannot be redistributed by this function */
if (me!=master && FIRSTELEMENT(theGrid) != NULL)
{
printf("Error: Redistributing distributed grids using recursive coordinate bisection is not implemented!\n");
return (1);
}
if (me==master)
{
if (NT(theGrid) == 0)
{
UserWriteF("WARNING in BalanceGridRCB: no elements in grid\n");
return (1);
}
Mark(theHeap,FROM_TOP,&MarkKey);
lbinfo = (LB_INFO *)
GetMemUsingKey(theHeap, NT(theGrid)*sizeof(LB_INFO), FROM_TOP, MarkKey);
if (lbinfo==NULL)
{
Release(theHeap,FROM_TOP,MarkKey);
UserWrite("ERROR in BalanceGridRCB: could not allocate memory from the MGHeap\n");
return (1);
}
/* construct LB_INFO list */
for (i=0, e=FIRSTELEMENT(theGrid); e!=NULL; i++, e=SUCCE(e))
{
lbinfo[i].elem = e;
CenterOfMass(e, lbinfo[i].center);
}
/* apply coordinate bisection strategy */
theRCB(lbinfo, NT(theGrid), 0, 0, DimX, DimY, 0);
IFDEBUG(dddif,1)
for (e=FIRSTELEMENT(theGrid); e!=NULL; e=SUCCE(e))
{
UserWriteF("elem %08x has dest=%d\n",
DDD_InfoGlobalId(PARHDRE(e)), PARTITION(e));
}
ENDDEBUG
for (i=0, e=FIRSTELEMENT(theGrid); e!=NULL; i++, e=SUCCE(e))
{
InheritPartition (e);
}
Release(theHeap,FROM_TOP,MarkKey);
}
return 0;
}
static INT NewtonSolver (NP_NL_SOLVER *nls, INT level, VECDATA_DESC *x,
NP_NL_ASSEMBLE *ass, VEC_SCALAR abslimit, VEC_SCALAR reduction,
NLRESULT *res)
{
NP_NEWTON *newton; /* object pointer */
MULTIGRID *mg; /* multigrid from base class */
INT r; /* iteration counter */
INT i,kk; /* some loop counters */
char text[DISPLAY_WIDTH+4]; /* display text in PCR */
INT PrintID; /* print id for PCR */
VEC_SCALAR defect, defect2reach; /* component--wise norm */
VEC_SCALAR defectmax; /* max defect without codivergence */
INT n_unk; /* number of components in solution */
DOUBLE s,sold,sprime,s2reach,sred; /* combined defect norm */
INT reassemble=1; /* adaptive computation of jacobian */
VEC_SCALAR linred; /* parameters for linear solver */
DOUBLE red_factor[MAX_VEC_COMP]; /* convergence factor for linear iter */
DOUBLE la; /* damping factor in line search */
DOUBLE rho[MAX_LINE_SEARCH+1]; /* reduction factors of linesearch */
DOUBLE rhomin; /* best reduction if !accept */
INT best_ls; /* best ls if !accept */
INT accept; /* line search accepted */
INT bl; /* baselevel returned by preprocess */
INT error; /* for return value */
LRESULT lr; /* result of linear solver */
DOUBLE lambda_old; /* last accepted lamda */
DOUBLE lambda_min; /* minimal lamda */
INT use_second;
/* get status */
newton = (NP_NEWTON *) nls; /* cast from abstract base class to final class*/
mg = nls->base.mg;
UG_math_error = 0;
/* fill result variable with error condition */
res->error_code = 0;
res->converged = 0;
res->rho_first = 0.0;
res->number_of_nonlinear_iterations = 0;
res->number_of_line_searches = 0;
res->total_linear_iterations = 0;
res->max_linear_iterations = 0;
res->exec_time = 0.0;
/* initialize timers and counters */
defect_c = newton_c = linear_c = 0;
defect_t = newton_t = linear_t = 0.0;
if (newton->lineSearch == 3) {
lambda_min = lambda_old = 1.0;
for (kk=1; kk<=newton->maxLineSearch; kk++)
lambda_min = LINE_SEARCH_REDUCTION * lambda_min;
}
/* check function pointers in numprocs */
if (ass->NLAssembleSolution==NULL)
{
UserWrite("Newton: ass->NLAssembleSolution not defined\n");
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
if (ass->NLAssembleDefect==NULL)
{
UserWrite("Newton: ass->NLAssembleDefect not defined\n");
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
if (ass->NLAssembleMatrix==NULL)
{
UserWrite("Newton: ass->NLAssembleMatrix not defined\n");
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
/* dynamic XDATA_DESC allocation */
if (ass->A == NULL)
ass->A = newton->J;
if (AllocVDFromVD(mg,0,level,x, &(newton->v)))
{res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
if (AllocVDFromVD(mg,0,level,x, &(newton->d)))
{res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
if (newton->lineSearch == 3) {
if (AllocVDFromVD(mg,0,level,x, &(newton->dold)))
{res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
if (AllocVDFromVD(mg,0,level,x, &(newton->dsave)))
{res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
}
/* get number of components */
n_unk = VD_NCOMP(x);
/* init ass once and compute nonlinear defect */
if (NonLinearDefect(mg,level,TRUE,x,newton,ass,defect,&error)!=0)
{
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
if (error)
goto exit;
/* display norm of nonlinear defect */
CenterInPattern(text,DISPLAY_WIDTH,ENVITEM_NAME(newton),'#',"\n");
if (PreparePCR(newton->d,newton->displayMode,text,&PrintID)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
if (sc_mul(defect2reach,defect,reduction,newton->d)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
if (sc_mul(defectmax,defect,newton->divFactor,newton->d)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
use_second=0; for (i=0; i<n_unk; i++) if (defectmax[i]==0.0) use_second=1;
if (DoPCR(PrintID,defect,PCR_CRATE)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
for (i=0; i<n_unk; i++) res->first_defect[i] = defect[i];
/* compute single norm */
s = 0.0;
for (i=0; i<n_unk; i++)
s += newton->scale[i]*newton->scale[i]*defect[i]*defect[i];
s = sqrt(s);
sprime = s;
sold = s * sqrt(2.0);
sred = 1.0E10; for (i=0; i<n_unk; i++) sred = MIN(sred,reduction[i]);
s2reach = s*sred;
if (newton->lineSearch)
if (newton->displayMode == PCR_FULL_DISPLAY)
UserWriteF(" ++ s=%12.4E Initial nonlinear residual\n",s);
/* check if iteration is necessary */
if (sc_cmp(defect,abslimit,newton->d) && !newton->force_iteration) {
res->converged = 1;
for (i=0; i<n_unk; i++) res->last_defect[i] = defect[i];
res->error_code = 0;
goto exit;
}
/* initialize reduction factor for linear solver */
for (i=0; i<n_unk; i++) red_factor[i] = newton->linMinRed[i];
reassemble = 1;
/* do newton iterations */
for (r=1; r<=newton->maxit; r++)
{
if (UG_math_error) {
UserWrite("math error before newton loop !\n");
UG_math_error = 0;
res->error_code = __LINE__;
break;
}
if (res->converged && newton->force_iteration!=2) break; /* solution already found */
/* compute jacobian */
CSTART();
dset(mg,0,level,ALL_VECTORS,newton->v,0.0);
if (reassemble)
{
if ((*ass->NLAssembleMatrix)(ass,0,level,x,newton->d,newton->v,newton->J,&error)) {
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
reassemble = 0;
}
CSTOP(newton_t,newton_c);
if (UG_math_error) {
UserWrite("math error in NLAssembleMatrix !\n");
UG_math_error = 0;
res->error_code = __LINE__;
break;
}
/* solve linear system */
CSTART();
for (i=0; i<n_unk; i++) linred[i] = red_factor[i];bl = 0;
if (newton->solve->PreProcess!=NULL)
if ((*newton->solve->PreProcess)(newton->solve,level,newton->v,newton->d,newton->J,&bl,&error)) {
UserWriteF("NewtonSolver: solve->PreProcess failed, error code %d\n",error);
res->error_code = __LINE__;
#ifndef ModelP
REP_ERR_RETURN (res->error_code);
#endif
REP_ERR_INC;
#ifndef Debug
return (res->error_code);
#endif
}
if ((*newton->solve->Residuum)(newton->solve,0,level,newton->v,newton->d,newton->J,&lr))
{
res->error_code = __LINE__;
goto exit;
}
if ((*newton->solve->Solver)(newton->solve,level,newton->v,newton->d,newton->J,newton->solve->abslimit,linred,&lr))
{
res->error_code = 0;
goto exit;
}
if (newton->solve->PostProcess!=NULL)
if ((*newton->solve->PostProcess)(newton->solve,level,newton->v,newton->d,newton->J,&error)) {
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
CSTOP(linear_t,linear_c);
if (UG_math_error) {
UG_math_error = 0;
res->error_code = __LINE__;
}
/* if linear solver did not converge, return here */
if (!lr.converged && newton->force_iteration!=2) {
UserWrite("\nLinear solver did not converge in Newton method\n");
if (newton->linearRate < 2) {
res->error_code = 0; /* no error but exit */
goto exit; /* or goto exit2 ??? */
}
}
IFDEBUG(np,3)
UserWrite("---- After linear solver\n");
ListVectorRange(mg,0,level,0,0,1000,FALSE,TRUE,~(INT)1,LV_MOD_DEFAULT);
ENDDEBUG
/* linear solver statistics */
res->total_linear_iterations += lr.number_of_linear_iterations;
res->max_linear_iterations = MAX(res->max_linear_iterations,lr.number_of_linear_iterations);
if (newton->lineSearch)
if (newton->displayMode == PCR_FULL_DISPLAY)
UserWriteF(" ++ newton step %3d\n",r);
/* save current solution for line search */
if (AllocVDFromVD(mg,0,level,x, &(newton->s)))
{res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
dcopy(mg,0,level,ALL_VECTORS,newton->s,x);
/* do a line search */
la = newton->lambda; accept=0;
for (kk=1; kk<=newton->maxLineSearch; kk++) {
/* update solution */
dcopy(mg,0,level,ALL_VECTORS,x,newton->s);
daxpy(mg,0,level,ALL_VECTORS,x,-la,newton->v);
if (newton->maxit==r && newton->noLastDef) {
res->error_code = 0;
if (FreeVD(mg,0,level,newton->s)) REP_ERR_RETURN(1);
goto exit2;
}
/* if linear problem: use result of linear solver ! */
if (newton->linearMode)
{
for (i=0; i<n_unk; i++) defect[i] = lr.last_defect[i];
error = 0;
}
else
if (NonLinearDefect(mg,level,FALSE,x,newton,ass,defect,&error)!=0)
{
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
if (error)
goto exit;
/* compute single norm */
sold = sprime;
sprime = 0.0;
for (i=0; i<n_unk; i++)
sprime += newton->scale[i]*newton->scale[i]*defect[i]*defect[i];
sprime = sqrt(sprime);
rho[kk] = sprime/s;
/* print results */
if (newton->lineSearch)
if (newton->displayMode == PCR_FULL_DISPLAY)
UserWriteF(" ++ ls=%2d, s=%12.4E, rho=%8.4g, lambda= %8.4g\n",
kk,sprime,rho[kk],la);
if (sprime/s<=1-0.25*fabs(la) || !newton->lineSearch) {
lambda_old = la;
accept=1;
break;
}
/* else reduce lambda */
la = LINE_SEARCH_REDUCTION*la;
}
/* if not accepted */
if (!accept)
switch (newton->lineSearch)
{
case 1 :
/* break iteration */
UserWrite("line search not accepted, Newton diverged\n");
res->error_code = 0;
if (FreeVD(mg,0,level,newton->s)) REP_ERR_RETURN(1);
goto exit;
case 2 :
/* accept best result */
best_ls = 1;
rhomin = rho[best_ls];
for (kk=2; kk<=newton->maxLineSearch; kk++)
if (rhomin>rho[kk]) {
rhomin = rho[kk];
best_ls = kk;
}
UserWriteF(" ++ accepting linesearch %d\n",best_ls);
/* set lambda factor */
la = newton->lambda * pow(LINE_SEARCH_REDUCTION,best_ls-1);
lambda_old = la;
/* update solution */
dcopy(mg,0,level,ALL_VECTORS,x,newton->s);
daxpy(mg,0,level,ALL_VECTORS,x,-la,newton->v);
if (NonLinearDefect(mg,level,FALSE,x,newton,ass, defect,&error)!=0)
{
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
if (error)
goto exit;
break;
/*default: accept */
}
if (FreeVD(mg,0,level,newton->s)) REP_ERR_RETURN(1);
/* print norm of defect */
if (DoPCR(PrintID,defect,PCR_CRATE)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
/* save convergence of first step, may be used to increase stepsize */
if (r==1) res->rho_first = sprime/s;
/* reassemble if nonlinear convergence bad */
if (sprime/s >= newton->rhoReass) reassemble = 1;
if (!newton->linearRate) reassemble = 1;
/* check convergence of nonlinear iteration */
if (newton->force_iteration!=2)
{
if (sprime<s2reach) {res->converged=1; break;}
if (sc_cmp(defect,abslimit,newton->d)) {res->converged=1; break;}
if (sc_cmp(defect,defect2reach,newton->d)) {res->converged=1; break;}
}
else
if (r==newton->maxit) {res->converged=1; break;}
if (use_second)
{
use_second=0;
if (sc_mul(defectmax,defect,newton->divFactor,newton->d))
{
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
} /*
else
{
if (!sc_cmp(defect,defectmax,newton->d)) break;
}
*/
/* compute new reduction factor, assuming quadratic convergence */
for (i=0; i<n_unk; i++)
{
red_factor[i] = MIN((sprime/s)*(sprime/s),newton->linMinRed[i]);
if (newton->linearRate == 1)
red_factor[i] = MIN(sprime/s,newton->linMinRed[i]);
if (newton->linearRate == 2)
red_factor[i] = newton->linMinRed[i];
}
/* accept new iterate */
sold = s;
s = sprime;
}
/* print norm of defect */
if (DoPCR(PrintID,defect,PCR_AVERAGE)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
/* report results and mean execution times */
res->error_code = 0;
res->number_of_nonlinear_iterations = newton_c;
res->number_of_line_searches = defect_c;
for (i=0; i<n_unk; i++) res->last_defect[i] = defect[i];
if (!res->converged) UserWriteF("NL SOLVER: desired convergence not reached\n");
exit2:
UserWriteF("AVG EXEC TIMES: DEF[%2d]=%10.4g JAC[%2d]=%10.4g LIN[%2d]=%10.4g\n",
defect_c,defect_t/defect_c,newton_c,newton_t/newton_c,linear_c,linear_t/linear_c);
res->exec_time = defect_t+newton_t+linear_t;
/* postprocess assemble once at the end */
if (ass->PostProcess!=NULL)
if ((*ass->PostProcess)(ass,0,level,x,newton->d,newton->J,&error)) {
res->error_code = __LINE__;
REP_ERR_RETURN(res->error_code);
}
exit:
if (PostPCR(PrintID,NULL)) {res->error_code = __LINE__; REP_ERR_RETURN(res->error_code);}
/* deallocate local XDATA_DESCs */
if (FreeVD(mg,0,level,newton->d)) REP_ERR_RETURN(1);
if (FreeVD(mg,0,level,newton->v)) REP_ERR_RETURN(1);
if (newton->lineSearch == 3) {
if (FreeVD(mg,0,level,newton->dold)) REP_ERR_RETURN(1);
if (FreeVD(mg,0,level,newton->dsave)) REP_ERR_RETURN(1);
}
if (res->error_code==0)
return (0);
else
REP_ERR_RETURN (res->error_code);
}
static INT EWNSolver (NP_EW_SOLVER *theNP, INT level, INT New, VECDATA_DESC **ev, DOUBLE *ew, NP_NL_ASSEMBLE *Assemble, VEC_SCALAR abslimit, VEC_SCALAR reduction, EWRESULT *ewresult)
{
NP_EWN *np = (NP_EWN *) theNP;
MULTIGRID *theMG = theNP->base.mg;
INT i,j,iter,done,result,DoLS;
char text[DISPLAY_WIDTH+4],format2[64],format3[64],formatr1[64],formatr2[64],formats[64];
DOUBLE shift,shift_old,cnorm[MAX_NUMBER_EW],norm_x1x2,norm_yx2,norm_yx1,delta;
DOUBLE A[MAX_NUMBER_EW][MAX_NUMBER_EW];
DOUBLE B[MAX_NUMBER_EW][MAX_NUMBER_EW];
DOUBLE E[MAX_NUMBER_EW][MAX_NUMBER_EW];
DOUBLE ew_re[MAX_NUMBER_EW],ew_im[MAX_NUMBER_EW];
DOUBLE ew_re_out,ew_im_out;
DOUBLE tmp_re[MAX_NUMBER_EW],tmp_im[MAX_NUMBER_EW];
DOUBLE old_re[MAX_NUMBER_EW],old_im[MAX_NUMBER_EW],norm;
DOUBLE* table[MAX_NUMBER_EW];
INT index[MAX_NUMBER_EW];
INT bl = 0;
ewresult->error_code = 0;
CenterInPattern(text,DISPLAY_WIDTH,ENVITEM_NAME(np),'§',"\n"); UserWrite(text);
sprintf(text,"%d.%d",np->c_d+1,np->c_d-1);
strcpy(formats," %-3d S: % "); strcat(formats,text); strcat(formats,"e\n");
strcpy(format2," %3d: (% "); strcat(format2,text); strcat(format2,"e, % "); strcat(format2,text); strcat(format2,"e)");
strcpy(format3," %3d: [% "); strcat(format3,text); strcat(format3,"e, % "); strcat(format3,text); strcat(format3,"e]");
strcpy(formatr1," %-3d res: %3d: (% "); strcat(formatr1,text); strcat(formatr1,"e, % "); strcat(formatr1,text); strcat(formatr1,"e)\n");
strcpy(formatr2," %3d: (% "); strcat(formatr2,text); strcat(formatr2,"e, % "); strcat(formatr2,text); strcat(formatr2,"e)\n");
shift=np->shift_min; DoLS=0; shift_old=shift-1;
for (iter=0; iter<np->maxiter; iter++)
{
/* preprocess if */
if (iter==0 || DoLS)
{
if (dmatcopy(theNP->base.mg,bl,level,ALL_VECTORS,np->M,np->N)) return(1);
if (dcopy(theNP->base.mg,bl,level,ALL_VECTORS,np->t,np->E)) return(1);
if (dscal(theNP->base.mg,bl,level,ALL_VECTORS,np->t,-shift)) return(1);
if (dmassadd(theNP->base.mg,bl,level,ALL_VECTORS,np->M,np->t,np->type)) return(1);
if (np->LS->PreProcess != NULL) if ((*np->LS->PreProcess)(np->LS,level,ev[0],np->r,np->M, &np->baselevel,&result)) return(1);
}
for (i=0; i<New; i++)
{
if (np->conv_mode==1)
if (dcopy(theMG,bl,level,ALL_VECTORS,np->s[i],ev[i])) NP_RETURN(1,ewresult->error_code);
if (dcopy(theMG,bl,level,ALL_VECTORS,np->t,ev[i])) NP_RETURN(1,ewresult->error_code);
if (dmassdot(theMG,bl,level,ALL_VECTORS,np->t,np->E,np->type)) NP_RETURN(1,ewresult->error_code);
if (np->LS->Defect!=NULL) if ((*np->LS->Defect)(np->LS,level,ev[i],np->t,np->M, &ewresult->error_code)) NP_RETURN(1,ewresult->error_code);
if (np->LS->Residuum!=NULL) if ((*np->LS->Residuum)(np->LS,0,level,ev[i],np->t,np->M, &ewresult->lresult[i])) NP_RETURN(1,ewresult->error_code);
if ((*np->LS->Solver)(np->LS,level,ev[i],np->t,np->M, abslimit,reduction, &ewresult->lresult[i])) NP_RETURN(1,ewresult->error_code);
if (np->Project != NULL) if (np->Project->Project(np->Project,bl,level, ev[i],&ewresult->error_code) != NUM_OK) NP_RETURN(1,ewresult->error_code);
}
for (i=0; i<New; i++)
{
if (ddot(theMG,0,level,ON_SURFACE,ev[i],ev[i],&B[i][i])) NP_RETURN(1,ewresult->error_code);
if (dscal(theMG,0,level,ALL_VECTORS,ev[i],1/sqrt(B[i][i])) != NUM_OK) NP_RETURN(1,ewresult->error_code);
}
for (i=0; i<New; i++)
{
if (dmatmul (theMG,0,level,ON_SURFACE,np->t,np->M,ev[i]) != NUM_OK) NP_RETURN(1,ewresult->error_code);
for (j=0; j<New; j++)
if (ddotw(theMG,0,level,ON_SURFACE,np->t,ev[j],np->weight,&A[i][j])) NP_RETURN(1,ewresult->error_code);
}
for (i=0; i<New; i++)
{
if (dcopy(theMG,bl,level,ALL_VECTORS,np->t,ev[i])) NP_RETURN(1,ewresult->error_code);
if (dmassdot(theMG,bl,level,ALL_VECTORS,np->t,np->E,np->type)) NP_RETURN(1,ewresult->error_code);
for (j=0; j<New; j++)
if (ddotw(theMG,0,level,ON_SURFACE,np->t,ev[j],np->weight,&B[i][j])) NP_RETURN(1,ewresult->error_code);
}
/* Special Eigenvalue problem G E_i = lambda E_i */
SmallEWNSolver_Sci(New,A,B,ew_re,ew_im,E);
IFDEBUG(np,1)
UserWriteF("A\n"); for (i=0; i<New; i++) { for (j=0; j<New; j++) UserWriteF("%8.4f\t",A[i][j]);UserWriteF("\n"); }
UserWriteF("B\n"); for (i=0; i<New; i++) { for (j=0; j<New; j++) UserWriteF("%8.4f\t",B[i][j]);UserWriteF("\n"); }
UserWriteF("E\n"); for (i=0; i<New; i++) { for (j=0; j<New; j++) UserWriteF("%8.4f\t",E[i][j]);UserWriteF("\n"); }
ENDDEBUG
for (i=0; i<New; i++)
if (AllocVDFromVD(theMG,bl,level,ev[0],&np->e[i])) NP_RETURN(1,ewresult->error_code);
for (i=0; i<New; i++)
{
if (dset(theMG,bl,level,ALL_VECTORS,np->e[i],0.0)) NP_RETURN(1,ewresult->error_code);
for (j=0; j<New; j++)
if (daxpy(theMG,bl,level,ALL_VECTORS,np->e[i],E[j][i],ev[j]) != NUM_OK) NP_RETURN(1,ewresult->error_code);
ddotw(theMG,bl,level,ON_SURFACE,np->e[i],np->e[i],np->weight,&norm); norm=sqrt(norm);
dscal(theMG,bl,level,ALL_VECTORS,np->e[i],1.0/norm);
}
/* sort eigen-values/vectors */
for (i=0; i<New; i++)
{
tmp_re[i]=ew_re[i]; tmp_im[i]=ew_im[i];
switch (np->order)
{
case ORDER_REAL_UP :
ew[i]=ew_re[i];
break;
case ORDER_REAL_DOWN :
ew[i]=-ew_re[i];
break;
case ORDER_ABS_UP :
ew[i]=ew_re[i]*ew_re[i]+ew_im[i]*ew_im[i];
break;
case ORDER_ABS_DOWN :
ew[i]=-ew_re[i]*ew_re[i]-ew_im[i]*ew_im[i];
break;
}
table[i] = &ew[i];
}
qsort(table, New, sizeof(*table),(int (*)(const void *, const void *))EWCompare);
for (i=0; i<New; i++)
for (j=0; j<New; j++)
if (table[i]==&ew[j])
index[i] = j;
for (i=0; i<New; i++)
{
if (dcopy(theMG,bl,level,ALL_VECTORS,ev[i],np->e[index[i]])) NP_RETURN(1,ewresult->error_code);
ew_re[i]=tmp_re[index[i]]; ew_im[i]=tmp_im[index[i]];
}
/* shift back eigenvalues */
for (i=0; i<np->ew.nev; i++) ew_re[i]+=shift;
/* check convergence */
if (iter>0)
{
done=1;
if (np->conv_mode==0)
{
/* convergence according to eigenvalues */
for (i=0; i<np->c_n; i++)
{
if (Round(ew_re[i],np->c_d)!=Round(old_re[i],np->c_d)) done=0;
if (Round(ABS(ew_im[i]),np->c_d)!=Round(ABS(old_im[i]),np->c_d)) done=0;
}
}
else
{
/* convergence according to eigenvectors */
for (i=0; i<New; i++)
if (ew_im[i]==0.0)
{
ddotw(theMG,bl,level,ON_SURFACE,np->s[i],np->e[index[i]],np->weight,&norm);
cnorm[i]=1-ABS(norm);
if (cnorm[i]>pow(0.1,np->c_d) && i<np->c_n) done=0;
}
else
{
ddotw(theMG,bl,level,ON_SURFACE,np->s[i],np->s[i+1],np->weight,&norm_x1x2);
ddotw(theMG,bl,level,ON_SURFACE,np->s[i],np->e[index[i]],np->weight,&norm_yx1);
ddotw(theMG,bl,level,ON_SURFACE,np->s[i+1],np->e[index[i]],np->weight,&norm_yx2);
norm=(norm_yx1*norm_yx1+norm_yx2*norm_yx2-2.0*norm_x1x2*norm_yx1*norm_yx2)/(1.0-norm_x1x2*norm_x1x2);
cnorm[i]=1-ABS(norm);
if (cnorm[i]>pow(0.1,np->c_d) && i<np->c_n) done=0;
ddotw(theMG,bl,level,ON_SURFACE,np->s[i],np->e[index[i+1]],np->weight,&norm_yx1);
ddotw(theMG,bl,level,ON_SURFACE,np->s[i+1],np->e[index[i+1]],np->weight,&norm_yx2);
i++;
norm=(norm_yx1*norm_yx1+norm_yx2*norm_yx2-2.0*norm_x1x2*norm_yx1*norm_yx2)/(1.0-norm_x1x2*norm_x1x2);
cnorm[i]=1-ABS(norm);
if (cnorm[i]>pow(0.1,np->c_d) && i<np->c_n) done=0;
}
}
}
else
done=0;
for (i=0; i<New; i++)
{
old_re[i]=ew_re[i];
old_im[i]=ew_im[i];
}
/* display */
if (np->display > PCR_NO_DISPLAY)
{
UserWriteF(formats,iter,shift*np->scale);
if (np->conv_mode==0)
{
/* conv_mode val */
for (i=0; i<np->ew.nev; i++)
{
ew_re_out=np->scale*ew_re[i];
ew_im_out=np->scale*ew_im[i];
if (i<np->c_n) { UserWriteF(format2,(int)i,ew_re_out,ew_im_out); UserWriteF("\n"); }
else { UserWriteF(format3,(int)i,ew_re_out,ew_im_out); UserWriteF("\n"); }
}
UserWriteF("\n");
}
else
{
/* conv_mode vec */
for (i=0; i<np->ew.nev; i++)
{
ew_re_out=np->scale*ew_re[i];
ew_im_out=np->scale*ew_im[i];
if (i<np->c_n) { UserWriteF(format2,(int)i,ew_re_out,ew_im_out); UserWriteF(" (%8.6e)\n",cnorm[i]); }
else { UserWriteF(format3,(int)i,ew_re_out,ew_im_out); UserWriteF(" [%8.6e]\n",cnorm[i]); }
}
UserWriteF("\n");
}
}
/* free VEC_DATADESC's */
for (i=0; i<New; i++)
if (FreeVD(theMG,bl,level,np->e[i])) NP_RETURN(1,ewresult->error_code);
/* convergence of smallest */
UserWriteF("convergence of smallest\n");
UserWriteF("-----------------------\n");
delta=0.0; for (i=0; i<New; i++) delta=MAX(delta,(ew_re[i]-shift)*(ew_re[i]-shift)+ew_im[i]*ew_im[i]);
delta=((ew_re[0]-shift)*(ew_re[0]-shift)+ew_im[0]*ew_im[0])/delta; delta=sqrt(delta);
UserWriteF("gamma: %e\n\n",delta);
/* calculate shift */
delta=0.0; for (i=0; i<New; i++) delta=MAX(delta,ABS(ew_im[i]));delta=MAX(delta,np->imag_max);
shift=ew_re[0]+delta*delta/(ew_re[0]-ew_re[New-1]);
delta=0.0; for (i=0; i<New; i++) { delta=ew_re[0]-ew_re[i]; if (delta!=0.0) break;}
shift=MIN(shift,ew_re[0]+0.5*delta);
shift=MAX(shift,np->shift_min);
shift=MIN(shift,np->shift_max);
DoLS=0; if (shift!=shift_old) DoLS=1;shift_old=shift;
/* postprocess if */
if (done || iter==np->maxiter-1 || DoLS)
{
if (np->LS->PostProcess!=NULL)
if ((*np->LS->PostProcess)(np->LS,level,ev[0],np->r,np->M,&result)) return(1);
}
/* done? */
if (done) break;
}
/* print result */
for (i=0; i<np->c_n; i++)
{
ew_re_out=np->scale*ew_re[i];
ew_im_out=np->scale*ew_im[i];
if (i==0)
UserWriteF(formatr1,(int)iter,(int)i,ew_re_out,ew_im_out);
else
UserWriteF(formatr2,(int)i,ew_re_out,ew_im_out);
}
UserWriteF("\n");
return (0);
}
FORMAT * NS_DIM_PREFIX CreateFormat (char *name, INT sVertex, INT sMultiGrid,
ConversionProcPtr PrintVertex, ConversionProcPtr PrintGrid,
ConversionProcPtr PrintMultigrid,
TaggedConversionProcPtr PrintVector, TaggedConversionProcPtr PrintMatrix,
INT nvDesc, VectorDescriptor *vDesc, INT nmDesc, MatrixDescriptor *mDesc,
SHORT ImatTypes[], INT po2t[MAXDOMPARTS][MAXVOBJECTS],
INT nodeelementlist, INT edata, INT ndata)
{
FORMAT *fmt;
INT i, j, type, type2, part, obj, MaxDepth, NeighborhoodDepth, MaxType;
/* change to /Formats directory */
if (ChangeEnvDir("/Formats")==NULL)
REP_ERR_RETURN_PTR (NULL);
/* allocate new format structure */
fmt = (FORMAT *) MakeEnvItem (name,theFormatDirID,sizeof(FORMAT));
if (fmt==NULL) REP_ERR_RETURN_PTR(NULL);
/* fill in data */
FMT_S_VERTEX(fmt) = sVertex;
FMT_S_MG(fmt) = sMultiGrid;
FMT_PR_VERTEX(fmt) = PrintVertex;
FMT_PR_GRID(fmt) = PrintGrid;
FMT_PR_MG(fmt) = PrintMultigrid;
FMT_PR_VEC(fmt) = PrintVector;
FMT_PR_MAT(fmt) = PrintMatrix;
FMT_NODE_ELEM_LIST(fmt) = nodeelementlist;
FMT_ELEM_DATA(fmt) = edata;
FMT_NODE_DATA(fmt) = ndata;
/* initialize with zero */
for (i=0; i<MAXVECTORS; i++)
{
FMT_S_VEC_TP(fmt,i) = 0;
}
for (i=0; i<MAXCONNECTIONS; i++)
{
FMT_S_MAT_TP(fmt,i) = 0;
FMT_CONN_DEPTH_TP(fmt,i) = 0;
}
for (i=FROM_VTNAME; i<=TO_VTNAME; i++)
FMT_SET_N2T(fmt,i,NOVTYPE);
MaxDepth = NeighborhoodDepth = 0;
/* set vector stuff */
for (i=0; i<nvDesc; i++)
{
if ((vDesc[i].tp<0)||(vDesc[i].tp>=MAXVECTORS)||(vDesc[i].size<0)) REP_ERR_RETURN_PTR(NULL);
FMT_S_VEC_TP(fmt,vDesc[i].tp) = vDesc[i].size;
if ((vDesc[i].name<FROM_VTNAME) || (TO_VTNAME<vDesc[i].name))
{
PrintErrorMessageF('E',"CreateFormat","type name '%c' out of range (%c-%c)",vDesc[i].name,FROM_VTNAME,TO_VTNAME);
REP_ERR_RETURN_PTR (NULL);
}
FMT_VTYPE_NAME(fmt,vDesc[i].tp) = vDesc[i].name;
FMT_SET_N2T(fmt,vDesc[i].name,vDesc[i].tp);
FMT_T2N(fmt,vDesc[i].tp) = vDesc[i].name;
}
/* copy part,obj to type table and derive t2p, t2o lists */
for (type=0; type<MAXVECTORS; type++)
FMT_T2P(fmt,type) = FMT_T2O(fmt,type) = 0;
for (part=0; part<MAXDOMPARTS; part++)
for (obj=0; obj<MAXVOBJECTS; obj++)
{
type = FMT_PO2T(fmt,part,obj) = po2t[part][obj];
FMT_T2P(fmt,type) |= (1<<part);
FMT_T2O(fmt,type) |= (1<<obj);
}
#ifdef __INTERPOLATION_MATRIX__
for (i=0; i<MAXMATRICES; i++)
FMT_S_IMAT_TP(fmt,i) = 0;
#endif
/* set connection stuff */
for (i=0; i<nmDesc; i++)
{
if ((mDesc[i].from<0)||(mDesc[i].from>=MAXVECTORS)) REP_ERR_RETURN_PTR(NULL);
if ((mDesc[i].to<0) ||(mDesc[i].to>=MAXVECTORS)) REP_ERR_RETURN_PTR(NULL);
if (mDesc[i].diag<0) REP_ERR_RETURN_PTR(NULL);
if ((mDesc[i].size<0)||(mDesc[i].depth<0)) REP_ERR_RETURN_PTR(NULL);
if (FMT_S_VEC_TP(fmt,mDesc[i].from)<=0) REP_ERR_RETURN_PTR(NULL);
if (FMT_S_VEC_TP(fmt,mDesc[i].to)<=0) REP_ERR_RETURN_PTR(NULL);
if (mDesc[i].size>0 && mDesc[i].depth>=0)
{
if (mDesc[i].from==mDesc[i].to)
{
/* set data (ensuring that size(diag) >= size(off-diag) */
if (mDesc[i].diag)
{
type=DIAGMATRIXTYPE(mDesc[i].from);
type2=MATRIXTYPE(mDesc[i].from,mDesc[i].from);
if (mDesc[i].size>=FMT_S_MAT_TP(fmt,type2))
FMT_S_MAT_TP(fmt,type) = mDesc[i].size;
else
FMT_S_MAT_TP(fmt,type) = FMT_S_MAT_TP(fmt,type2);
}
else
{
type=MATRIXTYPE(mDesc[i].from,mDesc[i].from);
FMT_S_MAT_TP(fmt,type) = mDesc[i].size;
type2=DIAGMATRIXTYPE(mDesc[i].from);
if (mDesc[i].size>=FMT_S_MAT_TP(fmt,type2))
FMT_S_MAT_TP(fmt,type2) = mDesc[i].size;
}
}
else
{
/* set data (ensuring size symmetry, which is needed at the moment) */
type=MATRIXTYPE(mDesc[i].from,mDesc[i].to);
FMT_S_MAT_TP(fmt,type) = mDesc[i].size;
type2 = MATRIXTYPE(mDesc[i].to,mDesc[i].from);
if (mDesc[i].size>FMT_S_MAT_TP(fmt,type2))
FMT_S_MAT_TP(fmt,type2) = mDesc[i].size;
}
}
/* set connection depth information */
FMT_CONN_DEPTH_TP(fmt,type) = mDesc[i].depth;
MaxDepth = MAX(MaxDepth,mDesc[i].depth);
if ((FMT_TYPE_USES_OBJ(fmt,mDesc[i].from,ELEMVEC))&&(FMT_TYPE_USES_OBJ(fmt,mDesc[i].to,ELEMVEC)))
NeighborhoodDepth = MAX(NeighborhoodDepth,mDesc[i].depth);
else
NeighborhoodDepth = MAX(NeighborhoodDepth,mDesc[i].depth+1);
}
FMT_CONN_DEPTH_MAX(fmt) = MaxDepth;
FMT_NB_DEPTH(fmt) = NeighborhoodDepth;
#ifdef __INTERPOLATION_MATRIX__
for (i=0; i<MAXVECTORS; i++)
for (j=0; j<MAXVECTORS; j++)
FMT_S_IMAT_TP(fmt,MATRIXTYPE(i,j)) = ImatTypes[i] * ImatTypes[j] * sizeof(DOUBLE);
#endif
/* derive additional information */
for (i=0; i<MAXVOBJECTS; i++) FMT_USES_OBJ(fmt,i) = FALSE;
FMT_MAX_PART(fmt) = 0;
MaxType = 0;
for (i=0; i<MAXDOMPARTS; i++)
for (j=0; j<MAXVOBJECTS; j++)
if (po2t[i][j]!=NOVTYPE)
{
FMT_USES_OBJ(fmt,j) = TRUE;
FMT_MAX_PART(fmt) = MAX(FMT_MAX_PART(fmt),i);
MaxType = MAX(MaxType,po2t[i][j]);
}
FMT_MAX_TYPE(fmt) = MaxType;
if (ChangeEnvDir(name)==NULL) REP_ERR_RETURN_PTR(NULL);
UserWrite("format "); UserWrite(name); UserWrite(" installed\n");
return(fmt);
}
static INT AMGSolverPreProcess (NP_LINEAR_SOLVER *theNP, INT level,
VECDATA_DESC *VD_x, VECDATA_DESC *VD_b,
MATDATA_DESC *MD_A,
INT *baselevel, INT *result)
{
MULTIGRID *theMG;
GRID *theGrid;
int n,nonzeros,blocksize;
int Acomp;
MATRIX *theMatrix;
VECTOR *theVector;
int i,j,block_i,block_j;
int nRows_A,nCols_A,nComp_x,nComp_b;
NP_AMG *theAMGC;
double ti;
int ii;
#ifdef ModelP
double clock_start;
#else
clock_t clock_start;
#endif
theAMGC = (NP_AMG *) theNP;
/* prepare solving */
theMG = theAMGC->ls.base.mg;
theGrid = GRID_ON_LEVEL(theMG,level);
/* mark heap for use by amg */
#ifndef DYNAMIC_MEMORY_ALLOCMODEL
Mark(MGHEAP(theMG),FROM_BOTTOM,&amg_MarkKey);
#else
Mark(MGHEAP(theMG),FROM_TOP,&amg_MarkKey);
#endif
mark_counter++;
/* initialize sp package */
AMG_InstallPrintHandler((AMG_PrintFuncPtr)UserWrite);
amgMG=theMG; /* make it global for memory handler */
AMG_InstallMallocHandler((AMG_MallocFuncPtr)amgmalloc);
/* get access to components */
nRows_A = MD_ROWS_IN_RT_CT(MD_A,NODEVEC,NODEVEC);
nCols_A = MD_COLS_IN_RT_CT(MD_A,NODEVEC,NODEVEC);
nComp_x = VD_NCMPS_IN_TYPE(VD_x,NODEVEC);
nComp_b = VD_NCMPS_IN_TYPE(VD_b,NODEVEC);
blocksize = nComp_x;
if (blocksize==0) goto exit;
if (nComp_b!=blocksize) goto exit;
if (nCols_A!=blocksize) goto exit;
if (nRows_A!=blocksize) goto exit;
Acomp = MD_MCMP_OF_RT_CT(MD_A,NODEVEC,NODEVEC,0);
CSTART(); ti=0; ii=0;
/* diagonal scaling */
if (theAMGC->scale)
if (DiagonalScaleSystem(theGrid,MD_A,MD_A,VD_b)!=NUM_OK)
{
UserWrite("Error in scaling system\n");
goto exit;
}
/* gather some data for the matrix */
n = nonzeros = 0;
/* loop through all vectors, we assume there are only node vectors ! */
for (theVector=FIRSTVECTOR(theGrid); theVector!= NULL; theVector=SUCCVC(theVector))
{
VINDEX(theVector) = n++; /* renumber vectors just to be sure ... */
/* now speed through this row */
for (theMatrix=VSTART(theVector); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
nonzeros++;
}
#ifdef ModelP
if (me == master)
{
#endif
/* now allocate fine grid vectors x and b */
theAMGC->x = AMG_NewVector(n*blocksize,1,"x");
if (theAMGC->x==NULL) {
UserWrite("no memory for x\n");
goto exit;
}
theAMGC->b = AMG_NewVector(n*blocksize,1,"b");
if (theAMGC->b==NULL) {
UserWrite("no memory for b\n");
goto exit;
}
/* and a new matrix */
theAMGC->A = AMG_NewMatrix(n*blocksize,1,nonzeros*blocksize*blocksize,blocksize,"fine grid A");
if (theAMGC->A==NULL) {
UserWrite("no memory for A\n");
goto exit;
}
#ifdef ModelP
}
else
{
/* no master vectors allowed */
assert(n==0);
/* only master builds up coarse levels */
return (0);
}
#endif
/* now fill matrix */
for (theVector=FIRSTVECTOR(theGrid); theVector!= NULL; theVector=SUCCVC(theVector))
{
i = VINDEX(theVector);
/* count row length */
nonzeros=0;
for (theMatrix=VSTART(theVector); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
nonzeros++;
/* for each row */
for (block_i=0; block_i<blocksize; block_i++)
{
/* allocate row */
if (AMG_SetRowLength(theAMGC->A,i*blocksize+block_i,nonzeros*blocksize)!=AMG_OK)
{
UserWrite("Error in AMG_SetRowLength\n");
goto exit;
}
/* the diagonal block, be careful to allocate the main diagonal first */
theMatrix=VSTART(theVector);
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,i*blocksize+block_i,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_i)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
for (block_j=0; block_j<blocksize; block_j++)
{
if (block_j==block_i) continue;
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,i*blocksize+block_j,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_j)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
}
/* all the offdiagonal blocks */
for (theMatrix=MNEXT(VSTART(theVector)); theMatrix!=NULL; theMatrix = MNEXT(theMatrix))
{
j = VINDEX(MDEST(theMatrix));
for (block_j=0; block_j<blocksize; block_j++)
{
if (AMG_InsertValues(theAMGC->A,i*blocksize+block_i,j*blocksize+block_j,
&(MVALUE(theMatrix,Acomp+block_i*blocksize+block_j)))<0)
{
UserWrite("Error in AMG_InsertValues\n");
goto exit;
}
}
}
}
}
/*AMG_PrintMatrix(theAMGC->A,"Matrix");*/
/* call algebraic multigrid solver */
if (AMG_Build(&theAMGC->sc,&theAMGC->cc,theAMGC->A)!=AMG_OK) theAMGC->AMG_Build_failed=1;
theAMGC->AMG_Build_failed=0;
CSTOP(ti,ii);
if (theAMGC->sc.verbose>0)
UserWriteF("AMG : L=%2d BUILD=%10.4g\n",level,ti);
return(0); /* ok, matrix is set up */
exit: /* error */
if (mark_counter>0) {
#ifndef DYNAMIC_MEMORY_ALLOCMODEL
Release(MGHEAP(theMG),FROM_BOTTOM,amg_MarkKey);
#else
Release(MGHEAP(theMG),FROM_TOP,amg_MarkKey);
#endif
mark_counter--;
}
return(1);
}
/* domain interface function: for description see domain.h */
BVP* NS_DIM_PREFIX BVP_Init (const char *name, HEAP *Heap, MESH *Mesh, INT MarkKey)
{
LGM_DOMAIN *theDomain;
LGM_PROBLEM *theProblem;
BndCondProcPtr BndCond,InnerBndCond;
INT i,nSubDom,conf_df_problem;
char **argv;
if ((theDomain = (LGM_DOMAIN *)BVP_GetByName(name))==NULL)
{
if ((theDomain = LGM_LoadDomain(name,name,Heap,theLGMDomainVarID,MarkKey))==NULL)
{
UserWriteF("ERROR in BVP_Init: cannot load domain '%s'\n",name);
return (NULL);
}
/* set problem */
theProblem = Lgm_Problem_GetByName(LGM_DOMAIN_PROBLEMNAME(theDomain));
conf_df_problem = 0;
if (theProblem==NULL)
{
theProblem = Lgm_Problem_GetByName("configurable");
if (theProblem==NULL)
{
UserWrite("ERROR in BVP_Init: cannot find problem\n");
return (NULL);
}
conf_df_problem = 1;
}
LGM_DOMAIN_PROBLEM(theDomain) = theProblem;
/* initialize problem */
if (conf_df_problem)
{
INT maxLineId = 0;
if (theProblem->InitProblem==NULL) return (NULL);
nSubDom = LGM_DOMAIN_NSUBDOM(theDomain);
argv = (char **) GetTmpMem(Heap, sizeof(char *)*(nSubDom+1),MarkKey);
if (argv==NULL)
{
UserWrite("ERROR in BVP_Init: cannot allocate argv\n");
return (NULL);
}
for(i=1; i<=nSubDom; i++)
{
LGM_SUBDOMAIN *subdom = LGM_DOMAIN_SUBDOM(theDomain,i);
argv[i] = LGM_SUBDOMAIN_UNIT(subdom);
}
/* get maximum Line/Surface-Id */
maxLineId = GetMaximumSurfaceID(theDomain);
if ((*(theProblem->InitProblem))(nSubDom, argv, maxLineId+1, LGM_DOMAIN_PROBLEMNAME(theDomain), Heap))
{
UserWrite("ERROR in BVP_Init: cannot initialize problem\n");
return (NULL);
}
}
/* set boundary conditions */
BndCond = LGM_PROBLEM_BNDCOND(theProblem);
InnerBndCond = LGM_PROBLEM_INNERBNDCOND(theProblem);
if (SetBoundaryCondition(theDomain,BndCond,InnerBndCond)) return (NULL);
}
/* set bounding sphere */
if (SetDomainSize(theDomain)) return (NULL);
/* set mesh with nothing */
if (Mesh!=NULL && LGM_LoadMesh(name, Heap,Mesh,theDomain,MarkKey))
{
Mesh->mesh_status = MESHSTAT_EMPTY;
Mesh->nBndP = 0;
Mesh->nInnP = 0;
Mesh->nSubDomains = 0;
Mesh->nbElements = NULL;
Mesh->nElements = NULL;
Mesh->VertexLevel = NULL;
Mesh->VertexPrio = NULL;
Mesh->ElementLevel = NULL;
Mesh->ElementPrio = NULL;
Mesh->ElemSideOnBnd = NULL;
}
/* allocate s2p table */
LGM_DOMAIN_NPART(theDomain) = 1;
LGM_DOMAIN_S2P_PTR(theDomain) = (INT*)GetFreelistMemory(Heap,(LGM_DOMAIN_NSUBDOM(theDomain)+1)*sizeof(INT));
if (LGM_DOMAIN_S2P_PTR(theDomain)==NULL)
return (NULL);
/* HRR_TODO: fill number of parts */
for (i=0; i<=LGM_DOMAIN_NSUBDOM(theDomain); i++)
LGM_DOMAIN_S2P(theDomain,i) = 0;
theDomain->theHeap = Heap;
return ((BVP *)theDomain);
}
static INT TecplotCommand (INT argc, char **argv)
{
INT i,j,k,v; /* counters etc. */
INT counter; /* for formatting output */
char item[1024],it[256]; /* item buffers */
INT ic=0; /* item length */
VECTOR *vc; /* a vector pointer */
ELEMENT *el; /* an element pointer */
MULTIGRID *mg; /* our multigrid */
char filename[NAMESIZE]; /* file name for output file */
PFILE *pf; /* the output file pointer */
INT nv; /* number of variables (eval functions) */
EVALUES *ev[MAXVARIABLES]; /* pointers to eval function descriptors */
char ev_name[MAXVARIABLES][NAMESIZE]; /* names for eval functions */
char s[NAMESIZE]; /* name of eval proc */
char zonename[NAMESIZE+7] = ""; /* name for zone (initialized to
empty string) */
INT numNodes; /* number of data points */
INT numElements; /* number of elements */
INT gnumNodes; /* number of data points globally */
INT gnumElements; /* number of elements globallay */
PreprocessingProcPtr pre; /* pointer to prepare function */
ElementEvalProcPtr eval; /* pointer to evaluation function */
DOUBLE *CornersCoord[MAX_CORNERS_OF_ELEM]; /* pointers to coordinates */
DOUBLE LocalCoord[DIM]; /* is one of the corners local coordinates */
DOUBLE local[DIM]; /* local coordinate in DOUBLE */
DOUBLE value; /* returned by user eval proc */
INT oe,on;
INT saveGeometry; /* save geometry flag */
/* get current multigrid */
mg = GetCurrentMultigrid();
if (mg==NULL)
{
PrintErrorMessage('W',"tecplot","no multigrid open\n");
return (OKCODE);
}
/* scan options */
nv = 0; saveGeometry = 0;
for(i=1; i<argc; i++)
{
switch(argv[i][0])
{
case 'e' : /* read eval proc */
if (nv>=MAXVARIABLES)
{
PrintErrorMessage('E',"tecplot","too many variables specified\n");
break;
}
sscanf(argv[i],"e %s", s);
ev[nv] = GetElementValueEvalProc(s);
if (ev[nv]==NULL)
{
PrintErrorMessageF('E',"tecplot","could not find eval proc %s\n",s);
break;
}
if (sscanf(argv[i+1],"s %s", s) == 1)
{
strcpy(ev_name[nv],s);
i++;
}
else
strcpy(ev_name[nv],ev[nv]->v.name);
nv++;
break;
case 'z' :
sscanf(argv[i],"z %s", zonename+3);
memcpy(zonename, "T=\"", 3);
memcpy(zonename+strlen(zonename), "\", \0", 4);
break;
case 'g' :
sscanf(argv[i],"g %d", &saveGeometry);
if (saveGeometry<0) saveGeometry=0;
if (saveGeometry>1) saveGeometry=1;
break;
}
}
if (nv==0) UserWrite("tecplot: no variables given, printing mesh data only\n");
/* get file name and open output file */
if (sscanf(argv[0],expandfmt(CONCAT3(" tecplot %",NAMELENSTR,"[ -~]")),filename)!=1)
{
PrintErrorMessage('E',"tecplot","could not read name of logfile");
return(PARAMERRORCODE);
}
pf = pfile_open(filename);
if (pf==NULL) return(PARAMERRORCODE);
/********************************/
/* TITLE */
/********************************/
ic = 0;
sprintf(it,"TITLE = \"UG TECPLOT OUTPUT\"\n");
strcpy(item+ic,it); ic+=strlen(it);
sprintf(it,"VARIABLES = \"X\", \"Y\"");
strcpy(item+ic,it); ic+=strlen(it);
if (DIM==3) {
sprintf(it,", \"Z\"");
strcpy(item+ic,it); ic+=strlen(it);
}
for (i=0; i<nv; i++) {
sprintf(it,", \"%s\"",ev[i]->v.name);
strcpy(item+ic,it); ic+=strlen(it);
}
sprintf(it,"\n");
strcpy(item+ic,it); ic+=strlen(it);
pfile_master_puts(pf,item); ic=0;
/********************************/
/* compute sizes */
/********************************/
/* clear VCFLAG on all levels */
for (k=0; k<=TOPLEVEL(mg); k++)
for (vc=FIRSTVECTOR(GRID_ON_LEVEL(mg,k)); vc!=NULL; vc=SUCCVC(vc))
SETVCFLAG(vc,0);
/* run thru all levels of elements and set index */
numNodes = numElements = 0;
for (k=0; k<=TOPLEVEL(mg); k++)
for (el=FIRSTELEMENT(GRID_ON_LEVEL(mg,k)); el!=NULL; el=SUCCE(el))
{
if (!EstimateHere(el)) continue; /* process finest level elements only */
numElements++; /* increase element counter */
for (i=0; i<CORNERS_OF_ELEM(el); i++)
{
vc = NVECTOR(CORNER(el,i));
if (VCFLAG(vc)) continue; /* we have this one already */
VINDEX(vc) = ++numNodes; /* number of data points, begins with 1 ! */
SETVCFLAG(vc,1); /* tag vector as visited */
}
}
#ifdef ModelP
gnumNodes = TPL_GlobalSumINT(numNodes);
gnumElements = TPL_GlobalSumINT(numElements);
on=get_offset(numNodes);
oe=get_offset(numElements);
/* clear VCFLAG on all levels */
for (k=0; k<=TOPLEVEL(mg); k++)
for (vc=FIRSTVECTOR(GRID_ON_LEVEL(mg,k)); vc!=NULL; vc=SUCCVC(vc))
SETVCFLAG(vc,0);
/* number in unique way */
for (k=0; k<=TOPLEVEL(mg); k++)
for (el=FIRSTELEMENT(GRID_ON_LEVEL(mg,k)); el!=NULL; el=SUCCE(el))
{
if (!EstimateHere(el)) continue; /* process finest level elements only */
for (i=0; i<CORNERS_OF_ELEM(el); i++)
{
vc = NVECTOR(CORNER(el,i));
if (VCFLAG(vc)) continue; /* we have this one already */
VINDEX(vc) += on; /* add offset */
SETVCFLAG(vc,1); /* tag vector as visited */
}
}
#else
gnumNodes = numNodes;
gnumElements = numElements;
oe=on=0;
#endif
/********************************/
/* write ZONE data */
/* uses FEPOINT for data */
/* uses QUADRILATERAL in 2D */
/* and BRICK in 3D */
/********************************/
/* write zone record header */
if (DIM==2) sprintf(it,"ZONE %sN=%d, E=%d, F=FEPOINT, ET=QUADRILATERAL\n", zonename, gnumNodes,gnumElements);
if (DIM==3) sprintf(it,"ZONE %sN=%d, E=%d, F=FEPOINT, ET=BRICK\n", zonename, gnumNodes,gnumElements);
strcpy(item+ic,it); ic+=strlen(it);
pfile_master_puts(pf,item); ic=0;
/* write data in FEPOINT format, i.e. all variables of a node per line*/
for (k=0; k<=TOPLEVEL(mg); k++)
for (vc=FIRSTVECTOR(GRID_ON_LEVEL(mg,k)); vc!=NULL; vc=SUCCVC(vc))
SETVCFLAG(vc,0); /* clear all flags */
counter=0;
for (k=0; k<=TOPLEVEL(mg); k++)
for (el=FIRSTELEMENT(GRID_ON_LEVEL(mg,k)); el!=NULL; el=SUCCE(el))
{
if (!EstimateHere(el)) continue; /* process finest level elements only */
for (i=0; i<CORNERS_OF_ELEM(el); i++)
CornersCoord[i] = CVECT(MYVERTEX(CORNER(el,i))); /* x,y,z of corners */
for (i=0; i<CORNERS_OF_ELEM(el); i++)
{
vc = NVECTOR(CORNER(el,i));
if (VCFLAG(vc)) continue; /* we have this one alre ady */
SETVCFLAG(vc,1); /* tag vector as visited */
sprintf(it,"%g",(double)XC(MYVERTEX(CORNER(el,i))));
strcpy(item+ic,it); ic+=strlen(it);
sprintf(it," %g",(double)YC(MYVERTEX(CORNER(el,i))));
strcpy(item+ic,it); ic+=strlen(it);
if (DIM == 3)
{
sprintf(it," %g",(double)ZC(MYVERTEX(CORNER(el,i))));
strcpy(item+ic,it); ic+=strlen(it);
}
/* now all the user variables */
/* get local coordinate of corner */
LocalCornerCoordinates(DIM,TAG(el),i,local);
for (j=0; j<DIM; j++) LocalCoord[j] = local[j];
for (v=0; v<nv; v++)
{
pre = ev[v]->PreprocessProc;
eval = ev[v]->EvalProc;
/* execute prepare function */
/* This is not really equivalent to
the FEBLOCK-version sinc we call "pre" more
often than there. D.Werner */
if (pre!=NULL) pre(ev_name[v],mg);
/* call eval function */
value = eval(el,(const DOUBLE **)CornersCoord,LocalCoord);
sprintf(it," %g",value);
strcpy(item+ic,it); ic+=strlen(it);
}
sprintf(it,"\n");
strcpy(item+ic,it); ic+=strlen(it);
pfile_tagged_puts(pf,item,counter+on); ic=0;
counter++;
}
}
pfile_sync(pf); /* end of segment */
sprintf(it,"\n");
strcpy(item+ic,it); ic+=strlen(it);
pfile_master_puts(pf,item); ic=0;
/* finally write the connectivity list */
counter=0;
for (k=0; k<=TOPLEVEL(mg); k++)
for (el=FIRSTELEMENT(GRID_ON_LEVEL(mg,k)); el!=NULL; el=SUCCE(el))
{
if (!EstimateHere(el)) continue; /* process finest level elements only */
switch(DIM) {
case 2 :
switch(TAG(el)) {
case TRIANGLE :
sprintf(it,"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,2)))
);
break;
case QUADRILATERAL :
sprintf(it,"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,3)))
);
break;
default :
UserWriteF("tecplot: unknown 2D element type with tag(el) = %d detected. Aborting further processing of command tecplot\n", TAG(el));
return CMDERRORCODE;
break;
}
break;
case 3 :
switch(TAG(el)) {
case HEXAHEDRON :
sprintf(it,"%d %d %d %d "
"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,4))),
VINDEX(NVECTOR(CORNER(el,5))),
VINDEX(NVECTOR(CORNER(el,6))),
VINDEX(NVECTOR(CORNER(el,7)))
);
break;
case TETRAHEDRON :
sprintf(it,"%d %d %d %d "
"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,3)))
);
break;
case PYRAMID :
sprintf(it,"%d %d %d %d "
"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,4))),
VINDEX(NVECTOR(CORNER(el,4))),
VINDEX(NVECTOR(CORNER(el,4))),
VINDEX(NVECTOR(CORNER(el,4)))
);
break;
case PRISM :
sprintf(it,"%d %d %d %d "
"%d %d %d %d\n",
VINDEX(NVECTOR(CORNER(el,0))),
VINDEX(NVECTOR(CORNER(el,1))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,2))),
VINDEX(NVECTOR(CORNER(el,3))),
VINDEX(NVECTOR(CORNER(el,4))),
VINDEX(NVECTOR(CORNER(el,5))),
VINDEX(NVECTOR(CORNER(el,5)))
);
break;
default :
UserWriteF("tecplot: unknown 3D element type with tag(el) = %d detected. Aborting further processing of command tecplot\n", TAG(el));
return CMDERRORCODE;
break;
}
break;
}
strcpy(item+ic,it); ic+=strlen(it);
pfile_tagged_puts(pf,item,counter+oe); ic=0;
counter++;
}
pfile_sync(pf); /* end of segment */
/********************************/
/* GEOMETRY */
/* we will do this later, since */
/* domain interface will change */
/********************************/
pfile_close(pf);
return(OKCODE);
}